diff --git a/.github/workflows/build-windows.yml b/.github/workflows/build-windows.yml index eec72483948..45959eb5e21 100644 --- a/.github/workflows/build-windows.yml +++ b/.github/workflows/build-windows.yml @@ -78,11 +78,11 @@ jobs: # export FSTAR_TAG=-$KERNEL-$ARCH # make -kj$(nproc) 0 V=1 # echo ------------------------------------------------- - # ./stage0/bin/fstar.exe --version - # ./stage0/bin/fstar.exe --locate - # ./stage0/bin/fstar.exe --locate_lib - # ./stage0/bin/fstar.exe --locate_ocaml - # ./stage0/bin/fstar.exe --include src --debug yes || true + # ./stage0/out/bin/fstar.exe --version + # ./stage0/out/bin/fstar.exe --locate + # ./stage0/out/bin/fstar.exe --locate_lib + # ./stage0/out/bin/fstar.exe --locate_ocaml + # ./stage0/out/bin/fstar.exe --include src --debug yes || true # echo ------------------------------------------------- # make -kj$(nproc) package V=1 diff --git a/Makefile b/Makefile index e5c298cb14c..bdeb7f9c62a 100644 --- a/Makefile +++ b/Makefile @@ -18,14 +18,12 @@ all-packages: package-1 package-2 package-src-1 package-src-2 # to a local build of stage0, to avoid recompiling it every time. ifneq ($(FSTAR_EXTERNAL_STAGE0),) FSTAR0_EXE := $(abspath $(FSTAR_EXTERNAL_STAGE0)) -_ != mkdir -p stage0/bin -_ != ln -Trsf $(FSTAR0_EXE) stage0/bin/fstar.exe +_ != mkdir -p stage0/out/bin +_ != ln -Trsf $(FSTAR0_EXE) stage0/out/bin/fstar.exe # ^ Setting this link allows VS code to work seamlessly. endif -# When stage0 is bumped, use this: -#FSTAR0_EXE ?= stage0/out/bin/fstar.exe -FSTAR0_EXE ?= stage0/bin/fstar.exe +FSTAR0_EXE ?= stage0/out/bin/fstar.exe # This is hardcoding some dune paths, with internal (non-public) names. # This is motivated by dune installing packages as a unit, so I could not @@ -72,11 +70,8 @@ build: 2 0 $(FSTAR0_EXE): $(call bold_msg, "STAGE 0") mkdir -p stage0/ulib/.cache # prevent warnings - $(MAKE) -C stage0 fstar + $(MAKE) -C stage0 install_bin # build: only fstar.exe $(MAKE) -C stage0 trim # We don't need OCaml build files. - # When the stage is bumped, use this: - # $(MAKE) -C stage0 build # build: only fstar.exe - # $(MAKE) -C stage0 trim # We don't need OCaml build files. .bare1.src.touch: $(FSTAR0_EXE) .force $(call bold_msg, "EXTRACT", "STAGE 1 FSTARC-BARE") @@ -435,7 +430,7 @@ ci: .force save: stage0_new stage0_new: TO=stage0_new -stage0_new: .stage2.touch +stage0_new: .stage2.src.touch $(call bold_msg, "SNAPSHOT", "$(TO)") rm -rf "$(TO)" .scripts/src-install.sh "stage2" "$(TO)" diff --git a/fstar.opam b/fstar.opam index a6fd44c0ebc..4f6276f1998 100644 --- a/fstar.opam +++ b/fstar.opam @@ -1,5 +1,5 @@ opam-version: "2.0" -version: "2025.01.06~dev" +version: "2025.02.06~dev" maintainer: "taramana@microsoft.com" authors: "Nik Swamy ,Jonathan Protzenko ,Tahina Ramananandro " homepage: "http://fstar-lang.org" diff --git a/src/FStarCompiler.fst.config.json b/src/FStarCompiler.fst.config.json index cf7dee212cc..36722693f43 100644 --- a/src/FStarCompiler.fst.config.json +++ b/src/FStarCompiler.fst.config.json @@ -1,5 +1,5 @@ { - "fstar_exe": "../stage0/bin/fstar.exe", + "fstar_exe": "../stage0/out/bin/fstar.exe", "options": [ "--MLish", "--MLish_effect", "FStarC.Effect", diff --git a/stage0/.fstarlock b/stage0/.fstarlock new file mode 100644 index 00000000000..e69de29bb2d diff --git a/stage0/.gitattributes b/stage0/.gitattributes deleted file mode 100644 index 49a35fe618a..00000000000 --- a/stage0/.gitattributes +++ /dev/null @@ -1,2 +0,0 @@ -** -diff -merge -** linguist-generated=true diff --git a/stage0/.gitignore b/stage0/.gitignore index 3daf4e6bbe4..1fcb1529f8e 100644 --- a/stage0/.gitignore +++ b/stage0/.gitignore @@ -1,3 +1 @@ -# copied from the root -version.txt -/lib +out diff --git a/stage0/.scripts/bin-install.sh b/stage0/.scripts/bin-install.sh new file mode 100755 index 00000000000..cd8571e5140 --- /dev/null +++ b/stage0/.scripts/bin-install.sh @@ -0,0 +1,52 @@ +#!/bin/bash + +# This is called by the Makefile *after* an installation into the +# prefix, so we add the rest of the files that go into a binary package. + +set -eu + +windows () { + # This seems portable enough and does not trigger an + # undefined variable error (see set -u above) if $OS + # is unset (like in linux/mac). Note: OSX's bash is usually + # old and does not support '[ -v OS ]'. + [[ "${OS:-}" = "Windows_NT" ]] +} + +if [ $# -ne 1 ]; then + echo "Usage: $0 " >&2 + exit 1 +fi + +PREFIX="$1" +mkdir -p "$PREFIX" +PREFIX="$(realpath "$PREFIX")" + +if ! [ -v FSTAR_PACKAGE_Z3 ] || ! [ "$FSTAR_PACKAGE_Z3" = false ]; then + .scripts/package_z3.sh "$PREFIX" +fi + +if windows; then + # This dll is needed. It must be installed if we're packaging, as we + # must have run F* already, but it should probably be obtained from + # somewhere else.. + LIBGMP=$(which libgmp-10.dll) || echo "error: libgmp-10.dll not found! Carrying on..." >&2 + cp "$LIBGMP" "$PREFIX/bin" +fi + +# License and extra files. Not there on normal installs, but present in +# package. +cp LICENSE* "$PREFIX" +cp README.md "$PREFIX" +cp INSTALL.md "$PREFIX" +cp version.txt "$PREFIX" + +# Save the megabytes! Strip binaries +STRIP=strip + +if windows; then + STRIP="$(pwd)/mk/winwrap.sh $STRIP" +fi + +$STRIP "$PREFIX"/bin/* || true +$STRIP "$PREFIX"/lib/fstar/z3-*/bin/* || true diff --git a/stage0/.scripts/get_fstar_z3.sh b/stage0/.scripts/get_fstar_z3.sh new file mode 100755 index 00000000000..938d9be0253 --- /dev/null +++ b/stage0/.scripts/get_fstar_z3.sh @@ -0,0 +1,146 @@ +#!/usr/bin/env bash +set -euo pipefail + +full_install=false + +kernel="$(uname -s)" +case "$kernel" in + CYGWIN*) kernel=Windows ;; +esac + +arch="$(uname -m)" +case "$arch" in + arm64) arch=aarch64 ;; +esac + +release_url=( + "Linux-x86_64-4.8.5":"https://github.com/Z3Prover/z3/releases/download/Z3-4.8.5/z3-4.8.5-x64-ubuntu-16.04.zip" + "Darwin-x86_64-4.8.5":"https://github.com/Z3Prover/z3/releases/download/Z3-4.8.5/z3-4.8.5-x64-osx-10.14.2.zip" + "Windows-x86_64-4.8.5":"https://github.com/Z3Prover/z3/releases/download/Z3-4.8.5/z3-4.8.5-x64-win.zip" + "Linux-x86_64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-x64-glibc-2.35.zip" + "Linux-aarch64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-arm64-glibc-2.34.zip" + "Darwin-x86_64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-x64-osx-13.7.zip" + "Darwin-aarch64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-arm64-osx-13.7.zip" + "Windows-x86_64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-x64-win.zip" +) + +get_url() { + local key elem + key="$1" + + for elem in "${release_url[@]}"; do + if [ "${elem%%:*}" = "$key" ]; then + echo -n "${elem#*:}" + break + fi + done +} + +trap "exit 1" HUP INT PIPE QUIT TERM +cleanup() { + if [ -n "${tmp_dir:-}" ]; then + rm -rf "$tmp_dir" + fi +} +trap "cleanup" EXIT + +download_z3() { + local url version destination_file_name base_name z3_path + url="$1" + version="$2" + destination_file_name="$3" + + if [ -z "${tmp_dir:-}" ]; then + tmp_dir="$(mktemp -d --tmpdir get_fstar_z3.XXXXXXX)" + fi + + echo ">>> Downloading Z3 $version from $url ..." + base_name="$(basename "$url")" + + z3_path="${base_name%.zip}/bin/z3" + if [ "$kernel" = Windows ]; then z3_path="$z3_path.exe"; fi + + pushd "$tmp_dir" > /dev/null + curl -s -L "$url" -o "$base_name" + + unzip -q "$base_name" "$z3_path" + popd > /dev/null + install -m0755 "$tmp_dir/$z3_path" "$destination_file_name" + echo ">>> Installed Z3 $version to $destination_file_name" +} + +full_install_z3() { + local url version dest_dir base_name + + url="$1" + version="$2" + dest_dir="$3" + + mkdir -p "$dest_dir/z3-$version" + pushd "$dest_dir/z3-$version" > /dev/null + + echo ">>> Downloading Z3 $version from $url ..." + base_name="$(basename "$url")" + curl -s -L "$url" -o "$base_name" + + unzip -q "$base_name" + mv "${base_name%.zip}"/* . + rmdir "${base_name%.zip}" + rm "$base_name" + popd > /dev/null +} + +usage() { + echo "Usage: get_fstar_z3.sh destination/directory/bin" + exit 1 +} + +if [ $# -ge 1 ] && [ "$1" == "--full" ]; then + # Passing --full xyz/ will create a tree like + # xyz/z3-4.8.5/bin/z3 + # xyz/z3-4.13.3/bin/z3 + # (plus all other files in each package). This is used + # for our binary packages which include Z3. + full_install=true; + shift; +fi + +if [ $# -ne 1 ]; then + usage +fi + +dest_dir="$1" + +mkdir -p "$dest_dir" + +for z3_ver in 4.8.5 4.13.3; do + destination_file_name="$dest_dir/z3-$z3_ver" + if [ "$kernel" = Windows ]; then destination_file_name="$destination_file_name.exe"; fi + + if [ -f "$destination_file_name" ]; then + echo ">>> Z3 $z3_ver already downloaded to $destination_file_name" + else + key="$kernel-$arch-$z3_ver" + + case "$key" in + Linux-aarch64-4.8.5) + echo ">>> Z3 4.8.5 is not available for aarch64, downloading x86_64 version. You need to install qemu-user (and shared libraries) to execute it." + key="$kernel-x86_64-$z3_ver" + ;; + Darwin-aarch64-4.8.5) + echo ">>> Z3 4.8.5 is not available for aarch64, downloading x86_64 version. You need to install Rosetta 2 to execute it." + key="$kernel-x86_64-$z3_ver" + ;; + esac + + url="$(get_url "$key")" + + if [ -z "$url" ]; then + echo ">>> Z3 $z3_ver not available for this architecture, skipping..." + elif $full_install; then + full_install_z3 "$url" "$z3_ver" "$dest_dir" + else + download_z3 "$url" "$z3_ver" "$destination_file_name" + fi + fi +done diff --git a/stage0/.scripts/mk-package.sh b/stage0/.scripts/mk-package.sh new file mode 100755 index 00000000000..7a02148b960 --- /dev/null +++ b/stage0/.scripts/mk-package.sh @@ -0,0 +1,117 @@ +#!/bin/bash + +set -eu + +# This will just create a tar.gz or zip out of a directory. +# You may want to look at src-install.sh and bin-install.sh +# that generate the layouts for a source and binary package, +# and are then packaged up with this script. + +if [ $# -ne 2 ]; then + exec >&2 + echo "usage: $0 " + echo "The archive format and command used depends on the system and installed tools," + echo "see script for details." + echo "Optionally set FSTAR_PACKAGE_FORMAT to: " + echo " - 'zip': create a .zip via 'zip' command" + echo " - '7z': create a .zip via '7z' command" + echo " - 'tar.gz': create a .tar.gz, via calling" + echo "Output filename is + proper extension" + echo "If FSTAR_RELEASE is non-empty, we use maximum compression." + exit 1 +fi + +PREFIX="$1" +ARCHIVE="$2" + +windows () { + # This seems portable enough and does not trigger an + # undefined variable error (see set -u above) if $OS + # is unset (like in linux/mac). Note: OSX's bash is usually + # old and does not support '[ -v OS ]'. + [[ "${OS:-}" = "Windows_NT" ]] +} + +release () { + [[ -n "${FSTAR_RELEASE:-}" ]] +} + +# Computes a (hopefully) sensible default for the current system +detect_format () { + if windows; then + # Github actions runner do not have 'zip' + if which zip > /dev/null; then + FSTAR_PACKAGE_FORMAT=zip + elif which 7z > /dev/null; then + FSTAR_PACKAGE_FORMAT=7z + else + echo "error: no zip or 7z command found." >&2 + exit 1 + fi + else + FSTAR_PACKAGE_FORMAT=tar.gz + fi +} + +# If unset, pick a default for the system. +if ! [ -v FSTAR_PACKAGE_FORMAT ]; then + detect_format +fi + +# Fix for stupid path confustion in windows +if windows; then + WRAP=$(pwd)/mk/winwrap.sh +else + WRAP= +fi + +case $FSTAR_PACKAGE_FORMAT in + zip) + TGT="$ARCHIVE.zip" + ATGT="$(realpath "$TGT")" + pushd "$PREFIX" >/dev/null + LEVEL= + if release; then + LEVEL=-9 + fi + $WRAP zip -q -r $LEVEL "$ATGT" . + popd >/dev/null + ;; + 7z) + TGT="$ARCHIVE.zip" + ATGT="$(realpath "$TGT")" + LEVEL= + if release; then + LEVEL=-mx9 + fi + pushd "$PREFIX" >/dev/null + $WRAP 7z $LEVEL a "$ATGT" . + popd >/dev/null + ;; + tar.gz|tgz) + # -h: resolve symlinks + TGT="$ARCHIVE.tar.gz" + $WRAP tar cf "$ARCHIVE.tar" -h -C "$PREFIX" . + LEVEL= + if release; then + LEVEL=-9 + fi + $WRAP gzip -f $LEVEL "$ARCHIVE.tar" + ;; + *) + echo "unrecognized FSTAR_PACKAGE_FORMAT: $FSTAR_PACKAGE_FORMAT" >&2 + exit 1 + ;; +esac + +if ! [ -f "$TGT" ] ; then + echo "error: something seems wrong, archive '$TGT' not found?" >&2 + exit 1 +fi + +# bytes=$(stat -c%s "$TGT") +# echo "Wrote $TGT" ($bytes bytes)" +# ^ Does not work in Mac (no -c option for stat) + +echo "Wrote $TGT" +ls -l "$TGT" || true diff --git a/stage0/.scripts/package_z3.sh b/stage0/.scripts/package_z3.sh new file mode 100755 index 00000000000..64f911921fd --- /dev/null +++ b/stage0/.scripts/package_z3.sh @@ -0,0 +1,33 @@ +#!/bin/bash + +PREFIX="$1" +mkdir -p "$PREFIX" +PREFIX="$(realpath "$PREFIX")" + +D="$(dirname "$0")" + +mkdir -p "$PREFIX"/lib/fstar + +TMP=$(mktemp -d) +$D/get_fstar_z3.sh --full "$TMP" + +pushd "$TMP" > /dev/null + +inst1 () { + TGT="$PREFIX/lib/fstar/$1" + mkdir -p "$(dirname "$TGT")" + cp "$1" "$TGT" +} + +for dir in z3-4.8.5 z3-4.13.3; do + inst1 ./$dir/bin/z3 + inst1 ./$dir/LICENSE.txt + for dll in ./$dir/bin/*dll; do + # Needed for Windows packages. + inst1 "$dll" + done +done + +popd > /dev/null + +rm -r "$TMP" diff --git a/stage0/INSTALL.md b/stage0/INSTALL.md new file mode 100644 index 00000000000..638eb914c0f --- /dev/null +++ b/stage0/INSTALL.md @@ -0,0 +1,387 @@ +## Table of Contents ## + + * [Online editor](#online-editor) + * [OPAM package](#opam-package) + * [Binary package](#binary-package) + * [Installing a binary package](#installing-a-binary-package) + * [Testing a binary package](#testing-a-binary-package) + * [Running F* from a docker image](#running-f-from-a-docker-image) + * [Chocolatey Package on Windows](#chocolatey-package-on-windows) + * [Nix Package](#nix-package) + * [Building F* from the OCaml sources](#building-f-from-the-ocaml-sources) + * [Prerequisites: Working OCaml setup](#prerequisites-working-ocaml-setup) + * [Instructions for Windows](#instructions-for-windows) + * [Instructions for Linux and Mac OS X](#instructions-for-linux-and-mac-os-x) + * [Instructions for all OSes](#instructions-for-all-oses) + * [Building F* and the libraries](#building-f-and-its-libraries) + * [Bootstrapping F* in OCaml](#bootstrapping-f-in-ocaml) + * [Step 1. Build an F* binary from OCaml snapshot](#step-1-build-an-f-binary-from-ocaml-snapshot) + * [Step 2b. Extract the sources of F* itself to OCaml](#step-2b-extract-the-sources-of-f-itself-to-ocaml) + * [Repeat Step 1](#repeat-step-1) + * [Runtime dependency: Particular version of Z3](#runtime-dependency-particular-version-of-z3) + +## Online editor ## + +The easiest way to try out F\* quickly is directly in your browser by +using the [online F\* editor] that's part of the [F\* tutorial]. + +[online F\* editor]: https://www.fstar-lang.org/run.php +[F\* tutorial]: https://www.fstar-lang.org/tutorial + +## Runtime dependency: Particular version of Z3 ## + +F\* requires specific versions of Z3 to work correctly, +and will refuse to run if the version string does not match. +You should have `z3-4.8.5` and `z3-4.13.3` in your `$PATH`: + +``` +❯ z3-4.8.5 --version +Z3 version 4.8.5 - 64 bit + +❯ z3-4.13.3 --version +Z3 version 4.13.3 - 64 bit +``` + +On Linux you can install these two versions with the following command: +```bash +sudo ./bin/get_fstar_z3.sh /usr/local/bin +``` + +## OPAM package ## + +If the OCaml package manager (OPAM version 2.0 or later) is present on your platform, +you can install the latest development version of F\* (`master` branch) and +required dependencies using the following command: + + $ opam pin add fstar --dev-repo + +To instead install the latest released version you can use the following command +(keeping in mind that you will often get an old version of F\* this way, +so unless a release happened recently we don't really recommend it): + + $ opam install fstar + +Note: To install OCaml and OPAM on your platform please read the +[Working OCaml setup](#prerequisites-working-ocaml-setup) +section further below, steps 0 to 3. + +Note: On MacOS you will additionally need to install `coreutils` +via Homebrew or Macports for the OPAM package of F\* to work +(see [issue #469](https://github.com/FStarLang/FStar/issues/469)). + + +## Binary package ## + +Every week or so we release [F\* binaries on GitHub] (for Windows and Linux). +This is a way to get F\* quickly running on your machine, +but if the build you use is old you might be missing out on new +features and bug fixes. Please do not report bugs in old releases +until making sure they still exist in the `master` branch (see +[OPAM package](#opam-package) above and +[Building F\* from sources](#building-f-from-the-ocaml-sources) below). + +[F\* binaries on GitHub]: https://github.com/FStarLang/FStar/releases + +Using a binary package allows you to use F* even if you do not want to +install OCaml on your machine. You will be able to verify F* code, and +to generate OCaml code from F*; but if you want to compile such +generated OCaml code, then you will need OCaml. + +### Installing a binary package ### + +After downloading a binary package and extracting its contents, you +need to perform the following step before your first use: + + Add `fstar.exe` and `z3` to your `PATH`, either permanently + or temporarily, for instance by running this: + + $ export PATH=/path/to/fstar/bin:$PATH + $ fstar.exe --version + F* 0.9.8.0~dev + platform=Linux_x86_64 + compiler=OCaml 4.14.0 + date=yyyy-mm-ddThh:nn:ss+02:00 + commit=xxxxxxxx + $ z3-4.13.3 --version + Z3 version 4.13.3 - 64 bit + + Note: if you are using the binary package and extracted it to, say, the + `/path/to/fstar` directory, then both `fstar.exe` and the right version of + `z3` are in the `path/to/fstar/bin` directory. + +### Testing a binary package ### + +After installing a F* binary package as described above, you can test +that the binary is good if you wish, by running the following +commands. (Note: On Windows this requires Cygwin and `make`) + +1. You can run the micro benchmarks: + + $ make -C tests/micro-benchmarks + + +2. You can also verify all the examples, keep in mind that this will + take a long time, use a lot of resources, and there are also some quirks + explained in the notes below. + + $ make -C examples -j6 HAS_OCAML= + $ echo $? # non-zero means build failed! scroll up for error message! + + Note: Some of the examples need to generate and compile OCaml + code. The `HAS_OCAML=` argument to `make` disables those + parts of those examples that rely on OCaml. If, however, you + remove that option, then you will most likely encounter + version discrepancies between the OCaml support libraries + included in the F\* binary packages and the OCaml libraries + and packages installed on your system. This is why, to avoid + such discrepancies, you should install F\* via opam if you + are interested in compiling these examples. + + Note: Some of the examples currently require having [KaRaMeL](https://github.com/FStarLang/karamel) + installed and the `KRML_HOME` variable pointing to its location. + If KaRaMeL is absent, then these examples will be skipped. + + Note: On Linux if you get a file descriptor exhaustion error that looks + like this `Unix.Unix_error(Unix.ENOMEM, "fork", "")` + you can increase the limits with `ulimit -n 4000`. + +## Running F\* from a docker image ## + +An alternative to installing binaries is to install a docker image. +We currently provide the following two on docker hub: `fstarlang/fstar-emacs` +with emacs support and `fstarlang/fstar` for purists. +The image is automatically kept up to date through a cloud build. + +You only have to install docker and an X server for your platform and you are good to go. +See [Running F\* from a docker image](https://github.com/FStarLang/FStar/wiki/Running-F%2A-from-a-docker-image) +for the details on how to use docker. + +## Chocolatey Package on Windows ## + +On windows you can use chocolatey package manager to install and update the +latest released version of F\*. (Keep in mind that you will often get an old +version of F\* this way, so unless a release happened recently we don't really +recommend it.) + + > choco install fstar + +or + + > cinst fstar + +you can find the package description [here](https://chocolatey.org/packages/FStar) + +## Nix Package ## + +On [Linux](https://nixos.org/download.html#nix-install-linux), +[MacOS](https://nixos.org/download.html#nix-install-macos) or +[Windows](https://nixos.org/download.html#nix-install-windows) (using +WSL2), you can use the [Nix package manager](https://nixos.org/) to +install F* from sources in a reproducible way, possibly with binaries +cached. + +**Bleeding-edge F\* from sources:** + +Install Nix and F\* `master` in one go with two lines of bash: +```bash +# 1. Install the Nix package manager manager (as https://nixos.org/download.html) +sh <(curl -L https://nixos.org/nix/install) --daemon +# 2. Build and install F\* in your profile environment +nix profile install github:FStarLang/FStar --experimental-features 'nix-command flakes' +``` + +For more information about building F\* from sources with Nix, see +[`./.nix/README.md`](./.nix/README.md). + +**F\* release with binary cache**: + +If you don't need bleeding-edge F\*, the Nix package collection +[Nixpkgs](https://github.com/NixOS/nixpkgs) provides F\* builds with +binary cache. The command `nix-shell -p fstar` will drop you in a bash +shell with F\*'s binary availaible in path. + + +## Building F\* from the OCaml sources ## + +If you have a serious interest in F\* then we recommend that you build +F\* from the sources on GitHub (the `master` branch). + +**Short version**: +Once you have a [working OCaml setup](#prerequisites-working-ocaml-setup), +simply run `make -j 6` from the `master` branch of the clone. +First we explain how to get a working OCaml setup on your machine. + +**Note:** To compile and use F\* from its sources, you will also need + to [get a particular version of + Z3](#runtime-dependency-particular-version-of-z3). + +### Prerequisites: Working OCaml setup ### + +The steps require a working OCaml setup. OCaml version 4.14.X should work. + +#### Instructions for Windows #### + +1. Please use [Andreas Hauptmann's OCaml Installer for Windows](https://fdopen.github.io/opam-repository-mingw/installation/) + to install both OCaml and OPAM. + +2. If needed switch to a supported OCaml version by running the following commands: + ```sh + $ opam update + $ opam switch list-available + $ opam switch create ocaml-variants.4.14.0+mingw64c + ``` + +3. Afterwards you can install the `depext` and `depext-cygwinports` packages, + to be able to install some binary dependencies below more easily. + ([More documentation on depext-cygwin here](https://fdopen.github.io/opam-repository-mingw/depext-cygwin/).) + ```sh + $ opam install depext depext-cygwinports + ``` + +Then follow step 4 in [Instructions for all OSes](#instructions-for-all-oses) below. + +#### Instructions for Linux and Mac OS X #### + +0. Install OCaml + - Can be installed using either your package manager or using OPAM + (see below). + +1. Install OPAM (version 2.0 or later). + + - Installation instructions are available at + [various](http://opam.ocaml.org/doc/Install.html) + [places](https://dev.realworldocaml.org/install.html). + +2. Initialize and configure OPAM + + - You need to initialize it by running `opam init` and update the `PATH` + variable to the `ocamlfind` and the OCaml libraries. If you allow + `opam init` to edit your `~/.bashrc` or `~/.profile`, it is done + automatically; otherwise, use: `eval $(opam config env)`. + +3. Ensure that OPAM is using a supported version of OCaml + + - Type `opam switch list`. The current OCaml version used by opam + is identified by the letter C. If it is not within the version + range required by F\* ([see above](#prerequisites-working-ocaml-setup)), + type `opam switch list-available` + to see what versions are available and then `opam switch `. + + - Afterwards you can also install the `depext` package if you are on OPAM version lower then 2.1, + to be able to install some binary dependencies below more easily. Version of OPAM after 2.1 has depext handling baked in. + ```sh + $ opam install depext + ``` + + Then follow [step 4](#instructions-for-all-oses) below. + +#### Instructions for all OSes #### + +4. F\* depends on a bunch of external OCaml packages which you should install using OPAM: + + ```sh + $ opam install --deps-only . + ``` + + **Note:** On some Linux distributions, for example Gentoo, where `opambuild` comes pre-installed, you may need run + `CHECK_IF_PREINSTALLED=false opam install .` instead to prevent build failures. + + **Note:** Some of these opam packages depend on binary packages that you need to install locally + (eg, using your Linux package manager). So if the command above gives you errors like this: + ```sh + [ERROR] The compilation of conf-gmp failed at "./test-win.sh". + ``` + You can use `depext` to install the missing binary packages, for instance: + ```sh + $ opam depext -i conf-gmp + ``` + On Windows, for dynamic libraries like gmp, you should add `/usr/x86_64-w64-mingw32/sys-root/mingw/bin:/usr/i686-w64-mingw32/sys-root/mingw/bin` to your cygwin `$PATH`. + If you additionally want to call `bin/fstar.exe` from Windows or VSCode (not just from a cygwin shell), + you also need to add the corresponding Windows paths (like `C:\cygwin64\usr\i686-w64-mingw32\sys-root\mingw\bin`) to your + Windows `$PATH`. Otherwise you will get popups like this when trying to call fstar.exe outside cygwin: + ```sh + The code execution cannot proceed because libgmp-10.dll was not found. Reinstall the program may fix this problem. + ``` + +### Building F\* and its libraries ### + +Once you have a working OCaml setup (see above) just run the following +command (you can use -j N, where N is a parallel factor suitable for +your machine): + + $ make -j N + +This does two things: + +1. As explained in more detail [below](#bootstrapping-f-in-ocaml), a snapshot of + the F\* sources extracted to OCaml is checked in the F\* repo and regularly + updated, and the command above will simply build an F\* binary out of that snapshot. + + That snapshot also contains the extracted OCaml code of the various + OCaml libraries needed for building OCaml code extracted from F\*, + native tactics, etc., so this step also compiles them. + + This step can be isolatedly run with `make dune-fstar` + + **Note:** On Windows this generates a *native* F\* binary, that is, + a binary that does *not* depend on `cygwin1.dll`, since [the installer above](#instructions-for-windows) + uses a *native* Windows + port of OCaml. Cygwin is just there to provide `make` and other + utilities required for the build. This also means that when + linking C libraries with OCaml compiled objects one needs to use + the *correct* mingw libraries and *not* the Cygwin ones. OCaml uses + special `flexlink` technology for this. See `examples/crypto` and + `contrib/CoreCrypto/ml` for examples. + +2. The command above verifies the F\* standard library, producing + `.checked` files that cache definitions to speed up subsequent + usage. + + This step can be isolatedly run with `make verify-ulib` + +## Bootstrapping F\* in OCaml + +F\* is written in a subset of F\* itself and can generate OCaml code from its own sources. +Therefore, the standard bootstrap build process of F\* involves the following three steps: + + **Step 1.** Build F\* using the OCaml compiler from the (possibly outdated) checked-in generated OCaml snapshot. + + **Step 2.** Extract the sources of F\* itself to OCaml using the F\* binary produced at step 1. + + **Repeat step 1**: Rebuild F\* from the newly generated OCaml code in the previous step. + +A convenience Makefile target is available to run all three steps: + + $ make boot -j6 + +If you already compiled F\*, you can do Step 2 then Step 1, by +skipping the first Step 1 (but not its repeat after Step 2) and using +your existing F\* to perform Step 2. To do so, just run `make +dune-bootstrap` instead of `make boot`. + +Those rules support parallelism and incrementality (by virtue of the +snapshot being compiled with dune). However, in some cases, it is +necessary to regenerate the whole snapshot by fully erasing it before +extracting it again. This may be needed for instance if some modules +in the F\* sources or in the standard library are renamed or +deleted. To this end, you can use `make dune-full-bootstrap` instead +of `make boot`. This command does `make clean-full-dune-snapshot` to +erase the extracted snapshot. + +### Step 1. Build an F\* binary from OCaml snapshot ### + +[Get an F\* binary using the OCaml build process](#building-f-and-its-libraries): + + $ make -j6 + +### Step 2. Extract the sources of F\* itself to OCaml ### + +1. Make sure you follow the instructions above to get a + [working OCaml setup](#prerequisites-working-ocaml-setup). + +2. Once you satisfy the prerequisites for your platform, + translate the F\* sources to OCaml using F\* by running: + + $ make dune-extract-all -j6 + +### Repeat [Step 1](#step-1-build-an-f-binary-from-ocaml-snapshot) diff --git a/stage0/LICENSE b/stage0/LICENSE new file mode 100644 index 00000000000..3a84ae5f46d --- /dev/null +++ b/stage0/LICENSE @@ -0,0 +1,190 @@ +Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + Copyright 2008-2014 Nikhil Swamy and Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. \ No newline at end of file diff --git a/stage0/LICENSE-fsharp.txt b/stage0/LICENSE-fsharp.txt new file mode 100644 index 00000000000..a42a2b03bae --- /dev/null +++ b/stage0/LICENSE-fsharp.txt @@ -0,0 +1,56 @@ +Apache License +Version 2.0, January 2004 +http://www.apache.org/licenses/ + +TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + +1. Definitions. + +"License" shall mean the terms and conditions for use, reproduction, and distribution as defined by Sections 1 through 9 of this document. + +"Licensor" shall mean the copyright owner or entity authorized by the copyright owner that is granting the License. + +"Legal Entity" shall mean the union of the acting entity and all other entities that control, are controlled by, or are under common control with that entity. For the purposes of this definition, "control" means (i) the power, direct or indirect, to cause the direction or management of such entity, whether by contract or otherwise, or (ii) ownership of fifty percent (50%) or more of the outstanding shares, or (iii) beneficial ownership of such entity. + +"You" (or "Your") shall mean an individual or Legal Entity exercising permissions granted by this License. + +"Source" form shall mean the preferred form for making modifications, including but not limited to software source code, documentation source, and configuration files. + +"Object" form shall mean any form resulting from mechanical transformation or translation of a Source form, including but not limited to compiled object code, generated documentation, and conversions to other media types. + +"Work" shall mean the work of authorship, whether in Source or Object form, made available under the License, as indicated by a copyright notice that is included in or attached to the work (an example is provided in the Appendix below). + +"Derivative Works" shall mean any work, whether in Source or Object form, that is based on (or derived from) the Work and for which the editorial revisions, annotations, elaborations, or other modifications represent, as a whole, an original work of authorship. For the purposes of this License, Derivative Works shall not include works that remain separable from, or merely link (or bind by name) to the interfaces of, the Work and Derivative Works thereof. + +"Contribution" shall mean any work of authorship, including the original version of the Work and any modifications or additions to that Work or Derivative Works thereof, that is intentionally submitted to Licensor for inclusion in the Work by the copyright owner or by an individual or Legal Entity authorized to submit on behalf of the copyright owner. For the purposes of this definition, "submitted" means any form of electronic, verbal, or written communication sent to the Licensor or its representatives, including but not limited to communication on electronic mailing lists, source code control systems, and issue tracking systems that are managed by, or on behalf of, the Licensor for the purpose of discussing and improving the Work, but excluding communication that is conspicuously marked or otherwise designated in writing by the copyright owner as "Not a Contribution." + +"Contributor" shall mean Licensor and any individual or Legal Entity on behalf of whom a Contribution has been received by Licensor and subsequently incorporated within the Work. + +2. Grant of Copyright License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable copyright license to reproduce, prepare Derivative Works of, publicly display, publicly perform, sublicense, and distribute the Work and such Derivative Works in Source or Object form. + +3. Grant of Patent License. Subject to the terms and conditions of this License, each Contributor hereby grants to You a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except as stated in this section) patent license to make, have made, use, offer to sell, sell, import, and otherwise transfer the Work, where such license applies only to those patent claims licensable by such Contributor that are necessarily infringed by their Contribution(s) alone or by combination of their Contribution(s) with the Work to which such Contribution(s) was submitted. If You institute patent litigation against any entity (including a cross-claim or counterclaim in a lawsuit) alleging that the Work or a Contribution incorporated within the Work constitutes direct or contributory patent infringement, then any patent licenses granted to You under this License for that Work shall terminate as of the date such litigation is filed. + +4. Redistribution. You may reproduce and distribute copies of the Work or Derivative Works thereof in any medium, with or without modifications, and in Source or Object form, provided that You meet the following conditions: + + 1. You must give any other recipients of the Work or Derivative Works a copy of this License; and + + 2. You must cause any modified files to carry prominent notices stating that You changed the files; and + + 3. You must retain, in the Source form of any Derivative Works that You distribute, all copyright, patent, trademark, and attribution notices from the Source form of the Work, excluding those notices that do not pertain to any part of the Derivative Works; and + + 4. If the Work includes a "NOTICE" text file as part of its distribution, then any Derivative Works that You distribute must include a readable copy of the attribution notices contained within such NOTICE file, excluding those notices that do not pertain to any part of the Derivative Works, in at least one of the following places: within a NOTICE text file distributed as part of the Derivative Works; within the Source form or documentation, if provided along with the Derivative Works; or, within a display generated by the Derivative Works, if and wherever such third-party notices normally appear. The contents of the NOTICE file are for informational purposes only and do not modify the License. You may add Your own attribution notices within Derivative Works that You distribute, alongside or as an addendum to the NOTICE text from the Work, provided that such additional attribution notices cannot be construed as modifying the License. + +You may add Your own copyright statement to Your modifications and may provide additional or different license terms and conditions for use, reproduction, or distribution of Your modifications, or for any such Derivative Works as a whole, provided Your use, reproduction, and distribution of the Work otherwise complies with the conditions stated in this License. + +5. Submission of Contributions. Unless You explicitly state otherwise, any Contribution intentionally submitted for inclusion in the Work by You to the Licensor shall be under the terms and conditions of this License, without any additional terms or conditions. Notwithstanding the above, nothing herein shall supersede or modify the terms of any separate license agreement you may have executed with Licensor regarding such Contributions. + +6. Trademarks. This License does not grant permission to use the trade names, trademarks, service marks, or product names of the Licensor, except as required for reasonable and customary use in describing the origin of the Work and reproducing the content of the NOTICE file. + +7. Disclaimer of Warranty. Unless required by applicable law or agreed to in writing, Licensor provides the Work (and each Contributor provides its Contributions) on an "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied, including, without limitation, any warranties or conditions of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A PARTICULAR PURPOSE. You are solely responsible for determining the appropriateness of using or redistributing the Work and assume any risks associated with Your exercise of permissions under this License. + +8. Limitation of Liability. In no event and under no legal theory, whether in tort (including negligence), contract, or otherwise, unless required by applicable law (such as deliberate and grossly negligent acts) or agreed to in writing, shall any Contributor be liable to You for damages, including any direct, indirect, special, incidental, or consequential damages of any character arising as a result of this License or out of the use or inability to use the Work (including but not limited to damages for loss of goodwill, work stoppage, computer failure or malfunction, or any and all other commercial damages or losses), even if such Contributor has been advised of the possibility of such damages. + +9. Accepting Warranty or Additional Liability. While redistributing the Work or Derivative Works thereof, You may choose to offer, and charge a fee for, acceptance of support, warranty, indemnity, or other liability obligations and/or rights consistent with this License. However, in accepting such obligations, You may act only on Your own behalf and on Your sole responsibility, not on behalf of any other Contributor, and only if You agree to indemnify, defend, and hold each Contributor harmless for any liability incurred by, or claims asserted against, such Contributor by reason of your accepting any such warranty or additional liability. + +See FAQ for answers to frequently asked questions about this license. + diff --git a/stage0/Makefile b/stage0/Makefile deleted file mode 120000 index b0cd2af01e9..00000000000 --- a/stage0/Makefile +++ /dev/null @@ -1 +0,0 @@ -../mk/stage0.mk \ No newline at end of file diff --git a/stage0/Makefile b/stage0/Makefile new file mode 100644 index 00000000000..3e14f3554b5 --- /dev/null +++ b/stage0/Makefile @@ -0,0 +1,123 @@ +# This makefile is for OCaml source distributions. +# +# Also note: this Makefile should run in Windows too. Some of the $(call +# cygpath, ..) below are in support of this. Example windows error: +# +# ... +# dune install --root=dune --prefix=/cygdrive/d/a/FStar/FStar/fstar/out +# env \ +# SRC=ulib/ \ +# FSTAR_EXE=out/bin/fstar.exe \ +# CACHE_DIR=ulib.checked \ +# TAG=lib \ +# CODEGEN=none \ +# OUTPUT_DIR=none \ +# make -f mk/lib.mk verify +# mk/lib.mk:3: *** FSTAR_EXE ("out/bin/fstar.exe") does not exist (cwd = /cygdrive/d/a/FStar/FStar/fstar). Stop. +# ... +# +# I think this is probably a dune bug. + +include mk/common.mk + +FSTAR_DUNE_OPTIONS += --no-print-directory +FSTAR_DUNE_OPTIONS += --display=quiet + +FSTAR_DUNE_BUILD_OPTIONS := $(FSTAR_DUNE_OPTIONS) +.DEFAULT_GOAL:= all + +.PHONY: .force +.force: + +# In some places, we need to compute absolute paths, and in a Cygwin +# enviroment we need Windows-style paths (forward slashes ok, but no +# /cygdrive/). +ifeq ($(OS),Windows_NT) +cygpath=$(shell cygpath -m "$(abspath $(1))") +else +cygpath=$(abspath "$(1)") +endif + +build: + $(call msg, "DUNE BUILD") + dune build --root=dune $(FSTAR_DUNE_BUILD_OPTIONS) + +install_bin: build + $(call msg, "DUNE INSTALL") + dune install --root=dune --prefix=$(call cygpath,out) + +check_lib: install_bin + $(call msg, "CHECK LIB") + env \ + SRC=ulib/ \ + FSTAR_EXE=$(call cygpath,out/bin/fstar.exe) \ + CACHE_DIR=ulib.checked \ + TAG=lib \ + CODEGEN=none \ + OUTPUT_DIR=none \ + FSTAR_ROOT=$(CURDIR) \ + $(MAKE) -f mk/lib.mk verify + +install_lib: check_lib + $(call msg, "INSTALL LIB") + @# Install library and its checked files + cp -T -H -p -r ulib out/lib/fstar/ulib + cp -T -H -p -r ulib.checked out/lib/fstar/ulib.checked + echo 'ulib' > out/lib/fstar/fstar.include + echo 'ulib.checked' >> out/lib/fstar/fstar.include + +check_fstarc: install_bin + $(call msg, "CHECK FSTARC") + env \ + SRC=src/ \ + FSTAR_EXE=$(call cygpath,out/bin/fstar.exe) \ + CACHE_DIR=fstarc.checked/ \ + CODEGEN=none \ + OUTPUT_DIR=none \ + TAG=fstarc \ + FSTAR_LIB=$(call cygpath,ulib) \ + FSTAR_ROOT=$(CURDIR) \ + $(MAKE) -f mk/fstar-12.mk verify + $(call msg, "DONE CHECK FSTARC") + +install_fstarc: check_fstarc + $(call msg, "INSTALL FSTARC") + @# Install checked files for FStarC + mkdir -p out/lib/fstar/fstarc/ + cp -T -H -p -r src out/lib/fstar/fstarc/src + cp -T -H -p -r fstarc.checked out/lib/fstar/fstarc/src.checked + echo 'src' > out/lib/fstar/fstarc/fstar.include + echo 'src.checked' >> out/lib/fstar/fstarc/fstar.include + +trim: .force + $(call msg, "DUNE CLEAN") + dune clean $(FSTAR_DUNE_OPTIONS) --root=dune + +clean: trim + rm -rf $(CURDIR)/out + rm -rf ulib.checked + rm -rf fstarc.checked + +all: install_lib install_fstarc + +install_fstarc: install_lib +# ^ The windows build in Github actions seems to sporadically +# hang for over an hour, but sometimes works fine. I suspect +# some kind of stupid race, so sequentialize these two install +# phases. + +# Needed for 'opam install' +PREFIX ?= /usr/local +install: install_lib install_fstarc + mkdir -p $(PREFIX) + cp -r out/* $(PREFIX) + +package: + rm -rf pkgtmp + mkdir -p pkgtmp + $(MAKE) install PREFIX=pkgtmp/fstar + .scripts/bin-install.sh pkgtmp/fstar + .scripts/mk-package.sh pkgtmp fstar$(FSTAR_TAG) +## LINES BELOW ADDED BY src-install.sh +export FSTAR_COMMITDATE=2025-02-06 23:16:52 -0800 +export FSTAR_COMMIT=5ffe835bff12dceb5e18353d6cb7d98eb2cd2fc8 diff --git a/stage0/README.md b/stage0/README.md new file mode 100644 index 00000000000..4f02a81869d --- /dev/null +++ b/stage0/README.md @@ -0,0 +1,94 @@ +F*: A Proof-oriented Programming Language +========================================= + +### F\* website + +More information on F\* can be found at www.fstar-lang.org + +### Installation + +See [INSTALL.md](https://github.com/FStarLang/FStar/blob/master/INSTALL.md) + +### Online book + +An online book _Proof-oriented Programming In F*_ is in the works and regular updates are +posted online. The book is available as a [PDF], or you can read it while trying out +examples and exercises in your browser interface from this [tutorial page]. + +[tutorial page]: https://www.fstar-lang.org/tutorial/ +[PDF]: http://fstar-lang.org/tutorial/proof-oriented-programming-in-fstar.pdf + +### Wiki + +The [F\* wiki] contains additional technical documentation on F\*, and is especially useful +for topics that are not yet covered by the book. + +[F\* wiki]: https://github.com/FStarLang/FStar/wiki + +### Editing F* code + +You can edit F\* code using various text editor. Emacs has the best support currently, +providing syntax highlighting, code completion and navigation, and interactive development, +using [fstar-mode.el]. However, other editors also have limited support. +More details on [editor support] are available on the [F\* wiki]. + +[editor support]: https://github.com/FStarLang/FStar/wiki/Editor-support-for-F* +[fstar-mode.el]: https://github.com/FStarLang/fstar-mode.el + +### Extracting and executing F* code + +By default F* only verifies the input code, it does not compile or execute it. +To execute F* code one needs to translate it for instance to OCaml or F\#, +using F\*'s code extraction facility---this is invoked using the +command line argument `--codegen OCaml` or `--codegen FSharp`. +More details on [executing F\* code via OCaml] on the [F\* wiki]. + +[executing F\* code via OCaml]: https://github.com/FStarLang/FStar/wiki/Executing-F*-code + +Also, code written in a C-like shallowly embedded DSL can be extracted to +[C](https://arxiv.org/abs/1703.00053) +or [WASM](https://doi.ieeecomputersociety.org/10.1109/SP.2019.00064) +by the [KaRaMeL tool](https://github.com/FStarLang/karamel), +and code written in an ASM-like deeply embedded DSL can be extracted +to ASM by the [Vale tool](https://github.com/project-everest/vale). + +### Chatting about F* on Slack and Zulip + +The F* developers and many users interact on this [Slack +forum](https://everestexpedition.slack.com)---you should be able to +join automatically by [clicking +here](https://aka.ms/JoinEverestSlack), +but if that doesn't work, please contact the mailing list mentioned +below. + +Users can also chat about F* or ask questions at this [Zulip +forum](https://fstar.zulipchat.com). + +### Mailing list + +We also have a [mailing list] which we use mainly for announcements. + +[mailing list]: https://groups.google.com/g/fstar-mailing-list + +### Reporting issues + +Please report issues using the [F\* issue tracker] on GitHub. +Before filing please search to make sure the issue doesn't already exist. +We don't maintain old releases, so if possible please use the +[online F\* editor] or directly [the GitHub sources] to check +that your problem still exists on the `master` branch. + +[F\* issue tracker]: https://github.com/FStarLang/FStar/issues +[online F\* editor]: https://www.fstar-lang.org/run.php +[the GitHub sources]: [https://github.com/FStarLang/FStar/blob/master/INSTALL.md#building-f-from-sources + +### Contributing + +See [CONTRIBUTING.md](https://github.com/FStarLang/FStar/blob/master/CONTRIBUTING.md) + +### License + +F* is released under the [Apache 2.0 license]; for more details +see [LICENSE](https://github.com/FStarLang/FStar/blob/master/LICENSE) + +[Apache 2.0 license]: https://www.apache.org/licenses/LICENSE-2.0 diff --git a/stage0/default.nix b/stage0/default.nix deleted file mode 100644 index ab09c88b203..00000000000 --- a/stage0/default.nix +++ /dev/null @@ -1,56 +0,0 @@ -{ batteries, buildDunePackage, includeBinaryAnnotations ? false -, installShellFiles, lib, makeWrapper, menhir, menhirLib, memtrace, mtime, ocaml -, pprint, ppxlib, ppx_deriving, ppx_deriving_yojson, process, removeReferencesTo -, sedlex, stdint, version, yojson, zarith }: - -buildDunePackage { - pname = "fstar"; - inherit version; - - duneVersion = "3"; - - src = lib.sourceByRegex ../. [ "ocaml.*" "version.txt" ]; - - prePatch = '' - cd ocaml - patchShebangs fstar-lib/make_fstar_version.sh - ''; - - nativeBuildInputs = - [ installShellFiles makeWrapper removeReferencesTo menhir ]; - - buildInputs = [ - batteries - menhirLib - pprint - ppx_deriving - ppx_deriving_yojson - ppxlib - process - sedlex - stdint - yojson - zarith - memtrace - mtime - ]; - - enableParallelBuilding = true; - - postFixup = '' - # OCaml leaves its full store path in produced binaries - # Thus we remove every reference to the path of OCaml - for binary in $out/bin/* - do - remove-references-to -t '${ocaml}' $binary - done - '' + (if includeBinaryAnnotations then - "" - else '' - # Binary annotations are useful only for nice IDE integration while developping OCaml programs that depend on the F* library - # Meanwhile, they add a dependency to the OCaml compiler and are thus removed by default - rm -f $out/lib/ocaml/${ocaml.version}/site-lib/fstar/lib/*.cmt - ''); - - FSTAR_COMMIT = version; -} diff --git a/stage0/dune b/stage0/dune deleted file mode 100644 index 46fe85e40b3..00000000000 --- a/stage0/dune +++ /dev/null @@ -1,3 +0,0 @@ -(env - (_ - (flags (:standard -w -A)))) diff --git a/stage0/dune-project b/stage0/dune-project deleted file mode 100644 index 8cccbd9aacd..00000000000 --- a/stage0/dune-project +++ /dev/null @@ -1,15 +0,0 @@ -(lang dune 3.2) -; ^ Before changing this, consider that we need a version -; that we can use to build Linux, Windows, and MacOS packages. -; In particular our current Windows runner is limited to Dune 3.5. -; Changes here may pass normal CI, but later fail when trying to do -; a release, so *make sure* to test it manually. - -(name fstar) -(generate_opam_files false) -(using menhir 2.1) - -(package - (name fstar) - (synopsis "The F* programming language and proof assistant") -) diff --git a/stage0/dune/dune b/stage0/dune/dune new file mode 100644 index 00000000000..190d1fc7081 --- /dev/null +++ b/stage0/dune/dune @@ -0,0 +1,5 @@ +(env + (_ + (bin_annot false) + (flags (:standard -w -A))) +) diff --git a/stage0/dune/dune-project b/stage0/dune/dune-project new file mode 100644 index 00000000000..93297f1ccae --- /dev/null +++ b/stage0/dune/dune-project @@ -0,0 +1,9 @@ +(lang dune 3.8) +(name fstar) +(generate_opam_files false) +(using menhir 2.1) + +(package + (name fstar) + (synopsis "The F* programming language and proof assistant") +) diff --git a/stage0/fstar-lib/FStarC_Parser_Parse.mly b/stage0/dune/fstar-guts/FStarC_Parser_Parse.mly similarity index 99% rename from stage0/fstar-lib/FStarC_Parser_Parse.mly rename to stage0/dune/fstar-guts/FStarC_Parser_Parse.mly index ccf4d38af78..46ef5124ff0 100644 --- a/stage0/fstar-lib/FStarC_Parser_Parse.mly +++ b/stage0/dune/fstar-guts/FStarC_Parser_Parse.mly @@ -21,9 +21,9 @@ open Prims open FStar_Pervasives open FStarC_Errors -open FStarC_Compiler_List -open FStarC_Compiler_Util -open FStarC_Compiler_Range +open FStarC_List +open FStarC_Util +open FStarC_Range (* TODO : these files should be deprecated and removed *) open FStarC_Parser_Const diff --git a/stage0/dune/fstar-guts/app/FStar_All.ml b/stage0/dune/fstar-guts/app/FStar_All.ml new file mode 100644 index 00000000000..c9a376ee3ac --- /dev/null +++ b/stage0/dune/fstar-guts/app/FStar_All.ml @@ -0,0 +1,3 @@ +exception Failure = Failure +let failwith x = raise (Failure x) +let exit i = exit (Z.to_int i) diff --git a/stage0/fstar-lib/FStar_Bytes.ml b/stage0/dune/fstar-guts/app/FStar_Bytes.ml similarity index 100% rename from stage0/fstar-lib/FStar_Bytes.ml rename to stage0/dune/fstar-guts/app/FStar_Bytes.ml diff --git a/stage0/fstar-lib/FStar_Char.ml b/stage0/dune/fstar-guts/app/FStar_Char.ml similarity index 100% rename from stage0/fstar-lib/FStar_Char.ml rename to stage0/dune/fstar-guts/app/FStar_Char.ml diff --git a/stage0/fstar-lib/FStar_CommonST.ml b/stage0/dune/fstar-guts/app/FStar_CommonST.ml similarity index 100% rename from stage0/fstar-lib/FStar_CommonST.ml rename to stage0/dune/fstar-guts/app/FStar_CommonST.ml diff --git a/stage0/fstar-lib/FStar_Exn.ml b/stage0/dune/fstar-guts/app/FStar_Exn.ml similarity index 100% rename from stage0/fstar-lib/FStar_Exn.ml rename to stage0/dune/fstar-guts/app/FStar_Exn.ml diff --git a/stage0/fstar-lib/FStar_Float.ml b/stage0/dune/fstar-guts/app/FStar_Float.ml similarity index 100% rename from stage0/fstar-lib/FStar_Float.ml rename to stage0/dune/fstar-guts/app/FStar_Float.ml diff --git a/stage0/fstar-lib/FStar_Heap.ml b/stage0/dune/fstar-guts/app/FStar_Heap.ml similarity index 100% rename from stage0/fstar-lib/FStar_Heap.ml rename to stage0/dune/fstar-guts/app/FStar_Heap.ml diff --git a/stage0/fstar-lib/FStar_IO.ml b/stage0/dune/fstar-guts/app/FStar_IO.ml similarity index 100% rename from stage0/fstar-lib/FStar_IO.ml rename to stage0/dune/fstar-guts/app/FStar_IO.ml diff --git a/stage0/fstar-lib/FStar_ImmutableArray.ml b/stage0/dune/fstar-guts/app/FStar_ImmutableArray.ml similarity index 100% rename from stage0/fstar-lib/FStar_ImmutableArray.ml rename to stage0/dune/fstar-guts/app/FStar_ImmutableArray.ml diff --git a/stage0/fstar-lib/FStar_ImmutableArray_Base.ml b/stage0/dune/fstar-guts/app/FStar_ImmutableArray_Base.ml similarity index 100% rename from stage0/fstar-lib/FStar_ImmutableArray_Base.ml rename to stage0/dune/fstar-guts/app/FStar_ImmutableArray_Base.ml diff --git a/stage0/fstar-lib/FStar_List.ml b/stage0/dune/fstar-guts/app/FStar_List.ml similarity index 100% rename from stage0/fstar-lib/FStar_List.ml rename to stage0/dune/fstar-guts/app/FStar_List.ml diff --git a/stage0/fstar-lib/FStar_List_Tot_Base.ml b/stage0/dune/fstar-guts/app/FStar_List_Tot_Base.ml similarity index 100% rename from stage0/fstar-lib/FStar_List_Tot_Base.ml rename to stage0/dune/fstar-guts/app/FStar_List_Tot_Base.ml diff --git a/stage0/fstar-lib/FStar_Monotonic_Heap.ml b/stage0/dune/fstar-guts/app/FStar_Monotonic_Heap.ml similarity index 100% rename from stage0/fstar-lib/FStar_Monotonic_Heap.ml rename to stage0/dune/fstar-guts/app/FStar_Monotonic_Heap.ml diff --git a/stage0/fstar-lib/FStar_Option.ml b/stage0/dune/fstar-guts/app/FStar_Option.ml similarity index 100% rename from stage0/fstar-lib/FStar_Option.ml rename to stage0/dune/fstar-guts/app/FStar_Option.ml diff --git a/stage0/fstar-lib/FStar_Pervasives_Native.ml b/stage0/dune/fstar-guts/app/FStar_Pervasives_Native.ml similarity index 100% rename from stage0/fstar-lib/FStar_Pervasives_Native.ml rename to stage0/dune/fstar-guts/app/FStar_Pervasives_Native.ml diff --git a/stage0/fstar-lib/FStar_Pprint.ml b/stage0/dune/fstar-guts/app/FStar_Pprint.ml similarity index 100% rename from stage0/fstar-lib/FStar_Pprint.ml rename to stage0/dune/fstar-guts/app/FStar_Pprint.ml diff --git a/stage0/fstar-lib/FStar_ST.ml b/stage0/dune/fstar-guts/app/FStar_ST.ml similarity index 100% rename from stage0/fstar-lib/FStar_ST.ml rename to stage0/dune/fstar-guts/app/FStar_ST.ml diff --git a/stage0/fstar-lib/FStar_String.ml b/stage0/dune/fstar-guts/app/FStar_String.ml similarity index 100% rename from stage0/fstar-lib/FStar_String.ml rename to stage0/dune/fstar-guts/app/FStar_String.ml diff --git a/stage0/fstar-lib/FStar_UInt8.ml b/stage0/dune/fstar-guts/app/FStar_UInt8.ml similarity index 97% rename from stage0/fstar-lib/FStar_UInt8.ml rename to stage0/dune/fstar-guts/app/FStar_UInt8.ml index c0f303c59a5..2148ee255f1 100644 --- a/stage0/fstar-lib/FStar_UInt8.ml +++ b/stage0/dune/fstar-guts/app/FStar_UInt8.ml @@ -1,3 +1,6 @@ +(* GM: This file is manual due to the derivings, + and that sucks. *) + type uint8 = int[@@deriving yojson,show] type byte = uint8[@@deriving yojson,show] type t = uint8[@@deriving yojson,show] diff --git a/stage0/fstar-lib/prims.ml b/stage0/dune/fstar-guts/app/Prims.ml similarity index 100% rename from stage0/fstar-lib/prims.ml rename to stage0/dune/fstar-guts/app/Prims.ml diff --git a/stage0/ulib/ml/FStar_Ints.ml.body b/stage0/dune/fstar-guts/app/ints/FStar_Ints.ml.body similarity index 99% rename from stage0/ulib/ml/FStar_Ints.ml.body rename to stage0/dune/fstar-guts/app/ints/FStar_Ints.ml.body index c4bece092bf..de9b5d23188 100644 --- a/stage0/ulib/ml/FStar_Ints.ml.body +++ b/stage0/dune/fstar-guts/app/ints/FStar_Ints.ml.body @@ -3,6 +3,8 @@ * integers, as they all pretty much share their definitions and are * based on Stdint. *) +type t = M.t + let v (x:t) : Prims.int = Prims.parse_int (M.to_string x) let zero = M.zero diff --git a/stage0/dune/fstar-guts/app/ints/dune b/stage0/dune/fstar-guts/app/ints/dune new file mode 100644 index 00000000000..2f7e19e83a6 --- /dev/null +++ b/stage0/dune/fstar-guts/app/ints/dune @@ -0,0 +1,46 @@ +; NOTE: We explcitly write 'bash ./mk_int_file.sh' instead of just +; calling the script so this works in native Windows. This is needed to +; even build a source package in Windows, since we ship exactly this +; dune file and script. We should consider just shipping the generated +; ML files, if there's a convenient way to do so. + +; This one is special and hand-written... sigh +; (rule +; (target FStar_UInt8.ml) +; (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) +; (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 8)))) + +(rule + (target FStar_UInt16.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 16)))) + +(rule + (target FStar_UInt32.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 32)))) + +(rule + (target FStar_UInt64.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 64)))) + +(rule + (target FStar_Int8.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 8)))) + +(rule + (target FStar_Int16.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 16)))) + +(rule + (target FStar_Int32.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 32)))) + +(rule + (target FStar_Int64.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 64)))) diff --git a/stage0/dune/fstar-guts/app/ints/mk_int_file.sh b/stage0/dune/fstar-guts/app/ints/mk_int_file.sh new file mode 100755 index 00000000000..6d4f6d64c32 --- /dev/null +++ b/stage0/dune/fstar-guts/app/ints/mk_int_file.sh @@ -0,0 +1,34 @@ +#!/usr/bin/env bash + +# This script must run on Windows/Cygwin too. + +set -eu + +SIGN=$1 +WIDTH=$2 + +if [ "$SIGN" == "U" ]; then + cat << EOF + module M = Stdint.Uint${WIDTH} + type uint${WIDTH} = M.t + let n = Prims.of_int ${WIDTH} + + let uint_to_t x = M.of_string (Z.to_string x) + let __uint_to_t = uint_to_t +EOF +elif [ "$SIGN" == "S" ]; then + cat << EOF + module M = Stdint.Int${WIDTH} + type int${WIDTH} = M.t + let n = Prims.of_int ${WIDTH} + + let int_to_t x = M.of_string (Z.to_string x) + let __int_to_t = int_to_t +EOF +else + echo "Bad usage" &>2 + exit 1 +fi + +cat ./FStar_Ints.ml.body +exit 0 diff --git a/stage0/fstar-lib/dune b/stage0/dune/fstar-guts/dune similarity index 59% rename from stage0/fstar-lib/dune rename to stage0/dune/fstar-guts/dune index e819359e059..a2c4f8f81cf 100644 --- a/stage0/fstar-lib/dune +++ b/stage0/dune/fstar-guts/dune @@ -1,7 +1,7 @@ (include_subdirs unqualified) (library - (name fstar_lib) - (public_name fstar.lib) + (name fstarcompiler) + (public_name fstar.compiler) (libraries batteries zarith @@ -15,13 +15,7 @@ sedlex mtime.clock.os ) - (modes native byte) - ; ^ Note: we need to compile fstar-lib in bytecode since some - ; clients use it (e.g. MLS* when being compiled into javascript - ; via js_of_ocaml, in general anything that wants to use js_of_ocaml). - ; We should consider a toggle to selectively enable it, as most users - ; do not need it. - (wrapped false) + (modes native) (preprocess (pps ppx_deriving.show ppx_deriving_yojson sedlex.ppx)) ) diff --git a/stage0/fstar-lib/generated/FStarC_Basefiles.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Basefiles.ml similarity index 82% rename from stage0/fstar-lib/generated/FStarC_Basefiles.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Basefiles.ml index 489f17db22d..44a7f11773e 100644 --- a/stage0/fstar-lib/generated/FStarC_Basefiles.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Basefiles.ml @@ -8,7 +8,7 @@ let (must_find : Prims.string -> Prims.string) = let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unable to find required file \"%s\" in the module search path." fn in FStarC_Errors_Msg.text uu___3 in @@ -23,13 +23,12 @@ let (prims : unit -> Prims.string) = | FStar_Pervasives_Native.Some fn -> fn | FStar_Pervasives_Native.None -> must_find "Prims.fst" let (prims_basename : unit -> Prims.string) = - fun uu___ -> let uu___1 = prims () in FStarC_Compiler_Util.basename uu___1 + fun uu___ -> let uu___1 = prims () in FStarC_Util.basename uu___1 let (pervasives : unit -> Prims.string) = fun uu___ -> must_find "FStar.Pervasives.fsti" let (pervasives_basename : unit -> Prims.string) = - fun uu___ -> - let uu___1 = pervasives () in FStarC_Compiler_Util.basename uu___1 + fun uu___ -> let uu___1 = pervasives () in FStarC_Util.basename uu___1 let (pervasives_native_basename : unit -> Prims.string) = fun uu___ -> let uu___1 = must_find "FStar.Pervasives.Native.fst" in - FStarC_Compiler_Util.basename uu___1 \ No newline at end of file + FStarC_Util.basename uu___1 \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_CList.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_CList.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Compiler_CList.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_CList.ml diff --git a/stage0/fstar-lib/generated/FStarC_CheckedFiles.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_CheckedFiles.ml similarity index 80% rename from stage0/fstar-lib/generated/FStarC_CheckedFiles.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_CheckedFiles.ml index 1f4e3c4bf35..402a491c71d 100644 --- a/stage0/fstar-lib/generated/FStarC_CheckedFiles.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_CheckedFiles.ml @@ -1,6 +1,6 @@ open Prims -let (dbg : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "CheckedFiles" +let (dbg : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "CheckedFiles" let (cache_version_number : Prims.int) = (Prims.of_int (72)) type tc_result = { @@ -101,8 +101,8 @@ let (uu___0 : tc_result_t FStarC_Class_Show.showable) = type cache_t = (tc_result_t * (Prims.string, FStarC_Parser_Dep.parsing_data) FStar_Pervasives.either) -let (mcache : cache_t FStarC_Compiler_Util.smap) = - FStarC_Compiler_Util.smap_create (Prims.of_int (50)) +let (mcache : cache_t FStarC_Util.smap) = + FStarC_Util.smap_create (Prims.of_int (50)) let (hash_dependences : FStarC_Parser_Dep.deps -> Prims.string -> @@ -117,10 +117,10 @@ let (hash_dependences : | FStar_Pervasives_Native.Some fn2 -> fn2 | uu___1 -> fn in let module_name = FStarC_Parser_Dep.lowercase_module_name fn1 in - let source_hash = FStarC_Compiler_Util.digest_of_file fn1 in + let source_hash = FStarC_Util.digest_of_file fn1 in let has_interface = let uu___ = FStarC_Parser_Dep.interface_of deps module_name in - FStarC_Compiler_Option.isSome uu___ in + FStarC_Option.isSome uu___ in let interface_checked_file_name = let uu___ = (FStarC_Parser_Dep.is_implementation fn1) && has_interface in @@ -129,13 +129,13 @@ let (hash_dependences : let uu___1 = let uu___2 = let uu___3 = FStarC_Parser_Dep.interface_of deps module_name in - FStarC_Compiler_Util.must uu___3 in + FStarC_Util.must uu___3 in FStarC_Parser_Dep.cache_file_name uu___2 in FStar_Pervasives_Native.Some uu___1 else FStar_Pervasives_Native.None in let binary_deps = let uu___ = FStarC_Parser_Dep.deps_of deps fn1 in - FStarC_Compiler_List.filter + FStarC_List.filter (fun fn2 -> let uu___1 = (FStarC_Parser_Dep.is_interface fn2) && @@ -143,28 +143,26 @@ let (hash_dependences : uu___2 = module_name) in Prims.op_Negation uu___1) uu___ in let binary_deps1 = - FStarC_Compiler_List.sortWith + FStarC_List.sortWith (fun fn11 -> fun fn2 -> let uu___ = FStarC_Parser_Dep.lowercase_module_name fn11 in let uu___1 = FStarC_Parser_Dep.lowercase_module_name fn2 in - FStarC_Compiler_String.compare uu___ uu___1) binary_deps in + FStarC_String.compare uu___ uu___1) binary_deps in let maybe_add_iface_hash out = match interface_checked_file_name with | FStar_Pervasives_Native.None -> FStar_Pervasives.Inr (("source", source_hash) :: out) | FStar_Pervasives_Native.Some iface -> - let uu___ = FStarC_Compiler_Util.smap_try_find mcache iface in + let uu___ = FStarC_Util.smap_try_find mcache iface in (match uu___ with | FStar_Pervasives_Native.None -> let msg = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "hash_dependences::the interface checked file %s does not exist\n" iface in - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg in - if uu___2 - then FStarC_Compiler_Util.print1 "%s\n" msg - else ()); + ((let uu___2 = FStarC_Effect.op_Bang dbg in + if uu___2 then FStarC_Util.print1 "%s\n" msg else ()); FStar_Pervasives.Inl msg) | FStar_Pervasives_Native.Some (Invalid msg, uu___1) -> FStar_Pervasives.Inl msg @@ -173,7 +171,7 @@ let (hash_dependences : ("interface", h) :: out) | FStar_Pervasives_Native.Some (Unknown, uu___1) -> let uu___2 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: unknown entry in the mcache for interface %s\n" iface in failwith uu___2) in @@ -183,17 +181,15 @@ let (hash_dependences : | fn2::deps1 -> let cache_fn = FStarC_Parser_Dep.cache_file_name fn2 in let digest = - let uu___1 = FStarC_Compiler_Util.smap_try_find mcache cache_fn in + let uu___1 = FStarC_Util.smap_try_find mcache cache_fn in match uu___1 with | FStar_Pervasives_Native.None -> let msg = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "For dependency %s, cache file %s is not loaded" fn2 cache_fn in - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg in - if uu___3 - then FStarC_Compiler_Util.print1 "%s\n" msg - else ()); + ((let uu___3 = FStarC_Effect.op_Bang dbg in + if uu___3 then FStarC_Util.print1 "%s\n" msg else ()); FStar_Pervasives.Inl msg) | FStar_Pervasives_Native.Some (Invalid msg, uu___2) -> FStar_Pervasives.Inl msg @@ -201,7 +197,7 @@ let (hash_dependences : FStar_Pervasives.Inr dig | FStar_Pervasives_Native.Some (Unknown, uu___2) -> let uu___3 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: unknown entry in the cache for dependence %s of module %s" fn2 module_name in failwith uu___3 in @@ -218,53 +214,57 @@ let (hash_dependences : let (load_checked_file : Prims.string -> Prims.string -> cache_t) = fun fn -> fun checked_fn -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___1 = FStarC_Effect.op_Bang dbg in if uu___1 then - FStarC_Compiler_Util.print1 - "Trying to load checked file result %s\n" checked_fn + FStarC_Util.print1 "Trying to load checked file result %s\n" + checked_fn else ()); - (let elt = FStarC_Compiler_Util.smap_try_find mcache checked_fn in - if FStarC_Compiler_Util.is_some elt - then FStarC_Compiler_Util.must elt + (let elt = FStarC_Util.smap_try_find mcache checked_fn in + if FStarC_Util.is_some elt + then + ((let uu___2 = FStarC_Effect.op_Bang dbg in + if uu___2 + then + FStarC_Util.print1 "Already loaded checked file %s\n" checked_fn + else ()); + FStarC_Util.must elt) else (let add_and_return elt1 = - FStarC_Compiler_Util.smap_add mcache checked_fn elt1; elt1 in - if Prims.op_Negation (FStarC_Compiler_Util.file_exists checked_fn) + FStarC_Util.smap_add mcache checked_fn elt1; elt1 in + if Prims.op_Negation (FStarC_Util.file_exists checked_fn) then let msg = - FStarC_Compiler_Util.format1 "checked file %s does not exist" - checked_fn in + FStarC_Util.format1 "checked file %s does not exist" checked_fn in add_and_return ((Invalid msg), (FStar_Pervasives.Inl msg)) else - (let entry = FStarC_Compiler_Util.load_value_from_file checked_fn in + (let entry = FStarC_Util.load_value_from_file checked_fn in match entry with | FStar_Pervasives_Native.None -> let msg = - FStarC_Compiler_Util.format1 "checked file %s is corrupt" + FStarC_Util.format1 "checked file %s is corrupt" checked_fn in add_and_return ((Invalid msg), (FStar_Pervasives.Inl msg)) | FStar_Pervasives_Native.Some x -> if x.version <> cache_version_number then let msg = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "checked file %s has incorrect version" checked_fn in add_and_return ((Invalid msg), (FStar_Pervasives.Inl msg)) else - (let current_digest = - FStarC_Compiler_Util.digest_of_file fn in + (let current_digest = FStarC_Util.digest_of_file fn in if x.digest <> current_digest then - ((let uu___5 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___5 = FStarC_Effect.op_Bang dbg in if uu___5 then - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Checked file %s is stale since incorrect digest of %s, expected: %s, found: %s\n" checked_fn fn current_digest x.digest else ()); (let msg = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "checked file %s is stale (digest mismatch for %s)" checked_fn fn in add_and_return @@ -278,7 +278,7 @@ let (load_tc_result : FStar_Pervasives_Native.option) = fun checked_fn -> - let entry = FStarC_Compiler_Util.load_2values_from_file checked_fn in + let entry = FStarC_Util.load_2values_from_file checked_fn in match entry with | FStar_Pervasives_Native.Some (uu___, s2) -> FStar_Pervasives_Native.Some ((s2.deps_dig), (s2.tc_res)) @@ -291,10 +291,10 @@ let (load_checked_file_with_tc_result : fun deps -> fun fn -> fun checked_fn -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___1 = FStarC_Effect.op_Bang dbg in if uu___1 then - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Trying to load checked file with tc result %s\n" checked_fn else ()); (let load_tc_result' fn1 = @@ -317,7 +317,7 @@ let (load_checked_file_with_tc_result : (match uu___1 with | FStar_Pervasives.Inl msg -> let elt1 = ((Invalid msg), parsing_data) in - (FStarC_Compiler_Util.smap_add mcache checked_fn elt1; + (FStarC_Util.smap_add mcache checked_fn elt1; FStar_Pervasives.Inl msg) | FStar_Pervasives.Inr deps_dig' -> let uu___2 = load_tc_result' checked_fn in @@ -328,11 +328,10 @@ let (load_checked_file_with_tc_result : let elt1 = let uu___3 = let uu___4 = - FStarC_Compiler_Util.digest_of_file checked_fn in + FStarC_Util.digest_of_file checked_fn in Valid uu___4 in (uu___3, parsing_data) in - (FStarC_Compiler_Util.smap_add mcache checked_fn - elt1; + (FStarC_Util.smap_add mcache checked_fn elt1; (let validate_iface_cache uu___4 = let iface = let uu___5 = @@ -349,47 +348,46 @@ let (load_checked_file_with_tc_result : FStarC_Parser_Dep.cache_file_name iface1 in let uu___6 = - FStarC_Compiler_Util.smap_try_find - mcache iface_checked_fn in + FStarC_Util.smap_try_find mcache + iface_checked_fn in (match uu___6 with | FStar_Pervasives_Native.Some (Unknown, parsing_data1) -> let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Util.digest_of_file + FStarC_Util.digest_of_file iface_checked_fn in Valid uu___9 in (uu___8, parsing_data1) in - FStarC_Compiler_Util.smap_add - mcache iface_checked_fn - uu___7 + FStarC_Util.smap_add mcache + iface_checked_fn uu___7 | uu___7 -> ())) () with | uu___5 -> ()) in validate_iface_cache (); FStar_Pervasives.Inr tc_result1)) else - ((let uu___5 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___5 = FStarC_Effect.op_Bang dbg in if uu___5 then ((let uu___7 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length deps_dig') in + FStarC_Util.string_of_int + (FStarC_List.length deps_dig') in let uu___8 = FStarC_Parser_Dep.print_digest deps_dig' in let uu___9 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length deps_dig) in + FStarC_Util.string_of_int + (FStarC_List.length deps_dig) in let uu___10 = FStarC_Parser_Dep.print_digest deps_dig in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "FAILING to load.\nExpected (%s) hashes:\n%s\n\nGot (%s) hashes:\n\t%s\n" uu___7 uu___8 uu___9 uu___10); if - (FStarC_Compiler_List.length deps_dig) = - (FStarC_Compiler_List.length deps_dig') + (FStarC_List.length deps_dig) = + (FStarC_List.length deps_dig') then - FStarC_Compiler_List.iter2 + FStarC_List.iter2 (fun uu___7 -> fun uu___8 -> match (uu___7, uu___8) with @@ -402,20 +400,19 @@ let (load_checked_file_with_tc_result : let uu___10 = FStarC_Parser_Dep.print_digest [(x', y')] in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Differ at: Expected %s\n Got %s\n" uu___9 uu___10 else ()) deps_dig deps_dig' else ()) else ()); (let msg = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "checked file %s is stale (dependence hash mismatch, use --debug yes for more details)" checked_fn in let elt1 = ((Invalid msg), (FStar_Pervasives.Inl msg)) in - FStarC_Compiler_Util.smap_add mcache checked_fn - elt1; + FStarC_Util.smap_add mcache checked_fn elt1; FStar_Pervasives.Inl msg))))) let (load_parsing_data_from_cache : Prims.string -> @@ -446,7 +443,7 @@ let (load_module_from_cache : FStarC_TypeChecker_Env.env -> Prims.string -> tc_result FStar_Pervasives_Native.option) = - let already_failed = FStarC_Compiler_Util.mk_ref false in + let already_failed = FStarC_Util.mk_ref false in fun env -> fun fn -> FStarC_Errors.with_ctx @@ -457,22 +454,20 @@ let (load_module_from_cache : let fail msg cache_file1 = let suppress_warning = (FStarC_Options.should_check_file fn1) || - (FStarC_Compiler_Effect.op_Bang already_failed) in + (FStarC_Effect.op_Bang already_failed) in if Prims.op_Negation suppress_warning then - (FStarC_Compiler_Effect.op_Colon_Equals already_failed true; + (FStarC_Effect.op_Colon_Equals already_failed true; (let uu___3 = let uu___4 = - FStarC_Compiler_Range_Type.mk_pos Prims.int_zero - Prims.int_zero in + FStarC_Range_Type.mk_pos Prims.int_zero Prims.int_zero in let uu___5 = - FStarC_Compiler_Range_Type.mk_pos Prims.int_zero - Prims.int_zero in - FStarC_Compiler_Range_Type.mk_range fn1 uu___4 uu___5 in + FStarC_Range_Type.mk_pos Prims.int_zero Prims.int_zero in + FStarC_Range_Type.mk_range fn1 uu___4 uu___5 in let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Unable to load %s since %s; will recheck %s (suppressing this warning for further modules)" cache_file1 msg fn1 in FStarC_Errors_Msg.text uu___6 in @@ -490,10 +485,10 @@ let (load_module_from_cache : | FStar_Pervasives.Inl msg -> (fail msg cache_file; FStar_Pervasives_Native.None) | FStar_Pervasives.Inr tc_result1 -> - ((let uu___4 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___4 = FStarC_Effect.op_Bang dbg in if uu___4 then - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Successfully loaded module from checked file %s\n" cache_file else ()); @@ -507,10 +502,10 @@ let (load_module_from_cache : FStarC_Parser_Dep.interface_of uu___1 uu___2 in let uu___1 = (FStarC_Parser_Dep.is_implementation fn) && - (FStarC_Compiler_Util.is_some i_fn_opt) in + (FStarC_Util.is_some i_fn_opt) in if uu___1 then - let i_fn = FStarC_Compiler_Util.must i_fn_opt in + let i_fn = FStarC_Util.must i_fn_opt in let i_tc = load_with_profiling i_fn in match i_tc with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None @@ -526,8 +521,7 @@ let (store_values_to_cache : FStarC_Errors.with_ctx (Prims.strcat "While writing checked file " cache_file) (fun uu___ -> - FStarC_Compiler_Util.save_2values_to_file cache_file stage1 - stage2) + FStarC_Util.save_2values_to_file cache_file stage1 stage2) let (store_module_to_cache : FStarC_TypeChecker_Env.env -> Prims.string -> FStarC_Parser_Dep.parsing_data -> tc_result -> unit) @@ -557,7 +551,7 @@ let (store_module_to_cache : extraction_time = Prims.int_zero } in let stage1 = - let uu___1 = FStarC_Compiler_Util.digest_of_file fn in + let uu___1 = FStarC_Util.digest_of_file fn in { version = cache_version_number; digest = uu___1; @@ -568,17 +562,15 @@ let (store_module_to_cache : | FStar_Pervasives.Inl msg -> let uu___1 = let uu___2 = - FStarC_Compiler_Range_Type.mk_pos Prims.int_zero - Prims.int_zero in + FStarC_Range_Type.mk_pos Prims.int_zero Prims.int_zero in let uu___3 = - FStarC_Compiler_Range_Type.mk_pos Prims.int_zero - Prims.int_zero in - FStarC_Compiler_Range_Type.mk_range fn uu___2 uu___3 in + FStarC_Range_Type.mk_pos Prims.int_zero Prims.int_zero in + FStarC_Range_Type.mk_range fn uu___2 uu___3 in let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_Util.format1 - "Checked file %s was not written." cache_file in + FStarC_Util.format1 "Checked file %s was not written." + cache_file in FStarC_Errors_Msg.text uu___4 in let uu___4 = let uu___5 = @@ -599,12 +591,12 @@ let (unsafe_raw_load_checked_file : FStar_Pervasives_Native.option) = fun checked_fn -> - let entry = FStarC_Compiler_Util.load_2values_from_file checked_fn in + let entry = FStarC_Util.load_2values_from_file checked_fn in match entry with | FStar_Pervasives_Native.Some (s1, s2) -> let uu___ = let uu___1 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst s2.deps_dig in + FStarC_List.map FStar_Pervasives_Native.fst s2.deps_dig in ((s1.parsing_data), uu___1, (s2.tc_res)) in FStar_Pervasives_Native.Some uu___ | uu___ -> FStar_Pervasives_Native.None \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Class_Binders.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Binders.ml similarity index 68% rename from stage0/fstar-lib/generated/FStarC_Class_Binders.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Binders.ml index a12ce53f992..dc297b25fbb 100644 --- a/stage0/fstar-lib/generated/FStarC_Class_Binders.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Binders.ml @@ -1,31 +1,22 @@ open Prims type 'a hasNames = { - freeNames: 'a -> FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.flat_set } + freeNames: 'a -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.flat_set } let __proj__MkhasNames__item__freeNames : - 'a . - 'a hasNames -> - 'a -> FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.flat_set - = fun projectee -> match projectee with | { freeNames;_} -> freeNames + 'a . 'a hasNames -> 'a -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.flat_set = + fun projectee -> match projectee with | { freeNames;_} -> freeNames let freeNames : - 'a . - 'a hasNames -> - 'a -> FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.flat_set - = + 'a . 'a hasNames -> 'a -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.flat_set = fun projectee -> match projectee with | { freeNames = freeNames1;_} -> freeNames1 type 'a hasBinders = { - boundNames: 'a -> FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.flat_set } + boundNames: 'a -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.flat_set } let __proj__MkhasBinders__item__boundNames : - 'a . - 'a hasBinders -> - 'a -> FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.flat_set + 'a . 'a hasBinders -> 'a -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.flat_set = fun projectee -> match projectee with | { boundNames;_} -> boundNames let boundNames : - 'a . - 'a hasBinders -> - 'a -> FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.flat_set + 'a . 'a hasBinders -> 'a -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.flat_set = fun projectee -> match projectee with | { boundNames = boundNames1;_} -> boundNames1 @@ -43,25 +34,25 @@ let (hasNames_comp : FStarC_Syntax_Syntax.comp hasNames) = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) ()) in let uu___1 = let uu___2 = FStarC_Syntax_Free.names ct.FStarC_Syntax_Syntax.result_typ in let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (a, uu___5) -> FStarC_Syntax_Free.names a) ct.FStarC_Syntax_Syntax.effect_args in uu___2 :: uu___3 in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun uu___2 -> (Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)))) uu___3 uu___2) uu___ uu___1) } @@ -72,9 +63,9 @@ let (hasBinders_list_bv : FStarC_Syntax_Syntax.bv Prims.list hasBinders) = (Obj.magic (FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)))) uu___) } let (hasBinders_set_bv : - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.flat_set hasBinders) = + FStarC_Syntax_Syntax.bv FStarC_FlatSet.flat_set hasBinders) = { boundNames = (fun x -> x) } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Class_Deq.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Deq.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Class_Deq.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Deq.ml diff --git a/stage0/fstar-lib/generated/FStarC_Class_HasRange.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_HasRange.ml similarity index 50% rename from stage0/fstar-lib/generated/FStarC_Class_HasRange.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_HasRange.ml index ec548c455b6..95938abf12f 100644 --- a/stage0/fstar-lib/generated/FStarC_Class_HasRange.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_HasRange.ml @@ -1,19 +1,18 @@ open Prims type 'a hasRange = { - pos: 'a -> FStarC_Compiler_Range_Type.range ; - setPos: FStarC_Compiler_Range_Type.range -> 'a -> 'a } + pos: 'a -> FStarC_Range_Type.range ; + setPos: FStarC_Range_Type.range -> 'a -> 'a } let __proj__MkhasRange__item__pos : - 'a . 'a hasRange -> 'a -> FStarC_Compiler_Range_Type.range = + 'a . 'a hasRange -> 'a -> FStarC_Range_Type.range = fun projectee -> match projectee with | { pos; setPos;_} -> pos let __proj__MkhasRange__item__setPos : - 'a . 'a hasRange -> FStarC_Compiler_Range_Type.range -> 'a -> 'a = + 'a . 'a hasRange -> FStarC_Range_Type.range -> 'a -> 'a = fun projectee -> match projectee with | { pos; setPos;_} -> setPos -let pos : 'a . 'a hasRange -> 'a -> FStarC_Compiler_Range_Type.range = +let pos : 'a . 'a hasRange -> 'a -> FStarC_Range_Type.range = fun projectee -> match projectee with | { pos = pos1; setPos;_} -> pos1 -let setPos : 'a . 'a hasRange -> FStarC_Compiler_Range_Type.range -> 'a -> 'a - = +let setPos : 'a . 'a hasRange -> FStarC_Range_Type.range -> 'a -> 'a = fun projectee -> match projectee with | { pos = pos1; setPos = setPos1;_} -> setPos1 -let (hasRange_range : FStarC_Compiler_Range_Type.range hasRange) = +let (hasRange_range : FStarC_Range_Type.range hasRange) = { pos = (fun x -> x); setPos = (fun r -> fun uu___ -> r) } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Class_Hashable.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Hashable.ml similarity index 98% rename from stage0/fstar-lib/generated/FStarC_Class_Hashable.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Hashable.ml index a4ad9f9938e..47535d9c1c2 100644 --- a/stage0/fstar-lib/generated/FStarC_Class_Hashable.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Hashable.ml @@ -17,7 +17,7 @@ let (ord_hash_code : FStarC_Hash.hash_code FStarC_Class_Ord.ord) = (fun x -> fun y -> let uu___ = FStarC_Hash.cmp_hash x y in - FStarC_Compiler_Order.order_from_int uu___) + FStarC_Order.order_from_int uu___) } let (hashable_int : Prims.int hashable) = { hash = FStarC_Hash.of_int } let (hashable_string : Prims.string hashable) = @@ -36,7 +36,7 @@ let hashable_list : 'a . 'a hashable -> 'a Prims.list hashable = hash = (fun xs -> let uu___1 = FStarC_Hash.of_int Prims.int_zero in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun h -> fun x -> let uu___2 = hash uu___ x in FStarC_Hash.mix h uu___2) diff --git a/stage0/fstar-lib/generated/FStarC_Class_Listlike.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Listlike.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Class_Listlike.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Listlike.ml diff --git a/stage0/fstar-lib/generated/FStarC_Class_Monad.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Monad.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_Class_Monad.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Monad.ml index 5f8a9fd3d74..9ed11bc318f 100644 --- a/stage0/fstar-lib/generated/FStarC_Class_Monad.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Monad.ml @@ -29,8 +29,7 @@ let (monad_option : unit FStar_Pervasives_Native.option monad) = fun uu___2 -> fun uu___1 -> fun uu___ -> - (fun uu___1 -> - fun uu___ -> Obj.magic FStarC_Compiler_Util.bind_opt) + (fun uu___1 -> fun uu___ -> Obj.magic FStarC_Util.bind_opt) uu___3 uu___2 uu___1 uu___) } let (monad_list : unit Prims.list monad) = @@ -49,8 +48,8 @@ let (monad_list : unit Prims.list monad) = let x = Obj.magic x in fun f -> let f = Obj.magic f in - Obj.magic (FStarC_Compiler_List.concatMap f x)) - uu___3 uu___2 uu___1 uu___) + Obj.magic (FStarC_List.concatMap f x)) uu___3 uu___2 + uu___1 uu___) } let rec mapM : 'm . 'm monad -> unit -> unit -> (Obj.t -> 'm) -> Obj.t Prims.list -> 'm = diff --git a/stage0/fstar-lib/generated/FStarC_Class_Monoid.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Monoid.ml similarity index 85% rename from stage0/fstar-lib/generated/FStarC_Class_Monoid.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Monoid.ml index b8d8399695b..1784f297d36 100644 --- a/stage0/fstar-lib/generated/FStarC_Class_Monoid.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Monoid.ml @@ -15,13 +15,11 @@ let mplus : 'a . 'a monoid -> 'a -> 'a -> 'a = let op_Plus_Plus : 'a . 'a monoid -> 'a -> 'a -> 'a = fun uu___ -> mplus uu___ let msum : 'a . 'a monoid -> 'a Prims.list -> 'a = - fun uu___ -> - fun xs -> FStarC_Compiler_List.fold_left (mplus uu___) (mzero uu___) xs + fun uu___ -> fun xs -> FStarC_List.fold_left (mplus uu___) (mzero uu___) xs let (monoid_int : Prims.int monoid) = { mzero = Prims.int_zero; mplus = (fun x -> fun y -> x + y) } let (monoid_string : Prims.string monoid) = { mzero = ""; mplus = (fun x -> fun y -> Prims.strcat x y) } let monoid_list : 'a . unit -> 'a Prims.list monoid = fun uu___ -> - { mzero = []; mplus = (fun x -> fun y -> FStarC_Compiler_List.op_At x y) - } \ No newline at end of file + { mzero = []; mplus = (fun x -> fun y -> FStarC_List.op_At x y) } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Class_Ord.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Ord.ml similarity index 73% rename from stage0/fstar-lib/generated/FStarC_Class_Ord.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Ord.ml index a0ddf556624..a8a101d1d6f 100644 --- a/stage0/fstar-lib/generated/FStarC_Class_Ord.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Ord.ml @@ -2,37 +2,28 @@ open Prims type 'a ord = { super: 'a FStarC_Class_Deq.deq ; - cmp: 'a -> 'a -> FStarC_Compiler_Order.order } + cmp: 'a -> 'a -> FStarC_Order.order } let __proj__Mkord__item__super : 'a . 'a ord -> 'a FStarC_Class_Deq.deq = fun projectee -> match projectee with | { super; cmp;_} -> super -let __proj__Mkord__item__cmp : - 'a . 'a ord -> 'a -> 'a -> FStarC_Compiler_Order.order = - fun projectee -> match projectee with | { super; cmp;_} -> cmp +let __proj__Mkord__item__cmp : 'a . 'a ord -> 'a -> 'a -> FStarC_Order.order + = fun projectee -> match projectee with | { super; cmp;_} -> cmp let super : 'a . 'a ord -> 'a FStarC_Class_Deq.deq = fun projectee -> match projectee with | { super = super1; cmp;_} -> super1 -let cmp : 'a . 'a ord -> 'a -> 'a -> FStarC_Compiler_Order.order = +let cmp : 'a . 'a ord -> 'a -> 'a -> FStarC_Order.order = fun projectee -> match projectee with | { super = super1; cmp = cmp1;_} -> cmp1 let op_Less_Question : 'a . 'a ord -> 'a -> 'a -> Prims.bool = fun uu___ -> - fun x -> - fun y -> - let uu___1 = cmp uu___ x y in uu___1 = FStarC_Compiler_Order.Lt + fun x -> fun y -> let uu___1 = cmp uu___ x y in uu___1 = FStarC_Order.Lt let op_Less_Equals_Question : 'a . 'a ord -> 'a -> 'a -> Prims.bool = fun uu___ -> - fun x -> - fun y -> - let uu___1 = cmp uu___ x y in uu___1 <> FStarC_Compiler_Order.Gt + fun x -> fun y -> let uu___1 = cmp uu___ x y in uu___1 <> FStarC_Order.Gt let op_Greater_Question : 'a . 'a ord -> 'a -> 'a -> Prims.bool = fun uu___ -> - fun x -> - fun y -> - let uu___1 = cmp uu___ x y in uu___1 = FStarC_Compiler_Order.Gt + fun x -> fun y -> let uu___1 = cmp uu___ x y in uu___1 = FStarC_Order.Gt let op_Greater_Equals_Question : 'a . 'a ord -> 'a -> 'a -> Prims.bool = fun uu___ -> - fun x -> - fun y -> - let uu___1 = cmp uu___ x y in uu___1 <> FStarC_Compiler_Order.Lt + fun x -> fun y -> let uu___1 = cmp uu___ x y in uu___1 <> FStarC_Order.Lt let min : 'a . 'a ord -> 'a -> 'a -> 'a = fun uu___ -> fun x -> @@ -64,16 +55,16 @@ let dedup : 'a . 'a ord -> 'a Prims.list -> 'a Prims.list = fun uu___ -> fun xs -> let out = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun out1 -> fun x -> let uu___1 = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun y -> FStarC_Class_Deq.op_Equals_Question (ord_eq uu___) x y) out1 in if uu___1 then out1 else x :: out1) [] xs in - FStarC_Compiler_List.rev out + FStarC_List.rev out let rec sort_dedup : 'a . 'a ord -> 'a Prims.list -> 'a Prims.list = fun uu___ -> fun xs -> @@ -83,10 +74,9 @@ let rec sort_dedup : 'a . 'a ord -> 'a Prims.list -> 'a Prims.list = | y::ys -> let uu___1 = cmp uu___ x y in (match uu___1 with - | FStarC_Compiler_Order.Eq -> ys - | FStarC_Compiler_Order.Lt -> x :: y :: ys - | FStarC_Compiler_Order.Gt -> - let uu___2 = insert x ys in y :: uu___2) in + | FStarC_Order.Eq -> ys + | FStarC_Order.Lt -> x :: y :: ys + | FStarC_Order.Gt -> let uu___2 = insert x ys in y :: uu___2) in match xs with | [] -> [] | x::xs1 -> let uu___1 = sort_dedup uu___ xs1 in insert x uu___1 @@ -107,36 +97,28 @@ let ord_list_diff : | (x::xs3, y::ys3) -> let uu___2 = cmp uu___ x y in (match uu___2 with - | FStarC_Compiler_Order.Lt -> - go ((x :: xd), yd) xs3 (y :: ys3) - | FStarC_Compiler_Order.Eq -> go (xd, yd) xs3 ys3 - | FStarC_Compiler_Order.Gt -> - go (xd, (y :: yd)) (x :: xs3) ys3) + | FStarC_Order.Lt -> go ((x :: xd), yd) xs3 (y :: ys3) + | FStarC_Order.Eq -> go (xd, yd) xs3 ys3 + | FStarC_Order.Gt -> go (xd, (y :: yd)) (x :: xs3) ys3) | (xs3, ys3) -> - ((FStarC_Compiler_List.rev_append xd xs3), - (FStarC_Compiler_List.rev_append yd ys3))) in + ((FStarC_List.rev_append xd xs3), + (FStarC_List.rev_append yd ys3))) in go ([], []) xs1 ys1 let (ord_int : Prims.int ord) = - { super = FStarC_Class_Deq.deq_int; cmp = FStarC_Compiler_Order.compare_int - } + { super = FStarC_Class_Deq.deq_int; cmp = FStarC_Order.compare_int } let (ord_bool : Prims.bool ord) = - { - super = FStarC_Class_Deq.deq_bool; - cmp = FStarC_Compiler_Order.compare_bool - } + { super = FStarC_Class_Deq.deq_bool; cmp = FStarC_Order.compare_bool } let (ord_unit : unit ord) = { super = FStarC_Class_Deq.deq_unit; - cmp = (fun uu___ -> fun uu___1 -> FStarC_Compiler_Order.Eq) + cmp = (fun uu___ -> fun uu___1 -> FStarC_Order.Eq) } let (ord_string : Prims.string ord) = { super = FStarC_Class_Deq.deq_string; cmp = (fun x -> - fun y -> - FStarC_Compiler_Order.order_from_int - (FStarC_Compiler_String.compare x y)) + fun y -> FStarC_Order.order_from_int (FStarC_String.compare x y)) } let ord_option : 'a . 'a ord -> 'a FStar_Pervasives_Native.option ord = fun d -> @@ -147,11 +129,11 @@ let ord_option : 'a . 'a ord -> 'a FStar_Pervasives_Native.option ord = fun y -> match (x, y) with | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) - -> FStarC_Compiler_Order.Eq + -> FStarC_Order.Eq | (FStar_Pervasives_Native.Some uu___, - FStar_Pervasives_Native.None) -> FStarC_Compiler_Order.Gt + FStar_Pervasives_Native.None) -> FStarC_Order.Gt | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some - uu___) -> FStarC_Compiler_Order.Lt + uu___) -> FStarC_Order.Lt | (FStar_Pervasives_Native.Some x1, FStar_Pervasives_Native.Some y1) -> cmp d x1 y1) } @@ -159,8 +141,7 @@ let ord_list : 'a . 'a ord -> 'a Prims.list ord = fun d -> { super = (FStarC_Class_Deq.deq_list (ord_eq d)); - cmp = - (fun l1 -> fun l2 -> FStarC_Compiler_Order.compare_list l1 l2 (cmp d)) + cmp = (fun l1 -> fun l2 -> FStarC_Order.compare_list l1 l2 (cmp d)) } let ord_either : 'a 'b . 'a ord -> 'b ord -> ('a, 'b) FStar_Pervasives.either ord = @@ -173,9 +154,9 @@ let ord_either : fun y -> match (x, y) with | (FStar_Pervasives.Inl uu___, FStar_Pervasives.Inr uu___1) -> - FStarC_Compiler_Order.Lt + FStarC_Order.Lt | (FStar_Pervasives.Inr uu___, FStar_Pervasives.Inl uu___1) -> - FStarC_Compiler_Order.Gt + FStarC_Order.Gt | (FStar_Pervasives.Inl x1, FStar_Pervasives.Inl y1) -> cmp d1 x1 y1 | (FStar_Pervasives.Inr x1, FStar_Pervasives.Inr y1) -> @@ -192,8 +173,7 @@ let ord_tuple2 : 'a 'b . 'a ord -> 'b ord -> ('a * 'b) ord = match (uu___, uu___1) with | ((x1, x2), (y1, y2)) -> let uu___2 = cmp d1 x1 y1 in - FStarC_Compiler_Order.lex uu___2 - (fun uu___3 -> cmp d2 x2 y2)) + FStarC_Order.lex uu___2 (fun uu___3 -> cmp d2 x2 y2)) } let ord_tuple3 : 'a 'b 'c . 'a ord -> 'b ord -> 'c ord -> ('a * 'b * 'c) ord = @@ -209,10 +189,10 @@ let ord_tuple3 : 'a 'b 'c . 'a ord -> 'b ord -> 'c ord -> ('a * 'b * 'c) ord match (uu___, uu___1) with | ((x1, x2, x3), (y1, y2, y3)) -> let uu___2 = cmp d1 x1 y1 in - FStarC_Compiler_Order.lex uu___2 + FStarC_Order.lex uu___2 (fun uu___3 -> let uu___4 = cmp d2 x2 y2 in - FStarC_Compiler_Order.lex uu___4 + FStarC_Order.lex uu___4 (fun uu___5 -> cmp d3 x3 y3))) } let ord_tuple4 : @@ -233,13 +213,13 @@ let ord_tuple4 : match (uu___, uu___1) with | ((x1, x2, x3, x4), (y1, y2, y3, y4)) -> let uu___2 = cmp d1 x1 y1 in - FStarC_Compiler_Order.lex uu___2 + FStarC_Order.lex uu___2 (fun uu___3 -> let uu___4 = cmp d2 x2 y2 in - FStarC_Compiler_Order.lex uu___4 + FStarC_Order.lex uu___4 (fun uu___5 -> let uu___6 = cmp d3 x3 y3 in - FStarC_Compiler_Order.lex uu___6 + FStarC_Order.lex uu___6 (fun uu___7 -> cmp d4 x4 y4)))) } let ord_tuple5 : @@ -262,16 +242,16 @@ let ord_tuple5 : match (uu___, uu___1) with | ((x1, x2, x3, x4, x5), (y1, y2, y3, y4, y5)) -> let uu___2 = cmp d1 x1 y1 in - FStarC_Compiler_Order.lex uu___2 + FStarC_Order.lex uu___2 (fun uu___3 -> let uu___4 = cmp d2 x2 y2 in - FStarC_Compiler_Order.lex uu___4 + FStarC_Order.lex uu___4 (fun uu___5 -> let uu___6 = cmp d3 x3 y3 in - FStarC_Compiler_Order.lex uu___6 + FStarC_Order.lex uu___6 (fun uu___7 -> let uu___8 = cmp d4 x4 y4 in - FStarC_Compiler_Order.lex uu___8 + FStarC_Order.lex uu___8 (fun uu___9 -> cmp d5 x5 y5))))) } let ord_tuple6 : @@ -298,19 +278,18 @@ let ord_tuple6 : | ((x1, x2, x3, x4, x5, x6), (y1, y2, y3, y4, y5, y6)) -> let uu___2 = cmp d1 x1 y1 in - FStarC_Compiler_Order.lex uu___2 + FStarC_Order.lex uu___2 (fun uu___3 -> let uu___4 = cmp d2 x2 y2 in - FStarC_Compiler_Order.lex uu___4 + FStarC_Order.lex uu___4 (fun uu___5 -> let uu___6 = cmp d3 x3 y3 in - FStarC_Compiler_Order.lex uu___6 + FStarC_Order.lex uu___6 (fun uu___7 -> let uu___8 = cmp d4 x4 y4 in - FStarC_Compiler_Order.lex uu___8 + FStarC_Order.lex uu___8 (fun uu___9 -> let uu___10 = cmp d5 x5 y5 in - FStarC_Compiler_Order.lex - uu___10 + FStarC_Order.lex uu___10 (fun uu___11 -> cmp d6 x6 y6)))))) } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Class_PP.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_PP.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Class_PP.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_PP.ml diff --git a/stage0/fstar-lib/generated/FStarC_Class_Setlike.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Setlike.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Class_Setlike.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Setlike.ml diff --git a/stage0/fstar-lib/generated/FStarC_Class_Show.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Show.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_Class_Show.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Show.ml index f5ae5681188..5ea169ae97e 100644 --- a/stage0/fstar-lib/generated/FStarC_Class_Show.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Show.ml @@ -12,10 +12,34 @@ let (showable_int : Prims.int showable) = { show = Prims.string_of_int } let (showable_string : Prims.string showable) = { show = (fun x -> Prims.strcat "\"" (Prims.strcat x "\"")) } let show_list : 'a . 'a showable -> 'a Prims.list showable = - fun uu___ -> { show = (FStarC_Common.string_of_list (show uu___)) } + fun uu___ -> + { + show = + (fun l -> + let rec show_list_aux l1 = + match l1 with + | [] -> "" + | x::[] -> show uu___ x + | x::xs -> + let uu___1 = show uu___ x in + let uu___2 = + let uu___3 = show_list_aux xs in Prims.strcat ", " uu___3 in + Prims.strcat uu___1 uu___2 in + let uu___1 = + let uu___2 = show_list_aux l in Prims.strcat uu___2 "]" in + Prims.strcat "[" uu___1) + } let show_option : 'a . 'a showable -> 'a FStar_Pervasives_Native.option showable = - fun uu___ -> { show = (FStarC_Common.string_of_option (show uu___)) } + fun uu___ -> + { + show = + (fun uu___1 -> + match uu___1 with + | FStar_Pervasives_Native.None -> "None" + | FStar_Pervasives_Native.Some x -> + let uu___2 = show uu___ x in Prims.strcat "Some " uu___2) + } let show_either : 'a 'b . 'a showable -> 'b showable -> ('a, 'b) FStar_Pervasives.either showable diff --git a/stage0/fstar-lib/generated/FStarC_Class_Tagged.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Tagged.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Class_Tagged.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Class_Tagged.ml diff --git a/stage0/fstar-lib/generated/FStarC_Common.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Common.ml similarity index 55% rename from stage0/fstar-lib/generated/FStarC_Common.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Common.ml index f721f9868d1..5158be8a4c7 100644 --- a/stage0/fstar-lib/generated/FStarC_Common.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Common.ml @@ -1,49 +1,21 @@ open Prims -let (has_cygpath : Prims.bool) = - try - (fun uu___ -> - match () with - | () -> - let t_out = - FStarC_Compiler_Util.run_process "has_cygpath" "which" - ["cygpath"] FStar_Pervasives_Native.None in - (FStarC_Compiler_Util.trim_string t_out) = "/usr/bin/cygpath") () - with | uu___ -> false -let (try_convert_file_name_to_mixed : Prims.string -> Prims.string) = - let cache = FStarC_Compiler_Util.smap_create (Prims.of_int (20)) in - fun s -> - if has_cygpath && (FStarC_Compiler_Util.starts_with s "/") - then - let uu___ = FStarC_Compiler_Util.smap_try_find cache s in - match uu___ with - | FStar_Pervasives_Native.Some s1 -> s1 - | FStar_Pervasives_Native.None -> - let label = "try_convert_file_name_to_mixed" in - let out = - let uu___1 = - FStarC_Compiler_Util.run_process label "cygpath" ["-m"; s] - FStar_Pervasives_Native.None in - FStarC_Compiler_Util.trim_string uu___1 in - (FStarC_Compiler_Util.smap_add cache s out; out) - else s let snapshot : 'a 'b 'c . - ('a -> 'b) -> - 'c Prims.list FStarC_Compiler_Effect.ref -> 'a -> (Prims.int * 'b) + ('a -> 'b) -> 'c Prims.list FStarC_Effect.ref -> 'a -> (Prims.int * 'b) = fun push -> fun stackref -> fun arg -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> let len = - let uu___1 = FStarC_Compiler_Effect.op_Bang stackref in - FStarC_Compiler_List.length uu___1 in + let uu___1 = FStarC_Effect.op_Bang stackref in + FStarC_List.length uu___1 in let arg' = push arg in (len, arg')) let rollback : 'a 'c . (unit -> 'a) -> - 'c Prims.list FStarC_Compiler_Effect.ref -> + 'c Prims.list FStarC_Effect.ref -> Prims.int FStar_Pervasives_Native.option -> 'a = fun pop -> @@ -57,16 +29,16 @@ let rollback : then pop () else ((let uu___3 = pop () in ()); aux (n - Prims.int_one)) in let curdepth = - let uu___ = FStarC_Compiler_Effect.op_Bang stackref in - FStarC_Compiler_List.length uu___ in + let uu___ = FStarC_Effect.op_Bang stackref in + FStarC_List.length uu___ in let n = match depth with | FStar_Pervasives_Native.Some d -> curdepth - d | FStar_Pervasives_Native.None -> Prims.int_one in - FStarC_Compiler_Util.atomically (fun uu___ -> aux n) + FStarC_Util.atomically (fun uu___ -> aux n) let raise_failed_assertion : 'uuuuu . Prims.string -> 'uuuuu = fun msg -> - let uu___ = FStarC_Compiler_Util.format1 "Assertion failed: %s" msg in + let uu___ = FStarC_Util.format1 "Assertion failed: %s" msg in failwith uu___ let (runtime_assert : Prims.bool -> Prims.string -> unit) = fun b -> @@ -80,18 +52,17 @@ let __string_of_list : match l with | [] -> "[]" | x::xs -> - let strb = FStarC_Compiler_Util.new_string_builder () in - (FStarC_Compiler_Util.string_builder_append strb "["; + let strb = FStarC_Util.new_string_builder () in + (FStarC_Util.string_builder_append strb "["; (let uu___2 = f x in - FStarC_Compiler_Util.string_builder_append strb uu___2); - FStarC_Compiler_List.iter + FStarC_Util.string_builder_append strb uu___2); + FStarC_List.iter (fun x1 -> - FStarC_Compiler_Util.string_builder_append strb delim; + FStarC_Util.string_builder_append strb delim; (let uu___4 = f x1 in - FStarC_Compiler_Util.string_builder_append strb uu___4)) - xs; - FStarC_Compiler_Util.string_builder_append strb "]"; - FStarC_Compiler_Util.string_of_string_builder strb) + FStarC_Util.string_builder_append strb uu___4)) xs; + FStarC_Util.string_builder_append strb "]"; + FStarC_Util.string_of_string_builder strb) let string_of_list : 'a . ('a -> Prims.string) -> 'a Prims.list -> Prims.string = fun f -> fun l -> __string_of_list ", " f l @@ -145,8 +116,8 @@ let max_suffix : | [] -> (acc, []) | x::xs2 when f x -> aux (x :: acc) xs2 | x::xs2 -> (acc, (x :: xs2)) in - let uu___ = aux [] (FStarC_Compiler_List.rev xs) in - match uu___ with | (xs1, ys) -> ((FStarC_Compiler_List.rev ys), xs1) + let uu___ = aux [] (FStarC_List.rev xs) in + match uu___ with | (xs1, ys) -> ((FStarC_List.rev ys), xs1) let rec eq_list : 'a . ('a -> 'a -> Prims.bool) -> 'a Prims.list -> 'a Prims.list -> Prims.bool @@ -160,19 +131,13 @@ let rec eq_list : | (uu___, []) -> false | (x1::t1, x2::t2) -> (f x1 x2) && (eq_list f t1 t2) let psmap_to_list : - 'a . 'a FStarC_Compiler_Util.psmap -> (Prims.string * 'a) Prims.list = - fun m -> - FStarC_Compiler_Util.psmap_fold m - (fun k -> fun v -> fun a1 -> (k, v) :: a1) [] -let psmap_keys : - 'a . 'a FStarC_Compiler_Util.psmap -> Prims.string Prims.list = - fun m -> - FStarC_Compiler_Util.psmap_fold m (fun k -> fun v -> fun a1 -> k :: a1) - [] -let psmap_values : 'a . 'a FStarC_Compiler_Util.psmap -> 'a Prims.list = + 'a . 'a FStarC_Util.psmap -> (Prims.string * 'a) Prims.list = fun m -> - FStarC_Compiler_Util.psmap_fold m (fun k -> fun v -> fun a1 -> v :: a1) - [] + FStarC_Util.psmap_fold m (fun k -> fun v -> fun a1 -> (k, v) :: a1) [] +let psmap_keys : 'a . 'a FStarC_Util.psmap -> Prims.string Prims.list = + fun m -> FStarC_Util.psmap_fold m (fun k -> fun v -> fun a1 -> k :: a1) [] +let psmap_values : 'a . 'a FStarC_Util.psmap -> 'a Prims.list = + fun m -> FStarC_Util.psmap_fold m (fun k -> fun v -> fun a1 -> v :: a1) [] let option_to_list : 'a . 'a FStar_Pervasives_Native.option -> 'a Prims.list = fun uu___ -> diff --git a/stage0/fstar-lib/generated/FStarC_Const.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Const.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_Const.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Const.ml index 3b14e9d8a0d..1284f92da40 100644 --- a/stage0/fstar-lib/generated/FStarC_Const.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Const.ml @@ -28,12 +28,12 @@ type sconst = | Const_bool of Prims.bool | Const_int of (Prims.string * (signedness * width) FStar_Pervasives_Native.option) - | Const_char of FStarC_BaseTypes.char + | Const_char of FStar_Char.char | Const_real of Prims.string - | Const_string of (Prims.string * FStarC_Compiler_Range_Type.range) + | Const_string of (Prims.string * FStarC_Range_Type.range) | Const_range_of | Const_set_range_of - | Const_range of FStarC_Compiler_Range_Type.range + | Const_range of FStarC_Range_Type.range | Const_reify of FStarC_Ident.lid FStar_Pervasives_Native.option | Const_reflect of FStarC_Ident.lid [@@deriving yojson,show] let (uu___is_Const_effect : sconst -> Prims.bool) = @@ -56,7 +56,7 @@ let (__proj__Const_int__item___0 : let (uu___is_Const_char : sconst -> Prims.bool) = fun projectee -> match projectee with | Const_char _0 -> true | uu___ -> false -let (__proj__Const_char__item___0 : sconst -> FStarC_BaseTypes.char) = +let (__proj__Const_char__item___0 : sconst -> FStar_Char.char) = fun projectee -> match projectee with | Const_char _0 -> _0 let (uu___is_Const_real : sconst -> Prims.bool) = fun projectee -> @@ -67,7 +67,7 @@ let (uu___is_Const_string : sconst -> Prims.bool) = fun projectee -> match projectee with | Const_string _0 -> true | uu___ -> false let (__proj__Const_string__item___0 : - sconst -> (Prims.string * FStarC_Compiler_Range_Type.range)) = + sconst -> (Prims.string * FStarC_Range_Type.range)) = fun projectee -> match projectee with | Const_string _0 -> _0 let (uu___is_Const_range_of : sconst -> Prims.bool) = fun projectee -> @@ -78,8 +78,7 @@ let (uu___is_Const_set_range_of : sconst -> Prims.bool) = let (uu___is_Const_range : sconst -> Prims.bool) = fun projectee -> match projectee with | Const_range _0 -> true | uu___ -> false -let (__proj__Const_range__item___0 : - sconst -> FStarC_Compiler_Range_Type.range) = +let (__proj__Const_range__item___0 : sconst -> FStarC_Range_Type.range) = fun projectee -> match projectee with | Const_range _0 -> _0 let (uu___is_Const_reify : sconst -> Prims.bool) = fun projectee -> @@ -97,9 +96,9 @@ let (eq_const : sconst -> sconst -> Prims.bool) = fun c2 -> match (c1, c2) with | (Const_int (s1, o1), Const_int (s2, o2)) -> - (let uu___ = FStarC_Compiler_Util.ensure_decimal s1 in - let uu___1 = FStarC_Compiler_Util.ensure_decimal s2 in - uu___ = uu___1) && (o1 = o2) + (let uu___ = FStarC_Util.ensure_decimal s1 in + let uu___1 = FStarC_Util.ensure_decimal s2 in uu___ = uu___1) && + (o1 = o2) | (Const_string (a, uu___), Const_string (b, uu___1)) -> a = b | (Const_reflect l1, Const_reflect l2) -> FStarC_Ident.lid_equals l1 l2 | (Const_reify uu___, Const_reify uu___1) -> true @@ -143,7 +142,7 @@ let (within_bounds : Prims.string -> signedness -> width -> Prims.bool) = match uu___ with | (lower, upper) -> let value = - let uu___1 = FStarC_Compiler_Util.ensure_decimal repr in + let uu___1 = FStarC_Util.ensure_decimal repr in FStarC_BigInt.big_int_of_string uu___1 in (FStarC_BigInt.le_big_int lower value) && (FStarC_BigInt.le_big_int value upper) \ No newline at end of file diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_Debug.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Debug.ml new file mode 100644 index 00000000000..20265542bfb --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Debug.ml @@ -0,0 +1,129 @@ +open Prims +let (anyref : Prims.bool FStarC_Effect.ref) = FStarC_Util.mk_ref false +let (_debug_all : Prims.bool FStarC_Effect.ref) = FStarC_Util.mk_ref false +let (toggle_list : + (Prims.string * Prims.bool FStarC_Effect.ref) Prims.list FStarC_Effect.ref) + = FStarC_Util.mk_ref [] +type saved_state = + { + toggles: (Prims.string * Prims.bool) Prims.list ; + any: Prims.bool ; + all: Prims.bool } +let (__proj__Mksaved_state__item__toggles : + saved_state -> (Prims.string * Prims.bool) Prims.list) = + fun projectee -> match projectee with | { toggles; any; all;_} -> toggles +let (__proj__Mksaved_state__item__any : saved_state -> Prims.bool) = + fun projectee -> match projectee with | { toggles; any; all;_} -> any +let (__proj__Mksaved_state__item__all : saved_state -> Prims.bool) = + fun projectee -> match projectee with | { toggles; any; all;_} -> all +let (snapshot : unit -> saved_state) = + fun uu___ -> + let uu___1 = + let uu___2 = FStarC_Effect.op_Bang toggle_list in + FStarC_List.map + (fun uu___3 -> + match uu___3 with + | (k, r) -> let uu___4 = FStarC_Effect.op_Bang r in (k, uu___4)) + uu___2 in + let uu___2 = FStarC_Effect.op_Bang anyref in + let uu___3 = FStarC_Effect.op_Bang _debug_all in + { toggles = uu___1; any = uu___2; all = uu___3 } +let (register_toggle : Prims.string -> Prims.bool FStarC_Effect.ref) = + fun k -> + let r = FStarC_Util.mk_ref false in + (let uu___1 = FStarC_Effect.op_Bang _debug_all in + if uu___1 then FStarC_Effect.op_Colon_Equals r true else ()); + (let uu___2 = + let uu___3 = FStarC_Effect.op_Bang toggle_list in (k, r) :: uu___3 in + FStarC_Effect.op_Colon_Equals toggle_list uu___2); + r +let (get_toggle : Prims.string -> Prims.bool FStarC_Effect.ref) = + fun k -> + let uu___ = + let uu___1 = FStarC_Effect.op_Bang toggle_list in + FStarC_List.tryFind + (fun uu___2 -> match uu___2 with | (k', uu___3) -> k = k') uu___1 in + match uu___ with + | FStar_Pervasives_Native.Some (uu___1, r) -> r + | FStar_Pervasives_Native.None -> register_toggle k +let (restore : saved_state -> unit) = + fun snapshot1 -> + (let uu___1 = FStarC_Effect.op_Bang toggle_list in + FStarC_List.iter + (fun uu___2 -> + match uu___2 with + | (uu___3, r) -> FStarC_Effect.op_Colon_Equals r false) uu___1); + FStarC_List.iter + (fun uu___2 -> + match uu___2 with + | (k, b) -> + let r = get_toggle k in FStarC_Effect.op_Colon_Equals r b) + snapshot1.toggles; + FStarC_Effect.op_Colon_Equals anyref snapshot1.any; + FStarC_Effect.op_Colon_Equals _debug_all snapshot1.all +let (list_all_toggles : unit -> Prims.string Prims.list) = + fun uu___ -> + let uu___1 = FStarC_Effect.op_Bang toggle_list in + FStarC_List.map FStar_Pervasives_Native.fst uu___1 +let (any : unit -> Prims.bool) = + fun uu___ -> + (FStarC_Effect.op_Bang anyref) || (FStarC_Effect.op_Bang _debug_all) +let (tag : Prims.string -> unit) = + fun s -> + let uu___ = any () in + if uu___ + then + FStarC_Util.print_string (Prims.strcat "DEBUG:" (Prims.strcat s "\n")) + else () +let (enable : unit -> unit) = + fun uu___ -> FStarC_Effect.op_Colon_Equals anyref true +let (dbg_level : Prims.int FStarC_Effect.ref) = + FStarC_Util.mk_ref Prims.int_zero +let (low : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStarC_Effect.op_Bang dbg_level in uu___1 >= Prims.int_one) + || (FStarC_Effect.op_Bang _debug_all) +let (medium : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStarC_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (2))) || (FStarC_Effect.op_Bang _debug_all) +let (high : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStarC_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (3))) || (FStarC_Effect.op_Bang _debug_all) +let (extreme : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStarC_Effect.op_Bang dbg_level in + uu___1 >= (Prims.of_int (4))) || (FStarC_Effect.op_Bang _debug_all) +let (set_level_low : unit -> unit) = + fun uu___ -> FStarC_Effect.op_Colon_Equals dbg_level Prims.int_one +let (set_level_medium : unit -> unit) = + fun uu___ -> FStarC_Effect.op_Colon_Equals dbg_level (Prims.of_int (2)) +let (set_level_high : unit -> unit) = + fun uu___ -> FStarC_Effect.op_Colon_Equals dbg_level (Prims.of_int (3)) +let (set_level_extreme : unit -> unit) = + fun uu___ -> FStarC_Effect.op_Colon_Equals dbg_level (Prims.of_int (4)) +let (enable_toggles : Prims.string Prims.list -> unit) = + fun keys -> + if Prims.uu___is_Cons keys then enable () else (); + FStarC_List.iter + (fun k -> + match k with + | "Low" -> set_level_low () + | "Medium" -> set_level_medium () + | "High" -> set_level_high () + | "Extreme" -> set_level_extreme () + | uu___1 -> + let t = get_toggle k in FStarC_Effect.op_Colon_Equals t true) + keys +let (disable_all : unit -> unit) = + fun uu___ -> + FStarC_Effect.op_Colon_Equals anyref false; + FStarC_Effect.op_Colon_Equals dbg_level Prims.int_zero; + (let uu___3 = FStarC_Effect.op_Bang toggle_list in + FStarC_List.iter + (fun uu___4 -> + match uu___4 with + | (uu___5, r) -> FStarC_Effect.op_Colon_Equals r false) uu___3) +let (set_debug_all : unit -> unit) = + fun uu___ -> FStarC_Effect.op_Colon_Equals _debug_all true \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Defensive.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Defensive.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_Defensive.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Defensive.ml index 0ff3953569b..8f45bd3ed62 100644 --- a/stage0/fstar-lib/generated/FStarC_Defensive.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Defensive.ml @@ -10,8 +10,7 @@ let (pp_bv : FStarC_Syntax_Syntax.bv FStarC_Class_PP.pretty) = let pp_set : 'a . 'a FStarC_Class_Ord.ord -> - 'a FStarC_Class_PP.pretty -> - 'a FStarC_Compiler_FlatSet.t FStarC_Class_PP.pretty + 'a FStarC_Class_PP.pretty -> 'a FStarC_FlatSet.t FStarC_Class_PP.pretty = fun uu___ -> fun uu___1 -> @@ -29,10 +28,9 @@ let pp_set : let uu___2 = let uu___3 = FStarC_Class_Setlike.elems () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set uu___)) + (Obj.magic (FStarC_FlatSet.setlike_flat_set uu___)) (Obj.magic s) in - FStarC_Compiler_List.map (FStarC_Class_PP.pp uu___1) uu___3 in + FStarC_List.map (FStarC_Class_PP.pp uu___1) uu___3 in doclist uu___2) } let __def_check_scoped : @@ -40,7 +38,7 @@ let __def_check_scoped : 'envut FStarC_Class_Binders.hasBinders -> 'thingut FStarC_Class_Binders.hasNames -> 'thingut FStarC_Class_PP.pretty -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.string -> 'envut -> 'thingut -> unit = fun uu___ -> @@ -56,7 +54,7 @@ let __def_check_scoped : let uu___4 = FStarC_Class_Setlike.subset () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic free) (Obj.magic scope) in Prims.op_Negation uu___4 in @@ -99,7 +97,7 @@ let __def_check_scoped : Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic free) (Obj.magic scope)) in FStarC_Class_PP.pp @@ -122,7 +120,7 @@ let def_check_scoped : 'envut FStarC_Class_Binders.hasBinders -> 'thingut FStarC_Class_Binders.hasNames -> 'thingut FStarC_Class_PP.pretty -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.string -> 'envut -> 'thingut -> unit = fun uu___ -> diff --git a/stage0/fstar-lib/generated/FStarC_Dependencies.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Dependencies.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_Dependencies.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Dependencies.ml index 9411005f246..650c83b63d3 100644 --- a/stage0/fstar-lib/generated/FStarC_Dependencies.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Dependencies.ml @@ -18,4 +18,4 @@ let (find_deps_if_needed : (Obj.magic "Dependency analysis failed; reverting to using only the files provided"); (files, deps)) - | uu___1 -> ((FStarC_Compiler_List.rev all_files), deps)) \ No newline at end of file + | uu___1 -> ((FStarC_List.rev all_files), deps)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Errors.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Errors.ml similarity index 69% rename from stage0/fstar-lib/generated/FStarC_Errors.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Errors.ml index 2ad1d592c9d..723fcb81cac 100644 --- a/stage0/fstar-lib/generated/FStarC_Errors.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Errors.ml @@ -1,21 +1,25 @@ open Prims let (fallback_range : - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + FStarC_Range_Type.range FStar_Pervasives_Native.option FStarC_Effect.ref) = + FStarC_Util.mk_ref FStar_Pervasives_Native.None let (error_range_bound : - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None -let with_error_bound : - 'a . FStarC_Compiler_Range_Type.range -> (unit -> 'a) -> 'a = + FStarC_Range_Type.range FStar_Pervasives_Native.option FStarC_Effect.ref) = + FStarC_Util.mk_ref FStar_Pervasives_Native.None +let with_error_bound : 'a . FStarC_Range_Type.range -> (unit -> 'a) -> 'a = fun r -> fun f -> - let old = FStarC_Compiler_Effect.op_Bang error_range_bound in - FStarC_Compiler_Effect.op_Colon_Equals error_range_bound + let old = FStarC_Effect.op_Bang error_range_bound in + FStarC_Effect.op_Colon_Equals error_range_bound (FStar_Pervasives_Native.Some r); (let res = f () in - FStarC_Compiler_Effect.op_Colon_Equals error_range_bound old; res) + FStarC_Effect.op_Colon_Equals error_range_bound old; res) +let (maybe_bound_range : FStarC_Range_Type.range -> FStarC_Range_Type.range) + = + fun r -> + let uu___ = FStarC_Effect.op_Bang error_range_bound in + match uu___ with + | FStar_Pervasives_Native.Some r' -> FStarC_Range_Ops.bound_range r r' + | FStar_Pervasives_Native.None -> r exception Invalid_warn_error_setting of Prims.string let (uu___is_Invalid_warn_error_setting : Prims.exn -> Prims.bool) = fun projectee -> @@ -34,7 +38,7 @@ let lookup_error : fun settings -> fun e -> let uu___ = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun uu___1 -> match uu___1 with | (v, uu___2, i) -> e = v) settings in match uu___ with @@ -51,7 +55,7 @@ let lookup_error_range : match uu___ with | (l, h) -> let uu___1 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___2 -> match uu___2 with | (uu___3, uu___4, i) -> (l <= i) && (i <= h)) settings in @@ -78,50 +82,48 @@ let (update_flags : | (FStarC_Errors_Codes.CWarning, FStarC_Errors_Codes.CAlwaysError) -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format1 - "cannot turn error %s into warning" uu___2 in + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format1 "cannot turn error %s into warning" uu___2 in Invalid_warn_error_setting uu___1 in - FStarC_Compiler_Effect.raise uu___ + FStarC_Effect.raise uu___ | (FStarC_Errors_Codes.CError, FStarC_Errors_Codes.CAlwaysError) -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format1 - "cannot turn error %s into warning" uu___2 in + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format1 "cannot turn error %s into warning" uu___2 in Invalid_warn_error_setting uu___1 in - FStarC_Compiler_Effect.raise uu___ + FStarC_Effect.raise uu___ | (FStarC_Errors_Codes.CSilent, FStarC_Errors_Codes.CAlwaysError) -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format1 "cannot silence error %s" uu___2 in + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format1 "cannot silence error %s" uu___2 in Invalid_warn_error_setting uu___1 in - FStarC_Compiler_Effect.raise uu___ + FStarC_Effect.raise uu___ | (FStarC_Errors_Codes.CSilent, FStarC_Errors_Codes.CFatal) -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format1 + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format1 "cannot change the error level of fatal error %s" uu___2 in Invalid_warn_error_setting uu___1 in - FStarC_Compiler_Effect.raise uu___ + FStarC_Effect.raise uu___ | (FStarC_Errors_Codes.CWarning, FStarC_Errors_Codes.CFatal) -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format1 + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format1 "cannot change the error level of fatal error %s" uu___2 in Invalid_warn_error_setting uu___1 in - FStarC_Compiler_Effect.raise uu___ + FStarC_Effect.raise uu___ | (FStarC_Errors_Codes.CError, FStarC_Errors_Codes.CFatal) -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format1 + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format1 "cannot change the error level of fatal error %s" uu___2 in Invalid_warn_error_setting uu___1 in - FStarC_Compiler_Effect.raise uu___ + FStarC_Effect.raise uu___ | (FStarC_Errors_Codes.CAlwaysError, FStarC_Errors_Codes.CFatal) -> FStarC_Errors_Codes.CFatal | uu___ -> flag in @@ -130,7 +132,7 @@ let (update_flags : | (flag, range) -> let errs = lookup_error_range FStarC_Errors_Codes.default_settings range in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (v, default_flag, i) -> @@ -139,29 +141,26 @@ let (update_flags : let compute_range uu___ = match uu___ with | (flag, s) -> - let r = FStarC_Compiler_Util.split s ".." in + let r = FStarC_Util.split s ".." in let uu___1 = match r with | r1::r2::[] -> - let uu___2 = FStarC_Compiler_Util.int_of_string r1 in - let uu___3 = FStarC_Compiler_Util.int_of_string r2 in - (uu___2, uu___3) + let uu___2 = FStarC_Util.int_of_string r1 in + let uu___3 = FStarC_Util.int_of_string r2 in (uu___2, uu___3) | uu___2 -> let uu___3 = let uu___4 = - FStarC_Compiler_Util.format1 - "Malformed warn-error range %s" s in + FStarC_Util.format1 "Malformed warn-error range %s" s in Invalid_warn_error_setting uu___4 in - FStarC_Compiler_Effect.raise uu___3 in + FStarC_Effect.raise uu___3 in (match uu___1 with | (l1, h) -> (flag, (l1, h))) in let error_range_settings = - FStarC_Compiler_List.map compute_range (FStarC_Compiler_List.rev l) in - let uu___ = - FStarC_Compiler_List.collect set_flag_for_range error_range_settings in - FStarC_Compiler_List.op_At uu___ FStarC_Errors_Codes.default_settings + FStarC_List.map compute_range (FStarC_List.rev l) in + let uu___ = FStarC_List.collect set_flag_for_range error_range_settings in + FStarC_List.op_At uu___ FStarC_Errors_Codes.default_settings type error = (FStarC_Errors_Codes.error_code * FStarC_Errors_Msg.error_message * - FStarC_Compiler_Range_Type.range * Prims.string Prims.list) + FStarC_Range_Type.range * Prims.string Prims.list) type issue_level = | ENotImplemented | EInfo @@ -206,8 +205,7 @@ type issue = { issue_msg: FStarC_Errors_Msg.error_message ; issue_level: issue_level ; - issue_range: - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option ; + issue_range: FStarC_Range_Type.range FStar_Pervasives_Native.option ; issue_number: Prims.int FStar_Pervasives_Native.option ; issue_ctx: Prims.string Prims.list } let (__proj__Mkissue__item__issue_msg : @@ -222,7 +220,7 @@ let (__proj__Mkissue__item__issue_level : issue -> issue_level) = | { issue_msg; issue_level = issue_level1; issue_range; issue_number; issue_ctx;_} -> issue_level1 let (__proj__Mkissue__item__issue_range : - issue -> FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option) = + issue -> FStarC_Range_Type.range FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { issue_msg; issue_level = issue_level1; issue_range; issue_number; @@ -256,9 +254,9 @@ let (json_of_issue : issue -> FStarC_Json.json) = (FStarC_Class_Monad.op_Less_Dollar_Greater FStarC_Class_Monad.monad_option () () (fun uu___8 -> - (Obj.magic FStarC_Compiler_Range_Type.json_of_range) - uu___8) (Obj.magic issue1.issue_range)) in - FStarC_Compiler_Util.dflt FStarC_Json.JsonNull uu___7 in + (Obj.magic FStarC_Range_Type.json_of_range) uu___8) + (Obj.magic issue1.issue_range)) in + FStarC_Util.dflt FStarC_Json.JsonNull uu___7 in ("range", uu___6) in let uu___6 = let uu___7 = @@ -272,7 +270,7 @@ let (json_of_issue : issue -> FStarC_Json.json) = let uu___10 = Obj.magic uu___10 in Obj.magic (FStarC_Json.JsonInt uu___10)) uu___10) (Obj.magic issue1.issue_number)) in - FStarC_Compiler_Util.dflt FStarC_Json.JsonNull uu___9 in + FStarC_Util.dflt FStarC_Json.JsonNull uu___9 in ("number", uu___8) in let uu___8 = let uu___9 = @@ -337,7 +335,7 @@ let (ctx_doc : Prims.string Prims.list -> FStarC_Pprint.document) = if uu___ then let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun s -> let uu___2 = let uu___3 = FStarC_Pprint.doc_of_string "> " in @@ -349,7 +347,7 @@ let (ctx_doc : Prims.string Prims.list -> FStarC_Pprint.document) = let (issue_message : issue -> FStarC_Errors_Msg.error_message) = fun i -> let uu___ = let uu___1 = ctx_doc i.issue_ctx in [uu___1] in - FStarC_Compiler_List.op_At i.issue_msg uu___ + FStarC_List.op_At i.issue_msg uu___ let (string_of_issue_level : issue_level -> Prims.string) = fun il -> match il with @@ -376,46 +374,47 @@ let optional_def : match o with | FStar_Pervasives_Native.Some x -> f x | FStar_Pervasives_Native.None -> def -let (format_issue' : Prims.bool -> issue -> Prims.string) = +let (issue_to_doc' : Prims.bool -> issue -> FStarC_Pprint.document) = fun print_hdr -> fun issue1 -> - let level_header = - let uu___ = string_of_issue_level issue1.issue_level in - FStarC_Pprint.doc_of_string uu___ in - let num_opt = - if (issue1.issue_level = EError) || (issue1.issue_level = EWarning) - then - let uu___ = FStarC_Pprint.blank Prims.int_one in - let uu___1 = - let uu___2 = FStarC_Pprint.doc_of_string "" in - optional_def - (fun n -> - let uu___3 = FStarC_Compiler_Util.string_of_int n in - FStarC_Pprint.doc_of_string uu___3) uu___2 - issue1.issue_number in - FStarC_Pprint.op_Hat_Hat uu___ uu___1 - else FStarC_Pprint.empty in let r = issue1.issue_range in - let atrng = - match r with - | FStar_Pervasives_Native.Some r1 when - r1 <> FStarC_Compiler_Range_Type.dummyRange -> - let uu___ = FStarC_Pprint.blank Prims.int_one in - let uu___1 = - let uu___2 = FStarC_Pprint.doc_of_string "at" in - let uu___3 = - let uu___4 = FStarC_Pprint.blank Prims.int_one in - let uu___5 = - let uu___6 = - FStarC_Compiler_Range_Ops.string_of_use_range r1 in - FStarC_Pprint.doc_of_string uu___6 in - FStarC_Pprint.op_Hat_Hat uu___4 uu___5 in - FStarC_Pprint.op_Hat_Hat uu___2 uu___3 in - FStarC_Pprint.op_Hat_Hat uu___ uu___1 - | uu___ -> FStarC_Pprint.empty in let hdr = if print_hdr then + let level_header = + let uu___ = string_of_issue_level issue1.issue_level in + FStarC_Pprint.doc_of_string uu___ in + let num_opt = + if + (issue1.issue_level = EError) || + (issue1.issue_level = EWarning) + then + let uu___ = FStarC_Pprint.blank Prims.int_one in + let uu___1 = + let uu___2 = FStarC_Pprint.doc_of_string "" in + optional_def + (fun n -> + let uu___3 = FStarC_Util.string_of_int n in + FStarC_Pprint.doc_of_string uu___3) uu___2 + issue1.issue_number in + FStarC_Pprint.op_Hat_Hat uu___ uu___1 + else FStarC_Pprint.empty in + let atrng = + match r with + | FStar_Pervasives_Native.Some r1 when + r1 <> FStarC_Range_Type.dummyRange -> + let uu___ = FStarC_Pprint.blank Prims.int_one in + let uu___1 = + let uu___2 = FStarC_Pprint.doc_of_string "at" in + let uu___3 = + let uu___4 = FStarC_Pprint.blank Prims.int_one in + let uu___5 = + let uu___6 = FStarC_Range_Ops.string_of_use_range r1 in + FStarC_Pprint.doc_of_string uu___6 in + FStarC_Pprint.op_Hat_Hat uu___4 uu___5 in + FStarC_Pprint.op_Hat_Hat uu___2 uu___3 in + FStarC_Pprint.op_Hat_Hat uu___ uu___1 + | uu___ -> FStarC_Pprint.empty in let uu___ = FStarC_Pprint.doc_of_string "*" in let uu___1 = let uu___2 = FStarC_Pprint.blank Prims.int_one in @@ -434,20 +433,19 @@ let (format_issue' : Prims.bool -> issue -> Prims.string) = let seealso = match r with | FStar_Pervasives_Native.Some r1 when - (let uu___ = FStarC_Compiler_Range_Type.def_range r1 in - let uu___1 = FStarC_Compiler_Range_Type.use_range r1 in - uu___ <> uu___1) && - (let uu___ = FStarC_Compiler_Range_Type.def_range r1 in + (let uu___ = FStarC_Range_Type.def_range r1 in + let uu___1 = FStarC_Range_Type.use_range r1 in uu___ <> uu___1) + && + (let uu___ = FStarC_Range_Type.def_range r1 in let uu___1 = - FStarC_Compiler_Range_Type.def_range - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.def_range FStarC_Range_Type.dummyRange in uu___ <> uu___1) -> let uu___ = FStarC_Pprint.doc_of_string "See also" in let uu___1 = let uu___2 = FStarC_Pprint.blank Prims.int_one in let uu___3 = - let uu___4 = FStarC_Compiler_Range_Ops.string_of_range r1 in + let uu___4 = FStarC_Range_Ops.string_of_range r1 in FStarC_Pprint.doc_of_string uu___4 in FStarC_Pprint.op_Hat_Hat uu___2 uu___3 in FStarC_Pprint.op_Hat_Hat uu___ uu___1 @@ -460,7 +458,7 @@ let (format_issue' : Prims.bool -> issue -> Prims.string) = let uu___1 = FStarC_Pprint.doc_of_string s in FStarC_Pprint.op_Hat_Hat uu___ uu___1 in let uu___ = d1 h in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun l -> fun r1 -> let uu___1 = @@ -471,36 +469,102 @@ let (format_issue' : Prims.bool -> issue -> Prims.string) = let subdoc = FStarC_Errors_Msg.subdoc' print_hdr in let mainmsg = let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun d -> let uu___1 = FStarC_Pprint.group d in subdoc uu___1) issue1.issue_msg in FStarC_Pprint.concat uu___ in - let doc = - let uu___ = - let uu___1 = - let uu___2 = subdoc seealso in - let uu___3 = subdoc ctx in FStarC_Pprint.op_Hat_Hat uu___2 uu___3 in - FStarC_Pprint.op_Hat_Hat mainmsg uu___1 in - FStarC_Pprint.op_Hat_Hat hdr uu___ in - FStarC_Errors_Msg.renderdoc doc + let uu___ = + let uu___1 = + let uu___2 = subdoc seealso in + let uu___3 = subdoc ctx in FStarC_Pprint.op_Hat_Hat uu___2 uu___3 in + FStarC_Pprint.op_Hat_Hat mainmsg uu___1 in + FStarC_Pprint.op_Hat_Hat hdr uu___ +let (format_issue' : Prims.bool -> issue -> Prims.string) = + fun print_hdr -> + fun issue1 -> + let uu___ = issue_to_doc' print_hdr issue1 in + FStarC_Errors_Msg.renderdoc uu___ let (format_issue : issue -> Prims.string) = fun issue1 -> format_issue' true issue1 let (print_issue_json : issue -> unit) = fun issue1 -> let uu___ = let uu___1 = json_of_issue issue1 in FStarC_Json.string_of_json uu___1 in - FStarC_Compiler_Util.print1_error "%s\n" uu___ + FStarC_Util.print1_error "%s\n" uu___ +let (print_issue_github : issue -> unit) = + fun issue1 -> + match issue1.issue_level with + | ENotImplemented -> () + | EInfo -> () + | EError -> + let level = + if uu___is_EError issue1.issue_level then "error" else "warning" in + let rng = + FStarC_Util.dflt FStarC_Range_Type.dummyRange issue1.issue_range in + let msg = format_issue' true issue1 in + let msg1 = FStarC_String.concat "%0A" (FStarC_Util.splitlines msg) in + let num = + match issue1.issue_number with + | FStar_Pervasives_Native.None -> "" + | FStar_Pervasives_Native.Some n -> + let uu___ = + FStarC_Class_Show.show FStarC_Class_Show.showable_int n in + FStarC_Util.format1 "(%s) " uu___ in + let uu___ = + let uu___1 = FStarC_Range_Ops.file_of_range rng in + let uu___2 = + let uu___3 = + let uu___4 = FStarC_Range_Ops.start_of_range rng in + FStarC_Range_Ops.line_of_pos uu___4 in + FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___3 in + let uu___3 = + let uu___4 = + let uu___5 = FStarC_Range_Ops.end_of_range rng in + FStarC_Range_Ops.line_of_pos uu___5 in + FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___4 in + FStarC_Util.format6 "::%s file=%s,line=%s,endLine=%s::%s%s\n" level + uu___1 uu___2 uu___3 num msg1 in + FStarC_Util.print_warning uu___ + | EWarning -> + let level = + if uu___is_EError issue1.issue_level then "error" else "warning" in + let rng = + FStarC_Util.dflt FStarC_Range_Type.dummyRange issue1.issue_range in + let msg = format_issue' true issue1 in + let msg1 = FStarC_String.concat "%0A" (FStarC_Util.splitlines msg) in + let num = + match issue1.issue_number with + | FStar_Pervasives_Native.None -> "" + | FStar_Pervasives_Native.Some n -> + let uu___ = + FStarC_Class_Show.show FStarC_Class_Show.showable_int n in + FStarC_Util.format1 "(%s) " uu___ in + let uu___ = + let uu___1 = FStarC_Range_Ops.file_of_range rng in + let uu___2 = + let uu___3 = + let uu___4 = FStarC_Range_Ops.start_of_range rng in + FStarC_Range_Ops.line_of_pos uu___4 in + FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___3 in + let uu___3 = + let uu___4 = + let uu___5 = FStarC_Range_Ops.end_of_range rng in + FStarC_Range_Ops.line_of_pos uu___5 in + FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___4 in + FStarC_Util.format6 "::%s file=%s,line=%s,endLine=%s::%s%s\n" level + uu___1 uu___2 uu___3 num msg1 in + FStarC_Util.print_warning uu___ let (print_issue_rendered : issue -> unit) = fun issue1 -> let printer = match issue1.issue_level with | EInfo -> (fun s -> - let uu___ = FStarC_Compiler_Util.colorize_cyan s in - FStarC_Compiler_Util.print_string uu___) - | EWarning -> FStarC_Compiler_Util.print_warning - | EError -> FStarC_Compiler_Util.print_error - | ENotImplemented -> FStarC_Compiler_Util.print_error in + let uu___ = FStarC_Util.colorize_cyan s in + FStarC_Util.print_string uu___) + | EWarning -> FStarC_Util.print_warning + | EError -> FStarC_Util.print_error + | ENotImplemented -> FStarC_Util.print_error in let uu___ = let uu___1 = format_issue issue1 in Prims.strcat uu___1 "\n" in printer uu___ let (print_issue : issue -> unit) = @@ -509,6 +573,7 @@ let (print_issue : issue -> unit) = match uu___ with | FStarC_Options.Human -> print_issue_rendered issue1 | FStarC_Options.Json -> print_issue_json issue1 + | FStarC_Options.Github -> print_issue_github issue1 let (compare_issues : issue -> issue -> Prims.int) = fun i1 -> fun i2 -> @@ -520,94 +585,92 @@ let (compare_issues : issue -> issue -> Prims.int) = | (FStar_Pervasives_Native.Some uu___, FStar_Pervasives_Native.None) -> Prims.int_one | (FStar_Pervasives_Native.Some r1, FStar_Pervasives_Native.Some r2) -> - FStarC_Compiler_Range_Ops.compare_use_range r1 r2 -let (dummy_ide_rng : FStarC_Compiler_Range_Type.rng) = - let uu___ = FStarC_Compiler_Range_Type.mk_pos Prims.int_one Prims.int_zero in - let uu___1 = FStarC_Compiler_Range_Type.mk_pos Prims.int_one Prims.int_zero in - FStarC_Compiler_Range_Type.mk_rng "" uu___ uu___1 -let (maybe_bound_rng : - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.range) = - fun r -> - let uu___ = FStarC_Compiler_Effect.op_Bang error_range_bound in - match uu___ with - | FStar_Pervasives_Native.Some r' -> - FStarC_Compiler_Range_Ops.bound_range r r' - | FStar_Pervasives_Native.None -> r -let (fixup_issue_range : issue -> issue) = - fun i -> - let rng = - match i.issue_range with + FStarC_Range_Ops.compare_use_range r1 r2 +let (dummy_ide_rng : FStarC_Range_Type.rng) = + let uu___ = FStarC_Range_Type.mk_pos Prims.int_one Prims.int_zero in + let uu___1 = FStarC_Range_Type.mk_pos Prims.int_one Prims.int_zero in + FStarC_Range_Type.mk_rng "" uu___ uu___1 +let (fixup_issue_range : + FStarC_Range_Type.range FStar_Pervasives_Native.option -> + FStarC_Range_Type.range FStar_Pervasives_Native.option) + = + fun rng -> + let rng1 = + match rng with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.op_Bang fallback_range + let uu___ = FStarC_Effect.op_Bang fallback_range in + (match uu___ with + | FStar_Pervasives_Native.Some r -> FStar_Pervasives_Native.Some r + | FStar_Pervasives_Native.None -> + FStarC_Effect.op_Bang error_range_bound) | FStar_Pervasives_Native.Some range -> - let use_rng = FStarC_Compiler_Range_Type.use_range range in + let use_rng = FStarC_Range_Type.use_range range in let use_rng' = if - (use_rng <> FStarC_Compiler_Range_Type.dummy_rng) && + (use_rng <> FStarC_Range_Type.dummy_rng) && (use_rng <> dummy_ide_rng) then use_rng else (let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang fallback_range in + let uu___2 = FStarC_Effect.op_Bang fallback_range in FStar_Pervasives_Native.uu___is_Some uu___2 in if uu___1 then let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang fallback_range in + let uu___3 = FStarC_Effect.op_Bang fallback_range in FStar_Pervasives_Native.__proj__Some__item__v uu___3 in - FStarC_Compiler_Range_Type.use_range uu___2 + FStarC_Range_Type.use_range uu___2 else use_rng) in - let uu___ = FStarC_Compiler_Range_Type.set_use_range range use_rng' in + let uu___ = FStarC_Range_Type.set_use_range range use_rng' in FStar_Pervasives_Native.Some uu___ in - let uu___ = FStarC_Compiler_Util.map_opt rng maybe_bound_rng in - { - issue_msg = (i.issue_msg); - issue_level = (i.issue_level); - issue_range = uu___; - issue_number = (i.issue_number); - issue_ctx = (i.issue_ctx) - } + FStarC_Util.map_opt rng1 maybe_bound_range let (mk_default_handler : Prims.bool -> error_handler) = fun print -> - let issues = FStarC_Compiler_Util.mk_ref [] in - let err_count = FStarC_Compiler_Util.mk_ref Prims.int_zero in + let issues = FStarC_Util.mk_ref [] in + let err_count = FStarC_Util.mk_ref Prims.int_zero in let add_one e = - if e.issue_level = EError + let e1 = + let uu___ = fixup_issue_range e.issue_range in + { + issue_msg = (e.issue_msg); + issue_level = (e.issue_level); + issue_range = uu___; + issue_number = (e.issue_number); + issue_ctx = (e.issue_ctx) + } in + if e1.issue_level = EError then (let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang err_count in + let uu___2 = FStarC_Effect.op_Bang err_count in Prims.int_one + uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals err_count uu___1) + FStarC_Effect.op_Colon_Equals err_count uu___1) else (); - (match e.issue_level with - | EInfo when print -> print_issue e - | uu___2 when print && (FStarC_Compiler_Debug.any ()) -> print_issue e + (match e1.issue_level with + | EInfo when print -> print_issue e1 + | uu___2 when print && (FStarC_Debug.any ()) -> print_issue e1 | uu___2 -> let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang issues in e :: - uu___4 in - FStarC_Compiler_Effect.op_Colon_Equals issues uu___3); + let uu___4 = FStarC_Effect.op_Bang issues in e1 :: uu___4 in + FStarC_Effect.op_Colon_Equals issues uu___3); (let uu___3 = (FStarC_Options.defensive_abort ()) && - (e.issue_number = (FStar_Pervasives_Native.Some defensive_errno)) in + (e1.issue_number = (FStar_Pervasives_Native.Some defensive_errno)) in if uu___3 then failwith "Aborting due to --defensive abort" else ()) in - let count_errors uu___ = FStarC_Compiler_Effect.op_Bang err_count in + let count_errors uu___ = FStarC_Effect.op_Bang err_count in let report uu___ = let unique_issues = - let uu___1 = FStarC_Compiler_Effect.op_Bang issues in - FStarC_Compiler_Util.remove_dups (fun i0 -> fun i1 -> i0 = i1) uu___1 in + let uu___1 = FStarC_Effect.op_Bang issues in + FStarC_Util.remove_dups (fun i0 -> fun i1 -> i0 = i1) uu___1 in let sorted_unique_issues = - FStarC_Compiler_List.sortWith compare_issues unique_issues in - if print - then FStarC_Compiler_List.iter print_issue sorted_unique_issues - else (); + FStarC_List.sortWith compare_issues unique_issues in + if print then FStarC_List.iter print_issue sorted_unique_issues else (); sorted_unique_issues in let clear uu___ = - FStarC_Compiler_Effect.op_Colon_Equals issues []; - FStarC_Compiler_Effect.op_Colon_Equals err_count Prims.int_zero in + FStarC_Effect.op_Colon_Equals issues []; + FStarC_Effect.op_Colon_Equals err_count Prims.int_zero in let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_bool print in + let uu___2 = FStarC_Util.string_of_bool print in Prims.strcat uu___2 ")" in Prims.strcat "default handler (print=" uu___1 in { @@ -618,11 +681,11 @@ let (mk_default_handler : Prims.bool -> error_handler) = eh_clear = clear } let (default_handler : error_handler) = mk_default_handler true -let (current_handler : error_handler FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref default_handler +let (current_handler : error_handler FStarC_Effect.ref) = + FStarC_Util.mk_ref default_handler let (mk_issue : issue_level -> - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> + FStarC_Range_Type.range FStar_Pervasives_Native.option -> FStarC_Errors_Msg.error_message -> Prims.int FStar_Pervasives_Native.option -> Prims.string Prims.list -> issue) @@ -641,55 +704,49 @@ let (mk_issue : } let (get_err_count : unit -> Prims.int) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang current_handler in + let uu___1 = FStarC_Effect.op_Bang current_handler in uu___1.eh_count_errors () let (wrapped_eh_add_one : error_handler -> issue -> unit) = fun h -> fun issue1 -> - let issue2 = fixup_issue_range issue1 in - h.eh_add_one issue2; - if issue2.issue_level <> EInfo + h.eh_add_one issue1; + if issue1.issue_level <> EInfo then ((let uu___2 = - let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.abort_counter in + let uu___3 = FStarC_Effect.op_Bang FStarC_Options.abort_counter in uu___3 - Prims.int_one in - FStarC_Compiler_Effect.op_Colon_Equals FStarC_Options.abort_counter - uu___2); + FStarC_Effect.op_Colon_Equals FStarC_Options.abort_counter uu___2); (let uu___2 = - let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.abort_counter in + let uu___3 = FStarC_Effect.op_Bang FStarC_Options.abort_counter in uu___3 = Prims.int_zero in if uu___2 then failwith "Aborting due to --abort_on" else ())) else () let (add_one : issue -> unit) = fun issue1 -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang current_handler in + let uu___1 = FStarC_Effect.op_Bang current_handler in wrapped_eh_add_one uu___1 issue1) let (add_many : issue Prims.list -> unit) = fun issues -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang current_handler in + let uu___2 = FStarC_Effect.op_Bang current_handler in wrapped_eh_add_one uu___2 in - FStarC_Compiler_List.iter uu___1 issues) + FStarC_List.iter uu___1 issues) let (add_issues : issue Prims.list -> unit) = fun issues -> add_many issues let (report_all : unit -> issue Prims.list) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang current_handler in - uu___1.eh_report () + let uu___1 = FStarC_Effect.op_Bang current_handler in uu___1.eh_report () let (clear : unit -> unit) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang current_handler in - uu___1.eh_clear () + let uu___1 = FStarC_Effect.op_Bang current_handler in uu___1.eh_clear () let (set_handler : error_handler -> unit) = fun handler -> let issues = report_all () in clear (); - FStarC_Compiler_Effect.op_Colon_Equals current_handler handler; + FStarC_Effect.op_Colon_Equals current_handler handler; add_many issues type error_context_t = { @@ -719,19 +776,18 @@ let (__proj__Mkerror_context_t__item__set : fun projectee -> match projectee with | { push; pop; clear = clear1; get; set;_} -> set let (error_context : error_context_t) = - let ctxs = FStarC_Compiler_Util.mk_ref [] in + let ctxs = FStarC_Util.mk_ref [] in let push s = - let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang ctxs in s :: uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals ctxs uu___ in + let uu___ = let uu___1 = FStarC_Effect.op_Bang ctxs in s :: uu___1 in + FStarC_Effect.op_Colon_Equals ctxs uu___ in let pop s = - let uu___ = FStarC_Compiler_Effect.op_Bang ctxs in + let uu___ = FStarC_Effect.op_Bang ctxs in match uu___ with - | h::t -> (FStarC_Compiler_Effect.op_Colon_Equals ctxs t; h) + | h::t -> (FStarC_Effect.op_Colon_Equals ctxs t; h) | uu___1 -> failwith "cannot pop error prefix..." in - let clear1 uu___ = FStarC_Compiler_Effect.op_Colon_Equals ctxs [] in - let get uu___ = FStarC_Compiler_Effect.op_Bang ctxs in - let set c = FStarC_Compiler_Effect.op_Colon_Equals ctxs c in + let clear1 uu___ = FStarC_Effect.op_Colon_Equals ctxs [] in + let get uu___ = FStarC_Effect.op_Bang ctxs in + let set c = FStarC_Effect.op_Colon_Equals ctxs c in { push; pop; clear = clear1; get; set } let (get_ctx : unit -> Prims.string Prims.list) = fun uu___ -> error_context.get () @@ -743,10 +799,10 @@ let (maybe_add_backtrace : then let uu___1 = let uu___2 = FStarC_Errors_Msg.backtrace_doc () in [uu___2] in - FStarC_Compiler_List.op_At msg uu___1 + FStarC_List.op_At msg uu___1 else msg let (warn_unsafe_options : - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> + FStarC_Range_Type.range FStar_Pervasives_Native.option -> Prims.string -> unit) = fun rng_opt -> @@ -773,19 +829,18 @@ let (warn_unsafe_options : add_one uu___1 | uu___1 -> () let (set_option_warning_callback_range : - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> unit) = + FStarC_Range_Type.range FStar_Pervasives_Native.option -> unit) = fun ropt -> FStarC_Options.set_option_warning_callback (warn_unsafe_options ropt) let (uu___0 : (((Prims.string -> FStarC_Errors_Codes.error_setting Prims.list) -> unit) * (unit -> FStarC_Errors_Codes.error_setting Prims.list))) = - let parser_callback = - FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in - let error_flags = FStarC_Compiler_Util.smap_create (Prims.of_int (10)) in + let parser_callback = FStarC_Util.mk_ref FStar_Pervasives_Native.None in + let error_flags = FStarC_Util.smap_create (Prims.of_int (10)) in let set_error_flags uu___ = let parse s = - let uu___1 = FStarC_Compiler_Effect.op_Bang parser_callback in + let uu___1 = FStarC_Effect.op_Bang parser_callback in match uu___1 with | FStar_Pervasives_Native.None -> failwith "Callback for parsing warn_error strings is not set" @@ -796,24 +851,23 @@ let (uu___0 : match () with | () -> let r = parse we in - (FStarC_Compiler_Util.smap_add error_flags we + (FStarC_Util.smap_add error_flags we (FStar_Pervasives_Native.Some r); FStarC_Getopt.Success)) () with | Invalid_warn_error_setting msg -> - (FStarC_Compiler_Util.smap_add error_flags we - FStar_Pervasives_Native.None; + (FStarC_Util.smap_add error_flags we FStar_Pervasives_Native.None; FStarC_Getopt.Error ((Prims.strcat "Invalid --warn_error setting: " (Prims.strcat msg "\n")), "warn_error")) in let get_error_flags uu___ = let we = FStarC_Options.warn_error () in - let uu___1 = FStarC_Compiler_Util.smap_try_find error_flags we in + let uu___1 = FStarC_Util.smap_try_find error_flags we in match uu___1 with | FStar_Pervasives_Native.Some (FStar_Pervasives_Native.Some w) -> w | uu___2 -> FStarC_Errors_Codes.default_settings in let set_callbacks f = - FStarC_Compiler_Effect.op_Colon_Equals parser_callback + FStarC_Effect.op_Colon_Equals parser_callback (FStar_Pervasives_Native.Some f); FStarC_Options.set_error_flags_callback set_error_flags; FStarC_Options.set_option_warning_callback @@ -862,7 +916,7 @@ let (lookup : with_level level' | uu___1 -> with_level level) let (log_issue_ctx : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Errors_Codes.error_code * FStarC_Errors_Msg.error_message) -> Prims.string Prims.list -> unit) = @@ -872,24 +926,25 @@ let (log_issue_ctx : match uu___ with | (e, msg) -> let msg1 = maybe_add_backtrace msg in + let r1 = fixup_issue_range (FStar_Pervasives_Native.Some r) in let uu___1 = lookup e in (match uu___1 with | (uu___2, FStarC_Errors_Codes.CAlwaysError, errno1) -> add_one - (mk_issue EError (FStar_Pervasives_Native.Some r) msg1 + (mk_issue EError r1 msg1 (FStar_Pervasives_Native.Some errno1) ctx) | (uu___2, FStarC_Errors_Codes.CError, errno1) -> add_one - (mk_issue EError (FStar_Pervasives_Native.Some r) msg1 + (mk_issue EError r1 msg1 (FStar_Pervasives_Native.Some errno1) ctx) | (uu___2, FStarC_Errors_Codes.CWarning, errno1) -> add_one - (mk_issue EWarning (FStar_Pervasives_Native.Some r) msg1 + (mk_issue EWarning r1 msg1 (FStar_Pervasives_Native.Some errno1) ctx) | (uu___2, FStarC_Errors_Codes.CSilent, uu___3) -> () | (uu___2, FStarC_Errors_Codes.CFatal, errno1) -> let i = - mk_issue EError (FStar_Pervasives_Native.Some r) msg1 + mk_issue EError r1 msg1 (FStar_Pervasives_Native.Some errno1) ctx in let uu___3 = FStarC_Options.ide () in if uu___3 @@ -913,12 +968,12 @@ let info : fun uu___2 -> fun msg -> let rng = FStarC_Class_HasRange.pos uu___ r in + let rng1 = fixup_issue_range (FStar_Pervasives_Native.Some rng) in let msg1 = FStarC_Errors_Msg.to_doc_list uu___2 msg in let msg2 = maybe_add_backtrace msg1 in let ctx = get_ctx () in add_one - (mk_issue EInfo (FStar_Pervasives_Native.Some rng) msg2 - FStar_Pervasives_Native.None ctx) + (mk_issue EInfo rng1 msg2 FStar_Pervasives_Native.None ctx) let diag : 'posut . 'posut FStarC_Class_HasRange.hasRange -> @@ -930,7 +985,7 @@ let diag : fun uu___1 -> fun uu___2 -> fun msg -> - let uu___3 = FStarC_Compiler_Debug.any () in + let uu___3 = FStarC_Debug.any () in if uu___3 then info uu___ r () uu___2 msg else () let raise_error : 'a 'posut . @@ -946,14 +1001,18 @@ let raise_error : fun uu___2 -> fun msg -> let rng = FStarC_Class_HasRange.pos uu___ r in - let msg1 = FStarC_Errors_Msg.to_doc_list uu___2 msg in let uu___3 = - let uu___4 = - let uu___5 = maybe_add_backtrace msg1 in - let uu___6 = error_context.get () in - (e, uu___5, rng, uu___6) in - Error uu___4 in - FStarC_Compiler_Effect.raise uu___3 + fixup_issue_range (FStar_Pervasives_Native.Some rng) in + match uu___3 with + | FStar_Pervasives_Native.Some rng1 -> + let msg1 = FStarC_Errors_Msg.to_doc_list uu___2 msg in + let uu___4 = + let uu___5 = + let uu___6 = maybe_add_backtrace msg1 in + let uu___7 = error_context.get () in + (e, uu___6, rng1, uu___7) in + Error uu___5 in + FStarC_Effect.raise uu___4 let log_issue : 'posut . 'posut FStarC_Class_HasRange.hasRange -> @@ -981,7 +1040,7 @@ let raise_error0 : fun uu___1 -> fun msg -> raise_error FStarC_Class_HasRange.hasRange_range - FStarC_Compiler_Range_Type.dummyRange e () uu___1 msg + FStarC_Range_Type.dummyRange e () uu___1 msg let (log_issue0 : FStarC_Errors_Codes.error_code -> unit -> Obj.t FStarC_Errors_Msg.is_error_message -> Obj.t -> unit) @@ -991,18 +1050,17 @@ let (log_issue0 : fun uu___1 -> fun msg -> log_issue FStarC_Class_HasRange.hasRange_range - FStarC_Compiler_Range_Type.dummyRange e () uu___1 msg + FStarC_Range_Type.dummyRange e () uu___1 msg let diag0 : 't . 't FStarC_Errors_Msg.is_error_message -> 't -> unit = fun uu___ -> fun msg -> - diag FStarC_Class_HasRange.hasRange_range - FStarC_Compiler_Range_Type.dummyRange () (Obj.magic uu___) - (Obj.magic msg) + diag FStarC_Class_HasRange.hasRange_range FStarC_Range_Type.dummyRange + () (Obj.magic uu___) (Obj.magic msg) let (add_errors : error Prims.list -> unit) = fun errs -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___1 -> match uu___1 with | (e, msg, r, ctx) -> log_issue_ctx r (e, msg) ctx) errs) @@ -1011,9 +1069,9 @@ let (issue_of_exn : Prims.exn -> issue FStar_Pervasives_Native.option) = match e with | Error (e1, msg, r, ctx) -> let errno1 = let uu___ = lookup e1 in error_number uu___ in + let r1 = fixup_issue_range (FStar_Pervasives_Native.Some r) in FStar_Pervasives_Native.Some - (mk_issue EError (FStar_Pervasives_Native.Some r) msg - (FStar_Pervasives_Native.Some errno1) ctx) + (mk_issue EError r1 msg (FStar_Pervasives_Native.Some errno1) ctx) | uu___ -> FStar_Pervasives_Native.None let (err_exn : Prims.exn -> unit) = fun exn -> @@ -1023,14 +1081,14 @@ let (err_exn : Prims.exn -> unit) = (let uu___1 = issue_of_exn exn in match uu___1 with | FStar_Pervasives_Native.Some issue1 -> add_one issue1 - | FStar_Pervasives_Native.None -> FStarC_Compiler_Effect.raise exn) + | FStar_Pervasives_Native.None -> FStarC_Effect.raise exn) let (handleable : Prims.exn -> Prims.bool) = fun uu___ -> match uu___ with | Error uu___1 -> true | Stop -> true | uu___1 -> false let (stop_if_err : unit -> unit) = fun uu___ -> let uu___1 = let uu___2 = get_err_count () in uu___2 > Prims.int_zero in - if uu___1 then FStarC_Compiler_Effect.raise Stop else () + if uu___1 then FStarC_Effect.raise Stop else () let with_ctx : 'a . Prims.string -> (unit -> 'a) -> 'a = fun s -> fun f -> @@ -1045,7 +1103,7 @@ let with_ctx : 'a . Prims.string -> (unit -> 'a) -> 'a = match () with | () -> let uu___4 = f () in FStar_Pervasives.Inr uu___4) () with - | FStarC_Compiler_Effect.Failure msg -> + | FStarC_Effect.Failure msg -> let uu___4 = let uu___5 = let uu___6 = @@ -1055,13 +1113,13 @@ let with_ctx : 'a . Prims.string -> (unit -> 'a) -> 'a = [uu___8] in FStarC_Errors_Msg.rendermsg uu___7 in Prims.strcat msg uu___6 in - FStarC_Compiler_Effect.Failure uu___5 in + FStarC_Effect.Failure uu___5 in FStar_Pervasives.Inl uu___4 | ex -> FStar_Pervasives.Inl ex) in (let uu___2 = error_context.pop () in ()); (match r with | FStar_Pervasives.Inr r1 -> r1 - | FStar_Pervasives.Inl e -> FStarC_Compiler_Effect.raise e)) + | FStar_Pervasives.Inl e -> FStarC_Effect.raise e)) let with_ctx_if : 'a . Prims.bool -> Prims.string -> (unit -> 'a) -> 'a = fun b -> fun s -> fun f -> if b then with_ctx s f else f () let catch_errors_aux : @@ -1072,14 +1130,13 @@ let catch_errors_aux : = fun f -> let newh = mk_default_handler false in - let old = FStarC_Compiler_Effect.op_Bang current_handler in - FStarC_Compiler_Effect.op_Colon_Equals current_handler newh; + let old = FStarC_Effect.op_Bang current_handler in + FStarC_Effect.op_Colon_Equals current_handler newh; (let finally_restore uu___1 = let all_issues = newh.eh_report () in - FStarC_Compiler_Effect.op_Colon_Equals current_handler old; + FStarC_Effect.op_Colon_Equals current_handler old; (let uu___3 = - FStarC_Compiler_List.partition (fun i -> i.issue_level = EError) - all_issues in + FStarC_List.partition (fun i -> i.issue_level = EError) all_issues in match uu___3 with | (errs, rest) -> (errs, rest)) in let r = try @@ -1092,8 +1149,7 @@ let catch_errors_aux : if handleable uu___1 then (err_exn uu___1; FStar_Pervasives_Native.None) else - (let uu___2 = finally_restore () in - FStarC_Compiler_Effect.raise uu___1) in + (let uu___2 = finally_restore () in FStarC_Effect.raise uu___1) in let uu___1 = finally_restore () in match uu___1 with | (errs, rest) -> (errs, rest, r)) let no_ctx : 'a . (unit -> 'a) -> 'a = @@ -1108,9 +1164,9 @@ let catch_errors : match uu___ with | (errs, rest, r) -> ((let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang current_handler in + let uu___3 = FStarC_Effect.op_Bang current_handler in uu___3.eh_add_one in - FStarC_Compiler_List.iter uu___2 rest); + FStarC_List.iter uu___2 rest); (errs, r)) let catch_errors_and_ignore_rest : 'a . (unit -> 'a) -> (issue Prims.list * 'a FStar_Pervasives_Native.option) @@ -1120,11 +1176,11 @@ let catch_errors_and_ignore_rest : match uu___ with | (errs, rest, r) -> ((let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang current_handler in + let uu___3 = FStarC_Effect.op_Bang current_handler in uu___3.eh_add_one in let uu___3 = - FStarC_Compiler_List.filter (fun i -> i.issue_level = EInfo) rest in - FStarC_Compiler_List.iter uu___2 uu___3); + FStarC_List.filter (fun i -> i.issue_level = EInfo) rest in + FStarC_List.iter uu___2 uu___3); (errs, r)) let (find_multiset_discrepancy : Prims.int Prims.list -> @@ -1133,7 +1189,7 @@ let (find_multiset_discrepancy : = fun l1 -> fun l2 -> - let sort = FStarC_Compiler_List.sortWith (fun x -> fun y -> x - y) in + let sort = FStarC_List.sortWith (fun x -> fun y -> x - y) in let rec collect l = match l with | [] -> [] @@ -1167,7 +1223,7 @@ let (find_multiset_discrepancy : aux l11 l21 let raise_error_doc : 'a . - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Errors_Codes.error_code -> FStarC_Errors_Msg.error_message -> 'a = fun rng -> @@ -1177,7 +1233,7 @@ let raise_error_doc : (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic msg) let (log_issue_doc : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Errors_Codes.error_code -> FStarC_Errors_Msg.error_message -> unit) = fun rng -> @@ -1188,7 +1244,7 @@ let (log_issue_doc : (Obj.magic msg) let raise_error_text : 'a . - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Errors_Codes.error_code -> Prims.string -> 'a = fun rng -> @@ -1198,7 +1254,7 @@ let raise_error_text : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic msg) let (log_issue_text : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Errors_Codes.error_code -> Prims.string -> unit) = fun rng -> diff --git a/stage0/fstar-lib/generated/FStarC_Errors_Codes.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Errors_Codes.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Errors_Codes.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Errors_Codes.ml diff --git a/stage0/fstar-lib/generated/FStarC_Errors_Msg.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Errors_Msg.ml similarity index 89% rename from stage0/fstar-lib/generated/FStarC_Errors_Msg.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Errors_Msg.ml index 9edd2bec618..a0959ad5579 100644 --- a/stage0/fstar-lib/generated/FStarC_Errors_Msg.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Errors_Msg.ml @@ -20,7 +20,7 @@ let (vconcat : FStarC_Pprint.document Prims.list -> FStarC_Pprint.document) = fun ds -> match ds with | h::t -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun l -> fun r -> let uu___ = FStarC_Pprint.op_Hat_Hat FStarC_Pprint.hardline r in @@ -40,8 +40,7 @@ let (sublist : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map - (fun d -> FStarC_Pprint.op_Hat_Hat h d) ds in + FStarC_List.map (fun d -> FStarC_Pprint.op_Hat_Hat h d) ds in vconcat uu___3 in FStarC_Pprint.align uu___2 in FStarC_Pprint.op_Hat_Hat FStarC_Pprint.hardline uu___1 in @@ -53,14 +52,13 @@ let (mkmsg : Prims.string -> error_message) = fun s -> let uu___ = FStarC_Pprint.arbitrary_string s in [uu___] let (renderdoc : FStarC_Pprint.document -> Prims.string) = fun d -> - let one = FStarC_Compiler_Util.float_of_string "1.0" in + let one = FStarC_Util.float_of_string "1.0" in FStarC_Pprint.pretty_string one (Prims.of_int (80)) d let (backtrace_doc : unit -> FStarC_Pprint.document) = fun uu___ -> - let s = FStarC_Compiler_Util.stack_dump () in + let s = FStarC_Util.stack_dump () in let uu___1 = text "Stack trace:" in - let uu___2 = - FStarC_Pprint.arbitrary_string (FStarC_Compiler_Util.trim_string s) in + let uu___2 = FStarC_Pprint.arbitrary_string (FStarC_Util.trim_string s) in FStarC_Pprint.op_Hat_Slash_Hat uu___1 uu___2 let (subdoc' : Prims.bool -> FStarC_Pprint.document -> FStarC_Pprint.document) = @@ -89,7 +87,7 @@ let (rendermsg : error_message -> Prims.string) = fun ds -> let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun d -> let uu___2 = FStarC_Pprint.group d in subdoc uu___2) ds in FStarC_Pprint.concat uu___1 in renderdoc uu___ @@ -97,7 +95,7 @@ let (json_of_error_message : FStarC_Pprint.document Prims.list -> FStarC_Json.json) = fun err_msg -> let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun doc -> let uu___1 = renderdoc doc in FStarC_Json.JsonStr uu___1) err_msg in FStarC_Json.JsonList uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_Krml.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_Krml.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_Extraction_Krml.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_Krml.ml index 55f14b8bbc7..54bd00c2f89 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_Krml.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_Krml.ml @@ -658,11 +658,11 @@ let (record_string : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (f, s) -> Prims.strcat f (Prims.strcat " = " s)) fs in - FStarC_Compiler_String.concat "; " uu___2 in + FStarC_String.concat "; " uu___2 in Prims.strcat uu___1 "}" in Prims.strcat "{" uu___ let (ctor : @@ -944,7 +944,7 @@ let rec (pattern_to_doc : pattern -> FStarC_Pprint.document) = let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (s, p1) -> @@ -1298,7 +1298,7 @@ and (expr_to_doc : expr -> FStarC_Pprint.document) = let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (s, e1) -> let uu___6 = expr_to_doc e1 in fld s uu___6) @@ -1559,8 +1559,7 @@ let (find_name : env -> Prims.string -> name) = fun env1 -> fun x -> let uu___ = - FStarC_Compiler_List.tryFind (fun name1 -> name1.pretty = x) - env1.names in + FStarC_List.tryFind (fun name1 -> name1.pretty = x) env1.names in match uu___ with | FStar_Pervasives_Native.Some name1 -> name1 | FStar_Pervasives_Native.None -> @@ -1572,13 +1571,12 @@ let (find : env -> Prims.string -> Prims.int) = (fun uu___ -> match () with | () -> - FStarC_Compiler_List.index (fun name1 -> name1.pretty = x) - env1.names) () + FStarC_List.index (fun name1 -> name1.pretty = x) env1.names) + () with | uu___ -> let uu___1 = - FStarC_Compiler_Util.format1 - "Internal error: name not found %s\n" x in + FStarC_Util.format1 "Internal error: name not found %s\n" x in failwith uu___1 let (find_t : env -> Prims.string -> Prims.int) = fun env1 -> @@ -1586,20 +1584,18 @@ let (find_t : env -> Prims.string -> Prims.int) = try (fun uu___ -> match () with - | () -> - FStarC_Compiler_List.index (fun name1 -> name1 = x) - env1.names_t) () + | () -> FStarC_List.index (fun name1 -> name1 = x) env1.names_t) + () with | uu___ -> let uu___1 = - FStarC_Compiler_Util.format1 - "Internal error: name not found %s\n" x in + FStarC_Util.format1 "Internal error: name not found %s\n" x in failwith uu___1 let (add_binders : env -> FStarC_Extraction_ML_Syntax.mlbinder Prims.list -> env) = fun env1 -> fun bs -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun uu___ -> match uu___ with @@ -1620,7 +1616,7 @@ let (list_elements : let (translate_flags : FStarC_Extraction_ML_Syntax.meta Prims.list -> flag Prims.list) = fun flags -> - FStarC_Compiler_List.choose + FStarC_List.choose (fun uu___ -> match uu___ with | FStarC_Extraction_ML_Syntax.Private -> @@ -1660,7 +1656,7 @@ let (translate_cc : = fun flags -> let uu___ = - FStarC_Compiler_List.choose + FStarC_List.choose (fun uu___1 -> match uu___1 with | FStarC_Extraction_ML_Syntax.CCConv s -> @@ -1685,108 +1681,100 @@ let (uu___is_NotSupportedByKrmlExtension : Prims.exn -> Prims.bool) = type translate_type_without_decay_t = env -> FStarC_Extraction_ML_Syntax.mlty -> typ let (ref_translate_type_without_decay : - translate_type_without_decay_t FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref + translate_type_without_decay_t FStarC_Effect.ref) = + FStarC_Util.mk_ref (fun uu___ -> - fun uu___1 -> FStarC_Compiler_Effect.raise NotSupportedByKrmlExtension) + fun uu___1 -> FStarC_Effect.raise NotSupportedByKrmlExtension) let (register_pre_translate_type_without_decay : translate_type_without_decay_t -> unit) = fun f -> - let before = - FStarC_Compiler_Effect.op_Bang ref_translate_type_without_decay in + let before = FStarC_Effect.op_Bang ref_translate_type_without_decay in let after e t = try (fun uu___ -> match () with | () -> f e t) () with | NotSupportedByKrmlExtension -> before e t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_type_without_decay - after + FStarC_Effect.op_Colon_Equals ref_translate_type_without_decay after let (register_post_translate_type_without_decay : translate_type_without_decay_t -> unit) = fun f -> - let before = - FStarC_Compiler_Effect.op_Bang ref_translate_type_without_decay in + let before = FStarC_Effect.op_Bang ref_translate_type_without_decay in let after e t = try (fun uu___ -> match () with | () -> before e t) () with | NotSupportedByKrmlExtension -> f e t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_type_without_decay - after + FStarC_Effect.op_Colon_Equals ref_translate_type_without_decay after let (translate_type_without_decay : env -> FStarC_Extraction_ML_Syntax.mlty -> typ) = fun env1 -> fun t -> - let uu___ = - FStarC_Compiler_Effect.op_Bang ref_translate_type_without_decay in + let uu___ = FStarC_Effect.op_Bang ref_translate_type_without_decay in uu___ env1 t type translate_type_t = env -> FStarC_Extraction_ML_Syntax.mlty -> typ -let (ref_translate_type : translate_type_t FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref +let (ref_translate_type : translate_type_t FStarC_Effect.ref) = + FStarC_Util.mk_ref (fun uu___ -> - fun uu___1 -> FStarC_Compiler_Effect.raise NotSupportedByKrmlExtension) + fun uu___1 -> FStarC_Effect.raise NotSupportedByKrmlExtension) let (register_pre_translate_type : translate_type_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_translate_type in + let before = FStarC_Effect.op_Bang ref_translate_type in let after e t = try (fun uu___ -> match () with | () -> f e t) () with | NotSupportedByKrmlExtension -> before e t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_type after + FStarC_Effect.op_Colon_Equals ref_translate_type after let (register_post_translate_type : translate_type_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_translate_type in + let before = FStarC_Effect.op_Bang ref_translate_type in let after e t = try (fun uu___ -> match () with | () -> before e t) () with | NotSupportedByKrmlExtension -> f e t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_type after + FStarC_Effect.op_Colon_Equals ref_translate_type after let (translate_type : env -> FStarC_Extraction_ML_Syntax.mlty -> typ) = fun env1 -> fun t -> - let uu___ = FStarC_Compiler_Effect.op_Bang ref_translate_type in - uu___ env1 t + let uu___ = FStarC_Effect.op_Bang ref_translate_type in uu___ env1 t type translate_expr_t = env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr -let (ref_translate_expr : translate_expr_t FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref +let (ref_translate_expr : translate_expr_t FStarC_Effect.ref) = + FStarC_Util.mk_ref (fun uu___ -> - fun uu___1 -> FStarC_Compiler_Effect.raise NotSupportedByKrmlExtension) + fun uu___1 -> FStarC_Effect.raise NotSupportedByKrmlExtension) let (register_pre_translate_expr : translate_expr_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_translate_expr in + let before = FStarC_Effect.op_Bang ref_translate_expr in let after e t = try (fun uu___ -> match () with | () -> f e t) () with | NotSupportedByKrmlExtension -> before e t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_expr after + FStarC_Effect.op_Colon_Equals ref_translate_expr after let (register_post_translate_expr : translate_expr_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_translate_expr in + let before = FStarC_Effect.op_Bang ref_translate_expr in let after e t = try (fun uu___ -> match () with | () -> before e t) () with | NotSupportedByKrmlExtension -> f e t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_expr after + FStarC_Effect.op_Colon_Equals ref_translate_expr after let (translate_expr : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = fun env1 -> fun e -> - let uu___ = FStarC_Compiler_Effect.op_Bang ref_translate_expr in - uu___ env1 e + let uu___ = FStarC_Effect.op_Bang ref_translate_expr in uu___ env1 e type translate_type_decl_t = env -> FStarC_Extraction_ML_Syntax.one_mltydecl -> decl FStar_Pervasives_Native.option -let (ref_translate_type_decl : - translate_type_decl_t FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref +let (ref_translate_type_decl : translate_type_decl_t FStarC_Effect.ref) = + FStarC_Util.mk_ref (fun uu___ -> - fun uu___1 -> FStarC_Compiler_Effect.raise NotSupportedByKrmlExtension) + fun uu___1 -> FStarC_Effect.raise NotSupportedByKrmlExtension) let (register_pre_translate_type_decl : translate_type_decl_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_translate_type_decl in + let before = FStarC_Effect.op_Bang ref_translate_type_decl in let after e t = try (fun uu___ -> match () with | () -> f e t) () with | NotSupportedByKrmlExtension -> before e t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_type_decl after + FStarC_Effect.op_Colon_Equals ref_translate_type_decl after let (register_post_translate_type_decl : translate_type_decl_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_translate_type_decl in + let before = FStarC_Effect.op_Bang ref_translate_type_decl in let after e t = try (fun uu___ -> match () with | () -> before e t) () with | NotSupportedByKrmlExtension -> f e t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_type_decl after + FStarC_Effect.op_Colon_Equals ref_translate_type_decl after let (translate_type_decl : env -> FStarC_Extraction_ML_Syntax.one_mltydecl -> @@ -1795,11 +1783,11 @@ let (translate_type_decl : fun env1 -> fun ty -> if - FStarC_Compiler_List.mem FStarC_Extraction_ML_Syntax.NoExtract + FStarC_List.mem FStarC_Extraction_ML_Syntax.NoExtract ty.FStarC_Extraction_ML_Syntax.tydecl_meta then FStar_Pervasives_Native.None else - (let uu___1 = FStarC_Compiler_Effect.op_Bang ref_translate_type_decl in + (let uu___1 = FStarC_Effect.op_Bang ref_translate_type_decl in uu___1 env1 ty) let rec (translate_type_without_decay' : env -> FStarC_Extraction_ML_Syntax.mlty -> typ) = @@ -1825,10 +1813,10 @@ let rec (translate_type_without_decay' : uu___ = "Prims.bool" -> TBool | FStarC_Extraction_ML_Syntax.MLTY_Named ([], ("FStar"::m::[], "t")) when is_machine_int m -> - let uu___ = FStarC_Compiler_Util.must (mk_width m) in TInt uu___ + let uu___ = FStarC_Util.must (mk_width m) in TInt uu___ | FStarC_Extraction_ML_Syntax.MLTY_Named ([], ("FStar"::m::[], "t'")) when is_machine_int m -> - let uu___ = FStarC_Compiler_Util.must (mk_width m) in TInt uu___ + let uu___ = FStarC_Util.must (mk_width m) in TInt uu___ | FStarC_Extraction_ML_Syntax.MLTY_Named ([], p) when let uu___ = FStarC_Extraction_ML_Syntax.string_of_mlpath p in uu___ = "FStar.Monotonic.HyperStack.mem" -> TUnit @@ -1965,30 +1953,28 @@ let rec (translate_type_without_decay' : TQualified (path, type_name) | FStarC_Extraction_ML_Syntax.MLTY_Named (args, (ns, t1)) when ((ns = ["Prims"]) || (ns = ["FStar"; "Pervasives"; "Native"])) && - (FStarC_Compiler_Util.starts_with t1 "tuple") + (FStarC_Util.starts_with t1 "tuple") -> let uu___ = - FStarC_Compiler_List.map (translate_type_without_decay env1) args in + FStarC_List.map (translate_type_without_decay env1) args in TTuple uu___ | FStarC_Extraction_ML_Syntax.MLTY_Named (args, lid) -> - if (FStarC_Compiler_List.length args) > Prims.int_zero + if (FStarC_List.length args) > Prims.int_zero then let uu___ = let uu___1 = - FStarC_Compiler_List.map (translate_type_without_decay env1) - args in + FStarC_List.map (translate_type_without_decay env1) args in (lid, uu___1) in TApp uu___ else TQualified lid | FStarC_Extraction_ML_Syntax.MLTY_Tuple ts -> - let uu___ = - FStarC_Compiler_List.map (translate_type_without_decay env1) ts in + let uu___ = FStarC_List.map (translate_type_without_decay env1) ts in TTuple uu___ and (translate_type' : env -> FStarC_Extraction_ML_Syntax.mlty -> typ) = fun env1 -> fun t -> translate_type_without_decay env1 t and (translate_binders : env -> FStarC_Extraction_ML_Syntax.mlbinder Prims.list -> binder Prims.list) - = fun env1 -> fun bs -> FStarC_Compiler_List.map (translate_binder env1) bs + = fun env1 -> fun bs -> FStarC_List.map (translate_binder env1) bs and (translate_binder : env -> FStarC_Extraction_ML_Syntax.mlbinder -> binder) = fun env1 -> @@ -2010,15 +1996,13 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = | FStarC_Extraction_ML_Syntax.MLE_Name ("FStar"::m::[], op1) when (is_machine_int m) && (is_op op1) -> let uu___ = - let uu___1 = FStarC_Compiler_Util.must (mk_op op1) in - let uu___2 = FStarC_Compiler_Util.must (mk_width m) in - (uu___1, uu___2) in + let uu___1 = FStarC_Util.must (mk_op op1) in + let uu___2 = FStarC_Util.must (mk_width m) in (uu___1, uu___2) in EOp uu___ | FStarC_Extraction_ML_Syntax.MLE_Name ("Prims"::[], op1) when is_bool_op op1 -> let uu___ = - let uu___1 = FStarC_Compiler_Util.must (mk_bool_op op1) in - (uu___1, Bool) in + let uu___1 = FStarC_Util.must (mk_bool_op op1) in (uu___1, Bool) in EOp uu___ | FStarC_Extraction_ML_Syntax.MLE_Name n -> EQualified n | FStarC_Extraction_ML_Syntax.MLE_Let @@ -2340,7 +2324,7 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = let uu___5 = let uu___6 = let uu___7 = list_elements e2 in - FStarC_Compiler_List.map (translate_expr env1) uu___7 in + FStarC_List.map (translate_expr env1) uu___7 in (Stack, uu___6) in EBufCreateL uu___5 | FStarC_Extraction_ML_Syntax.MLE_App @@ -2365,7 +2349,7 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = let uu___5 = let uu___6 = let uu___7 = list_elements e2 in - FStarC_Compiler_List.map (translate_expr env1) uu___7 in + FStarC_List.map (translate_expr env1) uu___7 in (Eternal, uu___6) in EBufCreateL uu___5 | FStarC_Extraction_ML_Syntax.MLE_App @@ -2943,8 +2927,8 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = FStarC_Extraction_ML_Syntax.loc = uu___1;_}, args) when (is_machine_int m) && (is_op op1) -> - let uu___2 = FStarC_Compiler_Util.must (mk_width m) in - let uu___3 = FStarC_Compiler_Util.must (mk_op op1) in + let uu___2 = FStarC_Util.must (mk_width m) in + let uu___3 = FStarC_Util.must (mk_op op1) in mk_op_app env1 uu___2 uu___3 args | FStarC_Extraction_ML_Syntax.MLE_App ({ @@ -2954,7 +2938,7 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = FStarC_Extraction_ML_Syntax.loc = uu___1;_}, args) when is_bool_op op1 -> - let uu___2 = FStarC_Compiler_Util.must (mk_bool_op op1) in + let uu___2 = FStarC_Util.must (mk_bool_op op1) in mk_op_app env1 Bool uu___2 args | FStarC_Extraction_ML_Syntax.MLE_App ({ @@ -2972,8 +2956,7 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = FStarC_Extraction_ML_Syntax.loc = uu___3;_}::[]) when is_machine_int m -> let uu___4 = - let uu___5 = FStarC_Compiler_Util.must (mk_width m) in - (uu___5, c) in + let uu___5 = FStarC_Util.must (mk_width m) in (uu___5, c) in EConstant uu___4 | FStarC_Extraction_ML_Syntax.MLE_App ({ @@ -2991,8 +2974,7 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = FStarC_Extraction_ML_Syntax.loc = uu___3;_}::[]) when is_machine_int m -> let uu___4 = - let uu___5 = FStarC_Compiler_Util.must (mk_width m) in - (uu___5, c) in + let uu___5 = FStarC_Util.must (mk_width m) in (uu___5, c) in EConstant uu___4 | FStarC_Extraction_ML_Syntax.MLE_App ({ @@ -3074,10 +3056,10 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = (FStarC_Extraction_ML_Syntax.MLC_String sbefore), FStarC_Extraction_ML_Syntax.MLE_Const (FStarC_Extraction_ML_Syntax.MLC_String safter)) -> - (if FStarC_Compiler_Util.contains sbefore "*/" + (if FStarC_Util.contains sbefore "*/" then failwith "Before Comment contains end-of-comment marker" else (); - if FStarC_Compiler_Util.contains safter "*/" + if FStarC_Util.contains safter "*/" then failwith "After Comment contains end-of-comment marker" else (); (let uu___11 = @@ -3101,7 +3083,7 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = (match e1 with | FStarC_Extraction_ML_Syntax.MLE_Const (FStarC_Extraction_ML_Syntax.MLC_String s) -> - (if FStarC_Compiler_Util.contains s "*/" + (if FStarC_Util.contains s "*/" then failwith "Standalone Comment contains end-of-comment marker" @@ -3137,72 +3119,63 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = arg::[]) -> let is_known_type = - (((((((FStarC_Compiler_Util.starts_with c "uint8") || - (FStarC_Compiler_Util.starts_with c "uint16")) - || (FStarC_Compiler_Util.starts_with c "uint32")) - || (FStarC_Compiler_Util.starts_with c "uint64")) - || (FStarC_Compiler_Util.starts_with c "int8")) - || (FStarC_Compiler_Util.starts_with c "int16")) - || (FStarC_Compiler_Util.starts_with c "int32")) - || (FStarC_Compiler_Util.starts_with c "int64") in - if (FStarC_Compiler_Util.ends_with c "uint64") && is_known_type + (((((((FStarC_Util.starts_with c "uint8") || + (FStarC_Util.starts_with c "uint16")) + || (FStarC_Util.starts_with c "uint32")) + || (FStarC_Util.starts_with c "uint64")) + || (FStarC_Util.starts_with c "int8")) + || (FStarC_Util.starts_with c "int16")) + || (FStarC_Util.starts_with c "int32")) + || (FStarC_Util.starts_with c "int64") in + if (FStarC_Util.ends_with c "uint64") && is_known_type then let uu___2 = let uu___3 = translate_expr env1 arg in (uu___3, (TInt UInt64)) in ECast uu___2 else - if (FStarC_Compiler_Util.ends_with c "uint32") && is_known_type + if (FStarC_Util.ends_with c "uint32") && is_known_type then (let uu___3 = let uu___4 = translate_expr env1 arg in (uu___4, (TInt UInt32)) in ECast uu___3) else - if (FStarC_Compiler_Util.ends_with c "uint16") && is_known_type + if (FStarC_Util.ends_with c "uint16") && is_known_type then (let uu___4 = let uu___5 = translate_expr env1 arg in (uu___5, (TInt UInt16)) in ECast uu___4) else - if - (FStarC_Compiler_Util.ends_with c "uint8") && is_known_type + if (FStarC_Util.ends_with c "uint8") && is_known_type then (let uu___5 = let uu___6 = translate_expr env1 arg in (uu___6, (TInt UInt8)) in ECast uu___5) else - if - (FStarC_Compiler_Util.ends_with c "int64") && - is_known_type + if (FStarC_Util.ends_with c "int64") && is_known_type then (let uu___6 = let uu___7 = translate_expr env1 arg in (uu___7, (TInt Int64)) in ECast uu___6) else - if - (FStarC_Compiler_Util.ends_with c "int32") && - is_known_type + if (FStarC_Util.ends_with c "int32") && is_known_type then (let uu___7 = let uu___8 = translate_expr env1 arg in (uu___8, (TInt Int32)) in ECast uu___7) else - if - (FStarC_Compiler_Util.ends_with c "int16") && - is_known_type + if (FStarC_Util.ends_with c "int16") && is_known_type then (let uu___8 = let uu___9 = translate_expr env1 arg in (uu___9, (TInt Int16)) in ECast uu___8) else - if - (FStarC_Compiler_Util.ends_with c "int8") && - is_known_type + if (FStarC_Util.ends_with c "int8") && is_known_type then (let uu___9 = let uu___10 = translate_expr env1 arg in @@ -3267,14 +3240,13 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = | FStarC_Extraction_ML_Syntax.MLE_App (head, args) -> let uu___ = let uu___1 = translate_expr env1 head in - let uu___2 = FStarC_Compiler_List.map (translate_expr env1) args in + let uu___2 = FStarC_List.map (translate_expr env1) args in (uu___1, uu___2) in EApp uu___ | FStarC_Extraction_ML_Syntax.MLE_TApp (head, ty_args) -> let uu___ = let uu___1 = translate_expr env1 head in - let uu___2 = - FStarC_Compiler_List.map (translate_type env1) ty_args in + let uu___2 = FStarC_List.map (translate_type env1) ty_args in (uu___1, uu___2) in ETypApp uu___ | FStarC_Extraction_ML_Syntax.MLE_Coerce (e1, t_from, t_to) -> @@ -3286,7 +3258,7 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = let uu___2 = let uu___3 = assert_lid env1 e.FStarC_Extraction_ML_Syntax.mlty in let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (field, expr1) -> @@ -3304,26 +3276,26 @@ and (translate_expr' : env -> FStarC_Extraction_ML_Syntax.mlexpr -> expr) = let uu___1 = let uu___2 = FStarC_Extraction_ML_Code.string_of_mlexpr ([], "") e in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "todo: translate_expr [MLE_Let] (expr is: %s)" uu___2 in failwith uu___1 | FStarC_Extraction_ML_Syntax.MLE_App (head, uu___) -> let uu___1 = let uu___2 = FStarC_Extraction_ML_Code.string_of_mlexpr ([], "") head in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "todo: translate_expr [MLE_App] (head is: %s)" uu___2 in failwith uu___1 | FStarC_Extraction_ML_Syntax.MLE_Seq seqs -> - let uu___ = FStarC_Compiler_List.map (translate_expr env1) seqs in + let uu___ = FStarC_List.map (translate_expr env1) seqs in ESequence uu___ | FStarC_Extraction_ML_Syntax.MLE_Tuple es -> - let uu___ = FStarC_Compiler_List.map (translate_expr env1) es in + let uu___ = FStarC_List.map (translate_expr env1) es in ETuple uu___ | FStarC_Extraction_ML_Syntax.MLE_CTor ((uu___, cons), es) -> let uu___1 = let uu___2 = assert_lid env1 e.FStarC_Extraction_ML_Syntax.mlty in - let uu___3 = FStarC_Compiler_List.map (translate_expr env1) es in + let uu___3 = FStarC_List.map (translate_expr env1) es in (uu___2, cons, uu___3) in ECons uu___1 | FStarC_Extraction_ML_Syntax.MLE_Fun (bs, body) -> @@ -3356,17 +3328,17 @@ and (assert_lid : env -> FStarC_Extraction_ML_Syntax.mlty -> typ) = fun t -> match t with | FStarC_Extraction_ML_Syntax.MLTY_Named (ts, lid) -> - if (FStarC_Compiler_List.length ts) > Prims.int_zero + if (FStarC_List.length ts) > Prims.int_zero then let uu___ = - let uu___1 = FStarC_Compiler_List.map (translate_type env1) ts in + let uu___1 = FStarC_List.map (translate_type env1) ts in (lid, uu___1) in TApp uu___ else TQualified lid | uu___ -> let uu___1 = let uu___2 = FStarC_Extraction_ML_Code.string_of_mlty ([], "") t in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "invalid argument: expected MLTY_Named, got %s" uu___2 in failwith uu___1 and (translate_branches : @@ -3377,8 +3349,7 @@ and (translate_branches : (pattern * expr) Prims.list) = fun env1 -> - fun branches1 -> - FStarC_Compiler_List.map (translate_branch env1) branches1 + fun branches1 -> FStarC_List.map (translate_branch env1) branches1 and (translate_branch : env -> (FStarC_Extraction_ML_Syntax.mlpattern * @@ -3444,7 +3415,7 @@ and (translate_pat : (env2, (PVar { name = "_"; typ = TAny; mut = false; meta = [] })) | FStarC_Extraction_ML_Syntax.MLP_CTor ((uu___, cons), ps) -> let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun p1 -> match uu___2 with @@ -3453,11 +3424,10 @@ and (translate_pat : (match uu___3 with | (env3, p2) -> (env3, (p2 :: acc)))) (env1, []) ps in (match uu___1 with - | (env2, ps1) -> - (env2, (PCons (cons, (FStarC_Compiler_List.rev ps1))))) + | (env2, ps1) -> (env2, (PCons (cons, (FStarC_List.rev ps1))))) | FStarC_Extraction_ML_Syntax.MLP_Record (uu___, ps) -> let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun uu___3 -> match (uu___2, uu___3) with @@ -3467,10 +3437,10 @@ and (translate_pat : | (env3, p2) -> (env3, ((field, p2) :: acc)))) (env1, []) ps in (match uu___1 with - | (env2, ps1) -> (env2, (PRecord (FStarC_Compiler_List.rev ps1)))) + | (env2, ps1) -> (env2, (PRecord (FStarC_List.rev ps1)))) | FStarC_Extraction_ML_Syntax.MLP_Tuple ps -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun p1 -> match uu___1 with @@ -3479,7 +3449,7 @@ and (translate_pat : (match uu___2 with | (env3, p2) -> (env3, (p2 :: acc)))) (env1, []) ps in (match uu___ with - | (env2, ps1) -> (env2, (PTuple (FStarC_Compiler_List.rev ps1)))) + | (env2, ps1) -> (env2, (PTuple (FStarC_List.rev ps1)))) | FStarC_Extraction_ML_Syntax.MLP_Const uu___ -> failwith "todo: translate_pat [MLP_Const]" | FStarC_Extraction_ML_Syntax.MLP_Branch uu___ -> @@ -3491,21 +3461,21 @@ and (translate_constant : FStarC_Extraction_ML_Syntax.mlconstant -> expr) = | FStarC_Extraction_ML_Syntax.MLC_Bool b -> EBool b | FStarC_Extraction_ML_Syntax.MLC_String s -> ((let uu___1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun c1 -> c1 = (FStar_Char.char_of_int Prims.int_zero)) (FStar_String.list_of_string s) in if uu___1 then let uu___2 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Refusing to translate a string literal that contains a null character: %s" s in failwith uu___2 else ()); EString s) | FStarC_Extraction_ML_Syntax.MLC_Char c1 -> - let i = FStarC_Compiler_Util.int_of_char c1 in - let s = FStarC_Compiler_Util.string_of_int i in + let i = FStarC_Util.int_of_char c1 in + let s = FStarC_Util.string_of_int i in let c2 = EConstant (CInt, s) in let char_of_int = EQualified (["FStar"; "Char"], "char_of_int") in EApp (char_of_int, [c2]) @@ -3530,7 +3500,7 @@ and (mk_op_app : fun op1 -> fun args -> let uu___ = - let uu___1 = FStarC_Compiler_List.map (translate_expr env1) args in + let uu___1 = FStarC_List.map (translate_expr env1) args in ((EOp (op1, w)), uu___1) in EApp uu___ let (translate_type_decl' : @@ -3552,7 +3522,7 @@ let (translate_type_decl' : -> let name2 = ((env1.module_name), name1) in let env2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env3 -> fun uu___1 -> match uu___1 with @@ -3563,14 +3533,13 @@ let (translate_type_decl' : -> extend_t env3 ty_param_name) env1 args in if assumed && - (FStarC_Compiler_List.mem FStarC_Extraction_ML_Syntax.CAbstract - flags) + (FStarC_List.mem FStarC_Extraction_ML_Syntax.CAbstract flags) then FStar_Pervasives_Native.Some (DTypeAbstractStruct name2) else if assumed then (let name3 = FStarC_Extraction_ML_Syntax.string_of_mlpath name2 in - FStarC_Compiler_Util.print1_warning + FStarC_Util.print1_warning "Not extracting type definition %s to KaRaMeL (assumed type)\n" name3; FStar_Pervasives_Native.None) @@ -3579,8 +3548,7 @@ let (translate_type_decl' : let uu___4 = let uu___5 = translate_flags flags in let uu___6 = translate_type env2 t in - (name2, uu___5, (FStarC_Compiler_List.length args), - uu___6) in + (name2, uu___5, (FStarC_List.length args), uu___6) in DTypeAlias uu___4 in FStar_Pervasives_Native.Some uu___3) | { FStarC_Extraction_ML_Syntax.tydecl_assumed = uu___; @@ -3594,7 +3562,7 @@ let (translate_type_decl' : -> let name2 = ((env1.module_name), name1) in let env2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env3 -> fun uu___2 -> match uu___2 with @@ -3607,7 +3575,7 @@ let (translate_type_decl' : let uu___3 = let uu___4 = translate_flags flags in let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> match uu___6 with | (f, t) -> @@ -3615,7 +3583,7 @@ let (translate_type_decl' : let uu___8 = translate_type_without_decay env2 t in (uu___8, false) in (f, uu___7)) fields in - (name2, uu___4, (FStarC_Compiler_List.length args), uu___5) in + (name2, uu___4, (FStarC_List.length args), uu___5) in DTypeFlat uu___3 in FStar_Pervasives_Native.Some uu___2 | { FStarC_Extraction_ML_Syntax.tydecl_assumed = uu___; @@ -3631,16 +3599,16 @@ let (translate_type_decl' : let flags1 = translate_flags flags in let env2 = let uu___2 = FStarC_Extraction_ML_Syntax.ty_param_names args in - FStarC_Compiler_List.fold_left extend_t env1 uu___2 in + FStarC_List.fold_left extend_t env1 uu___2 in let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (cons, ts) -> let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (name3, t) -> @@ -3650,7 +3618,7 @@ let (translate_type_decl' : (uu___9, false) in (name3, uu___8)) ts in (cons, uu___6)) branches1 in - (name2, flags1, (FStarC_Compiler_List.length args), uu___4) in + (name2, flags1, (FStarC_List.length args), uu___4) in DTypeVariant uu___3 in FStar_Pervasives_Native.Some uu___2 | { FStarC_Extraction_ML_Syntax.tydecl_assumed = uu___; @@ -3662,7 +3630,7 @@ let (translate_type_decl' : ((let uu___6 = let uu___7 = let uu___8 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Error extracting type definition %s to KaRaMeL." name1 in FStarC_Errors_Msg.text uu___8 in [uu___7] in @@ -3688,7 +3656,7 @@ let (translate_let' : FStarC_Extraction_ML_Syntax.mllb_attrs = uu___1; FStarC_Extraction_ML_Syntax.mllb_meta = meta; FStarC_Extraction_ML_Syntax.print_typ = uu___2;_} when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_Extraction_ML_Syntax.Assumed -> true @@ -3698,7 +3666,7 @@ let (translate_let' : let arg_names = match e.FStarC_Extraction_ML_Syntax.expr with | FStarC_Extraction_ML_Syntax.MLE_Fun (bs, uu___3) -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | { @@ -3709,7 +3677,7 @@ let (translate_let' : uu___6;_} -> mlbinder_name) bs | uu___3 -> [] in - if (FStarC_Compiler_List.length tvars) = Prims.int_zero + if (FStarC_List.length tvars) = Prims.int_zero then let uu___3 = let uu___4 = @@ -3722,7 +3690,7 @@ let (translate_let' : else ((let uu___5 = FStarC_Extraction_ML_Syntax.string_of_mlpath name2 in - FStarC_Compiler_Util.print1_warning + FStarC_Util.print1_warning "Not extracting %s to KaRaMeL (polymorphic assumes are not supported)\n" uu___5); FStar_Pervasives_Native.None) @@ -3739,9 +3707,7 @@ let (translate_let' : FStarC_Extraction_ML_Syntax.mllb_attrs = uu___3; FStarC_Extraction_ML_Syntax.mllb_meta = meta; FStarC_Extraction_ML_Syntax.print_typ = uu___4;_} -> - if - FStarC_Compiler_List.mem FStarC_Extraction_ML_Syntax.NoExtract - meta + if FStarC_List.mem FStarC_Extraction_ML_Syntax.NoExtract meta then FStar_Pervasives_Native.None else (let env2 = @@ -3751,7 +3717,7 @@ let (translate_let' : let env3 = let uu___6 = FStarC_Extraction_ML_Syntax.ty_param_names tvars in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env4 -> fun name2 -> extend_t env4 name2) env2 uu___6 in let rec find_return_type eff i uu___6 = match uu___6 with @@ -3762,7 +3728,7 @@ let (translate_let' : let name2 = ((env3.module_name), name1) in let uu___6 = find_return_type FStarC_Extraction_ML_Syntax.E_PURE - (FStarC_Compiler_List.length args) t0 in + (FStarC_List.length args) t0 in match uu___6 with | (i, eff, t) -> (if i > Prims.int_zero @@ -3771,7 +3737,7 @@ let (translate_let' : "function type annotation has less arrows than the number of arguments; please mark the return type abbreviation as inline_for_extraction" in let uu___8 = FStarC_Extraction_ML_Syntax.string_of_mlpath name2 in - FStarC_Compiler_Util.print2_warning + FStarC_Util.print2_warning "Not extracting %s to KaRaMeL (%s)\n" uu___8 msg) else (); (let t1 = translate_type env3 t in @@ -3794,19 +3760,18 @@ let (translate_let' : let body1 = translate_expr env4 body in FStar_Pervasives_Native.Some (DFunction - (cc1, meta1, - (FStarC_Compiler_List.length tvars), t1, - name2, binders, body1))) () + (cc1, meta1, (FStarC_List.length tvars), + t1, name2, binders, body1))) () with | uu___8 -> - let msg = FStarC_Compiler_Util.print_exn uu___8 in + let msg = FStarC_Util.print_exn uu___8 in ((let uu___10 = let uu___11 = let uu___12 = let uu___13 = FStarC_Extraction_ML_Syntax.string_of_mlpath name2 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Error while extracting %s to KaRaMeL." uu___13 in FStarC_Errors_Msg.text uu___12 in @@ -3826,8 +3791,7 @@ let (translate_let' : "This function was not extracted:\n" msg in FStar_Pervasives_Native.Some (DFunction - (cc1, meta1, - (FStarC_Compiler_List.length tvars), t1, + (cc1, meta1, (FStarC_List.length tvars), t1, name2, binders, (EAbortS msg1)))))))) | { FStarC_Extraction_ML_Syntax.mllb_name = name1; FStarC_Extraction_ML_Syntax.mllb_tysc = @@ -3837,16 +3801,14 @@ let (translate_let' : FStarC_Extraction_ML_Syntax.mllb_attrs = uu___1; FStarC_Extraction_ML_Syntax.mllb_meta = meta; FStarC_Extraction_ML_Syntax.print_typ = uu___2;_} -> - if - FStarC_Compiler_List.mem FStarC_Extraction_ML_Syntax.NoExtract - meta + if FStarC_List.mem FStarC_Extraction_ML_Syntax.NoExtract meta then FStar_Pervasives_Native.None else (let meta1 = translate_flags meta in let env2 = let uu___4 = FStarC_Extraction_ML_Syntax.ty_param_names tvars in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env3 -> fun name2 -> extend_t env3 name2) env1 uu___4 in let t1 = translate_type env2 t in let name2 = ((env2.module_name), name1) in @@ -3857,8 +3819,7 @@ let (translate_let' : let expr2 = translate_expr env2 expr1 in FStar_Pervasives_Native.Some (DGlobal - (meta1, name2, - (FStarC_Compiler_List.length tvars), t1, + (meta1, name2, (FStarC_List.length tvars), t1, expr2))) () with | uu___4 -> @@ -3868,13 +3829,12 @@ let (translate_let' : let uu___9 = FStarC_Extraction_ML_Syntax.string_of_mlpath name2 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Error extracting %s to KaRaMeL." uu___9 in FStarC_Errors_Msg.text uu___8 in let uu___8 = let uu___9 = - let uu___10 = - FStarC_Compiler_Util.print_exn uu___4 in + let uu___10 = FStarC_Util.print_exn uu___4 in FStarC_Pprint.arbitrary_string uu___10 in [uu___9] in uu___7 :: uu___8 in @@ -3884,8 +3844,7 @@ let (translate_let' : (Obj.magic uu___6)); FStar_Pervasives_Native.Some (DGlobal - (meta1, name2, (FStarC_Compiler_List.length tvars), - t1, EAny)))) + (meta1, name2, (FStarC_List.length tvars), t1, EAny)))) | { FStarC_Extraction_ML_Syntax.mllb_name = name1; FStarC_Extraction_ML_Syntax.mllb_tysc = ts; FStarC_Extraction_ML_Syntax.mllb_add_unit = uu___; @@ -3894,8 +3853,7 @@ let (translate_let' : FStarC_Extraction_ML_Syntax.mllb_meta = uu___3; FStarC_Extraction_ML_Syntax.print_typ = uu___4;_} -> ((let uu___6 = - FStarC_Compiler_Util.format1 "Not extracting %s to KaRaMeL\n" - name1 in + FStarC_Util.format1 "Not extracting %s to KaRaMeL\n" name1 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_DefinitionNotTranslated () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -3905,26 +3863,26 @@ let (translate_let' : let uu___7 = let uu___8 = FStarC_Extraction_ML_Syntax.ty_param_names tps in - FStarC_Compiler_String.concat ", " uu___8 in + FStarC_String.concat ", " uu___8 in let uu___8 = FStarC_Extraction_ML_Code.string_of_mlty ([], "") t in - FStarC_Compiler_Util.print2 - "Type scheme is: forall %s. %s\n" uu___7 uu___8 + FStarC_Util.print2 "Type scheme is: forall %s. %s\n" uu___7 + uu___8 | FStar_Pervasives_Native.None -> ()); FStar_Pervasives_Native.None) type translate_let_t = env -> FStarC_Extraction_ML_Syntax.mlletflavor -> FStarC_Extraction_ML_Syntax.mllb -> decl FStar_Pervasives_Native.option -let (ref_translate_let : translate_let_t FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref translate_let' +let (ref_translate_let : translate_let_t FStarC_Effect.ref) = + FStarC_Util.mk_ref translate_let' let (register_pre_translate_let : translate_let_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_translate_let in + let before = FStarC_Effect.op_Bang ref_translate_let in let after e fl lb = try (fun uu___ -> match () with | () -> f e fl lb) () with | NotSupportedByKrmlExtension -> before e fl lb in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_let after + FStarC_Effect.op_Colon_Equals ref_translate_let after let (translate_let : env -> FStarC_Extraction_ML_Syntax.mlletflavor -> @@ -3933,7 +3891,7 @@ let (translate_let : fun env1 -> fun flavor -> fun lb -> - let uu___ = FStarC_Compiler_Effect.op_Bang ref_translate_let in + let uu___ = FStarC_Effect.op_Bang ref_translate_let in uu___ env1 flavor lb let (translate_decl : env -> FStarC_Extraction_ML_Syntax.mlmodule1 -> decl Prims.list) = @@ -3941,14 +3899,14 @@ let (translate_decl : fun d -> match d.FStarC_Extraction_ML_Syntax.mlmodule1_m with | FStarC_Extraction_ML_Syntax.MLM_Let (flavor, lbs) -> - FStarC_Compiler_List.choose (translate_let env1 flavor) lbs + FStarC_List.choose (translate_let env1 flavor) lbs | FStarC_Extraction_ML_Syntax.MLM_Loc uu___ -> [] | FStarC_Extraction_ML_Syntax.MLM_Ty tys -> - FStarC_Compiler_List.choose (translate_type_decl env1) tys + FStarC_List.choose (translate_type_decl env1) tys | FStarC_Extraction_ML_Syntax.MLM_Top uu___ -> failwith "todo: translate_decl [MLM_Top]" | FStarC_Extraction_ML_Syntax.MLM_Exn (m, uu___) -> - (FStarC_Compiler_Util.print1_warning + (FStarC_Util.print1_warning "Not extracting exception %s to KaRaMeL (exceptions unsupported)\n" m; []) @@ -3964,17 +3922,16 @@ let (translate_module : match uu___ with | (module_name, modul, uu___1) -> let module_name1 = - FStarC_Compiler_List.op_At - (FStar_Pervasives_Native.fst module_name) + FStarC_List.op_At (FStar_Pervasives_Native.fst module_name) [FStar_Pervasives_Native.snd module_name] in let program1 = match modul with | FStar_Pervasives_Native.Some (_signature, decls) -> - FStarC_Compiler_List.collect + FStarC_List.collect (translate_decl (empty uenv module_name1)) decls | uu___2 -> failwith "Unexpected standalone interface or nested modules" in - ((FStarC_Compiler_String.concat "_" module_name1), program1) + ((FStarC_String.concat "_" module_name1), program1) let (translate : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Extraction_ML_Syntax.mllib -> file Prims.list) @@ -3983,7 +3940,7 @@ let (translate : fun uu___ -> match uu___ with | FStarC_Extraction_ML_Syntax.MLLib modules -> - FStarC_Compiler_List.filter_map + FStarC_List.filter_map (fun m -> let m_name = let uu___1 = m in @@ -3999,15 +3956,15 @@ let (translate : Prims.op_Negation uu___4 in if uu___3 then - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Attempting to translate module %s\n" m_name else ()); (let uu___3 = translate_module ue m in FStar_Pervasives_Native.Some uu___3))) () with | uu___1 -> - ((let uu___3 = FStarC_Compiler_Util.print_exn uu___1 in - FStarC_Compiler_Util.print2 + ((let uu___3 = FStarC_Util.print_exn uu___1 in + FStarC_Util.print2 "Unable to translate module: %s because:\n %s\n" m_name uu___3); FStar_Pervasives_Native.None)) modules diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Code.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Code.ml similarity index 89% rename from stage0/fstar-lib/generated/FStarC_Extraction_ML_Code.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Code.ml index c69daff1fdb..3ada9930ae5 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Code.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Code.ml @@ -67,12 +67,12 @@ let (e_app_prio : (Prims.int * fixity)) = let (min_op_prec : (Prims.int * fixity)) = ((Prims.of_int (-1)), (Infix NonAssoc)) let (max_op_prec : (Prims.int * fixity)) = - (FStarC_Compiler_Util.max_int, (Infix NonAssoc)) + (FStarC_Util.max_int, (Infix NonAssoc)) let (empty : doc) = Doc "" let (hardline : doc) = Doc "\n" let (text : Prims.string -> doc) = fun s -> Doc s let (num : Prims.int -> doc) = - fun i -> let uu___ = FStarC_Compiler_Util.string_of_int i in Doc uu___ + fun i -> let uu___ = FStarC_Util.string_of_int i in Doc uu___ let (break1 : doc) = text " " let (enclose : doc -> doc -> doc -> doc) = fun uu___ -> @@ -92,7 +92,7 @@ let (cat : doc -> doc -> doc) = match (uu___, uu___1) with | (Doc d1, Doc d2) -> Doc (Prims.strcat d1 d2) let (reduce : doc Prims.list -> doc) = - fun docs -> FStarC_Compiler_List.fold_left cat empty docs + fun docs -> FStarC_List.fold_left cat empty docs let (combine : doc -> doc Prims.list -> doc) = fun uu___ -> fun docs -> @@ -104,8 +104,8 @@ let (combine : doc -> doc Prims.list -> doc) = if d = "" then FStar_Pervasives_Native.None else FStar_Pervasives_Native.Some d in - let docs1 = FStarC_Compiler_List.choose select docs in - Doc (FStarC_Compiler_String.concat sep docs1) + let docs1 = FStarC_List.choose select docs in + Doc (FStarC_String.concat sep docs1) let (reduce1 : doc Prims.list -> doc) = fun docs -> combine break1 docs let (hbox : doc -> doc) = fun d -> d let rec in_ns : 'a . ('a Prims.list * 'a Prims.list) -> Prims.bool = @@ -125,14 +125,14 @@ let (path_of_ns : then [] else (let cg_libs = FStarC_Options.codegen_libs () in - let ns_len = FStarC_Compiler_List.length ns in + let ns_len = FStarC_List.length ns in let found = - FStarC_Compiler_Util.find_map cg_libs + FStarC_Util.find_map cg_libs (fun cg_path -> - let cg_len = FStarC_Compiler_List.length cg_path in - if (FStarC_Compiler_List.length cg_path) < ns_len + let cg_len = FStarC_List.length cg_path in + if (FStarC_List.length cg_path) < ns_len then - let uu___1 = FStarC_Compiler_Util.first_N cg_len ns in + let uu___1 = FStarC_Util.first_N cg_len ns in match uu___1 with | (pfx, sfx) -> (if pfx = cg_path @@ -142,7 +142,7 @@ let (path_of_ns : let uu___4 = FStarC_Extraction_ML_Util.flatten_ns sfx in [uu___4] in - FStarC_Compiler_List.op_At pfx uu___3 in + FStarC_List.op_At pfx uu___3 in FStar_Pervasives_Native.Some uu___2 else FStar_Pervasives_Native.None) else FStar_Pervasives_Native.None) in @@ -171,10 +171,9 @@ let (ptsym_of_symbol : fun s -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_String.get s Prims.int_zero in + let uu___2 = FStarC_String.get s Prims.int_zero in FStar_Char.lowercase uu___2 in - let uu___2 = FStarC_Compiler_String.get s Prims.int_zero in - uu___1 <> uu___2 in + let uu___2 = FStarC_String.get s Prims.int_zero in uu___1 <> uu___2 in if uu___ then Prims.strcat "l__" s else s let (ptsym : FStarC_Extraction_ML_Syntax.mlsymbol -> @@ -183,7 +182,7 @@ let (ptsym : = fun currentModule -> fun mlp -> - if FStarC_Compiler_List.isEmpty (FStar_Pervasives_Native.fst mlp) + if FStarC_List.isEmpty (FStar_Pervasives_Native.fst mlp) then ptsym_of_symbol (FStar_Pervasives_Native.snd mlp) else (let uu___1 = mlpath_of_mlpath currentModule mlp in @@ -191,8 +190,8 @@ let (ptsym : | (p, s) -> let uu___2 = let uu___3 = let uu___4 = ptsym_of_symbol s in [uu___4] in - FStarC_Compiler_List.op_At p uu___3 in - FStarC_Compiler_String.concat "." uu___2) + FStarC_List.op_At p uu___3 in + FStarC_String.concat "." uu___2) let (ptctor : FStarC_Extraction_ML_Syntax.mlsymbol -> FStarC_Extraction_ML_Syntax.mlpath -> @@ -206,13 +205,12 @@ let (ptctor : let s1 = let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_String.get s Prims.int_zero in + let uu___3 = FStarC_String.get s Prims.int_zero in FStar_Char.uppercase uu___3 in - let uu___3 = FStarC_Compiler_String.get s Prims.int_zero in + let uu___3 = FStarC_String.get s Prims.int_zero in uu___2 <> uu___3 in if uu___1 then Prims.strcat "U__" s else s in - FStarC_Compiler_String.concat "." - (FStarC_Compiler_List.op_At p [s1]) + FStarC_String.concat "." (FStarC_List.op_At p [s1]) let (infix_prim_ops : (Prims.string * (Prims.int * fixity) * Prims.string) Prims.list) = [("op_Addition", e_bin_prio_op1, "+"); @@ -242,7 +240,7 @@ let (prim_constructors : (Prims.string * Prims.string) Prims.list) = [("Some", "Some"); ("None", "None"); ("Nil", "[]"); ("Cons", "::")] let (is_prims_ns : FStarC_Extraction_ML_Syntax.mlsymbol Prims.list -> Prims.bool) = - fun ns -> (ns = ["Prims"]) || (ns = ["Prims"]) + fun ns -> (ns = ["Prims"]) || (ns = ["Fstarcompiler.Prims"]) let (as_bin_op : FStarC_Extraction_ML_Syntax.mlpath -> (FStarC_Extraction_ML_Syntax.mlsymbol * (Prims.int * fixity) * @@ -253,7 +251,7 @@ let (as_bin_op : | (ns, x) -> if is_prims_ns ns then - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | (y, uu___2, uu___3) -> x = y) infix_prim_ops else FStar_Pervasives_Native.None @@ -270,7 +268,7 @@ let (as_uni_op : if is_prims_ns ns then let uu___1 = prim_uni_ops () in - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___2 -> match uu___2 with | (y, uu___3) -> x = y) uu___1 else FStar_Pervasives_Native.None let (is_uni_op : FStarC_Extraction_ML_Syntax.mlpath -> Prims.bool) = @@ -287,7 +285,7 @@ let (as_standard_constructor : | (ns, x) -> if is_prims_ns ns then - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | (y, uu___2) -> x = y) prim_constructors else FStar_Pervasives_Native.None @@ -326,9 +324,9 @@ let (maybe_paren : | (uu___3, uu___4) -> false))) in if noparens inner outer side then doc1 else parens doc1 let (escape_byte_hex : FStarC_BaseTypes.byte -> Prims.string) = - fun x -> Prims.strcat "\\x" (FStarC_Compiler_Util.hex_string_of_byte x) + fun x -> Prims.strcat "\\x" (FStarC_Util.hex_string_of_byte x) let (escape_char_hex : FStarC_BaseTypes.char -> Prims.string) = - fun x -> escape_byte_hex (FStarC_Compiler_Util.byte_of_char x) + fun x -> escape_byte_hex (FStarC_Util.byte_of_char x) let (escape_or : (FStarC_BaseTypes.char -> Prims.string) -> FStarC_BaseTypes.char -> Prims.string) @@ -359,14 +357,14 @@ let (escape_or : if uu___ = 34 then "\\\"" else - if FStarC_Compiler_Util.is_letter_or_digit uu___ - then FStarC_Compiler_Util.string_of_char uu___ + if FStarC_Util.is_letter_or_digit uu___ + then FStarC_Util.string_of_char uu___ else - if FStarC_Compiler_Util.is_punctuation uu___ - then FStarC_Compiler_Util.string_of_char uu___ + if FStarC_Util.is_punctuation uu___ + then FStarC_Util.string_of_char uu___ else - if FStarC_Compiler_Util.is_symbol uu___ - then FStarC_Compiler_Util.string_of_char uu___ + if FStarC_Util.is_symbol uu___ + then FStarC_Util.string_of_char uu___ else fallback uu___ let (string_of_mlconstant : FStarC_Extraction_ML_Syntax.mlconstant -> Prims.string) = @@ -379,18 +377,17 @@ let (string_of_mlconstant : let uu___ = FStarC_Extraction_ML_Util.codegen_fsharp () in if uu___ then - Prims.strcat "'" - (Prims.strcat (FStarC_Compiler_Util.string_of_char c) "'") + Prims.strcat "'" (Prims.strcat (FStarC_Util.string_of_char c) "'") else (let nc = FStar_Char.int_of_char c in - let uu___2 = FStarC_Compiler_Util.string_of_int nc in + let uu___2 = FStarC_Util.string_of_int nc in Prims.strcat uu___2 (if ((nc >= (Prims.of_int (32))) && (nc = (Prims.of_int (127)))) && (nc < (Prims.of_int (34))) then Prims.strcat " (*" - (Prims.strcat (FStarC_Compiler_Util.string_of_char c) "*)") + (Prims.strcat (FStarC_Util.string_of_char c) "*)") else "")) | FStarC_Extraction_ML_Syntax.MLC_Int (s, FStar_Pervasives_Native.Some @@ -434,17 +431,17 @@ let (string_of_mlconstant : | FStarC_Extraction_ML_Syntax.MLC_Int (s, FStar_Pervasives_Native.None) -> Prims.strcat "(Prims.parse_int \"" (Prims.strcat s "\")") | FStarC_Extraction_ML_Syntax.MLC_Float d -> - FStarC_Compiler_Util.string_of_float d + FStarC_Util.string_of_float d | FStarC_Extraction_ML_Syntax.MLC_Bytes bytes -> let uu___ = - let uu___1 = FStarC_Compiler_Bytes.f_encode escape_byte_hex bytes in + let uu___1 = FStarC_Bytes.f_encode escape_byte_hex bytes in Prims.strcat uu___1 "\"" in Prims.strcat "\"" uu___ | FStarC_Extraction_ML_Syntax.MLC_String chars -> let uu___ = let uu___1 = - FStarC_Compiler_String.collect - (escape_or FStarC_Compiler_Util.string_of_char) chars in + FStarC_String.collect (escape_or FStarC_Util.string_of_char) + chars in Prims.strcat uu___1 "\"" in Prims.strcat "\"" uu___ | uu___ -> failwith "TODO: extract integer constants properly into OCaml" @@ -464,13 +461,13 @@ let rec (doc_of_mltype' : match ty with | FStarC_Extraction_ML_Syntax.MLTY_Var x -> let escape_tyvar s = - if FStarC_Compiler_Util.starts_with s "'_" - then FStarC_Compiler_Util.replace_char s 95 117 + if FStarC_Util.starts_with s "'_" + then FStarC_Util.replace_char s 95 117 else s in text (escape_tyvar x) | FStarC_Extraction_ML_Syntax.MLTY_Tuple tys -> let doc1 = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_mltype currentModule (t_prio_tpl, Left)) tys in let doc2 = let uu___ = @@ -485,7 +482,7 @@ let rec (doc_of_mltype' : doc_of_mltype currentModule (t_prio_name, Left) arg | uu___ -> let args2 = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_mltype currentModule (min_op_prec, NonAssoc)) args in let uu___1 = @@ -532,11 +529,10 @@ let rec (doc_of_expr : parens uu___2) | FStarC_Extraction_ML_Syntax.MLE_Seq es -> let docs = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_expr currentModule (min_op_prec, NonAssoc)) es in let docs1 = - FStarC_Compiler_List.map - (fun d -> reduce [d; text ";"; hardline]) docs in + FStarC_List.map (fun d -> reduce [d; text ";"; hardline]) docs in let uu___ = reduce docs1 in parens uu___ | FStarC_Extraction_ML_Syntax.MLE_Const c -> let uu___ = string_of_mlconstant c in text uu___ @@ -556,7 +552,7 @@ let rec (doc_of_expr : [uu___3; text "="; doc1] in reduce1 uu___2 in let uu___1 = - let uu___2 = FStarC_Compiler_List.map for1 fields in + let uu___2 = FStarC_List.map for1 fields in combine (text "; ") uu___2 in cbrackets uu___1 | FStarC_Extraction_ML_Syntax.MLE_CTor (ctor, []) -> @@ -566,7 +562,7 @@ let rec (doc_of_expr : then let uu___1 = let uu___2 = as_standard_constructor ctor in - FStarC_Compiler_Option.get uu___2 in + FStarC_Option.get uu___2 in FStar_Pervasives_Native.snd uu___1 else ptctor currentModule ctor in text name @@ -577,11 +573,11 @@ let rec (doc_of_expr : then let uu___1 = let uu___2 = as_standard_constructor ctor in - FStarC_Compiler_Option.get uu___2 in + FStarC_Option.get uu___2 in FStar_Pervasives_Native.snd uu___1 else ptctor currentModule ctor in let args1 = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_expr currentModule (min_op_prec, NonAssoc)) args in let doc1 = match (name, args1) with @@ -598,7 +594,7 @@ let rec (doc_of_expr : maybe_paren outer e_app_prio doc1 | FStarC_Extraction_ML_Syntax.MLE_Tuple es -> let docs = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___ = doc_of_expr currentModule (min_op_prec, NonAssoc) x in @@ -656,7 +652,7 @@ let rec (doc_of_expr : = uu___6;_}::[]) when (let uu___7 = FStarC_Extraction_ML_Syntax.string_of_mlpath p in - uu___7 = "FStarC.Compiler.Effect.try_with") || + uu___7 = "FStarC.Effect.try_with") || (let uu___7 = FStarC_Extraction_ML_Syntax.string_of_mlpath p in uu___7 = "FStar.All.try_with") @@ -717,7 +713,7 @@ let rec (doc_of_expr : | uu___ -> let e2 = doc_of_expr currentModule (e_app_prio, ILeft) e1 in let args1 = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_expr currentModule (e_app_prio, IRight)) args in let uu___1 = reduce1 (e2 :: args1) in parens uu___1) | FStarC_Extraction_ML_Syntax.MLE_Proj (e1, f) -> @@ -763,7 +759,7 @@ let rec (doc_of_expr : reduce1 uu___1 else text x in let ids1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | { FStarC_Extraction_ML_Syntax.mlbinder_name = x; @@ -820,8 +816,7 @@ let rec (doc_of_expr : | FStarC_Extraction_ML_Syntax.MLE_Match (cond, pats) -> let cond1 = doc_of_expr currentModule (min_op_prec, NonAssoc) cond in - let pats1 = - FStarC_Compiler_List.map (doc_of_branch currentModule) pats in + let pats1 = FStarC_List.map (doc_of_branch currentModule) pats in let doc1 = let uu___ = reduce1 [text "match"; parens cond1; text "with"] in uu___ :: pats1 in @@ -836,7 +831,7 @@ let rec (doc_of_expr : reduce1 uu___ | FStarC_Extraction_ML_Syntax.MLE_Raise (exn, args) -> let args1 = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_expr currentModule (min_op_prec, NonAssoc)) args in let uu___ = let uu___1 = @@ -858,8 +853,7 @@ let rec (doc_of_expr : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_List.map - (doc_of_branch currentModule) pats in + FStarC_List.map (doc_of_branch currentModule) pats in combine hardline uu___6 in [uu___5] in (text "with") :: uu___4 in @@ -878,8 +872,7 @@ and (doc_of_binop : fun p -> fun e1 -> fun e2 -> - let uu___ = - let uu___1 = as_bin_op p in FStarC_Compiler_Option.get uu___1 in + let uu___ = let uu___1 = as_bin_op p in FStarC_Option.get uu___1 in match uu___ with | (uu___1, prio, txt) -> let e11 = doc_of_expr currentModule (prio, Left) e1 in @@ -893,8 +886,7 @@ and (doc_of_uniop : fun currentModule -> fun p -> fun e1 -> - let uu___ = - let uu___1 = as_uni_op p in FStarC_Compiler_Option.get uu___1 in + let uu___ = let uu___1 = as_uni_op p in FStarC_Option.get uu___1 in match uu___ with | (uu___1, txt) -> let e11 = doc_of_expr currentModule (min_op_prec, NonAssoc) e1 in @@ -925,7 +917,7 @@ and (doc_of_pattern : uu___2 :: uu___3 in reduce1 uu___1 in let uu___ = - let uu___1 = FStarC_Compiler_List.map for1 fields in + let uu___1 = FStarC_List.map for1 fields in combine (text "; ") uu___1 in cbrackets uu___ | FStarC_Extraction_ML_Syntax.MLP_CTor (ctor, []) -> @@ -935,7 +927,7 @@ and (doc_of_pattern : then let uu___1 = let uu___2 = as_standard_constructor ctor in - FStarC_Compiler_Option.get uu___2 in + FStarC_Option.get uu___2 in FStar_Pervasives_Native.snd uu___1 else ptctor currentModule ctor in text name @@ -946,7 +938,7 @@ and (doc_of_pattern : then let uu___1 = let uu___2 = as_standard_constructor ctor in - FStarC_Compiler_Option.get uu___2 in + FStarC_Option.get uu___2 in FStar_Pervasives_Native.snd uu___1 else ptctor currentModule ctor in let doc1 = @@ -967,7 +959,7 @@ and (doc_of_pattern : let uu___2 = let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_List.hd pats in + let uu___5 = FStarC_List.hd pats in doc_of_pattern currentModule uu___5 in [uu___4] in (text name) :: uu___3 in @@ -978,8 +970,7 @@ and (doc_of_pattern : let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_List.map - (doc_of_pattern currentModule) pats in + FStarC_List.map (doc_of_pattern currentModule) pats in combine (text ", ") uu___5 in parens uu___4 in [uu___3] in @@ -987,14 +978,11 @@ and (doc_of_pattern : reduce1 uu___1 in maybe_paren (min_op_prec, NonAssoc) e_app_prio doc1 | FStarC_Extraction_ML_Syntax.MLP_Tuple ps -> - let ps1 = - FStarC_Compiler_List.map (doc_of_pattern currentModule) ps in + let ps1 = FStarC_List.map (doc_of_pattern currentModule) ps in let uu___ = combine (text ", ") ps1 in parens uu___ | FStarC_Extraction_ML_Syntax.MLP_Branch ps -> - let ps1 = - FStarC_Compiler_List.map (doc_of_pattern currentModule) ps in - let ps2 = FStarC_Compiler_List.map parens ps1 in - combine (text " | ") ps2 + let ps1 = FStarC_List.map (doc_of_pattern currentModule) ps in + let ps2 = FStarC_List.map parens ps1 in combine (text " | ") ps2 and (doc_of_branch : FStarC_Extraction_ML_Syntax.mlsymbol -> FStarC_Extraction_ML_Syntax.mlbranch -> doc) @@ -1085,7 +1073,7 @@ and (doc_of_lets : let uu___9 = FStarC_Extraction_ML_Syntax.ty_param_names vs in - FStarC_Compiler_List.map + FStarC_List.map (fun x -> doc_of_mltype currentModule (min_op_prec, NonAssoc) @@ -1104,9 +1092,9 @@ and (doc_of_lets : if rec_ = FStarC_Extraction_ML_Syntax.Rec then reduce1 [text "let"; text "rec"] else text "let" in - let lets1 = FStarC_Compiler_List.map for1 lets in + let lets1 = FStarC_List.map for1 lets in let lets2 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun doc1 -> reduce1 @@ -1124,7 +1112,7 @@ and (doc_of_loc : FStarC_Extraction_ML_Syntax.mlloc -> doc) = if uu___1 then empty else - (let file1 = FStarC_Compiler_Util.basename file in + (let file1 = FStarC_Util.basename file in let uu___3 = let uu___4 = let uu___5 = num lineno in @@ -1156,8 +1144,7 @@ let (doc_of_mltydecl : | [] -> empty | x2::[] -> text x2 | uu___3 -> - let doc1 = - FStarC_Compiler_List.map (fun x2 -> text x2) tparams2 in + let doc1 = FStarC_List.map (fun x2 -> text x2) tparams2 in let uu___4 = combine (text ", ") doc1 in parens uu___4 in let forbody body1 = match body1 with @@ -1173,29 +1160,28 @@ let (doc_of_mltydecl : ty in reduce1 [name1; text ":"; ty1] in let uu___3 = - let uu___4 = FStarC_Compiler_List.map forfield fields in + let uu___4 = FStarC_List.map forfield fields in combine (text "; ") uu___4 in cbrackets uu___3 | FStarC_Extraction_ML_Syntax.MLTD_DType ctors -> let forctor uu___3 = match uu___3 with | (name, tys) -> - let uu___4 = FStarC_Compiler_List.split tys in + let uu___4 = FStarC_List.split tys in (match uu___4 with | (_names, tys1) -> (match tys1 with | [] -> text name | uu___5 -> let tys2 = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_mltype currentModule (t_prio_tpl, Left)) tys1 in let tys3 = combine (text " * ") tys2 in reduce1 [text name; text "of"; tys3])) in - let ctors1 = FStarC_Compiler_List.map forctor ctors in + let ctors1 = FStarC_List.map forctor ctors in let ctors2 = - FStarC_Compiler_List.map (fun d -> reduce1 [text "|"; d]) - ctors1 in + FStarC_List.map (fun d -> reduce1 [text "|"; d]) ctors1 in combine hardline ctors2 in let doc1 = let uu___3 = @@ -1212,9 +1198,9 @@ let (doc_of_mltydecl : let uu___3 = let uu___4 = reduce1 [doc1; text "="] in [uu___4; body2] in combine hardline uu___3) in - let doc1 = FStarC_Compiler_List.map for1 decls in + let doc1 = FStarC_List.map for1 decls in let doc2 = - if (FStarC_Compiler_List.length doc1) > Prims.int_zero + if (FStarC_List.length doc1) > Prims.int_zero then let uu___ = let uu___1 = @@ -1243,7 +1229,7 @@ let rec (doc_of_sig1 : reduce1 [text "exception"; text x] | FStarC_Extraction_ML_Syntax.MLS_Exn (x, args) -> let args1 = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_mltype currentModule (min_op_prec, NonAssoc)) args in let args2 = let uu___ = combine (text " * ") args1 in parens uu___ in reduce1 [text "exception"; text x; text "of"; args2] @@ -1258,10 +1244,9 @@ and (doc_of_sig : = fun currentModule -> fun s -> - let docs = FStarC_Compiler_List.map (doc_of_sig1 currentModule) s in + let docs = FStarC_List.map (doc_of_sig1 currentModule) s in let docs1 = - FStarC_Compiler_List.map (fun x -> reduce [x; hardline; hardline]) - docs in + FStarC_List.map (fun x -> reduce [x; hardline; hardline]) docs in reduce docs1 let (doc_of_mod1 : FStarC_Extraction_ML_Syntax.mlsymbol -> @@ -1273,10 +1258,9 @@ let (doc_of_mod1 : | FStarC_Extraction_ML_Syntax.MLM_Exn (x, []) -> reduce1 [text "exception"; text x] | FStarC_Extraction_ML_Syntax.MLM_Exn (x, args) -> - let args1 = - FStarC_Compiler_List.map FStar_Pervasives_Native.snd args in + let args1 = FStarC_List.map FStar_Pervasives_Native.snd args in let args2 = - FStarC_Compiler_List.map + FStarC_List.map (doc_of_mltype currentModule (min_op_prec, NonAssoc)) args1 in let args3 = let uu___ = combine (text " * ") args2 in parens uu___ in reduce1 [text "exception"; text x; text "of"; args3] @@ -1304,7 +1288,7 @@ let (doc_of_mod : fun currentModule -> fun m -> let docs = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let doc1 = doc_of_mod1 currentModule x in [doc1; @@ -1312,7 +1296,7 @@ let (doc_of_mod : | FStarC_Extraction_ML_Syntax.MLM_Loc uu___ -> empty | uu___ -> hardline); hardline]) m in - reduce (FStarC_Compiler_List.flatten docs) + reduce (FStarC_List.flatten docs) let (doc_of_mllib_r : FStarC_Extraction_ML_Syntax.mllib -> (Prims.string * doc) Prims.list) = fun uu___ -> @@ -1326,14 +1310,14 @@ let (doc_of_mllib_r : reduce1 [text "module"; text x1; text ":"; text "sig"] in let tail = reduce1 [text "end"] in let doc1 = - FStarC_Compiler_Option.map + FStarC_Option.map (fun uu___2 -> match uu___2 with | (s, uu___3) -> doc_of_sig x1 s) sigmod in - let sub1 = FStarC_Compiler_List.map for1_sig sub in + let sub1 = FStarC_List.map for1_sig sub in let sub2 = - FStarC_Compiler_List.map - (fun x2 -> reduce [x2; hardline; hardline]) sub1 in + FStarC_List.map (fun x2 -> reduce [x2; hardline; hardline]) + sub1 in let uu___2 = let uu___3 = let uu___4 = @@ -1376,14 +1360,14 @@ let (doc_of_mllib_r : then reduce1 [text "end"] else reduce1 [] in let doc1 = - FStarC_Compiler_Option.map + FStarC_Option.map (fun uu___2 -> match uu___2 with | (uu___3, m) -> doc_of_mod target_mod_name m) sigmod in - let sub1 = FStarC_Compiler_List.map (for1_mod false) sub in + let sub1 = FStarC_List.map (for1_mod false) sub in let sub2 = - FStarC_Compiler_List.map - (fun x -> reduce [x; hardline; hardline]) sub1 in + FStarC_List.map (fun x -> reduce [x; hardline; hardline]) + sub1 in let prefix = let uu___2 = FStarC_Extraction_ML_Util.codegen_fsharp () in if uu___2 then [cat (text "#light \"off\"") hardline] else [] in @@ -1400,13 +1384,13 @@ let (doc_of_mllib_r : | FStar_Pervasives_Native.Some s -> cat s hardline) :: uu___7 in hardline :: uu___6 in - FStarC_Compiler_List.op_At maybe_open_pervasives uu___5 in - FStarC_Compiler_List.op_At - [head; hardline; text "open Prims"] uu___4 in - FStarC_Compiler_List.op_At prefix uu___3 in + FStarC_List.op_At maybe_open_pervasives uu___5 in + FStarC_List.op_At [head; hardline; text "open Prims"] + uu___4 in + FStarC_List.op_At prefix uu___3 in reduce uu___2 in let docs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (x, s, m) -> diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Modul.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Modul.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_Extraction_ML_Modul.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Modul.ml index c0bd18c3ec3..c79d5bf08ee 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Modul.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Modul.ml @@ -1,6 +1,6 @@ open Prims -let (dbg_ExtractionReify : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ExtractionReify" +let (dbg_ExtractionReify : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ExtractionReify" type tydef_declaration = (FStarC_Extraction_ML_Syntax.mlsymbol * FStarC_Extraction_ML_Syntax.metadata * Prims.int) @@ -75,23 +75,21 @@ let (__proj__Mkextension_extractor__item__extract_sigelt_iface : fun projectee -> match projectee with | { extract_sigelt; extract_sigelt_iface;_} -> extract_sigelt_iface -let (extension_extractor_table : - extension_extractor FStarC_Compiler_Util.smap) = - FStarC_Compiler_Util.smap_create (Prims.of_int (20)) +let (extension_extractor_table : extension_extractor FStarC_Util.smap) = + FStarC_Util.smap_create (Prims.of_int (20)) let (register_extension_extractor : Prims.string -> extension_extractor -> unit) = fun ext -> fun callback -> - FStarC_Compiler_Util.smap_add extension_extractor_table ext callback + FStarC_Util.smap_add extension_extractor_table ext callback let (lookup_extension_extractor : Prims.string -> extension_extractor FStar_Pervasives_Native.option) = fun ext -> - let do1 uu___ = - FStarC_Compiler_Util.smap_try_find extension_extractor_table ext in + let do1 uu___ = FStarC_Util.smap_try_find extension_extractor_table ext in let uu___ = do1 () in match uu___ with | FStar_Pervasives_Native.None -> - let uu___1 = FStarC_Compiler_Plugins.autoload_plugin ext in + let uu___1 = FStarC_Plugins.autoload_plugin ext in if uu___1 then do1 () else FStar_Pervasives_Native.None | r -> r type env_t = FStarC_Extraction_ML_UEnv.uenv @@ -120,11 +118,10 @@ let (fail_exp : FStarC_Class_Show.show FStarC_Ident.showable_lident lid in Prims.strcat "Not yet implemented: " uu___12 in - (uu___11, FStarC_Compiler_Range_Type.dummyRange) in + (uu___11, FStarC_Range_Type.dummyRange) in FStarC_Const.Const_string uu___10 in FStarC_Syntax_Syntax.Tm_constant uu___9 in - FStarC_Syntax_Syntax.mk uu___8 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Syntax_Syntax.mk uu___8 FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.as_arg uu___7 in [uu___6] in uu___4 :: uu___5 in @@ -133,7 +130,7 @@ let (fail_exp : FStarC_Syntax_Syntax.args = uu___3 } in FStarC_Syntax_Syntax.Tm_app uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange let (always_fail : FStarC_Ident.lident -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> @@ -338,7 +335,7 @@ let rec (extract_meta : let (extract_metadata : FStarC_Syntax_Syntax.term Prims.list -> FStarC_Extraction_ML_Syntax.meta Prims.list) - = fun metas -> FStarC_Compiler_List.choose extract_meta metas + = fun metas -> FStarC_List.choose extract_meta metas let (binders_as_mlty_binders : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.binder Prims.list -> @@ -347,7 +344,7 @@ let (binders_as_mlty_binders : = fun env -> fun bs -> - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun env1 -> fun uu___ -> match uu___ with @@ -363,7 +360,7 @@ let (binders_as_mlty_binders : ty.FStarC_Extraction_ML_UEnv.ty_b_name | uu___4 -> failwith "Impossible" in let ty_param_attrs = - FStarC_Compiler_List.map + FStarC_List.map (fun attr -> let uu___3 = FStarC_Extraction_ML_Term.term_as_mlexpr env2 attr in @@ -441,7 +438,7 @@ let (print_ifamily : inductive_family -> unit) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term i.ityp in let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun d -> let uu___5 = FStarC_Class_Show.show FStarC_Ident.showable_lident d.dname in @@ -451,9 +448,8 @@ let (print_ifamily : inductive_family -> unit) = d.dtyp in Prims.strcat " : " uu___7 in Prims.strcat uu___5 uu___6) i.idatas in - FStarC_Compiler_String.concat "\n\t\t" uu___4 in - FStarC_Compiler_Util.print4 "\n\t%s %s : %s { %s }\n" uu___ uu___1 uu___2 - uu___3 + FStarC_String.concat "\n\t\t" uu___4 in + FStarC_Util.print4 "\n\t%s %s : %s { %s }\n" uu___ uu___1 uu___2 uu___3 let (bundle_as_inductive_families : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.sigelt Prims.list -> @@ -464,7 +460,7 @@ let (bundle_as_inductive_families : fun ses -> fun quals -> let uu___ = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun env1 -> fun se -> match se.FStarC_Syntax_Syntax.sigel with @@ -485,7 +481,7 @@ let (bundle_as_inductive_families : (match uu___5 with | (bs1, t2) -> let datas1 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun se1 -> match se1.FStarC_Syntax_Syntax.sigel with @@ -513,13 +509,13 @@ let (bundle_as_inductive_families : (match uu___9 with | (bs', body) -> let uu___10 = - FStarC_Compiler_Util.first_N - (FStarC_Compiler_List.length + FStarC_Util.first_N + (FStarC_List.length bs1) bs' in (match uu___10 with | (bs_params, rest) -> let subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___11 -> fun uu___12 -> @@ -576,9 +572,8 @@ let (bundle_as_inductive_families : extract_metadata se.FStarC_Syntax_Syntax.sigattrs in let uu___7 = - FStarC_Compiler_List.choose flag_of_qual - quals in - FStarC_Compiler_List.op_At uu___6 uu___7 in + FStarC_List.choose flag_of_qual quals in + FStarC_List.op_At uu___6 uu___7 in let fv = FStarC_Syntax_Syntax.lid_as_fv l FStar_Pervasives_Native.None in @@ -600,7 +595,7 @@ let (bundle_as_inductive_families : }])))) | uu___1 -> (env1, [])) env ses in match uu___ with - | (env1, ifams) -> (env1, (FStarC_Compiler_List.flatten ifams)) + | (env1, ifams) -> (env1, (FStarC_List.flatten ifams)) let (empty_iface : iface) = { iface_module_name = ([], ""); @@ -622,10 +617,9 @@ let (iface_of_bindings : let (iface_of_tydefs : FStarC_Extraction_ML_UEnv.tydef Prims.list -> iface) = fun tds -> let uu___ = - FStarC_Compiler_List.map (fun uu___1 -> FStar_Pervasives.Inl uu___1) - tds in + FStarC_List.map (fun uu___1 -> FStar_Pervasives.Inl uu___1) tds in let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun td -> let uu___2 = FStarC_Extraction_ML_UEnv.tydef_fv td in let uu___3 = FStarC_Extraction_ML_UEnv.tydef_mlpath td in @@ -654,19 +648,17 @@ let (iface_union : iface -> iface -> iface) = { iface_module_name = uu___; iface_bindings = - (FStarC_Compiler_List.op_At if1.iface_bindings if2.iface_bindings); - iface_tydefs = - (FStarC_Compiler_List.op_At if1.iface_tydefs if2.iface_tydefs); + (FStarC_List.op_At if1.iface_bindings if2.iface_bindings); + iface_tydefs = (FStarC_List.op_At if1.iface_tydefs if2.iface_tydefs); iface_type_names = - (FStarC_Compiler_List.op_At if1.iface_type_names - if2.iface_type_names) + (FStarC_List.op_At if1.iface_type_names if2.iface_type_names) } let (iface_union_l : iface Prims.list -> iface) = - fun ifs -> FStarC_Compiler_List.fold_right iface_union ifs empty_iface + fun ifs -> FStarC_List.fold_right iface_union ifs empty_iface let (string_of_mlpath : FStarC_Extraction_ML_Syntax.mlpath -> Prims.string) = fun p -> - FStarC_Compiler_String.concat ". " - (FStarC_Compiler_List.op_At (FStar_Pervasives_Native.fst p) + FStarC_String.concat ". " + (FStarC_List.op_At (FStar_Pervasives_Native.fst p) [FStar_Pervasives_Native.snd p]) let tscheme_to_string : 'uuuuu . @@ -688,7 +680,7 @@ let (print_exp_binding : e.FStarC_Extraction_ML_UEnv.exp_b_expr in let uu___1 = tscheme_to_string cm e.FStarC_Extraction_ML_UEnv.exp_b_tscheme in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "{\n\texp_b_name = %s\n\texp_b_expr = %s\n\texp_b_tscheme = %s }" e.FStarC_Extraction_ML_UEnv.exp_b_name uu___ uu___1 let (print_binding : @@ -703,7 +695,7 @@ let (print_binding : let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fv in let uu___2 = print_exp_binding cm exp_binding in - FStarC_Compiler_Util.format2 "(%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "(%s, %s)" uu___1 uu___2 let print_tydef : 'uuuuu 'uuuuu1 . FStarC_Extraction_ML_Syntax.mlpath -> @@ -724,7 +716,7 @@ let print_tydef : (uu___1, uu___2) | FStar_Pervasives.Inr (p, uu___1, uu___2) -> (p, "None") in match uu___ with - | (name, defn) -> FStarC_Compiler_Util.format2 "(%s, %s)" name defn + | (name, defn) -> FStarC_Util.format2 "(%s, %s)" name defn let (iface_to_string : iface -> Prims.string) = fun iface1 -> let cm = iface1.iface_module_name in @@ -733,18 +725,15 @@ let (iface_to_string : iface -> Prims.string) = | (tn, uu___1) -> FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv tn in let uu___ = - let uu___1 = - FStarC_Compiler_List.map (print_binding cm) iface1.iface_bindings in - FStarC_Compiler_String.concat "\n" uu___1 in + let uu___1 = FStarC_List.map (print_binding cm) iface1.iface_bindings in + FStarC_String.concat "\n" uu___1 in let uu___1 = - let uu___2 = - FStarC_Compiler_List.map (print_tydef cm) iface1.iface_tydefs in - FStarC_Compiler_String.concat "\n" uu___2 in + let uu___2 = FStarC_List.map (print_tydef cm) iface1.iface_tydefs in + FStarC_String.concat "\n" uu___2 in let uu___2 = - let uu___3 = - FStarC_Compiler_List.map print_type_name iface1.iface_type_names in - FStarC_Compiler_String.concat "\n" uu___3 in - FStarC_Compiler_Util.format4 + let uu___3 = FStarC_List.map print_type_name iface1.iface_type_names in + FStarC_String.concat "\n" uu___3 in + FStarC_Util.format4 "Interface %s = {\niface_bindings=\n%s;\n\niface_tydefs=\n%s;\n\niface_type_names=%s;\n}" (string_of_mlpath iface1.iface_module_name) uu___ uu___1 uu___2 let (gamma_to_string : FStarC_Extraction_ML_UEnv.uenv -> Prims.string) = @@ -752,15 +741,15 @@ let (gamma_to_string : FStarC_Extraction_ML_UEnv.uenv -> Prims.string) = let cm = FStarC_Extraction_ML_UEnv.current_module_of_uenv env in let gamma = let uu___ = FStarC_Extraction_ML_UEnv.bindings_of_uenv env in - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___1 -> match uu___1 with | FStarC_Extraction_ML_UEnv.Fv (b, e) -> [(b, e)] | uu___2 -> []) uu___ in let uu___ = - let uu___1 = FStarC_Compiler_List.map (print_binding cm) gamma in - FStarC_Compiler_String.concat "\n" uu___1 in - FStarC_Compiler_Util.format1 "Gamma = {\n %s }" uu___ + let uu___1 = FStarC_List.map (print_binding cm) gamma in + FStarC_String.concat "\n" uu___1 in + FStarC_Util.format1 "Gamma = {\n %s }" uu___ let (extract_attrs : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.attribute Prims.list -> @@ -768,7 +757,7 @@ let (extract_attrs : = fun env -> fun attrs -> - FStarC_Compiler_List.map + FStarC_List.map (fun attr -> let uu___ = FStarC_Extraction_ML_Term.term_as_mlexpr env attr in match uu___ with | (e, uu___1, uu___2) -> e) attrs @@ -806,8 +795,7 @@ let (extract_typ_abbrev : let lbdef1 = FStarC_TypeChecker_Normalize.eta_expand_with_type tcenv lbdef lbtyp1 in - let fv = - FStarC_Compiler_Util.right lb.FStarC_Syntax_Syntax.lbname in + let fv = FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let lid = (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in let def = @@ -831,7 +819,7 @@ let (extract_typ_abbrev : (match uu___1 with | (bs, body) -> let assumed = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Assumption -> true @@ -852,8 +840,8 @@ let (extract_typ_abbrev : let meta = let uu___3 = extract_metadata attrs in let uu___4 = - FStarC_Compiler_List.choose flag_of_qual quals in - FStarC_Compiler_List.op_At uu___3 uu___4 in + FStarC_List.choose flag_of_qual quals in + FStarC_List.op_At uu___3 uu___4 in if has_val_decl then let uu___3 = @@ -864,7 +852,7 @@ let (extract_typ_abbrev : let tyscheme = (ml_bs, body1) in let uu___3 = let uu___4 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___5 -> match uu___5 with | FStarC_Syntax_Syntax.Assumption -> true @@ -953,17 +941,14 @@ let (extract_let_rec_type : let uu___2 = binders_as_mlty_binders env bs in (match uu___2 with | (env1, ml_bs) -> - let fv = - FStarC_Compiler_Util.right - lb.FStarC_Syntax_Syntax.lbname in + let fv = FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let lid = (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in let body = FStarC_Extraction_ML_Syntax.MLTY_Top in let metadata = let uu___3 = extract_metadata attrs in - let uu___4 = - FStarC_Compiler_List.choose flag_of_qual quals in - FStarC_Compiler_List.op_At uu___3 uu___4 in + let uu___4 = FStarC_List.choose flag_of_qual quals in + FStarC_List.op_At uu___3 uu___4 in let assumed = false in let tscheme = (ml_bs, body) in let uu___3 = @@ -1031,13 +1016,13 @@ let (extract_bundle_iface : match uu___ with | (env_iparams, vars) -> let uu___1 = - FStarC_Compiler_Util.fold_map (extract_ctor env_iparams vars) - env1 ind.idatas in + FStarC_Util.fold_map (extract_ctor env_iparams vars) env1 + ind.idatas in (match uu___1 with | (env2, ctors) -> let env3 = let uu___2 = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.RecordType uu___4 -> true @@ -1046,7 +1031,7 @@ let (extract_bundle_iface : | FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.RecordType (ns, ids)) -> let g = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun id -> fun g1 -> let uu___3 = @@ -1097,14 +1082,13 @@ let (extract_bundle_iface : match uu___3 with | (env1, ifams) -> let uu___4 = - FStarC_Compiler_Util.fold_map extract_one_family env1 - ifams in + FStarC_Util.fold_map extract_one_family env1 ifams in (match uu___4 with | (env2, td) -> let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___8 = FStarC_Extraction_ML_UEnv.mlpath_of_lident @@ -1112,8 +1096,7 @@ let (extract_bundle_iface : ((x.ifv), uu___8)) ifams in iface_of_type_names uu___7 in iface_union uu___6 - (iface_of_bindings - (FStarC_Compiler_List.flatten td)) in + (iface_of_bindings (FStarC_List.flatten td)) in (env2, uu___5))) | uu___ -> failwith "Unexpected signature element" let (extract_type_declaration : @@ -1136,7 +1119,7 @@ let (extract_type_declaration : fun t -> let uu___ = let uu___1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Assumption -> true @@ -1190,8 +1173,7 @@ let (extract_type_declaration : iface_tydefs = [FStar_Pervasives.Inr ((FStar_Pervasives_Native.snd mlp), - meta, - (FStarC_Compiler_List.length bs))]; + meta, (FStarC_List.length bs))]; iface_type_names = (empty_iface.iface_type_names) } @@ -1226,12 +1208,12 @@ let (extract_reifiable_effect : (FStarC_Extraction_ML_Syntax.NonRec, [lb])) in ((iface_of_bindings [(fv, exp_binding)]), uu___) in let rec extract_fv tm = - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_ExtractionReify in + (let uu___1 = FStarC_Effect.op_Bang dbg_ExtractionReify in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 "extract_fv term: %s\n" uu___2 + FStarC_Util.print1 "extract_fv term: %s\n" uu___2 else ()); (let uu___1 = let uu___2 = FStarC_Syntax_Subst.compress tm in @@ -1258,15 +1240,13 @@ let (extract_reifiable_effect : | uu___2 -> let uu___3 = let uu___4 = - FStarC_Compiler_Range_Ops.string_of_range - tm.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.string_of_range tm.FStarC_Syntax_Syntax.pos in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.format2 "(%s) Not an fv: %s" uu___4 - uu___5 in + FStarC_Util.format2 "(%s) Not an fv: %s" uu___4 uu___5 in failwith uu___3) in let extract_action g1 a = - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_ExtractionReify in + (let uu___1 = FStarC_Effect.op_Bang dbg_ExtractionReify in if uu___1 then let uu___2 = @@ -1275,8 +1255,7 @@ let (extract_reifiable_effect : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term a.FStarC_Syntax_Syntax.action_defn in - FStarC_Compiler_Util.print2 "Action type %s and term %s\n" uu___2 - uu___3 + FStarC_Util.print2 "Action type %s and term %s\n" uu___2 uu___3 else ()); (let lbname = let uu___1 = @@ -1323,31 +1302,31 @@ let (extract_reifiable_effect : (match uu___4 with | (a_nm, a_lid, exp_b, g2) -> ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_ExtractionReify in + FStarC_Effect.op_Bang dbg_ExtractionReify in if uu___6 then let uu___7 = FStarC_Extraction_ML_Code.string_of_mlexpr a_nm a_let in - FStarC_Compiler_Util.print1 - "Extracted action term: %s\n" uu___7 + FStarC_Util.print1 "Extracted action term: %s\n" + uu___7 else ()); (let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg_ExtractionReify in + FStarC_Effect.op_Bang dbg_ExtractionReify in if uu___7 then ((let uu___9 = FStarC_Extraction_ML_Code.string_of_mlty a_nm (FStar_Pervasives_Native.snd tysc) in - FStarC_Compiler_Util.print1 - "Extracted action type: %s\n" uu___9); + FStarC_Util.print1 "Extracted action type: %s\n" + uu___9); (let uu___9 = FStarC_Extraction_ML_Syntax.ty_param_names (FStar_Pervasives_Native.fst tysc) in - FStarC_Compiler_List.iter + FStarC_List.iter (fun x -> - FStarC_Compiler_Util.print1 - "and binders: %s\n" x) uu___9)) + FStarC_Util.print1 "and binders: %s\n" x) + uu___9)) else ()); (let uu___7 = extend_iface a_lid a_nm exp exp_b in match uu___7 with @@ -1357,7 +1336,7 @@ let (extract_reifiable_effect : let uu___2 = let uu___3 = let uu___4 = FStarC_Syntax_Util.get_return_repr ed in - FStarC_Compiler_Util.must uu___4 in + FStarC_Util.must uu___4 in FStar_Pervasives_Native.snd uu___3 in extract_fv uu___2 in match uu___1 with @@ -1377,7 +1356,7 @@ let (extract_reifiable_effect : let uu___3 = let uu___4 = let uu___5 = FStarC_Syntax_Util.get_bind_repr ed in - FStarC_Compiler_Util.must uu___5 in + FStarC_Util.must uu___5 in FStar_Pervasives_Native.snd uu___4 in extract_fv uu___3 in match uu___2 with @@ -1394,11 +1373,11 @@ let (extract_reifiable_effect : (match uu___1 with | (g2, bind_iface, bind_decl) -> let uu___2 = - FStarC_Compiler_Util.fold_map extract_action g2 + FStarC_Util.fold_map extract_action g2 ed.FStarC_Syntax_Syntax.actions in (match uu___2 with | (g3, actions) -> - let uu___3 = FStarC_Compiler_List.unzip actions in + let uu___3 = FStarC_List.unzip actions in (match uu___3 with | (actions_iface, actions1) -> let uu___4 = @@ -1509,11 +1488,10 @@ let (split_let_rec_types_and_terms : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb1 -> let uu___4 = - FStarC_Compiler_Util.right - lb1.FStarC_Syntax_Syntax.lbname in + FStarC_Util.right lb1.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.lid_of_fv uu___4) lbs1 in { FStarC_Syntax_Syntax.lbs1 = (true, lbs1); @@ -1535,7 +1513,7 @@ let (split_let_rec_types_and_terms : FStarC_Syntax_Syntax.sigopts = (se.FStarC_Syntax_Syntax.sigopts) } in - let sigs1 = FStarC_Compiler_List.op_At sigs [lb] in sigs1 + let sigs1 = FStarC_List.op_At sigs [lb] in sigs1 let (extract_let_rec_types : FStarC_Syntax_Syntax.sigelt -> FStarC_Extraction_ML_UEnv.uenv -> @@ -1547,7 +1525,7 @@ let (extract_let_rec_types : fun env -> fun lbs -> let uu___ = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun lb -> let uu___1 = FStarC_Extraction_ML_Term.is_arity env @@ -1557,7 +1535,7 @@ let (extract_let_rec_types : then failwith "Impossible: mixed mutual types and terms" else (let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun lb -> match uu___3 with @@ -1579,17 +1557,15 @@ let (extract_let_rec_types : (env, FStar_Pervasives_Native.None, []) lbs in match uu___2 with | (env1, iface_opt, impls) -> - let uu___3 = FStarC_Compiler_Option.get iface_opt in - (env1, uu___3, - (FStarC_Compiler_List.flatten - (FStarC_Compiler_List.rev impls)))) + let uu___3 = FStarC_Option.get iface_opt in + (env1, uu___3, (FStarC_List.flatten (FStarC_List.rev impls)))) let (get_noextract_to : FStarC_Syntax_Syntax.sigelt -> FStarC_Options.codegen_t FStar_Pervasives_Native.option -> Prims.bool) = fun se -> fun backend -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___ -> let uu___1 = FStarC_Syntax_Util.head_and_args uu___ in match uu___1 with @@ -1610,7 +1586,7 @@ let (get_noextract_to : FStarC_Syntax_Embeddings_Base.id_norm_cb in (match uu___4 with | FStar_Pervasives_Native.Some s -> - (FStarC_Compiler_Option.isSome backend) && + (FStarC_Option.isSome backend) && (let uu___5 = FStarC_Options.parse_codegen s in uu___5 = backend) | FStar_Pervasives_Native.None -> false) @@ -1618,7 +1594,7 @@ let (get_noextract_to : let (sigelt_has_noextract : FStarC_Syntax_Syntax.sigelt -> Prims.bool) = fun se -> let has_noextract_qualifier = - FStarC_Compiler_List.contains FStarC_Syntax_Syntax.NoExtract + FStarC_List.contains FStarC_Syntax_Syntax.NoExtract se.FStarC_Syntax_Syntax.sigquals in let has_noextract_attribute = let uu___ = FStarC_Options.codegen () in get_noextract_to se uu___ in @@ -1637,7 +1613,7 @@ let (karamel_fixup_qual : (FStar_Pervasives_Native.Some FStarC_Options.Krml))) && (Prims.op_Negation - (FStarC_Compiler_List.contains FStarC_Syntax_Syntax.NoExtract + (FStarC_List.contains FStarC_Syntax_Syntax.NoExtract se.FStarC_Syntax_Syntax.sigquals)) in if uu___ then @@ -1662,21 +1638,21 @@ let (mark_sigelt_erased : FStarC_Extraction_ML_UEnv.debug g (fun u -> let uu___1 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.print1 ">>>> NOT extracting %s \n" uu___1); - FStarC_Compiler_List.fold_right - (fun lid -> - fun g1 -> - let uu___1 = - FStarC_Syntax_Syntax.lid_as_fv lid - FStar_Pervasives_Native.None in - FStarC_Extraction_ML_UEnv.extend_erased_fv g1 uu___1) - (FStarC_Syntax_Util.lids_of_sigelt se) g + FStarC_Util.print1 ">>>> NOT extracting %s \n" uu___1); + (let uu___1 = FStarC_Syntax_Util.lids_of_sigelt se in + FStarC_List.fold_right + (fun lid -> + fun g1 -> + let uu___2 = + FStarC_Syntax_Syntax.lid_as_fv lid + FStar_Pervasives_Native.None in + FStarC_Extraction_ML_UEnv.extend_erased_fv g1 uu___2) uu___1 g) let (fixup_sigelt_extract_as : FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.sigelt) = fun se -> let uu___ = let uu___1 = - FStarC_Compiler_Util.find_map se.FStarC_Syntax_Syntax.sigattrs + FStarC_Util.find_map se.FStarC_Syntax_Syntax.sigattrs FStarC_TypeChecker_Normalize.is_extract_as_attr in ((se.FStarC_Syntax_Syntax.sigel), uu___1) in match uu___ with @@ -1753,7 +1729,7 @@ let rec (extract_sigelt_iface : lb.FStarC_Syntax_Syntax.lbtyp -> let uu___3 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___4 -> match uu___4 with | FStarC_Syntax_Syntax.Projector uu___5 -> true @@ -1779,7 +1755,7 @@ let rec (extract_sigelt_iface : iface_tydefs = (empty_iface.iface_tydefs); iface_type_names = (empty_iface.iface_type_names) } in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun se3 -> match uu___3 with @@ -1793,7 +1769,7 @@ let rec (extract_sigelt_iface : { FStarC_Syntax_Syntax.lbs1 = (true, lbs); FStarC_Syntax_Syntax.lids1 = uu___2;_} when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun lb -> FStarC_Extraction_ML_Term.is_arity g lb.FStarC_Syntax_Syntax.lbtyp) lbs @@ -1807,8 +1783,7 @@ let rec (extract_sigelt_iface : -> let quals = se2.FStarC_Syntax_Syntax.sigquals in let uu___3 = - (FStarC_Compiler_List.contains FStarC_Syntax_Syntax.Assumption - quals) + (FStarC_List.contains FStarC_Syntax_Syntax.Assumption quals) && (let uu___4 = let uu___5 = FStarC_Extraction_ML_UEnv.tcenv_of_uenv g in @@ -1833,7 +1808,7 @@ let rec (extract_sigelt_iface : (se2.FStarC_Syntax_Syntax.sigmeta).FStarC_Syntax_Syntax.sigmeta_extension_data -> let uu___3 = - FStarC_Compiler_List.tryPick + FStarC_List.tryPick (fun uu___4 -> match uu___4 with | (ext, blob) -> @@ -1858,7 +1833,7 @@ let rec (extract_sigelt_iface : | FStar_Pervasives.Inl res1 -> res1 | FStar_Pervasives.Inr err -> let uu___4 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Extension %s failed to extract iface: %s" ext err in FStarC_Errors.raise_error FStarC_Syntax_Syntax.has_range_sigelt se2 @@ -1894,8 +1869,7 @@ let rec (extract_sigelt_iface : FStarC_TypeChecker_Util.effect_extraction_mode uu___4 ed.FStarC_Syntax_Syntax.mname in uu___3 = FStarC_Syntax_Syntax.Extract_reify) && - (FStarC_Compiler_List.isEmpty - ed.FStarC_Syntax_Syntax.binders) in + (FStarC_List.isEmpty ed.FStarC_Syntax_Syntax.binders) in if uu___2 then let uu___3 = extract_reifiable_effect g ed in @@ -1922,7 +1896,7 @@ let (extract_iface' : iface_type_names = (empty_iface.iface_type_names) } in let res = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun se -> match uu___3 with @@ -1943,15 +1917,14 @@ let (extract_iface : let uu___ = FStarC_Syntax_Unionfind.with_uf_enabled (fun uu___1 -> - let uu___2 = FStarC_Compiler_Debug.any () in + let uu___2 = FStarC_Debug.any () in if uu___2 then let uu___3 = let uu___4 = FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.format1 "Extracted interface of %s" - uu___4 in - FStarC_Compiler_Util.measure_execution_time uu___3 + FStarC_Util.format1 "Extracted interface of %s" uu___4 in + FStarC_Util.measure_execution_time uu___3 (fun uu___4 -> extract_iface' g modul) else extract_iface' g modul) in match uu___ with @@ -1960,7 +1933,7 @@ let (extract_iface : FStarC_Extraction_ML_UEnv.with_typars_env g1 (fun e -> let iface_tydefs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | FStar_Pervasives.Inl td -> @@ -2027,7 +2000,7 @@ let (extract_bundle : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = uu___1;_} -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | { @@ -2050,7 +2023,7 @@ let (extract_bundle : let uu___2 = let uu___3 = let uu___4 = FStarC_Extraction_ML_Util.argTypes mlt in - FStarC_Compiler_List.zip names uu___4 in + FStarC_List.zip names uu___4 in (mls, uu___3) in (env2, uu___2) in let extract_one_family env1 ind = @@ -2058,8 +2031,8 @@ let (extract_bundle : match uu___ with | (env_iparams, vars) -> let uu___1 = - FStarC_Compiler_Util.fold_map (extract_ctor env_iparams vars) - env1 ind.idatas in + FStarC_Util.fold_map (extract_ctor env_iparams vars) env1 + ind.idatas in (match uu___1 with | (env2, ctors) -> let uu___2 = FStarC_Syntax_Util.arrow_formals ind.ityp in @@ -2067,12 +2040,11 @@ let (extract_bundle : | (indices, uu___3) -> let ml_params = let uu___4 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___5 -> let uu___6 = - let uu___7 = - FStarC_Compiler_Util.string_of_int i in + let uu___7 = FStarC_Util.string_of_int i in Prims.strcat "'dummyV" uu___7 in { FStarC_Extraction_ML_Syntax.ty_param_name @@ -2080,10 +2052,10 @@ let (extract_bundle : FStarC_Extraction_ML_Syntax.ty_param_attrs = [] }) indices in - FStarC_Compiler_List.append vars uu___4 in + FStarC_List.append vars uu___4 in let uu___4 = let uu___5 = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___6 -> match uu___6 with | FStarC_Syntax_Syntax.RecordType uu___7 -> @@ -2092,11 +2064,11 @@ let (extract_bundle : match uu___5 with | FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.RecordType (ns, ids)) -> - let uu___6 = FStarC_Compiler_List.hd ctors in + let uu___6 = FStarC_List.hd ctors in (match uu___6 with | (uu___7, c_ty) -> let uu___8 = - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun id -> fun uu___9 -> fun uu___10 -> @@ -2116,9 +2088,8 @@ let (extract_bundle : (FStarC_Extraction_ML_Syntax.MLTD_Record fields)), g))) | uu___6 when - (FStarC_Compiler_List.length ctors) = - Prims.int_zero - -> (FStar_Pervasives_Native.None, env2) + (FStarC_List.length ctors) = Prims.int_zero -> + (FStar_Pervasives_Native.None, env2) | uu___6 -> ((FStar_Pervasives_Native.Some (FStarC_Extraction_ML_Syntax.MLTD_DType ctors)), @@ -2193,8 +2164,7 @@ let (extract_bundle : match uu___3 with | (env1, ifams) -> let uu___4 = - FStarC_Compiler_Util.fold_map extract_one_family env1 - ifams in + FStarC_Util.fold_map extract_one_family env1 ifams in (match uu___4 with | (env2, td) -> let uu___5 = @@ -2233,8 +2203,8 @@ let (lb_is_tactic : env_t -> FStarC_Syntax_Syntax.letbinding -> Prims.bool) = | (bs, c) -> let c_eff_name = let uu___2 = FStarC_Extraction_ML_UEnv.tcenv_of_uenv g in - FStarC_TypeChecker_Env.norm_eff_name uu___2 - (FStarC_Syntax_Util.comp_effect_name c) in + let uu___3 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Env.norm_eff_name uu___2 uu___3 in FStarC_Ident.lid_equals c_eff_name FStarC_Parser_Const.effect_TAC_lid else false @@ -2247,14 +2217,14 @@ let rec (extract_sig : fun se -> let uu___ = let uu___1 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.format1 - "While extracting top-level definition `%s`" uu___1 in + FStarC_Util.format1 "While extracting top-level definition `%s`" + uu___1 in FStarC_Errors.with_ctx uu___ (fun uu___1 -> FStarC_Extraction_ML_UEnv.debug g (fun u -> let uu___3 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.print1 ">>>> extract_sig %s \n" uu___3); + FStarC_Util.print1 ">>>> extract_sig %s \n" uu___3); (let uu___3 = sigelt_has_noextract se in if uu___3 then let g1 = mark_sigelt_erased se g in (g1, []) @@ -2270,7 +2240,7 @@ let rec (extract_sig : let uu___8 = FStarC_Extraction_ML_RegEmb.maybe_register_plugin g1 se2 in - FStarC_Compiler_List.op_At ses uu___8 in + FStarC_List.op_At ses uu___8 in (g1, uu___7)) | FStarC_Syntax_Syntax.Sig_inductive_typ uu___5 -> let uu___6 = extract_bundle g se2 in @@ -2280,7 +2250,7 @@ let rec (extract_sig : let uu___8 = FStarC_Extraction_ML_RegEmb.maybe_register_plugin g1 se2 in - FStarC_Compiler_List.op_At ses uu___8 in + FStarC_List.op_At ses uu___8 in (g1, uu___7)) | FStarC_Syntax_Syntax.Sig_datacon uu___5 -> let uu___6 = extract_bundle g se2 in @@ -2290,7 +2260,7 @@ let rec (extract_sig : let uu___8 = FStarC_Extraction_ML_RegEmb.maybe_register_plugin g1 se2 in - FStarC_Compiler_List.op_At ses uu___8 in + FStarC_List.op_At ses uu___8 in (g1, uu___7)) | FStarC_Syntax_Syntax.Sig_new_effect ed when let uu___5 = FStarC_Extraction_ML_UEnv.tcenv_of_uenv g in @@ -2307,16 +2277,20 @@ let rec (extract_sig : | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = (uu___5, lbs); FStarC_Syntax_Syntax.lids1 = uu___6;_} - when FStarC_Compiler_List.for_all (lb_is_irrelevant g) lbs - -> (g, []) + when FStarC_List.for_all (lb_is_irrelevant g) lbs -> + (g, []) | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = (uu___5, lbs); FStarC_Syntax_Syntax.lids1 = uu___6;_} when - (let uu___7 = FStarC_Options.codegen () in - uu___7 <> - (FStar_Pervasives_Native.Some FStarC_Options.Plugin)) - && (FStarC_Compiler_List.for_all (lb_is_tactic g) lbs) + (let uu___7 = + let uu___8 = FStarC_Options.codegen () in + FStarC_List.mem uu___8 + [FStar_Pervasives_Native.Some FStarC_Options.Plugin; + FStar_Pervasives_Native.Some + FStarC_Options.PluginNoLib] in + Prims.op_Negation uu___7) && + (FStarC_List.for_all (lb_is_tactic g) lbs) -> (g, []) | FStarC_Syntax_Syntax.Sig_declare_typ { FStarC_Syntax_Syntax.lid2 = lid; @@ -2336,7 +2310,7 @@ let rec (extract_sig : lb.FStarC_Syntax_Syntax.lbtyp -> let uu___6 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___7 -> match uu___7 with | FStarC_Syntax_Syntax.Projector uu___8 -> true @@ -2355,7 +2329,7 @@ let rec (extract_sig : FStarC_Syntax_Syntax.lids1 = uu___5;_} when should_split_let_rec_types_and_terms g lbs -> let ses = split_let_rec_types_and_terms se2 g lbs in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___6 -> fun se3 -> match uu___6 with @@ -2363,13 +2337,13 @@ let rec (extract_sig : let uu___7 = extract_sig g1 se3 in (match uu___7 with | (g2, mls) -> - (g2, (FStarC_Compiler_List.op_At out mls)))) + (g2, (FStarC_List.op_At out mls)))) (g, []) ses | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = (true, lbs); FStarC_Syntax_Syntax.lids1 = uu___5;_} when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun lb -> FStarC_Extraction_ML_Term.is_arity g lb.FStarC_Syntax_Syntax.lbtyp) lbs @@ -2384,7 +2358,7 @@ let rec (extract_sig : (se2.FStarC_Syntax_Syntax.sigmeta).FStarC_Syntax_Syntax.sigmeta_extension_data -> let uu___6 = - FStarC_Compiler_List.tryPick + FStarC_List.tryPick (fun uu___7 -> match uu___7 with | (ext, blob) -> @@ -2408,7 +2382,7 @@ let rec (extract_sig : let mlattrs = extract_attrs g se2.FStarC_Syntax_Syntax.sigattrs in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___8 -> fun d -> match uu___8 with @@ -2419,7 +2393,7 @@ let rec (extract_sig : (maybe_rec, mllb::[]) -> let uu___9 = let uu___10 = - FStarC_Compiler_Util.must + FStarC_Util.must mllb.FStarC_Extraction_ML_Syntax.mllb_tysc in FStarC_Extraction_ML_UEnv.extend_lb g1 @@ -2459,8 +2433,8 @@ let rec (extract_sig : [mllb1])) mlattrs in [uu___13] in - FStarC_Compiler_List.op_At - decls1 uu___12 in + FStarC_List.op_At decls1 + uu___12 in (g2, uu___11)) | uu___9 -> let uu___10 = @@ -2468,13 +2442,13 @@ let rec (extract_sig : FStarC_Class_Show.show FStarC_Extraction_ML_Syntax.showable_mlmodule1 d in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unexpected ML decl returned by the extension: %s" uu___11 in failwith uu___10)) (g, []) decls | FStar_Pervasives.Inr err -> let uu___8 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Extension %s failed to extract term: %s" ext err in FStarC_Errors.raise_error @@ -2492,8 +2466,8 @@ let rec (extract_sig : -> let quals = se2.FStarC_Syntax_Syntax.sigquals in let uu___6 = - (FStarC_Compiler_List.contains - FStarC_Syntax_Syntax.Assumption quals) + (FStarC_List.contains FStarC_Syntax_Syntax.Assumption + quals) && (let uu___7 = let uu___8 = @@ -2534,7 +2508,7 @@ let rec (extract_sig : (match uu___7 with | (g1, mlm) -> let uu___8 = - FStarC_Compiler_Util.find_map quals + FStarC_Util.find_map quals (fun uu___9 -> match uu___9 with | FStarC_Syntax_Syntax.Discriminator l -> @@ -2561,7 +2535,7 @@ let rec (extract_sig : (g1, uu___9) | uu___9 -> let uu___10 = - FStarC_Compiler_Util.find_map quals + FStarC_Util.find_map quals (fun uu___11 -> match uu___11 with | FStarC_Syntax_Syntax.Projector @@ -2657,7 +2631,7 @@ and (extract_sig_let : | FStar_Pervasives_Native.None -> lbs1 | FStar_Pervasives_Native.Some tau -> let uu___3 = - FStarC_Compiler_List.map (postprocess_lb tau) + FStarC_List.map (postprocess_lb tau) (FStar_Pervasives_Native.snd lbs1) in ((FStar_Pervasives_Native.fst lbs1), uu___3) in let maybe_normalize_for_extraction lbs1 = @@ -2694,7 +2668,7 @@ and (extract_sig_let : let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term steps1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Ill-formed application of 'normalize_for_extraction': normalization steps '%s' could not be interpreted" uu___10 in FStarC_Errors.log_issue @@ -2853,7 +2827,7 @@ and (extract_sig_let : | FStar_Pervasives_Native.None -> lbs1 | FStar_Pervasives_Native.Some steps -> let uu___3 = - FStarC_Compiler_List.map (norm_one_lb steps) + FStarC_List.map (norm_one_lb steps) (FStar_Pervasives_Native.snd lbs1) in ((FStar_Pervasives_Native.fst lbs1), uu___3) in let uu___3 = @@ -2876,11 +2850,10 @@ and (extract_sig_let : (match ml_let.FStarC_Extraction_ML_Syntax.expr with | FStarC_Extraction_ML_Syntax.MLE_Let ((flavor, bindings), uu___6) -> - let flags = - FStarC_Compiler_List.choose flag_of_qual quals in + let flags = FStarC_List.choose flag_of_qual quals in let flags' = extract_metadata attrs in let uu___7 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___8 -> fun ml_lb -> fun uu___9 -> @@ -2895,7 +2868,7 @@ and (extract_sig_let : FStarC_Syntax_Syntax.lbpos = uu___14;_}) -> if - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Extraction_ML_Syntax.Erased ml_lb.FStarC_Extraction_ML_Syntax.mllb_meta then (env, ml_lbs) @@ -2903,8 +2876,7 @@ and (extract_sig_let : (let lb_lid = let uu___16 = let uu___17 = - FStarC_Compiler_Util.right - lbname in + FStarC_Util.right lbname in uu___17.FStarC_Syntax_Syntax.fv_name in uu___16.FStarC_Syntax_Syntax.v in let flags'' = @@ -2947,9 +2919,9 @@ and (extract_sig_let : [FStarC_Extraction_ML_Syntax.StackInline] | uu___17 -> [] in let meta = - FStarC_Compiler_List.op_At flags - (FStarC_Compiler_List.op_At - flags' flags'') in + FStarC_List.op_At flags + (FStarC_List.op_At flags' + flags'') in let ml_lb1 = { FStarC_Extraction_ML_Syntax.mllb_name @@ -2974,7 +2946,7 @@ and (extract_sig_let : } in let uu___16 = let uu___17 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___18 -> match uu___18 with | FStarC_Syntax_Syntax.Projector @@ -2984,10 +2956,9 @@ and (extract_sig_let : then let uu___18 = let uu___19 = - FStarC_Compiler_Util.right - lbname in + FStarC_Util.right lbname in let uu___20 = - FStarC_Compiler_Util.must + FStarC_Util.must ml_lb1.FStarC_Extraction_ML_Syntax.mllb_tysc in FStarC_Extraction_ML_UEnv.extend_fv env uu___19 uu___20 @@ -3020,7 +2991,7 @@ and (extract_sig_let : else (let uu___19 = let uu___20 = - FStarC_Compiler_Util.must + FStarC_Util.must ml_lb1.FStarC_Extraction_ML_Syntax.mllb_tysc in FStarC_Extraction_ML_UEnv.extend_lb env lbname t uu___20 @@ -3049,15 +3020,14 @@ and (extract_sig_let : let uu___12 = FStarC_Extraction_ML_Syntax.mk_mlmodule1_with_attrs (FStarC_Extraction_ML_Syntax.MLM_Let - (flavor, - (FStarC_Compiler_List.rev ml_lbs'))) + (flavor, (FStarC_List.rev ml_lbs'))) mlattrs in [uu___12] in uu___10 :: uu___11 in let uu___10 = FStarC_Extraction_ML_RegEmb.maybe_register_plugin g1 se in - FStarC_Compiler_List.op_At uu___9 uu___10 in + FStarC_List.op_At uu___9 uu___10 in (g1, uu___8)) | uu___6 -> let uu___7 = @@ -3067,7 +3037,7 @@ and (extract_sig_let : g in FStarC_Extraction_ML_Code.string_of_mlexpr uu___9 ml_let in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: Translated a let to a non-let: %s" uu___8 in failwith uu___7))) @@ -3093,37 +3063,34 @@ let (extract' : FStarC_Extraction_ML_UEnv.set_tcenv g1 uu___2 in let g3 = FStarC_Extraction_ML_UEnv.set_current_module g2 name in let uu___2 = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun g4 -> fun se -> - let uu___3 = FStarC_Compiler_Debug.any () in + let uu___3 = FStarC_Debug.any () in if uu___3 then let nm = let uu___4 = - FStarC_Compiler_List.map FStarC_Ident.string_of_lid - (FStarC_Syntax_Util.lids_of_sigelt se) in - FStarC_Compiler_String.concat ", " uu___4 in - (FStarC_Compiler_Util.print1 - "+++About to extract {%s}\n" nm; + let uu___5 = FStarC_Syntax_Util.lids_of_sigelt se in + FStarC_List.map FStarC_Ident.string_of_lid uu___5 in + FStarC_String.concat ", " uu___4 in + (FStarC_Util.print1 "+++About to extract {%s}\n" nm; (let r = let uu___5 = - FStarC_Compiler_Util.format1 "---Extracted {%s}" - nm in - FStarC_Compiler_Util.measure_execution_time uu___5 + FStarC_Util.format1 "---Extracted {%s}" nm in + FStarC_Util.measure_execution_time uu___5 (fun uu___6 -> extract_sig g4 se) in (let uu___6 = FStarC_Class_Show.show FStarC_Extraction_ML_Syntax.showable_mlmodule (FStar_Pervasives_Native.snd r) in - FStarC_Compiler_Util.print1 "Extraction result: %s\n" - uu___6); + FStarC_Util.print1 "Extraction result: %s\n" uu___6); r)) else extract_sig g4 se) g3 m.FStarC_Syntax_Syntax.declarations in (match uu___2 with | (g4, sigs) -> - let mlm = FStarC_Compiler_List.flatten sigs in + let mlm = FStarC_List.flatten sigs in let is_karamel = let uu___3 = FStarC_Options.codegen () in uu___3 = (FStar_Pervasives_Native.Some FStarC_Options.Krml) in @@ -3142,8 +3109,7 @@ let (extract' : then let uu___6 = FStarC_Ident.string_of_lid m.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.print1 "Extracted module %s\n" - uu___6 + FStarC_Util.print1 "Extracted module %s\n" uu___6 else ()); (g4, (FStar_Pervasives_Native.Some @@ -3177,7 +3143,7 @@ let (extract : let uu___3 = let uu___4 = FStarC_Ident.string_of_lid m.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Extract called on a module %s that should not be extracted" uu___4 in failwith uu___3 diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_ML_RegEmb.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_RegEmb.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_Extraction_ML_RegEmb.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_RegEmb.ml index 641bc0fdc1b..ce8a1ef8cb8 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_ML_RegEmb.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_RegEmb.ml @@ -13,8 +13,8 @@ let (__proj__Unsupported__item__uu___ : Prims.exn -> Prims.string) = fun projectee -> match projectee with | Unsupported uu___ -> uu___ let splitlast : 'uuuuu . 'uuuuu Prims.list -> ('uuuuu Prims.list * 'uuuuu) = fun s -> - let uu___ = FStarC_Compiler_List.rev s in - match uu___ with | x::xs -> ((FStarC_Compiler_List.rev xs), x) + let uu___ = FStarC_List.rev s in + match uu___ with | x::xs -> ((FStarC_List.rev xs), x) let (mk : FStarC_Extraction_ML_Syntax.mlexpr' -> FStarC_Extraction_ML_Syntax.mlexpr) = @@ -88,44 +88,53 @@ let (ml_some : FStarC_Extraction_ML_Syntax.mlexpr) = let (s_tdataconstr : FStarC_Extraction_ML_Syntax.mlexpr) = mk (FStarC_Extraction_ML_Syntax.MLE_Name - (splitlast ["FStarC"; "Syntax"; "Syntax"; "tdataconstr"])) + (splitlast ["Fstarcompiler.FStarC"; "Syntax"; "Syntax"; "tdataconstr"])) let (mk_app : FStarC_Extraction_ML_Syntax.mlexpr) = mk (FStarC_Extraction_ML_Syntax.MLE_Name - (splitlast ["FStarC"; "Syntax"; "Util"; "mk_app"])) + (splitlast ["Fstarcompiler.FStarC"; "Syntax"; "Util"; "mk_app"])) let (tm_fvar : FStarC_Extraction_ML_Syntax.mlexpr) = mk (FStarC_Extraction_ML_Syntax.MLE_Name - (splitlast ["FStarC"; "Syntax"; "Syntax"; "Tm_fvar"])) + (splitlast ["Fstarcompiler.FStarC"; "Syntax"; "Syntax"; "Tm_fvar"])) let (fv_eq_lid : FStarC_Extraction_ML_Syntax.mlexpr) = mk (FStarC_Extraction_ML_Syntax.MLE_Name - (splitlast ["FStarC"; "Syntax"; "Syntax"; "fv_eq_lid"])) + (splitlast ["Fstarcompiler.FStarC"; "Syntax"; "Syntax"; "fv_eq_lid"])) let (lid_of_str : FStarC_Extraction_ML_Syntax.mlexpr) = mk (FStarC_Extraction_ML_Syntax.MLE_Name - (splitlast ["FStarC"; "Ident"; "lid_of_str"])) + (splitlast ["Fstarcompiler.FStarC"; "Ident"; "lid_of_str"])) let (nil_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_str "Prims.Nil" let (cons_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_str "Prims.Cons" let (embed : FStarC_Extraction_ML_Syntax.mlexpr) = mk (FStarC_Extraction_ML_Syntax.MLE_Name (splitlast - ["FStarC"; "Syntax"; "Embeddings"; "Base"; "extracted_embed"])) + ["Fstarcompiler.FStarC"; + "Syntax"; + "Embeddings"; + "Base"; + "extracted_embed"])) let (unembed : FStarC_Extraction_ML_Syntax.mlexpr) = mk (FStarC_Extraction_ML_Syntax.MLE_Name (splitlast - ["FStarC"; "Syntax"; "Embeddings"; "Base"; "extracted_unembed"])) + ["Fstarcompiler.FStarC"; + "Syntax"; + "Embeddings"; + "Base"; + "extracted_unembed"])) let (bind_opt : FStarC_Extraction_ML_Syntax.mlexpr) = mk (FStarC_Extraction_ML_Syntax.MLE_Name - (splitlast ["FStarC"; "Compiler"; "Util"; "bind_opt"])) + (splitlast ["Fstarcompiler.FStarC"; "Util"; "bind_opt"])) let (ml_nbe_unsupported : FStarC_Extraction_ML_Syntax.mlexpr) = let hd = mk (FStarC_Extraction_ML_Syntax.MLE_Name - (["FStarC"; "TypeChecker"; "NBETerm"], "e_unsupported")) in + (["Fstarcompiler.FStarC"; "TypeChecker"; "NBETerm"], + "e_unsupported")) in mk (FStarC_Extraction_ML_Syntax.MLE_App (hd, [FStarC_Extraction_ML_Syntax.ml_unit])) @@ -180,13 +189,13 @@ let rec (pats_to_list_pat : ((["Prims"], "Cons"), uu___1) in FStarC_Extraction_ML_Syntax.MLP_CTor uu___ let (fresh : Prims.string -> Prims.string) = - let r = FStarC_Compiler_Util.mk_ref Prims.int_zero in + let r = FStarC_Util.mk_ref Prims.int_zero in fun s -> - let v = FStarC_Compiler_Effect.op_Bang r in - FStarC_Compiler_Effect.op_Colon_Equals r (v + Prims.int_one); + let v = FStarC_Effect.op_Bang r in + FStarC_Effect.op_Colon_Equals r (v + Prims.int_one); Prims.strcat s (Prims.strcat "_" (Prims.string_of_int v)) let (not_implemented_warning : - FStarC_Compiler_Range_Type.range -> Prims.string -> Prims.string -> unit) = + FStarC_Range_Type.range -> Prims.string -> Prims.string -> unit) = fun r -> fun t -> fun msg -> @@ -194,7 +203,7 @@ let (not_implemented_warning : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Plugin `%s' can not run natively because:" t in FStarC_Errors_Msg.text uu___3 in let uu___3 = FStarC_Errors_Msg.text msg in @@ -239,18 +248,21 @@ let (__proj__Mkembedding_data__item__nbe_emb : let (builtin_embeddings : (FStarC_Ident.lident * embedding_data) Prims.list) = let syn_emb_lid s = - FStarC_Ident.lid_of_path ["FStarC"; "Syntax"; "Embeddings"; s] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path + ["Fstarcompiler.FStarC"; "Syntax"; "Embeddings"; s] + FStarC_Range_Type.dummyRange in let nbe_emb_lid s = - FStarC_Ident.lid_of_path ["FStarC"; "TypeChecker"; "NBETerm"; s] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path + ["Fstarcompiler.FStarC"; "TypeChecker"; "NBETerm"; s] + FStarC_Range_Type.dummyRange in let refl_emb_lid s = - FStarC_Ident.lid_of_path ["FStarC"; "Reflection"; "V2"; "Embeddings"; s] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path + ["Fstarcompiler.FStarC"; "Reflection"; "V2"; "Embeddings"; s] + FStarC_Range_Type.dummyRange in let nbe_refl_emb_lid s = FStarC_Ident.lid_of_path - ["FStarC"; "Reflection"; "V2"; "NBEEmbeddings"; s] - FStarC_Compiler_Range_Type.dummyRange in + ["Fstarcompiler.FStarC"; "Reflection"; "V2"; "NBEEmbeddings"; s] + FStarC_Range_Type.dummyRange in let uu___ = let uu___1 = let uu___2 = syn_emb_lid "e_int" in @@ -365,7 +377,7 @@ let (builtin_embeddings : (FStarC_Ident.lident * embedding_data) Prims.list) let uu___20 = let uu___21 = FStarC_Parser_Const.mk_tuple_lid (Prims.of_int (2)) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___22 = let uu___23 = syn_emb_lid "e_tuple2" in let uu___24 = @@ -381,8 +393,7 @@ let (builtin_embeddings : (FStarC_Ident.lident * embedding_data) Prims.list) let uu___22 = let uu___23 = FStarC_Parser_Const.mk_tuple_lid - (Prims.of_int (3)) - FStarC_Compiler_Range_Type.dummyRange in + (Prims.of_int (3)) FStarC_Range_Type.dummyRange in let uu___24 = let uu___25 = syn_emb_lid "e_tuple3" in let uu___26 = @@ -1084,36 +1095,34 @@ let (builtin_embeddings : (FStarC_Ident.lident * embedding_data) Prims.list) uu___4 :: uu___5 in uu___2 :: uu___3 in uu___ :: uu___1 -let (dbg_plugin : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Plugins" +let (dbg_plugin : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Plugins" let (local_fv_embeddings : - (FStarC_Ident.lident * embedding_data) Prims.list - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref [] + (FStarC_Ident.lident * embedding_data) Prims.list FStarC_Effect.ref) = + FStarC_Util.mk_ref [] let (register_embedding : FStarC_Ident.lident -> embedding_data -> unit) = fun l -> fun d -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_plugin in + (let uu___1 = FStarC_Effect.op_Bang dbg_plugin in if uu___1 then let uu___2 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.print1 "Registering local embedding for %s\n" - uu___2 + FStarC_Util.print1 "Registering local embedding for %s\n" uu___2 else ()); (let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang local_fv_embeddings in - (l, d) :: uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals local_fv_embeddings uu___1) + let uu___2 = FStarC_Effect.op_Bang local_fv_embeddings in (l, d) :: + uu___2 in + FStarC_Effect.op_Colon_Equals local_fv_embeddings uu___1) let (list_local : unit -> (FStarC_Ident.lident * embedding_data) Prims.list) - = fun uu___ -> FStarC_Compiler_Effect.op_Bang local_fv_embeddings + = fun uu___ -> FStarC_Effect.op_Bang local_fv_embeddings let (find_fv_embedding' : FStarC_Ident.lident -> embedding_data FStar_Pervasives_Native.option) = fun l -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang local_fv_embeddings in - FStarC_Compiler_List.op_At uu___2 builtin_embeddings in - FStarC_Compiler_List.find + let uu___2 = FStarC_Effect.op_Bang local_fv_embeddings in + FStarC_List.op_At uu___2 builtin_embeddings in + FStarC_List.find (fun uu___2 -> match uu___2 with | (l', uu___3) -> FStarC_Ident.lid_equals l l') uu___1 in @@ -1132,7 +1141,7 @@ let (find_fv_embedding : FStarC_Ident.lident -> embedding_data) = let uu___3 = FStarC_Ident.string_of_lid l in Prims.strcat "Embedding not defined for type " uu___3 in NoEmbedding uu___2 in - FStarC_Compiler_Effect.raise uu___1 + FStarC_Effect.raise uu___1 type embedding_kind = | SyntaxTerm | NBETerm @@ -1159,11 +1168,13 @@ let rec (embedding_for : | SyntaxTerm -> mk (FStarC_Extraction_ML_Syntax.MLE_Name - (["FStarC"; "Syntax"; "Embeddings"], "e_arrow")) + (["Fstarcompiler.FStarC"; "Syntax"; "Embeddings"], + "e_arrow")) | NBETerm -> mk (FStarC_Extraction_ML_Syntax.MLE_Name - (["FStarC"; "TypeChecker"; "NBETerm"], "e_arrow")) in + (["Fstarcompiler.FStarC"; "TypeChecker"; "NBETerm"], + "e_arrow")) in mk (FStarC_Extraction_ML_Syntax.MLE_App (comb, [e1; e2])) in let find_env_entry bv uu___ = match uu___ with @@ -1173,23 +1184,24 @@ let rec (embedding_for : let t3 = FStarC_Syntax_Subst.compress t2 in match t3.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_name bv when - FStarC_Compiler_Util.for_some (find_env_entry bv) env -> + FStarC_Util.for_some (find_env_entry bv) env -> let comb = match k with | SyntaxTerm -> mk (FStarC_Extraction_ML_Syntax.MLE_Name - (["FStarC"; "Syntax"; "Embeddings"], "mk_any_emb")) + (["Fstarcompiler.FStarC"; "Syntax"; "Embeddings"], + "mk_any_emb")) | NBETerm -> mk (FStarC_Extraction_ML_Syntax.MLE_Name - (["FStarC"; "TypeChecker"; "NBETerm"], - "mk_any_emb")) in + (["Fstarcompiler.FStarC"; + "TypeChecker"; + "NBETerm"], "mk_any_emb")) in let s = let uu___ = - let uu___1 = - FStarC_Compiler_Util.find_opt (find_env_entry bv) env in - FStarC_Compiler_Util.must uu___1 in + let uu___1 = FStarC_Util.find_opt (find_env_entry bv) env in + FStarC_Util.must uu___1 in FStar_Pervasives_Native.snd uu___ in let uu___ = let uu___1 = @@ -1248,7 +1260,7 @@ let rec (embedding_for : | (head, args) -> let e_head = embedding_for tcenv mutuals k env head in let e_args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (t4, uu___3) -> @@ -1256,7 +1268,7 @@ let rec (embedding_for : mk (FStarC_Extraction_ML_Syntax.MLE_App (e_head, e_args))) | FStarC_Syntax_Syntax.Tm_fvar fv when - FStarC_Compiler_List.existsb + FStarC_List.existsb (FStarC_Ident.lid_equals (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v) mutuals @@ -1300,8 +1312,7 @@ let rec (embedding_for : let uu___ = let uu___1 = let uu___2 = FStarC_Ident.ns_of_lid lid in - FStarC_Compiler_List.map FStarC_Ident.string_of_id - uu___2 in + FStarC_List.map FStarC_Ident.string_of_id uu___2 in let uu___2 = let uu___3 = let uu___4 = FStarC_Ident.ident_of_lid lid in @@ -1316,10 +1327,10 @@ let rec (embedding_for : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t3 in - FStarC_Compiler_Util.format1 - "Embedding not defined for name `%s'" uu___2 in + FStarC_Util.format1 "Embedding not defined for name `%s'" + uu___2 in NoEmbedding uu___1 in - FStarC_Compiler_Effect.raise uu___ + FStarC_Effect.raise uu___ | uu___ -> let uu___1 = let uu___2 = @@ -1329,10 +1340,10 @@ let rec (embedding_for : let uu___4 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t3 in - FStarC_Compiler_Util.format2 - "Cannot embed type `%s' (%s)" uu___3 uu___4 in + FStarC_Util.format2 "Cannot embed type `%s' (%s)" uu___3 + uu___4 in NoEmbedding uu___2 in - FStarC_Compiler_Effect.raise uu___1 + FStarC_Effect.raise uu___1 type wrapped_term = (FStarC_Extraction_ML_Syntax.mlexpr * FStarC_Extraction_ML_Syntax.mlexpr * Prims.int * Prims.bool) @@ -1375,7 +1386,8 @@ let (interpret_plugin_as_term_fun : let fv_lid_embedded = let uu___ = let uu___1 = - let uu___2 = as_name1 (["FStarC_Ident"], "lid_of_str") in + let uu___2 = + as_name1 (["Fstarcompiler.FStarC_Ident"], "lid_of_str") in let uu___3 = let uu___4 = let uu___5 = @@ -1393,7 +1405,7 @@ let (interpret_plugin_as_term_fun : let mk_tactic_interpretation l arity = if arity > FStarC_Tactics_InterpFuns.max_tac_arity then - FStarC_Compiler_Effect.raise + FStarC_Effect.raise (NoEmbedding "tactic plugins can only take up to 20 arguments") else @@ -1402,7 +1414,7 @@ let (interpret_plugin_as_term_fun : | SyntaxTerm -> "mk_tactic_interpretation_" | NBETerm -> "mk_nbe_tactic_interpretation_" in as_name1 - (["FStarC_Tactics_InterpFuns"], + (["Fstarcompiler.FStarC_Tactics_InterpFuns"], (Prims.strcat idroot (Prims.string_of_int arity)))) in let mk_from_tactic l arity = let idroot = @@ -1410,13 +1422,15 @@ let (interpret_plugin_as_term_fun : | SyntaxTerm -> "from_tactic_" | NBETerm -> "from_nbe_tactic_" in as_name1 - (["FStarC_Tactics_Native"], + (["Fstarcompiler.FStarC_Tactics_Native"], (Prims.strcat idroot (Prims.string_of_int arity))) in let mk_arrow_as_prim_step k arity = let modul = match k with - | SyntaxTerm -> ["FStarC"; "Syntax"; "Embeddings"] - | NBETerm -> ["FStarC"; "TypeChecker"; "NBETerm"] in + | SyntaxTerm -> + ["Fstarcompiler.FStarC"; "Syntax"; "Embeddings"] + | NBETerm -> + ["Fstarcompiler.FStarC"; "TypeChecker"; "NBETerm"] in as_name1 (modul, (Prims.strcat "arrow_as_prim_step_" @@ -1429,7 +1443,8 @@ let (interpret_plugin_as_term_fun : let uu___1 = let uu___2 = as_name1 - (["FStarC_Syntax_Embeddings"], "debug_wrap") in + (["Fstarcompiler.FStarC_Syntax_Embeddings"], + "debug_wrap") in let uu___3 = let uu___4 = let uu___5 = @@ -1469,7 +1484,7 @@ let (interpret_plugin_as_term_fun : [FStarC_Extraction_ML_Syntax.MLP_Var v; FStarC_Extraction_ML_Syntax.MLP_Wild] in let pattern = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun hd_var -> mk_cons (fst_pat hd_var)) tvar_names args_tail in let branch = @@ -1512,7 +1527,8 @@ let (interpret_plugin_as_term_fun : let uu___2 = let uu___3 = as_name1 - (["FStarC_Syntax_Embeddings"], "debug_wrap") in + (["Fstarcompiler.FStarC_Syntax_Embeddings"], + "debug_wrap") in let uu___4 = let uu___5 = let uu___6 = @@ -1537,13 +1553,13 @@ let (interpret_plugin_as_term_fun : match arity_opt with | FStar_Pervasives_Native.None -> (bs, c) | FStar_Pervasives_Native.Some n -> - let n_bs = FStarC_Compiler_List.length bs in + let n_bs = FStarC_List.length bs in if n = n_bs then (bs, c) else if n < n_bs then - (let uu___3 = FStarC_Compiler_Util.first_N n bs in + (let uu___3 = FStarC_Util.first_N n bs in match uu___3 with | (bs1, rest) -> let c1 = @@ -1553,21 +1569,19 @@ let (interpret_plugin_as_term_fun : else (let msg = let uu___4 = FStarC_Ident.string_of_lid fv_lid in - let uu___5 = - FStarC_Compiler_Util.string_of_int n in - let uu___6 = - FStarC_Compiler_Util.string_of_int n_bs in - FStarC_Compiler_Util.format3 + let uu___5 = FStarC_Util.string_of_int n in + let uu___6 = FStarC_Util.string_of_int n_bs in + FStarC_Util.format3 "Embedding not defined for %s; expected arity at least %s; got %s" uu___4 uu___5 uu___6 in - FStarC_Compiler_Effect.raise (NoEmbedding msg)) in + FStarC_Effect.raise (NoEmbedding msg)) in (match uu___1 with | (bs1, c1) -> let result_typ = FStarC_Syntax_Util.comp_result c1 in - let arity = FStarC_Compiler_List.length bs1 in + let arity = FStarC_List.length bs1 in let uu___2 = let uu___3 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun uu___4 -> match uu___4 with | { FStarC_Syntax_Syntax.binder_bv = b; @@ -1591,18 +1605,16 @@ let (interpret_plugin_as_term_fun : (tvars, (x :: rest)) in (match uu___2 with | (type_vars, bs2) -> - let tvar_arity = - FStarC_Compiler_List.length type_vars in - let non_tvar_arity = - FStarC_Compiler_List.length bs2 in + let tvar_arity = FStarC_List.length type_vars in + let non_tvar_arity = FStarC_List.length bs2 in let tvar_names = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun tv -> Prims.strcat "tv_" (Prims.string_of_int i)) type_vars in let tvar_context = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun nm -> ((b.FStarC_Syntax_Syntax.binder_bv), nm)) @@ -1611,7 +1623,7 @@ let (interpret_plugin_as_term_fun : match bs3 with | [] -> let arg_unembeddings = - FStarC_Compiler_List.rev accum_embeddings in + FStarC_List.rev accum_embeddings in let res_embedding = embedding_for tcenv [] loc tvar_context result_typ in @@ -1631,8 +1643,7 @@ let (interpret_plugin_as_term_fun : let uu___6 = lid_to_name fv_lid1 in [uu___6; fv_lid_embedded; cb; us] in res_embedding :: uu___5 in - FStarC_Compiler_List.op_At - arg_unembeddings uu___4 in + FStarC_List.op_At arg_unembeddings uu___4 in let fun_embedding = mk (FStarC_Extraction_ML_Syntax.MLE_App @@ -1650,10 +1661,11 @@ let (interpret_plugin_as_term_fun : else (let uu___5 = let uu___6 = + let uu___7 = + FStarC_Syntax_Util.comp_effect_name + c1 in FStarC_TypeChecker_Env.norm_eff_name - tcenv - (FStarC_Syntax_Util.comp_effect_name - c1) in + tcenv uu___7 in FStarC_Ident.lid_equals uu___6 FStarC_Parser_Const.effect_TAC_lid in if uu___5 @@ -1696,10 +1708,9 @@ let (interpret_plugin_as_term_fun : uu___9 in mk uu___8 in [uu___7] in - FStarC_Compiler_List.op_At uu___6 - (FStarC_Compiler_List.op_At - [tac_fun] - (FStarC_Compiler_List.op_At + FStarC_List.op_At uu___6 + (FStarC_List.op_At [tac_fun] + (FStarC_List.op_At arg_unembeddings [res_embedding; psc; ncb; us])) in let tabs = @@ -1709,8 +1720,8 @@ let (interpret_plugin_as_term_fun : mk (FStarC_Extraction_ML_Syntax.MLE_App (h, - (FStarC_Compiler_List.op_At - args [all_args]))) in + (FStarC_List.op_At args + [all_args]))) in ml_lam "args" uu___6 | uu___6 -> let uu___7 = @@ -1735,7 +1746,7 @@ let (interpret_plugin_as_term_fun : "Plugins not defined for type " uu___9 in NoEmbedding uu___8 in - FStarC_Compiler_Effect.raise uu___7)) + FStarC_Effect.raise uu___7)) | { FStarC_Syntax_Syntax.binder_bv = b; FStarC_Syntax_Syntax.binder_qual = uu___3; FStarC_Syntax_Syntax.binder_positivity = @@ -1782,9 +1793,9 @@ let (mk_unembed : fun mutuals -> fun record_fields -> fun ctors -> - let e_branches = FStarC_Compiler_Util.mk_ref [] in + let e_branches = FStarC_Util.mk_ref [] in let arg_v = fresh "tm" in - FStarC_Compiler_List.iter + FStarC_List.iter (fun ctor -> match ctor.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -1801,7 +1812,7 @@ let (mk_unembed : (match uu___3 with | (bs, c) -> let vs = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___4 = let uu___5 = @@ -1818,7 +1829,7 @@ let (mk_unembed : FStarC_Extraction_ML_Syntax.MLP_Const uu___4 in let pat_args = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (v, uu___6) -> @@ -1832,7 +1843,7 @@ let (mk_unembed : match record_fields with | FStar_Pervasives_Native.Some fields -> let uu___4 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___5 -> fun fld -> match uu___5 with @@ -1846,7 +1857,7 @@ let (mk_unembed : ml_record lid uu___4 | FStar_Pervasives_Native.None -> let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (v, uu___6) -> @@ -1859,7 +1870,7 @@ let (mk_unembed : (FStarC_Extraction_ML_Syntax.MLE_App (ml_some, [ret])) in let body = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___4 -> fun body1 -> match uu___4 with @@ -1900,20 +1911,18 @@ let (mk_unembed : let br = (pat_both, FStar_Pervasives_Native.None, body) in let uu___4 = - let uu___5 = - FStarC_Compiler_Effect.op_Bang e_branches in - br :: uu___5 in - FStarC_Compiler_Effect.op_Colon_Equals e_branches - uu___4) + let uu___5 = FStarC_Effect.op_Bang e_branches in br + :: uu___5 in + FStarC_Effect.op_Colon_Equals e_branches uu___4) | uu___1 -> failwith "impossible, filter above") ctors; (let nomatch = (FStarC_Extraction_ML_Syntax.MLP_Wild, FStar_Pervasives_Native.None, ml_none) in let branches = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang e_branches in - nomatch :: uu___2 in - FStarC_Compiler_List.rev uu___1 in + let uu___2 = FStarC_Effect.op_Bang e_branches in nomatch :: + uu___2 in + FStarC_List.rev uu___1 in let sc = mk (FStarC_Extraction_ML_Syntax.MLE_Var arg_v) in let def = mk (FStarC_Extraction_ML_Syntax.MLE_Match (sc, branches)) in @@ -1935,9 +1944,9 @@ let (mk_embed : fun mutuals -> fun record_fields -> fun ctors -> - let e_branches = FStarC_Compiler_Util.mk_ref [] in + let e_branches = FStarC_Util.mk_ref [] in let arg_v = fresh "tm" in - FStarC_Compiler_List.iter + FStarC_List.iter (fun ctor -> match ctor.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -1954,7 +1963,7 @@ let (mk_embed : (match uu___3 with | (bs, c) -> let vs = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___4 = let uu___5 = @@ -1969,7 +1978,7 @@ let (mk_embed : | FStar_Pervasives_Native.Some fields -> let uu___4 = let uu___5 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun v -> fun fld -> ((FStar_Pervasives_Native.snd fld), @@ -1984,7 +1993,7 @@ let (mk_embed : let uu___6 = FStarC_Ident.path_of_lid lid in splitlast uu___6 in let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun v -> FStarC_Extraction_ML_Syntax.MLP_Var (FStar_Pervasives_Native.fst v)) vs in @@ -2022,7 +2031,7 @@ let (mk_embed : mk uu___4 in let mk_mk_app t1 ts = let ts1 = - FStarC_Compiler_List.map + FStarC_List.map (fun t2 -> mk (FStarC_Extraction_ML_Syntax.MLE_Tuple @@ -2037,7 +2046,7 @@ let (mk_embed : FStarC_Extraction_ML_Syntax.MLE_App uu___5 in mk uu___4 in let args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (v, ty) -> @@ -2058,15 +2067,13 @@ let (mk_embed : let ret = mk_mk_app head args in let br = (pat, FStar_Pervasives_Native.None, ret) in let uu___4 = - let uu___5 = - FStarC_Compiler_Effect.op_Bang e_branches in - br :: uu___5 in - FStarC_Compiler_Effect.op_Colon_Equals e_branches - uu___4) + let uu___5 = FStarC_Effect.op_Bang e_branches in br + :: uu___5 in + FStarC_Effect.op_Colon_Equals e_branches uu___4) | uu___1 -> failwith "impossible, filter above") ctors; (let branches = - let uu___1 = FStarC_Compiler_Effect.op_Bang e_branches in - FStarC_Compiler_List.rev uu___1 in + let uu___1 = FStarC_Effect.op_Bang e_branches in + FStarC_List.rev uu___1 in let sc = mk (FStarC_Extraction_ML_Syntax.MLE_Var arg_v) in let def = mk (FStarC_Extraction_ML_Syntax.MLE_Match (sc, branches)) in @@ -2092,8 +2099,7 @@ let (__do_handle_plugin : FStarC_Syntax_Syntax.lids1 = uu___;_} -> let mk_registration lb = - let fv = - FStarC_Compiler_Util.right lb.FStarC_Syntax_Syntax.lbname in + let fv = FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let fv_lid = (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in let fv_t = lb.FStarC_Syntax_Syntax.lbtyp in @@ -2110,11 +2116,11 @@ let (__do_handle_plugin : let uu___2 = if plugin then - ((["FStarC_Tactics_Native"], "register_plugin"), - [interp; nbe_interp]) + ((["Fstarcompiler.FStarC_Tactics_Native"], + "register_plugin"), [interp; nbe_interp]) else - ((["FStarC_Tactics_Native"], "register_tactic"), - [interp]) in + ((["Fstarcompiler.FStarC_Tactics_Native"], + "register_tactic"), [interp]) in (match uu___2 with | (register, args) -> let h = @@ -2135,7 +2141,7 @@ let (__do_handle_plugin : let uu___8 = let uu___9 = mk arity1 in [uu___9] in uu___7 :: uu___8 in - FStarC_Compiler_List.op_At uu___6 args in + FStarC_List.op_At uu___6 args in (h, uu___5) in FStarC_Extraction_ML_Syntax.MLE_App uu___4 in FStarC_Extraction_ML_Syntax.with_ty @@ -2145,20 +2151,20 @@ let (__do_handle_plugin : (FStarC_Extraction_ML_Syntax.MLM_Top app) in [uu___3]) | FStar_Pervasives_Native.None -> [] in - FStarC_Compiler_List.collect mk_registration + FStarC_List.collect mk_registration (FStar_Pervasives_Native.snd lbs) | FStarC_Syntax_Syntax.Sig_bundle { FStarC_Syntax_Syntax.ses = ses; FStarC_Syntax_Syntax.lids = uu___;_} -> let mutual_sigelts = - FStarC_Compiler_List.filter + FStarC_List.filter (fun se1 -> match se1.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ uu___1 -> true | uu___1 -> false) ses in let mutual_lids = - FStarC_Compiler_List.map + FStarC_List.map (fun se1 -> match se1.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ @@ -2184,19 +2190,19 @@ let (__do_handle_plugin : FStarC_Syntax_Syntax.ds = uu___6; FStarC_Syntax_Syntax.injective_type_params = uu___7;_} -> - (if (FStarC_Compiler_List.length ps) > Prims.int_zero + (if (FStarC_List.length ps) > Prims.int_zero then - FStarC_Compiler_Effect.raise + FStarC_Effect.raise (Unsupported "parameters on inductive") else (); (let ns = FStarC_Ident.ns_of_lid tlid in let name = let uu___9 = let uu___10 = FStarC_Ident.ids_of_lid tlid in - FStarC_Compiler_List.last uu___10 in + FStarC_List.last uu___10 in FStarC_Ident.string_of_id uu___9 in let ctors = - FStarC_Compiler_List.filter + FStarC_List.filter (fun se1 -> match se1.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -2219,7 +2225,7 @@ let (__do_handle_plugin : mk uu___9 in let record_fields = let uu___9 = - FStarC_Compiler_List.find + FStarC_List.find (fun uu___10 -> match uu___10 with | FStarC_Syntax_Syntax.RecordType uu___11 -> @@ -2230,7 +2236,7 @@ let (__do_handle_plugin : | FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.RecordType (uu___10, b)) -> let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun f -> FStarC_Extraction_ML_UEnv.lookup_record_field_name g (tlid, f)) b in @@ -2247,8 +2253,10 @@ let (__do_handle_plugin : let uu___11 = mk (FStarC_Extraction_ML_Syntax.MLE_Name - (["FStarC"; "Syntax"; "Embeddings"; "Base"], - "mk_extracted_embedding")) in + (["Fstarcompiler.FStarC"; + "Syntax"; + "Embeddings"; + "Base"], "mk_extracted_embedding")) in (uu___11, [ml_name1; ml_unembed; ml_embed]) in FStarC_Extraction_ML_Syntax.MLE_App uu___10 in mk uu___9 in @@ -2274,7 +2282,7 @@ let (__do_handle_plugin : let uu___12 = FStarC_Ident.mk_ident ((Prims.strcat "e_" name), - FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Range_Type.dummyRange) in FStarC_Ident.lid_of_ns_and_id ns uu___12 in { arity = Prims.int_zero; @@ -2283,9 +2291,9 @@ let (__do_handle_plugin : } in register_embedding tlid uu___10); [lb])) in - let lbs = FStarC_Compiler_List.concatMap proc_one mutual_sigelts in + let lbs = FStarC_List.concatMap proc_one mutual_sigelts in let unthunking = - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun se1 -> let tlid = match se1.FStarC_Syntax_Syntax.sigel with @@ -2303,7 +2311,7 @@ let (__do_handle_plugin : let name = let uu___1 = let uu___2 = FStarC_Ident.ids_of_lid tlid in - FStarC_Compiler_List.last uu___2 in + FStarC_List.last uu___2 in FStarC_Ident.string_of_id uu___1 in let app = let head = @@ -2336,7 +2344,7 @@ let (__do_handle_plugin : (FStarC_Extraction_ML_Syntax.MLM_Let (FStarC_Extraction_ML_Syntax.Rec, lbs)) in [uu___2] in - FStarC_Compiler_List.op_At uu___1 unthunking + FStarC_List.op_At uu___1 unthunking | uu___ -> [] let (do_handle_plugin : FStarC_Extraction_ML_UEnv.uenv -> @@ -2354,7 +2362,7 @@ let (do_handle_plugin : | Unsupported msg -> ((let uu___2 = let uu___3 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Could not generate a plugin for %s, reason = %s" uu___3 msg in FStarC_Errors.log_issue FStarC_Syntax_Syntax.has_range_sigelt @@ -2375,7 +2383,7 @@ let (maybe_register_plugin : fun g -> fun se -> let plugin_with_arity attrs = - FStarC_Compiler_Util.find_map attrs + FStarC_Util.find_map attrs (fun t -> let uu___ = FStarC_Syntax_Util.head_and_args t in match uu___ with @@ -2399,8 +2407,12 @@ let (maybe_register_plugin : FStar_Pervasives_Native.Some FStar_Pervasives_Native.None)) in let uu___ = - let uu___1 = FStarC_Options.codegen () in - uu___1 <> (FStar_Pervasives_Native.Some FStarC_Options.Plugin) in + let uu___1 = + let uu___2 = FStarC_Options.codegen () in + FStarC_List.mem uu___2 + [FStar_Pervasives_Native.Some FStarC_Options.Plugin; + FStar_Pervasives_Native.Some FStarC_Options.PluginNoLib] in + Prims.op_Negation uu___1 in if uu___ then [] else @@ -2408,7 +2420,7 @@ let (maybe_register_plugin : match uu___2 with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some uu___3 when - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___4 -> match uu___4 with | FStarC_Syntax_Syntax.Projector uu___5 -> true diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_ML_RemoveUnusedParameters.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_RemoveUnusedParameters.ml similarity index 85% rename from stage0/fstar-lib/generated/FStarC_Extraction_ML_RemoveUnusedParameters.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_RemoveUnusedParameters.ml index 51a9ce9e6c6..346acc838f7 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_ML_RemoveUnusedParameters.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_RemoveUnusedParameters.ml @@ -10,17 +10,16 @@ type entry = argument_tag Prims.list type env_t = { current_module: FStarC_Extraction_ML_Syntax.mlsymbol Prims.list ; - tydef_map: entry FStarC_Compiler_Util.psmap } + tydef_map: entry FStarC_Util.psmap } let (__proj__Mkenv_t__item__current_module : env_t -> FStarC_Extraction_ML_Syntax.mlsymbol Prims.list) = fun projectee -> match projectee with | { current_module; tydef_map;_} -> current_module -let (__proj__Mkenv_t__item__tydef_map : - env_t -> entry FStarC_Compiler_Util.psmap) = +let (__proj__Mkenv_t__item__tydef_map : env_t -> entry FStarC_Util.psmap) = fun projectee -> match projectee with | { current_module; tydef_map;_} -> tydef_map let (initial_env : env_t) = - let uu___ = FStarC_Compiler_Util.psmap_empty () in + let uu___ = FStarC_Util.psmap_empty () in { current_module = []; tydef_map = uu___ } type tydef = (FStarC_Extraction_ML_Syntax.mlsymbol * @@ -36,7 +35,7 @@ let (extend_env : let uu___1 = FStarC_Extraction_ML_Syntax.string_of_mlpath ((env.current_module), i) in - FStarC_Compiler_Util.psmap_add env.tydef_map uu___1 e in + FStarC_Util.psmap_add env.tydef_map uu___1 e in { current_module = (env.current_module); tydef_map = uu___ } let (lookup_tyname : env_t -> @@ -46,13 +45,12 @@ let (lookup_tyname : fun env -> fun name -> let uu___ = FStarC_Extraction_ML_Syntax.string_of_mlpath name in - FStarC_Compiler_Util.psmap_try_find env.tydef_map uu___ -type var_set = FStarC_Extraction_ML_Syntax.mlident FStarC_Compiler_RBSet.t -let (empty_var_set : Prims.string FStarC_Compiler_RBSet.t) = + FStarC_Util.psmap_try_find env.tydef_map uu___ +type var_set = FStarC_Extraction_ML_Syntax.mlident FStarC_RBSet.t +let (empty_var_set : Prims.string FStarC_RBSet.t) = Obj.magic (FStarC_Class_Setlike.empty () - (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) + (Obj.magic (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) ()) let rec (freevars_of_mlty' : var_set -> FStarC_Extraction_ML_Syntax.mlty -> var_set) = @@ -66,7 +64,7 @@ let rec (freevars_of_mlty' : (Obj.repr (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) i (Obj.magic vars))) | FStarC_Extraction_ML_Syntax.MLTY_Fun (t0, uu___, t1) -> Obj.magic @@ -75,14 +73,10 @@ let rec (freevars_of_mlty' : freevars_of_mlty' uu___1 t1)) | FStarC_Extraction_ML_Syntax.MLTY_Named (tys, uu___) -> Obj.magic - (Obj.repr - (FStarC_Compiler_List.fold_left freevars_of_mlty' vars - tys)) + (Obj.repr (FStarC_List.fold_left freevars_of_mlty' vars tys)) | FStarC_Extraction_ML_Syntax.MLTY_Tuple tys -> Obj.magic - (Obj.repr - (FStarC_Compiler_List.fold_left freevars_of_mlty' vars - tys)) + (Obj.repr (FStarC_List.fold_left freevars_of_mlty' vars tys)) | uu___ -> Obj.magic (Obj.repr vars)) uu___1 uu___ let (freevars_of_mlty : FStarC_Extraction_ML_Syntax.mlty -> var_set) = freevars_of_mlty' empty_var_set @@ -100,21 +94,19 @@ let rec (elim_mlty : let uu___2 = elim_mlty env t1 in (uu___1, e, uu___2) in FStarC_Extraction_ML_Syntax.MLTY_Fun uu___ | FStarC_Extraction_ML_Syntax.MLTY_Named (args, name) -> - let args1 = FStarC_Compiler_List.map (elim_mlty env) args in + let args1 = FStarC_List.map (elim_mlty env) args in let uu___ = lookup_tyname env name in (match uu___ with | FStar_Pervasives_Native.None -> FStarC_Extraction_ML_Syntax.MLTY_Named (args1, name) | FStar_Pervasives_Native.Some entry1 -> - (if - (FStarC_Compiler_List.length entry1) <> - (FStarC_Compiler_List.length args1) + (if (FStarC_List.length entry1) <> (FStarC_List.length args1) then failwith "Impossible: arity mismatch between definition and use" else (); (let args2 = - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun arg -> fun tag -> fun out -> @@ -123,7 +115,7 @@ let rec (elim_mlty : | uu___2 -> out) args1 entry1 [] in FStarC_Extraction_ML_Syntax.MLTY_Named (args2, name)))) | FStarC_Extraction_ML_Syntax.MLTY_Tuple tys -> - let uu___ = FStarC_Compiler_List.map (elim_mlty env) tys in + let uu___ = FStarC_List.map (elim_mlty env) tys in FStarC_Extraction_ML_Syntax.MLTY_Tuple uu___ | FStarC_Extraction_ML_Syntax.MLTY_Top -> mlty | FStarC_Extraction_ML_Syntax.MLTY_Erased -> mlty @@ -146,23 +138,22 @@ let rec (elim_mlexpr' : | FStarC_Extraction_ML_Syntax.MLE_App (e1, es) -> let uu___ = let uu___1 = elim_mlexpr env e1 in - let uu___2 = FStarC_Compiler_List.map (elim_mlexpr env) es in + let uu___2 = FStarC_List.map (elim_mlexpr env) es in (uu___1, uu___2) in FStarC_Extraction_ML_Syntax.MLE_App uu___ | FStarC_Extraction_ML_Syntax.MLE_TApp (e1, tys) -> let uu___ = - let uu___1 = FStarC_Compiler_List.map (elim_mlty env) tys in - (e1, uu___1) in + let uu___1 = FStarC_List.map (elim_mlty env) tys in (e1, uu___1) in FStarC_Extraction_ML_Syntax.MLE_TApp uu___ | FStarC_Extraction_ML_Syntax.MLE_Fun (bvs, e1) -> let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___2 = elim_mlty env b.FStarC_Extraction_ML_Syntax.mlbinder_ty in let uu___3 = - FStarC_Compiler_List.map (elim_mlexpr env) + FStarC_List.map (elim_mlexpr env) b.FStarC_Extraction_ML_Syntax.mlbinder_attrs in { FStarC_Extraction_ML_Syntax.mlbinder_name = @@ -175,7 +166,7 @@ let rec (elim_mlexpr' : | FStarC_Extraction_ML_Syntax.MLE_Match (e1, branches) -> let uu___ = let uu___1 = elim_mlexpr env e1 in - let uu___2 = FStarC_Compiler_List.map (elim_branch env) branches in + let uu___2 = FStarC_List.map (elim_branch env) branches in (uu___1, uu___2) in FStarC_Extraction_ML_Syntax.MLE_Match uu___ | FStarC_Extraction_ML_Syntax.MLE_Coerce (e1, t0, t1) -> @@ -186,19 +177,18 @@ let rec (elim_mlexpr' : FStarC_Extraction_ML_Syntax.MLE_Coerce uu___ | FStarC_Extraction_ML_Syntax.MLE_CTor (l, es) -> let uu___ = - let uu___1 = FStarC_Compiler_List.map (elim_mlexpr env) es in - (l, uu___1) in + let uu___1 = FStarC_List.map (elim_mlexpr env) es in (l, uu___1) in FStarC_Extraction_ML_Syntax.MLE_CTor uu___ | FStarC_Extraction_ML_Syntax.MLE_Seq es -> - let uu___ = FStarC_Compiler_List.map (elim_mlexpr env) es in + let uu___ = FStarC_List.map (elim_mlexpr env) es in FStarC_Extraction_ML_Syntax.MLE_Seq uu___ | FStarC_Extraction_ML_Syntax.MLE_Tuple es -> - let uu___ = FStarC_Compiler_List.map (elim_mlexpr env) es in + let uu___ = FStarC_List.map (elim_mlexpr env) es in FStarC_Extraction_ML_Syntax.MLE_Tuple uu___ | FStarC_Extraction_ML_Syntax.MLE_Record (syms, nm, fields) -> let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (s, e1) -> @@ -212,19 +202,17 @@ let rec (elim_mlexpr' : let uu___ = let uu___1 = elim_mlexpr env e1 in let uu___2 = elim_mlexpr env e11 in - let uu___3 = - FStarC_Compiler_Util.map_opt e2_opt (elim_mlexpr env) in + let uu___3 = FStarC_Util.map_opt e2_opt (elim_mlexpr env) in (uu___1, uu___2, uu___3) in FStarC_Extraction_ML_Syntax.MLE_If uu___ | FStarC_Extraction_ML_Syntax.MLE_Raise (p, es) -> let uu___ = - let uu___1 = FStarC_Compiler_List.map (elim_mlexpr env) es in - (p, uu___1) in + let uu___1 = FStarC_List.map (elim_mlexpr env) es in (p, uu___1) in FStarC_Extraction_ML_Syntax.MLE_Raise uu___ | FStarC_Extraction_ML_Syntax.MLE_Try (e1, branches) -> let uu___ = let uu___1 = elim_mlexpr env e1 in - let uu___2 = FStarC_Compiler_List.map (elim_branch env) branches in + let uu___2 = FStarC_List.map (elim_branch env) branches in (uu___1, uu___2) in FStarC_Extraction_ML_Syntax.MLE_Try uu___ and (elim_letbinding : @@ -240,8 +228,7 @@ and (elim_letbinding : | (flavor, lbs) -> let elim_one_lb lb = let ts = - FStarC_Compiler_Util.map_opt - lb.FStarC_Extraction_ML_Syntax.mllb_tysc + FStarC_Util.map_opt lb.FStarC_Extraction_ML_Syntax.mllb_tysc (fun uu___1 -> match uu___1 with | (vars, t) -> @@ -262,8 +249,7 @@ and (elim_letbinding : FStarC_Extraction_ML_Syntax.print_typ = (lb.FStarC_Extraction_ML_Syntax.print_typ) } in - let uu___1 = FStarC_Compiler_List.map elim_one_lb lbs in - (flavor, uu___1) + let uu___1 = FStarC_List.map elim_one_lb lbs in (flavor, uu___1) and (elim_branch : env_t -> (FStarC_Extraction_ML_Syntax.mlpattern * @@ -277,7 +263,7 @@ and (elim_branch : fun uu___ -> match uu___ with | (pat, wopt, e) -> - let uu___1 = FStarC_Compiler_Util.map_opt wopt (elim_mlexpr env) in + let uu___1 = FStarC_Util.map_opt wopt (elim_mlexpr env) in let uu___2 = elim_mlexpr env e in (pat, uu___1, uu___2) and (elim_mlexpr : env_t -> @@ -311,14 +297,14 @@ let (elim_tydef : fun parameters -> fun mlty -> let val_decl_range = - FStarC_Compiler_Util.find_map metadata + FStarC_Util.find_map metadata (fun uu___ -> match uu___ with | FStarC_Extraction_ML_Syntax.HasValDecl r -> FStar_Pervasives_Native.Some r | uu___1 -> FStar_Pervasives_Native.None) in let remove_typars_list = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun uu___ -> match uu___ with | FStarC_Extraction_ML_Syntax.RemoveUnusedTypeParameters @@ -326,8 +312,7 @@ let (elim_tydef : | uu___1 -> false) metadata in let range_of_tydef = match remove_typars_list with - | FStar_Pervasives_Native.None -> - FStarC_Compiler_Range_Type.dummyRange + | FStar_Pervasives_Native.None -> FStarC_Range_Type.dummyRange | FStar_Pervasives_Native.Some (FStarC_Extraction_ML_Syntax.RemoveUnusedTypeParameters (uu___, r)) -> r in @@ -335,7 +320,7 @@ let (elim_tydef : match remove_typars_list with | FStar_Pervasives_Native.Some (FStarC_Extraction_ML_Syntax.RemoveUnusedTypeParameters - (l, r)) -> FStarC_Compiler_List.contains i l + (l, r)) -> FStarC_List.contains i l | uu___ -> false in let can_eliminate i = match (val_decl_range, remove_typars_list) with @@ -345,7 +330,7 @@ let (elim_tydef : let mlty1 = elim_mlty env mlty in let freevars = freevars_of_mlty mlty1 in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun param -> match uu___1 with @@ -355,7 +340,7 @@ let (elim_tydef : let uu___2 = FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) p (Obj.magic freevars) in if uu___2 @@ -363,7 +348,7 @@ let (elim_tydef : (if must_eliminate i then (let uu___4 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Expected parameter %s of %s to be unused in its definition and eliminated" p name in FStarC_Errors.log_issue @@ -395,41 +380,48 @@ let (elim_tydef : | uu___6 -> range_of_tydef in ((let uu___7 = let uu___8 = - FStarC_Class_Show.show - FStarC_Class_Show.showable_int i in + let uu___9 = + let uu___10 = + FStarC_Class_Show.show + FStarC_Class_Show.showable_int i in + let uu___11 = + FStarC_Class_Show.show + FStarC_Class_Show.showable_int i in + FStarC_Util.format3 + "Parameter %s of %s is unused and must be eliminated for F#; add `[@@ remove_unused_type_parameters [%s; ...]]` to the interface signature." + uu___10 name uu___11 in + FStarC_Errors_Msg.text uu___9 in let uu___9 = - FStarC_Class_Show.show - FStarC_Class_Show.showable_int i in - FStarC_Compiler_Util.format3 - "Parameter %s of %s is unused and must be eliminated for F#; add `[@@ remove_unused_type_parameters [%s; ...]]` to the interface signature; \nThis type definition is being dropped" - uu___8 name uu___9 in + let uu___10 = + FStarC_Errors_Msg.text + "This type definition is being dropped" in + [uu___10] in + uu___8 :: uu___9 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range range FStarC_Errors_Codes.Error_RemoveUnusedTypeParameter () (Obj.magic - FStarC_Errors_Msg.is_error_message_string) + FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___7)); - FStarC_Compiler_Effect.raise Drop_tydef) + FStarC_Effect.raise Drop_tydef) else ((i + Prims.int_one), (param :: params), (Retain :: entry1)))) (Prims.int_zero, [], []) parameters in match uu___ with | (uu___1, parameters1, entry1) -> - let uu___2 = - extend_env env name (FStarC_Compiler_List.rev entry1) in + let uu___2 = extend_env env name (FStarC_List.rev entry1) in (uu___2, - (name, metadata, (FStarC_Compiler_List.rev parameters1), - mlty1)) + (name, metadata, (FStarC_List.rev parameters1), mlty1)) let (elim_tydef_or_decl : env_t -> tydef -> (env_t * tydef)) = fun env -> fun td -> match td with | (name, metadata, FStar_Pervasives.Inr arity) -> let remove_typars_list = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun uu___ -> match uu___ with | FStarC_Extraction_ML_Syntax.RemoveUnusedTypeParameters @@ -440,7 +432,7 @@ let (elim_tydef_or_decl : env_t -> tydef -> (env_t * tydef)) = | FStar_Pervasives_Native.Some (FStarC_Extraction_ML_Syntax.RemoveUnusedTypeParameters (l, r)) -> - let must_eliminate i = FStarC_Compiler_List.contains i l in + let must_eliminate i = FStarC_List.contains i l in let rec aux i = if i = arity then [] @@ -468,7 +460,7 @@ let (elim_tydefs : env_t -> tydef Prims.list -> (env_t * tydef Prims.list)) = then (env, tds) else (let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun td -> match uu___3 with @@ -481,8 +473,7 @@ let (elim_tydefs : env_t -> tydef Prims.list -> (env_t * tydef Prims.list)) = (match uu___5 with | (env2, td1) -> (env2, (td1 :: out)))) () with | Drop_tydef -> (env1, out))) (env, []) tds in - match uu___2 with - | (env1, tds1) -> (env1, (FStarC_Compiler_List.rev tds1))) + match uu___2 with | (env1, tds1) -> (env1, (FStarC_List.rev tds1))) let (elim_one_mltydecl : env_t -> FStarC_Extraction_ML_Syntax.one_mltydecl -> @@ -509,7 +500,7 @@ let (elim_one_mltydecl : | FStarC_Extraction_ML_Syntax.MLTD_Record fields -> let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (name1, ty) -> @@ -520,12 +511,12 @@ let (elim_one_mltydecl : | FStarC_Extraction_ML_Syntax.MLTD_DType inductive -> let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (i, constrs) -> let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (constr, ty) -> @@ -568,8 +559,7 @@ let (elim_module : let elim_module1 env1 m1 = match m1.FStarC_Extraction_ML_Syntax.mlmodule1_m with | FStarC_Extraction_ML_Syntax.MLM_Ty td -> - let uu___ = - FStarC_Compiler_Util.fold_map elim_one_mltydecl env1 td in + let uu___ = FStarC_Util.fold_map elim_one_mltydecl env1 td in (match uu___ with | (env2, td1) -> (env2, @@ -595,7 +585,7 @@ let (elim_module : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (s, t) -> @@ -622,7 +612,7 @@ let (elim_module : (env1, uu___) | uu___ -> (env1, m1) in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun m1 -> match uu___1 with @@ -635,13 +625,13 @@ let (elim_module : (match uu___3 with | (env2, m2) -> (env2, (m2 :: out)))) () with | Drop_tydef -> (env1, out))) (env, []) m in - match uu___ with | (env1, m1) -> (env1, (FStarC_Compiler_List.rev m1)) + match uu___ with | (env1, m1) -> (env1, (FStarC_List.rev m1)) let (set_current_module : env_t -> FStarC_Extraction_ML_Syntax.mlpath -> env_t) = fun e -> fun n -> let curmod = - FStarC_Compiler_List.op_At (FStar_Pervasives_Native.fst n) + FStarC_List.op_At (FStar_Pervasives_Native.fst n) [FStar_Pervasives_Native.snd n] in { current_module = curmod; tydef_map = (e.tydef_map) } let (elim_mllib : @@ -677,7 +667,7 @@ let (elim_mllib : (FStar_Pervasives_Native.None, env2) in (match uu___4 with | (sig_mod1, env3) -> (env3, (name, sig_mod1, _libs))) in - let uu___3 = FStarC_Compiler_Util.fold_map elim_one_lib env libs in + let uu___3 = FStarC_Util.fold_map elim_one_lib env libs in (match uu___3 with | (env1, libs1) -> (env1, (FStarC_Extraction_ML_Syntax.MLLib libs1)))) @@ -686,5 +676,5 @@ let (elim_mllibs : FStarC_Extraction_ML_Syntax.mllib Prims.list) = fun l -> - let uu___ = FStarC_Compiler_Util.fold_map elim_mllib initial_env l in + let uu___ = FStarC_Util.fold_map elim_mllib initial_env l in FStar_Pervasives_Native.snd uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Syntax.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Syntax.ml similarity index 97% rename from stage0/fstar-lib/generated/FStarC_Extraction_ML_Syntax.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Syntax.ml index 2e01a6f1cc6..5759243215b 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Syntax.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Syntax.ml @@ -167,8 +167,7 @@ let (fsharpkeywords : Prims.string Prims.list) = let (string_of_mlpath : mlpath -> Prims.string) = fun uu___ -> match uu___ with - | (p, s) -> - FStarC_Compiler_String.concat "." (FStarC_Compiler_List.op_At p [s]) + | (p, s) -> FStarC_String.concat "." (FStarC_List.op_At p [s]) type mlidents = mlident Prims.list type mlsymbols = mlsymbol Prims.list type e_tag = @@ -323,8 +322,8 @@ type meta = | CMacro | Deprecated of Prims.string | RemoveUnusedTypeParameters of (Prims.int Prims.list * - FStarC_Compiler_Range_Type.range) - | HasValDecl of FStarC_Compiler_Range_Type.range + FStarC_Range_Type.range) + | HasValDecl of FStarC_Range_Type.range | CNoInline let (uu___is_Mutable : meta -> Prims.bool) = fun projectee -> match projectee with | Mutable -> true | uu___ -> false @@ -397,13 +396,13 @@ let (uu___is_RemoveUnusedTypeParameters : meta -> Prims.bool) = | RemoveUnusedTypeParameters _0 -> true | uu___ -> false let (__proj__RemoveUnusedTypeParameters__item___0 : - meta -> (Prims.int Prims.list * FStarC_Compiler_Range_Type.range)) = + meta -> (Prims.int Prims.list * FStarC_Range_Type.range)) = fun projectee -> match projectee with | RemoveUnusedTypeParameters _0 -> _0 let (uu___is_HasValDecl : meta -> Prims.bool) = fun projectee -> match projectee with | HasValDecl _0 -> true | uu___ -> false -let (__proj__HasValDecl__item___0 : meta -> FStarC_Compiler_Range_Type.range) - = fun projectee -> match projectee with | HasValDecl _0 -> _0 +let (__proj__HasValDecl__item___0 : meta -> FStarC_Range_Type.range) = + fun projectee -> match projectee with | HasValDecl _0 -> _0 let (uu___is_CNoInline : meta -> Prims.bool) = fun projectee -> match projectee with | CNoInline -> true | uu___ -> false type metadata = meta Prims.list @@ -775,7 +774,7 @@ let (apply_obj_repr : mlexpr -> mlty -> mlexpr) = with_ty_loc MLTY_Top (MLE_App (obj_repr, [x])) x.loc let (ty_param_names : ty_param Prims.list -> Prims.string Prims.list) = fun tys -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | { ty_param_name; ty_param_attrs = uu___1;_} -> ty_param_name) tys @@ -837,13 +836,13 @@ let rec (mlty_to_doc : mlty -> FStarC_Pprint.document) = ctor' "" uu___1 | MLTY_Named (ts, p) -> let uu___ = - let uu___1 = FStarC_Compiler_List.map mlty_to_doc ts in + let uu___1 = FStarC_List.map mlty_to_doc ts in let uu___2 = let uu___3 = let uu___4 = string_of_mlpath p in FStarC_Pprint.doc_of_string uu___4 in [uu___3] in - FStarC_Compiler_List.op_At uu___1 uu___2 in + FStarC_List.op_At uu___1 uu___2 in ctor' "" uu___ | MLTY_Tuple ts -> let uu___ = @@ -980,8 +979,7 @@ let rec (mlexpr_to_doc : mlexpr -> FStarC_Pprint.document) = | MLE_Var x -> let uu___ = FStarC_Pprint.doc_of_string x in ctor "MLE_Var" uu___ | MLE_Name (p, x) -> - let uu___ = - FStarC_Pprint.doc_of_string (FStarC_Compiler_String.concat "." p) in + let uu___ = FStarC_Pprint.doc_of_string (FStarC_String.concat "." p) in let uu___1 = FStarC_Pprint.doc_of_string x in ctor2 "MLE_Name" uu___ uu___1 | MLE_Let (lbs, e1) -> @@ -1024,8 +1022,7 @@ let rec (mlexpr_to_doc : mlexpr -> FStarC_Pprint.document) = let uu___ = list_to_doc es mlexpr_to_doc in ctor "MLE_Tuple" uu___ | MLE_Record (p, n, es) -> let uu___ = - list_to_doc (FStarC_Compiler_List.op_At p [n]) - FStarC_Pprint.doc_of_string in + list_to_doc (FStarC_List.op_At p [n]) FStarC_Pprint.doc_of_string in let uu___1 = list_to_doc es (fun uu___2 -> @@ -1105,8 +1102,7 @@ and (mllb_to_doc : mllb -> FStarC_Pprint.document) = let uu___6 = let uu___7 = let uu___8 = - let uu___9 = - FStarC_Compiler_Util.string_of_bool lb.mllb_add_unit in + let uu___9 = FStarC_Util.string_of_bool lb.mllb_add_unit in FStarC_Pprint.doc_of_string uu___9 in fld "mllb_add_unit" uu___8 in let uu___8 = @@ -1125,7 +1121,7 @@ and (mlconstant_to_doc : mlconstant -> FStarC_Pprint.document) = | MLC_Unit -> FStarC_Pprint.doc_of_string "MLC_Unit" | MLC_Bool b -> let uu___ = - let uu___1 = FStarC_Compiler_Util.string_of_bool b in + let uu___1 = FStarC_Util.string_of_bool b in FStarC_Pprint.doc_of_string uu___1 in ctor "MLC_Bool" uu___ | MLC_Int (s, FStar_Pervasives_Native.None) -> @@ -1159,8 +1155,7 @@ and (mlpattern_to_doc : mlpattern -> FStarC_Pprint.document) = ctor "MLP_Branch" uu___ | MLP_Record (path, fields) -> let uu___ = - FStarC_Pprint.doc_of_string - (FStarC_Compiler_String.concat "." path) in + FStarC_Pprint.doc_of_string (FStarC_String.concat "." path) in let uu___1 = list_to_doc fields (fun uu___2 -> @@ -1251,7 +1246,7 @@ let (one_mltydecl_to_doc : one_mltydecl -> FStarC_Pprint.document) = let uu___4 = let uu___5 = let uu___6 = ty_param_names d.tydecl_parameters in - FStarC_Compiler_String.concat "," uu___6 in + FStarC_String.concat "," uu___6 in FStarC_Pprint.doc_of_string uu___5 in fld "tydecl_parameters" uu___4 in let uu___4 = diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Term.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Term.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_Extraction_ML_Term.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Term.ml index 1f5aa8d7d48..6efe28109ba 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Term.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Term.ml @@ -1,8 +1,8 @@ open Prims -let (dbg_Extraction : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Extraction" -let (dbg_ExtractionNorm : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ExtractionNorm" +let (dbg_Extraction : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Extraction" +let (dbg_ExtractionNorm : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ExtractionNorm" exception Un_extractable let (uu___is_Un_extractable : Prims.exn -> Prims.bool) = fun projectee -> @@ -68,7 +68,7 @@ let err_ill_typed_application : (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) args in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Ill-typed application: source application is %s \n translated prefix to %s at type %s\n remaining args are %s\n" uu___1 uu___2 uu___3 uu___4 in FStarC_Errors.raise_error @@ -79,8 +79,7 @@ let err_ill_typed_application : let err_ill_typed_erasure : 'uuuuu . FStarC_Extraction_ML_UEnv.uenv -> - FStarC_Compiler_Range_Type.range -> - FStarC_Extraction_ML_Syntax.mlty -> 'uuuuu + FStarC_Range_Type.range -> FStarC_Extraction_ML_Syntax.mlty -> 'uuuuu = fun env -> fun pos -> @@ -89,7 +88,7 @@ let err_ill_typed_erasure : let uu___1 = let uu___2 = FStarC_Extraction_ML_UEnv.current_module_of_uenv env in FStarC_Extraction_ML_Code.string_of_mlty uu___2 ty in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Erased value found where a value of type %s was expected" uu___1 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range pos FStarC_Errors_Codes.Fatal_IllTyped () @@ -101,7 +100,7 @@ let err_value_restriction : 'uuuuu . FStarC_Syntax_Syntax.term -> 'uuuuu = let uu___1 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Refusing to generalize because of the value restriction: (%s) %s" uu___1 uu___2 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) t @@ -165,8 +164,7 @@ let (err_unexpected_eff : let err_cannot_extract_effect : 'uuuuu . FStarC_Ident.lident -> - FStarC_Compiler_Range_Type.range -> - Prims.string -> Prims.string -> 'uuuuu + FStarC_Range_Type.range -> Prims.string -> Prims.string -> 'uuuuu = fun l -> fun r -> @@ -176,7 +174,7 @@ let err_cannot_extract_effect : let uu___1 = let uu___2 = let uu___3 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Cannot extract effect %s because %s (when extracting %s)" uu___3 reason ctxt in FStarC_Errors_Msg.text uu___2 in @@ -189,11 +187,11 @@ let (effect_as_etag : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Ident.lident -> FStarC_Extraction_ML_Syntax.e_tag) = - let cache = FStarC_Compiler_Util.smap_create (Prims.of_int (20)) in + let cache = FStarC_Util.smap_create (Prims.of_int (20)) in let rec delta_norm_eff g l = let uu___ = let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_try_find cache uu___1 in + FStarC_Util.smap_try_find cache uu___1 in match uu___ with | FStar_Pervasives_Native.Some l1 -> l1 | FStar_Pervasives_Native.None -> @@ -205,9 +203,10 @@ let (effect_as_etag : match uu___1 with | FStar_Pervasives_Native.None -> l | FStar_Pervasives_Native.Some (uu___2, c) -> - delta_norm_eff g (FStarC_Syntax_Util.comp_effect_name c) in + let uu___3 = FStarC_Syntax_Util.comp_effect_name c in + delta_norm_eff g uu___3 in ((let uu___2 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_add cache uu___2 res); + FStarC_Util.smap_add cache uu___2 res); res) in fun g -> fun l -> @@ -250,25 +249,25 @@ let rec (is_arity_aux : let uu___1 = let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in - FStarC_Compiler_Util.format1 "Impossible: is_arity (%s)" uu___2 in + FStarC_Util.format1 "Impossible: is_arity (%s)" uu___2 in failwith uu___1 | FStarC_Syntax_Syntax.Tm_delayed uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in - FStarC_Compiler_Util.format1 "Impossible: is_arity (%s)" uu___3 in + FStarC_Util.format1 "Impossible: is_arity (%s)" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_ascribed uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in - FStarC_Compiler_Util.format1 "Impossible: is_arity (%s)" uu___3 in + FStarC_Util.format1 "Impossible: is_arity (%s)" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_meta uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in - FStarC_Compiler_Util.format1 "Impossible: is_arity (%s)" uu___3 in + FStarC_Util.format1 "Impossible: is_arity (%s)" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_lazy i -> let uu___1 = FStarC_Syntax_Util.unfold_lazy i in @@ -282,7 +281,9 @@ let rec (is_arity_aux : | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = uu___1; FStarC_Syntax_Syntax.comp = c;_} - -> is_arity_aux tcenv (FStarC_Syntax_Util.comp_result c) + -> + let uu___2 = FStarC_Syntax_Util.comp_result c in + is_arity_aux tcenv uu___2 | FStarC_Syntax_Syntax.Tm_fvar fv -> let topt = FStarC_TypeChecker_Env.lookup_definition @@ -346,13 +347,13 @@ let rec (is_type_aux : let uu___1 = let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in - FStarC_Compiler_Util.format1 "Impossible: %s" uu___2 in + FStarC_Util.format1 "Impossible: %s" uu___2 in failwith uu___1 | FStarC_Syntax_Syntax.Tm_unknown -> let uu___ = let uu___1 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in - FStarC_Compiler_Util.format1 "Impossible: %s" uu___1 in + FStarC_Util.format1 "Impossible: %s" uu___1 in failwith uu___ | FStarC_Syntax_Syntax.Tm_lazy i -> let uu___ = FStarC_Syntax_Util.unfold_lazy i in @@ -384,8 +385,8 @@ let rec (is_type_aux : let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in - FStarC_Compiler_Util.format1 - "Extraction: variable not found: %s" uu___3 in + FStarC_Util.format1 "Extraction: variable not found: %s" + uu___3 in failwith uu___2) | FStarC_Syntax_Syntax.Tm_ascribed { FStarC_Syntax_Syntax.tm = t2; FStarC_Syntax_Syntax.asc = uu___; @@ -405,7 +406,7 @@ let rec (is_type_aux : { FStarC_Syntax_Syntax.lbs = (false, lb::[]); FStarC_Syntax_Syntax.body1 = body;_} -> - let x = FStarC_Compiler_Util.left lb.FStarC_Syntax_Syntax.lbname in + let x = FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in let uu___ = let uu___1 = let uu___2 = FStarC_Syntax_Syntax.mk_binder x in [uu___2] in @@ -422,11 +423,10 @@ let rec (is_type_aux : | (lbs1, body1) -> let env1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___3 = - FStarC_Compiler_Util.left - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.mk_binder uu___3) lbs1 in push_tcenv_binders env uu___2 in is_type_aux env1 body1) @@ -450,7 +450,7 @@ let rec (is_type_aux : | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some (uu___7, bvs) -> let binders = - FStarC_Compiler_List.map + FStarC_List.map (fun bv -> FStarC_Syntax_Syntax.mk_binder bv) bvs in let env1 = push_tcenv_binders env binders in @@ -476,8 +476,7 @@ let (is_type : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 "checking is_type (%s) %s\n" uu___2 - uu___3); + FStarC_Util.print2 "checking is_type (%s) %s\n" uu___2 uu___3); (let b = is_type_aux env t in FStarC_Extraction_ML_UEnv.debug env (fun uu___2 -> @@ -487,16 +486,14 @@ let (is_type : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___4 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.print2 "yes, is_type %s (%s)\n" uu___3 - uu___4 + FStarC_Util.print2 "yes, is_type %s (%s)\n" uu___3 uu___4 else (let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___5 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.print2 "not a type %s (%s)\n" uu___4 - uu___5)); + FStarC_Util.print2 "not a type %s (%s)\n" uu___4 uu___5)); b) let (is_type_binder : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.binder -> Prims.bool) @@ -538,7 +535,7 @@ let rec (is_fstar_value : FStarC_Syntax_Syntax.term -> Prims.bool) = let uu___1 = is_constructor head in if uu___1 then - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___2 -> match uu___2 with | (te, uu___3) -> is_fstar_value te) args else false @@ -559,11 +556,11 @@ let rec (is_ml_value : FStarC_Extraction_ML_Syntax.mlexpr -> Prims.bool) = | FStarC_Extraction_ML_Syntax.MLE_Name uu___ -> true | FStarC_Extraction_ML_Syntax.MLE_Fun uu___ -> true | FStarC_Extraction_ML_Syntax.MLE_CTor (uu___, exps) -> - FStarC_Compiler_Util.for_all is_ml_value exps + FStarC_Util.for_all is_ml_value exps | FStarC_Extraction_ML_Syntax.MLE_Tuple exps -> - FStarC_Compiler_Util.for_all is_ml_value exps + FStarC_Util.for_all is_ml_value exps | FStarC_Extraction_ML_Syntax.MLE_Record (uu___, uu___1, fields) -> - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun uu___2 -> match uu___2 with | (uu___3, e1) -> is_ml_value e1) fields | FStarC_Extraction_ML_Syntax.MLE_TApp (h, uu___) -> is_ml_value h @@ -577,7 +574,7 @@ let (normalize_abs : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) | FStarC_Syntax_Syntax.Tm_abs { FStarC_Syntax_Syntax.bs = bs'; FStarC_Syntax_Syntax.body = body; FStarC_Syntax_Syntax.rc_opt = copt1;_} - -> aux (FStarC_Compiler_List.op_At bs bs') body copt1 + -> aux (FStarC_List.op_At bs bs') body copt1 | uu___ -> let e' = FStarC_Syntax_Util.unascribe t1 in let uu___1 = FStarC_Syntax_Util.is_fun e' in @@ -600,15 +597,14 @@ let (check_pats_for_ite : fun l -> let def = (false, FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) in - if (FStarC_Compiler_List.length l) <> (Prims.of_int (2)) + if (FStarC_List.length l) <> (Prims.of_int (2)) then def else - (let uu___1 = FStarC_Compiler_List.hd l in + (let uu___1 = FStarC_List.hd l in match uu___1 with | (p1, w1, e1) -> let uu___2 = - let uu___3 = FStarC_Compiler_List.tl l in - FStarC_Compiler_List.hd uu___3 in + let uu___3 = FStarC_List.tl l in FStarC_List.hd uu___3 in (match uu___2 with | (p2, w2, e2) -> (match (w1, w2, (p1.FStarC_Syntax_Syntax.v), @@ -646,7 +642,7 @@ let (fresh_mlidents : fun ts -> fun g -> let uu___ = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun t -> fun uu___1 -> match uu___1 with @@ -667,7 +663,7 @@ let (fresh_binders : match uu___ with | (vs_ts, g1) -> let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (v, t) -> @@ -695,8 +691,8 @@ let (instantiate_maybe_partial : let uu___ = s in match uu___ with | (vars, t) -> - let n_vars = FStarC_Compiler_List.length vars in - let n_args = FStarC_Compiler_List.length tyargs in + let n_vars = FStarC_List.length vars in + let n_args = FStarC_List.length tyargs in if n_args = n_vars then (if n_args = Prims.int_zero @@ -716,15 +712,14 @@ let (instantiate_maybe_partial : if n_args < n_vars then (let extra_tyargs = - let uu___2 = FStarC_Compiler_Util.first_N n_args vars in + let uu___2 = FStarC_Util.first_N n_args vars in match uu___2 with | (uu___3, rest_vars) -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> FStarC_Extraction_ML_Syntax.MLTY_Erased) rest_vars in - let tyargs1 = - FStarC_Compiler_List.op_At tyargs extra_tyargs in + let tyargs1 = FStarC_List.op_At tyargs extra_tyargs in let ts = instantiate_tyscheme (vars, t) tyargs1 in let tapp = { @@ -735,7 +730,7 @@ let (instantiate_maybe_partial : (e.FStarC_Extraction_ML_Syntax.loc) } in let t1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun out -> fun t2 -> FStarC_Extraction_ML_Syntax.MLTY_Fun @@ -771,7 +766,7 @@ let (eta_expand : match uu___2 with | (vs_ts, g1) -> let vs_es = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | { FStarC_Extraction_ML_Syntax.mlbinder_name = v; @@ -838,7 +833,7 @@ let (maybe_eta_expand_coercion : uu___1 = (FStar_Pervasives_Native.Some FStarC_Options.Krml) in if uu___ then e else eta_expand g expect e let (apply_coercion : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Extraction_ML_UEnv.uenv -> FStarC_Extraction_ML_Syntax.mlexpr -> FStarC_Extraction_ML_Syntax.mlty -> @@ -856,18 +851,26 @@ let (apply_coercion : let uu___2 = let uu___3 = let uu___4 = - FStarC_Extraction_ML_UEnv.current_module_of_uenv g in - FStarC_Extraction_ML_Code.string_of_mlty uu___4 ty in + let uu___5 = + let uu___6 = + FStarC_Extraction_ML_UEnv.current_module_of_uenv g in + FStarC_Extraction_ML_Code.string_of_mlty uu___6 ty in + let uu___6 = + let uu___7 = + FStarC_Extraction_ML_UEnv.current_module_of_uenv g in + FStarC_Extraction_ML_Code.string_of_mlty uu___7 expect in + FStarC_Util.format2 + "Inserted an unsafe type coercion in generated code from %s to %s." + uu___5 uu___6 in + FStarC_Errors_Msg.text uu___4 in let uu___4 = let uu___5 = - FStarC_Extraction_ML_UEnv.current_module_of_uenv g in - FStarC_Extraction_ML_Code.string_of_mlty uu___5 expect in - FStarC_Compiler_Util.format2 - "Inserted an unsafe type coercion in generated code from %s to %s; this may be unsound in F#" - uu___3 uu___4 in + FStarC_Errors_Msg.text "This may be unsound in F#." in + [uu___5] in + uu___3 :: uu___4 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range pos FStarC_Errors_Codes.Warning_NoMagicInFSharp () - (Obj.magic FStarC_Errors_Msg.is_error_message_string) + (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___2) else ()); (let mk_fun binder body = @@ -953,8 +956,7 @@ let (apply_coercion : uu___2, uu___3) -> let uu___4 = let uu___5 = - let uu___6 = - FStarC_Compiler_List.map coerce_branch branches in + let uu___6 = FStarC_List.map coerce_branch branches in (s, uu___6) in FStarC_Extraction_ML_Syntax.MLE_Match uu___5 in FStarC_Extraction_ML_Syntax.with_ty expect1 uu___4 @@ -964,28 +966,27 @@ let (apply_coercion : let uu___5 = let uu___6 = aux b1 ty1 expect1 in let uu___7 = - FStarC_Compiler_Util.map_opt b2_opt + FStarC_Util.map_opt b2_opt (fun b2 -> aux b2 ty1 expect1) in (s, uu___6, uu___7) in FStarC_Extraction_ML_Syntax.MLE_If uu___5 in FStarC_Extraction_ML_Syntax.with_ty expect1 uu___4 | (FStarC_Extraction_ML_Syntax.MLE_Seq es, uu___2, uu___3) -> - let uu___4 = FStarC_Compiler_Util.prefix es in + let uu___4 = FStarC_Util.prefix es in (match uu___4 with | (prefix, last) -> let uu___5 = let uu___6 = let uu___7 = let uu___8 = aux last ty1 expect1 in [uu___8] in - FStarC_Compiler_List.op_At prefix uu___7 in + FStarC_List.op_At prefix uu___7 in FStarC_Extraction_ML_Syntax.MLE_Seq uu___6 in FStarC_Extraction_ML_Syntax.with_ty expect1 uu___5) | (FStarC_Extraction_ML_Syntax.MLE_Try (s, branches), uu___2, uu___3) -> let uu___4 = let uu___5 = - let uu___6 = - FStarC_Compiler_List.map coerce_branch branches in + let uu___6 = FStarC_List.map coerce_branch branches in (s, uu___6) in FStarC_Extraction_ML_Syntax.MLE_Try uu___5 in FStarC_Extraction_ML_Syntax.with_ty expect1 uu___4 @@ -995,7 +996,7 @@ let (apply_coercion : (e1, ty1, expect1)) in aux e ty expect) let (maybe_coerce : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Extraction_ML_UEnv.uenv -> FStarC_Extraction_ML_Syntax.mlexpr -> FStarC_Extraction_ML_Syntax.mlty -> @@ -1041,7 +1042,7 @@ let (maybe_coerce : g in FStarC_Extraction_ML_Code.string_of_mlty uu___8 ty1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "\n Effect mismatch on type of %s : %s\n" uu___6 uu___7); e) @@ -1066,7 +1067,7 @@ let (maybe_coerce : g in FStarC_Extraction_ML_Code.string_of_mlty uu___10 expect in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "\n (*needed to coerce expression \n %s \n of type \n %s \n to type \n %s *) \n" uu___7 uu___8 uu___9); (let uu___6 = apply_coercion pos g e ty1 expect in @@ -1113,8 +1114,8 @@ let maybe_reify_comp : fun env -> fun c -> let uu___ = - FStarC_TypeChecker_Util.effect_extraction_mode env - (FStarC_Syntax_Util.comp_effect_name c) in + let uu___1 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Util.effect_extraction_mode env uu___1 in match uu___ with | FStarC_Syntax_Syntax.Extract_reify -> let uu___1 = @@ -1125,10 +1126,11 @@ let maybe_reify_comp : | FStarC_Syntax_Syntax.Extract_primitive -> FStarC_Syntax_Util.comp_result c | FStarC_Syntax_Syntax.Extract_none s -> - let uu___1 = + let uu___1 = FStarC_Syntax_Util.comp_effect_name c in + let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - err_cannot_extract_effect (FStarC_Syntax_Util.comp_effect_name c) - c.FStarC_Syntax_Syntax.pos s uu___1 + err_cannot_extract_effect uu___1 c.FStarC_Syntax_Syntax.pos s + uu___2 let (maybe_reify_term : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> @@ -1180,26 +1182,24 @@ let (uu___is_NotSupportedByExtension : Prims.exn -> Prims.bool) = type translate_typ_t = FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.term -> FStarC_Extraction_ML_Syntax.mlty -let (ref_translate_term_to_mlty : translate_typ_t FStarC_Compiler_Effect.ref) - = - FStarC_Compiler_Util.mk_ref - (fun uu___ -> - fun uu___1 -> FStarC_Compiler_Effect.raise NotSupportedByExtension) +let (ref_translate_term_to_mlty : translate_typ_t FStarC_Effect.ref) = + FStarC_Util.mk_ref + (fun uu___ -> fun uu___1 -> FStarC_Effect.raise NotSupportedByExtension) let (translate_term_to_mlty : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.term -> FStarC_Extraction_ML_Syntax.mlty) = fun g -> fun t0 -> - let uu___ = FStarC_Compiler_Effect.op_Bang ref_translate_term_to_mlty in + let uu___ = FStarC_Effect.op_Bang ref_translate_term_to_mlty in uu___ g t0 let (register_pre_translate_typ : translate_typ_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_translate_term_to_mlty in + let before = FStarC_Effect.op_Bang ref_translate_term_to_mlty in let after g t = try (fun uu___ -> match () with | () -> f g t) () with | NotSupportedByExtension -> before g t in - FStarC_Compiler_Effect.op_Colon_Equals ref_translate_term_to_mlty after + FStarC_Effect.op_Colon_Equals ref_translate_term_to_mlty after let rec (translate_term_to_mlty' : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.term -> FStarC_Extraction_ML_Syntax.mlty) @@ -1243,21 +1243,20 @@ let rec (translate_term_to_mlty' : FStarC_Syntax_Util.arrow_formals fvty1 in match uu___4 with | (formals, uu___5) -> - let mlargs = FStarC_Compiler_List.map (arg_as_mlty g1) args in + let mlargs = FStarC_List.map (arg_as_mlty g1) args in let mlargs1 = - let n_args = FStarC_Compiler_List.length args in - if (FStarC_Compiler_List.length formals) > n_args + let n_args = FStarC_List.length args in + if (FStarC_List.length formals) > n_args then - let uu___6 = - FStarC_Compiler_Util.first_N n_args formals in + let uu___6 = FStarC_Util.first_N n_args formals in match uu___6 with | (uu___7, rest) -> let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___9 -> FStarC_Extraction_ML_Syntax.MLTY_Erased) rest in - FStarC_Compiler_List.op_At mlargs uu___8 + FStarC_List.op_At mlargs uu___8 else mlargs in let nm = FStarC_Extraction_ML_UEnv.mlpath_of_lident g1 @@ -1272,22 +1271,19 @@ let rec (translate_term_to_mlty' : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format1 "Impossible: Unexpected term %s" - uu___2 in + FStarC_Util.format1 "Impossible: Unexpected term %s" uu___2 in failwith uu___1 | FStarC_Syntax_Syntax.Tm_delayed uu___ -> let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format1 "Impossible: Unexpected term %s" - uu___2 in + FStarC_Util.format1 "Impossible: Unexpected term %s" uu___2 in failwith uu___1 | FStarC_Syntax_Syntax.Tm_unknown -> let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format1 "Impossible: Unexpected term %s" - uu___1 in + FStarC_Util.format1 "Impossible: Unexpected term %s" uu___1 in failwith uu___ | FStarC_Syntax_Syntax.Tm_lazy i -> let uu___ = FStarC_Syntax_Util.unfold_lazy i in @@ -1333,8 +1329,8 @@ let rec (translate_term_to_mlty' : maybe_reify_comp env1 uu___2 c1 in let t_ret = translate_term_to_mlty env1 codom in let etag = - effect_as_etag env1 - (FStarC_Syntax_Util.comp_effect_name c1) in + let uu___2 = FStarC_Syntax_Util.comp_effect_name c1 in + effect_as_etag env1 uu___2 in let etag1 = if etag = FStarC_Extraction_ML_Syntax.E_IMPURE then etag @@ -1346,7 +1342,7 @@ let rec (translate_term_to_mlty' : then FStarC_Extraction_ML_Syntax.E_IMPURE else etag) in let uu___2 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___3 -> fun uu___4 -> match (uu___3, uu___4) with @@ -1419,7 +1415,7 @@ and (binders_as_ml_binders : fun g -> fun bs -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -1449,8 +1445,7 @@ and (binders_as_ml_binders : | (env1, b2, uu___5) -> let ml_b = (b2, t) in ((ml_b :: ml_bs), env1))) ([], g) bs in - match uu___ with - | (ml_bs, env) -> ((FStarC_Compiler_List.rev ml_bs), env) + match uu___ with | (ml_bs, env) -> ((FStarC_List.rev ml_bs), env) let (term_as_mlty : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.term -> FStarC_Extraction_ML_Syntax.mlty) @@ -1472,11 +1467,9 @@ let (mk_MLE_Seq : with | (FStarC_Extraction_ML_Syntax.MLE_Seq es1, FStarC_Extraction_ML_Syntax.MLE_Seq es2) -> - FStarC_Extraction_ML_Syntax.MLE_Seq - (FStarC_Compiler_List.op_At es1 es2) + FStarC_Extraction_ML_Syntax.MLE_Seq (FStarC_List.op_At es1 es2) | (FStarC_Extraction_ML_Syntax.MLE_Seq es1, uu___) -> - FStarC_Extraction_ML_Syntax.MLE_Seq - (FStarC_Compiler_List.op_At es1 [e2]) + FStarC_Extraction_ML_Syntax.MLE_Seq (FStarC_List.op_At es1 [e2]) | (uu___, FStarC_Extraction_ML_Syntax.MLE_Seq es2) -> FStarC_Extraction_ML_Syntax.MLE_Seq (e1 :: es2) | uu___ -> FStarC_Extraction_ML_Syntax.MLE_Seq [e1; e2] @@ -1528,11 +1521,11 @@ let record_fields : fun fns -> fun xs -> let fns1 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> FStarC_Extraction_ML_UEnv.lookup_record_field_name g (ty, x)) fns in - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___ -> fun x -> match uu___ with | (p, s) -> (s, x)) fns1 xs let (resugar_pat : @@ -1556,8 +1549,7 @@ let (resugar_pat : (FStarC_Syntax_Syntax.Record_ctor (ty, fns)) -> let path = let uu___2 = FStarC_Ident.ns_of_lid ty in - FStarC_Compiler_List.map FStarC_Ident.string_of_id - uu___2 in + FStarC_List.map FStarC_Ident.string_of_id uu___2 in let fs = record_fields g ty fns pats in let path1 = FStarC_Extraction_ML_UEnv.no_fstar_stubs_ns path in @@ -1605,7 +1597,7 @@ let rec (extract_one_pat : FStarC_Extraction_ML_UEnv.current_module_of_uenv g in FStarC_Extraction_ML_Code.string_of_mlty uu___5 t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Expected pattern type %s; got pattern type %s\n" uu___3 uu___4) else (); @@ -1637,7 +1629,7 @@ let rec (extract_one_pat : FStarC_Extraction_ML_UEnv.tcenv_of_uenv g in uu___2.FStarC_TypeChecker_Env.dsenv in FStarC_ToSyntax_ToSyntax.desugar_machine_integer - uu___1 c sw FStarC_Compiler_Range_Type.dummyRange in + uu___1 c sw FStarC_Range_Type.dummyRange in let uu___1 = term_as_mlexpr g source_term in (match uu___1 with | (mlterm, uu___2, mlty) -> (mlterm, mlty)) in @@ -1675,7 +1667,7 @@ let rec (extract_one_pat : let t = let uu___ = FStarC_Extraction_ML_UEnv.tcenv_of_uenv g in FStarC_TypeChecker_TcTerm.tc_constant uu___ - FStarC_Compiler_Range_Type.dummyRange s in + FStarC_Range_Type.dummyRange s in let mlty = term_as_mlty g t in let uu___ = let uu___1 = @@ -1726,7 +1718,7 @@ let rec (extract_one_pat : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv f in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Cannot extract this pattern, the %s constructor was erased" uu___4 in FStarC_Errors.raise_error @@ -1738,14 +1730,13 @@ let rec (extract_one_pat : (match uu___1 with | (d, tys) -> let nTyVars = - FStarC_Compiler_List.length - (FStar_Pervasives_Native.fst tys) in - let uu___2 = FStarC_Compiler_Util.first_N nTyVars pats in + FStarC_List.length (FStar_Pervasives_Native.fst tys) in + let uu___2 = FStarC_Util.first_N nTyVars pats in (match uu___2 with | (tysVarPats, restPats) -> let f_ty = let mlty_args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (p1, uu___4) -> @@ -1782,23 +1773,21 @@ let rec (extract_one_pat : g in FStarC_Extraction_ML_Code.string_of_mlty uu___10 in - FStarC_Compiler_List.map uu___9 - args in - FStarC_Compiler_String.concat " -> " - uu___8 in + FStarC_List.map uu___9 args in + FStarC_String.concat " -> " uu___8 in let res = let uu___8 = FStarC_Extraction_ML_UEnv.current_module_of_uenv g in FStarC_Extraction_ML_Code.string_of_mlty uu___8 t in - FStarC_Compiler_Util.format2 "%s -> %s" - args1 res in - FStarC_Compiler_Util.print2 + FStarC_Util.format2 "%s -> %s" args1 + res in + FStarC_Util.print2 "@@@Expected type of pattern with head = %s is %s\n" uu___5 uu___6); (let uu___4 = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun g1 -> fun uu___5 -> match uu___5 with @@ -1813,7 +1802,7 @@ let rec (extract_one_pat : match uu___4 with | (g1, tyMLPats) -> let uu___5 = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun uu___6 -> fun uu___7 -> match (uu___6, uu___7) with @@ -1841,15 +1830,15 @@ let rec (extract_one_pat : | ((g2, f_ty1, sub_pats_ok), restMLPats) -> let uu___6 = let uu___7 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___8 -> match uu___8 with | FStar_Pervasives_Native.Some x -> [x] | uu___9 -> []) - (FStarC_Compiler_List.append - tyMLPats restMLPats) in - FStarC_Compiler_List.split uu___7 in + (FStarC_List.append tyMLPats + restMLPats) in + FStarC_List.split uu___7 in (match uu___6 with | (mlPats, when_clauses) -> let pat_ty_compat = @@ -1864,7 +1853,7 @@ let rec (extract_one_pat : (FStarC_Extraction_ML_Syntax.MLP_CTor (d, mlPats)) in (uu___9, - (FStarC_Compiler_List.flatten + (FStarC_List.flatten when_clauses)) in FStar_Pervasives_Native.Some uu___8 in @@ -1900,8 +1889,8 @@ let (extract_pat : | [] -> FStar_Pervasives_Native.None | hd::tl -> let uu___ = - FStarC_Compiler_List.fold_left - FStarC_Extraction_ML_Util.conjoin hd tl in + FStarC_List.fold_left FStarC_Extraction_ML_Util.conjoin hd + tl in FStar_Pervasives_Native.Some uu___ in let uu___ = extract_one_pat1 g p expected_t in match uu___ with @@ -1934,7 +1923,7 @@ let (maybe_eta_data_and_project_record : uu___3 :: more_args in eta_args g2 uu___2 t1) | FStarC_Extraction_ML_Syntax.MLTY_Named (uu___, uu___1) -> - ((FStarC_Compiler_List.rev more_args), t) + ((FStarC_List.rev more_args), t) | uu___ -> let uu___1 = let uu___2 = @@ -1946,7 +1935,7 @@ let (maybe_eta_data_and_project_record : let uu___4 = FStarC_Extraction_ML_UEnv.current_module_of_uenv g1 in FStarC_Extraction_ML_Code.string_of_mlty uu___4 t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: Head type is not an arrow: (%s : %s)" uu___2 uu___3 in failwith uu___1 in @@ -1957,7 +1946,7 @@ let (maybe_eta_data_and_project_record : (tyname, fields))) -> let path = let uu___1 = FStarC_Ident.ns_of_lid tyname in - FStarC_Compiler_List.map FStarC_Ident.string_of_id uu___1 in + FStarC_List.map FStarC_Ident.string_of_id uu___1 in let fields1 = record_fields g tyname fields args in let path1 = FStarC_Extraction_ML_UEnv.no_fstar_stubs_ns path in let uu___1 = @@ -1979,7 +1968,7 @@ let (maybe_eta_data_and_project_record : let uu___1 = as_record qual1 e in FStarC_Extraction_ML_Util.resugar_exp uu___1 | uu___1 -> - let uu___2 = FStarC_Compiler_List.unzip eargs in + let uu___2 = FStarC_List.unzip eargs in (match uu___2 with | (binders, eargs1) -> (match e.FStarC_Extraction_ML_Syntax.expr with @@ -1991,14 +1980,13 @@ let (maybe_eta_data_and_project_record : FStarC_Extraction_ML_Syntax.with_ty tres (FStarC_Extraction_ML_Syntax.MLE_CTor (head, - (FStarC_Compiler_List.op_At args - eargs1))) in + (FStarC_List.op_At args eargs1))) in as_record qual1 uu___4 in FStarC_Extraction_ML_Util.resugar_exp uu___3 in let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> match uu___6 with | (x, t) -> @@ -2220,17 +2208,16 @@ type translate_t = FStarC_Syntax_Syntax.term -> (FStarC_Extraction_ML_Syntax.mlexpr * FStarC_Extraction_ML_Syntax.e_tag * FStarC_Extraction_ML_Syntax.mlty) -let (ref_term_as_mlexpr : translate_t FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref - (fun uu___ -> - fun uu___1 -> FStarC_Compiler_Effect.raise NotSupportedByExtension) +let (ref_term_as_mlexpr : translate_t FStarC_Effect.ref) = + FStarC_Util.mk_ref + (fun uu___ -> fun uu___1 -> FStarC_Effect.raise NotSupportedByExtension) let (register_pre_translate : translate_t -> unit) = fun f -> - let before = FStarC_Compiler_Effect.op_Bang ref_term_as_mlexpr in + let before = FStarC_Effect.op_Bang ref_term_as_mlexpr in let after g t = try (fun uu___ -> match () with | () -> f g t) () with | NotSupportedByExtension -> before g t in - FStarC_Compiler_Effect.op_Colon_Equals ref_term_as_mlexpr after + FStarC_Effect.op_Colon_Equals ref_term_as_mlexpr after type lb_sig = (FStarC_Syntax_Syntax.lbname * FStarC_Extraction_ML_Syntax.e_tag * (FStarC_Syntax_Syntax.typ * (FStarC_Syntax_Syntax.binders * @@ -2274,25 +2261,25 @@ let rec (extract_lb_sig : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} when - let uu___5 = FStarC_Compiler_List.hd bs in - is_type_binder g uu___5 -> + let uu___5 = FStarC_List.hd bs in is_type_binder g uu___5 + -> let uu___5 = FStarC_Syntax_Subst.open_comp bs c in (match uu___5 with | (bs1, c1) -> let etag_of_comp c2 = - effect_as_etag g - (FStarC_Syntax_Util.comp_effect_name c2) in + let uu___6 = FStarC_Syntax_Util.comp_effect_name c2 in + effect_as_etag g uu___6 in let uu___6 = let uu___7 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun x -> let uu___8 = is_type_binder g x in Prims.op_Negation uu___8) bs1 in match uu___7 with | FStar_Pervasives_Native.None -> let uu___8 = etag_of_comp c1 in - (bs1, uu___8, - (FStarC_Syntax_Util.comp_result c1)) + let uu___9 = FStarC_Syntax_Util.comp_result c1 in + (bs1, uu___8, uu___9) | FStar_Pervasives_Native.Some (bs2, b, rest) -> let uu___8 = FStarC_Syntax_Util.arrow (b :: rest) c1 in @@ -2300,13 +2287,12 @@ let rec (extract_lb_sig : uu___8) in (match uu___6 with | (tbinders, eff_body, tbody) -> - let n_tbinders = - FStarC_Compiler_List.length tbinders in + let n_tbinders = FStarC_List.length tbinders in let lbdef1 = let uu___7 = normalize_abs lbdef in FStarC_Syntax_Util.unmeta uu___7 in let tbinders_as_ty_params env = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | { FStarC_Syntax_Syntax.binder_bv = x; @@ -2323,7 +2309,7 @@ let rec (extract_lb_sig : env x in uu___11.FStarC_Extraction_ML_UEnv.ty_b_name in let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun attr -> let uu___12 = term_as_mlexpr g attr in @@ -2348,16 +2334,15 @@ let rec (extract_lb_sig : | (bs3, body1) -> if n_tbinders <= - (FStarC_Compiler_List.length bs3) + (FStarC_List.length bs3) then let uu___8 = - FStarC_Compiler_Util.first_N - n_tbinders bs3 in + FStarC_Util.first_N n_tbinders bs3 in (match uu___8 with | (targs, rest_args) -> let expected_source_ty = let s = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___9 -> fun uu___10 -> match (uu___9, @@ -2393,7 +2378,7 @@ let rec (extract_lb_sig : FStarC_Syntax_Subst.subst s tbody in let env = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env1 -> fun uu___9 -> match uu___9 with @@ -2454,7 +2439,7 @@ let rec (extract_lb_sig : failwith "Not enough type binders") | FStarC_Syntax_Syntax.Tm_uinst uu___7 -> let env = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env1 -> fun uu___8 -> match uu___8 with @@ -2476,7 +2461,7 @@ let rec (extract_lb_sig : tbinders_as_ty_params env tbinders in (uu___8, expected_t) in let args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | { @@ -2506,7 +2491,7 @@ let rec (extract_lb_sig : has_c_inline, e) | FStarC_Syntax_Syntax.Tm_fvar uu___7 -> let env = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env1 -> fun uu___8 -> match uu___8 with @@ -2528,7 +2513,7 @@ let rec (extract_lb_sig : tbinders_as_ty_params env tbinders in (uu___8, expected_t) in let args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | { @@ -2558,7 +2543,7 @@ let rec (extract_lb_sig : has_c_inline, e) | FStarC_Syntax_Syntax.Tm_name uu___7 -> let env = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env1 -> fun uu___8 -> match uu___8 with @@ -2580,7 +2565,7 @@ let rec (extract_lb_sig : tbinders_as_ty_params env tbinders in (uu___8, expected_t) in let args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | { @@ -2610,8 +2595,7 @@ let rec (extract_lb_sig : has_c_inline, e) | uu___7 -> err_value_restriction lbdef1))) | uu___5 -> no_gen ()) in - FStarC_Compiler_List.map maybe_generalize - (FStar_Pervasives_Native.snd lbs) + FStarC_List.map maybe_generalize (FStar_Pervasives_Native.snd lbs) and (extract_lb_iface : FStarC_Extraction_ML_UEnv.uenv -> FStarC_Syntax_Syntax.letbindings -> @@ -2625,7 +2609,7 @@ and (extract_lb_iface : let is_rec = (Prims.op_Negation is_top) && (FStar_Pervasives_Native.fst lbs) in let lbs1 = extract_lb_sig g lbs in - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun env -> fun uu___ -> match uu___ with @@ -2637,7 +2621,7 @@ and (extract_lb_iface : (match uu___1 with | (env1, uu___2, exp_binding) -> let uu___3 = - let uu___4 = FStarC_Compiler_Util.right lbname in + let uu___4 = FStarC_Util.right lbname in (uu___4, exp_binding) in (env1, uu___3))) g lbs1 and (check_term_as_mlexpr : @@ -2661,8 +2645,8 @@ and (check_term_as_mlexpr : FStarC_Extraction_ML_UEnv.current_module_of_uenv g in FStarC_Extraction_ML_Code.string_of_mlty uu___4 ty in let uu___4 = FStarC_Extraction_ML_Util.eff_to_string f in - FStarC_Compiler_Util.print3 - "Checking %s at type %s and eff %s\n" uu___2 uu___3 uu___4); + FStarC_Util.print3 "Checking %s at type %s and eff %s\n" + uu___2 uu___3 uu___4); (match (f, ty) with | (FStarC_Extraction_ML_Syntax.E_ERASABLE, uu___1) -> (FStarC_Extraction_ML_Syntax.ml_unit, @@ -2693,7 +2677,7 @@ and (check_term_as_mlexpr : FStarC_Extraction_ML_UEnv.current_module_of_uenv g in FStarC_Extraction_ML_Code.string_of_mlty uu___9 t in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Extracted %s to %s at eff %s and type %s\n" uu___5 uu___6 uu___7 uu___8); (let uu___4 = FStarC_Extraction_ML_Util.eff_leq tag f in @@ -2726,8 +2710,7 @@ and (term_as_mlexpr : fun g -> fun e -> let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang ref_term_as_mlexpr in - uu___1 g e in + let uu___1 = FStarC_Effect.op_Bang ref_term_as_mlexpr in uu___1 g e in match uu___ with | (e1, f, t) -> let uu___1 = maybe_promote_effect e1 f t in @@ -2745,16 +2728,15 @@ and (term_as_mlexpr' : (fun u -> let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.string_of_range - top1.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.string_of_range top1.FStarC_Syntax_Syntax.pos in let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term top1 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top1 in - FStarC_Compiler_Util.format3 "%s: term_as_mlexpr' (%s) : %s \n" - uu___2 uu___3 uu___4 in - FStarC_Compiler_Util.print_string uu___1); + FStarC_Util.format3 "%s: term_as_mlexpr' (%s) : %s \n" uu___2 + uu___3 uu___4 in + FStarC_Util.print_string uu___1); (let is_match t = let uu___1 = let uu___2 = @@ -2765,7 +2747,7 @@ and (term_as_mlexpr' : | FStarC_Syntax_Syntax.Tm_match uu___2 -> true | uu___2 -> false in let should_apply_to_match_branches = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___1 -> match uu___1 with | (t, uu___2) -> @@ -2791,7 +2773,7 @@ and (term_as_mlexpr' : FStarC_Syntax_Syntax.rc_opt1 = uu___3;_} -> let branches1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (pat, when_opt, body) -> @@ -2835,29 +2817,25 @@ and (term_as_mlexpr' : let uu___1 = let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.format1 "Impossible: Unexpected term: %s" - uu___2 in + FStarC_Util.format1 "Impossible: Unexpected term: %s" uu___2 in failwith uu___1 | FStarC_Syntax_Syntax.Tm_delayed uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.format1 "Impossible: Unexpected term: %s" - uu___3 in + FStarC_Util.format1 "Impossible: Unexpected term: %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_uvar uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.format1 "Impossible: Unexpected term: %s" - uu___3 in + FStarC_Util.format1 "Impossible: Unexpected term: %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_bvar uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.format1 "Impossible: Unexpected term: %s" - uu___3 in + FStarC_Util.format1 "Impossible: Unexpected term: %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_lazy i -> let uu___1 = FStarC_Syntax_Util.unfold_lazy i in @@ -2966,13 +2944,11 @@ and (term_as_mlexpr' : | FStarC_Syntax_Syntax.Tm_let { FStarC_Syntax_Syntax.lbs = (false, lb::[]); FStarC_Syntax_Syntax.body1 = body;_} - when - FStarC_Compiler_Util.is_left lb.FStarC_Syntax_Syntax.lbname - -> + when FStarC_Util.is_left lb.FStarC_Syntax_Syntax.lbname -> let tcenv = FStarC_Extraction_ML_UEnv.tcenv_of_uenv g in let uu___2 = let uu___3 = FStarC_TypeChecker_Env.effect_decl_opt tcenv m in - FStarC_Compiler_Util.must uu___3 in + FStarC_Util.must uu___3 in (match uu___2 with | (ed, qualifiers) -> let uu___3 = @@ -2987,7 +2963,7 @@ and (term_as_mlexpr' : let uu___6 = FStarC_Ident.string_of_lid ed.FStarC_Syntax_Syntax.mname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "This should not happen (should have been handled at Tm_abs level for effect %s)" uu___6 in failwith uu___5)) @@ -3128,9 +3104,8 @@ and (term_as_mlexpr' : FStarC_Class_Show.show FStarC_Extraction_ML_Code.showable_mlty (FStar_Pervasives_Native.snd mltys) in - FStarC_Compiler_Util.print3 - "looked up %s: got %s at %s \n" uu___8 uu___9 - uu___10); + FStarC_Util.print3 "looked up %s: got %s at %s \n" + uu___8 uu___9 uu___10); (match mltys with | ([], t1) when t1 = FStarC_Extraction_ML_Syntax.ml_unit_ty -> @@ -3155,13 +3130,13 @@ and (term_as_mlexpr' : (match uu___2 with | (ml_bs, env) -> let ml_bs1 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___3 -> fun b -> match uu___3 with | (x, t1) -> let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun attr -> let uu___5 = term_as_mlexpr env attr in match uu___5 with @@ -3188,14 +3163,14 @@ and (term_as_mlexpr' : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term body1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "No computation type for: %s\n" uu___5); body1) in let uu___3 = term_as_mlexpr env body2 in (match uu___3 with | (ml_body, f, t1) -> let uu___4 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___5 -> fun uu___6 -> match (uu___5, uu___6) with @@ -3304,7 +3279,7 @@ and (term_as_mlexpr' : (FStarC_Ident.lid_equals rc.FStarC_Syntax_Syntax.residual_effect FStarC_Parser_Const.effect_Tot_lid) || - (FStarC_Compiler_List.existsb + (FStarC_List.existsb (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.TOTAL -> true @@ -3338,12 +3313,12 @@ and (term_as_mlexpr' : let e = let uu___2 = FStarC_Extraction_ML_UEnv.tcenv_of_uenv g in let uu___3 = - let uu___4 = FStarC_Compiler_List.hd args in + let uu___4 = FStarC_List.hd args in FStar_Pervasives_Native.fst uu___4 in maybe_reify_term uu___2 uu___3 l in let tm = let uu___2 = FStarC_TypeChecker_Util.remove_reify e in - let uu___3 = FStarC_Compiler_List.tl args in + let uu___3 = FStarC_List.tl args in FStarC_Syntax_Syntax.mk_Tm_app uu___2 uu___3 t.FStarC_Syntax_Syntax.pos in term_as_mlexpr g tm @@ -3352,7 +3327,7 @@ and (term_as_mlexpr' : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Cannot extract %s (reify effect is not set)" uu___3 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) top1 @@ -3365,9 +3340,8 @@ and (term_as_mlexpr' : | ((mlhead, mlargs_f), (f, t1)) -> let mk_head uu___5 = let mlargs = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst - (FStarC_Compiler_List.rev mlargs_f) in + FStarC_List.map FStar_Pervasives_Native.fst + (FStarC_List.rev mlargs_f) in FStarC_Extraction_ML_Syntax.with_ty t1 (FStarC_Extraction_ML_Syntax.MLE_App (mlhead, mlargs)) in @@ -3392,7 +3366,7 @@ and (term_as_mlexpr' : | (hd, uu___10)::uu___11 -> FStarC_Class_Show.show FStarC_Syntax_Print.showable_term hd in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "extract_app ml_head=%s type of head = %s, next arg = %s\n" uu___7 uu___8 uu___9); (match (restArgs, t1) with @@ -3460,7 +3434,7 @@ and (term_as_mlexpr' : t1) | FStarC_Extraction_ML_Syntax.MLTY_Top -> let t2 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun t3 -> fun out -> FStarC_Extraction_ML_Syntax.MLTY_Fun @@ -3470,10 +3444,9 @@ and (term_as_mlexpr' : FStarC_Extraction_ML_Syntax.MLTY_Top in let mlhead1 = let mlargs = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst - (FStarC_Compiler_List.rev - mlargs_f) in + (FStarC_List.rev mlargs_f) in let head1 = FStarC_Extraction_ML_Syntax.with_ty FStarC_Extraction_ML_Syntax.MLTY_Top @@ -3489,10 +3462,9 @@ and (term_as_mlexpr' : | uu___8 -> let mlhead1 = let mlargs = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst - (FStarC_Compiler_List.rev - mlargs_f) in + (FStarC_List.rev mlargs_f) in let head1 = FStarC_Extraction_ML_Syntax.with_ty FStarC_Extraction_ML_Syntax.MLTY_Top @@ -3559,7 +3531,7 @@ and (term_as_mlexpr' : FStarC_Class_Show.show FStarC_Extraction_ML_Code.showable_etag exp_b.FStarC_Extraction_ML_UEnv.exp_b_eff in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "@@@looked up %s: got %s at %s with eff <%s>\n" uu___9 uu___10 uu___11 uu___12); (((exp_b.FStarC_Extraction_ML_UEnv.exp_b_expr), @@ -3574,24 +3546,23 @@ and (term_as_mlexpr' : | (a, uu___6)::uu___7 -> is_type g a | uu___6 -> false in let uu___6 = - let n = FStarC_Compiler_List.length vars in + let n = FStarC_List.length vars in let uu___7 = - if (FStarC_Compiler_List.length args) <= n + if (FStarC_List.length args) <= n then let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___9 -> match uu___9 with | (x, uu___10) -> term_as_mlty g x) args in (uu___8, []) else - (let uu___9 = - FStarC_Compiler_Util.first_N n args in + (let uu___9 = FStarC_Util.first_N n args in match uu___9 with | (prefix, rest) -> let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___11 -> match uu___11 with | (x, uu___12) -> @@ -3685,7 +3656,7 @@ and (term_as_mlexpr' : FStarC_Class_Show.show FStarC_Extraction_ML_Code.showable_etag exp_b.FStarC_Extraction_ML_UEnv.exp_b_eff in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "@@@looked up %s: got %s at %s with eff <%s>\n" uu___9 uu___10 uu___11 uu___12); (((exp_b.FStarC_Extraction_ML_UEnv.exp_b_expr), @@ -3700,24 +3671,23 @@ and (term_as_mlexpr' : | (a, uu___6)::uu___7 -> is_type g a | uu___6 -> false in let uu___6 = - let n = FStarC_Compiler_List.length vars in + let n = FStarC_List.length vars in let uu___7 = - if (FStarC_Compiler_List.length args) <= n + if (FStarC_List.length args) <= n then let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___9 -> match uu___9 with | (x, uu___10) -> term_as_mlty g x) args in (uu___8, []) else - (let uu___9 = - FStarC_Compiler_Util.first_N n args in + (let uu___9 = FStarC_Util.first_N n args in match uu___9 with | (prefix, rest) -> let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___11 -> match uu___11 with | (x, uu___12) -> @@ -3845,11 +3815,10 @@ and (term_as_mlexpr' : FStarC_Syntax_Util.get_attribute FStarC_Parser_Const.rename_let_attr lb.FStarC_Syntax_Syntax.lbattrs in - FStarC_Compiler_Util.is_some uu___1) + FStarC_Util.is_some uu___1) -> let b = - let uu___1 = - FStarC_Compiler_Util.left lb.FStarC_Syntax_Syntax.lbname in + let uu___1 = FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.mk_binder uu___1 in let uu___1 = FStarC_Syntax_Subst.open_term_1 b e' in (match uu___1 with @@ -3909,12 +3878,12 @@ and (term_as_mlexpr' : FStar_Pervasives_Native.None in let remove_attr attrs = let uu___5 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun attr -> let uu___6 = FStarC_Syntax_Util.get_attribute FStarC_Parser_Const.rename_let_attr [attr] in - FStarC_Compiler_Util.is_some uu___6) + FStarC_Util.is_some uu___6) lb.FStarC_Syntax_Syntax.lbattrs in match uu___5 with | (uu___6, other_attrs) -> other_attrs in let maybe_rewritten_let = @@ -4004,11 +3973,10 @@ and (term_as_mlexpr' : if uu___3 then (lbs, e') else - (let lb = FStarC_Compiler_List.hd lbs in + (let lb = FStarC_List.hd lbs in let x = let uu___5 = - FStarC_Compiler_Util.left - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.freshen_bv uu___5 in let lb1 = { @@ -4051,11 +4019,11 @@ and (term_as_mlexpr' : g in FStar_Pervasives_Native.snd uu___8 in [uu___7] in - FStarC_Compiler_List.op_At uu___5 uu___6 in + FStarC_List.op_At uu___5 uu___6 in FStarC_Ident.lid_of_path uu___4 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_TypeChecker_Env.set_current_module uu___2 uu___3 in - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let lbdef = let norm_call uu___2 = @@ -4075,10 +4043,8 @@ and (term_as_mlexpr' : lb.FStarC_Syntax_Syntax.lbdef) uu___3 "FStarC.Extraction.ML.Term.normalize_lb_def" in let uu___2 = - (FStarC_Compiler_Effect.op_Bang dbg_Extraction) - || - (FStarC_Compiler_Effect.op_Bang - dbg_ExtractionNorm) in + (FStarC_Effect.op_Bang dbg_Extraction) || + (FStarC_Effect.op_Bang dbg_ExtractionNorm) in if uu___2 then ((let uu___4 = @@ -4091,15 +4057,15 @@ and (term_as_mlexpr' : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lb.FStarC_Syntax_Syntax.lbdef in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Starting to normalize top-level let %s = %s\n" uu___4 uu___5); (let a = norm_call () in (let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term a in - FStarC_Compiler_Util.print1 - "Normalized to %s\n" uu___5); + FStarC_Util.print1 "Normalized to %s\n" + uu___5); a)) else norm_call () in { @@ -4125,7 +4091,7 @@ and (term_as_mlexpr' : (_lbname, f, (_t, (targs, polytype)), add_unit, has_c_inline, e)) -> let env1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun uu___3 -> match uu___3 with @@ -4176,7 +4142,7 @@ and (term_as_mlexpr' : }))) in let lbs3 = extract_lb_sig g (is_rec, lbs2) in let uu___2 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun lb -> fun uu___3 -> match uu___3 with @@ -4207,8 +4173,7 @@ and (term_as_mlexpr' : (match uu___2 with | (env_body, lbs4, env_burn) -> let env_def = if is_rec then env_body else env_burn in - let lbs5 = - FStarC_Compiler_List.map (check_lb env_def) lbs4 in + let lbs5 = FStarC_List.map (check_lb env_def) lbs4 in let e'_rng = e'1.FStarC_Syntax_Syntax.pos in let uu___3 = term_as_mlexpr env_body e'1 in (match uu___3 with @@ -4216,8 +4181,8 @@ and (term_as_mlexpr' : let f = let uu___4 = let uu___5 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst lbs5 in + FStarC_List.map FStar_Pervasives_Native.fst + lbs5 in f' :: uu___5 in FStarC_Extraction_ML_Util.join_l e'_rng uu___4 in let is_rec1 = @@ -4228,8 +4193,8 @@ and (term_as_mlexpr' : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.snd lbs5 in + FStarC_List.map FStar_Pervasives_Native.snd + lbs5 in (is_rec1, uu___7) in mk_MLE_Let top_level uu___6 e'2 in let uu___6 = @@ -4302,7 +4267,7 @@ and (term_as_mlexpr' : "ITE pats matched but then and else expressions not found?") else (let uu___6 = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun compat -> fun br -> let uu___7 = @@ -4340,7 +4305,7 @@ and (term_as_mlexpr' : | (mlbranch, f_branch, t_branch) -> let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___12 -> match uu___12 with | (p1, wopt) -> @@ -4360,8 +4325,7 @@ and (term_as_mlexpr' : uu___11))))) true pats in match uu___6 with | (pat_t_compat, mlbranches) -> - let mlbranches1 = - FStarC_Compiler_List.flatten mlbranches in + let mlbranches1 = FStarC_List.flatten mlbranches in let e1 = if pat_t_compat then e @@ -4380,7 +4344,7 @@ and (term_as_mlexpr' : g in FStarC_Extraction_ML_Code.string_of_mlty uu___12 t_e in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Coercing scrutinee %s from type %s because pattern type is incompatible\n" uu___10 uu___11); FStarC_Extraction_ML_Syntax.with_ty t_e @@ -4431,7 +4395,7 @@ and (term_as_mlexpr' : | (uu___7, uu___8, (uu___9, f_first, t_first))::rest -> let uu___10 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___11 -> fun uu___12 -> match (uu___11, uu___12) with @@ -4472,7 +4436,7 @@ and (term_as_mlexpr' : (match uu___10 with | (topt, f_match) -> let mlbranches2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___11 -> match uu___11 with | (p, (wopt, uu___12), @@ -4523,7 +4487,7 @@ let (ind_discriminator_body : FStarC_Syntax_Syntax.comp = uu___4;_} -> let binders1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___5 -> match uu___5 with | { FStarC_Syntax_Syntax.binder_bv = uu___6; @@ -4534,7 +4498,7 @@ let (ind_discriminator_body : FStarC_Syntax_Syntax.binder_attrs = uu___9;_} -> true | uu___6 -> false) binders in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___5 -> fun uu___6 -> match uu___6 with @@ -4557,7 +4521,7 @@ let (ind_discriminator_body : let disc_ty = FStarC_Extraction_ML_Syntax.MLTY_Top in let discrBody = let bs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (x, t) -> @@ -4569,8 +4533,7 @@ let (ind_discriminator_body : FStarC_Extraction_ML_Syntax.mlbinder_attrs = [] }) - (FStarC_Compiler_List.op_At wildcards - [(mlid, targ)]) in + (FStarC_List.op_At wildcards [(mlid, targ)]) in let uu___4 = let uu___5 = let uu___6 = diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_ML_UEnv.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_UEnv.ml similarity index 84% rename from stage0/fstar-lib/generated/FStarC_Extraction_ML_UEnv.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_UEnv.ml index b4a1184f365..2ee1a04178d 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_ML_UEnv.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_UEnv.ml @@ -56,6 +56,16 @@ let (uu___is_ErasedFv : binding -> Prims.bool) = match projectee with | ErasedFv _0 -> true | uu___ -> false let (__proj__ErasedFv__item___0 : binding -> FStarC_Syntax_Syntax.fv) = fun projectee -> match projectee with | ErasedFv _0 -> _0 +let (plug : unit -> Prims.bool) = + fun uu___ -> + (let uu___1 = FStarC_Options.codegen () in + uu___1 = (FStar_Pervasives_Native.Some FStarC_Options.Plugin)) || + (let uu___1 = FStarC_Options.codegen () in + uu___1 = (FStar_Pervasives_Native.Some FStarC_Options.PluginNoLib)) +let (plug_no_lib : unit -> Prims.bool) = + fun uu___ -> + let uu___1 = FStarC_Options.codegen () in + uu___1 = (FStar_Pervasives_Native.Some FStarC_Options.PluginNoLib) type tydef = { tydef_fv: FStarC_Syntax_Syntax.fv ; @@ -103,19 +113,15 @@ type uenv = { env_tcenv: FStarC_TypeChecker_Env.env ; env_bindings: binding Prims.list ; - env_mlident_map: - FStarC_Extraction_ML_Syntax.mlident FStarC_Compiler_Util.psmap ; + env_mlident_map: FStarC_Extraction_ML_Syntax.mlident FStarC_Util.psmap ; env_remove_typars: FStarC_Extraction_ML_RemoveUnusedParameters.env_t ; - mlpath_of_lid: - FStarC_Extraction_ML_Syntax.mlpath FStarC_Compiler_Util.psmap ; - env_fieldname_map: - FStarC_Extraction_ML_Syntax.mlident FStarC_Compiler_Util.psmap ; - mlpath_of_fieldname: - FStarC_Extraction_ML_Syntax.mlpath FStarC_Compiler_Util.psmap ; + mlpath_of_lid: FStarC_Extraction_ML_Syntax.mlpath FStarC_Util.psmap ; + env_fieldname_map: FStarC_Extraction_ML_Syntax.mlident FStarC_Util.psmap ; + mlpath_of_fieldname: FStarC_Extraction_ML_Syntax.mlpath FStarC_Util.psmap ; tydefs: tydef Prims.list ; type_names: (FStarC_Syntax_Syntax.fv * FStarC_Extraction_ML_Syntax.mlpath) Prims.list ; - tydef_declarations: Prims.bool FStarC_Compiler_Util.psmap ; + tydef_declarations: Prims.bool FStarC_Util.psmap ; currentModule: FStarC_Extraction_ML_Syntax.mlpath } let (__proj__Mkuenv__item__env_tcenv : uenv -> FStarC_TypeChecker_Env.env) = fun projectee -> @@ -130,7 +136,7 @@ let (__proj__Mkuenv__item__env_bindings : uenv -> binding Prims.list) = mlpath_of_lid; env_fieldname_map; mlpath_of_fieldname; tydefs; type_names; tydef_declarations; currentModule;_} -> env_bindings let (__proj__Mkuenv__item__env_mlident_map : - uenv -> FStarC_Extraction_ML_Syntax.mlident FStarC_Compiler_Util.psmap) = + uenv -> FStarC_Extraction_ML_Syntax.mlident FStarC_Util.psmap) = fun projectee -> match projectee with | { env_tcenv; env_bindings; env_mlident_map; env_remove_typars; @@ -144,21 +150,21 @@ let (__proj__Mkuenv__item__env_remove_typars : mlpath_of_lid; env_fieldname_map; mlpath_of_fieldname; tydefs; type_names; tydef_declarations; currentModule;_} -> env_remove_typars let (__proj__Mkuenv__item__mlpath_of_lid : - uenv -> FStarC_Extraction_ML_Syntax.mlpath FStarC_Compiler_Util.psmap) = + uenv -> FStarC_Extraction_ML_Syntax.mlpath FStarC_Util.psmap) = fun projectee -> match projectee with | { env_tcenv; env_bindings; env_mlident_map; env_remove_typars; mlpath_of_lid; env_fieldname_map; mlpath_of_fieldname; tydefs; type_names; tydef_declarations; currentModule;_} -> mlpath_of_lid let (__proj__Mkuenv__item__env_fieldname_map : - uenv -> FStarC_Extraction_ML_Syntax.mlident FStarC_Compiler_Util.psmap) = + uenv -> FStarC_Extraction_ML_Syntax.mlident FStarC_Util.psmap) = fun projectee -> match projectee with | { env_tcenv; env_bindings; env_mlident_map; env_remove_typars; mlpath_of_lid; env_fieldname_map; mlpath_of_fieldname; tydefs; type_names; tydef_declarations; currentModule;_} -> env_fieldname_map let (__proj__Mkuenv__item__mlpath_of_fieldname : - uenv -> FStarC_Extraction_ML_Syntax.mlpath FStarC_Compiler_Util.psmap) = + uenv -> FStarC_Extraction_ML_Syntax.mlpath FStarC_Util.psmap) = fun projectee -> match projectee with | { env_tcenv; env_bindings; env_mlident_map; env_remove_typars; @@ -181,7 +187,7 @@ let (__proj__Mkuenv__item__type_names : mlpath_of_lid; env_fieldname_map; mlpath_of_fieldname; tydefs; type_names; tydef_declarations; currentModule;_} -> type_names let (__proj__Mkuenv__item__tydef_declarations : - uenv -> Prims.bool FStarC_Compiler_Util.psmap) = + uenv -> Prims.bool FStarC_Util.psmap) = fun projectee -> match projectee with | { env_tcenv; env_bindings; env_mlident_map; env_remove_typars; @@ -258,30 +264,28 @@ let with_typars_env : currentModule = (u.currentModule) }, x) let (bindings_of_uenv : uenv -> binding Prims.list) = fun u -> u.env_bindings -let (dbg : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Extraction" +let (dbg : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Extraction" let (debug : uenv -> (unit -> unit) -> unit) = fun g -> fun f -> let c = FStarC_Extraction_ML_Syntax.string_of_mlpath g.currentModule in - let uu___ = FStarC_Compiler_Effect.op_Bang dbg in - if uu___ then f () else () + let uu___ = FStarC_Effect.op_Bang dbg in if uu___ then f () else () let (print_mlpath_map : uenv -> Prims.string) = fun g -> let string_of_mlpath mlp = Prims.strcat - (FStarC_Compiler_String.concat "." (FStar_Pervasives_Native.fst mlp)) + (FStarC_String.concat "." (FStar_Pervasives_Native.fst mlp)) (Prims.strcat "." (FStar_Pervasives_Native.snd mlp)) in let entries = - FStarC_Compiler_Util.psmap_fold g.mlpath_of_lid + FStarC_Util.psmap_fold g.mlpath_of_lid (fun key -> fun value -> fun entries1 -> let uu___ = - FStarC_Compiler_Util.format2 "%s -> %s" key - (string_of_mlpath value) in + FStarC_Util.format2 "%s -> %s" key (string_of_mlpath value) in uu___ :: entries1) [] in - FStarC_Compiler_String.concat "\n" entries + FStarC_String.concat "\n" entries let (lookup_fv_generic : uenv -> FStarC_Syntax_Syntax.fv -> @@ -290,7 +294,7 @@ let (lookup_fv_generic : fun g -> fun fv -> let v = - FStarC_Compiler_Util.find_map g.env_bindings + FStarC_Util.find_map g.env_bindings (fun uu___ -> match uu___ with | Fv (fv', t) when FStarC_Syntax_Syntax.fv_eq fv fv' -> @@ -302,7 +306,7 @@ let (lookup_fv_generic : | FStar_Pervasives_Native.Some r -> r | FStar_Pervasives_Native.None -> FStar_Pervasives.Inl false let (try_lookup_fv : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> uenv -> FStarC_Syntax_Syntax.fv -> exp_binding FStar_Pervasives_Native.option) = @@ -319,7 +323,7 @@ let (try_lookup_fv : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fv in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Will not extract reference to variable `%s` since it has the `noextract` qualifier." uu___5 in FStarC_Errors_Msg.text uu___4 in @@ -331,9 +335,9 @@ let (try_lookup_fv : let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Util.string_of_int + FStarC_Util.string_of_int FStarC_Errors.call_to_erased_errno in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "This error can be ignored with `--warn_error -%s`." uu___9 in FStarC_Errors_Msg.text uu___8 in @@ -347,8 +351,7 @@ let (try_lookup_fv : FStar_Pervasives_Native.None) | FStar_Pervasives.Inl (false) -> FStar_Pervasives_Native.None let (lookup_fv : - FStarC_Compiler_Range_Type.range -> - uenv -> FStarC_Syntax_Syntax.fv -> exp_binding) + FStarC_Range_Type.range -> uenv -> FStarC_Syntax_Syntax.fv -> exp_binding) = fun r -> fun g -> @@ -359,13 +362,13 @@ let (lookup_fv : | FStar_Pervasives.Inl b -> let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.p in let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - let uu___4 = FStarC_Compiler_Util.string_of_bool b in - FStarC_Compiler_Util.format3 + let uu___4 = FStarC_Util.string_of_bool b in + FStarC_Util.format3 "Internal error: (%s) free variable %s not found during extraction (erased=%s)\n" uu___2 uu___3 uu___4 in failwith uu___1 @@ -373,7 +376,7 @@ let (lookup_bv : uenv -> FStarC_Syntax_Syntax.bv -> ty_or_exp_b) = fun g -> fun bv -> let x = - FStarC_Compiler_Util.find_map g.env_bindings + FStarC_Util.find_map g.env_bindings (fun uu___ -> match uu___ with | Bv (bv', r) when FStarC_Syntax_Syntax.bv_eq bv bv' -> @@ -385,11 +388,11 @@ let (lookup_bv : uenv -> FStarC_Syntax_Syntax.bv -> ty_or_exp_b) = let uu___1 = let uu___2 = FStarC_Ident.range_of_id bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Range_Ops.string_of_range uu___2 in + FStarC_Range_Ops.string_of_range uu___2 in let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv bv in - FStarC_Compiler_Util.format2 "(%s) bound Variable %s not found\n" - uu___1 uu___2 in + FStarC_Util.format2 "(%s) bound Variable %s not found\n" uu___1 + uu___2 in failwith uu___ | FStar_Pervasives_Native.Some y -> y let (lookup_term : @@ -425,7 +428,7 @@ let (lookup_tydef : fun uu___ -> match uu___ with | (module_name, ty_name) -> - FStarC_Compiler_Util.find_map env.tydefs + FStarC_Util.find_map env.tydefs (fun tydef1 -> if (ty_name = tydef1.tydef_name) && @@ -437,7 +440,7 @@ let (has_tydef_declaration : uenv -> FStarC_Ident.lident -> Prims.bool) = fun l -> let uu___ = let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.psmap_try_find u.tydef_declarations uu___1 in + FStarC_Util.psmap_try_find u.tydef_declarations uu___1 in match uu___ with | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some b -> b @@ -447,16 +450,15 @@ let (mlpath_of_lident : fun x -> let uu___ = let uu___1 = FStarC_Ident.string_of_lid x in - FStarC_Compiler_Util.psmap_try_find g.mlpath_of_lid uu___1 in + FStarC_Util.psmap_try_find g.mlpath_of_lid uu___1 in match uu___ with | FStar_Pervasives_Native.None -> (debug g (fun uu___2 -> (let uu___4 = FStarC_Ident.string_of_lid x in - FStarC_Compiler_Util.print1 "Identifier not found: %s" - uu___4); + FStarC_Util.print1 "Identifier not found: %s" uu___4); (let uu___4 = print_mlpath_map g in - FStarC_Compiler_Util.print1 "Env is \n%s\n" uu___4)); + FStarC_Util.print1 "Env is \n%s\n" uu___4)); (let uu___2 = let uu___3 = FStarC_Ident.string_of_lid x in Prims.strcat "Identifier not found: " uu___3 in @@ -465,7 +467,7 @@ let (mlpath_of_lident : let (is_type_name : uenv -> FStarC_Syntax_Syntax.fv -> Prims.bool) = fun g -> fun fv -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___ -> match uu___ with | (x, uu___1) -> FStarC_Syntax_Syntax.fv_eq fv x) g.type_names @@ -473,7 +475,7 @@ let (is_fv_type : uenv -> FStarC_Syntax_Syntax.fv -> Prims.bool) = fun g -> fun fv -> (is_type_name g fv) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun tydef1 -> FStarC_Syntax_Syntax.fv_eq fv tydef1.tydef_fv) g.tydefs) let (no_fstar_stubs_ns : @@ -481,12 +483,17 @@ let (no_fstar_stubs_ns : FStarC_Extraction_ML_Syntax.mlsymbol Prims.list) = fun ns -> - let pl = - let uu___ = FStarC_Options.codegen () in - uu___ = (FStar_Pervasives_Native.Some FStarC_Options.Plugin) in match ns with - | "Prims"::[] when pl -> ["Prims"] - | "FStar"::"Stubs"::rest when pl -> "FStarC" :: rest + | "FStar"::"Stubs"::rest when + (plug_no_lib ()) && (FStarC_Options_Ext.enabled "__guts") -> "FStarC" + :: rest + | "FStar"::"Stubs"::"Tactics"::"V1"::"Builtins"::[] when plug () -> + ["FStarC"; "Tactics"; "V1"; "Builtins"] + | "FStar"::"Stubs"::"Tactics"::"V2"::"Builtins"::[] when plug () -> + ["FStarC"; "Tactics"; "V2"; "Builtins"] + | "FStar"::"Stubs"::"Tactics"::"Unseal"::[] when plug () -> + ["FStarC"; "Tactics"; "Unseal"] + | "FStar"::"Stubs"::rest when plug () -> "Fstarcompiler.FStarC" :: rest | "FStar"::"Stubs"::rest -> "FStar" :: rest | uu___ -> ns let (no_fstar_stubs : @@ -507,11 +514,11 @@ let (lookup_record_field_name : let key = let uu___1 = let uu___2 = FStarC_Ident.ids_of_lid type_name in - FStarC_Compiler_List.op_At uu___2 [fn] in + FStarC_List.op_At uu___2 [fn] in FStarC_Ident.lid_of_ids uu___1 in let uu___1 = let uu___2 = FStarC_Ident.string_of_lid key in - FStarC_Compiler_Util.psmap_try_find g.mlpath_of_fieldname uu___2 in + FStarC_Util.psmap_try_find g.mlpath_of_fieldname uu___2 in (match uu___1 with | FStar_Pervasives_Native.None -> let uu___2 = @@ -521,22 +528,11 @@ let (lookup_record_field_name : | FStar_Pervasives_Native.Some mlp -> let uu___2 = mlp in (match uu___2 with - | (ns, id) -> - let uu___3 = - let uu___4 = FStarC_Options.codegen () in - uu___4 = - (FStar_Pervasives_Native.Some FStarC_Options.Plugin) in - if uu___3 - then - let uu___4 = - FStarC_Compiler_List.filter (fun s -> s <> "Stubs") - ns in - (uu___4, id) - else (ns, id))) -let (initial_mlident_map : unit -> Prims.string FStarC_Compiler_Util.psmap) = - let map = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + | (ns, id) -> let ns1 = no_fstar_stubs_ns ns in (ns1, id))) +let (initial_mlident_map : unit -> Prims.string FStarC_Util.psmap) = + let map = FStarC_Util.mk_ref FStar_Pervasives_Native.None in fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang map in + let uu___1 = FStarC_Effect.op_Bang map in match uu___1 with | FStar_Pervasives_Native.Some m -> m | FStar_Pervasives_Native.None -> @@ -550,49 +546,46 @@ let (initial_mlident_map : unit -> Prims.string FStarC_Compiler_Util.psmap) = FStarC_Extraction_ML_Syntax.ocamlkeywords | FStar_Pervasives_Native.Some (FStarC_Options.Plugin) -> FStarC_Extraction_ML_Syntax.ocamlkeywords + | FStar_Pervasives_Native.Some (FStarC_Options.PluginNoLib) -> + FStarC_Extraction_ML_Syntax.ocamlkeywords | FStar_Pervasives_Native.Some (FStarC_Options.Krml) -> FStarC_Extraction_ML_Syntax.krml_keywords | FStar_Pervasives_Native.Some (FStarC_Options.Extension) -> [] | FStar_Pervasives_Native.None -> [] in - let uu___3 = FStarC_Compiler_Util.psmap_empty () in - FStarC_Compiler_List.fold_right - (fun x -> fun m1 -> FStarC_Compiler_Util.psmap_add m1 x "") - uu___2 uu___3 in - (FStarC_Compiler_Effect.op_Colon_Equals map - (FStar_Pervasives_Native.Some m); + let uu___3 = FStarC_Util.psmap_empty () in + FStarC_List.fold_right + (fun x -> fun m1 -> FStarC_Util.psmap_add m1 x "") uu___2 uu___3 in + (FStarC_Effect.op_Colon_Equals map (FStar_Pervasives_Native.Some m); m) let (rename_conventional : Prims.string -> Prims.bool -> Prims.string) = fun s -> fun is_local_type_variable -> let cs = FStar_String.list_of_string s in let sanitize_typ uu___ = - let valid_rest c = FStarC_Compiler_Util.is_letter_or_digit c in + let valid_rest c = FStarC_Util.is_letter_or_digit c in let aux cs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___1 = valid_rest x in if uu___1 then x else 117) cs1 in - let uu___1 = let uu___2 = FStarC_Compiler_List.hd cs in uu___2 = 39 in + let uu___1 = let uu___2 = FStarC_List.hd cs in uu___2 = 39 in if uu___1 then - let uu___2 = FStarC_Compiler_List.hd cs in - let uu___3 = - let uu___4 = FStarC_Compiler_List.tail cs in aux uu___4 in + let uu___2 = FStarC_List.hd cs in + let uu___3 = let uu___4 = FStarC_List.tail cs in aux uu___4 in uu___2 :: uu___3 else (let uu___3 = aux cs in 39 :: uu___3) in let sanitize_term uu___ = let valid c = - ((FStarC_Compiler_Util.is_letter_or_digit c) || (c = 95)) || - (c = 39) in + ((FStarC_Util.is_letter_or_digit c) || (c = 95)) || (c = 39) in let cs' = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun c -> fun cs1 -> let uu___1 = let uu___2 = valid c in if uu___2 then [c] else [95; 95] in - FStarC_Compiler_List.op_At uu___1 cs1) cs [] in + FStarC_List.op_At uu___1 cs1) cs [] in match cs' with - | c::cs1 when (FStarC_Compiler_Util.is_digit c) || (c = 39) -> 95 :: - c :: cs1 + | c::cs1 when (FStarC_Util.is_digit c) || (c = 39) -> 95 :: c :: cs1 | uu___1 -> cs in let uu___ = if is_local_type_variable then sanitize_typ () else sanitize_term () in @@ -602,15 +595,15 @@ let (root_name_of_bv : fun x -> let uu___ = (let uu___1 = FStarC_Ident.string_of_id x.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Util.starts_with uu___1 FStarC_Ident.reserved_prefix) - || (FStarC_Syntax_Syntax.is_null_bv x) in + FStarC_Util.starts_with uu___1 FStarC_Ident.reserved_prefix) || + (FStarC_Syntax_Syntax.is_null_bv x) in if uu___ then FStarC_Ident.reserved_prefix else FStarC_Ident.string_of_id x.FStarC_Syntax_Syntax.ppname let (find_uniq : - Prims.string FStarC_Compiler_Util.psmap -> + Prims.string FStarC_Util.psmap -> Prims.string -> - Prims.bool -> (Prims.string * Prims.string FStarC_Compiler_Util.psmap)) + Prims.bool -> (Prims.string * Prims.string FStarC_Util.psmap)) = fun ml_ident_map -> fun root_name -> @@ -620,23 +613,20 @@ let (find_uniq : if i = Prims.int_zero then root_name1 else - (let uu___1 = FStarC_Compiler_Util.string_of_int i in + (let uu___1 = FStarC_Util.string_of_int i in Prims.strcat root_name1 uu___1) in - let uu___ = - FStarC_Compiler_Util.psmap_try_find ml_ident_map target_mlident in + let uu___ = FStarC_Util.psmap_try_find ml_ident_map target_mlident in match uu___ with | FStar_Pervasives_Native.Some x -> aux (i + Prims.int_one) root_name1 | FStar_Pervasives_Native.None -> - let map = - FStarC_Compiler_Util.psmap_add ml_ident_map target_mlident "" in + let map = FStarC_Util.psmap_add ml_ident_map target_mlident "" in (target_mlident, map) in let mlident = rename_conventional root_name is_local_type_variable in if is_local_type_variable then let uu___ = - let uu___1 = - FStarC_Compiler_Util.substring_from mlident Prims.int_one in + let uu___1 = FStarC_Util.substring_from mlident Prims.int_one in aux Prims.int_zero uu___1 in match uu___ with | (nm, map) -> ((Prims.strcat "'" nm), map) else aux Prims.int_zero mlident @@ -645,7 +635,7 @@ let (mlns_of_lid : fun x -> let uu___ = let uu___1 = FStarC_Ident.ns_of_lid x in - FStarC_Compiler_List.map FStarC_Ident.string_of_id uu___1 in + FStarC_List.map FStarC_Ident.string_of_id uu___1 in no_fstar_stubs_ns uu___ let (new_mlpath_of_lident : uenv -> FStarC_Ident.lident -> (FStarC_Extraction_ML_Syntax.mlpath * uenv)) @@ -690,10 +680,44 @@ let (new_mlpath_of_lident : (uu___4, g1)) in match uu___ with | (mlp, g1) -> + let guts uu___1 = + match uu___1 with + | (p::ps, l) -> (((Prims.strcat "Fstarcompiler." p) :: ps), l) in + let mlp1 = + let uu___1 = FStarC_Ident.string_of_lid x in + match uu___1 with + | "Prims.dtuple2" when plug () -> guts mlp + | "Prims.Mkdtuple2" when plug () -> guts mlp + | "FStar.Pervasives.either" when plug () -> guts mlp + | "FStar.Pervasives.Inl" when plug () -> guts mlp + | "FStar.Pervasives.Inr" when plug () -> guts mlp + | "FStar.Pervasives.norm_step" when plug () -> guts mlp + | "FStar.Pervasives.norm_debug" when plug () -> guts mlp + | "FStar.Pervasives.simplify" when plug () -> guts mlp + | "FStar.Pervasives.weak" when plug () -> guts mlp + | "FStar.Pervasives.hnf" when plug () -> guts mlp + | "FStar.Pervasives.primops" when plug () -> guts mlp + | "FStar.Pervasives.delta" when plug () -> guts mlp + | "FStar.Pervasives.norm_debug" when plug () -> guts mlp + | "FStar.Pervasives.zeta" when plug () -> guts mlp + | "FStar.Pervasives.zeta_full" when plug () -> guts mlp + | "FStar.Pervasives.iota" when plug () -> guts mlp + | "FStar.Pervasives.nbe" when plug () -> guts mlp + | "FStar.Pervasives.reify_" when plug () -> guts mlp + | "FStar.Pervasives.delta_only" when plug () -> guts mlp + | "FStar.Pervasives.delta_fully" when plug () -> guts mlp + | "FStar.Pervasives.delta_attr" when plug () -> guts mlp + | "FStar.Pervasives.delta_qualifier" when plug () -> guts mlp + | "FStar.Pervasives.delta_namespace" when plug () -> guts mlp + | "FStar.Pervasives.unmeta" when plug () -> guts mlp + | "FStar.Pervasives.unascribe" when plug () -> guts mlp + | "FStar.Stubs.Tactics.Common.Stop" -> + (["Fstarcompiler.FStarC"; "Errors"], "Stop") + | uu___2 -> mlp in let g2 = let uu___1 = let uu___2 = FStarC_Ident.string_of_lid x in - FStarC_Compiler_Util.psmap_add g1.mlpath_of_lid uu___2 mlp in + FStarC_Util.psmap_add g1.mlpath_of_lid uu___2 mlp1 in { env_tcenv = (g1.env_tcenv); env_bindings = (g1.env_bindings); @@ -707,7 +731,7 @@ let (new_mlpath_of_lident : tydef_declarations = (g1.tydef_declarations); currentModule = (g1.currentModule) } in - (mlp, g2) + (mlp1, g2) let (extend_ty : uenv -> FStarC_Syntax_Syntax.bv -> Prims.bool -> uenv) = fun g -> fun a -> @@ -816,7 +840,7 @@ let (extend_bv : let (burn_name : uenv -> FStarC_Extraction_ML_Syntax.mlident -> uenv) = fun g -> fun i -> - let uu___ = FStarC_Compiler_Util.psmap_add g.env_mlident_map i "" in + let uu___ = FStarC_Util.psmap_add g.env_mlident_map i "" in { env_tcenv = (g.env_tcenv); env_bindings = (g.env_bindings); @@ -855,19 +879,17 @@ let (extend_fv : | FStarC_Extraction_ML_Syntax.MLTY_Var x1 -> [x1] | FStarC_Extraction_ML_Syntax.MLTY_Fun (t1, f, t2) -> let uu___ = mltyFvars t1 in - let uu___1 = mltyFvars t2 in - FStarC_Compiler_List.append uu___ uu___1 + let uu___1 = mltyFvars t2 in FStarC_List.append uu___ uu___1 | FStarC_Extraction_ML_Syntax.MLTY_Named (args, path) -> - FStarC_Compiler_List.collect mltyFvars args + FStarC_List.collect mltyFvars args | FStarC_Extraction_ML_Syntax.MLTY_Tuple ts -> - FStarC_Compiler_List.collect mltyFvars ts + FStarC_List.collect mltyFvars ts | FStarC_Extraction_ML_Syntax.MLTY_Top -> [] | FStarC_Extraction_ML_Syntax.MLTY_Erased -> [] in let rec subsetMlidents la lb = match la with | h::tla -> - (FStarC_Compiler_List.contains h lb) && - (subsetMlidents tla lb) + (FStarC_List.contains h lb) && (subsetMlidents tla lb) | [] -> true in let tySchemeIsClosed tys = let uu___ = mltyFvars (FStar_Pervasives_Native.snd tys) in @@ -917,8 +939,7 @@ let (extend_fv : } in let gamma = (Fv (x, exp_binding1)) :: (g1.env_bindings) in let mlident_map = - FStarC_Compiler_Util.psmap_add g1.env_mlident_map - mlsymbol "" in + FStarC_Util.psmap_add g1.env_mlident_map mlsymbol "" in ({ env_tcenv = (g1.env_tcenv); env_bindings = gamma; @@ -936,7 +957,7 @@ let (extend_fv : (let uu___2 = let uu___3 = FStarC_Extraction_ML_Syntax.mltyscheme_to_string t_x in - FStarC_Compiler_Util.format1 "freevars found (%s)" uu___3 in + FStarC_Util.format1 "freevars found (%s)" uu___3 in failwith uu___2) let (extend_erased_fv : uenv -> FStarC_Syntax_Syntax.fv -> uenv) = fun g -> @@ -1013,7 +1034,7 @@ let (extend_with_tydef_declaration : uenv -> FStarC_Ident.lident -> uenv) = fun l -> let uu___ = let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.psmap_add u.tydef_declarations uu___1 true in + FStarC_Util.psmap_add u.tydef_declarations uu___1 true in { env_tcenv = (u.env_tcenv); env_bindings = (u.env_bindings); @@ -1098,7 +1119,7 @@ let (extend_with_action_name : let uu___ = let uu___1 = let uu___2 = FStarC_Ident.id_of_text nm in [uu___2] in - FStarC_Compiler_List.op_At module_name uu___1 in + FStarC_List.op_At module_name uu___1 in FStarC_Ident.lid_of_ids uu___ in let uu___ = let uu___1 = @@ -1120,7 +1141,7 @@ let (extend_record_field_name : let key = let uu___1 = let uu___2 = FStarC_Ident.ids_of_lid type_name in - FStarC_Compiler_List.op_At uu___2 [fn] in + FStarC_List.op_At uu___2 [fn] in FStarC_Ident.lid_of_ids uu___1 in let uu___1 = let uu___2 = FStarC_Ident.string_of_id fn in @@ -1133,8 +1154,7 @@ let (extend_record_field_name : let g1 = let uu___2 = let uu___3 = FStarC_Ident.string_of_lid key in - FStarC_Compiler_Util.psmap_add g.mlpath_of_fieldname - uu___3 mlp1 in + FStarC_Util.psmap_add g.mlpath_of_fieldname uu___3 mlp1 in { env_tcenv = (g.env_tcenv); env_bindings = (g.env_bindings); @@ -1180,10 +1200,10 @@ let (new_uenv : FStarC_TypeChecker_Env.env -> uenv) = fun e -> let env = let uu___ = initial_mlident_map () in - let uu___1 = FStarC_Compiler_Util.psmap_empty () in + let uu___1 = FStarC_Util.psmap_empty () in let uu___2 = initial_mlident_map () in - let uu___3 = FStarC_Compiler_Util.psmap_empty () in - let uu___4 = FStarC_Compiler_Util.psmap_empty () in + let uu___3 = FStarC_Util.psmap_empty () in + let uu___4 = FStarC_Util.psmap_empty () in { env_tcenv = e; env_bindings = []; diff --git a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Util.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Util.ml similarity index 86% rename from stage0/fstar-lib/generated/FStarC_Extraction_ML_Util.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Util.ml index b17379e28fc..da7105d1b78 100644 --- a/stage0/fstar-lib/generated/FStarC_Extraction_ML_Util.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Extraction_ML_Util.ml @@ -6,7 +6,7 @@ let (codegen_fsharp : unit -> Prims.bool) = let pruneNones : 'a . 'a FStar_Pervasives_Native.option Prims.list -> 'a Prims.list = fun l -> - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun x -> fun ll -> match x with @@ -42,7 +42,7 @@ let (mlconst_of_const' : | FStarC_Const.Const_reflect uu___ -> failwith "Unhandled constant: real/reify/reflect" let (mlconst_of_const : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Const.sconst -> FStarC_Extraction_ML_Syntax.mlconstant) = fun p -> @@ -51,20 +51,20 @@ let (mlconst_of_const : with | uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_Range_Ops.string_of_range p in + let uu___2 = FStarC_Range_Ops.string_of_range p in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c in - FStarC_Compiler_Util.format2 - "(%s) Failed to translate constant %s " uu___2 uu___3 in + FStarC_Util.format2 "(%s) Failed to translate constant %s " + uu___2 uu___3 in failwith uu___1 let (mlexpr_of_range : - FStarC_Compiler_Range_Type.range -> FStarC_Extraction_ML_Syntax.mlexpr') = + FStarC_Range_Type.range -> FStarC_Extraction_ML_Syntax.mlexpr') = fun r -> let cint i = let uu___ = let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Util.string_of_int i in + let uu___3 = FStarC_Util.string_of_int i in (uu___3, FStar_Pervasives_Native.None) in FStarC_Extraction_ML_Syntax.MLC_Int uu___2 in FStarC_Extraction_ML_Syntax.MLE_Const uu___1 in @@ -75,37 +75,36 @@ let (mlexpr_of_range : FStarC_Extraction_ML_Syntax.ml_string_ty (FStarC_Extraction_ML_Syntax.MLE_Const (FStarC_Extraction_ML_Syntax.MLC_String s)) in - let drop_path = FStarC_Compiler_Util.basename in + let drop_path = FStarC_Util.basename in let uu___ = let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Range_Ops.file_of_range r in - drop_path uu___4 in + let uu___4 = FStarC_Range_Ops.file_of_range r in drop_path uu___4 in cstr uu___3 in let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_Range_Ops.start_of_range r in - FStarC_Compiler_Range_Ops.line_of_pos uu___6 in + let uu___6 = FStarC_Range_Ops.start_of_range r in + FStarC_Range_Ops.line_of_pos uu___6 in cint uu___5 in let uu___5 = let uu___6 = let uu___7 = - let uu___8 = FStarC_Compiler_Range_Ops.start_of_range r in - FStarC_Compiler_Range_Ops.col_of_pos uu___8 in + let uu___8 = FStarC_Range_Ops.start_of_range r in + FStarC_Range_Ops.col_of_pos uu___8 in cint uu___7 in let uu___7 = let uu___8 = let uu___9 = - let uu___10 = FStarC_Compiler_Range_Ops.end_of_range r in - FStarC_Compiler_Range_Ops.line_of_pos uu___10 in + let uu___10 = FStarC_Range_Ops.end_of_range r in + FStarC_Range_Ops.line_of_pos uu___10 in cint uu___9 in let uu___9 = let uu___10 = let uu___11 = - let uu___12 = FStarC_Compiler_Range_Ops.end_of_range r in - FStarC_Compiler_Range_Ops.col_of_pos uu___12 in + let uu___12 = FStarC_Range_Ops.end_of_range r in + FStarC_Range_Ops.col_of_pos uu___12 in cint uu___11 in [uu___10] in uu___8 :: uu___9 in @@ -115,7 +114,7 @@ let (mlexpr_of_range : (mk_range_mle, uu___1) in FStarC_Extraction_ML_Syntax.MLE_App uu___ let (mlexpr_of_const : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Const.sconst -> FStarC_Extraction_ML_Syntax.mlexpr') = fun p -> @@ -135,7 +134,7 @@ let rec (subst_aux : match t with | FStarC_Extraction_ML_Syntax.MLTY_Var x -> let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | (y, uu___2) -> y = x) subst in (match uu___ with | FStar_Pervasives_Native.Some ts -> @@ -148,11 +147,11 @@ let rec (subst_aux : FStarC_Extraction_ML_Syntax.MLTY_Fun uu___ | FStarC_Extraction_ML_Syntax.MLTY_Named (args, path) -> let uu___ = - let uu___1 = FStarC_Compiler_List.map (subst_aux subst) args in + let uu___1 = FStarC_List.map (subst_aux subst) args in (uu___1, path) in FStarC_Extraction_ML_Syntax.MLTY_Named uu___ | FStarC_Extraction_ML_Syntax.MLTY_Tuple ts -> - let uu___ = FStarC_Compiler_List.map (subst_aux subst) ts in + let uu___ = FStarC_List.map (subst_aux subst) ts in FStarC_Extraction_ML_Syntax.MLTY_Tuple uu___ | FStarC_Extraction_ML_Syntax.MLTY_Top -> t | FStarC_Extraction_ML_Syntax.MLTY_Erased -> t @@ -165,16 +164,14 @@ let (try_subst : fun args -> match uu___ with | (formals, t) -> - if - (FStarC_Compiler_List.length formals) <> - (FStarC_Compiler_List.length args) + if (FStarC_List.length formals) <> (FStarC_List.length args) then FStar_Pervasives_Native.None else (let uu___2 = let uu___3 = let uu___4 = FStarC_Extraction_ML_Syntax.ty_param_names formals in - FStarC_Compiler_List.zip uu___4 args in + FStarC_List.zip uu___4 args in subst_aux uu___3 t in FStar_Pervasives_Native.Some uu___2) let (subst : @@ -210,13 +207,12 @@ let (udelta_unfold : let uu___4 = FStarC_Extraction_ML_Syntax.string_of_mlpath n in let uu___5 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length args) in + FStarC_Util.string_of_int (FStarC_List.length args) in let uu___6 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length + FStarC_Util.string_of_int + (FStarC_List.length (FStar_Pervasives_Native.fst ts)) in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Substitution must be fully applied; got an application of %s with %s args whereas %s were expected (see GitHub issue #490)" uu___4 uu___5 uu___6 in failwith uu___3 @@ -244,7 +240,7 @@ let (eff_to_string : FStarC_Extraction_ML_Syntax.e_tag -> Prims.string) = | FStarC_Extraction_ML_Syntax.E_ERASABLE -> "Erasable" | FStarC_Extraction_ML_Syntax.E_IMPURE -> "Impure" let (join : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Extraction_ML_Syntax.e_tag -> FStarC_Extraction_ML_Syntax.e_tag -> FStarC_Extraction_ML_Syntax.e_tag) = @@ -275,27 +271,26 @@ let (join : FStarC_Extraction_ML_Syntax.E_PURE | uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_Range_Ops.string_of_range r in + let uu___2 = FStarC_Range_Ops.string_of_range r in let uu___3 = eff_to_string f in let uu___4 = eff_to_string f' in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Impossible (%s): Inconsistent effects %s and %s" uu___2 uu___3 uu___4 in failwith uu___1 let (join_l : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Extraction_ML_Syntax.e_tag Prims.list -> FStarC_Extraction_ML_Syntax.e_tag) = fun r -> fun fs -> - FStarC_Compiler_List.fold_left (join r) - FStarC_Extraction_ML_Syntax.E_PURE fs + FStarC_List.fold_left (join r) FStarC_Extraction_ML_Syntax.E_PURE fs let (mk_ty_fun : FStarC_Extraction_ML_Syntax.mlbinder Prims.list -> FStarC_Extraction_ML_Syntax.mlty -> FStarC_Extraction_ML_Syntax.mlty) = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___ -> fun t -> match uu___ with @@ -335,7 +330,7 @@ let rec (type_leq_c : match body.FStarC_Extraction_ML_Syntax.expr with | FStarC_Extraction_ML_Syntax.MLE_Fun (ys, body1) -> FStarC_Extraction_ML_Syntax.MLE_Fun - ((FStarC_Compiler_List.op_At xs ys), body1) + ((FStarC_List.op_At xs ys), body1) | uu___1 -> FStarC_Extraction_ML_Syntax.MLE_Fun (xs, body) in let uu___1 = @@ -410,8 +405,7 @@ let rec (type_leq_c : if path = path' then let uu___ = - FStarC_Compiler_List.forall2 (type_leq unfold_ty) args - args' in + FStarC_List.forall2 (type_leq unfold_ty) args args' in (if uu___ then (true, e) else (false, FStar_Pervasives_Native.None)) @@ -429,8 +423,7 @@ let rec (type_leq_c : type_leq_c unfold_ty e t t'1)) | (FStarC_Extraction_ML_Syntax.MLTY_Tuple ts, FStarC_Extraction_ML_Syntax.MLTY_Tuple ts') -> - let uu___ = - FStarC_Compiler_List.forall2 (type_leq unfold_ty) ts ts' in + let uu___ = FStarC_List.forall2 (type_leq unfold_ty) ts ts' in if uu___ then (true, e) else (false, FStar_Pervasives_Native.None) @@ -487,15 +480,13 @@ let (is_xtuple : match uu___ with | (ns, n) -> let uu___1 = - let uu___2 = - FStarC_Compiler_Util.concat_l "." - (FStarC_Compiler_List.op_At ns [n]) in + let uu___2 = FStarC_Util.concat_l "." (FStarC_List.op_At ns [n]) in FStarC_Parser_Const.is_tuple_datacon_string uu___2 in if uu___1 then let uu___2 = - let uu___3 = FStarC_Compiler_Util.char_at n (Prims.of_int (7)) in - FStarC_Compiler_Util.int_of_char uu___3 in + let uu___3 = FStarC_Util.char_at n (Prims.of_int (7)) in + FStarC_Util.int_of_char uu___3 in FStar_Pervasives_Native.Some uu___2 else FStar_Pervasives_Native.None let (resugar_exp : @@ -517,12 +508,10 @@ let (record_field_path : match uu___ with | f::uu___1 -> let uu___2 = - let uu___3 = FStarC_Ident.ns_of_lid f in - FStarC_Compiler_Util.prefix uu___3 in + let uu___3 = FStarC_Ident.ns_of_lid f in FStarC_Util.prefix uu___3 in (match uu___2 with | (ns, uu___3) -> - FStarC_Compiler_List.map - (fun id -> FStarC_Ident.string_of_id id) ns) + FStarC_List.map (fun id -> FStarC_Ident.string_of_id id) ns) | uu___1 -> failwith "impos" let record_fields : 'a . @@ -531,7 +520,7 @@ let record_fields : = fun fs -> fun vs -> - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun f -> fun e -> let uu___ = @@ -546,15 +535,13 @@ let (is_xtuple_ty : match uu___ with | (ns, n) -> let uu___1 = - let uu___2 = - FStarC_Compiler_Util.concat_l "." - (FStarC_Compiler_List.op_At ns [n]) in + let uu___2 = FStarC_Util.concat_l "." (FStarC_List.op_At ns [n]) in FStarC_Parser_Const.is_tuple_constructor_string uu___2 in if uu___1 then let uu___2 = - let uu___3 = FStarC_Compiler_Util.char_at n (Prims.of_int (5)) in - FStarC_Compiler_Util.int_of_char uu___3 in + let uu___3 = FStarC_Util.char_at n (Prims.of_int (5)) in + FStarC_Util.int_of_char uu___3 in FStar_Pervasives_Native.Some uu___2 else FStar_Pervasives_Native.None let (resugar_mlty : @@ -569,19 +556,18 @@ let (resugar_mlty : | uu___1 -> t) | uu___ -> t let (flatten_ns : Prims.string Prims.list -> Prims.string) = - fun ns -> FStarC_Compiler_String.concat "_" ns + fun ns -> FStarC_String.concat "_" ns let (flatten_mlpath : (Prims.string Prims.list * Prims.string) -> Prims.string) = fun uu___ -> match uu___ with - | (ns, n) -> - FStarC_Compiler_String.concat "_" (FStarC_Compiler_List.op_At ns [n]) + | (ns, n) -> FStarC_String.concat "_" (FStarC_List.op_At ns [n]) let (ml_module_name_of_lid : FStarC_Ident.lident -> Prims.string) = fun l -> let mlp = let uu___ = let uu___1 = FStarC_Ident.ns_of_lid l in - FStarC_Compiler_List.map FStarC_Ident.string_of_id uu___1 in + FStarC_List.map FStarC_Ident.string_of_id uu___1 in let uu___1 = let uu___2 = FStarC_Ident.ident_of_lid l in FStarC_Ident.string_of_id uu___2 in @@ -633,12 +619,11 @@ let rec (eraseTypeDeep : then FStarC_Extraction_ML_Syntax.MLTY_Erased else (let uu___2 = - let uu___3 = - FStarC_Compiler_List.map (eraseTypeDeep unfold_ty) lty in + let uu___3 = FStarC_List.map (eraseTypeDeep unfold_ty) lty in (uu___3, mlp) in FStarC_Extraction_ML_Syntax.MLTY_Named uu___2) | FStarC_Extraction_ML_Syntax.MLTY_Tuple lty -> - let uu___ = FStarC_Compiler_List.map (eraseTypeDeep unfold_ty) lty in + let uu___ = FStarC_List.map (eraseTypeDeep unfold_ty) lty in FStarC_Extraction_ML_Syntax.MLTY_Tuple uu___ | uu___ -> t let (prims_op_equality : FStarC_Extraction_ML_Syntax.mlexpr) = @@ -686,12 +671,12 @@ let (conjoin_opt : FStar_Pervasives_Native.Some x | (FStar_Pervasives_Native.Some x, FStar_Pervasives_Native.Some y) -> let uu___ = conjoin x y in FStar_Pervasives_Native.Some uu___ -let (mlloc_of_range : - FStarC_Compiler_Range_Type.range -> (Prims.int * Prims.string)) = +let (mlloc_of_range : FStarC_Range_Type.range -> (Prims.int * Prims.string)) + = fun r -> - let pos = FStarC_Compiler_Range_Ops.start_of_range r in - let line = FStarC_Compiler_Range_Ops.line_of_pos pos in - let uu___ = FStarC_Compiler_Range_Ops.file_of_range r in (line, uu___) + let pos = FStarC_Range_Ops.start_of_range r in + let line = FStarC_Range_Ops.line_of_pos pos in + let uu___ = FStarC_Range_Ops.file_of_range r in (line, uu___) let rec (doms_and_cod : FStarC_Extraction_ML_Syntax.mlty -> (FStarC_Extraction_ML_Syntax.mlty Prims.list * @@ -727,14 +712,15 @@ let (list_elements : let rec list_elements1 acc e1 = match e1.FStarC_Extraction_ML_Syntax.expr with | FStarC_Extraction_ML_Syntax.MLE_CTor - (("Prims"::[], "Cons"), hd::tl::[]) -> + (("Fstarcompiler.Prims"::[], "Cons"), hd::tl::[]) -> list_elements1 (hd :: acc) tl - | FStarC_Extraction_ML_Syntax.MLE_CTor (("Prims"::[], "Nil"), []) -> - FStar_Pervasives_Native.Some (FStarC_Compiler_List.rev acc) + | FStarC_Extraction_ML_Syntax.MLE_CTor + (("Fstarcompiler.Prims"::[], "Nil"), []) -> + FStar_Pervasives_Native.Some (FStarC_List.rev acc) | FStarC_Extraction_ML_Syntax.MLE_CTor (("Prims"::[], "Cons"), hd::tl::[]) -> list_elements1 (hd :: acc) tl | FStarC_Extraction_ML_Syntax.MLE_CTor (("Prims"::[], "Nil"), []) -> - FStar_Pervasives_Native.Some (FStarC_Compiler_List.rev acc) + FStar_Pervasives_Native.Some (FStarC_List.rev acc) | uu___ -> FStar_Pervasives_Native.None in list_elements1 [] e \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Find.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Find.ml similarity index 69% rename from stage0/fstar-lib/generated/FStarC_Find.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Find.ml index fbb39f07615..00c11156468 100644 --- a/stage0/fstar-lib/generated/FStarC_Find.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Find.ml @@ -1,6 +1,5 @@ open Prims -let (fstar_bin_directory : Prims.string) = - FStarC_Compiler_Util.get_exec_dir () +let (fstar_bin_directory : Prims.string) = FStarC_Util.get_exec_dir () let (read_fstar_include : Prims.string -> Prims.string Prims.list FStar_Pervasives_Native.option) = fun fn -> @@ -8,17 +7,18 @@ let (read_fstar_include : (fun uu___ -> match () with | () -> - let s = FStarC_Compiler_Util.file_get_contents fn in + let s = FStarC_Util.file_get_contents fn in let subdirs = - FStarC_Compiler_List.filter + let uu___1 = + FStarC_List.map FStarC_Util.trim_string + (FStarC_String.split [13; 10] s) in + FStarC_List.filter (fun s1 -> (s1 <> "") && - (let uu___1 = - let uu___2 = - FStarC_Compiler_String.get s1 Prims.int_zero in - uu___2 = 35 in - Prims.op_Negation uu___1)) - (FStarC_Compiler_String.split [10] s) in + (let uu___2 = + let uu___3 = FStarC_String.get s1 Prims.int_zero in + uu___3 = 35 in + Prims.op_Negation uu___2)) uu___1 in FStar_Pervasives_Native.Some subdirs) () with | uu___ -> @@ -27,50 +27,47 @@ let (read_fstar_include : let rec (expand_include_d : Prims.string -> Prims.string Prims.list) = fun dirname -> let dot_inc_path = Prims.strcat dirname "/fstar.include" in - if FStarC_Compiler_Util.file_exists dot_inc_path + if FStarC_Util.file_exists dot_inc_path then let subdirs = let uu___ = read_fstar_include dot_inc_path in FStar_Pervasives_Native.__proj__Some__item__v uu___ in let uu___ = - FStarC_Compiler_List.collect + FStarC_List.collect (fun subd -> expand_include_d (Prims.strcat dirname (Prims.strcat "/" subd))) subdirs in dirname :: uu___ else [dirname] let (expand_include_ds : Prims.string Prims.list -> Prims.string Prims.list) - = fun dirnames -> FStarC_Compiler_List.collect expand_include_d dirnames + = fun dirnames -> FStarC_List.collect expand_include_d dirnames let (lib_root : unit -> Prims.string FStar_Pervasives_Native.option) = fun uu___ -> let uu___1 = FStarC_Options.no_default_includes () in if uu___1 then FStar_Pervasives_Native.None else - (let uu___3 = - FStarC_Compiler_Util.expand_environment_variable "FSTAR_LIB" in + (let uu___3 = FStarC_Util.expand_environment_variable "FSTAR_LIB" in match uu___3 with | FStar_Pervasives_Native.Some s -> FStar_Pervasives_Native.Some s | FStar_Pervasives_Native.None -> - if - FStarC_Compiler_Util.file_exists - (Prims.strcat fstar_bin_directory "/../ulib") - then - FStar_Pervasives_Native.Some - (Prims.strcat fstar_bin_directory "/../ulib") - else - if - FStarC_Compiler_Util.file_exists - (Prims.strcat fstar_bin_directory "/../lib/fstar") - then - FStar_Pervasives_Native.Some - (Prims.strcat fstar_bin_directory "/../lib/fstar") - else FStar_Pervasives_Native.None) + FStar_Pervasives_Native.Some + (Prims.strcat fstar_bin_directory "/../lib/fstar")) +let (fstarc_paths : unit -> Prims.string Prims.list) = + fun uu___ -> + let uu___1 = FStarC_Options.with_fstarc () in + if uu___1 + then + expand_include_d + (Prims.strcat fstar_bin_directory "/../lib/fstar/fstarc") + else [] let (lib_paths : unit -> Prims.string Prims.list) = fun uu___ -> let uu___1 = - let uu___2 = lib_root () in FStarC_Common.option_to_list uu___2 in - expand_include_ds uu___1 + let uu___2 = + let uu___3 = lib_root () in FStarC_Common.option_to_list uu___3 in + expand_include_ds uu___2 in + let uu___2 = fstarc_paths () in FStarC_List.op_At uu___1 uu___2 let (include_path : unit -> Prims.string Prims.list) = fun uu___ -> let cache_dir = @@ -84,19 +81,19 @@ let (include_path : unit -> Prims.string Prims.list) = let uu___2 = lib_paths () in let uu___3 = let uu___4 = expand_include_d "." in - FStarC_Compiler_List.op_At include_paths uu___4 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At cache_dir uu___1 + FStarC_List.op_At include_paths uu___4 in + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At cache_dir uu___1 let (do_find : Prims.string Prims.list -> Prims.string -> Prims.string FStar_Pervasives_Native.option) = fun paths -> fun filename -> - let uu___ = FStarC_Compiler_Util.is_path_absolute filename in + let uu___ = FStarC_Util.is_path_absolute filename in if uu___ then - (if FStarC_Compiler_Util.file_exists filename + (if FStarC_Util.file_exists filename then FStar_Pervasives_Native.Some filename else FStar_Pervasives_Native.None) else @@ -104,35 +101,34 @@ let (do_find : (fun uu___2 -> match () with | () -> - FStarC_Compiler_Util.find_map - (FStarC_Compiler_List.rev paths) + FStarC_Util.find_map (FStarC_List.rev paths) (fun p -> let path = if p = "." then filename - else FStarC_Compiler_Util.join_paths p filename in - if FStarC_Compiler_Util.file_exists path + else FStarC_Util.join_paths p filename in + if FStarC_Util.file_exists path then FStar_Pervasives_Native.Some path else FStar_Pervasives_Native.None)) () with | uu___2 -> FStar_Pervasives_Native.None) let (find_file : Prims.string -> Prims.string FStar_Pervasives_Native.option) = - let cache = FStarC_Compiler_Util.smap_create (Prims.of_int (100)) in + let cache = FStarC_Util.smap_create (Prims.of_int (100)) in fun filename -> - let uu___ = FStarC_Compiler_Util.smap_try_find cache filename in + let uu___ = FStarC_Util.smap_try_find cache filename in match uu___ with | FStar_Pervasives_Native.Some f -> f | FStar_Pervasives_Native.None -> let result = let uu___1 = include_path () in do_find uu___1 filename in (if FStar_Pervasives_Native.uu___is_Some result - then FStarC_Compiler_Util.smap_add cache filename result + then FStarC_Util.smap_add cache filename result else (); result) let (find_file_odir : Prims.string -> Prims.string FStar_Pervasives_Native.option) = - let cache = FStarC_Compiler_Util.smap_create (Prims.of_int (100)) in + let cache = FStarC_Util.smap_create (Prims.of_int (100)) in fun filename -> - let uu___ = FStarC_Compiler_Util.smap_try_find cache filename in + let uu___ = FStarC_Util.smap_try_find cache filename in match uu___ with | FStar_Pervasives_Native.Some f -> f | FStar_Pervasives_Native.None -> @@ -143,11 +139,10 @@ let (find_file_odir : | FStar_Pervasives_Native.None -> [] in let result = let uu___1 = - let uu___2 = include_path () in - FStarC_Compiler_List.op_At uu___2 odir in + let uu___2 = include_path () in FStarC_List.op_At uu___2 odir in do_find uu___1 filename in (if FStar_Pervasives_Native.uu___is_Some result - then FStarC_Compiler_Util.smap_add cache filename result + then FStarC_Util.smap_add cache filename result else (); result) let (prepend_output_dir : Prims.string -> Prims.string) = @@ -155,31 +150,29 @@ let (prepend_output_dir : Prims.string -> Prims.string) = let uu___ = FStarC_Options.output_dir () in match uu___ with | FStar_Pervasives_Native.None -> fname - | FStar_Pervasives_Native.Some x -> - FStarC_Compiler_Util.join_paths x fname + | FStar_Pervasives_Native.Some x -> FStarC_Util.join_paths x fname let (prepend_cache_dir : Prims.string -> Prims.string) = fun fpath -> let uu___ = FStarC_Options.cache_dir () in match uu___ with | FStar_Pervasives_Native.None -> fpath | FStar_Pervasives_Native.Some x -> - let uu___1 = FStarC_Compiler_Util.basename fpath in - FStarC_Compiler_Util.join_paths x uu___1 + let uu___1 = FStarC_Util.basename fpath in + FStarC_Util.join_paths x uu___1 let (locate : unit -> Prims.string) = fun uu___ -> - let uu___1 = FStarC_Compiler_Util.get_exec_dir () in - FStarC_Compiler_Util.normalize_file_path uu___1 + let uu___1 = FStarC_Util.get_exec_dir () in + FStarC_Util.normalize_file_path uu___1 let (locate_lib : unit -> Prims.string FStar_Pervasives_Native.option) = fun uu___ -> let uu___1 = lib_root () in - FStarC_Compiler_Util.map_opt uu___1 - FStarC_Compiler_Util.normalize_file_path + FStarC_Util.map_opt uu___1 FStarC_Util.normalize_file_path let (locate_ocaml : unit -> Prims.string) = fun uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_Util.get_exec_dir () in + let uu___2 = FStarC_Util.get_exec_dir () in Prims.strcat uu___2 "/../lib" in - FStarC_Compiler_Util.normalize_file_path uu___1 + FStarC_Util.normalize_file_path uu___1 let (z3url : Prims.string) = "https://github.com/Z3Prover/z3/releases" let (packaged_z3_versions : Prims.string Prims.list) = ["4.8.5"; "4.13.3"] let (z3_install_suggestion : @@ -189,8 +182,7 @@ let (z3_install_suggestion : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_Util.format1 - "Please download version %s of Z3 from" v in + FStarC_Util.format1 "Please download version %s of Z3 from" v in FStarC_Errors_Msg.text uu___3 in let uu___3 = FStarC_Pprint.url z3url in FStarC_Pprint.prefix (Prims.of_int (4)) Prims.int_one uu___2 uu___3 in @@ -210,10 +202,10 @@ let (z3_install_suggestion : FStarC_Pprint.op_Hat_Slash_Hat uu___1 uu___2 in let uu___1 = let uu___2 = - if FStarC_Compiler_List.mem v packaged_z3_versions + if FStarC_List.mem v packaged_z3_versions then let uu___3 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Version %s of Z3 should be included in binary packages of F*. If you are using a binary package and are seeing\n this error, please file a bug report." v in FStarC_Errors_Msg.text uu___3 @@ -227,8 +219,8 @@ let (z3_inpath : Prims.string -> Prims.bool) = match () with | () -> let s = - FStarC_Compiler_Util.run_process "z3_pathtest" path - ["-version"] FStar_Pervasives_Native.None in + FStarC_Util.run_process "z3_pathtest" path ["-version"] + FStar_Pervasives_Native.None in s <> "") () with | uu___ -> false let (do_locate_z3 : @@ -257,10 +249,8 @@ let (do_locate_z3 : FStarC_Platform.exe (Prims.strcat root (Prims.strcat "/z3-" (Prims.strcat v "/bin/z3"))) in - let path2 = - FStarC_Compiler_Util.normalize_file_path path1 in - let uu___2 = - guard (FStarC_Compiler_Util.file_exists path2) in + let path2 = FStarC_Util.normalize_file_path path1 in + let uu___2 = guard (FStarC_Util.file_exists path2) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Class_Monad.monad_option () () uu___2 @@ -289,7 +279,7 @@ let (do_locate_z3 : (op_Less_Bar_Greater FStarC_Options.smt in_lib) (from_path (Prims.strcat "z3-" v))) (from_path "z3")) (fun uu___ -> FStar_Pervasives_Native.None) () in - (let uu___1 = FStarC_Compiler_Debug.any () in + (let uu___1 = FStarC_Debug.any () in if uu___1 then let uu___2 = @@ -298,17 +288,17 @@ let (do_locate_z3 : FStarC_Class_Show.show (FStarC_Class_Show.show_option FStarC_Class_Show.showable_string) path in - FStarC_Compiler_Util.print2 "do_locate_z3(%s) = %s\n" uu___2 uu___3 + FStarC_Util.print2 "do_locate_z3(%s) = %s\n" uu___2 uu___3 else ()); path let (locate_z3 : Prims.string -> Prims.string FStar_Pervasives_Native.option) = fun v -> - let cache = FStarC_Compiler_Util.smap_create (Prims.of_int (5)) in + let cache = FStarC_Util.smap_create (Prims.of_int (5)) in let find_or k f = - let uu___ = FStarC_Compiler_Util.smap_try_find cache k in + let uu___ = FStarC_Util.smap_try_find cache k in match uu___ with | FStar_Pervasives_Native.Some v1 -> v1 | FStar_Pervasives_Native.None -> - let v1 = f k in (FStarC_Compiler_Util.smap_add cache k v1; v1) in + let v1 = f k in (FStarC_Util.smap_add cache k v1; v1) in find_or v do_locate_z3 \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_FlatSet.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_FlatSet.ml similarity index 87% rename from stage0/fstar-lib/generated/FStarC_Compiler_FlatSet.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_FlatSet.ml index 7827801c39e..4939fda019a 100644 --- a/stage0/fstar-lib/generated/FStarC_Compiler_FlatSet.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_FlatSet.ml @@ -22,7 +22,7 @@ let mem : 'a . 'a FStarC_Class_Ord.ord -> 'a -> 'a flat_set -> Prims.bool = fun uu___ -> fun x -> fun s -> - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun y -> FStarC_Class_Deq.op_Equals_Question (FStarC_Class_Ord.ord_eq uu___) x y) s @@ -31,9 +31,7 @@ let singleton : 'a . 'a FStarC_Class_Ord.ord -> 'a -> 'a flat_set = let is_empty : 'a . 'a flat_set -> Prims.bool = fun s -> Prims.uu___is_Nil s let addn : 'a . 'a FStarC_Class_Ord.ord -> 'a Prims.list -> 'a flat_set -> 'a flat_set - = - fun uu___ -> - fun xs -> fun ys -> FStarC_Compiler_List.fold_right (add uu___) xs ys + = fun uu___ -> fun xs -> fun ys -> FStarC_List.fold_right (add uu___) xs ys let rec remove : 'a . 'a FStarC_Class_Ord.ord -> 'a -> 'a flat_set -> 'a flat_set = fun uu___ -> @@ -50,11 +48,9 @@ let rec remove : else (let uu___3 = remove uu___ x yy in y :: uu___3) let elems : 'a . 'a flat_set -> 'a Prims.list = fun s -> s let for_all : 'a . ('a -> Prims.bool) -> 'a flat_set -> Prims.bool = - fun p -> - fun s -> let uu___ = elems s in FStarC_Compiler_List.for_all p uu___ + fun p -> fun s -> let uu___ = elems s in FStarC_List.for_all p uu___ let for_any : 'a . ('a -> Prims.bool) -> 'a flat_set -> Prims.bool = - fun p -> - fun s -> let uu___ = elems s in FStarC_Compiler_List.existsb p uu___ + fun p -> fun s -> let uu___ = elems s in FStarC_List.existsb p uu___ let subset : 'a . 'a FStarC_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> Prims.bool = fun uu___ -> fun s1 -> fun s2 -> for_all (fun y -> mem uu___ y s2) s1 @@ -72,20 +68,17 @@ let union : 'a . 'a FStarC_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = fun uu___ -> fun s1 -> - fun s2 -> - FStarC_Compiler_List.fold_left (fun s -> fun x -> add uu___ x s) s1 - s2 + fun s2 -> FStarC_List.fold_left (fun s -> fun x -> add uu___ x s) s1 s2 let inter : 'a . 'a FStarC_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = fun uu___ -> - fun s1 -> - fun s2 -> FStarC_Compiler_List.filter (fun y -> mem uu___ y s2) s1 + fun s1 -> fun s2 -> FStarC_List.filter (fun y -> mem uu___ y s2) s1 let diff : 'a . 'a FStarC_Class_Ord.ord -> 'a flat_set -> 'a flat_set -> 'a flat_set = fun uu___ -> fun s1 -> fun s2 -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun y -> let uu___1 = mem uu___ y s2 in Prims.op_Negation uu___1) s1 let collect : @@ -97,7 +90,7 @@ let collect : fun f -> fun l -> let uu___1 = empty () in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun x -> fun acc -> let uu___2 = f x in union uu___ uu___2 acc) l uu___1 let showable_set : @@ -134,7 +127,7 @@ let setlike_flat_set : FStarC_Class_Setlike.for_all = for_all; FStarC_Class_Setlike.for_any = for_any; FStarC_Class_Setlike.elems = elems; - FStarC_Class_Setlike.filter = FStarC_Compiler_List.filter; + FStarC_Class_Setlike.filter = FStarC_List.filter; FStarC_Class_Setlike.collect = (collect uu___); FStarC_Class_Setlike.from_list = (from_list uu___); FStarC_Class_Setlike.addn = (addn uu___) diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_GenSym.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_GenSym.ml new file mode 100644 index 00000000000..f38f6f3ca7a --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_GenSym.ml @@ -0,0 +1,19 @@ +open Prims +let (gensym_st : Prims.int FStarC_Effect.ref) = + FStarC_Util.mk_ref Prims.int_zero +let (next_id : unit -> Prims.int) = + fun uu___ -> + let r = FStarC_Effect.op_Bang gensym_st in + FStarC_Effect.op_Colon_Equals gensym_st (r + Prims.int_one); r +let (reset_gensym : unit -> unit) = + fun uu___ -> FStarC_Effect.op_Colon_Equals gensym_st Prims.int_zero +let with_frozen_gensym : 'a . (unit -> 'a) -> 'a = + fun f -> + let v = FStarC_Effect.op_Bang gensym_st in + let r = + try (fun uu___ -> match () with | () -> f ()) () + with + | uu___ -> + (FStarC_Effect.op_Colon_Equals gensym_st v; + FStarC_Effect.raise uu___) in + FStarC_Effect.op_Colon_Equals gensym_st v; r \ No newline at end of file diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_Hooks.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Hooks.ml new file mode 100644 index 00000000000..1a093da8128 --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Hooks.ml @@ -0,0 +1,74 @@ +open Prims +let (lazy_chooser : + FStarC_Syntax_Syntax.lazy_kind -> + FStarC_Syntax_Syntax.lazyinfo -> FStarC_Syntax_Syntax.term) + = + fun k -> + fun i -> + match k with + | FStarC_Syntax_Syntax.BadLazy -> + failwith "lazy chooser: got a BadLazy" + | FStarC_Syntax_Syntax.Lazy_bv -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_bv i + | FStarC_Syntax_Syntax.Lazy_namedv -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_namedv i + | FStarC_Syntax_Syntax.Lazy_binder -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_binder i + | FStarC_Syntax_Syntax.Lazy_letbinding -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_letbinding i + | FStarC_Syntax_Syntax.Lazy_optionstate -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_optionstate i + | FStarC_Syntax_Syntax.Lazy_fvar -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_fvar i + | FStarC_Syntax_Syntax.Lazy_comp -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_comp i + | FStarC_Syntax_Syntax.Lazy_env -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_env i + | FStarC_Syntax_Syntax.Lazy_sigelt -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_sigelt i + | FStarC_Syntax_Syntax.Lazy_universe -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_universe i + | FStarC_Syntax_Syntax.Lazy_proofstate -> + FStarC_Tactics_Embedding.unfold_lazy_proofstate i + | FStarC_Syntax_Syntax.Lazy_goal -> + FStarC_Tactics_Embedding.unfold_lazy_goal i + | FStarC_Syntax_Syntax.Lazy_doc -> + FStarC_Reflection_V2_Embeddings.unfold_lazy_doc i + | FStarC_Syntax_Syntax.Lazy_uvar -> + FStarC_Syntax_Util.exp_string "((uvar))" + | FStarC_Syntax_Syntax.Lazy_universe_uvar -> + FStarC_Syntax_Util.exp_string "((universe_uvar))" + | FStarC_Syntax_Syntax.Lazy_issue -> + FStarC_Syntax_Util.exp_string "((issue))" + | FStarC_Syntax_Syntax.Lazy_ident -> + FStarC_Syntax_Util.exp_string "((ident))" + | FStarC_Syntax_Syntax.Lazy_tref -> + FStarC_Syntax_Util.exp_string "((tref))" + | FStarC_Syntax_Syntax.Lazy_embedding (uu___, t) -> + FStarC_Thunk.force t + | FStarC_Syntax_Syntax.Lazy_extension s -> + let uu___ = FStarC_Util.format1 "((extension %s))" s in + FStarC_Syntax_Util.exp_string uu___ +let (setup_hooks : unit -> unit) = + fun uu___ -> + FStarC_Effect.op_Colon_Equals + FStarC_Syntax_DsEnv.ugly_sigelt_to_string_hook + (FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt); + FStarC_Errors.set_parse_warn_error FStarC_Parser_ParseIt.parse_warn_error; + FStarC_Effect.op_Colon_Equals FStarC_Syntax_Syntax.lazy_chooser + (FStar_Pervasives_Native.Some lazy_chooser); + FStarC_Effect.op_Colon_Equals FStarC_Syntax_Util.tts_f + (FStar_Pervasives_Native.Some + (FStarC_Class_Show.show FStarC_Syntax_Print.showable_term)); + FStarC_Effect.op_Colon_Equals FStarC_Syntax_Util.ttd_f + (FStar_Pervasives_Native.Some + (FStarC_Class_PP.pp FStarC_Syntax_Print.pretty_term)); + FStarC_Effect.op_Colon_Equals + FStarC_TypeChecker_Normalize.unembed_binder_knot + (FStar_Pervasives_Native.Some FStarC_Reflection_V2_Embeddings.e_binder); + FStarC_List.iter + FStarC_Tactics_Interpreter.register_tactic_primitive_step + FStarC_Tactics_V1_Primops.ops; + FStarC_List.iter + FStarC_Tactics_Interpreter.register_tactic_primitive_step + FStarC_Tactics_V2_Primops.ops \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Ident.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Ident.ml similarity index 75% rename from stage0/fstar-lib/generated/FStarC_Ident.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Ident.ml index fb08fc9782c..a36bee2808c 100644 --- a/stage0/fstar-lib/generated/FStarC_Ident.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Ident.ml @@ -1,12 +1,10 @@ open Prims -type ident = - { +type ident = { idText: Prims.string ; - idRange: FStarC_Compiler_Range_Type.range }[@@deriving yojson,show] + idRange: FStarC_Range_Type.range }[@@deriving yojson,show] let (__proj__Mkident__item__idText : ident -> Prims.string) = fun projectee -> match projectee with | { idText; idRange;_} -> idText -let (__proj__Mkident__item__idRange : - ident -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mkident__item__idRange : ident -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { idText; idRange;_} -> idRange type path = Prims.string Prims.list[@@deriving yojson,show] type ipath = ident Prims.list[@@deriving yojson,show] @@ -28,44 +26,40 @@ let (__proj__Mklident__item__nsstr : lident -> Prims.string) = let (__proj__Mklident__item__str : lident -> Prims.string) = fun projectee -> match projectee with | { ns; ident = ident1; nsstr; str;_} -> str -let (mk_ident : (Prims.string * FStarC_Compiler_Range_Type.range) -> ident) = +let (mk_ident : (Prims.string * FStarC_Range_Type.range) -> ident) = fun uu___ -> match uu___ with | (text, range) -> { idText = text; idRange = range } -let (set_id_range : FStarC_Compiler_Range_Type.range -> ident -> ident) = +let (set_id_range : FStarC_Range_Type.range -> ident -> ident) = fun r -> fun i -> { idText = (i.idText); idRange = r } let (reserved_prefix : Prims.string) = "uu___" -let (gen' : Prims.string -> FStarC_Compiler_Range_Type.range -> ident) = +let (gen' : Prims.string -> FStarC_Range_Type.range -> ident) = fun s -> fun r -> let i = FStarC_GenSym.next_id () in mk_ident ((Prims.strcat s (Prims.string_of_int i)), r) -let (gen : FStarC_Compiler_Range_Type.range -> ident) = +let (gen : FStarC_Range_Type.range -> ident) = fun r -> gen' reserved_prefix r let (ident_of_lid : lident -> ident) = fun l -> l.ident -let (range_of_id : ident -> FStarC_Compiler_Range_Type.range) = - fun id -> id.idRange +let (range_of_id : ident -> FStarC_Range_Type.range) = fun id -> id.idRange let (id_of_text : Prims.string -> ident) = - fun str -> mk_ident (str, FStarC_Compiler_Range_Type.dummyRange) + fun str -> mk_ident (str, FStarC_Range_Type.dummyRange) let (string_of_id : ident -> Prims.string) = fun id -> id.idText let (text_of_path : path -> Prims.string) = - fun path1 -> FStarC_Compiler_Util.concat_l "." path1 + fun path1 -> FStarC_Util.concat_l "." path1 let (path_of_text : Prims.string -> path) = - fun text -> FStar_String.split [46] text -let (path_of_ns : ipath -> path) = - fun ns -> FStarC_Compiler_List.map string_of_id ns + fun text -> FStarC_String.split [46] text +let (path_of_ns : ipath -> path) = fun ns -> FStarC_List.map string_of_id ns let (path_of_lid : lident -> path) = fun lid -> - FStarC_Compiler_List.map string_of_id - (FStarC_Compiler_List.op_At lid.ns [lid.ident]) + FStarC_List.map string_of_id (FStarC_List.op_At lid.ns [lid.ident]) let (ns_of_lid : lident -> ipath) = fun lid -> lid.ns let (ids_of_lid : lident -> ipath) = - fun lid -> FStarC_Compiler_List.op_At lid.ns [lid.ident] + fun lid -> FStarC_List.op_At lid.ns [lid.ident] let (lid_of_ns_and_id : ipath -> ident -> lident) = fun ns -> fun id -> let nsstr = - let uu___ = FStarC_Compiler_List.map string_of_id ns in - text_of_path uu___ in + let uu___ = FStarC_List.map string_of_id ns in text_of_path uu___ in { ns; ident = id; @@ -77,18 +71,16 @@ let (lid_of_ns_and_id : ipath -> ident -> lident) = } let (lid_of_ids : ipath -> lident) = fun ids -> - let uu___ = FStarC_Compiler_Util.prefix ids in + let uu___ = FStarC_Util.prefix ids in match uu___ with | (ns, id) -> lid_of_ns_and_id ns id let (lid_of_str : Prims.string -> lident) = fun str -> - let uu___ = - FStarC_Compiler_List.map id_of_text - (FStarC_Compiler_Util.split str ".") in + let uu___ = FStarC_List.map id_of_text (FStarC_Util.split str ".") in lid_of_ids uu___ -let (lid_of_path : path -> FStarC_Compiler_Range_Type.range -> lident) = +let (lid_of_path : path -> FStarC_Range_Type.range -> lident) = fun path1 -> fun pos -> - let ids = FStarC_Compiler_List.map (fun s -> mk_ident (s, pos)) path1 in + let ids = FStarC_List.map (fun s -> mk_ident (s, pos)) path1 in lid_of_ids ids let (text_of_lid : lident -> Prims.string) = fun lid -> lid.str let (lid_equals : lident -> lident -> Prims.bool) = @@ -96,9 +88,9 @@ let (lid_equals : lident -> lident -> Prims.bool) = let (ident_equals : ident -> ident -> Prims.bool) = fun id1 -> fun id2 -> id1.idText = id2.idText type lid = lident[@@deriving yojson,show] -let (range_of_lid : lident -> FStarC_Compiler_Range_Type.range) = +let (range_of_lid : lident -> FStarC_Range_Type.range) = fun lid1 -> range_of_id lid1.ident -let (set_lid_range : lident -> FStarC_Compiler_Range_Type.range -> lident) = +let (set_lid_range : lident -> FStarC_Range_Type.range -> lident) = fun l -> fun r -> { @@ -113,20 +105,19 @@ let (lid_add_suffix : lident -> Prims.string -> lident) = fun s -> let path1 = path_of_lid l in let uu___ = range_of_lid l in - lid_of_path (FStarC_Compiler_List.op_At path1 [s]) uu___ + lid_of_path (FStarC_List.op_At path1 [s]) uu___ let (ml_path_of_lid : lident -> Prims.string) = fun lid1 -> let uu___ = let uu___1 = path_of_ns lid1.ns in let uu___2 = let uu___3 = string_of_id lid1.ident in [uu___3] in - FStarC_Compiler_List.op_At uu___1 uu___2 in - FStar_String.concat "_" uu___ + FStarC_List.op_At uu___1 uu___2 in + FStarC_String.concat "_" uu___ let (string_of_lid : lident -> Prims.string) = fun lid1 -> lid1.str let (qual_id : lident -> ident -> lident) = fun lid1 -> fun id -> - let uu___ = - lid_of_ids (FStarC_Compiler_List.op_At lid1.ns [lid1.ident; id]) in + let uu___ = lid_of_ids (FStarC_List.op_At lid1.ns [lid1.ident; id]) in let uu___1 = range_of_id id in set_lid_range uu___ uu___1 let (nsstr : lident -> Prims.string) = fun l -> l.nsstr let (showable_ident : ident FStarC_Class_Show.showable) = diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_CompletionTable.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_CompletionTable.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Interactive_CompletionTable.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_CompletionTable.ml index 4195850c42c..6b341bd0fe8 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_CompletionTable.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_CompletionTable.ml @@ -1,6 +1,6 @@ open Prims let (string_compare : Prims.string -> Prims.string -> Prims.int) = - fun s1 -> fun s2 -> FStarC_Compiler_String.compare s1 s2 + fun s1 -> fun s2 -> FStarC_String.compare s1 s2 type 'a heap = | EmptyHeap | Heap of ('a * 'a heap Prims.list) @@ -64,8 +64,7 @@ let heap_from_list : ('uuuuu -> 'uuuuu -> Prims.int) -> 'uuuuu Prims.list -> 'uuuuu heap = fun cmp -> - fun values -> - FStarC_Compiler_List.fold_left (heap_insert cmp) EmptyHeap values + fun values -> FStarC_List.fold_left (heap_insert cmp) EmptyHeap values let push_nodup : 'uuuuu . ('uuuuu -> Prims.string) -> @@ -119,10 +118,10 @@ let merge_increasing_lists_rev : | FStar_Pervasives_Native.Some ((pr, v::tl), lists2) -> let uu___1 = heap_insert cmp lists2 (pr, tl) in let uu___2 = push_nodup key_fn v acc in aux uu___1 uu___2 in - let lists1 = FStarC_Compiler_List.filter (fun x -> x <> []) lists in + let lists1 = FStarC_List.filter (fun x -> x <> []) lists in match lists1 with | [] -> [] - | l::[] -> FStarC_Compiler_List.rev l + | l::[] -> FStarC_List.rev l | uu___ -> let lists2 = add_priorities Prims.int_zero [] lists1 in let uu___1 = heap_from_list cmp lists2 in aux uu___1 [] @@ -304,7 +303,7 @@ let btree_find_prefix : | StrEmpty -> acc | StrBranch (k, v, lbt, rbt) -> let cmp = string_compare k prefix1 in - let include_middle = FStarC_Compiler_Util.starts_with k prefix1 in + let include_middle = FStarC_Util.starts_with k prefix1 in let explore_right = (cmp <= Prims.int_zero) || include_middle in let explore_left = cmp > Prims.int_zero in let matches = if explore_right then aux rbt prefix1 acc else acc in @@ -332,7 +331,7 @@ let rec btree_fold : let uu___ = let uu___1 = btree_fold rbt f acc in f k v uu___1 in btree_fold lbt f uu___ let (query_to_string : Prims.string Prims.list -> Prims.string) = - fun q -> FStarC_Compiler_String.concat "." q + fun q -> FStarC_String.concat "." q type 'a name_collection = | Names of 'a btree | ImportedNames of (Prims.string * 'a name_collection Prims.list) @@ -385,7 +384,7 @@ let rec trie_descend_exact : | [] -> FStar_Pervasives_Native.Some tr | ns::query2 -> let uu___ = names_find_exact tr.namespaces ns in - FStarC_Compiler_Util.bind_opt uu___ + FStarC_Util.bind_opt uu___ (fun scope -> trie_descend_exact scope query2) let rec trie_find_exact : 'a . 'a trie -> query -> 'a FStar_Pervasives_Native.option = @@ -396,7 +395,7 @@ let rec trie_find_exact : | name::[] -> names_find_exact tr.bindings name | ns::query2 -> let uu___ = names_find_exact tr.namespaces ns in - FStarC_Compiler_Util.bind_opt uu___ + FStarC_Util.bind_opt uu___ (fun scope -> trie_find_exact scope query2) let names_insert : 'a . 'a names -> Prims.string -> 'a -> 'a names = fun name_collections -> @@ -429,7 +428,7 @@ let rec namespaces_mutate : fun mut_leaf -> let trie1 = let uu___ = names_find_exact namespaces ns in - FStarC_Compiler_Util.dflt (trie_empty ()) uu___ in + FStarC_Util.dflt (trie_empty ()) uu___ in let uu___ = trie_mutate trie1 q rev_acc mut_node mut_leaf in names_insert namespaces ns uu___ and trie_mutate : @@ -486,7 +485,7 @@ let trie_import : let label = query_to_string included_query in let included_trie = let uu___ = trie_descend_exact tr included_query in - FStarC_Compiler_Util.dflt (trie_empty ()) uu___ in + FStarC_Util.dflt (trie_empty ()) uu___ in trie_mutate_leaf tr host_query (fun tr1 -> fun uu___ -> mutator tr1 included_trie label) let trie_include : 'a . 'a trie -> query -> query -> 'a trie = @@ -540,7 +539,7 @@ let names_revmap : fun fn -> fun name_collections -> let rec aux acc imports name_collections1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc1 -> fun uu___ -> match uu___ with @@ -589,11 +588,11 @@ let names_find_rev : | NSTPrefix id1 -> names_revmap (fun bt -> btree_find_prefix bt id1) names1 in let matching_values_per_collection = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (imports, matches) -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (segment, v) -> ((mk_path_el imports segment), v)) @@ -622,7 +621,7 @@ let rec trie_find_prefix' : let matching_namespaces_rev = names_find_rev tr.namespaces ns_search_term in let acc_with_recursive_bindings = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc1 -> fun uu___1 -> match uu___1 with @@ -631,11 +630,11 @@ let rec trie_find_prefix' : query2 acc1) acc matching_namespaces_rev in let matching_bindings_rev = names_find_rev tr.bindings bindings_search_term in - FStarC_Compiler_List.rev_map_onto + FStarC_List.rev_map_onto (fun uu___1 -> match uu___1 with | (path_el, v) -> - ((FStarC_Compiler_List.rev (path_el :: path_acc)), v)) + ((FStarC_List.rev (path_el :: path_acc)), v)) matching_bindings_rev acc_with_recursive_bindings let trie_find_prefix : 'a . 'a trie -> query -> (path * 'a) Prims.list = fun tr -> fun query1 -> trie_find_prefix' tr [] query1 [] @@ -732,8 +731,7 @@ let (register_module_path : mod_loaded = loaded1 }) in let name_of_revq query1 = - FStarC_Compiler_String.concat "." - (FStarC_Compiler_List.rev query1) in + FStarC_String.concat "." (FStarC_List.rev query1) in let ins id q revq bindings loaded1 = let name = name_of_revq (id :: revq) in match q with @@ -752,13 +750,12 @@ let (register_module_path : { tbl_lids = (tbl.tbl_lids); tbl_mods = uu___ } let (string_of_path : path -> Prims.string) = fun path1 -> - let uu___ = - FStarC_Compiler_List.map (fun el -> (el.segment).completion) path1 in - FStarC_Compiler_String.concat "." uu___ + let uu___ = FStarC_List.map (fun el -> (el.segment).completion) path1 in + FStarC_String.concat "." uu___ let (match_length_of_path : path -> Prims.int) = fun path1 -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun elem -> let uu___1 = acc in @@ -767,8 +764,7 @@ let (match_length_of_path : path -> Prims.int) = (match (elem.segment).prefix with | FStar_Pervasives_Native.Some prefix -> let completion_len = - FStarC_Compiler_String.length - (elem.segment).completion in + FStarC_String.length (elem.segment).completion in (((acc_len + Prims.int_one) + completion_len), (prefix, completion_len)) | FStar_Pervasives_Native.None -> acc)) @@ -776,14 +772,13 @@ let (match_length_of_path : path -> Prims.int) = match uu___ with | (length, (last_prefix, last_completion_length)) -> ((length - Prims.int_one) - last_completion_length) + - (FStarC_Compiler_String.length last_prefix) + (FStarC_String.length last_prefix) let (first_import_of_path : path -> Prims.string FStar_Pervasives_Native.option) = fun path1 -> match path1 with | [] -> FStar_Pervasives_Native.None - | { imports; segment = uu___;_}::uu___1 -> - FStarC_Compiler_List.last_opt imports + | { imports; segment = uu___;_}::uu___1 -> FStarC_List.last_opt imports let (alist_of_ns_info : ns_info -> (Prims.string * FStarC_Json.json) Prims.list) = fun ns_info1 -> @@ -833,7 +828,7 @@ let completion_result_of_lid : 'uuuuu . (path * 'uuuuu) -> completion_result let uu___2 = string_of_path path1 in let uu___3 = let uu___4 = first_import_of_path path1 in - FStarC_Compiler_Util.dflt "" uu___4 in + FStarC_Util.dflt "" uu___4 in { completion_match_length = uu___1; completion_candidate = uu___2; @@ -847,8 +842,7 @@ let (completion_result_of_mod : let uu___ = match_length_of_path path1 in let uu___1 = string_of_path path1 in let uu___2 = - FStarC_Compiler_Util.format1 (if loaded then " %s " else "(%s)") - annot in + FStarC_Util.format1 (if loaded then " %s " else "(%s)") annot in { completion_match_length = uu___; completion_candidate = uu___1; @@ -872,7 +866,7 @@ let (autocomplete_lid : table -> query -> completion_result Prims.list) = fun tbl -> fun query1 -> let uu___ = trie_find_prefix tbl.tbl_lids query1 in - FStarC_Compiler_List.map completion_result_of_lid uu___ + FStarC_List.map completion_result_of_lid uu___ let (autocomplete_mod_or_ns : table -> query -> @@ -885,5 +879,5 @@ let (autocomplete_mod_or_ns : fun filter -> let uu___ = let uu___1 = trie_find_prefix tbl.tbl_mods query1 in - FStarC_Compiler_List.filter_map filter uu___1 in - FStarC_Compiler_List.map completion_result_of_ns_or_mod uu___ \ No newline at end of file + FStarC_List.filter_map filter uu___1 in + FStarC_List.map completion_result_of_ns_or_mod uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_Ide.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Ide.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_Interactive_Ide.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Ide.ml index 8e6ec72de76..fd7b84a723c 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_Ide.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Ide.ml @@ -1,10 +1,11 @@ open Prims -let (dbg : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "IDE" +let (dbg : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "IDE" +let (json_of_issue : FStarC_Errors.issue -> FStarC_Json.json) = + FStarC_Interactive_Ide_Types.json_of_issue let with_captured_errors' : 'uuuuu . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Util.sigint_handler -> + FStarC_Util.sigint_handler -> (FStarC_TypeChecker_Env.env -> 'uuuuu FStar_Pervasives_Native.option) -> 'uuuuu FStar_Pervasives_Native.option = @@ -15,10 +16,10 @@ let with_captured_errors' : (fun uu___ -> match () with | () -> - FStarC_Compiler_Util.with_sigint_handler sigint_handler + FStarC_Util.with_sigint_handler sigint_handler (fun uu___1 -> f env)) () with - | FStarC_Compiler_Effect.Failure msg -> + | FStarC_Effect.Failure msg -> let msg1 = Prims.strcat "ASSERTION FAILURE: " (Prims.strcat msg @@ -28,8 +29,8 @@ let with_captured_errors' : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic msg1); FStar_Pervasives_Native.None) - | FStarC_Compiler_Util.SigInt -> - (FStarC_Compiler_Util.print_string "Interrupted"; + | FStarC_Util.SigInt -> + (FStarC_Util.print_string "Interrupted"; FStar_Pervasives_Native.None) | FStarC_Errors.Error (e, msg, r, ctx) -> (FStarC_TypeChecker_Err.add_errors env [(e, msg, r, ctx)]; @@ -38,7 +39,7 @@ let with_captured_errors' : let with_captured_errors : 'uuuuu . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Util.sigint_handler -> + FStarC_Util.sigint_handler -> (FStarC_TypeChecker_Env.env -> 'uuuuu FStar_Pervasives_Native.option) -> 'uuuuu FStar_Pervasives_Native.option = @@ -49,19 +50,17 @@ let with_captured_errors : if uu___ then f env else with_captured_errors' env sigint_handler f type env_t = FStarC_TypeChecker_Env.env let (repl_current_qid : - Prims.string FStar_Pervasives_Native.option FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + Prims.string FStar_Pervasives_Native.option FStarC_Effect.ref) = + FStarC_Util.mk_ref FStar_Pervasives_Native.None let (nothing_left_to_pop : FStarC_Interactive_Ide_Types.repl_state -> Prims.bool) = fun st -> let uu___ = let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_Interactive_PushHelper.repl_stack in - FStarC_Compiler_List.length uu___1 in + FStarC_Effect.op_Bang FStarC_Interactive_PushHelper.repl_stack in + FStarC_List.length uu___1 in uu___ = - (FStarC_Compiler_List.length - st.FStarC_Interactive_Ide_Types.repl_deps_stack) + (FStarC_List.length st.FStarC_Interactive_Ide_Types.repl_deps_stack) let (run_repl_transaction : FStarC_Interactive_Ide_Types.repl_state -> FStarC_Interactive_Ide_Types.push_kind FStar_Pervasives_Native.option -> @@ -87,7 +86,7 @@ let (run_repl_transaction : (Prims.op_Negation must_rollback) in let uu___1 = let uu___2 = - with_captured_errors env FStarC_Compiler_Util.sigint_raise + with_captured_errors env FStarC_Util.sigint_raise (fun env1 -> let uu___3 = FStarC_Interactive_PushHelper.run_repl_task @@ -130,8 +129,7 @@ let (run_repl_transaction : = (st1.FStarC_Interactive_Ide_Types.repl_buffered_input_queries); FStarC_Interactive_Ide_Types.repl_lang = - (FStarC_Compiler_List.op_At - (FStarC_Compiler_List.rev lds) + (FStarC_List.op_At (FStarC_List.rev lds) st1.FStarC_Interactive_Ide_Types.repl_lang) } in FStarC_Interactive_PushHelper.commit_name_tracking @@ -151,12 +149,12 @@ let (run_repl_ld_transactions : fun tasks -> fun progress_callback -> let debug verb task = - let uu___ = FStarC_Compiler_Effect.op_Bang dbg in + let uu___ = FStarC_Effect.op_Bang dbg in if uu___ then let uu___1 = FStarC_Interactive_Ide_Types.string_of_repl_task task in - FStarC_Compiler_Util.print2 "%s %s" verb uu___1 + FStarC_Util.print2 "%s %s" verb uu___1 else () in let rec revert_many st1 uu___ = match uu___ with @@ -221,7 +219,7 @@ let (run_repl_ld_transactions : then let uu___4 = let uu___5 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang FStarC_Interactive_PushHelper.repl_stack in { FStarC_Interactive_Ide_Types.repl_line = @@ -257,8 +255,7 @@ let (run_repl_ld_transactions : | (tasks2, previous1) -> let uu___ = revert_many st1 previous1 in aux uu___ tasks2 [] in aux st tasks - (FStarC_Compiler_List.rev - st.FStarC_Interactive_Ide_Types.repl_deps_stack) + (FStarC_List.rev st.FStarC_Interactive_Ide_Types.repl_deps_stack) let (wrap_js_failure : Prims.string -> Prims.string -> FStarC_Json.json -> FStarC_Interactive_Ide_Types.query) @@ -269,8 +266,8 @@ let (wrap_js_failure : let uu___ = let uu___1 = let uu___2 = FStarC_Interactive_JsonHelper.json_debug got in - FStarC_Compiler_Util.format2 - "JSON decoding failed: expected %s, got %s" expected uu___2 in + FStarC_Util.format2 "JSON decoding failed: expected %s, got %s" + expected uu___2 in FStarC_Interactive_Ide_Types.ProtocolViolation uu___1 in { FStarC_Interactive_Ide_Types.qq = uu___; @@ -286,10 +283,9 @@ let (unpack_interactive_query : | FStar_Pervasives_Native.None -> let uu___1 = let uu___2 = - FStarC_Compiler_Util.format2 "Missing key [%s] in %s." key - errloc in + FStarC_Util.format2 "Missing key [%s] in %s." key errloc in FStarC_Interactive_JsonHelper.InvalidQuery uu___2 in - FStarC_Compiler_Effect.raise uu___1 in + FStarC_Effect.raise uu___1 in let request = FStarC_Interactive_JsonHelper.js_assoc json in let qid = let uu___ = assoc "query" "query-id" request in @@ -346,7 +342,7 @@ let (unpack_interactive_query : let uu___1 = read_to_position () in FStarC_Interactive_Ide_Types.LaxToPosition uu___1 | uu___1 -> - FStarC_Compiler_Effect.raise + FStarC_Effect.raise (FStarC_Interactive_JsonHelper.InvalidQuery "Invalid full-buffer kind") in let uu___1 = @@ -456,10 +452,10 @@ let (unpack_interactive_query : let uu___5 = let uu___6 = let uu___7 = try_arg "location" in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option FStarC_Interactive_JsonHelper.js_assoc uu___7 in - FStarC_Compiler_Util.map_option - (read_position "[location]") uu___6 in + FStarC_Util.map_option (read_position "[location]") + uu___6 in let uu___6 = let uu___7 = arg "requested-info" in FStarC_Interactive_JsonHelper.js_list @@ -474,7 +470,7 @@ let (unpack_interactive_query : FStarC_Interactive_JsonHelper.js_str uu___4 in let uu___4 = let uu___5 = try_arg "rules" in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (FStarC_Interactive_JsonHelper.js_list FStarC_Interactive_Ide_Types.js_reductionrule) uu___5 in @@ -489,7 +485,7 @@ let (unpack_interactive_query : let uu___2 = let uu___3 = let uu___4 = try_arg "filename" in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option FStarC_Interactive_JsonHelper.js_str uu___4 in let uu___4 = let uu___5 = arg "contents" in @@ -517,7 +513,7 @@ let (unpack_interactive_query : FStarC_Interactive_Ide_Types.Cancel uu___2 | uu___2 -> let uu___3 = - FStarC_Compiler_Util.format1 "Unknown query '%s'" query in + FStarC_Util.format1 "Unknown query '%s'" query in FStarC_Interactive_Ide_Types.ProtocolViolation uu___3 in { FStarC_Interactive_Ide_Types.qq = uu___1; @@ -586,23 +582,21 @@ let (buffer_input_queries : FStarC_Interactive_Ide_Types.repl_names = (st2.FStarC_Interactive_Ide_Types.repl_names); FStarC_Interactive_Ide_Types.repl_buffered_input_queries = - (FStarC_Compiler_List.op_At + (FStarC_List.op_At st2.FStarC_Interactive_Ide_Types.repl_buffered_input_queries - (FStarC_Compiler_List.rev qs1)); + (FStarC_List.rev qs1)); FStarC_Interactive_Ide_Types.repl_lang = (st2.FStarC_Interactive_Ide_Types.repl_lang) } in let uu___ = let uu___1 = - FStarC_Compiler_Util.poll_stdin - (FStarC_Compiler_Util.float_of_string "0.0") in + FStarC_Util.poll_stdin (FStarC_Util.float_of_string "0.0") in Prims.op_Negation uu___1 in if uu___ then done1 qs st1 else (let uu___2 = - FStarC_Compiler_Util.read_line - st1.FStarC_Interactive_Ide_Types.repl_stdin in + FStarC_Util.read_line st1.FStarC_Interactive_Ide_Types.repl_stdin in match uu___2 with | FStar_Pervasives_Native.None -> done1 qs st1 | FStar_Pervasives_Native.Some line -> @@ -642,11 +636,9 @@ let (read_interactive_query : match st.FStarC_Interactive_Ide_Types.repl_buffered_input_queries with | [] -> let uu___ = - FStarC_Compiler_Util.read_line - st.FStarC_Interactive_Ide_Types.repl_stdin in + FStarC_Util.read_line st.FStarC_Interactive_Ide_Types.repl_stdin in (match uu___ with - | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.exit Prims.int_zero + | FStar_Pervasives_Native.None -> FStarC_Effect.exit Prims.int_zero | FStar_Pervasives_Native.Some line -> let uu___1 = parse_interactive_query line in (uu___1, st)) | q::qs -> @@ -679,8 +671,8 @@ let json_of_opt : = fun json_of_a -> fun opt_a -> - let uu___ = FStarC_Compiler_Util.map_option json_of_a opt_a in - FStarC_Compiler_Util.dflt FStarC_Json.JsonNull uu___ + let uu___ = FStarC_Util.map_option json_of_a opt_a in + FStarC_Util.dflt FStarC_Json.JsonNull uu___ let (alist_of_symbol_lookup_result : FStarC_Interactive_QueryHelper.sl_reponse -> Prims.string -> @@ -694,7 +686,7 @@ let (alist_of_symbol_lookup_result : let uu___1 = let uu___2 = let uu___3 = - json_of_opt FStarC_Compiler_Range_Ops.json_of_def_range + json_of_opt FStarC_Range_Ops.json_of_def_range lr.FStarC_Interactive_QueryHelper.slr_def_range in ("defined-at", uu___3) in let uu___3 = @@ -731,14 +723,14 @@ let (alist_of_symbol_lookup_result : let uu___3 = json_of_opt (fun x -> x) symrange_opt in ("symbol-range", uu___3) in [uu___2; ("symbol", (FStarC_Json.JsonStr symbol))] in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___ uu___1 let (alist_of_protocol_info : (Prims.string * FStarC_Json.json) Prims.list) = let js_version = FStarC_Json.JsonInt FStarC_Interactive_Ide_Types.interactive_protocol_vernum in let js_features = let uu___ = - FStarC_Compiler_List.map (fun uu___1 -> FStarC_Json.JsonStr uu___1) + FStarC_List.map (fun uu___1 -> FStarC_Json.JsonStr uu___1) FStarC_Interactive_Ide_Types.interactive_protocol_features in FStarC_Json.JsonList uu___ in [("version", js_version); ("features", js_features)] @@ -845,7 +837,7 @@ let (snippets_of_fstar_option : | FStarC_Options.SimpleStr desc -> [mk_field desc] | FStarC_Options.EnumStr strs -> strs | FStarC_Options.OpenEnumStr (strs, desc) -> - FStarC_Compiler_List.op_At strs [mk_field desc] + FStarC_List.op_At strs [mk_field desc] | FStarC_Options.PostProcessed (uu___, elem_spec) -> arg_snippets_of_type elem_spec | FStarC_Options.Accumulated elem_spec -> @@ -855,7 +847,7 @@ let (snippets_of_fstar_option : | FStarC_Options.WithSideEffect (uu___, elem_spec) -> arg_snippets_of_type elem_spec in let uu___ = arg_snippets_of_type typ in - FStarC_Compiler_List.map (mk_snippet name) uu___ + FStarC_List.map (mk_snippet name) uu___ let rec (json_of_fstar_option_value : FStarC_Options.option_val -> FStarC_Json.json) = fun uu___ -> @@ -865,7 +857,7 @@ let rec (json_of_fstar_option_value : | FStarC_Options.Path s -> FStarC_Json.JsonStr s | FStarC_Options.Int n -> FStarC_Json.JsonInt n | FStarC_Options.List vs -> - let uu___1 = FStarC_Compiler_List.map json_of_fstar_option_value vs in + let uu___1 = FStarC_List.map json_of_fstar_option_value vs in FStarC_Json.JsonList uu___1 | FStarC_Options.Unset -> FStarC_Json.JsonNull let (alist_of_fstar_option : @@ -944,7 +936,7 @@ let (json_of_message : Prims.string -> FStarC_Json.json -> FStarC_Json.json) let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang repl_current_qid in + let uu___4 = FStarC_Effect.op_Bang repl_current_qid in json_of_opt (fun uu___5 -> FStarC_Json.JsonStr uu___5) uu___4 in ("query-id", uu___3) in [uu___2; @@ -967,7 +959,7 @@ let (json_of_hello : FStarC_Json.json) = FStarC_Interactive_Ide_Types.interactive_protocol_vernum in let js_features = let uu___ = - FStarC_Compiler_List.map (fun uu___1 -> FStarC_Json.JsonStr uu___1) + FStarC_List.map (fun uu___1 -> FStarC_Json.JsonStr uu___1) FStarC_Interactive_Ide_Types.interactive_protocol_features in FStarC_Json.JsonList uu___ in FStarC_Json.JsonAssoc (("kind", (FStarC_Json.JsonStr "protocol-info")) :: @@ -985,14 +977,14 @@ let (sig_of_fstar_option : | FStar_Pervasives_Native.Some arg_sig -> Prims.strcat flag (Prims.strcat " " arg_sig) let (fstar_options_list_cache : fstar_option Prims.list) = - let defaults = FStarC_Compiler_Util.smap_of_list FStarC_Options.defaults in + let defaults = FStarC_Util.smap_of_list FStarC_Options.defaults in let uu___ = - FStarC_Compiler_List.filter_map + FStarC_List.filter_map (fun uu___1 -> match uu___1 with | (_shortname, name, typ, doc) -> - let uu___2 = FStarC_Compiler_Util.smap_try_find defaults name in - FStarC_Compiler_Util.map_option + let uu___2 = FStarC_Util.smap_try_find defaults name in + FStarC_Util.map_option (fun default_value -> let uu___3 = sig_of_fstar_option name typ in let uu___4 = snippets_of_fstar_option name typ in @@ -1015,16 +1007,14 @@ let (fstar_options_list_cache : fstar_option Prims.list) = opt_documentation = uu___5; opt_permission_level = uu___6 }) uu___2) FStarC_Options.all_specs_with_types in - FStarC_Compiler_List.sortWith + FStarC_List.sortWith (fun o1 -> fun o2 -> - FStarC_Compiler_String.compare - (FStarC_Compiler_String.lowercase o1.opt_name) - (FStarC_Compiler_String.lowercase o2.opt_name)) uu___ -let (fstar_options_map_cache : fstar_option FStarC_Compiler_Util.smap) = - let cache = FStarC_Compiler_Util.smap_create (Prims.of_int (50)) in - FStarC_Compiler_List.iter - (fun opt -> FStarC_Compiler_Util.smap_add cache opt.opt_name opt) + FStarC_String.compare (FStarC_String.lowercase o1.opt_name) + (FStarC_String.lowercase o2.opt_name)) uu___ +let (fstar_options_map_cache : fstar_option FStarC_Util.smap) = + let cache = FStarC_Util.smap_create (Prims.of_int (50)) in + FStarC_List.iter (fun opt -> FStarC_Util.smap_add cache opt.opt_name opt) fstar_options_list_cache; cache let (update_option : fstar_option -> fstar_option) = @@ -1043,16 +1033,15 @@ let (update_option : fstar_option -> fstar_option) = let (current_fstar_options : (fstar_option -> Prims.bool) -> fstar_option Prims.list) = fun filter -> - let uu___ = FStarC_Compiler_List.filter filter fstar_options_list_cache in - FStarC_Compiler_List.map update_option uu___ + let uu___ = FStarC_List.filter filter fstar_options_list_cache in + FStarC_List.map update_option uu___ let (trim_option_name : Prims.string -> (Prims.string * Prims.string)) = fun opt_name -> let opt_prefix = "--" in - if FStarC_Compiler_Util.starts_with opt_name opt_prefix + if FStarC_Util.starts_with opt_name opt_prefix then let uu___ = - FStarC_Compiler_Util.substring_from opt_name - (FStarC_Compiler_String.length opt_prefix) in + FStarC_Util.substring_from opt_name (FStarC_String.length opt_prefix) in (opt_prefix, uu___) else ("", opt_name) let (json_of_repl_state : @@ -1075,10 +1064,9 @@ let (json_of_repl_state : let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.concatMap filenames + FStarC_List.concatMap filenames st.FStarC_Interactive_Ide_Types.repl_deps_stack in - FStarC_Compiler_List.map - (fun uu___5 -> FStarC_Json.JsonStr uu___5) uu___4 in + FStarC_List.map (fun uu___5 -> FStarC_Json.JsonStr uu___5) uu___4 in FStarC_Json.JsonList uu___3 in ("loaded-dependencies", uu___2) in let uu___2 = @@ -1086,7 +1074,7 @@ let (json_of_repl_state : let uu___4 = let uu___5 = let uu___6 = current_fstar_options (fun uu___7 -> true) in - FStarC_Compiler_List.map json_of_fstar_option uu___6 in + FStarC_List.map json_of_fstar_option uu___6 in FStarC_Json.JsonList uu___5 in ("options", uu___4) in [uu___3] in @@ -1179,7 +1167,7 @@ let run_segment : (uu___2, decls, uu___3)) -> decls in let uu___ = with_captured_errors st.FStarC_Interactive_Ide_Types.repl_env - FStarC_Compiler_Util.sigint_ignore + FStarC_Util.sigint_ignore (fun uu___1 -> let uu___2 = collect_decls () in FStar_Pervasives_Native.Some uu___2) in @@ -1187,8 +1175,7 @@ let run_segment : | FStar_Pervasives_Native.None -> let errors = let uu___1 = collect_errors () in - FStarC_Compiler_List.map - FStarC_Interactive_Ide_Types.json_of_issue uu___1 in + FStarC_List.map json_of_issue uu___1 in ((FStarC_Interactive_Ide_Types.QueryNOK, (FStarC_Json.JsonList errors)), (FStar_Pervasives.Inl st)) | FStar_Pervasives_Native.Some decls -> @@ -1196,13 +1183,13 @@ let run_segment : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_Range_Ops.json_of_def_range + FStarC_Range_Ops.json_of_def_range decl.FStarC_Parser_AST.drange in ("def_range", uu___3) in [uu___2] in FStarC_Json.JsonAssoc uu___1 in let js_decls = - let uu___1 = FStarC_Compiler_List.map json_of_decl decls in + let uu___1 = FStarC_List.map json_of_decl decls in FStarC_Json.JsonList uu___1 in ((FStarC_Interactive_Ide_Types.QueryOK, (FStarC_Json.JsonAssoc [("decls", js_decls)])), @@ -1220,8 +1207,8 @@ let run_vfs_add : fun opt_fname -> fun contents -> let fname = - FStarC_Compiler_Util.dflt - st.FStarC_Interactive_Ide_Types.repl_fname opt_fname in + FStarC_Util.dflt st.FStarC_Interactive_Ide_Types.repl_fname + opt_fname in FStarC_Parser_ParseIt.add_vfs_entry fname contents; ((FStarC_Interactive_Ide_Types.QueryOK, FStarC_Json.JsonNull), (FStar_Pervasives.Inl st)) @@ -1291,7 +1278,7 @@ let (load_deps : fun st -> let uu___ = with_captured_errors st.FStarC_Interactive_Ide_Types.repl_env - FStarC_Compiler_Util.sigint_ignore + FStarC_Util.sigint_ignore (fun _env -> let uu___1 = FStarC_Interactive_PushHelper.deps_and_repl_ld_tasks_of_our_file @@ -1356,15 +1343,13 @@ let (write_full_buffer_fragment_progress : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.json_of_def_range - cf.FStarC_Parser_ParseIt.range in + FStarC_Range_Ops.json_of_def_range cf.FStarC_Parser_ParseIt.range in ("range", uu___2) in let uu___2 = let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_Util.digest_of_string - cf.FStarC_Parser_ParseIt.code in + FStarC_Util.digest_of_string cf.FStarC_Parser_ParseIt.code in FStarC_Json.JsonStr uu___5 in ("code-digest", uu___4) in [uu___3] in @@ -1378,8 +1363,7 @@ let (write_full_buffer_fragment_progress : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.json_of_def_range - d.FStarC_Parser_AST.drange in + FStarC_Range_Ops.json_of_def_range d.FStarC_Parser_AST.drange in ("ranges", uu___2) in [uu___1] in write_progress @@ -1389,8 +1373,7 @@ let (write_full_buffer_fragment_progress : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.json_of_def_range - d.FStarC_Parser_AST.drange in + FStarC_Range_Ops.json_of_def_range d.FStarC_Parser_AST.drange in ("ranges", uu___2) in let uu___2 = let uu___3 = @@ -1405,8 +1388,7 @@ let (write_full_buffer_fragment_progress : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.json_of_def_range - d.FStarC_Parser_AST.drange in + FStarC_Range_Ops.json_of_def_range d.FStarC_Parser_AST.drange in ("ranges", uu___2) in let uu___2 = let uu___3 = @@ -1420,23 +1402,20 @@ let (write_full_buffer_fragment_progress : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.json_of_def_range - d.FStarC_Parser_AST.drange in + FStarC_Range_Ops.json_of_def_range d.FStarC_Parser_AST.drange in ("ranges", uu___2) in [uu___1] in write_progress (FStar_Pervasives_Native.Some "full-buffer-fragment-failed") uu___ | FStarC_Interactive_Incremental.FragmentError issues -> let qid = - let uu___ = FStarC_Compiler_Effect.op_Bang repl_current_qid in + let uu___ = FStarC_Effect.op_Bang repl_current_qid in match uu___ with | FStar_Pervasives_Native.None -> "unknown" | FStar_Pervasives_Native.Some q -> q in let uu___ = let uu___1 = - let uu___2 = - FStarC_Compiler_List.map - FStarC_Interactive_Ide_Types.json_of_issue issues in + let uu___2 = FStarC_List.map json_of_issue issues in FStarC_Json.JsonList uu___2 in json_of_response qid FStarC_Interactive_Ide_Types.QueryNOK uu___1 in FStarC_Interactive_JsonHelper.write_json uu___ @@ -1452,11 +1431,11 @@ let (trunc_modul : fun pred -> let rec filter decls acc = match decls with - | [] -> (false, (FStarC_Compiler_List.rev acc)) + | [] -> (false, (FStarC_List.rev acc)) | d::ds -> let uu___ = pred d in if uu___ - then (true, (FStarC_Compiler_List.rev acc)) + then (true, (FStarC_List.rev acc)) else filter ds (d :: acc) in let uu___ = filter m.FStarC_Syntax_Syntax.declarations [] in match uu___ with @@ -1510,7 +1489,8 @@ let (load_partial_checked_file : let uu___6 = FStarC_Ident.string_of_lid lid in uu___6 = until_lid in if uu___5 then true else pred1 lids1 in - pred1 (FStarC_Syntax_Util.lids_of_sigelt se) in + let uu___5 = FStarC_Syntax_Util.lids_of_sigelt se in + pred1 uu___5 in let uu___5 = trunc_modul tc_result.FStarC_CheckedFiles.checked_module pred in @@ -1567,10 +1547,8 @@ let (run_load_partial_file : | FStar_Pervasives.Inr st1 -> let errors = let uu___1 = collect_errors () in - FStarC_Compiler_List.map rephrase_dependency_error uu___1 in - let js_errors = - FStarC_Compiler_List.map - FStarC_Interactive_Ide_Types.json_of_issue errors in + FStarC_List.map rephrase_dependency_error uu___1 in + let js_errors = FStarC_List.map json_of_issue errors in ((FStarC_Interactive_Ide_Types.QueryNOK, (FStarC_Json.JsonList js_errors)), (FStar_Pervasives.Inl st1)) | FStar_Pervasives.Inl (st1, deps) -> @@ -1581,7 +1559,7 @@ let (run_load_partial_file : FStarC_Interactive_Ide_Types.Noop st1 in let env = st2.FStarC_Interactive_Ide_Types.repl_env in let uu___1 = - with_captured_errors env FStarC_Compiler_Util.sigint_raise + with_captured_errors env FStarC_Util.sigint_raise (fun env1 -> let uu___2 = load_partial_checked_file env1 @@ -1618,8 +1596,7 @@ let (run_load_partial_file : | uu___2 -> let json_error_list = let uu___3 = collect_errors () in - FStarC_Compiler_List.map - FStarC_Interactive_Ide_Types.json_of_issue uu___3 in + FStarC_List.map json_of_issue uu___3 in let json_errors = FStarC_Json.JsonList json_error_list in let st3 = FStarC_Interactive_PushHelper.pop_repl "load partial file" @@ -1805,7 +1782,7 @@ let (run_push_without_deps : else FStarC_Interactive_Ide_Types.QueryNOK in let errs = collect_errors () in let has_error = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun i -> match i.FStarC_Errors.issue_level with | FStarC_Errors.EError -> true @@ -1823,9 +1800,7 @@ let (run_push_without_deps : (FStarC_Interactive_Incremental.FragmentFailed d) | uu___4 -> ()); (let json_errors = - let uu___4 = - FStarC_Compiler_List.map - FStarC_Interactive_Ide_Types.json_of_issue errs in + let uu___4 = FStarC_List.map json_of_issue errs in FStarC_Json.JsonList uu___4 in (match (errs, status) with | (uu___5::uu___6, FStarC_Interactive_Ide_Types.QueryOK) @@ -1868,9 +1843,9 @@ let (run_push_with_deps : = fun st -> fun query -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___1 = FStarC_Effect.op_Bang dbg in if uu___1 - then FStarC_Compiler_Util.print_string "Reloading dependencies" + then FStarC_Util.print_string "Reloading dependencies" else ()); FStarC_TypeChecker_Env.toggle_id_info st.FStarC_Interactive_Ide_Types.repl_env false; @@ -1879,10 +1854,8 @@ let (run_push_with_deps : | FStar_Pervasives.Inr st1 -> let errors = let uu___3 = collect_errors () in - FStarC_Compiler_List.map rephrase_dependency_error uu___3 in - let js_errors = - FStarC_Compiler_List.map - FStarC_Interactive_Ide_Types.json_of_issue errors in + FStarC_List.map rephrase_dependency_error uu___3 in + let js_errors = FStarC_List.map json_of_issue errors in ((FStarC_Interactive_Ide_Types.QueryNOK, (FStarC_Json.JsonList js_errors)), (FStar_Pervasives.Inl st1)) | FStar_Pervasives.Inl (st1, deps) -> @@ -1967,8 +1940,7 @@ let (run_option_lookup : match uu___ with | (uu___1, trimmed_name) -> let uu___2 = - FStarC_Compiler_Util.smap_try_find fstar_options_map_cache - trimmed_name in + FStarC_Util.smap_try_find fstar_options_map_cache trimmed_name in (match uu___2 with | FStar_Pervasives_Native.None -> FStar_Pervasives.Inl (Prims.strcat "Unknown option:" opt_name) @@ -1988,7 +1960,7 @@ let (run_module_lookup : = fun st -> fun symbol -> - let query = FStarC_Compiler_Util.split symbol "." in + let query = FStarC_Util.split symbol "." in let uu___ = FStarC_Interactive_CompletionTable.find_module_or_ns st.FStarC_Interactive_Ide_Types.repl_names query in @@ -2137,9 +2109,9 @@ let run_code_autocomplete : FStarC_Interactive_CompletionTable.completion_annotation = "" } in - FStarC_Compiler_List.op_At result [result_correlator] in + FStarC_List.op_At result [result_correlator] in let js = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Interactive_CompletionTable.json_of_completion_result results in ((FStarC_Interactive_Ide_Types.QueryOK, (FStarC_Json.JsonList js)), @@ -2158,13 +2130,13 @@ let run_module_autocomplete : fun search_term -> fun modules -> fun namespaces -> - let needle = FStarC_Compiler_Util.split search_term "." in + let needle = FStarC_Util.split search_term "." in let mods_and_nss = FStarC_Interactive_CompletionTable.autocomplete_mod_or_ns st.FStarC_Interactive_Ide_Types.repl_names needle (fun uu___ -> FStar_Pervasives_Native.Some uu___) in let json = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Interactive_CompletionTable.json_of_completion_result mods_and_nss in ((FStarC_Interactive_Ide_Types.QueryOK, @@ -2193,7 +2165,7 @@ let candidates_of_fstar_option : Prims.strcat "(" (Prims.strcat explanation (Prims.strcat " " (Prims.strcat opt_type ")"))) in - FStarC_Compiler_List.map + FStarC_List.map (fun snippet -> { FStarC_Interactive_CompletionTable.completion_match_length @@ -2218,15 +2190,14 @@ let run_option_autocomplete : match uu___ with | ("--", trimmed_name) -> let matcher opt = - FStarC_Compiler_Util.starts_with opt.opt_name trimmed_name in + FStarC_Util.starts_with opt.opt_name trimmed_name in let options = current_fstar_options matcher in - let match_len = FStarC_Compiler_String.length search_term in + let match_len = FStarC_String.length search_term in let collect_candidates = candidates_of_fstar_option match_len is_reset in - let results = - FStarC_Compiler_List.concatMap collect_candidates options in + let results = FStarC_List.concatMap collect_candidates options in let json = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Interactive_CompletionTable.json_of_completion_result results in ((FStarC_Interactive_Ide_Types.QueryOK, @@ -2276,20 +2247,17 @@ let run_and_rewind : (fun uu___ -> match () with | () -> - FStarC_Compiler_Util.with_sigint_handler - FStarC_Compiler_Util.sigint_raise + FStarC_Util.with_sigint_handler FStarC_Util.sigint_raise (fun uu___1 -> let uu___2 = task st1 in FStar_Pervasives.Inl uu___2)) () - with - | FStarC_Compiler_Util.SigInt -> - FStar_Pervasives.Inl sigint_default + with | FStarC_Util.SigInt -> FStar_Pervasives.Inl sigint_default | e -> FStar_Pervasives.Inr e in let st2 = FStarC_Interactive_PushHelper.pop_repl "run_and_rewind" st1 in match results with | FStar_Pervasives.Inl results1 -> (results1, (FStar_Pervasives.Inl st2)) - | FStar_Pervasives.Inr e -> FStarC_Compiler_Effect.raise e + | FStar_Pervasives.Inr e -> FStarC_Effect.raise e let run_with_parsed_and_tc_term : 'uuuuu 'uuuuu1 'uuuuu2 . FStarC_Interactive_Ide_Types.repl_state -> @@ -2312,8 +2280,7 @@ let run_with_parsed_and_tc_term : fun continuation -> let dummy_let_fragment term1 = let dummy_decl = - FStarC_Compiler_Util.format1 "let __compute_dummy__ = (%s)" - term1 in + FStarC_Util.format1 "let __compute_dummy__ = (%s)" term1 in { FStarC_Parser_ParseIt.frag_fname = " input"; FStarC_Parser_ParseIt.frag_text = dummy_decl; @@ -2351,8 +2318,7 @@ let run_with_parsed_and_tc_term : | FStarC_Parser_ParseIt.IncrementalFragment (decls, uu___1, _err) -> let uu___2 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - decls in + FStarC_List.map FStar_Pervasives_Native.fst decls in FStar_Pervasives_Native.Some uu___2 | uu___1 -> FStar_Pervasives_Native.None in let desugar env decls = @@ -2409,7 +2375,7 @@ let run_with_parsed_and_tc_term : (FStarC_Interactive_Ide_Types.QueryNOK, uu___5) | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.raise uu___3))) + FStarC_Effect.raise uu___3))) let run_compute : 'uuuuu . FStarC_Interactive_Ide_Types.repl_state -> @@ -2424,7 +2390,7 @@ let run_compute : fun term -> fun rules -> let rules1 = - FStarC_Compiler_List.op_At + FStarC_List.op_At (match rules with | FStar_Pervasives_Native.Some rules2 -> rules2 | FStar_Pervasives_Native.None -> @@ -2474,18 +2440,16 @@ let (__proj__Mksearch_term__item__st_term : search_term -> search_term') = let (st_cost : search_term' -> Prims.int) = fun uu___ -> match uu___ with - | NameContainsStr str -> - (FStarC_Compiler_String.length str) + | NameContainsStr str -> - (FStarC_String.length str) | TypeContainsLid lid -> Prims.int_one type search_candidate = { sc_lid: FStarC_Ident.lid ; sc_typ: - FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref - ; + FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option FStarC_Effect.ref ; sc_fvars: - FStarC_Ident.lid FStarC_Compiler_RBSet.t FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref + FStarC_Ident.lid FStarC_RBSet.t FStar_Pervasives_Native.option + FStarC_Effect.ref } let (__proj__Mksearch_candidate__item__sc_lid : search_candidate -> FStarC_Ident.lid) = @@ -2493,29 +2457,28 @@ let (__proj__Mksearch_candidate__item__sc_lid : match projectee with | { sc_lid; sc_typ; sc_fvars;_} -> sc_lid let (__proj__Mksearch_candidate__item__sc_typ : search_candidate -> - FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) + FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option FStarC_Effect.ref) = fun projectee -> match projectee with | { sc_lid; sc_typ; sc_fvars;_} -> sc_typ let (__proj__Mksearch_candidate__item__sc_fvars : search_candidate -> - FStarC_Ident.lid FStarC_Compiler_RBSet.t FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) + FStarC_Ident.lid FStarC_RBSet.t FStar_Pervasives_Native.option + FStarC_Effect.ref) = fun projectee -> match projectee with | { sc_lid; sc_typ; sc_fvars;_} -> sc_fvars let (sc_of_lid : FStarC_Ident.lid -> search_candidate) = fun lid -> - let uu___ = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in - let uu___1 = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let uu___ = FStarC_Util.mk_ref FStar_Pervasives_Native.None in + let uu___1 = FStarC_Util.mk_ref FStar_Pervasives_Native.None in { sc_lid = lid; sc_typ = uu___; sc_fvars = uu___1 } let (sc_typ : FStarC_TypeChecker_Env.env -> search_candidate -> FStarC_Syntax_Syntax.typ) = fun tcenv -> fun sc -> - let uu___ = FStarC_Compiler_Effect.op_Bang sc.sc_typ in + let uu___ = FStarC_Effect.op_Bang sc.sc_typ in match uu___ with | FStar_Pervasives_Native.Some t -> t | FStar_Pervasives_Native.None -> @@ -2525,24 +2488,24 @@ let (sc_typ : match uu___1 with | FStar_Pervasives_Native.None -> FStarC_Syntax_Syntax.mk FStarC_Syntax_Syntax.Tm_unknown - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange | FStar_Pervasives_Native.Some ((uu___2, typ1), uu___3) -> typ1 in - (FStarC_Compiler_Effect.op_Colon_Equals sc.sc_typ + (FStarC_Effect.op_Colon_Equals sc.sc_typ (FStar_Pervasives_Native.Some typ); typ) let (sc_fvars : FStarC_TypeChecker_Env.env -> - search_candidate -> FStarC_Ident.lident FStarC_Compiler_RBSet.t) + search_candidate -> FStarC_Ident.lident FStarC_RBSet.t) = fun tcenv -> fun sc -> - let uu___ = FStarC_Compiler_Effect.op_Bang sc.sc_fvars in + let uu___ = FStarC_Effect.op_Bang sc.sc_fvars in match uu___ with | FStar_Pervasives_Native.Some fv -> fv | FStar_Pervasives_Native.None -> let fv = let uu___1 = sc_typ tcenv sc in FStarC_Syntax_Free.fvars uu___1 in - (FStarC_Compiler_Effect.op_Colon_Equals sc.sc_fvars + (FStarC_Effect.op_Colon_Equals sc.sc_fvars (FStar_Pervasives_Native.Some fv); fv) let (json_of_search_result : @@ -2586,40 +2549,38 @@ let run_search : match term.st_term with | NameContainsStr str -> let uu___ = FStarC_Ident.string_of_lid candidate.sc_lid in - FStarC_Compiler_Util.contains uu___ str + FStarC_Util.contains uu___ str | TypeContainsLid lid -> let uu___ = sc_fvars tcenv candidate in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_fv)) lid (Obj.magic uu___) in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) + lid (Obj.magic uu___) in found <> term.st_negate in let parse search_str1 = let parse_one term = - let negate = FStarC_Compiler_Util.starts_with term "-" in + let negate = FStarC_Util.starts_with term "-" in let term1 = if negate - then FStarC_Compiler_Util.substring_from term Prims.int_one + then FStarC_Util.substring_from term Prims.int_one else term in - let beg_quote = FStarC_Compiler_Util.starts_with term1 "\"" in - let end_quote = FStarC_Compiler_Util.ends_with term1 "\"" in + let beg_quote = FStarC_Util.starts_with term1 "\"" in + let end_quote = FStarC_Util.ends_with term1 "\"" in let strip_quotes str = - if (FStarC_Compiler_String.length str) < (Prims.of_int (2)) - then - FStarC_Compiler_Effect.raise - (InvalidSearch "Empty search term") + if (FStarC_String.length str) < (Prims.of_int (2)) + then FStarC_Effect.raise (InvalidSearch "Empty search term") else - FStarC_Compiler_Util.substring str Prims.int_one - ((FStarC_Compiler_String.length term1) - (Prims.of_int (2))) in + FStarC_Util.substring str Prims.int_one + ((FStarC_String.length term1) - (Prims.of_int (2))) in let parsed = if beg_quote <> end_quote then let uu___ = let uu___1 = - FStarC_Compiler_Util.format1 - "Improperly quoted search term: %s" term1 in + FStarC_Util.format1 "Improperly quoted search term: %s" + term1 in InvalidSearch uu___1 in - FStarC_Compiler_Effect.raise uu___ + FStarC_Effect.raise uu___ else if beg_quote then @@ -2633,24 +2594,22 @@ let run_search : | FStar_Pervasives_Native.None -> let uu___3 = let uu___4 = - FStarC_Compiler_Util.format1 - "Unknown identifier: %s" term1 in + FStarC_Util.format1 "Unknown identifier: %s" term1 in InvalidSearch uu___4 in - FStarC_Compiler_Effect.raise uu___3 + FStarC_Effect.raise uu___3 | FStar_Pervasives_Native.Some lid1 -> TypeContainsLid lid1) in { st_negate = negate; st_term = parsed } in let terms = - FStarC_Compiler_List.map parse_one - (FStarC_Compiler_Util.split search_str1 " ") in + FStarC_List.map parse_one (FStarC_Util.split search_str1 " ") in let cmp x y = (st_cost x.st_term) - (st_cost y.st_term) in - FStarC_Compiler_Util.sort_with cmp terms in + FStarC_Util.sort_with cmp terms in let pprint_one term = let uu___ = match term.st_term with - | NameContainsStr s -> FStarC_Compiler_Util.format1 "\"%s\"" s + | NameContainsStr s -> FStarC_Util.format1 "\"%s\"" s | TypeContainsLid l -> let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 "%s" uu___1 in + FStarC_Util.format1 "%s" uu___1 in Prims.strcat (if term.st_negate then "-" else "") uu___ in let results = try @@ -2659,32 +2618,28 @@ let run_search : | () -> let terms = parse search_str in let all_lidents = FStarC_TypeChecker_Env.lidents tcenv in - let all_candidates = - FStarC_Compiler_List.map sc_of_lid all_lidents in + let all_candidates = FStarC_List.map sc_of_lid all_lidents in let matches_all candidate = - FStarC_Compiler_List.for_all (st_matches candidate) terms in + FStarC_List.for_all (st_matches candidate) terms in let cmp r1 r2 = let uu___1 = FStarC_Ident.string_of_lid r1.sc_lid in let uu___2 = FStarC_Ident.string_of_lid r2.sc_lid in - FStarC_Compiler_Util.compare uu___1 uu___2 in - let results1 = - FStarC_Compiler_List.filter matches_all all_candidates in - let sorted = FStarC_Compiler_Util.sort_with cmp results1 in + FStarC_Util.compare uu___1 uu___2 in + let results1 = FStarC_List.filter matches_all all_candidates in + let sorted = FStarC_Util.sort_with cmp results1 in let js = - FStarC_Compiler_List.map (json_of_search_result tcenv) - sorted in + FStarC_List.map (json_of_search_result tcenv) sorted in (match results1 with | [] -> let kwds = - let uu___1 = - FStarC_Compiler_List.map pprint_one terms in - FStarC_Compiler_Util.concat_l " " uu___1 in + let uu___1 = FStarC_List.map pprint_one terms in + FStarC_Util.concat_l " " uu___1 in let uu___1 = let uu___2 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "No results found for query [%s]" kwds in InvalidSearch uu___2 in - FStarC_Compiler_Effect.raise uu___1 + FStarC_Effect.raise uu___1 | uu___1 -> (FStarC_Interactive_Ide_Types.QueryOK, (FStarC_Json.JsonList js)))) () @@ -2715,9 +2670,7 @@ let run_format_code : let uu___ = let uu___1 = let uu___2 = - let uu___3 = - FStarC_Compiler_List.map - FStarC_Interactive_Ide_Types.json_of_issue issue in + let uu___3 = FStarC_List.map json_of_issue issue in FStarC_Json.JsonList uu___3 in ("formatted-code-issue", uu___2) in [uu___1] in @@ -2746,14 +2699,13 @@ let (maybe_cancel_queries : fun st -> fun l -> let log_cancellation l1 = - let uu___ = FStarC_Compiler_Effect.op_Bang dbg in + let uu___ = FStarC_Effect.op_Bang dbg in if uu___ then - FStarC_Compiler_List.iter + FStarC_List.iter (fun q -> let uu___1 = FStarC_Interactive_Ide_Types.query_to_string q in - FStarC_Compiler_Util.print1 "Cancelling query: %s\n" uu___1) - l1 + FStarC_Util.print1 "Cancelling query: %s\n" uu___1) l1 else () in match st.FStarC_Interactive_Ide_Types.repl_buffered_input_queries with | { @@ -2794,8 +2746,7 @@ let (maybe_cancel_queries : pq.FStarC_Interactive_Ide_Types.push_line >= l1 | uu___3 -> false) in let l1 = - let uu___1 = - FStarC_Compiler_Util.prefix_until (query_ahead_of p1) l in + let uu___1 = FStarC_Util.prefix_until (query_ahead_of p1) l in match uu___1 with | FStar_Pervasives_Native.None -> l | FStar_Pervasives_Native.Some (l2, q, qs) -> @@ -2820,7 +2771,7 @@ let rec (fold_query : let uu___ = f st q in (match uu___ with | ((status, responses), st') -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (write_response q.FStarC_Interactive_Ide_Types.qid status) responses; (match (status, st') with @@ -2907,7 +2858,7 @@ let rec (run_query : with_symbols write_full_buffer_fragment_progress in match uu___1 with | (queries, issues) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (write_response q.FStarC_Interactive_Ide_Types.qid FStarC_Interactive_Ide_Types.QueryOK) issues; (let res = fold_query validate_and_run_query queries st in @@ -2942,14 +2893,14 @@ and (validate_and_run_query : fun st -> fun query -> let query1 = validate_query st query in - FStarC_Compiler_Effect.op_Colon_Equals repl_current_qid + FStarC_Effect.op_Colon_Equals repl_current_qid (FStar_Pervasives_Native.Some (query1.FStarC_Interactive_Ide_Types.qid)); - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___2 = FStarC_Effect.op_Bang dbg in if uu___2 then let uu___3 = FStarC_Interactive_Ide_Types.query_to_string query1 in - FStarC_Compiler_Util.print2 "Running query %s: %s\n" + FStarC_Util.print2 "Running query %s: %s\n" query1.FStarC_Interactive_Ide_Types.qid uu___3 else ()); run_query st query1 @@ -2966,7 +2917,7 @@ let (js_repl_eval : match uu___ with | ((status, responses), st_opt) -> let js_responses = - FStarC_Compiler_List.map + FStarC_List.map (json_of_response query.FStarC_Interactive_Ide_Types.qid status) responses in (js_responses, st_opt) @@ -2994,8 +2945,7 @@ let (js_repl_eval_str : js_repl_eval st uu___1 in match uu___ with | (js_response, st_opt) -> - let uu___1 = - FStarC_Compiler_List.map FStarC_Json.string_of_json js_response in + let uu___1 = FStarC_List.map FStarC_Json.string_of_json js_response in (uu___1, st_opt) let (js_repl_init_opts : unit -> unit) = fun uu___ -> @@ -3023,32 +2973,40 @@ let rec (go : FStarC_Interactive_Ide_Types.repl_state -> Prims.int) = let uu___1 = validate_and_run_query st1 query in (match uu___1 with | ((status, responses), state_opt) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (write_response query.FStarC_Interactive_Ide_Types.qid status) responses; (match state_opt with | FStar_Pervasives.Inl st' -> go st' | FStar_Pervasives.Inr exitcode -> exitcode))) let (interactive_error_handler : FStarC_Errors.error_handler) = - let issues = FStarC_Compiler_Util.mk_ref [] in + let issues = FStarC_Util.mk_ref [] in let add_one e = - let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang issues in e :: uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals issues uu___ in + let e1 = + let uu___ = FStarC_Errors.fixup_issue_range e.FStarC_Errors.issue_range in + { + FStarC_Errors.issue_msg = (e.FStarC_Errors.issue_msg); + FStarC_Errors.issue_level = (e.FStarC_Errors.issue_level); + FStarC_Errors.issue_range = uu___; + FStarC_Errors.issue_number = (e.FStarC_Errors.issue_number); + FStarC_Errors.issue_ctx = (e.FStarC_Errors.issue_ctx) + } in + let uu___ = let uu___1 = FStarC_Effect.op_Bang issues in e1 :: uu___1 in + FStarC_Effect.op_Colon_Equals issues uu___ in let count_errors uu___ = let issues1 = - let uu___1 = FStarC_Compiler_Effect.op_Bang issues in - FStarC_Compiler_Util.remove_dups (fun i0 -> fun i1 -> i0 = i1) uu___1 in + let uu___1 = FStarC_Effect.op_Bang issues in + FStarC_Util.remove_dups (fun i0 -> fun i1 -> i0 = i1) uu___1 in let uu___1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun e -> e.FStarC_Errors.issue_level = FStarC_Errors.EError) issues1 in - FStarC_Compiler_List.length uu___1 in + FStarC_List.length uu___1 in let report uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang issues in - FStarC_Compiler_Util.remove_dups (fun i0 -> fun i1 -> i0 = i1) uu___2 in - FStarC_Compiler_List.sortWith FStarC_Errors.compare_issues uu___1 in - let clear uu___ = FStarC_Compiler_Effect.op_Colon_Equals issues [] in + let uu___2 = FStarC_Effect.op_Bang issues in + FStarC_Util.remove_dups (fun i0 -> fun i1 -> i0 = i1) uu___2 in + FStarC_List.sortWith FStarC_Errors.compare_issues uu___1 in + let clear uu___ = FStarC_Effect.op_Colon_Equals issues [] in { FStarC_Errors.eh_name = "interactive error handler"; FStarC_Errors.eh_add_one = add_one; @@ -3056,17 +3014,17 @@ let (interactive_error_handler : FStarC_Errors.error_handler) = FStarC_Errors.eh_report = report; FStarC_Errors.eh_clear = clear } -let (interactive_printer : - (FStarC_Json.json -> unit) -> FStarC_Compiler_Util.printer) = +let (interactive_printer : (FStarC_Json.json -> unit) -> FStarC_Util.printer) + = fun printer -> { - FStarC_Compiler_Util.printer_prinfo = + FStarC_Util.printer_prinfo = (fun s -> forward_message printer "info" (FStarC_Json.JsonStr s)); - FStarC_Compiler_Util.printer_prwarning = + FStarC_Util.printer_prwarning = (fun s -> forward_message printer "warning" (FStarC_Json.JsonStr s)); - FStarC_Compiler_Util.printer_prerror = + FStarC_Util.printer_prerror = (fun s -> forward_message printer "error" (FStarC_Json.JsonStr s)); - FStarC_Compiler_Util.printer_prgeneric = + FStarC_Util.printer_prgeneric = (fun label -> fun get_string -> fun get_json -> @@ -3074,7 +3032,7 @@ let (interactive_printer : } let (install_ide_mode_hooks : (FStarC_Json.json -> unit) -> unit) = fun printer -> - FStarC_Compiler_Util.set_printer (interactive_printer printer); + FStarC_Util.set_printer (interactive_printer printer); FStarC_Errors.set_handler interactive_error_handler let (build_initial_repl_state : Prims.string -> FStarC_Interactive_Ide_Types.repl_state) = @@ -3084,7 +3042,7 @@ let (build_initial_repl_state : FStarC_TypeChecker_Env.set_range env FStarC_Interactive_Ide_Types.initial_range in FStarC_Options.set_ide_filename filename; - (let uu___1 = FStarC_Compiler_Util.open_stdin () in + (let uu___1 = FStarC_Util.open_stdin () in { FStarC_Interactive_Ide_Types.repl_line = Prims.int_one; FStarC_Interactive_Ide_Types.repl_column = Prims.int_zero; @@ -3104,25 +3062,16 @@ let interactive_mode' : fun init_st -> write_hello (); (let exit_code = - let uu___1 = - (FStarC_Options.record_hints ()) || (FStarC_Options.use_hints ()) in - if uu___1 - then - let uu___2 = - let uu___3 = FStarC_Options.file_list () in - FStarC_Compiler_List.hd uu___3 in - FStarC_SMTEncoding_Solver.with_hints_db uu___2 - (fun uu___3 -> go init_st) - else go init_st in - FStarC_Compiler_Effect.exit exit_code) + let fn = + let uu___1 = FStarC_Options.file_list () in FStarC_List.hd uu___1 in + FStarC_SMTEncoding_Solver.with_hints_db fn (fun uu___1 -> go init_st) in + FStarC_Effect.exit exit_code) let (interactive_mode : Prims.string -> unit) = fun filename -> install_ide_mode_hooks FStarC_Interactive_JsonHelper.write_json; - FStarC_Compiler_Util.set_sigint_handler - FStarC_Compiler_Util.sigint_ignore; + FStarC_Util.set_sigint_handler FStarC_Util.sigint_ignore; (let uu___3 = - let uu___4 = FStarC_Options.codegen () in - FStarC_Compiler_Option.isSome uu___4 in + let uu___4 = FStarC_Options.codegen () in FStarC_Option.isSome uu___4 in if uu___3 then FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_IDEIgnoreCodeGen @@ -3138,4 +3087,4 @@ let (interactive_mode : Prims.string -> unit) = with | uu___5 -> (FStarC_Errors.set_handler FStarC_Errors.default_handler; - FStarC_Compiler_Effect.raise uu___5))) \ No newline at end of file + FStarC_Effect.raise uu___5))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_Ide_Types.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Ide_Types.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_Interactive_Ide_Types.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Ide_Types.ml index ad142a94e4c..f68889e1e04 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_Ide_Types.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Ide_Types.ml @@ -1,8 +1,19 @@ open Prims -let (initial_range : FStarC_Compiler_Range_Type.range) = - let uu___ = FStarC_Compiler_Range_Type.mk_pos Prims.int_one Prims.int_zero in - let uu___1 = FStarC_Compiler_Range_Type.mk_pos Prims.int_one Prims.int_zero in - FStarC_Compiler_Range_Type.mk_range "" uu___ uu___1 +let (initial_range : FStarC_Range_Type.range) = + let uu___ = FStarC_Range_Type.mk_pos Prims.int_one Prims.int_zero in + let uu___1 = FStarC_Range_Type.mk_pos Prims.int_one Prims.int_zero in + FStarC_Range_Type.mk_range "" uu___ uu___1 +type push_kind = + | SyntaxCheck + | LaxCheck + | FullCheck +let (uu___is_SyntaxCheck : push_kind -> Prims.bool) = + fun projectee -> + match projectee with | SyntaxCheck -> true | uu___ -> false +let (uu___is_LaxCheck : push_kind -> Prims.bool) = + fun projectee -> match projectee with | LaxCheck -> true | uu___ -> false +let (uu___is_FullCheck : push_kind -> Prims.bool) = + fun projectee -> match projectee with | FullCheck -> true | uu___ -> false type completion_context = | CKCode | CKOption of Prims.bool @@ -35,17 +46,6 @@ let (uu___is_LKOption : lookup_context -> Prims.bool) = let (uu___is_LKCode : lookup_context -> Prims.bool) = fun projectee -> match projectee with | LKCode -> true | uu___ -> false type position = (Prims.string * Prims.int * Prims.int) -type push_kind = - | SyntaxCheck - | LaxCheck - | FullCheck -let (uu___is_SyntaxCheck : push_kind -> Prims.bool) = - fun projectee -> - match projectee with | SyntaxCheck -> true | uu___ -> false -let (uu___is_LaxCheck : push_kind -> Prims.bool) = - fun projectee -> match projectee with | LaxCheck -> true | uu___ -> false -let (uu___is_FullCheck : push_kind -> Prims.bool) = - fun projectee -> match projectee with | FullCheck -> true | uu___ -> false type push_query = { push_kind: push_kind ; @@ -104,12 +104,12 @@ type optmod_t = FStarC_Syntax_Syntax.modul FStar_Pervasives_Native.option type timed_fname = { tf_fname: Prims.string ; - tf_modtime: FStarC_Compiler_Util.time_of_day } + tf_modtime: FStarC_Util.time_of_day } let (__proj__Mktimed_fname__item__tf_fname : timed_fname -> Prims.string) = fun projectee -> match projectee with | { tf_fname; tf_modtime;_} -> tf_fname let (__proj__Mktimed_fname__item__tf_modtime : - timed_fname -> FStarC_Compiler_Util.time_of_day) = + timed_fname -> FStarC_Util.time_of_day) = fun projectee -> match projectee with | { tf_fname; tf_modtime;_} -> tf_modtime type repl_task = @@ -212,7 +212,7 @@ and repl_state = repl_deps_stack: (repl_depth_t * (repl_task * repl_state)) Prims.list ; repl_curmod: optmod_t ; repl_env: FStarC_TypeChecker_Env.env ; - repl_stdin: FStarC_Compiler_Util.stream_reader ; + repl_stdin: FStarC_Util.stream_reader ; repl_names: FStarC_Interactive_CompletionTable.table ; repl_buffered_input_queries: query Prims.list ; repl_lang: FStarC_Universal.lang_decls_t } @@ -349,7 +349,7 @@ let (__proj__Mkrepl_state__item__repl_env : repl_env; repl_stdin; repl_names; repl_buffered_input_queries; repl_lang;_} -> repl_env let (__proj__Mkrepl_state__item__repl_stdin : - repl_state -> FStarC_Compiler_Util.stream_reader) = + repl_state -> FStarC_Util.stream_reader) = fun projectee -> match projectee with | { repl_line; repl_column; repl_fname; repl_deps_stack; repl_curmod; @@ -384,18 +384,17 @@ type repl_stack_entry_t = (repl_depth_t * (repl_task * repl_state)) type repl_stack_t = (repl_depth_t * (repl_task * repl_state)) Prims.list type grepl_state = { - grepl_repls: repl_state FStarC_Compiler_Util.psmap ; - grepl_stdin: FStarC_Compiler_Util.stream_reader } + grepl_repls: repl_state FStarC_Util.psmap ; + grepl_stdin: FStarC_Util.stream_reader } let (__proj__Mkgrepl_state__item__grepl_repls : - grepl_state -> repl_state FStarC_Compiler_Util.psmap) = + grepl_state -> repl_state FStarC_Util.psmap) = fun projectee -> match projectee with | { grepl_repls; grepl_stdin;_} -> grepl_repls let (__proj__Mkgrepl_state__item__grepl_stdin : - grepl_state -> FStarC_Compiler_Util.stream_reader) = + grepl_state -> FStarC_Util.stream_reader) = fun projectee -> match projectee with | { grepl_repls; grepl_stdin;_} -> grepl_stdin -let (t0 : FStarC_Compiler_Util.time_of_day) = - FStarC_Compiler_Util.get_time_of_day () +let (t0 : FStarC_Util.time_of_day) = FStarC_Util.get_time_of_day () let (dummy_tf_of_fname : Prims.string -> timed_fname) = fun fname -> { tf_fname = fname; tf_modtime = t0 } let (string_of_timed_fname : timed_fname -> Prims.string) = @@ -403,49 +402,49 @@ let (string_of_timed_fname : timed_fname -> Prims.string) = match uu___ with | { tf_fname = fname; tf_modtime = modtime;_} -> if modtime = t0 - then FStarC_Compiler_Util.format1 "{ %s }" fname + then FStarC_Util.format1 "{ %s }" fname else - (let uu___2 = FStarC_Compiler_Util.string_of_time_of_day modtime in - FStarC_Compiler_Util.format2 "{ %s; %s }" fname uu___2) + (let uu___2 = FStarC_Util.string_of_time_of_day modtime in + FStarC_Util.format2 "{ %s; %s }" fname uu___2) let (string_of_repl_task : repl_task -> Prims.string) = fun uu___ -> match uu___ with | LDInterleaved (intf, impl) -> let uu___1 = string_of_timed_fname intf in let uu___2 = string_of_timed_fname impl in - FStarC_Compiler_Util.format2 "LDInterleaved (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "LDInterleaved (%s, %s)" uu___1 uu___2 | LDSingle intf_or_impl -> let uu___1 = string_of_timed_fname intf_or_impl in - FStarC_Compiler_Util.format1 "LDSingle %s" uu___1 + FStarC_Util.format1 "LDSingle %s" uu___1 | LDInterfaceOfCurrentFile intf -> let uu___1 = string_of_timed_fname intf in - FStarC_Compiler_Util.format1 "LDInterfaceOfCurrentFile %s" uu___1 + FStarC_Util.format1 "LDInterfaceOfCurrentFile %s" uu___1 | PushFragment (FStar_Pervasives.Inl frag, uu___1, uu___2) -> - FStarC_Compiler_Util.format1 "PushFragment { code = %s }" + FStarC_Util.format1 "PushFragment { code = %s }" frag.FStarC_Parser_ParseIt.frag_text | PushFragment (FStar_Pervasives.Inr d, uu___1, uu___2) -> let uu___3 = FStarC_Class_Show.show FStarC_Parser_AST.showable_decl d in - FStarC_Compiler_Util.format1 "PushFragment { decl = %s }" uu___3 + FStarC_Util.format1 "PushFragment { decl = %s }" uu___3 | Noop -> "Noop {}" let (string_of_repl_stack_entry : repl_stack_entry_t -> Prims.string) = fun uu___ -> match uu___ with | ((depth, i), (task, state)) -> let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in + let uu___2 = FStarC_Util.string_of_int i in let uu___3 = let uu___4 = string_of_repl_task task in [uu___4] in uu___2 :: uu___3 in - FStarC_Compiler_Util.format "{depth=%s; task=%s}" uu___1 + FStarC_Util.format "{depth=%s; task=%s}" uu___1 let (string_of_repl_stack : repl_stack_entry_t Prims.list -> Prims.string) = fun s -> - let uu___ = FStarC_Compiler_List.map string_of_repl_stack_entry s in - FStarC_Compiler_String.concat ";\n\t\t" uu___ + let uu___ = FStarC_List.map string_of_repl_stack_entry s in + FStarC_String.concat ";\n\t\t" uu___ let (repl_state_to_string : repl_state -> Prims.string) = fun r -> let uu___ = - let uu___1 = FStarC_Compiler_Util.string_of_int r.repl_line in + let uu___1 = FStarC_Util.string_of_int r.repl_line in let uu___2 = - let uu___3 = FStarC_Compiler_Util.string_of_int r.repl_column in + let uu___3 = FStarC_Util.string_of_int r.repl_column in let uu___4 = let uu___5 = let uu___6 = @@ -459,7 +458,7 @@ let (repl_state_to_string : repl_state -> Prims.string) = (r.repl_fname) :: uu___5 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStarC_Compiler_Util.format + FStarC_Util.format "{\n\trepl_line=%s;\n\trepl_column=%s;\n\trepl_fname=%s;\n\trepl_cur_mod=%s;\n\t\\ \n repl_deps_stack={%s}\n}" uu___ let (push_query_to_string : push_query -> Prims.string) = @@ -475,17 +474,16 @@ let (push_query_to_string : push_query -> Prims.string) = | FStar_Pervasives.Inr (_decl, code) -> code.FStarC_Parser_ParseIt.code in let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int pq.push_line in + let uu___2 = FStarC_Util.string_of_int pq.push_line in let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_int pq.push_column in + let uu___4 = FStarC_Util.string_of_int pq.push_column in let uu___5 = - let uu___6 = - FStarC_Compiler_Util.string_of_bool pq.push_peek_only in + let uu___6 = FStarC_Util.string_of_bool pq.push_peek_only in [uu___6; code_or_decl] in uu___4 :: uu___5 in uu___2 :: uu___3 in pk :: uu___1 in - FStarC_Compiler_Util.format + FStarC_Util.format "{ push_kind = %s; push_line = %s; push_column = %s; push_peek_only = %s; push_code_or_decl = %s }" uu___ let (query_to_string : query -> Prims.string) = @@ -509,11 +507,11 @@ let (query_to_string : query -> Prims.string) = match pos with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some (f, i, j) -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in - let uu___2 = FStarC_Compiler_Util.string_of_int j in - FStarC_Compiler_Util.format3 "(%s, %s, %s)" f uu___1 uu___2 in - FStarC_Compiler_Util.format3 "(Lookup %s %s [%s])" s uu___ - (FStarC_Compiler_String.concat "; " features) + let uu___1 = FStarC_Util.string_of_int i in + let uu___2 = FStarC_Util.string_of_int j in + FStarC_Util.format3 "(%s, %s, %s)" f uu___1 uu___2 in + FStarC_Util.format3 "(Lookup %s %s [%s])" s uu___ + (FStarC_String.concat "; " features) | Compute uu___ -> "Compute" | Search uu___ -> "Search" | GenericError uu___ -> "GenericError" @@ -603,30 +601,28 @@ let (json_of_issue : FStarC_Errors.issue -> FStarC_Json.json) = match issue.FStarC_Errors.issue_range with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some r -> - let uu___9 = - FStarC_Compiler_Range_Ops.json_of_use_range r in + let uu___9 = FStarC_Range_Ops.json_of_use_range r in [uu___9] in let uu___9 = match issue.FStarC_Errors.issue_range with | FStar_Pervasives_Native.Some r when - let uu___10 = FStarC_Compiler_Range_Type.def_range r in - let uu___11 = FStarC_Compiler_Range_Type.use_range r in + let uu___10 = FStarC_Range_Type.def_range r in + let uu___11 = FStarC_Range_Type.use_range r in uu___10 <> uu___11 -> - let uu___10 = - FStarC_Compiler_Range_Ops.json_of_def_range r in + let uu___10 = FStarC_Range_Ops.json_of_def_range r in [uu___10] | uu___10 -> [] in - FStarC_Compiler_List.op_At uu___8 uu___9 in + FStarC_List.op_At uu___8 uu___9 in FStarC_Json.JsonList uu___7 in ("ranges", uu___6) in [uu___5] in uu___3 :: uu___4 in - FStarC_Compiler_List.op_At + FStarC_List.op_At (match issue.FStarC_Errors.issue_number with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some n -> [("number", (FStarC_Json.JsonInt n))]) uu___2 in - FStarC_Compiler_List.op_At + FStarC_List.op_At [("level", (json_of_issue_level issue.FStarC_Errors.issue_level))] uu___1 in FStarC_Json.JsonAssoc uu___ diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_Incremental.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Incremental.ml similarity index 83% rename from stage0/fstar-lib/generated/FStarC_Interactive_Incremental.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Incremental.ml index b13b043b82a..5ca269db2e7 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_Incremental.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Incremental.ml @@ -84,7 +84,7 @@ let (as_query : let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_int i in + let uu___4 = FStarC_Util.string_of_int i in Prims.strcat "." uu___4 in Prims.strcat qid_prefix uu___3 in { @@ -96,12 +96,12 @@ let (dump_symbols_for_lid : FStarC_Ident.lident -> FStarC_Interactive_Ide_Types.query qst) = fun l -> let r = FStarC_Ident.range_of_lid l in - let start_pos = FStarC_Compiler_Range_Ops.start_of_range r in - let end_pos = FStarC_Compiler_Range_Ops.end_of_range r in - let start_line = FStarC_Compiler_Range_Ops.line_of_pos start_pos in - let start_col = FStarC_Compiler_Range_Ops.col_of_pos start_pos in - let end_line = FStarC_Compiler_Range_Ops.line_of_pos end_pos in - let end_col = FStarC_Compiler_Range_Ops.col_of_pos end_pos in + let start_pos = FStarC_Range_Ops.start_of_range r in + let end_pos = FStarC_Range_Ops.end_of_range r in + let start_line = FStarC_Range_Ops.line_of_pos start_pos in + let start_col = FStarC_Range_Ops.col_of_pos start_pos in + let end_line = FStarC_Range_Ops.line_of_pos end_pos in + let end_col = FStarC_Range_Ops.col_of_pos end_pos in let position = ("", start_line, start_col) in let uu___ = let uu___1 = @@ -145,14 +145,14 @@ let (push_decl : let pq = let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.start_of_range + FStarC_Range_Ops.start_of_range d.FStarC_Parser_AST.drange in - FStarC_Compiler_Range_Ops.line_of_pos uu___2 in + FStarC_Range_Ops.line_of_pos uu___2 in let uu___2 = let uu___3 = - FStarC_Compiler_Range_Ops.start_of_range + FStarC_Range_Ops.start_of_range d.FStarC_Parser_AST.drange in - FStarC_Compiler_Range_Ops.col_of_pos uu___3 in + FStarC_Range_Ops.col_of_pos uu___3 in { FStarC_Interactive_Ide_Types.push_kind = push_kind; FStarC_Interactive_Ide_Types.push_line = uu___1; @@ -178,9 +178,7 @@ let (push_decl : let uu___3 = dump_symbols d in op_let_Bang uu___3 (fun lookups -> - return - (FStarC_Compiler_List.op_At [cb; push] - lookups)) + return (FStarC_List.op_At [cb; push] lookups)) else return [cb; push])) let (push_decls : FStarC_Interactive_Ide_Types.push_kind -> @@ -197,8 +195,7 @@ let (push_decls : map (push_decl push_kind with_symbols write_full_buffer_fragment_progress) ds in - op_let_Bang uu___ - (fun qs -> return (FStarC_Compiler_List.flatten qs)) + op_let_Bang uu___ (fun qs -> return (FStarC_List.flatten qs)) let (pop_entries : FStarC_Interactive_Ide_Types.repl_stack_entry_t Prims.list -> FStarC_Interactive_Ide_Types.query Prims.list qst) @@ -221,12 +218,12 @@ let (inspect_repl_stack : fun push_kind -> fun with_symbols -> fun write_full_buffer_fragment_progress -> - let entries = FStarC_Compiler_List.rev s in + let entries = FStarC_List.rev s in let push_decls1 = push_decls push_kind with_symbols write_full_buffer_fragment_progress in let uu___ = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun uu___1 -> match uu___1 with | (uu___2, @@ -257,9 +254,9 @@ let (inspect_repl_stack : op_let_Bang uu___4 (fun pushes -> return - ((FStarC_Compiler_List.op_At lookups - (FStarC_Compiler_List.op_At pops - pushes)), accum))) + ((FStarC_List.op_At lookups + (FStarC_List.op_At pops pushes)), + accum))) | FStarC_Interactive_Ide_Types.PushFragment (FStar_Pervasives.Inr d', pk, issues) -> let uu___1 = @@ -278,15 +275,13 @@ let (inspect_repl_stack : op_let_Bang uu___4 (fun lookups' -> matching_prefix - (FStarC_Compiler_List.op_At - issues accum) - (FStarC_Compiler_List.op_At - lookups' lookups) entries3 - ds2)) + (FStarC_List.op_At issues accum) + (FStarC_List.op_At lookups' + lookups) entries3 ds2)) else matching_prefix - (FStarC_Compiler_List.op_At issues - accum) lookups entries3 ds2)) + (FStarC_List.op_At issues accum) + lookups entries3 ds2)) else (let uu___3 = pop_entries (e :: entries3) in op_let_Bang uu___3 @@ -295,23 +290,19 @@ let (inspect_repl_stack : op_let_Bang uu___4 (fun pushes -> return - ((FStarC_Compiler_List.op_At pops - (FStarC_Compiler_List.op_At - lookups pushes)), accum))))) + ((FStarC_List.op_At pops + (FStarC_List.op_At lookups + pushes)), accum))))) | ([], ds2) -> let uu___1 = push_decls1 ds2 in op_let_Bang uu___1 (fun pushes -> - return - ((FStarC_Compiler_List.op_At lookups pushes), - accum)) + return ((FStarC_List.op_At lookups pushes), accum)) | (es, []) -> let uu___1 = pop_entries es in op_let_Bang uu___1 (fun pops -> - return - ((FStarC_Compiler_List.op_At lookups pops), - accum)) in + return ((FStarC_List.op_At lookups pops), accum)) in matching_prefix [] [] entries1 ds let reload_deps : 'uuuuu 'uuuuu1 . @@ -321,7 +312,7 @@ let reload_deps : fun repl_stack -> let pop_until_deps entries = let uu___ = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun e -> match repl_task e with | FStarC_Interactive_Ide_Types.PushFragment uu___1 -> false @@ -333,8 +324,7 @@ let reload_deps : let uu___3 = as_query FStarC_Interactive_Ide_Types.Pop in op_let_Bang uu___3 (fun pop -> - let uu___4 = - FStarC_Compiler_List.map (fun uu___5 -> pop) prefix in + let uu___4 = FStarC_List.map (fun uu___5 -> pop) prefix in return uu___4) in pop_until_deps repl_stack let (parse_code : @@ -346,18 +336,18 @@ let (parse_code : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.file_of_range + FStarC_Range_Ops.file_of_range FStarC_Interactive_Ide_Types.initial_range in let uu___3 = let uu___4 = - FStarC_Compiler_Range_Ops.start_of_range + FStarC_Range_Ops.start_of_range FStarC_Interactive_Ide_Types.initial_range in - FStarC_Compiler_Range_Ops.line_of_pos uu___4 in + FStarC_Range_Ops.line_of_pos uu___4 in let uu___4 = let uu___5 = - FStarC_Compiler_Range_Ops.start_of_range + FStarC_Range_Ops.start_of_range FStarC_Interactive_Ide_Types.initial_range in - FStarC_Compiler_Range_Ops.col_of_pos uu___5 in + FStarC_Range_Ops.col_of_pos uu___5 in { FStarC_Parser_ParseIt.frag_fname = uu___2; FStarC_Parser_ParseIt.frag_text = code; @@ -368,7 +358,7 @@ let (parse_code : FStarC_Parser_ParseIt.parse lang uu___ let (syntax_issue : (FStarC_Errors_Codes.error_code * FStarC_Errors_Msg.error_message * - FStarC_Compiler_Range_Type.range) -> FStarC_Errors.issue) + FStarC_Range_Type.range) -> FStarC_Errors.issue) = fun uu___ -> match uu___ with @@ -415,27 +405,27 @@ let (run_full_buffer : match request_type with | FStarC_Interactive_Ide_Types.VerifyToPosition (uu___, line, _col) -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___1 -> match uu___1 with | (d, uu___2) -> let start = - FStarC_Compiler_Range_Ops.start_of_range + FStarC_Range_Ops.start_of_range d.FStarC_Parser_AST.drange in let start_line = - FStarC_Compiler_Range_Ops.line_of_pos start in + FStarC_Range_Ops.line_of_pos start in start_line <= line) decls | FStarC_Interactive_Ide_Types.LaxToPosition (uu___, line, _col) -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___1 -> match uu___1 with | (d, uu___2) -> let start = - FStarC_Compiler_Range_Ops.start_of_range + FStarC_Range_Ops.start_of_range d.FStarC_Parser_AST.drange in let start_line = - FStarC_Compiler_Range_Ops.line_of_pos start in + FStarC_Range_Ops.line_of_pos start in start_line <= line) decls | uu___ -> decls in let qs = @@ -443,17 +433,15 @@ let (run_full_buffer : | FStarC_Parser_ParseIt.IncrementalFragment (decls, uu___, err_opt) -> ((let uu___2 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length decls) in - FStarC_Compiler_Util.print1 "Parsed %s declarations\n" - uu___2); + FStarC_Util.string_of_int (FStarC_List.length decls) in + FStarC_Util.print1 "Parsed %s declarations\n" uu___2); (match (request_type, decls) with | (FStarC_Interactive_Ide_Types.ReloadDeps, d::uu___2) -> let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang FStarC_Interactive_PushHelper.repl_stack in reload_deps uu___5 in op_let_Bang uu___4 @@ -466,8 +454,8 @@ let (run_full_buffer : op_let_Bang uu___5 (fun push_mod -> return - ((FStarC_Compiler_List.op_At queries - push_mod), []))) in + ((FStarC_List.op_At queries push_mod), + []))) in run_qst uu___3 qid1 | uu___2 -> let decls1 = filter_decls decls in @@ -483,7 +471,7 @@ let (run_full_buffer : let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang FStarC_Interactive_PushHelper.repl_stack in inspect_repl_stack uu___5 decls1 push_kind with_symbols @@ -496,17 +484,16 @@ let (run_full_buffer : FStarC_Interactive_Ide_Types.Cache then log_syntax_issues err_opt else (); - (let uu___6 = FStarC_Compiler_Debug.any () in + (let uu___6 = FStarC_Debug.any () in if uu___6 then let uu___7 = let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Interactive_Ide_Types.query_to_string queries in - FStarC_Compiler_String.concat "\n" - uu___8 in - FStarC_Compiler_Util.print1 + FStarC_String.concat "\n" uu___8 in + FStarC_Util.print1 "Generating queries\n%s\n" uu___7 else ()); if @@ -543,11 +530,10 @@ let (format_code : | FStarC_Parser_ParseIt.IncrementalFragment (decls, comments, FStar_Pervasives_Native.None) -> let doc_to_string doc = - FStarC_Pprint.pretty_string - (FStarC_Compiler_Util.float_of_string "1.0") + FStarC_Pprint.pretty_string (FStarC_Util.float_of_string "1.0") (Prims.of_int (100)) doc in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -560,12 +546,12 @@ let (format_code : let uu___5 = let uu___6 = doc_to_string doc in uu___6 :: out in (uu___5, comments2))) - ([], (FStarC_Compiler_List.rev comments)) decls in + ([], (FStarC_List.rev comments)) decls in (match uu___ with | (formatted_code_rev, leftover_comments) -> let code1 = - FStarC_Compiler_String.concat "\n\n" - (FStarC_Compiler_List.rev formatted_code_rev) in + FStarC_String.concat "\n\n" + (FStarC_List.rev formatted_code_rev) in let formatted_code = match leftover_comments with | [] -> code1 diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_JsonHelper.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_JsonHelper.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_Interactive_JsonHelper.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_JsonHelper.ml index 2662a42050d..2d144b9990f 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_JsonHelper.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_JsonHelper.ml @@ -6,9 +6,9 @@ let (try_assoc : fun key -> fun d -> let uu___ = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun uu___1 -> match uu___1 with | (k, uu___2) -> k = key) d in - FStarC_Compiler_Util.map_option FStar_Pervasives_Native.snd uu___ + FStarC_Util.map_option FStar_Pervasives_Native.snd uu___ exception MissingKey of Prims.string let (uu___is_MissingKey : Prims.exn -> Prims.bool) = fun projectee -> @@ -44,27 +44,23 @@ let (assoc : Prims.string -> assoct -> FStarC_Json.json) = | FStar_Pervasives_Native.Some v -> v | FStar_Pervasives_Native.None -> let uu___1 = - let uu___2 = FStarC_Compiler_Util.format1 "Missing key [%s]" key in + let uu___2 = FStarC_Util.format1 "Missing key [%s]" key in MissingKey uu___2 in - FStarC_Compiler_Effect.raise uu___1 + FStarC_Effect.raise uu___1 let (write_json : FStarC_Json.json -> unit) = fun js -> (let uu___1 = FStarC_Json.string_of_json js in - FStarC_Compiler_Util.print_raw uu___1); - FStarC_Compiler_Util.print_raw "\n" + FStarC_Util.print_raw uu___1); + FStarC_Util.print_raw "\n" let (write_jsonrpc : FStarC_Json.json -> unit) = fun js -> let js_str = FStarC_Json.string_of_json js in - let len = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_String.length js_str) in - let uu___ = - FStarC_Compiler_Util.format2 "Content-Length: %s\r\n\r\n%s" len js_str in - FStarC_Compiler_Util.print_raw uu___ + let len = FStarC_Util.string_of_int (FStarC_String.length js_str) in + let uu___ = FStarC_Util.format2 "Content-Length: %s\r\n\r\n%s" len js_str in + FStarC_Util.print_raw uu___ let js_fail : 'a . Prims.string -> FStarC_Json.json -> 'a = fun expected -> - fun got -> - FStarC_Compiler_Effect.raise (UnexpectedJsonType (expected, got)) + fun got -> FStarC_Effect.raise (UnexpectedJsonType (expected, got)) let (js_int : FStarC_Json.json -> Prims.int) = fun uu___ -> match uu___ with @@ -85,7 +81,7 @@ let js_list : fun k -> fun uu___ -> match uu___ with - | FStarC_Json.JsonList l -> FStarC_Compiler_List.map k l + | FStarC_Json.JsonList l -> FStarC_List.map k l | other -> js_fail "list" other let (js_assoc : FStarC_Json.json -> assoct) = fun uu___ -> @@ -96,7 +92,7 @@ let (js_str_int : FStarC_Json.json -> Prims.int) = fun uu___ -> match uu___ with | FStarC_Json.JsonInt i -> i - | FStarC_Json.JsonStr s -> FStarC_Compiler_Util.int_of_string s + | FStarC_Json.JsonStr s -> FStarC_Util.int_of_string s | other -> js_fail "string or int" other let (arg : Prims.string -> assoct -> FStarC_Json.json) = fun k -> @@ -107,16 +103,14 @@ let (uri_to_path : Prims.string -> Prims.string) = fun u -> let uu___ = let uu___1 = - FStarC_Compiler_Util.substring u (Prims.of_int (9)) - (Prims.of_int (3)) in + FStarC_Util.substring u (Prims.of_int (9)) (Prims.of_int (3)) in uu___1 = "%3A" in if uu___ then - let uu___1 = - FStarC_Compiler_Util.substring u (Prims.of_int (8)) Prims.int_one in - let uu___2 = FStarC_Compiler_Util.substring_from u (Prims.of_int (12)) in - FStarC_Compiler_Util.format2 "%s:%s" uu___1 uu___2 - else FStarC_Compiler_Util.substring_from u (Prims.of_int (7)) + let uu___1 = FStarC_Util.substring u (Prims.of_int (8)) Prims.int_one in + let uu___2 = FStarC_Util.substring_from u (Prims.of_int (12)) in + FStarC_Util.format2 "%s:%s" uu___1 uu___2 + else FStarC_Util.substring_from u (Prims.of_int (7)) type completion_context = { trigger_kind: Prims.int ; @@ -132,17 +126,15 @@ let (__proj__Mkcompletion_context__item__trigger_char : let (path_to_uri : Prims.string -> Prims.string) = fun u -> let uu___ = - let uu___1 = FStarC_Compiler_Util.char_at u Prims.int_one in - uu___1 = 58 in + let uu___1 = FStarC_Util.char_at u Prims.int_one in uu___1 = 58 in if uu___ then let rest = - let uu___1 = FStarC_Compiler_Util.substring_from u (Prims.of_int (2)) in - FStarC_Compiler_Util.replace_char uu___1 92 47 in - let uu___1 = - FStarC_Compiler_Util.substring u Prims.int_zero Prims.int_one in - FStarC_Compiler_Util.format2 "file:///%s%3A%s" uu___1 rest - else FStarC_Compiler_Util.format1 "file://%s" u + let uu___1 = FStarC_Util.substring_from u (Prims.of_int (2)) in + FStarC_Util.replace_char uu___1 92 47 in + let uu___1 = FStarC_Util.substring u Prims.int_zero Prims.int_one in + FStarC_Util.format2 "file:///%s%3A%s" uu___1 rest + else FStarC_Util.format1 "file://%s" u let (js_compl_context : FStarC_Json.json -> completion_context) = fun uu___ -> match uu___ with @@ -150,7 +142,7 @@ let (js_compl_context : FStarC_Json.json -> completion_context) = let uu___1 = let uu___2 = assoc "triggerKind" a in js_int uu___2 in let uu___2 = let uu___3 = try_assoc "triggerChar" a in - FStarC_Compiler_Util.map_option js_str uu___3 in + FStarC_Util.map_option js_str uu___3 in { trigger_kind = uu___1; trigger_char = uu___2 } | other -> js_fail "dictionary" other type txdoc_item = @@ -246,12 +238,12 @@ let (js_contentch : FStarC_Json.json -> Prims.string) = match uu___ with | FStarC_Json.JsonList l -> let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | FStarC_Json.JsonAssoc a -> let uu___3 = assoc "text" a in js_str uu___3) l in - FStarC_Compiler_List.hd uu___1 + FStarC_List.hd uu___1 | other -> js_fail "dictionary" other type lquery = | Initialize of (Prims.int * Prims.string) @@ -555,12 +547,11 @@ let (json_debug : FStarC_Json.json -> Prims.string) = match uu___ with | FStarC_Json.JsonNull -> "null" | FStarC_Json.JsonBool b -> - FStarC_Compiler_Util.format1 "bool (%s)" - (if b then "true" else "false") + FStarC_Util.format1 "bool (%s)" (if b then "true" else "false") | FStarC_Json.JsonInt i -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format1 "int (%s)" uu___1 - | FStarC_Json.JsonStr s -> FStarC_Compiler_Util.format1 "string (%s)" s + let uu___1 = FStarC_Util.string_of_int i in + FStarC_Util.format1 "int (%s)" uu___1 + | FStarC_Json.JsonStr s -> FStarC_Util.format1 "string (%s)" s | FStarC_Json.JsonList uu___1 -> "list (...)" | FStarC_Json.JsonAssoc uu___1 -> "dictionary (...)" let (wrap_jsfail : @@ -573,8 +564,8 @@ let (wrap_jsfail : let uu___ = let uu___1 = let uu___2 = json_debug got in - FStarC_Compiler_Util.format2 - "JSON decoding failed: expected %s, got %s" expected uu___2 in + FStarC_Util.format2 "JSON decoding failed: expected %s, got %s" + expected uu___2 in BadProtocolMsg uu___1 in { query_id = qid; q = uu___ } let (resultResponse : @@ -592,13 +583,13 @@ let (json_of_response : match qid with | FStar_Pervasives_Native.Some i -> FStarC_Json.JsonAssoc - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [("jsonrpc", (FStarC_Json.JsonStr "2.0")); ("id", (FStarC_Json.JsonInt i))] response) | FStar_Pervasives_Native.None -> FStarC_Json.JsonAssoc - (FStarC_Compiler_List.op_At - [("jsonrpc", (FStarC_Json.JsonStr "2.0"))] response) + (FStarC_List.op_At [("jsonrpc", (FStarC_Json.JsonStr "2.0"))] + response) let (js_resperr : error_code -> Prims.string -> FStarC_Json.json) = fun err -> fun msg -> @@ -635,38 +626,36 @@ let (js_servcap : FStarC_Json.json) = ("documentSymbolProvider", (FStarC_Json.JsonBool false)); ("workspaceSymbolProvider", (FStarC_Json.JsonBool false)); ("codeActionProvider", (FStarC_Json.JsonBool false))]))] -let (js_pos : FStarC_Compiler_Range_Type.pos -> FStarC_Json.json) = +let (js_pos : FStarC_Range_Type.pos -> FStarC_Json.json) = fun p -> let uu___ = let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Range_Ops.line_of_pos p in + let uu___4 = FStarC_Range_Ops.line_of_pos p in uu___4 - Prims.int_one in FStarC_Json.JsonInt uu___3 in ("line", uu___2) in let uu___2 = let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_Range_Ops.col_of_pos p in + let uu___5 = FStarC_Range_Ops.col_of_pos p in FStarC_Json.JsonInt uu___5 in ("character", uu___4) in [uu___3] in uu___1 :: uu___2 in FStarC_Json.JsonAssoc uu___ -let (js_range : FStarC_Compiler_Range_Type.range -> FStarC_Json.json) = +let (js_range : FStarC_Range_Type.range -> FStarC_Json.json) = fun r -> let uu___ = let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Range_Ops.start_of_range r in - js_pos uu___3 in + let uu___3 = FStarC_Range_Ops.start_of_range r in js_pos uu___3 in ("start", uu___2) in let uu___2 = let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_Range_Ops.end_of_range r in - js_pos uu___5 in + let uu___5 = FStarC_Range_Ops.end_of_range r in js_pos uu___5 in ("end", uu___4) in [uu___3] in uu___1 :: uu___2 in @@ -681,7 +670,7 @@ let (js_dummyrange : FStarC_Json.json) = (FStarC_Json.JsonAssoc [("line", (FStarC_Json.JsonInt Prims.int_zero)); ("character", (FStarC_Json.JsonInt Prims.int_zero))]))]))] -let (js_loclink : FStarC_Compiler_Range_Type.range -> FStarC_Json.json) = +let (js_loclink : FStarC_Range_Type.range -> FStarC_Json.json) = fun r -> let s = js_range r in let uu___ = @@ -690,7 +679,7 @@ let (js_loclink : FStarC_Compiler_Range_Type.range -> FStarC_Json.json) = let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_Range_Ops.file_of_range r in + let uu___6 = FStarC_Range_Ops.file_of_range r in path_to_uri uu___6 in FStarC_Json.JsonStr uu___5 in ("targetUri", uu___4) in @@ -703,8 +692,7 @@ let (pos_munge : txdoc_pos -> (Prims.string * Prims.int * Prims.int)) = let (js_diag : Prims.string -> Prims.string -> - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> - assoct) + FStarC_Range_Type.range FStar_Pervasives_Native.option -> assoct) = fun fname -> fun msg -> diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_Legacy.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Legacy.ml similarity index 78% rename from stage0/fstar-lib/generated/FStarC_Interactive_Legacy.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Legacy.ml index 09ecc7bf5ba..5240a5916e0 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_Legacy.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Legacy.ml @@ -227,112 +227,106 @@ let (__proj__Completions__item___0 : input_chunks -> Prims.string) = fun projectee -> match projectee with | Completions _0 -> _0 type interactive_state = { - chunk: FStarC_Compiler_Util.string_builder ; + chunk: FStarC_Util.string_builder ; stdin: - FStarC_Compiler_Util.stream_reader FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref + FStarC_Util.stream_reader FStar_Pervasives_Native.option + FStarC_Effect.ref ; - buffer: input_chunks Prims.list FStarC_Compiler_Effect.ref ; + buffer: input_chunks Prims.list FStarC_Effect.ref ; log: - FStarC_Compiler_Util.out_channel FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref - } + FStarC_Util.out_channel FStar_Pervasives_Native.option FStarC_Effect.ref } let (__proj__Mkinteractive_state__item__chunk : - interactive_state -> FStarC_Compiler_Util.string_builder) = + interactive_state -> FStarC_Util.string_builder) = fun projectee -> match projectee with | { chunk; stdin; buffer; log;_} -> chunk let (__proj__Mkinteractive_state__item__stdin : interactive_state -> - FStarC_Compiler_Util.stream_reader FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) + FStarC_Util.stream_reader FStar_Pervasives_Native.option + FStarC_Effect.ref) = fun projectee -> match projectee with | { chunk; stdin; buffer; log;_} -> stdin let (__proj__Mkinteractive_state__item__buffer : - interactive_state -> input_chunks Prims.list FStarC_Compiler_Effect.ref) = + interactive_state -> input_chunks Prims.list FStarC_Effect.ref) = fun projectee -> match projectee with | { chunk; stdin; buffer; log;_} -> buffer let (__proj__Mkinteractive_state__item__log : interactive_state -> - FStarC_Compiler_Util.out_channel FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) + FStarC_Util.out_channel FStar_Pervasives_Native.option FStarC_Effect.ref) = fun projectee -> match projectee with | { chunk; stdin; buffer; log;_} -> log let (the_interactive_state : interactive_state) = - let uu___ = FStarC_Compiler_Util.new_string_builder () in - let uu___1 = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in - let uu___2 = FStarC_Compiler_Util.mk_ref [] in - let uu___3 = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let uu___ = FStarC_Util.new_string_builder () in + let uu___1 = FStarC_Util.mk_ref FStar_Pervasives_Native.None in + let uu___2 = FStarC_Util.mk_ref [] in + let uu___3 = FStarC_Util.mk_ref FStar_Pervasives_Native.None in { chunk = uu___; stdin = uu___1; buffer = uu___2; log = uu___3 } let rec (read_chunk : unit -> input_chunks) = fun uu___ -> let s = the_interactive_state in let log = - let uu___1 = FStarC_Compiler_Debug.any () in + let uu___1 = FStarC_Debug.any () in if uu___1 then let transcript = - let uu___2 = FStarC_Compiler_Effect.op_Bang s.log in + let uu___2 = FStarC_Effect.op_Bang s.log in match uu___2 with | FStar_Pervasives_Native.Some transcript1 -> transcript1 | FStar_Pervasives_Native.None -> let transcript1 = - FStarC_Compiler_Util.open_file_for_writing "transcript" in - (FStarC_Compiler_Effect.op_Colon_Equals s.log + FStarC_Util.open_file_for_writing "transcript" in + (FStarC_Effect.op_Colon_Equals s.log (FStar_Pervasives_Native.Some transcript1); transcript1) in fun line -> - (FStarC_Compiler_Util.append_to_file transcript line; - FStarC_Compiler_Util.flush transcript) + (FStarC_Util.append_to_file transcript line; + FStarC_Util.flush transcript) else (fun uu___3 -> ()) in let stdin = - let uu___1 = FStarC_Compiler_Effect.op_Bang s.stdin in + let uu___1 = FStarC_Effect.op_Bang s.stdin in match uu___1 with | FStar_Pervasives_Native.Some i -> i | FStar_Pervasives_Native.None -> - let i = FStarC_Compiler_Util.open_stdin () in - (FStarC_Compiler_Effect.op_Colon_Equals s.stdin + let i = FStarC_Util.open_stdin () in + (FStarC_Effect.op_Colon_Equals s.stdin (FStar_Pervasives_Native.Some i); i) in let line = - let uu___1 = FStarC_Compiler_Util.read_line stdin in + let uu___1 = FStarC_Util.read_line stdin in match uu___1 with - | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.exit Prims.int_zero + | FStar_Pervasives_Native.None -> FStarC_Effect.exit Prims.int_zero | FStar_Pervasives_Native.Some l -> l in log line; - (let l = FStarC_Compiler_Util.trim_string line in - if FStarC_Compiler_Util.starts_with l "#end" + (let l = FStarC_Util.trim_string line in + if FStarC_Util.starts_with l "#end" then let responses = - match FStarC_Compiler_Util.split l " " with + match FStarC_Util.split l " " with | uu___2::ok::fail::[] -> (ok, fail) | uu___2 -> ("ok", "fail") in - let str = FStarC_Compiler_Util.string_of_string_builder s.chunk in - (FStarC_Compiler_Util.clear_string_builder s.chunk; - Code (str, responses)) + let str = FStarC_Util.string_of_string_builder s.chunk in + (FStarC_Util.clear_string_builder s.chunk; Code (str, responses)) else - if FStarC_Compiler_Util.starts_with l "#pop" - then (FStarC_Compiler_Util.clear_string_builder s.chunk; Pop l) + if FStarC_Util.starts_with l "#pop" + then (FStarC_Util.clear_string_builder s.chunk; Pop l) else - if FStarC_Compiler_Util.starts_with l "#push" + if FStarC_Util.starts_with l "#push" then - (FStarC_Compiler_Util.clear_string_builder s.chunk; + (FStarC_Util.clear_string_builder s.chunk; (let lc_lax = let uu___5 = - FStarC_Compiler_Util.substring_from l - (FStarC_Compiler_String.length "#push") in - FStarC_Compiler_Util.trim_string uu___5 in + FStarC_Util.substring_from l (FStarC_String.length "#push") in + FStarC_Util.trim_string uu___5 in let lc = - match FStarC_Compiler_Util.split lc_lax " " with + match FStarC_Util.split lc_lax " " with | l1::c::"#lax"::[] -> - let uu___5 = FStarC_Compiler_Util.int_of_string l1 in - let uu___6 = FStarC_Compiler_Util.int_of_string c in + let uu___5 = FStarC_Util.int_of_string l1 in + let uu___6 = FStarC_Util.int_of_string c in (true, uu___5, uu___6) | l1::c::[] -> - let uu___5 = FStarC_Compiler_Util.int_of_string l1 in - let uu___6 = FStarC_Compiler_Util.int_of_string c in + let uu___5 = FStarC_Util.int_of_string l1 in + let uu___6 = FStarC_Util.int_of_string c in (false, uu___5, uu___6) | uu___5 -> (FStarC_Errors.log_issue0 @@ -345,21 +339,19 @@ let rec (read_chunk : unit -> input_chunks) = (false, Prims.int_one, Prims.int_zero)) in Push lc)) else - if FStarC_Compiler_Util.starts_with l "#info " + if FStarC_Util.starts_with l "#info " then - (match FStarC_Compiler_Util.split l " " with + (match FStarC_Util.split l " " with | uu___5::symbol::[] -> - (FStarC_Compiler_Util.clear_string_builder s.chunk; + (FStarC_Util.clear_string_builder s.chunk; Info (symbol, true, FStar_Pervasives_Native.None)) | uu___5::symbol::file::row::col::[] -> - (FStarC_Compiler_Util.clear_string_builder s.chunk; + (FStarC_Util.clear_string_builder s.chunk; (let uu___7 = let uu___8 = let uu___9 = - let uu___10 = - FStarC_Compiler_Util.int_of_string row in - let uu___11 = - FStarC_Compiler_Util.int_of_string col in + let uu___10 = FStarC_Util.int_of_string row in + let uu___11 = FStarC_Util.int_of_string col in (file, uu___10, uu___11) in FStar_Pervasives_Native.Some uu___9 in (symbol, false, uu___8) in @@ -370,13 +362,13 @@ let rec (read_chunk : unit -> input_chunks) = (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic (Prims.strcat "Unrecognized \"#info\" request: " l)); - FStarC_Compiler_Effect.exit Prims.int_one)) + FStarC_Effect.exit Prims.int_one)) else - if FStarC_Compiler_Util.starts_with l "#completions " + if FStarC_Util.starts_with l "#completions " then - (match FStarC_Compiler_Util.split l " " with + (match FStarC_Util.split l " " with | uu___6::prefix::"#"::[] -> - (FStarC_Compiler_Util.clear_string_builder s.chunk; + (FStarC_Util.clear_string_builder s.chunk; Completions prefix) | uu___6 -> (FStarC_Errors.log_issue0 @@ -385,30 +377,29 @@ let rec (read_chunk : unit -> input_chunks) = (Obj.magic (Prims.strcat "Unrecognized \"#completions\" request: " l)); - FStarC_Compiler_Effect.exit Prims.int_one)) + FStarC_Effect.exit Prims.int_one)) else if l = "#finish" - then FStarC_Compiler_Effect.exit Prims.int_zero + then FStarC_Effect.exit Prims.int_zero else - (FStarC_Compiler_Util.string_builder_append s.chunk line; - FStarC_Compiler_Util.string_builder_append s.chunk "\n"; + (FStarC_Util.string_builder_append s.chunk line; + FStarC_Util.string_builder_append s.chunk "\n"; read_chunk ())) let (shift_chunk : unit -> input_chunks) = fun uu___ -> let s = the_interactive_state in - let uu___1 = FStarC_Compiler_Effect.op_Bang s.buffer in + let uu___1 = FStarC_Effect.op_Bang s.buffer in match uu___1 with | [] -> read_chunk () - | chunk::chunks -> - (FStarC_Compiler_Effect.op_Colon_Equals s.buffer chunks; chunk) + | chunk::chunks -> (FStarC_Effect.op_Colon_Equals s.buffer chunks; chunk) let (fill_buffer : unit -> unit) = fun uu___ -> let s = the_interactive_state in let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang s.buffer in + let uu___2 = FStarC_Effect.op_Bang s.buffer in let uu___3 = let uu___4 = read_chunk () in [uu___4] in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals s.buffer uu___1 + FStarC_List.op_At uu___2 uu___3 in + FStarC_Effect.op_Colon_Equals s.buffer uu___1 let (deps_of_our_file : Prims.string -> (Prims.string Prims.list * Prims.string FStar_Pervasives_Native.option * @@ -421,7 +412,7 @@ let (deps_of_our_file : match uu___ with | (deps, dep_graph) -> let uu___1 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun x -> let uu___2 = FStarC_Parser_Dep.lowercase_module_name x in let uu___3 = FStarC_Parser_Dep.lowercase_module_name filename in @@ -440,7 +431,7 @@ let (deps_of_our_file : if uu___3 then let uu___4 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Found %s and %s but not an interface + implementation" intf impl in FStarC_Errors.log_issue0 @@ -453,9 +444,8 @@ let (deps_of_our_file : | impl::[] -> FStar_Pervasives_Native.None | uu___2 -> ((let uu___4 = - FStarC_Compiler_Util.format1 - "Unexpected: ended up with %s" - (FStarC_Compiler_String.concat " " same_name) in + FStarC_Util.format1 "Unexpected: ended up with %s" + (FStarC_String.concat " " same_name) in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_UnexpectedFile () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -464,8 +454,8 @@ let (deps_of_our_file : (deps1, maybe_intf, dep_graph)) type m_timestamps = (Prims.string FStar_Pervasives_Native.option * Prims.string * - FStarC_Compiler_Util.time_of_day FStar_Pervasives_Native.option * - FStarC_Compiler_Util.time_of_day) Prims.list + FStarC_Util.time_of_day FStar_Pervasives_Native.option * + FStarC_Util.time_of_day) Prims.list let rec (tc_deps : modul_t -> stack_t -> @@ -520,14 +510,14 @@ let (update_deps : let is_stale intf impl intf_t impl_t = let impl_mt = FStarC_Parser_ParseIt.get_file_last_modification_time impl in - (FStarC_Compiler_Util.is_before impl_t impl_mt) || + (FStarC_Util.is_before impl_t impl_mt) || (match (intf, intf_t) with | (FStar_Pervasives_Native.Some intf1, FStar_Pervasives_Native.Some intf_t1) -> let intf_mt = FStarC_Parser_ParseIt.get_file_last_modification_time intf1 in - FStarC_Compiler_Util.is_before intf_t1 intf_mt + FStarC_Util.is_before intf_t1 intf_mt | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> false | (uu___, uu___1) -> @@ -556,9 +546,8 @@ let (update_deps : | uu___::ts3 -> (pop env1 ""; (let uu___2 = - let uu___3 = FStarC_Compiler_List.hd stack in - let uu___4 = FStarC_Compiler_List.tl stack in - (uu___3, uu___4) in + let uu___3 = FStarC_List.hd stack in + let uu___4 = FStarC_List.tl stack in (uu___3, uu___4) in match uu___2 with | ((env2, uu___3), stack1) -> pop_tc_and_stack env2 stack1 ts3)) in @@ -577,12 +566,12 @@ let (update_deps : then let env1 = pop_tc_and_stack env' - (FStarC_Compiler_List.rev_append st []) ts1 in + (FStarC_List.rev_append st []) ts1 in tc_deps m good_stack env1 depnames good_ts else (let uu___4 = - let uu___5 = FStarC_Compiler_List.hd st in - let uu___6 = FStarC_Compiler_List.tl st in + let uu___5 = FStarC_List.hd st in + let uu___6 = FStarC_List.tl st in (uu___5, uu___6) in match uu___4 with | (stack_elt, st') -> @@ -592,13 +581,13 @@ let (update_deps : let uu___ = deps_of_our_file filename in match uu___ with | (filenames, uu___1, dep_graph) -> - iterate filenames (FStarC_Compiler_List.rev_append stk []) - env (FStarC_Compiler_List.rev_append ts []) [] [] + iterate filenames (FStarC_List.rev_append stk []) env + (FStarC_List.rev_append ts []) [] [] let (format_info : FStarC_TypeChecker_Env.env -> Prims.string -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.string FStar_Pervasives_Native.option -> Prims.string) = fun env -> @@ -606,15 +595,15 @@ let (format_info : fun typ -> fun range -> fun doc -> - let uu___ = FStarC_Compiler_Range_Ops.string_of_range range in + let uu___ = FStarC_Range_Ops.string_of_range range in let uu___1 = FStarC_TypeChecker_Normalize.term_to_string env typ in let uu___2 = match doc with | FStar_Pervasives_Native.Some docstring -> - FStarC_Compiler_Util.format1 "#doc %s" docstring + FStarC_Util.format1 "#doc %s" docstring | FStar_Pervasives_Native.None -> "" in - FStarC_Compiler_Util.format4 "(defined at %s) %s: %s%s" uu___ - name uu___1 uu___2 + FStarC_Util.format4 "(defined at %s) %s: %s%s" uu___ name uu___1 + uu___2 let rec (go : (Prims.int * Prims.int) -> Prims.string -> stack_t -> modul_t -> env_t -> m_timestamps -> unit) @@ -643,9 +632,8 @@ let rec (go : else (let lid = let uu___2 = - FStarC_Compiler_List.map - FStarC_Ident.id_of_text - (FStarC_Compiler_Util.split symbol ".") in + FStarC_List.map FStarC_Ident.id_of_text + (FStarC_Util.split symbol ".") in FStarC_Ident.lid_of_ids uu___2 in let lid1 = if fqn_only @@ -659,7 +647,7 @@ let rec (go : | FStar_Pervasives_Native.Some lid2 -> lid2) in let uu___2 = FStarC_TypeChecker_Env.try_lookup_lid env lid1 in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun uu___3 -> match uu___3 with | ((uu___4, typ), r) -> @@ -667,7 +655,7 @@ let rec (go : uu___2) in ((match info_opt with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Util.print_string "\n#done-nok\n" + FStarC_Util.print_string "\n#done-nok\n" | FStar_Pervasives_Native.Some (name_or_lid, typ, rng) -> let uu___2 = match name_or_lid with @@ -679,8 +667,7 @@ let rec (go : (match uu___2 with | (name, doc) -> let uu___3 = format_info env name typ rng doc in - FStarC_Compiler_Util.print1 "%s\n#done-ok\n" - uu___3)); + FStarC_Util.print1 "%s\n#done-ok\n" uu___3)); go line_col filename stack curmod env ts) | Completions search_term -> let rec measure_anchored_match search_term1 candidate = @@ -690,23 +677,21 @@ let rec (go : | (uu___1, []) -> FStar_Pervasives_Native.None | (hs::ts1, hc::tc) -> let hc_text = FStarC_Ident.string_of_id hc in - if FStarC_Compiler_Util.starts_with hc_text hs + if FStarC_Util.starts_with hc_text hs then (match ts1 with | [] -> FStar_Pervasives_Native.Some - (candidate, - (FStarC_Compiler_String.length hs)) + (candidate, (FStarC_String.length hs)) | uu___1 -> let uu___2 = measure_anchored_match ts1 tc in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun uu___3 -> match uu___3 with | (matched, len) -> ((hc :: matched), - (((FStarC_Compiler_String.length - hc_text) - + Prims.int_one) + (((FStarC_String.length hc_text) + + Prims.int_one) + len))) uu___2) else FStar_Pervasives_Native.None in let rec locate_match needle candidate = @@ -719,22 +704,22 @@ let rec (go : | [] -> FStar_Pervasives_Native.None | hc::tc -> let uu___2 = locate_match needle tc in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun uu___3 -> match uu___3 with | (prefix, matched, len) -> ((hc :: prefix), matched, len)) uu___2) in let str_of_ids ids = let uu___1 = - FStarC_Compiler_List.map FStarC_Ident.string_of_id ids in - FStarC_Compiler_Util.concat_l "." uu___1 in + FStarC_List.map FStarC_Ident.string_of_id ids in + FStarC_Util.concat_l "." uu___1 in let match_lident_against needle lident = let uu___1 = let uu___2 = FStarC_Ident.ns_of_lid lident in let uu___3 = let uu___4 = FStarC_Ident.ident_of_lid lident in [uu___4] in - FStarC_Compiler_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___2 uu___3 in locate_match needle uu___1 in let shorten_namespace uu___1 = match uu___1 with @@ -761,10 +746,9 @@ let rec (go : else ((Prims.strcat prefix (Prims.strcat "." matched)), stripped_ns, - (((FStarC_Compiler_String.length prefix) + - match_len) - + Prims.int_one)) in - let needle = FStarC_Compiler_Util.split search_term "." in + (((FStarC_String.length prefix) + match_len) + + Prims.int_one)) in + let needle = FStarC_Util.split search_term "." in let all_lidents_in_env = FStarC_TypeChecker_Env.lidents env in let matches = let case_a_find_transitive_includes orig_ns m id = @@ -772,15 +756,15 @@ let rec (go : FStarC_Syntax_DsEnv.transitive_exported_ids env.FStarC_TypeChecker_Env.dsenv m in let matched_length = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun out -> fun s -> - ((FStarC_Compiler_String.length s) + out) + - Prims.int_one) - (FStarC_Compiler_String.length id) orig_ns in - FStarC_Compiler_List.filter_map + ((FStarC_String.length s) + out) + + Prims.int_one) (FStarC_String.length id) + orig_ns in + FStarC_List.filter_map (fun n -> - if FStarC_Compiler_Util.starts_with n id + if FStarC_Util.starts_with n id then let lid = let uu___1 = FStarC_Ident.ids_of_lid m in @@ -789,24 +773,24 @@ let rec (go : let uu___1 = FStarC_Syntax_DsEnv.resolve_to_fully_qualified_name env.FStarC_TypeChecker_Env.dsenv lid in - FStarC_Compiler_Option.map + FStarC_Option.map (fun fqn -> let uu___2 = let uu___3 = - FStarC_Compiler_List.map - FStarC_Ident.id_of_text orig_ns in + FStarC_List.map FStarC_Ident.id_of_text + orig_ns in let uu___4 = let uu___5 = FStarC_Ident.ident_of_lid fqn in [uu___5] in - FStarC_Compiler_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___3 uu___4 in ([], uu___2, matched_length)) uu___1 else FStar_Pervasives_Native.None) exported_names in let case_b_find_matches_in_env uu___1 = let matches1 = - FStarC_Compiler_List.filter_map - (match_lident_against needle) all_lidents_in_env in - FStarC_Compiler_List.filter + FStarC_List.filter_map (match_lident_against needle) + all_lidents_in_env in + FStarC_List.filter (fun uu___2 -> match uu___2 with | (ns, id, uu___3) -> @@ -819,10 +803,10 @@ let rec (go : | FStar_Pervasives_Native.Some l -> let uu___5 = FStarC_Ident.lid_of_ids - (FStarC_Compiler_List.op_At ns id) in + (FStarC_List.op_At ns id) in FStarC_Ident.lid_equals l uu___5)) matches1 in - let uu___1 = FStarC_Compiler_Util.prefix needle in + let uu___1 = FStarC_Util.prefix needle in match uu___1 with | (ns, id) -> let matched_ids = @@ -831,7 +815,7 @@ let rec (go : | uu___2 -> let l = FStarC_Ident.lid_of_path ns - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___3 = FStarC_Syntax_DsEnv.resolve_module_name env.FStarC_TypeChecker_Env.dsenv l true in @@ -840,31 +824,28 @@ let rec (go : case_b_find_matches_in_env () | FStar_Pervasives_Native.Some m -> case_a_find_transitive_includes ns m id) in - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___2 = shorten_namespace x in prepare_candidate uu___2) matched_ids in ((let uu___2 = - FStarC_Compiler_Util.sort_with + FStarC_Util.sort_with (fun uu___3 -> fun uu___4 -> match (uu___3, uu___4) with | ((cd1, ns1, uu___5), (cd2, ns2, uu___6)) -> - (match FStarC_Compiler_String.compare cd1 - cd2 - with + (match FStarC_String.compare cd1 cd2 with | uu___7 when uu___7 = Prims.int_zero -> - FStarC_Compiler_String.compare ns1 ns2 + FStarC_String.compare ns1 ns2 | n -> n)) matches in - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___3 -> match uu___3 with | (candidate, ns, match_len) -> - let uu___4 = - FStarC_Compiler_Util.string_of_int match_len in - FStarC_Compiler_Util.print3 "%s %s %s \n" uu___4 - ns candidate) uu___2); - FStarC_Compiler_Util.print_string "#done-ok\n"; + let uu___4 = FStarC_Util.string_of_int match_len in + FStarC_Util.print3 "%s %s %s \n" uu___4 ns + candidate) uu___2); + FStarC_Util.print_string "#done-ok\n"; go line_col filename stack curmod env ts) | Pop msg -> (pop env msg; @@ -876,16 +857,14 @@ let rec (go : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic "Too many pops"); - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) | hd::tl -> (hd, tl) in match uu___2 with | ((env1, curmod1), stack1) -> go line_col filename stack1 curmod1 env1 ts)) | Push (lax, l, c) -> let uu___1 = - if - (FStarC_Compiler_List.length stack) = - (FStarC_Compiler_List.length ts) + if (FStarC_List.length stack) = (FStarC_List.length ts) then let uu___2 = update_deps filename curmod stack env ts in (true, uu___2) @@ -900,7 +879,7 @@ let rec (go : | Code (text, (ok, fail)) -> let fail1 curmod1 tcenv = report_fail (); - FStarC_Compiler_Util.print1 "%s\n" fail; + FStarC_Util.print1 "%s\n" fail; go line_col filename stack curmod1 tcenv ts in let frag = { @@ -916,15 +895,14 @@ let rec (go : | FStar_Pervasives_Native.Some (curmod1, env1, n_errs) -> if n_errs = Prims.int_zero then - (FStarC_Compiler_Util.print1 "\n%s\n" ok; + (FStarC_Util.print1 "\n%s\n" ok; go line_col filename stack curmod1 env1 ts) else fail1 curmod1 env1 | uu___1 -> fail1 curmod env) let (interactive_mode : Prims.string -> unit) = fun filename -> (let uu___1 = - let uu___2 = FStarC_Options.codegen () in - FStarC_Compiler_Option.isSome uu___2 in + let uu___2 = FStarC_Options.codegen () in FStarC_Option.isSome uu___2 in if uu___1 then FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_IDEIgnoreCodeGen @@ -942,30 +920,20 @@ let (interactive_mode : Prims.string -> unit) = | (stack, env1, ts) -> let initial_range = let uu___3 = - FStarC_Compiler_Range_Type.mk_pos Prims.int_one - Prims.int_zero in + FStarC_Range_Type.mk_pos Prims.int_one Prims.int_zero in let uu___4 = - FStarC_Compiler_Range_Type.mk_pos Prims.int_one - Prims.int_zero in - FStarC_Compiler_Range_Type.mk_range filename uu___3 uu___4 in + FStarC_Range_Type.mk_pos Prims.int_one Prims.int_zero in + FStarC_Range_Type.mk_range filename uu___3 uu___4 in let env2 = FStarC_TypeChecker_Env.set_range env1 initial_range in let env3 = match maybe_intf with | FStar_Pervasives_Native.Some intf -> FStarC_Universal.load_interface_decls env2 intf | FStar_Pervasives_Native.None -> env2 in - let uu___3 = - (FStarC_Options.record_hints ()) || - (FStarC_Options.use_hints ()) in - if uu___3 - then - let uu___4 = - let uu___5 = FStarC_Options.file_list () in - FStarC_Compiler_List.hd uu___5 in - FStarC_SMTEncoding_Solver.with_hints_db uu___4 - (fun uu___5 -> - go (Prims.int_one, Prims.int_zero) filename stack - FStar_Pervasives_Native.None env3 ts) - else - go (Prims.int_one, Prims.int_zero) filename stack - FStar_Pervasives_Native.None env3 ts)) \ No newline at end of file + let fn = + let uu___3 = FStarC_Options.file_list () in + FStarC_List.hd uu___3 in + FStarC_SMTEncoding_Solver.with_hints_db fn + (fun uu___3 -> + go (Prims.int_one, Prims.int_zero) filename stack + FStar_Pervasives_Native.None env3 ts))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_Lsp.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Lsp.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_Interactive_Lsp.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Lsp.ml index 47e631734d8..9a45ee78ac7 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_Lsp.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_Lsp.ml @@ -6,8 +6,7 @@ let (unpack_lsp_query : fun r -> let qid = let uu___ = FStarC_Interactive_JsonHelper.try_assoc "id" r in - FStarC_Compiler_Util.map_option - FStarC_Interactive_JsonHelper.js_str_int uu___ in + FStarC_Util.map_option FStarC_Interactive_JsonHelper.js_str_int uu___ in try (fun uu___ -> match () with @@ -155,8 +154,7 @@ let (unpack_lsp_query : | "textDocument/foldingRange" -> FStarC_Interactive_JsonHelper.FoldingRange | m -> - let uu___2 = - FStarC_Compiler_Util.format1 "Unknown method '%s'" m in + let uu___2 = FStarC_Util.format1 "Unknown method '%s'" m in FStarC_Interactive_JsonHelper.BadProtocolMsg uu___2 in { FStarC_Interactive_JsonHelper.query_id = qid; @@ -202,14 +200,12 @@ let (repl_state_init : Prims.string -> FStarC_Interactive_Ide_Types.repl_state) = fun fname -> let intial_range = - let uu___ = - FStarC_Compiler_Range_Type.mk_pos Prims.int_one Prims.int_zero in - let uu___1 = - FStarC_Compiler_Range_Type.mk_pos Prims.int_one Prims.int_zero in - FStarC_Compiler_Range_Type.mk_range fname uu___ uu___1 in + let uu___ = FStarC_Range_Type.mk_pos Prims.int_one Prims.int_zero in + let uu___1 = FStarC_Range_Type.mk_pos Prims.int_one Prims.int_zero in + FStarC_Range_Type.mk_range fname uu___ uu___1 in let env = FStarC_Universal.init_env FStarC_Parser_Dep.empty_deps in let env1 = FStarC_TypeChecker_Env.set_range env intial_range in - let uu___ = FStarC_Compiler_Util.open_stdin () in + let uu___ = FStarC_Util.open_stdin () in { FStarC_Interactive_Ide_Types.repl_line = Prims.int_one; FStarC_Interactive_Ide_Types.repl_column = Prims.int_zero; @@ -245,10 +241,10 @@ let (invoke_full_lax : match uu___2 with | (diag, st') -> let repls = - FStarC_Compiler_Util.psmap_add + FStarC_Util.psmap_add gst.FStarC_Interactive_Ide_Types.grepl_repls fname st' in let diag1 = - if FStarC_Compiler_Util.is_some diag + if FStarC_Util.is_some diag then diag else (let uu___4 = @@ -262,7 +258,7 @@ let (invoke_full_lax : (gst.FStarC_Interactive_Ide_Types.grepl_stdin) }))) in let uu___ = - FStarC_Compiler_Util.psmap_try_find + FStarC_Util.psmap_try_find gst.FStarC_Interactive_Ide_Types.grepl_repls fname in match uu___ with | FStar_Pervasives_Native.Some uu___1 -> @@ -326,7 +322,7 @@ let (run_query : (FStar_Pervasives_Native.None, (FStar_Pervasives.Inl gst)) | FStarC_Interactive_JsonHelper.Completion (txpos, ctx) -> let uu___ = - FStarC_Compiler_Util.psmap_try_find + FStarC_Util.psmap_try_find gst.FStarC_Interactive_Ide_Types.grepl_repls txpos.FStarC_Interactive_JsonHelper.path in (match uu___ with @@ -342,7 +338,7 @@ let (run_query : (FStar_Pervasives.Inl gst)) | FStarC_Interactive_JsonHelper.Hover txpos -> let uu___ = - FStarC_Compiler_Util.psmap_try_find + FStarC_Util.psmap_try_find gst.FStarC_Interactive_Ide_Types.grepl_repls txpos.FStarC_Interactive_JsonHelper.path in (match uu___ with @@ -362,7 +358,7 @@ let (run_query : (FStar_Pervasives.Inl gst)) | FStarC_Interactive_JsonHelper.Definition txpos -> let uu___ = - FStarC_Compiler_Util.psmap_try_find + FStarC_Util.psmap_try_find gst.FStarC_Interactive_Ide_Types.grepl_repls txpos.FStarC_Interactive_JsonHelper.path in (match uu___ with @@ -436,59 +432,54 @@ let (run_query : FStarC_Interactive_JsonHelper.errorResponse uu___1 in (uu___, (FStar_Pervasives.Inl gst)) let rec (parse_header_len : - FStarC_Compiler_Util.stream_reader -> Prims.int -> Prims.int) = + FStarC_Util.stream_reader -> Prims.int -> Prims.int) = fun stream -> fun len -> - let uu___ = FStarC_Compiler_Util.read_line stream in + let uu___ = FStarC_Util.read_line stream in match uu___ with | FStar_Pervasives_Native.Some s -> - if FStarC_Compiler_Util.starts_with s "Content-Length: " + if FStarC_Util.starts_with s "Content-Length: " then let uu___1 = - let uu___2 = - FStarC_Compiler_Util.substring_from s (Prims.of_int (16)) in - FStarC_Compiler_Util.safe_int_of_string uu___2 in + let uu___2 = FStarC_Util.substring_from s (Prims.of_int (16)) in + FStarC_Util.safe_int_of_string uu___2 in (match uu___1 with | FStar_Pervasives_Native.Some new_len -> parse_header_len stream new_len | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.raise + FStarC_Effect.raise FStarC_Interactive_JsonHelper.MalformedHeader) else - if FStarC_Compiler_Util.starts_with s "Content-Type: " + if FStarC_Util.starts_with s "Content-Type: " then parse_header_len stream len else if s = "" then len else - FStarC_Compiler_Effect.raise + FStarC_Effect.raise FStarC_Interactive_JsonHelper.MalformedHeader | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.raise - FStarC_Interactive_JsonHelper.InputExhausted + FStarC_Effect.raise FStarC_Interactive_JsonHelper.InputExhausted let rec (read_lsp_query : - FStarC_Compiler_Util.stream_reader -> - FStarC_Interactive_JsonHelper.lsp_query) - = + FStarC_Util.stream_reader -> FStarC_Interactive_JsonHelper.lsp_query) = fun stream -> try (fun uu___ -> match () with | () -> let n = parse_header_len stream Prims.int_zero in - let uu___1 = FStarC_Compiler_Util.nread stream n in + let uu___1 = FStarC_Util.nread stream n in (match uu___1 with | FStar_Pervasives_Native.Some s -> parse_lsp_query s | FStar_Pervasives_Native.None -> let uu___2 = - let uu___3 = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "Could not read %s bytes" - uu___3 in + let uu___3 = FStarC_Util.string_of_int n in + FStarC_Util.format1 "Could not read %s bytes" uu___3 in FStarC_Interactive_JsonHelper.wrap_content_szerr uu___2)) () with | FStarC_Interactive_JsonHelper.MalformedHeader -> - (FStarC_Compiler_Util.print_error "[E] Malformed Content Header\n"; + (FStarC_Util.print_error "[E] Malformed Content Header\n"; read_lsp_query stream) | FStarC_Interactive_JsonHelper.InputExhausted -> read_lsp_query stream let rec (go : FStarC_Interactive_Ide_Types.grepl_state -> Prims.int) = @@ -511,11 +502,11 @@ let (start_server : unit -> unit) = fun uu___ -> let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Util.psmap_empty () in - let uu___4 = FStarC_Compiler_Util.open_stdin () in + let uu___3 = FStarC_Util.psmap_empty () in + let uu___4 = FStarC_Util.open_stdin () in { FStarC_Interactive_Ide_Types.grepl_repls = uu___3; FStarC_Interactive_Ide_Types.grepl_stdin = uu___4 } in go uu___2 in - FStarC_Compiler_Effect.exit uu___1 \ No newline at end of file + FStarC_Effect.exit uu___1 \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_PushHelper.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_PushHelper.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_Interactive_PushHelper.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_PushHelper.ml index b45eaa2717c..28ba5a47707 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_PushHelper.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_PushHelper.ml @@ -39,8 +39,8 @@ let (__proj__NTBinding__item___0 : FStar_Pervasives.either) = fun projectee -> match projectee with | NTBinding _0 -> _0 let (repl_stack : - FStarC_Interactive_Ide_Types.repl_stack_t FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref [] + FStarC_Interactive_Ide_Types.repl_stack_t FStarC_Effect.ref) = + FStarC_Util.mk_ref [] let (set_check_kind : FStarC_TypeChecker_Env.env_t -> FStarC_Interactive_Ide_Types.push_kind -> FStarC_TypeChecker_Env.env_t) @@ -153,7 +153,7 @@ let (repl_ld_tasks_of_deps : fun deps -> fun final_tasks -> let wrap fname = - let uu___ = FStarC_Compiler_Util.get_time_of_day () in + let uu___ = FStarC_Util.get_time_of_day () in { FStarC_Interactive_Ide_Types.tf_fname = fname; FStarC_Interactive_Ide_Types.tf_modtime = uu___ @@ -190,7 +190,7 @@ let (deps_and_repl_ld_tasks_of_our_file : FStarC_Dependencies.find_deps_if_needed [filename] parse_data_cache in match uu___ with | (deps, dep_graph) -> - let uu___1 = FStarC_Compiler_List.partition has_our_mod_name deps in + let uu___1 = FStarC_List.partition has_our_mod_name deps in (match uu___1 with | (same_name, real_deps) -> let intf_tasks = @@ -202,8 +202,8 @@ let (deps_and_repl_ld_tasks_of_our_file : if uu___3 then let uu___4 = - FStarC_Compiler_Util.format1 - "Expecting an interface, got %s" intf in + FStarC_Util.format1 "Expecting an interface, got %s" + intf in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_MissingInterface () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -215,7 +215,7 @@ let (deps_and_repl_ld_tasks_of_our_file : if uu___4 then let uu___5 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Expecting an implementation, got %s" impl in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_MissingImplementation () @@ -224,7 +224,7 @@ let (deps_and_repl_ld_tasks_of_our_file : else ()); (let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_Util.get_time_of_day () in + let uu___6 = FStarC_Util.get_time_of_day () in { FStarC_Interactive_Ide_Types.tf_fname = intf; FStarC_Interactive_Ide_Types.tf_modtime = uu___6 @@ -234,11 +234,10 @@ let (deps_and_repl_ld_tasks_of_our_file : [uu___4])) | impl::[] -> [] | uu___2 -> - let mods_str = FStarC_Compiler_String.concat " " same_name in + let mods_str = FStarC_String.concat " " same_name in let message = "Too many or too few files matching %s: %s" in ((let uu___4 = - FStarC_Compiler_Util.format message - [our_mod_name; mods_str] in + FStarC_Util.format message [our_mod_name; mods_str] in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TooManyOrTooFewFileMatch () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -276,9 +275,9 @@ let (push_repl : match uu___ with | (depth, env) -> ((let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang repl_stack in + let uu___3 = FStarC_Effect.op_Bang repl_stack in (depth, (task, st)) :: uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals repl_stack uu___2); + FStarC_Effect.op_Colon_Equals repl_stack uu___2); (match push_kind_opt with | FStar_Pervasives_Native.None -> st | FStar_Pervasives_Native.Some push_kind -> @@ -307,16 +306,15 @@ let (push_repl : })) let (add_issues_to_push_fragment : FStarC_Json.json Prims.list -> unit) = fun issues -> - let uu___ = FStarC_Compiler_Effect.op_Bang repl_stack in + let uu___ = FStarC_Effect.op_Bang repl_stack in match uu___ with | (depth, (FStarC_Interactive_Ide_Types.PushFragment (frag, push_kind, i), st))::rest -> let pf = FStarC_Interactive_Ide_Types.PushFragment - (frag, push_kind, (FStarC_Compiler_List.op_At issues i)) in - FStarC_Compiler_Effect.op_Colon_Equals repl_stack ((depth, (pf, st)) - :: rest) + (frag, push_kind, (FStarC_List.op_At issues i)) in + FStarC_Effect.op_Colon_Equals repl_stack ((depth, (pf, st)) :: rest) | uu___1 -> () let (rollback_env : FStarC_TypeChecker_Env.solver_t -> @@ -341,7 +339,7 @@ let (pop_repl : = fun msg -> fun st -> - let uu___ = FStarC_Compiler_Effect.op_Bang repl_stack in + let uu___ = FStarC_Effect.op_Bang repl_stack in match uu___ with | [] -> failwith "Too many pops" | (depth, (uu___1, st'))::stack_tl -> @@ -349,9 +347,9 @@ let (pop_repl : rollback_env (st.FStarC_Interactive_Ide_Types.repl_env).FStarC_TypeChecker_Env.solver msg depth in - (FStarC_Compiler_Effect.op_Colon_Equals repl_stack stack_tl; + (FStarC_Effect.op_Colon_Equals repl_stack stack_tl; (let uu___4 = - FStarC_Compiler_Util.physical_equality env + FStarC_Util.physical_equality env st'.FStarC_Interactive_Ide_Types.repl_env in FStarC_Common.runtime_assert uu___4 "Inconsistent stack state"); st') @@ -411,14 +409,14 @@ let (run_repl_task : | FStarC_Interactive_Ide_Types.Noop -> (curmod, env, []) let (query_of_ids : FStarC_Ident.ident Prims.list -> FStarC_Interactive_CompletionTable.query) - = fun ids -> FStarC_Compiler_List.map FStarC_Ident.string_of_id ids + = fun ids -> FStarC_List.map FStarC_Ident.string_of_id ids let (query_of_lid : FStarC_Ident.lident -> FStarC_Interactive_CompletionTable.query) = fun lid -> let uu___ = let uu___1 = FStarC_Ident.ns_of_lid lid in let uu___2 = let uu___3 = FStarC_Ident.ident_of_lid lid in [uu___3] in - FStarC_Compiler_List.op_At uu___1 uu___2 in + FStarC_List.op_At uu___1 uu___2 in query_of_ids uu___ let (update_names_from_event : Prims.string -> @@ -462,7 +460,7 @@ let (update_names_from_event : (lid, uu___)) -> [lid] | FStar_Pervasives.Inr (lids1, uu___) -> lids1 | uu___ -> [] in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun tbl -> fun lid -> let ns_query = @@ -495,7 +493,7 @@ let (commit_name_tracking' : let uu___ = FStarC_Syntax_Syntax.mod_name md in FStarC_Ident.string_of_lid uu___ in let updater = update_names_from_event cur_mod_str in - FStarC_Compiler_List.fold_left updater names name_events + FStarC_List.fold_left updater names name_events let (commit_name_tracking : FStarC_Interactive_Ide_Types.repl_state -> name_tracking_event Prims.list -> FStarC_Interactive_Ide_Types.repl_state) @@ -528,15 +526,14 @@ let (commit_name_tracking : } let (fresh_name_tracking_hooks : unit -> - (name_tracking_event Prims.list FStarC_Compiler_Effect.ref * + (name_tracking_event Prims.list FStarC_Effect.ref * FStarC_Syntax_DsEnv.dsenv_hooks * FStarC_TypeChecker_Env.tcenv_hooks)) = fun uu___ -> - let events = FStarC_Compiler_Util.mk_ref [] in + let events = FStarC_Util.mk_ref [] in let push_event evt = - let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang events in evt :: uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals events uu___1 in + let uu___1 = let uu___2 = FStarC_Effect.op_Bang events in evt :: uu___2 in + FStarC_Effect.op_Colon_Equals events uu___1 in let uu___1 = FStarC_Syntax_DsEnv.mk_dsenv_hooks (fun dsenv -> @@ -598,8 +595,8 @@ let (track_name_changes : ((fun env1 -> let uu___3 = set_hooks old_dshooks old_tchooks env1 in let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang events in - FStarC_Compiler_List.rev uu___5 in + let uu___5 = FStarC_Effect.op_Bang events in + FStarC_List.rev uu___5 in (uu___3, uu___4))))) let (repl_tx : FStarC_Interactive_Ide_Types.repl_state -> @@ -650,8 +647,7 @@ let (repl_tx : = (st1.FStarC_Interactive_Ide_Types.repl_buffered_input_queries); FStarC_Interactive_Ide_Types.repl_lang = - (FStarC_Compiler_List.op_At - (FStarC_Compiler_List.rev lds) + (FStarC_List.op_At (FStarC_List.rev lds) st1.FStarC_Interactive_Ide_Types.repl_lang) } in let uu___3 = finish_name_tracking env1 in @@ -661,7 +657,7 @@ let (repl_tx : commit_name_tracking st2 name_events in (FStar_Pervasives_Native.None, uu___4))))) () with - | FStarC_Compiler_Effect.Failure msg -> + | FStarC_Effect.Failure msg -> let uu___1 = let uu___2 = FStarC_Interactive_JsonHelper.js_diag @@ -669,8 +665,8 @@ let (repl_tx : FStar_Pervasives_Native.None in FStar_Pervasives_Native.Some uu___2 in (uu___1, st) - | FStarC_Compiler_Util.SigInt -> - (FStarC_Compiler_Util.print_error "[E] Interrupt"; + | FStarC_Util.SigInt -> + (FStarC_Util.print_error "[E] Interrupt"; (FStar_Pervasives_Native.None, st)) | FStarC_Errors.Error (e, msg, r, _ctx) -> let uu___1 = @@ -682,7 +678,7 @@ let (repl_tx : FStar_Pervasives_Native.Some uu___2 in (uu___1, st) | FStarC_Errors.Stop -> - (FStarC_Compiler_Util.print_error "[E] Stop"; + (FStarC_Util.print_error "[E] Stop"; (FStar_Pervasives_Native.None, st)) let (tf_of_fname : Prims.string -> FStarC_Interactive_Ide_Types.timed_fname) = @@ -762,10 +758,10 @@ let (repl_ldtx : timestamped_task in (match uu___ with | (diag, st2) -> - if Prims.op_Negation (FStarC_Compiler_Util.is_some diag) + if Prims.op_Negation (FStarC_Util.is_some diag) then let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang repl_stack in + let uu___2 = FStarC_Effect.op_Bang repl_stack in { FStarC_Interactive_Ide_Types.repl_line = (st2.FStarC_Interactive_Ide_Types.repl_line); @@ -798,8 +794,7 @@ let (repl_ldtx : | (tasks2, previous1) -> let uu___ = revert_many st1 previous1 in aux uu___ tasks2 [] in aux st tasks - (FStarC_Compiler_List.rev - st.FStarC_Interactive_Ide_Types.repl_deps_stack) + (FStarC_List.rev st.FStarC_Interactive_Ide_Types.repl_deps_stack) let (ld_deps : FStarC_Interactive_Ide_Types.repl_state -> ((FStarC_Interactive_Ide_Types.repl_state * Prims.string Prims.list), @@ -849,13 +844,12 @@ let (ld_deps : with | FStarC_Errors.Error (e, msg, _rng, ctx) -> ((let uu___2 = FStarC_Errors_Msg.rendermsg msg in - FStarC_Compiler_Util.print1_error "[E] Failed to load deps. %s" - uu___2); + FStarC_Util.print1_error "[E] Failed to load deps. %s" uu___2); FStar_Pervasives.Inr st) | exn -> - ((let uu___2 = FStarC_Compiler_Util.message_of_exn exn in - FStarC_Compiler_Util.print1_error - "[E] Failed to load deps. Message: %s" uu___2); + ((let uu___2 = FStarC_Util.message_of_exn exn in + FStarC_Util.print1_error "[E] Failed to load deps. Message: %s" + uu___2); FStar_Pervasives.Inr st) let (add_module_completions : Prims.string -> @@ -871,42 +865,40 @@ let (add_module_completions : then str else (let first = - FStarC_Compiler_String.substring str Prims.int_zero - Prims.int_one in + FStarC_String.substring str Prims.int_zero Prims.int_one in let uu___1 = - FStarC_Compiler_String.substring str Prims.int_one - ((FStarC_Compiler_String.length str) - Prims.int_one) in - Prims.strcat (FStarC_Compiler_String.uppercase first) uu___1) in + FStarC_String.substring str Prims.int_one + ((FStarC_String.length str) - Prims.int_one) in + Prims.strcat (FStarC_String.uppercase first) uu___1) in let mods = FStarC_Parser_Dep.build_inclusion_candidates_list () in let loaded_mods_set = - let uu___ = FStarC_Compiler_Util.psmap_empty () in + let uu___ = FStarC_Util.psmap_empty () in let uu___1 = let uu___2 = FStarC_Basefiles.prims () in uu___2 :: deps in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun dep -> let uu___2 = FStarC_Parser_Dep.lowercase_module_name dep in - FStarC_Compiler_Util.psmap_add acc uu___2 true) uu___ uu___1 in + FStarC_Util.psmap_add acc uu___2 true) uu___ uu___1 in let loaded modname = - FStarC_Compiler_Util.psmap_find_default loaded_mods_set modname - false in + FStarC_Util.psmap_find_default loaded_mods_set modname false in let this_mod_key = FStarC_Parser_Dep.lowercase_module_name this_fname in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun table1 -> fun uu___ -> match uu___ with | (modname, mod_path) -> - let mod_key = FStarC_Compiler_String.lowercase modname in + let mod_key = FStarC_String.lowercase modname in if this_mod_key = mod_key then table1 else (let ns_query = let uu___2 = capitalize modname in - FStarC_Compiler_Util.split uu___2 "." in + FStarC_Util.split uu___2 "." in let uu___2 = loaded mod_key in FStarC_Interactive_CompletionTable.register_module_path table1 uu___2 mod_path ns_query)) table - (FStarC_Compiler_List.rev mods) + (FStarC_List.rev mods) let (full_lax : Prims.string -> FStarC_Interactive_Ide_Types.repl_state -> diff --git a/stage0/fstar-lib/generated/FStarC_Interactive_QueryHelper.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_QueryHelper.ml similarity index 86% rename from stage0/fstar-lib/generated/FStarC_Interactive_QueryHelper.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_QueryHelper.ml index f09de694ab1..91793cab20e 100644 --- a/stage0/fstar-lib/generated/FStarC_Interactive_QueryHelper.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Interactive_QueryHelper.ml @@ -3,8 +3,7 @@ type position = (Prims.string * Prims.int * Prims.int) type sl_reponse = { slr_name: Prims.string ; - slr_def_range: - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option ; + slr_def_range: FStarC_Range_Type.range FStar_Pervasives_Native.option ; slr_typ: Prims.string FStar_Pervasives_Native.option ; slr_doc: Prims.string FStar_Pervasives_Native.option ; slr_def: Prims.string FStar_Pervasives_Native.option } @@ -13,9 +12,7 @@ let (__proj__Mksl_reponse__item__slr_name : sl_reponse -> Prims.string) = match projectee with | { slr_name; slr_def_range; slr_typ; slr_doc; slr_def;_} -> slr_name let (__proj__Mksl_reponse__item__slr_def_range : - sl_reponse -> - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option) - = + sl_reponse -> FStarC_Range_Type.range FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { slr_name; slr_def_range; slr_typ; slr_doc; slr_def;_} -> @@ -73,16 +70,16 @@ let (symlookup : let info_of_lid_str lid_str = let lid = let uu___ = - FStarC_Compiler_List.map FStarC_Ident.id_of_text - (FStarC_Compiler_Util.split lid_str ".") in + FStarC_List.map FStarC_Ident.id_of_text + (FStarC_Util.split lid_str ".") in FStarC_Ident.lid_of_ids uu___ in let lid1 = let uu___ = FStarC_Syntax_DsEnv.resolve_to_fully_qualified_name tcenv.FStarC_TypeChecker_Env.dsenv lid in - FStarC_Compiler_Util.dflt lid uu___ in + FStarC_Util.dflt lid uu___ in let uu___ = FStarC_TypeChecker_Env.try_lookup_lid tcenv lid1 in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun uu___1 -> match uu___1 with | ((uu___2, typ), r) -> @@ -90,7 +87,7 @@ let (symlookup : let docs_of_lid lid = FStar_Pervasives_Native.None in let def_of_lid lid = let uu___ = FStarC_TypeChecker_Env.lookup_qname tcenv lid in - FStarC_Compiler_Util.bind_opt uu___ + FStarC_Util.bind_opt uu___ (fun uu___1 -> match uu___1 with | (FStar_Pervasives.Inr (se, uu___2), uu___3) -> @@ -98,7 +95,7 @@ let (symlookup : FStar_Pervasives_Native.Some uu___4 | uu___2 -> FStar_Pervasives_Native.None) in let info_at_pos_opt = - FStarC_Compiler_Util.bind_opt pos_opt + FStarC_Util.bind_opt pos_opt (fun uu___ -> match uu___ with | (file, row, col) -> @@ -122,7 +119,7 @@ let (symlookup : | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some s -> s in let typ_str = - if FStarC_Compiler_List.mem "type" requested_info + if FStarC_List.mem "type" requested_info then let uu___ = term_to_string tcenv typ in FStar_Pervasives_Native.Some uu___ @@ -130,17 +127,17 @@ let (symlookup : let doc_str = match name_or_lid with | FStar_Pervasives.Inr lid when - FStarC_Compiler_List.mem "documentation" requested_info - -> docs_of_lid lid + FStarC_List.mem "documentation" requested_info -> + docs_of_lid lid | uu___ -> FStar_Pervasives_Native.None in let def_str = match name_or_lid with | FStar_Pervasives.Inr lid when - FStarC_Compiler_List.mem "definition" requested_info -> + FStarC_List.mem "definition" requested_info -> def_of_lid lid | uu___ -> FStar_Pervasives_Native.None in let def_range = - if FStarC_Compiler_List.mem "defined-at" requested_info + if FStarC_List.mem "defined-at" requested_info then FStar_Pervasives_Native.Some rng else FStar_Pervasives_Native.None in FStar_Pervasives_Native.Some @@ -190,14 +187,14 @@ let (ck_completion : = fun st -> fun search_term -> - let needle = FStarC_Compiler_Util.split search_term "." in + let needle = FStarC_Util.split search_term "." in let mods_and_nss = FStarC_Interactive_CompletionTable.autocomplete_mod_or_ns st.FStarC_Interactive_Ide_Types.repl_names needle mod_filter in let lids = FStarC_Interactive_CompletionTable.autocomplete_lid st.FStarC_Interactive_Ide_Types.repl_names needle in - FStarC_Compiler_List.op_At lids mods_and_nss + FStarC_List.op_At lids mods_and_nss let (deflookup : FStarC_TypeChecker_Env.env -> FStarC_Interactive_JsonHelper.txdoc_pos -> @@ -238,8 +235,8 @@ let (hoverlookup : slr_def = FStar_Pervasives_Native.Some d;_} -> let hovertxt = - FStarC_Compiler_Util.format2 - "```fstar\n%s\n````\n---\n```fstar\n%s\n```" t d in + FStarC_Util.format2 "```fstar\n%s\n````\n---\n```fstar\n%s\n```" + t d in FStarC_Interactive_JsonHelper.resultResponse (FStarC_Json.JsonAssoc [("contents", @@ -264,14 +261,11 @@ let (complookup : match l with | [] -> Prims.int_zero | h::t -> - if - (h = 32) && - ((FStarC_Compiler_List.length t) < current_col) - then (FStarC_Compiler_List.length t) + Prims.int_one + if (h = 32) && ((FStarC_List.length t) < current_col) + then (FStarC_List.length t) + Prims.int_one else find_col t in let str = - FStarC_Compiler_List.nth - (FStarC_Compiler_Util.splitlines text) + FStarC_List.nth (FStarC_Util.splitlines text) (row - Prims.int_one) in let explode s = let rec exp i l = @@ -279,21 +273,19 @@ let (complookup : then l else (let uu___4 = - let uu___5 = FStarC_Compiler_String.get s i in uu___5 - :: l in + let uu___5 = FStarC_String.get s i in uu___5 :: l in exp (i - Prims.int_one) uu___4) in - exp ((FStarC_Compiler_String.length s) - Prims.int_one) [] in + exp ((FStarC_String.length s) - Prims.int_one) [] in let begin_col = let uu___3 = - let uu___4 = explode str in - FStarC_Compiler_List.rev uu___4 in + let uu___4 = explode str in FStarC_List.rev uu___4 in find_col uu___3 in let term = - FStarC_Compiler_Util.substring str begin_col + FStarC_Util.substring str begin_col (current_col - begin_col) in let items = ck_completion st term in let l = - FStarC_Compiler_List.map + FStarC_List.map (fun r -> FStarC_Json.JsonAssoc [("label", diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_MachineInts.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_MachineInts.ml similarity index 97% rename from stage0/fstar-lib/generated/FStarC_Compiler_MachineInts.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_MachineInts.ml index 0db9159bfce..ade04f13924 100644 --- a/stage0/fstar-lib/generated/FStarC_Compiler_MachineInts.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_MachineInts.ml @@ -97,7 +97,7 @@ let (int_to_t_lid_for : machint_kind -> FStarC_Ident.lid) = [uu___3] in uu___1 :: uu___2 in "FStar" :: uu___ in - FStarC_Ident.lid_of_path path FStarC_Compiler_Range_Type.dummyRange + FStarC_Ident.lid_of_path path FStarC_Range_Type.dummyRange let (int_to_t_for : machint_kind -> FStarC_Syntax_Syntax.term) = fun k -> let lid = int_to_t_lid_for k in @@ -114,7 +114,7 @@ let (__int_to_t_lid_for : machint_kind -> FStarC_Ident.lid) = [uu___3] in uu___1 :: uu___2 in "FStar" :: uu___ in - FStarC_Ident.lid_of_path path FStarC_Compiler_Range_Type.dummyRange + FStarC_Ident.lid_of_path path FStarC_Range_Type.dummyRange let (__int_to_t_for : machint_kind -> FStarC_Syntax_Syntax.term) = fun k -> let lid = __int_to_t_lid_for k in @@ -249,8 +249,7 @@ let (e_machint : let uu___2 = let uu___3 = let uu___4 = module_name_for k in [uu___4; "t"] in "FStar" :: uu___3 in - FStarC_Ident.lid_of_path uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path uu___2 FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.fvar uu___1 FStar_Pervasives_Native.None) (fun uu___ -> "boundedint") (fun uu___ -> FStarC_Syntax_Syntax.ET_abstract) @@ -336,8 +335,7 @@ let (nbe_machint : let uu___3 = let uu___4 = let uu___5 = module_name_for k in [uu___5; "t"] in "FStar" :: uu___4 in - FStarC_Ident.lid_of_path uu___3 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path uu___3 FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.lid_as_fv uu___2 FStar_Pervasives_Native.None in FStarC_TypeChecker_NBETerm.mkFV uu___1 [] []) (fun uu___ -> FStarC_Syntax_Syntax.ET_abstract) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Main.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Main.ml similarity index 59% rename from stage0/fstar-lib/generated/FStarC_Main.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Main.ml index 543e86f3b79..328307c7249 100644 --- a/stage0/fstar-lib/generated/FStarC_Main.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Main.ml @@ -3,20 +3,19 @@ let (uu___0 : unit) = FStarC_Version.dummy () let (process_args : unit -> (FStarC_Getopt.parse_cmdline_res * Prims.string Prims.list)) = fun uu___ -> FStarC_Options.parse_cmd_line () -let (cleanup : unit -> unit) = fun uu___ -> FStarC_Compiler_Util.kill_all () let (finished_message : (Prims.bool * FStarC_Ident.lident) Prims.list -> Prims.int -> unit) = fun fmods -> fun errs -> let print_to = if errs > Prims.int_zero - then FStarC_Compiler_Util.print_error - else FStarC_Compiler_Util.print_string in + then FStarC_Util.print_error + else FStarC_Util.print_string in let uu___ = let uu___1 = FStarC_Options.silent () in Prims.op_Negation uu___1 in if uu___ then - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun uu___2 -> match uu___2 with | (iface, name) -> @@ -29,43 +28,38 @@ let (finished_message : then let uu___4 = let uu___5 = FStarC_Ident.string_of_lid name in - FStarC_Compiler_Util.format2 "Verified %s: %s\n" tag - uu___5 in + FStarC_Util.format2 "Verified %s: %s\n" tag uu___5 in print_to uu___4 else ()) fmods; if errs > Prims.int_zero then (if errs = Prims.int_one - then - FStarC_Compiler_Util.print_error - "1 error was reported (see above)\n" + then FStarC_Util.print_error "1 error was reported (see above)\n" else - (let uu___3 = FStarC_Compiler_Util.string_of_int errs in - FStarC_Compiler_Util.print1_error + (let uu___3 = FStarC_Util.string_of_int errs in + FStarC_Util.print1_error "%s errors were reported (see above)\n" uu___3)) else (let uu___3 = - FStarC_Compiler_Util.colorize_bold + FStarC_Util.colorize_bold "All verification conditions discharged successfully" in - FStarC_Compiler_Util.print1 "%s\n" uu___3)) + FStarC_Util.print1 "%s\n" uu___3)) else () let (report_errors : (Prims.bool * FStarC_Ident.lident) Prims.list -> unit) = fun fmods -> (let uu___1 = FStarC_Errors.report_all () in ()); (let nerrs = FStarC_Errors.get_err_count () in if nerrs > Prims.int_zero - then - (finished_message fmods nerrs; - FStarC_Compiler_Effect.exit Prims.int_one) + then (finished_message fmods nerrs; FStarC_Effect.exit Prims.int_one) else ()) let (load_native_tactics : unit -> unit) = fun uu___ -> let modules_to_load = let uu___1 = FStarC_Options.load () in - FStarC_Compiler_List.map FStarC_Ident.lid_of_str uu___1 in + FStarC_List.map FStarC_Ident.lid_of_str uu___1 in let cmxs_to_load = let uu___1 = FStarC_Options.load_cmxs () in - FStarC_Compiler_List.map FStarC_Ident.lid_of_str uu___1 in + FStarC_List.map FStarC_Ident.lid_of_str uu___1 in let ml_module_name m = FStarC_Extraction_ML_Util.ml_module_name_of_lid m in let ml_file m = let uu___1 = ml_module_name m in Prims.strcat uu___1 ".ml" in @@ -75,10 +69,9 @@ let (load_native_tactics : unit -> unit) = match uu___1 with | FStar_Pervasives_Native.Some f -> f | FStar_Pervasives_Native.None -> - if FStarC_Compiler_List.contains m cmxs_to_load + if FStarC_List.contains m cmxs_to_load then - let uu___2 = - FStarC_Compiler_Util.format1 "Could not find %s to load" cmxs in + let uu___2 = FStarC_Util.format1 "Could not find %s to load" cmxs in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_FailToCompileNativeTactic () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -90,7 +83,7 @@ let (load_native_tactics : unit -> unit) = | FStar_Pervasives_Native.None -> let uu___4 = let uu___5 = ml_file m in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Failed to compile native tactic; extracted module %s not found" uu___5 in FStarC_Errors.raise_error0 @@ -98,14 +91,14 @@ let (load_native_tactics : unit -> unit) = (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4) | FStar_Pervasives_Native.Some ml -> - let dir = FStarC_Compiler_Util.dirname ml in + let dir = FStarC_Util.dirname ml in ((let uu___5 = let uu___6 = ml_module_name m in [uu___6] in - FStarC_Compiler_Plugins.compile_modules dir uu___5); + FStarC_Plugins.compile_modules dir uu___5); (let uu___5 = FStarC_Find.find_file_odir cmxs in match uu___5 with | FStar_Pervasives_Native.None -> let uu___6 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Failed to compile native tactic; compiled object %s not found" cmxs in FStarC_Errors.raise_error0 @@ -115,38 +108,30 @@ let (load_native_tactics : unit -> unit) = (Obj.magic uu___6) | FStar_Pervasives_Native.Some f -> f))) in let cmxs_files = - FStarC_Compiler_List.map cmxs_file - (FStarC_Compiler_List.op_At modules_to_load cmxs_to_load) in - (let uu___2 = FStarC_Compiler_Debug.any () in - if uu___2 - then - FStarC_Compiler_Util.print1 "Will try to load cmxs files: [%s]\n" - (FStarC_Compiler_String.concat ", " cmxs_files) - else ()); - FStarC_Compiler_Plugins.load_plugins cmxs_files; - (let uu___4 = FStarC_Options.use_native_tactics () in - FStarC_Compiler_Util.iter_opt uu___4 - FStarC_Compiler_Plugins.load_plugins_dir) + FStarC_List.map cmxs_file + (FStarC_List.op_At modules_to_load cmxs_to_load) in + FStarC_Plugins.load_plugins cmxs_files; + (let uu___3 = FStarC_Options.use_native_tactics () in + FStarC_Util.iter_opt uu___3 FStarC_Plugins.load_plugins_dir) let (fstar_files : - Prims.string Prims.list FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + Prims.string Prims.list FStar_Pervasives_Native.option FStarC_Effect.ref) = + FStarC_Util.mk_ref FStar_Pervasives_Native.None let (set_error_trap : unit -> unit) = fun uu___ -> - let h = FStarC_Compiler_Util.get_sigint_handler () in + let h = FStarC_Util.get_sigint_handler () in let h' s = - FStarC_Compiler_Debug.enable (); + FStarC_Debug.enable (); FStarC_Options.set_option "error_contexts" (FStarC_Options.Bool true); (let uu___4 = let uu___5 = FStarC_Errors_Msg.text "GOT SIGINT! Exiting" in [uu___5] in FStarC_Errors.diag FStarC_Class_HasRange.hasRange_range - FStarC_Compiler_Range_Type.dummyRange () + FStarC_Range_Type.dummyRange () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___4)); - FStarC_Compiler_Effect.exit Prims.int_one in - let uu___1 = FStarC_Compiler_Util.sigint_handler_f h' in - FStarC_Compiler_Util.set_sigint_handler uu___1 + FStarC_Effect.exit Prims.int_one in + let uu___1 = FStarC_Util.sigint_handler_f h' in + FStarC_Util.set_sigint_handler uu___1 let (print_help_for : Prims.string -> unit) = fun o -> let uu___ = FStarC_Options.help_for_option o in @@ -154,7 +139,7 @@ let (print_help_for : Prims.string -> unit) = | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some doc -> let uu___1 = FStarC_Errors_Msg.renderdoc doc in - FStarC_Compiler_Util.print_error uu___1 + FStarC_Util.print_error uu___1 let (go_normal : unit -> unit) = fun uu___ -> let uu___1 = process_args () in @@ -163,31 +148,30 @@ let (go_normal : unit -> unit) = let check_no_filenames opt = if Prims.uu___is_Cons filenames then - (FStarC_Compiler_Util.print1_error + (FStarC_Util.print1_error "error: No filenames should be passed with option %s\n" opt; - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) else () in ((let uu___3 = FStarC_Options.trace_error () in if uu___3 then set_error_trap () else ()); (match res with | FStarC_Getopt.Empty -> (FStarC_Options.display_usage (); - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) | FStarC_Getopt.Help -> (FStarC_Options.display_usage (); - FStarC_Compiler_Effect.exit Prims.int_zero) + FStarC_Effect.exit Prims.int_zero) | FStarC_Getopt.Error (msg, opt) -> - (FStarC_Compiler_Util.print_error (Prims.strcat "error: " msg); + (FStarC_Util.print_error (Prims.strcat "error: " msg); print_help_for opt; - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) | FStarC_Getopt.Success when FStarC_Options.print_cache_version () -> ((let uu___4 = - FStarC_Compiler_Util.string_of_int + FStarC_Util.string_of_int FStarC_CheckedFiles.cache_version_number in - FStarC_Compiler_Util.print1 "F* cache version number: %s\n" - uu___4); - FStarC_Compiler_Effect.exit Prims.int_zero) + FStarC_Util.print1 "F* cache version number: %s\n" uu___4); + FStarC_Effect.exit Prims.int_zero) | FStarC_Getopt.Success when let uu___3 = FStarC_Options.dep () in uu___3 <> FStar_Pervasives_Native.None -> @@ -200,19 +184,12 @@ let (go_normal : unit -> unit) = | FStarC_Getopt.Success when (FStarC_Options.print ()) || (FStarC_Options.print_in_place ()) -> - (if - Prims.op_Negation - FStarC_Platform.is_fstar_compiler_using_ocaml - then - failwith - "You seem to be using the F#-generated version of the compiler ; \\o\n reindenting is not known to work yet with this version" - else (); - (let printing_mode = - let uu___4 = FStarC_Options.print () in - if uu___4 - then FStarC_Prettyprint.FromTempToStdout - else FStarC_Prettyprint.FromTempToFile in - FStarC_Prettyprint.generate printing_mode filenames)) + let printing_mode = + let uu___3 = FStarC_Options.print () in + if uu___3 + then FStarC_Prettyprint.FromTempToStdout + else FStarC_Prettyprint.FromTempToFile in + FStarC_Prettyprint.generate printing_mode filenames | FStarC_Getopt.Success when let uu___3 = FStarC_Options.read_checked_file () in FStar_Pervasives_Native.uu___is_Some uu___3 -> @@ -241,14 +218,14 @@ let (go_normal : unit -> unit) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_modul tcr.FStarC_CheckedFiles.checked_module in - FStarC_Compiler_Util.print1 "%s\n" uu___4) + FStarC_Util.print1 "%s\n" uu___4) | FStarC_Getopt.Success when let uu___3 = FStarC_Options.read_krml_file () in FStar_Pervasives_Native.uu___is_Some uu___3 -> let path = let uu___3 = FStarC_Options.read_krml_file () in FStar_Pervasives_Native.__proj__Some__item__v uu___3 in - let uu___3 = FStarC_Compiler_Util.load_value_from_file path in + let uu___3 = FStarC_Util.load_value_from_file path in (match uu___3 with | FStar_Pervasives_Native.None -> let uu___4 = @@ -266,68 +243,65 @@ let (go_normal : unit -> unit) = ((let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_int version in - FStarC_Compiler_Util.print1 - "Karamel format version: %s\n" uu___5); - FStarC_Compiler_List.iter + FStarC_Util.print1 "Karamel format version: %s\n" uu___5); + FStarC_List.iter (fun uu___5 -> match uu___5 with | (name, decls) -> - (FStarC_Compiler_Util.print1 "%s:\n" name; - FStarC_Compiler_List.iter + (FStarC_Util.print1 "%s:\n" name; + FStarC_List.iter (fun d -> let uu___7 = FStarC_Class_Show.show FStarC_Extraction_Krml.showable_decl d in - FStarC_Compiler_Util.print1 " %s\n" - uu___7) decls)) files)) + FStarC_Util.print1 " %s\n" uu___7) decls)) + files)) | FStarC_Getopt.Success when FStarC_Options.list_plugins () -> let ps = FStarC_TypeChecker_Cfg.list_plugins () in let ts = FStarC_Tactics_Interpreter.native_tactics_steps () in ((let uu___4 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun p -> let uu___6 = FStarC_Class_Show.show FStarC_Ident.showable_lident p.FStarC_TypeChecker_Primops_Base.name in Prims.strcat " " uu___6) ps in - FStarC_Compiler_String.concat "\n" uu___5 in - FStarC_Compiler_Util.print1 "Registered plugins:\n%s\n" - uu___4); + FStarC_String.concat "\n" uu___5 in + FStarC_Util.print1 "Registered plugins:\n%s\n" uu___4); (let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun p -> let uu___7 = FStarC_Class_Show.show FStarC_Ident.showable_lident p.FStarC_TypeChecker_Primops_Base.name in Prims.strcat " " uu___7) ts in - FStarC_Compiler_String.concat "\n" uu___6 in - FStarC_Compiler_Util.print1 - "Registered tactic plugins:\n%s\n" uu___5)) + FStarC_String.concat "\n" uu___6 in + FStarC_Util.print1 "Registered tactic plugins:\n%s\n" uu___5)) | FStarC_Getopt.Success when FStarC_Options.locate () -> (check_no_filenames "--locate"; (let uu___5 = FStarC_Find.locate () in - FStarC_Compiler_Util.print1 "%s\n" uu___5); - FStarC_Compiler_Effect.exit Prims.int_zero) + FStarC_Util.print1 "%s\n" uu___5); + FStarC_Effect.exit Prims.int_zero) | FStarC_Getopt.Success when FStarC_Options.locate_lib () -> (check_no_filenames "--locate_lib"; (let uu___4 = FStarC_Find.locate_lib () in match uu___4 with | FStar_Pervasives_Native.None -> - (FStarC_Compiler_Util.print_error + (FStarC_Util.print_error "No library found (is --no_default_includes set?)\n"; - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) | FStar_Pervasives_Native.Some s -> - (FStarC_Compiler_Util.print1 "%s\n" s; - FStarC_Compiler_Effect.exit Prims.int_zero))) + (FStarC_Util.print1 "%s\n" s; + FStarC_Effect.exit Prims.int_zero))) | FStarC_Getopt.Success when FStarC_Options.locate_ocaml () -> (check_no_filenames "--locate_ocaml"; (let uu___5 = FStarC_Find.locate_ocaml () in - FStarC_Compiler_Util.print1 "%s\n" uu___5); - FStarC_Compiler_Effect.exit Prims.int_zero) + FStarC_Util.print1 "%s\n" uu___5); + FStarC_Effect.exit Prims.int_zero) | FStarC_Getopt.Success when let uu___3 = FStarC_Options.locate_file () in FStar_Pervasives_Native.uu___is_Some uu___3 -> @@ -338,14 +312,13 @@ let (go_normal : unit -> unit) = let uu___4 = FStarC_Find.find_file f in match uu___4 with | FStar_Pervasives_Native.None -> - (FStarC_Compiler_Util.print1_error + (FStarC_Util.print1_error "File %s was not found in include path.\n" f; - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) | FStar_Pervasives_Native.Some fn -> - ((let uu___6 = - FStarC_Compiler_Util.normalize_file_path fn in - FStarC_Compiler_Util.print1 "%s\n" uu___6); - FStarC_Compiler_Effect.exit Prims.int_zero))) + ((let uu___6 = FStarC_Util.normalize_file_path fn in + FStarC_Util.print1 "%s\n" uu___6); + FStarC_Effect.exit Prims.int_zero))) | FStarC_Getopt.Success when let uu___3 = FStarC_Options.locate_z3 () in FStar_Pervasives_Native.uu___is_Some uu___3 -> @@ -360,42 +333,47 @@ let (go_normal : unit -> unit) = let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Z3 version '%s' was not found." v in FStarC_Errors_Msg.text uu___9 in [uu___8] in let uu___8 = FStarC_Find.z3_install_suggestion v in - FStarC_Compiler_List.op_At uu___7 uu___8 in + FStarC_List.op_At uu___7 uu___8 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Error_Z3InvocationError () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___6)); report_errors []; - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) | FStar_Pervasives_Native.Some fn -> - (FStarC_Compiler_Util.print1 "%s\n" fn; - FStarC_Compiler_Effect.exit Prims.int_zero))) + (FStarC_Util.print1 "%s\n" fn; + FStarC_Effect.exit Prims.int_zero))) | FStarC_Getopt.Success -> - (FStarC_Compiler_Effect.op_Colon_Equals fstar_files + (FStarC_Effect.op_Colon_Equals fstar_files (FStar_Pervasives_Native.Some filenames); - (let uu___5 = FStarC_Compiler_Debug.any () in + (let uu___5 = FStarC_Debug.any () in if uu___5 then - (FStarC_Compiler_Util.print1 "- F* executable: %s\n" - FStarC_Compiler_Util.exec_name; - (let uu___8 = - let uu___9 = FStarC_Find.lib_root () in - FStarC_Compiler_Util.dflt "" uu___9 in - FStarC_Compiler_Util.print1 "- Library root: %s\n" uu___8); + ((let uu___7 = + FStarC_Effect.op_Bang FStarC_Options._version in + let uu___8 = FStarC_Effect.op_Bang FStarC_Options._commit in + let uu___9 = FStarC_Platform_Base.kernel () in + FStarC_Util.print3 "- F* version %s -- %s (on %s)\n" + uu___7 uu___8 uu___9); + FStarC_Util.print1 "- Executable: %s\n" + FStarC_Util.exec_name; (let uu___9 = - let uu___10 = FStarC_Find.include_path () in + let uu___10 = FStarC_Find.lib_root () in + FStarC_Util.dflt "" uu___10 in + FStarC_Util.print1 "- Library root: %s\n" uu___9); + (let uu___10 = + let uu___11 = FStarC_Find.include_path () in FStarC_Class_Show.show (FStarC_Class_Show.show_list - FStarC_Class_Show.showable_string) uu___10 in - FStarC_Compiler_Util.print1 "- Full include path: %s\n" - uu___9); - FStarC_Compiler_Util.print_string "\n") + FStarC_Class_Show.showable_string) uu___11 in + FStarC_Util.print1 "- Full include path: %s\n" uu___10); + FStarC_Util.print_string "\n") else ()); FStarC_Syntax_Unionfind.set_ro (); load_native_tactics (); @@ -415,7 +393,7 @@ let (go_normal : unit -> unit) = FStarC_Errors_Msg.is_error_message_string) (Obj.magic "--ide: Name of current file missing in command line invocation\n"); - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) | uu___11::uu___12::uu___13 -> (FStarC_Errors.log_issue0 FStarC_Errors_Codes.Error_TooManyFiles () @@ -423,7 +401,7 @@ let (go_normal : unit -> unit) = FStarC_Errors_Msg.is_error_message_string) (Obj.magic "--ide: Too many files in command line invocation\n"); - FStarC_Compiler_Effect.exit Prims.int_one) + FStarC_Effect.exit Prims.int_one) | filename::[] -> let uu___11 = FStarC_Options.legacy_interactive () in if uu___11 @@ -450,10 +428,10 @@ let (go_normal : unit -> unit) = FStarC_Universal.batch_mode_tc filenames1 dep_graph in (match uu___13 with - | (tcrs, env, cleanup1) -> - ((let uu___15 = cleanup1 env in ()); + | (tcrs, env, cleanup) -> + ((let uu___15 = cleanup env in ()); (let module_names = - FStarC_Compiler_List.map + FStarC_List.map (fun tcr -> FStarC_Universal.module_or_interface_name tcr.FStarC_CheckedFiles.checked_module) @@ -463,14 +441,13 @@ let (go_normal : unit -> unit) = Prims.int_zero)))))))))) let (go : unit -> unit) = fun uu___ -> - let args = FStarC_Compiler_Util.get_cmd_args () in + let args = FStarC_Util.get_cmd_args () in match args with | uu___1::"--ocamlenv"::[] -> let new_ocamlpath = FStarC_OCaml.new_ocamlpath () in ((let uu___3 = FStarC_OCaml.shellescape new_ocamlpath in - FStarC_Compiler_Util.print1 "OCAMLPATH='%s'; export OCAMLPATH;\n" - uu___3); - FStarC_Compiler_Effect.exit Prims.int_zero) + FStarC_Util.print1 "OCAMLPATH='%s'; export OCAMLPATH;\n" uu___3); + FStarC_Effect.exit Prims.int_zero) | uu___1::"--ocamlenv"::cmd::args1 -> FStarC_OCaml.exec_in_ocamlenv cmd args1 | uu___1::"--ocamlc"::rest -> FStarC_OCaml.exec_ocamlc rest @@ -478,101 +455,22 @@ let (go : unit -> unit) = | uu___1::"--ocamlopt_plugin"::rest -> FStarC_OCaml.exec_ocamlopt_plugin rest | uu___1 -> go_normal () -let (lazy_chooser : - FStarC_Syntax_Syntax.lazy_kind -> - FStarC_Syntax_Syntax.lazyinfo -> FStarC_Syntax_Syntax.term) - = - fun k -> - fun i -> - match k with - | FStarC_Syntax_Syntax.BadLazy -> - failwith "lazy chooser: got a BadLazy" - | FStarC_Syntax_Syntax.Lazy_bv -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_bv i - | FStarC_Syntax_Syntax.Lazy_namedv -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_namedv i - | FStarC_Syntax_Syntax.Lazy_binder -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_binder i - | FStarC_Syntax_Syntax.Lazy_letbinding -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_letbinding i - | FStarC_Syntax_Syntax.Lazy_optionstate -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_optionstate i - | FStarC_Syntax_Syntax.Lazy_fvar -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_fvar i - | FStarC_Syntax_Syntax.Lazy_comp -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_comp i - | FStarC_Syntax_Syntax.Lazy_env -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_env i - | FStarC_Syntax_Syntax.Lazy_sigelt -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_sigelt i - | FStarC_Syntax_Syntax.Lazy_universe -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_universe i - | FStarC_Syntax_Syntax.Lazy_proofstate -> - FStarC_Tactics_Embedding.unfold_lazy_proofstate i - | FStarC_Syntax_Syntax.Lazy_goal -> - FStarC_Tactics_Embedding.unfold_lazy_goal i - | FStarC_Syntax_Syntax.Lazy_doc -> - FStarC_Reflection_V2_Embeddings.unfold_lazy_doc i - | FStarC_Syntax_Syntax.Lazy_uvar -> - FStarC_Syntax_Util.exp_string "((uvar))" - | FStarC_Syntax_Syntax.Lazy_universe_uvar -> - FStarC_Syntax_Util.exp_string "((universe_uvar))" - | FStarC_Syntax_Syntax.Lazy_issue -> - FStarC_Syntax_Util.exp_string "((issue))" - | FStarC_Syntax_Syntax.Lazy_ident -> - FStarC_Syntax_Util.exp_string "((ident))" - | FStarC_Syntax_Syntax.Lazy_tref -> - FStarC_Syntax_Util.exp_string "((tref))" - | FStarC_Syntax_Syntax.Lazy_embedding (uu___, t) -> - FStarC_Thunk.force t - | FStarC_Syntax_Syntax.Lazy_extension s -> - let uu___ = FStarC_Compiler_Util.format1 "((extension %s))" s in - FStarC_Syntax_Util.exp_string uu___ -let (setup_hooks : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Effect.op_Colon_Equals - FStarC_Syntax_DsEnv.ugly_sigelt_to_string_hook - (FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt); - FStarC_Errors.set_parse_warn_error FStarC_Parser_ParseIt.parse_warn_error; - FStarC_Compiler_Effect.op_Colon_Equals FStarC_Syntax_Syntax.lazy_chooser - (FStar_Pervasives_Native.Some lazy_chooser); - FStarC_Compiler_Effect.op_Colon_Equals FStarC_Syntax_Util.tts_f - (FStar_Pervasives_Native.Some - (FStarC_Class_Show.show FStarC_Syntax_Print.showable_term)); - FStarC_Compiler_Effect.op_Colon_Equals FStarC_Syntax_Util.ttd_f - (FStar_Pervasives_Native.Some - (FStarC_Class_PP.pp FStarC_Syntax_Print.pretty_term)); - FStarC_Compiler_Effect.op_Colon_Equals - FStarC_TypeChecker_Normalize.unembed_binder_knot - (FStar_Pervasives_Native.Some FStarC_Reflection_V2_Embeddings.e_binder); - FStarC_Compiler_List.iter - FStarC_Tactics_Interpreter.register_tactic_primitive_step - FStarC_Tactics_V1_Primops.ops; - FStarC_Compiler_List.iter - FStarC_Tactics_Interpreter.register_tactic_primitive_step - FStarC_Tactics_V2_Primops.ops let (handle_error : Prims.exn -> unit) = fun e -> (let uu___1 = FStarC_Errors.handleable e in - if uu___1 then FStarC_Errors.err_exn e else ()); - (let uu___2 = FStarC_Options.trace_error () in - if uu___2 - then - let uu___3 = FStarC_Compiler_Util.message_of_exn e in - let uu___4 = FStarC_Compiler_Util.trace_of_exn e in - FStarC_Compiler_Util.print2_error "Unexpected error\n%s\n%s\n" uu___3 - uu___4 + if uu___1 + then FStarC_Errors.err_exn e else - (let uu___4 = - let uu___5 = FStarC_Errors.handleable e in Prims.op_Negation uu___5 in - if uu___4 - then - let uu___5 = FStarC_Compiler_Util.message_of_exn e in - FStarC_Compiler_Util.print1_error - "Unexpected error; please file a bug report, ideally with a minimized version of the source program that triggered the error.\n%s\n" - uu___5 - else ())); - cleanup (); + ((let uu___4 = FStarC_Util.message_of_exn e in + FStarC_Util.print1_error "Unexpected error: %s\n" uu___4); + (let uu___4 = FStarC_Options.trace_error () in + if uu___4 + then + let uu___5 = FStarC_Util.trace_of_exn e in + FStarC_Util.print1_error "Trace:\n%s\n" uu___5 + else + FStarC_Util.print_error + "Please file a bug report, ideally with a minimized version of the source program that triggered the error.\n"))); report_errors [] let main : 'uuuuu . unit -> 'uuuuu = fun uu___ -> @@ -580,22 +478,19 @@ let main : 'uuuuu . unit -> 'uuuuu = (fun uu___1 -> match () with | () -> - (setup_hooks (); - (let uu___3 = FStarC_Compiler_Util.record_time_ms go in + (FStarC_Hooks.setup_hooks (); + (let uu___3 = FStarC_Util.record_time_ms go in match uu___3 with | (uu___4, time) -> ((let uu___6 = FStarC_Options.query_stats () in if uu___6 then - let uu___7 = FStarC_Compiler_Util.string_of_int time in + let uu___7 = FStarC_Util.string_of_int time in let uu___8 = let uu___9 = FStarC_Getopt.cmdline () in - FStarC_Compiler_String.concat " " uu___9 in - FStarC_Compiler_Util.print2_error - "TOTAL TIME %s ms: %s\n" uu___7 uu___8 + FStarC_String.concat " " uu___9 in + FStarC_Util.print2_error "TOTAL TIME %s ms: %s\n" + uu___7 uu___8 else ()); - cleanup (); - FStarC_Compiler_Effect.exit Prims.int_zero)))) () - with - | uu___1 -> - (handle_error uu___1; FStarC_Compiler_Effect.exit Prims.int_one) \ No newline at end of file + FStarC_Effect.exit Prims.int_zero)))) () + with | uu___1 -> (handle_error uu___1; FStarC_Effect.exit Prims.int_one) \ No newline at end of file diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_Misc.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Misc.ml new file mode 100644 index 00000000000..a3f35644da1 --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Misc.ml @@ -0,0 +1,17 @@ +open Prims +let (compare_version : Prims.string -> Prims.string -> FStarC_Order.order) = + fun v1 -> + fun v2 -> + let cs1 = + FStarC_List.map FStarC_Util.int_of_string + (FStarC_String.split [46] v1) in + let cs2 = + FStarC_List.map FStarC_Util.int_of_string + (FStarC_String.split [46] v2) in + FStarC_Order.compare_list cs1 cs2 FStarC_Order.compare_int +let (version_gt : Prims.string -> Prims.string -> Prims.bool) = + fun v1 -> + fun v2 -> let uu___ = compare_version v1 v2 in uu___ = FStarC_Order.Gt +let (version_ge : Prims.string -> Prims.string -> Prims.bool) = + fun v1 -> + fun v2 -> let uu___ = compare_version v1 v2 in uu___ <> FStarC_Order.Lt \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_OCaml.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_OCaml.ml similarity index 58% rename from stage0/fstar-lib/generated/FStarC_OCaml.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_OCaml.ml index b712a3e77f0..fd74bf42e3e 100644 --- a/stage0/fstar-lib/generated/FStarC_OCaml.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_OCaml.ml @@ -2,40 +2,35 @@ open Prims let (shellescape : Prims.string -> Prims.string) = fun s -> let uu___ = - let uu___1 = FStarC_Compiler_String.list_of_string s in - FStarC_Compiler_List.map + let uu___1 = FStarC_String.list_of_string s in + FStarC_List.map (fun uu___2 -> match uu___2 with | 39 -> "'\"'\"'" - | c -> FStarC_Compiler_String.make Prims.int_one c) uu___1 in - FStarC_Compiler_String.concat "" uu___ + | c -> FStarC_String.make Prims.int_one c) uu___1 in + FStarC_String.concat "" uu___ let (new_ocamlpath : unit -> Prims.string) = fun uu___ -> let ocamldir = FStarC_Find.locate_ocaml () in - let sep = - match FStarC_Platform.system with - | FStarC_Platform.Windows -> ";" - | FStarC_Platform.Posix -> ":" in let old_ocamlpath = - let uu___1 = - FStarC_Compiler_Util.expand_environment_variable "OCAMLPATH" in - FStarC_Compiler_Util.dflt "" uu___1 in + let uu___1 = FStarC_Util.expand_environment_variable "OCAMLPATH" in + FStarC_Util.dflt "" uu___1 in let new_ocamlpath1 = - Prims.strcat ocamldir (Prims.strcat sep old_ocamlpath) in + Prims.strcat ocamldir + (Prims.strcat FStarC_Platform.ocamlpath_sep old_ocamlpath) in new_ocamlpath1 let exec_in_ocamlenv : 'a . Prims.string -> Prims.string Prims.list -> 'a = fun cmd -> fun args -> let new_ocamlpath1 = new_ocamlpath () in - FStarC_Compiler_Util.putenv "OCAMLPATH" new_ocamlpath1; - (let pid = FStarC_Compiler_Util.create_process cmd (cmd :: args) in - let rc = FStarC_Compiler_Util.waitpid pid in + FStarC_Util.putenv "OCAMLPATH" new_ocamlpath1; + (let pid = FStarC_Util.create_process cmd (cmd :: args) in + let rc = FStarC_Util.waitpid pid in match rc with - | FStar_Pervasives.Inl rc1 -> FStarC_Compiler_Effect.exit rc1 - | FStar_Pervasives.Inr uu___1 -> - FStarC_Compiler_Effect.exit Prims.int_one) + | FStar_Pervasives.Inl rc1 -> FStarC_Effect.exit rc1 + | FStar_Pervasives.Inr uu___1 -> FStarC_Effect.exit Prims.int_one) let (app_lib : Prims.string) = "fstar.lib" -let (plugin_lib : Prims.string) = "fstar.lib" +let (plugin_lib : Prims.string) = "fstar.pluginlib" let (wstr : Prims.string) = "-8" let (common_args : Prims.string Prims.list) = ["-w"; wstr; "-thread"] let exec_ocamlc : 'a . Prims.string Prims.list -> 'a = diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Option.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Option.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Compiler_Option.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Option.ml diff --git a/stage0/fstar-lib/generated/FStarC_Options.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Options.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Options.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Options.ml index f67e8c1e7f8..80346eff992 100644 --- a/stage0/fstar-lib/generated/FStarC_Options.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Options.ml @@ -4,6 +4,7 @@ type codegen_t = | FSharp | Krml | Plugin + | PluginNoLib | Extension let (uu___is_OCaml : codegen_t -> Prims.bool) = fun projectee -> match projectee with | OCaml -> true | uu___ -> false @@ -13,6 +14,9 @@ let (uu___is_Krml : codegen_t -> Prims.bool) = fun projectee -> match projectee with | Krml -> true | uu___ -> false let (uu___is_Plugin : codegen_t -> Prims.bool) = fun projectee -> match projectee with | Plugin -> true | uu___ -> false +let (uu___is_PluginNoLib : codegen_t -> Prims.bool) = + fun projectee -> + match projectee with | PluginNoLib -> true | uu___ -> false let (uu___is_Extension : codegen_t -> Prims.bool) = fun projectee -> match projectee with | Extension -> true | uu___ -> false type split_queries_t = @@ -28,10 +32,13 @@ let (uu___is_Always : split_queries_t -> Prims.bool) = type message_format_t = | Json | Human + | Github let (uu___is_Json : message_format_t -> Prims.bool) = fun projectee -> match projectee with | Json -> true | uu___ -> false let (uu___is_Human : message_format_t -> Prims.bool) = fun projectee -> match projectee with | Human -> true | uu___ -> false +let (uu___is_Github : message_format_t -> Prims.bool) = + fun projectee -> match projectee with | Github -> true | uu___ -> false type option_val = | Bool of Prims.bool | String of Prims.string @@ -61,7 +68,7 @@ let (__proj__List__item___0 : option_val -> option_val Prims.list) = fun projectee -> match projectee with | List _0 -> _0 let (uu___is_Unset : option_val -> Prims.bool) = fun projectee -> match projectee with | Unset -> true | uu___ -> false -type optionstate = option_val FStarC_Compiler_Util.psmap +type optionstate = option_val FStarC_Util.psmap type opt_type = | Const of option_val | IntStr of Prims.string @@ -125,18 +132,24 @@ let (uu___is_WithSideEffect : opt_type -> Prims.bool) = let (__proj__WithSideEffect__item___0 : opt_type -> ((unit -> unit) * opt_type)) = fun projectee -> match projectee with | WithSideEffect _0 -> _0 -let (debug_embedding : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref false -let (eager_embedding : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref false -let (__unit_tests__ : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref false +exception NotSettable of Prims.string +let (uu___is_NotSettable : Prims.exn -> Prims.bool) = + fun projectee -> + match projectee with | NotSettable uu___ -> true | uu___ -> false +let (__proj__NotSettable__item__uu___ : Prims.exn -> Prims.string) = + fun projectee -> match projectee with | NotSettable uu___ -> uu___ +let (debug_embedding : Prims.bool FStarC_Effect.ref) = + FStarC_Util.mk_ref false +let (eager_embedding : Prims.bool FStarC_Effect.ref) = + FStarC_Util.mk_ref false +let (__unit_tests__ : Prims.bool FStarC_Effect.ref) = + FStarC_Util.mk_ref false let (__unit_tests : unit -> Prims.bool) = - fun uu___ -> FStarC_Compiler_Effect.op_Bang __unit_tests__ + fun uu___ -> FStarC_Effect.op_Bang __unit_tests__ let (__set_unit_tests : unit -> unit) = - fun uu___ -> FStarC_Compiler_Effect.op_Colon_Equals __unit_tests__ true + fun uu___ -> FStarC_Effect.op_Colon_Equals __unit_tests__ true let (__clear_unit_tests : unit -> unit) = - fun uu___ -> FStarC_Compiler_Effect.op_Colon_Equals __unit_tests__ false + fun uu___ -> FStarC_Effect.op_Colon_Equals __unit_tests__ false let (as_bool : option_val -> Prims.bool) = fun uu___ -> match uu___ with @@ -149,7 +162,7 @@ let (as_string : option_val -> Prims.string) = fun uu___ -> match uu___ with | String b -> b - | Path b -> FStarC_Common.try_convert_file_name_to_mixed b + | Path b -> b | uu___1 -> failwith "Impos: expected String" let (as_list' : option_val -> option_val Prims.list) = fun uu___ -> @@ -158,8 +171,7 @@ let (as_list' : option_val -> option_val Prims.list) = | uu___1 -> failwith "Impos: expected List" let as_list : 'uuuuu . (option_val -> 'uuuuu) -> option_val -> 'uuuuu Prims.list = - fun as_t -> - fun x -> let uu___ = as_list' x in FStarC_Compiler_List.map as_t uu___ + fun as_t -> fun x -> let uu___ = as_list' x in FStarC_List.map as_t uu___ let as_option : 'uuuuu . (option_val -> 'uuuuu) -> @@ -175,78 +187,72 @@ let (as_comma_string_list : option_val -> Prims.string Prims.list) = match uu___ with | List ls -> let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun l -> - let uu___2 = as_string l in - FStarC_Compiler_Util.split uu___2 ",") ls in - FStarC_Compiler_List.flatten uu___1 + let uu___2 = as_string l in FStarC_Util.split uu___2 ",") ls in + FStarC_List.flatten uu___1 | uu___1 -> failwith "Impos: expected String (comma list)" let copy_optionstate : - 'uuuuu . - 'uuuuu FStarC_Compiler_Util.smap -> 'uuuuu FStarC_Compiler_Util.smap - = fun m -> FStarC_Compiler_Util.smap_copy m + 'uuuuu . 'uuuuu FStarC_Util.smap -> 'uuuuu FStarC_Util.smap = + fun m -> FStarC_Util.smap_copy m type history1 = - (FStarC_Compiler_Debug.saved_state * FStarC_Options_Ext.ext_state * - optionstate) -let (fstar_options : optionstate FStarC_Compiler_Effect.ref) = - let uu___ = FStarC_Compiler_Util.psmap_empty () in - FStarC_Compiler_Util.mk_ref uu___ -let (history : history1 Prims.list Prims.list FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref [] + (FStarC_Debug.saved_state * FStarC_Options_Ext.ext_state * optionstate) +let (fstar_options : optionstate FStarC_Effect.ref) = + let uu___ = FStarC_Util.psmap_empty () in FStarC_Util.mk_ref uu___ +let (history : history1 Prims.list Prims.list FStarC_Effect.ref) = + FStarC_Util.mk_ref [] let (peek : unit -> optionstate) = - fun uu___ -> FStarC_Compiler_Effect.op_Bang fstar_options + fun uu___ -> FStarC_Effect.op_Bang fstar_options let (internal_push : unit -> unit) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang history in + let uu___1 = FStarC_Effect.op_Bang history in match uu___1 with | lev1::rest -> let newhd = - let uu___2 = FStarC_Compiler_Debug.snapshot () in + let uu___2 = FStarC_Debug.snapshot () in let uu___3 = FStarC_Options_Ext.save () in - let uu___4 = FStarC_Compiler_Effect.op_Bang fstar_options in + let uu___4 = FStarC_Effect.op_Bang fstar_options in (uu___2, uu___3, uu___4) in - FStarC_Compiler_Effect.op_Colon_Equals history ((newhd :: lev1) :: - rest) + FStarC_Effect.op_Colon_Equals history ((newhd :: lev1) :: rest) let (internal_pop : unit -> Prims.bool) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang history in + let uu___1 = FStarC_Effect.op_Bang history in match uu___1 with | lev1::rest -> (match lev1 with | [] -> false | (dbg, ext, opts)::lev1' -> - (FStarC_Compiler_Debug.restore dbg; + (FStarC_Debug.restore dbg; FStarC_Options_Ext.restore ext; - FStarC_Compiler_Effect.op_Colon_Equals fstar_options opts; - FStarC_Compiler_Effect.op_Colon_Equals history (lev1' :: rest); + FStarC_Effect.op_Colon_Equals fstar_options opts; + FStarC_Effect.op_Colon_Equals history (lev1' :: rest); true)) let (push : unit -> unit) = fun uu___ -> internal_push (); - (let uu___2 = FStarC_Compiler_Effect.op_Bang history in + (let uu___2 = FStarC_Effect.op_Bang history in match uu___2 with | lev1::uu___3 -> ((let uu___5 = - let uu___6 = FStarC_Compiler_Effect.op_Bang history in lev1 :: - uu___6 in - FStarC_Compiler_Effect.op_Colon_Equals history uu___5); + let uu___6 = FStarC_Effect.op_Bang history in lev1 :: uu___6 in + FStarC_Effect.op_Colon_Equals history uu___5); (let uu___6 = internal_pop () in ()))) let (pop : unit -> unit) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang history in + let uu___1 = FStarC_Effect.op_Bang history in match uu___1 with | [] -> failwith "TOO MANY POPS!" | uu___2::levs -> - (FStarC_Compiler_Effect.op_Colon_Equals history levs; + (FStarC_Effect.op_Colon_Equals history levs; (let uu___4 = let uu___5 = internal_pop () in Prims.op_Negation uu___5 in if uu___4 then failwith "aaa!!!" else ())) let (set : optionstate -> unit) = - fun o -> FStarC_Compiler_Effect.op_Colon_Equals fstar_options o + fun o -> FStarC_Effect.op_Colon_Equals fstar_options o let (depth : unit -> Prims.int) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang history in - match uu___1 with | lev::uu___2 -> FStarC_Compiler_List.length lev + let uu___1 = FStarC_Effect.op_Bang history in + match uu___1 with | lev::uu___2 -> FStarC_List.length lev let (snapshot : unit -> (Prims.int * unit)) = fun uu___ -> FStarC_Common.snapshot push history () let (rollback : Prims.int FStar_Pervasives_Native.option -> unit) = @@ -257,15 +263,15 @@ let (set_option : Prims.string -> option_val -> unit) = let map = peek () in if k = "report_assumes" then - let uu___ = FStarC_Compiler_Util.psmap_try_find map k in + let uu___ = FStarC_Util.psmap_try_find map k in match uu___ with | FStar_Pervasives_Native.Some (String "error") -> () | uu___1 -> - let uu___2 = FStarC_Compiler_Util.psmap_add map k v in - FStarC_Compiler_Effect.op_Colon_Equals fstar_options uu___2 + let uu___2 = FStarC_Util.psmap_add map k v in + FStarC_Effect.op_Colon_Equals fstar_options uu___2 else - (let uu___1 = FStarC_Compiler_Util.psmap_add map k v in - FStarC_Compiler_Effect.op_Colon_Equals fstar_options uu___1) + (let uu___1 = FStarC_Util.psmap_add map k v in + FStarC_Effect.op_Colon_Equals fstar_options uu___1) let (set_option' : (Prims.string * option_val) -> unit) = fun uu___ -> match uu___ with | (k, v) -> set_option k v let (set_admit_smt_queries : Prims.bool -> unit) = @@ -296,7 +302,7 @@ let (defaults : (Prims.string * option_val) Prims.list) = ("eager_subtyping", (Bool false)); ("error_contexts", (Bool false)); ("expose_interfaces", (Bool false)); - ("message_format", (String "human")); + ("message_format", (String "auto")); ("ext", Unset); ("extract", Unset); ("extract_all", (Bool false)); @@ -330,7 +336,7 @@ let (defaults : (Prims.string * option_val) Prims.list) = ("max_fuel", (Int (Prims.of_int (8)))); ("max_ifuel", (Int (Prims.of_int (2)))); ("MLish", (Bool false)); - ("MLish_effect", (String "FStar.Compiler.Effect")); + ("MLish_effect", (String "FStar.Effect")); ("no_default_includes", (Bool false)); ("no_extract", (List [])); ("no_location_info", (Bool false)); @@ -411,28 +417,28 @@ let (defaults : (Prims.string * option_val) Prims.list) = ("use_nbe", (Bool false)); ("use_nbe_for_extraction", (Bool false)); ("trivial_pre_for_unannotated_effectful_fns", (Bool true)); + ("with_fstarc", (Bool false)); ("profile_group_by_decl", (Bool false)); ("profile_component", Unset); ("profile", Unset)] let (init : unit -> unit) = fun uu___ -> - FStarC_Compiler_Debug.disable_all (); + FStarC_Debug.disable_all (); FStarC_Options_Ext.reset (); - (let uu___4 = FStarC_Compiler_Util.psmap_empty () in - FStarC_Compiler_Effect.op_Colon_Equals fstar_options uu___4); - FStarC_Compiler_List.iter set_option' defaults + (let uu___4 = FStarC_Util.psmap_empty () in + FStarC_Effect.op_Colon_Equals fstar_options uu___4); + FStarC_List.iter set_option' defaults let (clear : unit -> unit) = - fun uu___ -> FStarC_Compiler_Effect.op_Colon_Equals history [[]]; init () + fun uu___ -> FStarC_Effect.op_Colon_Equals history [[]]; init () let (uu___0 : unit) = clear () let (get_option : Prims.string -> option_val) = fun s -> - let uu___ = - let uu___1 = peek () in FStarC_Compiler_Util.psmap_try_find uu___1 s in + let uu___ = let uu___1 = peek () in FStarC_Util.psmap_try_find uu___1 s in match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = - let uu___2 = FStarC_Compiler_String.op_Hat s " not found" in - FStarC_Compiler_String.op_Hat "Impossible: option " uu___2 in + let uu___2 = FStarC_String.op_Hat s " not found" in + FStarC_String.op_Hat "Impossible: option " uu___2 in failwith uu___1 | FStar_Pervasives_Native.Some s1 -> s1 let rec (option_val_to_string : option_val -> Prims.string) = @@ -440,21 +446,21 @@ let rec (option_val_to_string : option_val -> Prims.string) = match v with | Bool b -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_bool b in - FStarC_Compiler_String.op_Hat "Bool " uu___ + FStarC_String.op_Hat "Bool " uu___ | String s -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_string s in - FStarC_Compiler_String.op_Hat "String " uu___ + FStarC_String.op_Hat "String " uu___ | Path s -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_string s in - FStarC_Compiler_String.op_Hat "Path " uu___ + FStarC_String.op_Hat "Path " uu___ | Int i -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_int i in - FStarC_Compiler_String.op_Hat "Int " uu___ + FStarC_String.op_Hat "Int " uu___ | List vs -> let uu___ = FStarC_Common.string_of_list option_val_to_string vs in - FStarC_Compiler_String.op_Hat "List " uu___ + FStarC_String.op_Hat "List " uu___ | Unset -> "Unset" let (showable_option_val : option_val FStarC_Class_Show.showable) = { FStarC_Class_Show.show = option_val_to_string } @@ -509,9 +515,8 @@ let (show_options : unit -> Prims.string) = Obj.magic (Obj.repr (let v = - let uu___3 = - FStarC_Compiler_Util.psmap_try_find s k in - FStarC_Compiler_Util.must uu___3 in + let uu___3 = FStarC_Util.psmap_try_find s k in + FStarC_Util.must uu___3 in let v0 = list_try_find FStarC_Class_Deq.deq_string k defaults in @@ -529,22 +534,22 @@ let (show_options : unit -> Prims.string) = let rec show_optionval v = match v with | String s1 -> - let uu___1 = FStarC_Compiler_String.op_Hat s1 "\"" in - FStarC_Compiler_String.op_Hat "\"" uu___1 + let uu___1 = FStarC_String.op_Hat s1 "\"" in + FStarC_String.op_Hat "\"" uu___1 | Bool b -> FStarC_Class_Show.show FStarC_Class_Show.showable_bool b | Int i -> FStarC_Class_Show.show FStarC_Class_Show.showable_int i | Path s1 -> s1 | List s1 -> - let uu___1 = FStarC_Compiler_List.map show_optionval s1 in - FStarC_Compiler_String.concat "," uu___1 + let uu___1 = FStarC_List.map show_optionval s1 in + FStarC_String.concat "," uu___1 | Unset -> "" in let show1 uu___1 = match uu___1 with | (k, v) -> let uu___2 = show_optionval v in - FStarC_Compiler_Util.format2 "--%s %s" k uu___2 in - let uu___1 = FStarC_Compiler_List.map show1 kvs in - FStarC_Compiler_String.concat "\n" uu___1 + FStarC_Util.format2 "--%s %s" k uu___2 in + let uu___1 = FStarC_List.map show1 kvs in + FStarC_String.concat "\n" uu___1 let (set_verification_options : optionstate -> unit) = fun o -> let verifopts = @@ -573,11 +578,11 @@ let (set_verification_options : optionstate -> unit) = "z3seed"; "z3version"; "trivial_pre_for_unannotated_effectful_fns"] in - FStarC_Compiler_List.iter + FStarC_List.iter (fun k -> let uu___ = - let uu___1 = FStarC_Compiler_Util.psmap_try_find o k in - FStarC_Compiler_Util.must uu___1 in + let uu___1 = FStarC_Util.psmap_try_find o k in + FStarC_Util.must uu___1 in set_option k uu___) verifopts let lookup_opt : 'uuuuu . Prims.string -> (option_val -> 'uuuuu) -> 'uuuuu = fun s -> fun c -> let uu___ = get_option s in c uu___ @@ -841,6 +846,8 @@ let (get_use_nbe_for_extraction : unit -> Prims.bool) = fun uu___ -> lookup_opt "use_nbe_for_extraction" as_bool let (get_trivial_pre_for_unannotated_effectful_fns : unit -> Prims.bool) = fun uu___ -> lookup_opt "trivial_pre_for_unannotated_effectful_fns" as_bool +let (get_with_fstarc : unit -> Prims.bool) = + fun uu___ -> lookup_opt "with_fstarc" as_bool let (get_profile : unit -> Prims.string Prims.list FStar_Pervasives_Native.option) = fun uu___ -> lookup_opt "profile" (as_option (as_list as_string)) @@ -849,32 +856,27 @@ let (get_profile_group_by_decl : unit -> Prims.bool) = let (get_profile_component : unit -> Prims.string Prims.list FStar_Pervasives_Native.option) = fun uu___ -> lookup_opt "profile_component" (as_option (as_list as_string)) -let (_version : Prims.string FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref "" -let (_platform : Prims.string FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref "" -let (_compiler : Prims.string FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref "" -let (_date : Prims.string FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref " not set" -let (_commit : Prims.string FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref "" +let (_version : Prims.string FStarC_Effect.ref) = FStarC_Util.mk_ref "" +let (_platform : Prims.string FStarC_Effect.ref) = FStarC_Util.mk_ref "" +let (_compiler : Prims.string FStarC_Effect.ref) = FStarC_Util.mk_ref "" +let (_date : Prims.string FStarC_Effect.ref) = FStarC_Util.mk_ref " not set" +let (_commit : Prims.string FStarC_Effect.ref) = FStarC_Util.mk_ref "" let (display_version : unit -> unit) = fun uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang _version in - let uu___3 = FStarC_Compiler_Effect.op_Bang _platform in - let uu___4 = FStarC_Compiler_Effect.op_Bang _compiler in - let uu___5 = FStarC_Compiler_Effect.op_Bang _date in - let uu___6 = FStarC_Compiler_Effect.op_Bang _commit in - FStarC_Compiler_Util.format5 + let uu___2 = FStarC_Effect.op_Bang _version in + let uu___3 = FStarC_Effect.op_Bang _platform in + let uu___4 = FStarC_Effect.op_Bang _compiler in + let uu___5 = FStarC_Effect.op_Bang _date in + let uu___6 = FStarC_Effect.op_Bang _commit in + FStarC_Util.format5 "F* %s\nplatform=%s\ncompiler=%s\ndate=%s\ncommit=%s\n" uu___2 uu___3 uu___4 uu___5 uu___6 in - FStarC_Compiler_Util.print_string uu___1 + FStarC_Util.print_string uu___1 let (bold_doc : FStarC_Pprint.document -> FStarC_Pprint.document) = fun d -> let uu___ = - let uu___1 = FStarC_Compiler_Util.stdout_isatty () in + let uu___1 = FStarC_Util.stdout_isatty () in uu___1 = (FStar_Pervasives_Native.Some true) in if uu___ then @@ -886,13 +888,12 @@ let (bold_doc : FStarC_Pprint.document -> FStarC_Pprint.document) = else d let (display_debug_keys : unit -> unit) = fun uu___ -> - let keys = FStarC_Compiler_Debug.list_all_toggles () in - let uu___1 = - FStarC_Compiler_List.sortWith FStarC_Compiler_String.compare keys in - FStarC_Compiler_List.iter + let keys = FStarC_Debug.list_all_toggles () in + let uu___1 = FStarC_List.sortWith FStarC_String.compare keys in + FStarC_List.iter (fun s -> - let uu___2 = FStarC_Compiler_String.op_Hat s "\n" in - FStarC_Compiler_Util.print_string uu___2) uu___1 + let uu___2 = FStarC_String.op_Hat s "\n" in + FStarC_Util.print_string uu___2) uu___1 let (usage_for : (FStarC_Getopt.opt * FStarC_Pprint.document) -> FStarC_Pprint.document) = fun o -> @@ -912,9 +913,8 @@ let (usage_for : let uu___1 = let uu___2 = let uu___3 = - let uu___4 = - FStarC_Compiler_String.make Prims.int_one short in - FStarC_Compiler_String.op_Hat "-" uu___4 in + let uu___4 = FStarC_String.make Prims.int_one short in + FStarC_String.op_Hat "-" uu___4 in FStarC_Pprint.doc_of_string uu___3 in FStarC_Pprint.op_Hat_Hat uu___2 arg in [uu___1] @@ -924,7 +924,7 @@ let (usage_for : then let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_String.op_Hat "--" flag in + let uu___3 = FStarC_String.op_Hat "--" flag in FStarC_Pprint.doc_of_string uu___3 in FStarC_Pprint.op_Hat_Hat uu___2 arg in [uu___1] @@ -936,7 +936,7 @@ let (usage_for : let uu___5 = FStarC_Pprint.blank Prims.int_one in FStarC_Pprint.op_Hat_Hat FStarC_Pprint.comma uu___5 in FStarC_Pprint.separate uu___4 - (FStarC_Compiler_List.op_At short_opt long_opt) in + (FStarC_List.op_At short_opt long_opt) in bold_doc uu___3 in FStarC_Pprint.group uu___2 in let uu___2 = @@ -963,13 +963,13 @@ let (display_usage_aux : let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Util.colorize_bold "@" in - FStarC_Compiler_Util.format1 + let uu___4 = FStarC_Util.colorize_bold "@" in + FStarC_Util.format1 " %srespfile: read command-line options from respfile\n" uu___4 in FStarC_Pprint.doc_of_string uu___3 in let uu___3 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun o -> fun rest -> let uu___4 = usage_for o in @@ -978,9 +978,9 @@ let (display_usage_aux : FStarC_Pprint.op_Hat_Slash_Hat uu___2 uu___3 in FStarC_Pprint.op_Hat_Slash_Hat uu___ uu___1 in let uu___ = - FStarC_Pprint.pretty_string - (FStarC_Compiler_Util.float_of_string "1.0") (Prims.of_int (80)) d in - FStarC_Compiler_Util.print_string uu___ + FStarC_Pprint.pretty_string (FStarC_Util.float_of_string "1.0") + (Prims.of_int (80)) d in + FStarC_Util.print_string uu___ let (mk_spec : (FStarC_BaseTypes.char * Prims.string * option_val FStarC_Getopt.opt_variant) -> FStarC_Getopt.opt) @@ -1003,15 +1003,15 @@ let (accumulated_option : Prims.string -> option_val -> option_val) = fun value -> let prev_values = let uu___ = lookup_opt name (as_option as_list') in - FStarC_Compiler_Util.dflt [] uu___ in + FStarC_Util.dflt [] uu___ in List (value :: prev_values) let (reverse_accumulated_option : Prims.string -> option_val -> option_val) = fun name -> fun value -> let prev_values = let uu___ = lookup_opt name (as_option as_list') in - FStarC_Compiler_Util.dflt [] uu___ in - List (FStarC_Compiler_List.op_At prev_values [value]) + FStarC_Util.dflt [] uu___ in + List (FStarC_List.op_At prev_values [value]) let accumulate_string : 'uuuuu . Prims.string -> ('uuuuu -> Prims.string) -> 'uuuuu -> unit = fun name -> @@ -1022,14 +1022,11 @@ let accumulate_string : accumulated_option name uu___1 in set_option name uu___ let (add_extract_module : Prims.string -> unit) = - fun s -> - accumulate_string "extract_module" FStarC_Compiler_String.lowercase s + fun s -> accumulate_string "extract_module" FStarC_String.lowercase s let (add_extract_namespace : Prims.string -> unit) = - fun s -> - accumulate_string "extract_namespace" FStarC_Compiler_String.lowercase s + fun s -> accumulate_string "extract_namespace" FStarC_String.lowercase s let (add_verify_module : Prims.string -> unit) = - fun s -> - accumulate_string "verify_module" FStarC_Compiler_String.lowercase s + fun s -> accumulate_string "verify_module" FStarC_String.lowercase s exception InvalidArgument of Prims.string let (uu___is_InvalidArgument : Prims.exn -> Prims.bool) = fun projectee -> @@ -1048,13 +1045,11 @@ let rec (parse_opt_val : (match typ with | Const c -> c | IntStr uu___1 -> - let uu___2 = - FStarC_Compiler_Util.safe_int_of_string str_val in + let uu___2 = FStarC_Util.safe_int_of_string str_val in (match uu___2 with | FStar_Pervasives_Native.Some v -> Int v | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.raise - (InvalidArgument opt_name)) + FStarC_Effect.raise (InvalidArgument opt_name)) | BoolStr -> let uu___1 = if str_val = "true" @@ -1062,18 +1057,14 @@ let rec (parse_opt_val : else if str_val = "false" then false - else - FStarC_Compiler_Effect.raise - (InvalidArgument opt_name) in + else FStarC_Effect.raise (InvalidArgument opt_name) in Bool uu___1 | PathStr uu___1 -> Path str_val | SimpleStr uu___1 -> String str_val | EnumStr strs -> - if FStarC_Compiler_List.mem str_val strs + if FStarC_List.mem str_val strs then String str_val - else - FStarC_Compiler_Effect.raise - (InvalidArgument opt_name) + else FStarC_Effect.raise (InvalidArgument opt_name) | OpenEnumStr uu___1 -> String str_val | PostProcessed (pp, elem_spec) -> let uu___1 = parse_opt_val opt_name elem_spec str_val in @@ -1090,14 +1081,13 @@ let rec (parse_opt_val : with | InvalidArgument opt_name1 -> let uu___1 = - FStarC_Compiler_Util.format1 "Invalid argument to --%s" - opt_name1 in + FStarC_Util.format1 "Invalid argument to --%s" opt_name1 in failwith uu___1 let rec (desc_of_opt_type : opt_type -> Prims.string FStar_Pervasives_Native.option) = fun typ -> let desc_of_enum cases = - FStar_Pervasives_Native.Some (FStarC_Compiler_String.concat "|" cases) in + FStar_Pervasives_Native.Some (FStarC_String.concat "|" cases) in match typ with | Const c -> FStar_Pervasives_Native.None | IntStr desc -> FStar_Pervasives_Native.Some desc @@ -1106,7 +1096,7 @@ let rec (desc_of_opt_type : | SimpleStr desc -> FStar_Pervasives_Native.Some desc | EnumStr strs -> desc_of_enum strs | OpenEnumStr (strs, desc) -> - desc_of_enum (FStarC_Compiler_List.op_At strs [desc]) + desc_of_enum (FStarC_List.op_At strs [desc]) | PostProcessed (uu___, elem_spec) -> desc_of_opt_type elem_spec | Accumulated elem_spec -> desc_of_opt_type elem_spec | ReverseAccumulated elem_spec -> desc_of_opt_type elem_spec @@ -1116,8 +1106,8 @@ let (arg_spec_of_opt_type : fun opt_name -> fun typ -> let wrap s = - let uu___ = FStarC_Compiler_String.op_Hat s ">" in - FStarC_Compiler_String.op_Hat "<" uu___ in + let uu___ = FStarC_String.op_Hat s ">" in + FStarC_String.op_Hat "<" uu___ in let parser = parse_opt_val opt_name typ in let uu___ = desc_of_opt_type typ in match uu___ with @@ -1126,20 +1116,18 @@ let (arg_spec_of_opt_type : | FStar_Pervasives_Native.Some desc -> let desc1 = wrap desc in FStarC_Getopt.OneArg (parser, desc1) let (pp_validate_dir : option_val -> option_val) = - fun p -> - let pp = as_string p in FStarC_Compiler_Util.mkdir false true pp; p + fun p -> let pp = as_string p in FStarC_Util.mkdir false true pp; p let (pp_lowercase : option_val -> option_val) = fun s -> - let uu___ = - let uu___1 = as_string s in FStarC_Compiler_String.lowercase uu___1 in + let uu___ = let uu___1 = as_string s in FStarC_String.lowercase uu___1 in String uu___ -let (abort_counter : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero +let (abort_counter : Prims.int FStarC_Effect.ref) = + FStarC_Util.mk_ref Prims.int_zero let (interp_quake_arg : Prims.string -> (Prims.int * Prims.int * Prims.bool)) = fun s -> - let ios = FStarC_Compiler_Util.int_of_string in - match FStarC_Compiler_Util.split s "/" with + let ios = FStarC_Util.int_of_string in + match FStarC_Util.split s "/" with | f::[] -> let uu___ = ios f in let uu___1 = ios f in (uu___, uu___1, false) | f1::f2::[] -> @@ -1156,12 +1144,11 @@ let (interp_quake_arg : Prims.string -> (Prims.int * Prims.int * Prims.bool)) else failwith "unexpected value for --quake" | uu___ -> failwith "unexpected value for --quake" let (uu___1 : (((Prims.string -> unit) -> unit) * (Prims.string -> unit))) = - let cb = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let cb = FStarC_Util.mk_ref FStar_Pervasives_Native.None in let set1 f = - FStarC_Compiler_Effect.op_Colon_Equals cb - (FStar_Pervasives_Native.Some f) in + FStarC_Effect.op_Colon_Equals cb (FStar_Pervasives_Native.Some f) in let call msg = - let uu___ = FStarC_Compiler_Effect.op_Bang cb in + let uu___ = FStarC_Effect.op_Bang cb in match uu___ with | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some f -> f msg in @@ -1194,8 +1181,7 @@ let rec (specs_with_types : ((fun uu___3 -> match uu___3 with | Int x -> - (FStarC_Compiler_Effect.op_Colon_Equals abort_counter x; - Int x) + (FStarC_Effect.op_Colon_Equals abort_counter x; Int x) | x -> failwith "?"), (IntStr "non-negative integer"))), uu___2) in let uu___2 = @@ -1293,6 +1279,7 @@ let rec (specs_with_types : "FSharp"; "krml"; "Plugin"; + "PluginNoLib"; "Extension"]), uu___26) in let uu___26 = let uu___27 = @@ -1309,8 +1296,7 @@ let rec (specs_with_types : "Enable general debugging, i.e. increase verbosity." in (100, "", (PostProcessed - ((fun o -> - FStarC_Compiler_Debug.enable (); o), + ((fun o -> FStarC_Debug.enable (); o), (Const (Bool true)))), uu___30) in let uu___30 = let uu___31 = @@ -1322,8 +1308,7 @@ let rec (specs_with_types : ((fun o -> let keys = as_comma_string_list o in - FStarC_Compiler_Debug.enable_toggles - keys; + FStarC_Debug.enable_toggles keys; o), (ReverseAccumulated (SimpleStr "debug toggles")))), @@ -1338,7 +1323,7 @@ let rec (specs_with_types : ((fun o -> match o with | Bool (true) -> - (FStarC_Compiler_Debug.set_debug_all + (FStarC_Debug.set_debug_all (); o) | uu___35 -> failwith "?"), @@ -1483,13 +1468,13 @@ let rec (specs_with_types : let parse_ext s = let exts = - FStarC_Compiler_Util.split + FStarC_Util.split s ";" in - FStarC_Compiler_List.collect + FStarC_List.collect (fun s1 -> match - FStarC_Compiler_Util.split + FStarC_Util.split s1 "=" with | @@ -1508,10 +1493,10 @@ let rec (specs_with_types : = as_comma_string_list o in - FStarC_Compiler_List.collect + FStarC_List.collect parse_ext uu___55 in - FStarC_Compiler_List.iter + FStarC_List.iter ( fun uu___55 @@ -1532,7 +1517,7 @@ let rec (specs_with_types : let uu___53 = let uu___54 = text - "Extract only those modules whose names or namespaces match the provided options. 'TargetName' ranges over {OCaml, krml, FSharp, Plugin, Extension}. A 'ModuleSelector' is a space or comma-separated list of '[+|-]( * | namespace | module)'. For example --extract 'OCaml:A -A.B' --extract 'krml:A -A.C' --extract '*' means for OCaml, extract everything in the A namespace only except A.B; for krml, extract everything in the A namespace only except A.C; for everything else, extract everything. Note, the '+' is optional: --extract '+A' and --extract 'A' mean the same thing. Note also that '--extract A' applies both to a module named 'A' and to any module in the 'A' namespace Multiple uses of this option accumulate, e.g., --extract A --extract B is interpreted as --extract 'A B'." in + "Extract only those modules whose names or namespaces match the provided options. 'TargetName' ranges over {OCaml, krml, FSharp, Plugin, PluginNoLib, Extension}. A 'ModuleSelector' is a space or comma-separated list of '[+|-]( * | namespace | module)'. For example --extract 'OCaml:A -A.B' --extract 'krml:A -A.C' --extract '*' means for OCaml, extract everything in the A namespace only except A.B; for krml, extract everything in the A namespace only except A.C; for everything else, extract everything. Note, the '+' is optional: --extract '+A' and --extract 'A' mean the same thing. Note also that '--extract A' applies both to a module named 'A' and to any module in the 'A' namespace Multiple uses of this option accumulate, e.g., --extract A --extract B is interpreted as --extract 'A B'." in (FStarC_Getopt.noshort, "extract", (Accumulated @@ -1581,13 +1566,15 @@ let rec (specs_with_types : let uu___62 = text - "Format of the messages emitted by F* (default `human`)" in + "Format of the messages emitted by F*. Using 'auto' will use human messages unless the variable GITHUB_ACTIONS is non-empty, in which case 'github' is used (default `auto`)." in (FStarC_Getopt.noshort, "message_format", ( EnumStr ["human"; - "json"]), + "json"; + "github"; + "auto"]), uu___62) in let uu___62 = let uu___63 @@ -1778,14 +1765,14 @@ let rec (specs_with_types : let p f = let uu___90 = - FStarC_Compiler_Util.int_of_string + FStarC_Util.int_of_string f in Int uu___90 in let uu___90 = match - FStarC_Compiler_Util.split + FStarC_Util.split s "," with | @@ -1847,14 +1834,14 @@ let rec (specs_with_types : let p f = let uu___92 = - FStarC_Compiler_Util.int_of_string + FStarC_Util.int_of_string f in Int uu___92 in let uu___92 = match - FStarC_Compiler_Util.split + FStarC_Util.split s "," with | @@ -2073,7 +2060,7 @@ let rec (specs_with_types : let uu___116 = text - "Set the default effect *module* for --MLish (default: FStar.Compiler.Effect)" in + "Set the default effect *module* for --MLish (default: FStar.Effect)" in (FStarC_Getopt.noshort, "MLish_effect", (SimpleStr @@ -3056,7 +3043,7 @@ let rec (specs_with_types : let uu___226 = text - "Prunes the context to include only the facts from the given namespace or fact id. Facts can be include or excluded using the [+|-] qualifier. For example --using_facts_from '* -FStarC.Reflection +FStarC.Compiler.List -FStarC.Compiler.List.Tot' will remove all facts from FStarC.Compiler.List.Tot.*, retain all remaining facts from FStarC.Compiler.List.*, remove all facts from FStarC.Reflection.*, and retain all the rest. Note, the '+' is optional: --using_facts_from 'FStarC.Compiler.List' is equivalent to --using_facts_from '+FStarC.Compiler.List'. Multiple uses of this option accumulate, e.g., --using_facts_from A --using_facts_from B is interpreted as --using_facts_from A^B." in + "Prunes the context to include only the facts from the given namespace or fact id. Facts can be include or excluded using the [+|-] qualifier. For example --using_facts_from '* -FStarC.Reflection +FStarC.List -FStarC.List.Tot' will remove all facts from FStarC.List.Tot.*, retain all remaining facts from FStarC.List.*, remove all facts from FStarC.Reflection.*, and retain all the rest. Note, the '+' is optional: --using_facts_from 'FStarC.List' is equivalent to --using_facts_from '+FStarC.List'. Multiple uses of this option accumulate, e.g., --using_facts_from A --using_facts_from B is interpreted as --using_facts_from A^B." in (FStarC_Getopt.noshort, "using_facts_from", (ReverseAccumulated @@ -3093,7 +3080,7 @@ let rec (specs_with_types : -> display_version (); - FStarC_Compiler_Effect.exit + FStarC_Effect.exit Prims.int_zero), (Const (Bool @@ -3331,25 +3318,39 @@ let rec (specs_with_types : let uu___258 = text + "Expose compiler internal modules (FStarC namespace). Only for advanced plugins you should probably not use it." in + (FStarC_Getopt.noshort, + "with_fstarc", + (Const + (Bool + true)), + uu___258) in + let uu___258 + = + let uu___259 + = + let uu___260 + = + text "Debug messages for embeddings/unembeddings of natively compiled terms" in (FStarC_Getopt.noshort, "__debug_embedding", (WithSideEffect ((fun - uu___259 + uu___261 -> - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals debug_embedding true), (Const (Bool true)))), - uu___258) in - let uu___258 + uu___260) in + let uu___260 = - let uu___259 + let uu___261 = - let uu___260 + let uu___262 = text "Eagerly embed and unembed terms to primitive operations and plugins: not recommended except for benchmarking" in @@ -3357,20 +3358,20 @@ let rec (specs_with_types : "eager_embedding", (WithSideEffect ((fun - uu___261 + uu___263 -> - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals eager_embedding true), (Const (Bool true)))), - uu___260) in - let uu___260 + uu___262) in + let uu___262 = - let uu___261 + let uu___263 = - let uu___262 + let uu___264 = text "Emit profiles grouped by declaration rather than by module" in @@ -3379,12 +3380,12 @@ let rec (specs_with_types : (Const (Bool true)), - uu___262) in - let uu___262 + uu___264) in + let uu___264 = - let uu___263 + let uu___265 = - let uu___264 + let uu___266 = text "Specific source locations in the compiler are instrumented with profiling counters. Pass `--profile_component FStarC.TypeChecker` to enable all counters in the FStarC.TypeChecker namespace. This option is a module or namespace selector, like many other options (e.g., `--extract`)" in @@ -3393,12 +3394,12 @@ let rec (specs_with_types : (Accumulated (SimpleStr "One or more space-separated occurrences of '[+|-]( * | namespace | module | identifier)'")), - uu___264) in - let uu___264 + uu___266) in + let uu___266 = - let uu___265 + let uu___267 = - let uu___266 + let uu___268 = text "Profiling can be enabled when the compiler is processing a given set of source modules. Pass `--profile FStar.Pervasives` to enable profiling when the compiler is processing any module in FStar.Pervasives. This option is a module or namespace selector, like many other options (e.g., `--extract`)" in @@ -3407,12 +3408,12 @@ let rec (specs_with_types : (Accumulated (SimpleStr "One or more space-separated occurrences of '[+|-]( * | namespace | module)'")), - uu___266) in - let uu___266 + uu___268) in + let uu___268 = - let uu___267 + let uu___269 = - let uu___268 + let uu___270 = text "Display this information" in @@ -3420,26 +3421,26 @@ let rec (specs_with_types : "help", (WithSideEffect ((fun - uu___269 + uu___271 -> ( - let uu___271 + let uu___273 = specs warn_unsafe in display_usage_aux - uu___271); - FStarC_Compiler_Effect.exit + uu___273); + FStarC_Effect.exit Prims.int_zero), (Const (Bool true)))), - uu___268) in - let uu___268 + uu___270) in + let uu___270 = - let uu___269 + let uu___271 = - let uu___270 + let uu___272 = text "List all debug keys and exit" in @@ -3447,29 +3448,15 @@ let rec (specs_with_types : "list_debug_keys", (WithSideEffect ((fun - uu___271 + uu___273 -> display_debug_keys (); - FStarC_Compiler_Effect.exit + FStarC_Effect.exit Prims.int_zero), (Const (Bool true)))), - uu___270) in - let uu___270 - = - let uu___271 - = - let uu___272 - = - text - "List all registered plugins and exit" in - (FStarC_Getopt.noshort, - "list_plugins", - (Const - (Bool - true)), uu___272) in let uu___272 = @@ -3478,9 +3465,9 @@ let rec (specs_with_types : let uu___274 = text - "Print the root of the F* installation and exit" in + "List all registered plugins and exit" in (FStarC_Getopt.noshort, - "locate", + "list_plugins", (Const (Bool true)), @@ -3492,9 +3479,9 @@ let rec (specs_with_types : let uu___276 = text - "Print the root of the F* library and exit" in + "Print the root of the F* installation and exit" in (FStarC_Getopt.noshort, - "locate_lib", + "locate", (Const (Bool true)), @@ -3506,9 +3493,9 @@ let rec (specs_with_types : let uu___278 = text - "Print the root of the built OCaml F* library and exit" in + "Print the root of the F* library and exit" in (FStarC_Getopt.noshort, - "locate_ocaml", + "locate_lib", (Const (Bool true)), @@ -3520,11 +3507,12 @@ let rec (specs_with_types : let uu___280 = text - "Find a file in F*'s include path and print its absolute path, then exit" in + "Print the root of the built OCaml F* library and exit" in (FStarC_Getopt.noshort, - "locate_file", - (SimpleStr - "basename"), + "locate_ocaml", + (Const + (Bool + true)), uu___280) in let uu___280 = @@ -3533,11 +3521,11 @@ let rec (specs_with_types : let uu___282 = text - "Locate the executable for a given Z3 version, then exit. The output is either an absolute path, or a name that was found in the PATH. Note: this is the Z3 executable that F* will attempt to call for the given version, but the version check is not performed at this point." in + "Find a file in F*'s include path and print its absolute path, then exit" in (FStarC_Getopt.noshort, - "locate_z3", + "locate_file", (SimpleStr - "version"), + "basename"), uu___282) in let uu___282 = @@ -3546,26 +3534,39 @@ let rec (specs_with_types : let uu___284 = text + "Locate the executable for a given Z3 version, then exit. The output is either an absolute path, or a name that was found in the PATH. Note: this is the Z3 executable that F* will attempt to call for the given version, but the version check is not performed at this point." in + (FStarC_Getopt.noshort, + "locate_z3", + (SimpleStr + "version"), + uu___284) in + let uu___284 + = + let uu___285 + = + let uu___286 + = + text "With no arguments: print shell code to set up an environment with the OCaml libraries in scope (similar to 'opam env'). With arguments: run a command in that environment. NOTE: this must be the FIRST argument passed to F* and other options are NOT processed." in (FStarC_Getopt.noshort, "ocamlenv", (WithSideEffect ((fun - uu___285 + uu___287 -> - FStarC_Compiler_Util.print_error + FStarC_Util.print_error "--ocamlenv must be the first argument, see fstar.exe --help for details\n"; - FStarC_Compiler_Effect.exit + FStarC_Effect.exit Prims.int_one), (Const (Bool true)))), - uu___284) in - let uu___284 + uu___286) in + let uu___286 = - let uu___285 + let uu___287 = - let uu___286 + let uu___288 = text "A helper. This runs 'ocamlc' in the environment set up by --ocamlenv, for building an F* application bytecode executable." in @@ -3573,21 +3574,21 @@ let rec (specs_with_types : "ocamlc", (WithSideEffect ((fun - uu___287 + uu___289 -> - FStarC_Compiler_Util.print_error + FStarC_Util.print_error "--ocamlc must be the first argument, see fstar.exe --help for details\n"; - FStarC_Compiler_Effect.exit + FStarC_Effect.exit Prims.int_one), (Const (Bool true)))), - uu___286) in - let uu___286 + uu___288) in + let uu___288 = - let uu___287 + let uu___289 = - let uu___288 + let uu___290 = text "A helper. This runs 'ocamlopt' in the environment set up by --ocamlenv, for building an F* application native executable." in @@ -3595,21 +3596,21 @@ let rec (specs_with_types : "ocamlopt", (WithSideEffect ((fun - uu___289 + uu___291 -> - FStarC_Compiler_Util.print_error + FStarC_Util.print_error "--ocamlopt must be the first argument, see fstar.exe --help for details\n"; - FStarC_Compiler_Effect.exit + FStarC_Effect.exit Prims.int_one), (Const (Bool true)))), - uu___288) in - let uu___288 + uu___290) in + let uu___290 = - let uu___289 + let uu___291 = - let uu___290 + let uu___292 = text "A helper. This runs 'ocamlopt' in the environment set up by --ocamlenv, for building an F* plugin." in @@ -3617,17 +3618,20 @@ let rec (specs_with_types : "ocamlopt_plugin", (WithSideEffect ((fun - uu___291 + uu___293 -> - FStarC_Compiler_Util.print_error + FStarC_Util.print_error "--ocamlopt_plugin must be the first argument, see fstar.exe --help for details\n"; - FStarC_Compiler_Effect.exit + FStarC_Effect.exit Prims.int_one), (Const (Bool true)))), - uu___290) in - [uu___289] in + uu___292) in + [uu___291] in + uu___289 + :: + uu___290 in uu___287 :: uu___288 in @@ -4004,7 +4008,7 @@ and (specs : Prims.bool -> (FStarC_Getopt.opt * FStarC_Pprint.document) Prims.list) = fun warn_unsafe -> let uu___ = specs_with_types warn_unsafe in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (short, long, typ, doc) -> @@ -4069,6 +4073,7 @@ let (settable : Prims.string -> Prims.bool) = | "quake" -> true | "query_cache" -> true | "query_stats" -> true + | "record_hints" -> true | "record_options" -> true | "retry" -> true | "reuse_hint_for" -> true @@ -4109,7 +4114,7 @@ let (settable : Prims.string -> Prims.bool) = let (all_specs : (FStarC_Getopt.opt * FStarC_Pprint.document) Prims.list) = specs true let (all_specs_getopt : FStarC_Getopt.opt Prims.list) = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst all_specs + FStarC_List.map FStar_Pervasives_Native.fst all_specs let (all_specs_with_types : (FStarC_BaseTypes.char * Prims.string * opt_type * FStarC_Pprint.document) Prims.list) @@ -4118,15 +4123,29 @@ let (settable_specs : ((FStarC_BaseTypes.char * Prims.string * unit FStarC_Getopt.opt_variant) * FStarC_Pprint.document) Prims.list) = - FStarC_Compiler_List.filter - (fun uu___ -> - match uu___ with | ((uu___2, x, uu___3), uu___4) -> settable x) - all_specs + FStarC_List.map + (fun spec -> + let uu___ = spec in + match uu___ with + | ((c, x, h), doc) -> + let uu___2 = settable x in + if uu___2 + then spec + else + (let h' = + match h with + | FStarC_Getopt.ZeroArgs uu___4 -> + FStarC_Getopt.ZeroArgs + ((fun uu___5 -> FStarC_Effect.raise (NotSettable x))) + | FStarC_Getopt.OneArg (uu___4, k) -> + FStarC_Getopt.OneArg + (((fun s -> FStarC_Effect.raise (NotSettable x))), k) in + ((c, x, h'), doc))) all_specs let (help_for_option : Prims.string -> FStarC_Pprint.document FStar_Pervasives_Native.option) = fun s -> let uu___ = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | ((uu___3, x, uu___4), uu___5) -> x = s) all_specs in @@ -4138,12 +4157,11 @@ let (uu___2 : (((unit -> FStarC_Getopt.parse_cmdline_res) -> unit) * (unit -> FStarC_Getopt.parse_cmdline_res))) = - let callback = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let callback = FStarC_Util.mk_ref FStar_Pervasives_Native.None in let set1 f = - FStarC_Compiler_Effect.op_Colon_Equals callback - (FStar_Pervasives_Native.Some f) in + FStarC_Effect.op_Colon_Equals callback (FStar_Pervasives_Native.Some f) in let call uu___ = - let uu___3 = FStarC_Compiler_Effect.op_Bang callback in + let uu___3 = FStarC_Effect.op_Bang callback in match uu___3 with | FStar_Pervasives_Native.None -> failwith "Error flags callback not yet set" @@ -4161,10 +4179,9 @@ let (set_error_flags_callback : (unit -> FStarC_Getopt.parse_cmdline_res) -> unit) = set_error_flags_callback_aux let (display_usage : unit -> unit) = fun uu___ -> display_usage_aux all_specs -let (fstar_bin_directory : Prims.string) = - FStarC_Compiler_Util.get_exec_dir () -let (file_list_ : Prims.string Prims.list FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref [] +let (fstar_bin_directory : Prims.string) = FStarC_Util.get_exec_dir () +let (file_list_ : Prims.string Prims.list FStarC_Effect.ref) = + FStarC_Util.mk_ref [] let rec (parse_filename_arg : FStarC_Getopt.opt Prims.list -> Prims.bool -> Prims.string -> FStarC_Getopt.parse_cmdline_res) @@ -4172,20 +4189,19 @@ let rec (parse_filename_arg : fun specs1 -> fun enable_filenames -> fun arg -> - if FStarC_Compiler_Util.starts_with arg "@" + if FStarC_Util.starts_with arg "@" then - let filename = - FStarC_Compiler_Util.substring_from arg Prims.int_one in - let lines = FStarC_Compiler_Util.file_get_lines filename in + let filename = FStarC_Util.substring_from arg Prims.int_one in + let lines = FStarC_Util.file_get_lines filename in FStarC_Getopt.parse_list specs1 (parse_filename_arg specs1 enable_filenames) lines else (if enable_filenames then (let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang file_list_ in - FStarC_Compiler_List.op_At uu___5 [arg] in - FStarC_Compiler_Effect.op_Colon_Equals file_list_ uu___4) + let uu___5 = FStarC_Effect.op_Bang file_list_ in + FStarC_List.op_At uu___5 [arg] in + FStarC_Effect.op_Colon_Equals file_list_ uu___4) else (); FStarC_Getopt.Success) let (parse_cmd_line : @@ -4196,13 +4212,9 @@ let (parse_cmd_line : (parse_filename_arg all_specs_getopt true) in let res1 = if res = FStarC_Getopt.Success then set_error_flags () else res in - let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang file_list_ in - FStarC_Compiler_List.map FStarC_Common.try_convert_file_name_to_mixed - uu___4 in - (res1, uu___3) + let uu___3 = FStarC_Effect.op_Bang file_list_ in (res1, uu___3) let (file_list : unit -> Prims.string Prims.list) = - fun uu___ -> FStarC_Compiler_Effect.op_Bang file_list_ + fun uu___ -> FStarC_Effect.op_Bang file_list_ let (restore_cmd_line_options : Prims.bool -> FStarC_Getopt.parse_cmdline_res) = fun should_clear -> @@ -4210,35 +4222,34 @@ let (restore_cmd_line_options : if should_clear then clear () else init (); (let specs1 = let uu___3 = specs false in - FStarC_Compiler_List.map FStar_Pervasives_Native.fst uu___3 in + FStarC_List.map FStar_Pervasives_Native.fst uu___3 in let r = FStarC_Getopt.parse_cmdline specs1 (parse_filename_arg specs1 false) in (let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_List.map (fun uu___7 -> String uu___7) - old_verify_module in + FStarC_List.map (fun uu___7 -> String uu___7) old_verify_module in List uu___6 in ("verify_module", uu___5) in set_option' uu___4); r) let (module_name_of_file_name : Prims.string -> Prims.string) = fun f -> - let f1 = FStarC_Compiler_Util.basename f in + let f1 = FStarC_Util.basename f in let f2 = let uu___ = let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_Util.get_file_extension f1 in - FStarC_Compiler_String.length uu___5 in - (FStarC_Compiler_String.length f1) - uu___4 in + let uu___5 = FStarC_Util.get_file_extension f1 in + FStarC_String.length uu___5 in + (FStarC_String.length f1) - uu___4 in uu___3 - Prims.int_one in - FStarC_Compiler_String.substring f1 Prims.int_zero uu___ in - FStarC_Compiler_String.lowercase f2 + FStarC_String.substring f1 Prims.int_zero uu___ in + FStarC_String.lowercase f2 let (should_check : Prims.string -> Prims.bool) = fun m -> let l = get_verify_module () in - FStarC_Compiler_List.contains (FStarC_Compiler_String.lowercase m) l + FStarC_List.contains (FStarC_String.lowercase m) l let (should_verify : Prims.string -> Prims.bool) = fun m -> (let uu___ = get_lax () in Prims.op_Negation uu___) && (should_check m) @@ -4248,9 +4259,7 @@ let (should_verify_file : Prims.string -> Prims.bool) = fun fn -> let uu___ = module_name_of_file_name fn in should_verify uu___ let (module_name_eq : Prims.string -> Prims.string -> Prims.bool) = fun m1 -> - fun m2 -> - (FStarC_Compiler_String.lowercase m1) = - (FStarC_Compiler_String.lowercase m2) + fun m2 -> (FStarC_String.lowercase m1) = (FStarC_String.lowercase m2) let (should_print_message : Prims.string -> Prims.bool) = fun m -> let uu___ = should_verify m in if uu___ then m <> "Prims" else false @@ -4261,19 +4270,19 @@ let (cache_dir : unit -> Prims.string FStar_Pervasives_Native.option) = let (include_ : unit -> Prims.string Prims.list) = fun uu___ -> get_include () let (path_of_text : Prims.string -> Prims.string Prims.list) = - fun text -> FStarC_Compiler_String.split [46] text + fun text -> FStarC_String.split [46] text let (parse_settings : Prims.string Prims.list -> (Prims.string Prims.list * Prims.bool) Prims.list) = fun ns -> - let cache = FStarC_Compiler_Util.smap_create (Prims.of_int (31)) in + let cache = FStarC_Util.smap_create (Prims.of_int (31)) in let with_cache f s = - let uu___ = FStarC_Compiler_Util.smap_try_find cache s in + let uu___ = FStarC_Util.smap_try_find cache s in match uu___ with | FStar_Pervasives_Native.Some s1 -> s1 | FStar_Pervasives_Native.None -> - let res = f s in (FStarC_Compiler_Util.smap_add cache s res; res) in + let res = f s in (FStarC_Util.smap_add cache s res; res) in let parse_one_setting s = if s = "*" then ([], true) @@ -4281,37 +4290,36 @@ let (parse_settings : if s = "-*" then ([], false) else - if FStarC_Compiler_Util.starts_with s "-" + if FStarC_Util.starts_with s "-" then (let path = - let uu___4 = - FStarC_Compiler_Util.substring_from s Prims.int_one in + let uu___4 = FStarC_Util.substring_from s Prims.int_one in path_of_text uu___4 in (path, false)) else (let s1 = - if FStarC_Compiler_Util.starts_with s "+" - then FStarC_Compiler_Util.substring_from s Prims.int_one + if FStarC_Util.starts_with s "+" + then FStarC_Util.substring_from s Prims.int_one else s in ((path_of_text s1), true)) in let uu___ = - FStarC_Compiler_List.collect + FStarC_List.collect (fun s -> - let s1 = FStarC_Compiler_Util.trim_string s in + let s1 = FStarC_Util.trim_string s in if s1 = "" then [] else with_cache (fun s2 -> - let s3 = FStarC_Compiler_Util.replace_char s2 32 44 in + let s3 = FStarC_Util.replace_char s2 32 44 in let uu___4 = let uu___5 = - FStarC_Compiler_List.concatMap - (fun s4 -> FStarC_Compiler_Util.split s4 ",") - (FStarC_Compiler_Util.splitlines s3) in - FStarC_Compiler_List.filter (fun s4 -> s4 <> "") uu___5 in - FStarC_Compiler_List.map parse_one_setting uu___4) s1) ns in - FStarC_Compiler_List.rev uu___ + FStarC_List.concatMap + (fun s4 -> FStarC_Util.split s4 ",") + (FStarC_Util.splitlines s3) in + FStarC_List.filter (fun s4 -> s4 <> "") uu___5 in + FStarC_List.map parse_one_setting uu___4) s1) ns in + FStarC_List.rev uu___ let (admit_smt_queries : unit -> Prims.bool) = fun uu___ -> get_admit_smt_queries () let (admit_except : unit -> Prims.string FStar_Pervasives_Native.option) = @@ -4356,6 +4364,7 @@ let (parse_codegen : | "FSharp" -> FStar_Pervasives_Native.Some FSharp | "krml" -> FStar_Pervasives_Native.Some Krml | "Plugin" -> FStar_Pervasives_Native.Some Plugin + | "PluginNoLib" -> FStar_Pervasives_Native.Some PluginNoLib | "Extension" -> FStar_Pervasives_Native.Some Extension | uu___3 -> FStar_Pervasives_Native.None let (print_codegen : codegen_t -> Prims.string) = @@ -4365,18 +4374,17 @@ let (print_codegen : codegen_t -> Prims.string) = | FSharp -> "FSharp" | Krml -> "krml" | Plugin -> "Plugin" + | PluginNoLib -> "PluginNoLib" | Extension -> "Extension" let (codegen : unit -> codegen_t FStar_Pervasives_Native.option) = fun uu___ -> let uu___3 = get_codegen () in - FStarC_Compiler_Util.map_opt uu___3 - (fun s -> - let uu___4 = parse_codegen s in FStarC_Compiler_Util.must uu___4) + FStarC_Util.map_opt uu___3 + (fun s -> let uu___4 = parse_codegen s in FStarC_Util.must uu___4) let (codegen_libs : unit -> Prims.string Prims.list Prims.list) = fun uu___ -> let uu___3 = get_codegen_lib () in - FStarC_Compiler_List.map (fun x -> FStarC_Compiler_Util.split x ".") - uu___3 + FStarC_List.map (fun x -> FStarC_Util.split x ".") uu___3 let (profile_group_by_decl : unit -> Prims.bool) = fun uu___ -> get_profile_group_by_decl () let (defensive : unit -> Prims.bool) = @@ -4395,25 +4403,39 @@ let (any_dump_module : unit -> Prims.bool) = let (dump_module : Prims.string -> Prims.bool) = fun s -> let uu___ = get_dump_module () in - FStarC_Compiler_List.existsb (module_name_eq s) uu___ + FStarC_List.existsb (module_name_eq s) uu___ let (eager_subtyping : unit -> Prims.bool) = fun uu___ -> get_eager_subtyping () let (error_contexts : unit -> Prims.bool) = fun uu___ -> get_error_contexts () let (expose_interfaces : unit -> Prims.bool) = fun uu___ -> get_expose_interfaces () +let (interactive : unit -> Prims.bool) = + fun uu___ -> ((get_in ()) || (get_ide ())) || (get_lsp ()) let (message_format : unit -> message_format_t) = fun uu___ -> let uu___3 = get_message_format () in match uu___3 with + | "auto" -> + let uu___4 = interactive () in + if uu___4 + then Human + else + (let uu___6 = + FStarC_Util.expand_environment_variable "GITHUB_ACTIONS" in + match uu___6 with + | FStar_Pervasives_Native.None -> Human + | FStar_Pervasives_Native.Some "" -> Human + | FStar_Pervasives_Native.Some uu___7 -> Github) | "human" -> Human | "json" -> Json + | "github" -> Github | illegal -> let uu___4 = let uu___5 = - FStarC_Compiler_String.op_Hat illegal + FStarC_String.op_Hat illegal "`. This should be impossible: `message_format` was supposed to be validated." in - FStarC_Compiler_String.op_Hat + FStarC_String.op_Hat "print_issue: option `message_format` was expected to be `human` or `json`, not `" uu___5 in failwith uu___4 @@ -4437,10 +4459,10 @@ let (hint_file_for_src : Prims.string -> Prims.string) = let uu___3 = hint_dir () in match uu___3 with | FStar_Pervasives_Native.Some dir -> - let uu___4 = FStarC_Compiler_Util.basename src_filename in - FStarC_Compiler_Util.concat_dir_filename dir uu___4 + let uu___4 = FStarC_Util.basename src_filename in + FStarC_Util.concat_dir_filename dir uu___4 | uu___4 -> src_filename in - FStarC_Compiler_Util.format1 "%s.hints" file_name + FStarC_Util.format1 "%s.hints" file_name let (ide : unit -> Prims.bool) = fun uu___ -> get_ide () let (ide_id_info_off : unit -> Prims.bool) = fun uu___ -> get_ide_id_info_off () @@ -4448,16 +4470,15 @@ let (ide_file_name_st : ((Prims.string -> unit) * (unit -> Prims.string FStar_Pervasives_Native.option))) = - let v = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let v = FStarC_Util.mk_ref FStar_Pervasives_Native.None in let set1 f = - let uu___ = FStarC_Compiler_Effect.op_Bang v in + let uu___ = FStarC_Effect.op_Bang v in match uu___ with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.op_Colon_Equals v - (FStar_Pervasives_Native.Some f) + FStarC_Effect.op_Colon_Equals v (FStar_Pervasives_Native.Some f) | FStar_Pervasives_Native.Some uu___3 -> failwith "ide_file_name_st already set" in - let get uu___ = FStarC_Compiler_Effect.op_Bang v in (set1, get) + let get uu___ = FStarC_Effect.op_Bang v in (set1, get) let (set_ide_filename : Prims.string -> unit) = FStar_Pervasives_Native.fst ide_file_name_st let (ide_filename : unit -> Prims.string FStar_Pervasives_Native.option) = @@ -4473,8 +4494,6 @@ let (initial_ifuel : unit -> Prims.int) = fun uu___ -> let uu___3 = get_initial_ifuel () in let uu___4 = get_max_ifuel () in Prims.min uu___3 uu___4 -let (interactive : unit -> Prims.bool) = - fun uu___ -> ((get_in ()) || (get_ide ())) || (get_lsp ()) let (lax : unit -> Prims.bool) = fun uu___ -> get_lax () let (load : unit -> Prims.string Prims.list) = fun uu___ -> get_load () let (load_cmxs : unit -> Prims.string Prims.list) = @@ -4499,7 +4518,7 @@ let (no_default_includes : unit -> Prims.bool) = let (no_extract : Prims.string -> Prims.bool) = fun s -> let uu___ = get_no_extract () in - FStarC_Compiler_List.existsb (module_name_eq s) uu___ + FStarC_List.existsb (module_name_eq s) uu___ let (normalize_pure_terms_for_extraction : unit -> Prims.bool) = fun uu___ -> get_normalize_pure_terms_for_extraction () let (no_location_info : unit -> Prims.bool) = @@ -4590,7 +4609,7 @@ let (split_queries : unit -> split_queries_t) = fun uu___ -> let uu___3 = let uu___4 = get_split_queries () in parse_split_queries uu___4 in - FStarC_Compiler_Util.must uu___3 + FStarC_Util.must uu___3 let (tactic_raw_binders : unit -> Prims.bool) = fun uu___ -> get_tactic_raw_binders () let (tactics_failhard : unit -> Prims.bool) = @@ -4627,8 +4646,7 @@ let (warn_default_effects : unit -> Prims.bool) = fun uu___ -> get_warn_default_effects () let (warn_error : unit -> Prims.string) = fun uu___ -> - let uu___3 = get_warn_error () in - FStarC_Compiler_String.concat " " uu___3 + let uu___3 = get_warn_error () in FStarC_String.concat " " uu___3 let (z3_cliopt : unit -> Prims.string Prims.list) = fun uu___ -> get_z3cliopt () let (z3_smtopt : unit -> Prims.string Prims.list) = @@ -4645,6 +4663,7 @@ let (use_nbe_for_extraction : unit -> Prims.bool) = fun uu___ -> get_use_nbe_for_extraction () let (trivial_pre_for_unannotated_effectful_fns : unit -> Prims.bool) = fun uu___ -> get_trivial_pre_for_unannotated_effectful_fns () +let (with_fstarc : unit -> Prims.bool) = fun uu___ -> get_with_fstarc () let (debug_keys : unit -> Prims.string Prims.list) = fun uu___ -> lookup_opt "debug" as_comma_string_list let (debug_all : unit -> Prims.bool) = @@ -4666,24 +4685,23 @@ let with_saved_options : 'a . (unit -> 'a) -> 'a = pop (); (match r with | FStar_Pervasives.Inr v -> v - | FStar_Pervasives.Inl ex -> FStarC_Compiler_Effect.raise ex))) + | FStar_Pervasives.Inl ex -> FStarC_Effect.raise ex))) else (push (); (let retv = f () in pop (); retv)) let (module_matches_namespace_filter : Prims.string -> Prims.string Prims.list -> Prims.bool) = fun m -> fun filter -> - let m1 = FStarC_Compiler_String.lowercase m in + let m1 = FStarC_String.lowercase m in let setting = parse_settings filter in let m_components = path_of_text m1 in let rec matches_path m_components1 path = match (m_components1, path) with | (uu___, []) -> true | (m2::ms, p::ps) -> - (m2 = (FStarC_Compiler_String.lowercase p)) && - (matches_path ms ps) + (m2 = (FStarC_String.lowercase p)) && (matches_path ms ps) | uu___ -> false in let uu___ = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun uu___3 -> match uu___3 with | (path, uu___4) -> matches_path m_components path) setting in @@ -4719,14 +4737,14 @@ let (print_pes : parsed_extract_setting -> Prims.string) = fun pes -> let uu___ = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (tgt, s) -> - FStarC_Compiler_Util.format2 "(%s, %s)" (print_codegen tgt) - s) pes.target_specific_settings in - FStarC_Compiler_String.concat "; " uu___3 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "(%s, %s)" (print_codegen tgt) s) + pes.target_specific_settings in + FStarC_String.concat "; " uu___3 in + FStarC_Util.format2 "{ target_specific_settings = %s;\n\t\n default_settings = %s }" uu___ (match pes.default_settings with @@ -4740,7 +4758,7 @@ let (find_setting_for_target : fun tgt -> fun s -> let uu___ = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun uu___3 -> match uu___3 with | (x, uu___4) -> x = tgt) s in match uu___ with | FStar_Pervasives_Native.Some (uu___3, s1) -> @@ -4748,8 +4766,7 @@ let (find_setting_for_target : | uu___3 -> FStar_Pervasives_Native.None let (extract_settings : unit -> parsed_extract_setting FStar_Pervasives_Native.option) = - let memo = - FStarC_Compiler_Util.mk_ref (FStar_Pervasives_Native.None, false) in + let memo = FStarC_Util.mk_ref (FStar_Pervasives_Native.None, false) in let merge_parsed_extract_settings p0 p1 = let merge_setting s0 s1 = match (s0, s1) with @@ -4762,8 +4779,8 @@ let (extract_settings : | (FStar_Pervasives_Native.Some p01, FStar_Pervasives_Native.Some p11) -> let uu___ = - let uu___3 = FStarC_Compiler_String.op_Hat "," p11 in - FStarC_Compiler_String.op_Hat p01 uu___3 in + let uu___3 = FStarC_String.op_Hat "," p11 in + FStarC_String.op_Hat p01 uu___3 in FStar_Pervasives_Native.Some uu___ in let merge_target tgt = let uu___ = @@ -4774,18 +4791,18 @@ let (extract_settings : | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some x -> [(tgt, x)] in let uu___ = - FStarC_Compiler_List.collect merge_target - [OCaml; FSharp; Krml; Plugin; Extension] in + FStarC_List.collect merge_target + [OCaml; FSharp; Krml; Plugin; PluginNoLib; Extension] in let uu___3 = merge_setting p0.default_settings p1.default_settings in { target_specific_settings = uu___; default_settings = uu___3 } in fun uu___ -> - let uu___3 = FStarC_Compiler_Effect.op_Bang memo in + let uu___3 = FStarC_Effect.op_Bang memo in match uu___3 with | (result, set1) -> let fail msg = display_usage (); (let uu___5 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Could not parse '%s' passed to the --extract option" msg in failwith uu___5) in if set1 @@ -4794,39 +4811,38 @@ let (extract_settings : (let uu___5 = get_extract () in match uu___5 with | FStar_Pervasives_Native.None -> - (FStarC_Compiler_Effect.op_Colon_Equals memo + (FStarC_Effect.op_Colon_Equals memo (FStar_Pervasives_Native.None, true); FStar_Pervasives_Native.None) | FStar_Pervasives_Native.Some extract_settings1 -> let parse_one_setting extract_setting = let tgt_specific_settings = - FStarC_Compiler_Util.split extract_setting ";" in + FStarC_Util.split extract_setting ";" in let split_one t_setting = - match FStarC_Compiler_Util.split t_setting ":" with + match FStarC_Util.split t_setting ":" with | default_setting::[] -> FStar_Pervasives.Inr - (FStarC_Compiler_Util.trim_string default_setting) + (FStarC_Util.trim_string default_setting) | target::setting::[] -> - let target1 = FStarC_Compiler_Util.trim_string target in + let target1 = FStarC_Util.trim_string target in let uu___6 = parse_codegen target1 in (match uu___6 with | FStar_Pervasives_Native.None -> fail target1 | FStar_Pervasives_Native.Some tgt -> FStar_Pervasives.Inl - (tgt, - (FStarC_Compiler_Util.trim_string setting)) + (tgt, (FStarC_Util.trim_string setting)) | uu___7 -> fail t_setting) in let settings = - FStarC_Compiler_List.map split_one tgt_specific_settings in + FStarC_List.map split_one tgt_specific_settings in let fail_duplicate msg tgt = display_usage (); (let uu___7 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Could not parse '%s'; multiple setting for %s target" msg tgt in failwith uu___7) in let pes = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun setting -> fun out -> match setting with @@ -4843,7 +4859,7 @@ let (extract_settings : fail_duplicate def "default") | FStar_Pervasives.Inl (target, setting1) -> let uu___6 = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun uu___7 -> match uu___7 with | (x, uu___8) -> x = target) @@ -4871,19 +4887,19 @@ let (extract_settings : default_settings = FStar_Pervasives_Native.None } in let pes = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun setting -> fun pes1 -> let uu___6 = parse_one_setting setting in merge_parsed_extract_settings pes1 uu___6) extract_settings1 empty_pes in - (FStarC_Compiler_Effect.op_Colon_Equals memo + (FStarC_Effect.op_Colon_Equals memo ((FStar_Pervasives_Native.Some pes), true); FStar_Pervasives_Native.Some pes)) let (should_extract : Prims.string -> codegen_t -> Prims.bool) = fun m -> fun tgt -> - let m1 = FStarC_Compiler_String.lowercase m in + let m1 = FStarC_String.lowercase m in if m1 = "prims" then false else @@ -4916,17 +4932,17 @@ let (should_extract : Prims.string -> codegen_t -> Prims.bool) = match uu___4 with | [] -> false | ns -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun n -> - FStarC_Compiler_Util.starts_with m2 - (FStarC_Compiler_String.lowercase n)) ns in + FStarC_Util.starts_with m2 + (FStarC_String.lowercase n)) ns in let should_extract_module m2 = let uu___4 = get_extract_module () in match uu___4 with | [] -> false | l -> - FStarC_Compiler_Util.for_some - (fun n -> (FStarC_Compiler_String.lowercase n) = m2) l in + FStarC_Util.for_some + (fun n -> (FStarC_String.lowercase n) = m2) l in (let uu___4 = no_extract m1 in Prims.op_Negation uu___4) && (let uu___4 = let uu___5 = get_extract_namespace () in @@ -4978,12 +4994,11 @@ let (set_options : Prims.string -> FStarC_Getopt.parse_cmdline_res) = then FStarC_Getopt.Success else (let settable_specs1 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - settable_specs in + FStarC_List.map FStar_Pervasives_Native.fst settable_specs in let res = FStarC_Getopt.parse_string settable_specs1 (fun s1 -> - FStarC_Compiler_Effect.raise (File_argument s1); + FStarC_Effect.raise (File_argument s1); FStarC_Getopt.Error ("set_options with file argument", "")) s in if res = FStarC_Getopt.Success @@ -4992,8 +5007,7 @@ let (set_options : Prims.string -> FStarC_Getopt.parse_cmdline_res) = with | File_argument s1 -> let uu___3 = - let uu___4 = - FStarC_Compiler_Util.format1 "File %s is not a valid option" s1 in + let uu___4 = FStarC_Util.format1 "File %s is not a valid option" s1 in (uu___4, "") in FStarC_Getopt.Error uu___3 let with_options : 'a . Prims.string -> (unit -> 'a) -> 'a = @@ -5096,13 +5110,13 @@ let (set_vconfig : FStarC_VConfig.vconfig -> unit) = set_option "no_tactics" (Bool (vcfg.FStarC_VConfig.no_tactics)); (let uu___22 = let uu___23 = - FStarC_Compiler_List.map (fun uu___24 -> String uu___24) + FStarC_List.map (fun uu___24 -> String uu___24) vcfg.FStarC_VConfig.z3cliopt in List uu___23 in set_option "z3cliopt" uu___22); (let uu___23 = let uu___24 = - FStarC_Compiler_List.map (fun uu___25 -> String uu___25) + FStarC_List.map (fun uu___25 -> String uu___25) vcfg.FStarC_VConfig.z3smtopt in List uu___24 in set_option "z3smtopt" uu___23); diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_Options_Ext.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Options_Ext.ml new file mode 100644 index 00000000000..98e28c16696 --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Options_Ext.ml @@ -0,0 +1,68 @@ +open Prims +type key = Prims.string +type value = Prims.string +type ext_state = + | E of Prims.string FStarC_Util.psmap +let (uu___is_E : ext_state -> Prims.bool) = fun projectee -> true +let (__proj__E__item__map : ext_state -> Prims.string FStarC_Util.psmap) = + fun projectee -> match projectee with | E map -> map +let (init : ext_state) = let uu___ = FStarC_Util.psmap_empty () in E uu___ +let (cur_state : ext_state FStarC_Effect.ref) = FStarC_Util.mk_ref init +let (set : key -> value -> unit) = + fun k -> + fun v -> + let uu___ = + let uu___1 = + let uu___2 = + let uu___3 = FStarC_Effect.op_Bang cur_state in + __proj__E__item__map uu___3 in + FStarC_Util.psmap_add uu___2 k v in + E uu___1 in + FStarC_Effect.op_Colon_Equals cur_state uu___ +let (get : key -> value) = + fun k -> + let r = + let uu___ = + let uu___1 = + let uu___2 = FStarC_Effect.op_Bang cur_state in + __proj__E__item__map uu___2 in + FStarC_Util.psmap_try_find uu___1 k in + match uu___ with + | FStar_Pervasives_Native.None -> "" + | FStar_Pervasives_Native.Some v -> v in + r +let (enabled : key -> Prims.bool) = + fun k -> + let v = get k in + let v1 = FStarC_String.lowercase v in + (v1 <> "") && + (Prims.op_Negation (((v1 = "off") || (v1 = "false")) || (v1 = "0"))) +let (is_prefix : Prims.string -> Prims.string -> Prims.bool) = + fun s1 -> + fun s2 -> + let l1 = FStarC_String.length s1 in + let l2 = FStarC_String.length s2 in + (l2 >= l1) && + (let uu___ = FStarC_String.substring s2 Prims.int_zero l1 in + uu___ = s1) +let (getns : Prims.string -> (key * value) Prims.list) = + fun ns -> + let f k v acc = + let uu___ = is_prefix (Prims.strcat ns ":") k in + if uu___ then (k, v) :: acc else acc in + let uu___ = + let uu___1 = FStarC_Effect.op_Bang cur_state in + __proj__E__item__map uu___1 in + FStarC_Util.psmap_fold uu___ f [] +let (all : unit -> (key * value) Prims.list) = + fun uu___ -> + let f k v acc = (k, v) :: acc in + let uu___1 = + let uu___2 = FStarC_Effect.op_Bang cur_state in + __proj__E__item__map uu___2 in + FStarC_Util.psmap_fold uu___1 f [] +let (save : unit -> ext_state) = fun uu___ -> FStarC_Effect.op_Bang cur_state +let (restore : ext_state -> unit) = + fun s -> FStarC_Effect.op_Colon_Equals cur_state s +let (reset : unit -> unit) = + fun uu___ -> FStarC_Effect.op_Colon_Equals cur_state init \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Order.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Order.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Compiler_Order.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Order.ml diff --git a/stage0/fstar-lib/generated/FStarC_Parser_AST.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_AST.ml similarity index 86% rename from stage0/fstar-lib/generated/FStarC_Parser_AST.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_AST.ml index 542a9c6ab88..90a3803a6c8 100644 --- a/stage0/fstar-lib/generated/FStarC_Parser_AST.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_AST.ml @@ -42,7 +42,7 @@ type term' = | Construct of (FStarC_Ident.lid * (term * imp) Prims.list) | Abs of (pattern Prims.list * term) | Function of ((pattern * term FStar_Pervasives_Native.option * term) - Prims.list * FStarC_Compiler_Range_Type.range) + Prims.list * FStarC_Range_Type.range) | App of (term * term * imp) | Let of (let_qualifier * (term Prims.list FStar_Pervasives_Native.option * (pattern * term)) Prims.list * term) @@ -101,10 +101,9 @@ type term' = | ElimAnd of (term * term * term * binder * binder * term) | ListLiteral of term Prims.list | SeqLiteral of term Prims.list -and term = - { +and term = { tm: term' ; - range: FStarC_Compiler_Range_Type.range ; + range: FStarC_Range_Type.range ; level: level } and calc_step = | CalcStep of (term * term * term) @@ -117,7 +116,7 @@ and binder' = and binder = { b: binder' ; - brange: FStarC_Compiler_Range_Type.range ; + brange: FStarC_Range_Type.range ; blevel: level ; aqual: arg_qualifier FStar_Pervasives_Native.option ; battributes: term Prims.list } @@ -140,7 +139,7 @@ and pattern' = | PatVQuote of term and pattern = { pat: pattern' ; - prange: FStarC_Compiler_Range_Type.range } + prange: FStarC_Range_Type.range } and arg_qualifier = | Implicit | Equality @@ -201,7 +200,7 @@ let (uu___is_Function : term' -> Prims.bool) = let (__proj__Function__item___0 : term' -> ((pattern * term FStar_Pervasives_Native.option * term) Prims.list * - FStarC_Compiler_Range_Type.range)) + FStarC_Range_Type.range)) = fun projectee -> match projectee with | Function _0 -> _0 let (uu___is_App : term' -> Prims.bool) = fun projectee -> match projectee with | App _0 -> true | uu___ -> false @@ -444,8 +443,7 @@ let (__proj__SeqLiteral__item___0 : term' -> term Prims.list) = let (__proj__Mkterm__item__tm : term -> term') = fun projectee -> match projectee with | { tm; range; level = level1;_} -> tm -let (__proj__Mkterm__item__range : term -> FStarC_Compiler_Range_Type.range) - = +let (__proj__Mkterm__item__range : term -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { tm; range; level = level1;_} -> range let (__proj__Mkterm__item__level : term -> level) = @@ -481,8 +479,7 @@ let (__proj__NoName__item___0 : binder' -> term) = let (__proj__Mkbinder__item__b : binder -> binder') = fun projectee -> match projectee with | { b; brange; blevel; aqual; battributes;_} -> b -let (__proj__Mkbinder__item__brange : - binder -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mkbinder__item__brange : binder -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { b; brange; blevel; aqual; battributes;_} -> brange @@ -569,8 +566,7 @@ let (__proj__PatVQuote__item___0 : pattern' -> term) = fun projectee -> match projectee with | PatVQuote _0 -> _0 let (__proj__Mkpattern__item__pat : pattern -> pattern') = fun projectee -> match projectee with | { pat; prange;_} -> pat -let (__proj__Mkpattern__item__prange : - pattern -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mkpattern__item__prange : pattern -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { pat; prange;_} -> prange let (uu___is_Implicit : arg_qualifier -> Prims.bool) = fun projectee -> match projectee with | Implicit -> true | uu___ -> false @@ -949,14 +945,14 @@ type decl' = | Assume of (FStarC_Ident.ident * term) | Splice of (Prims.bool * FStarC_Ident.ident Prims.list * term) | DeclSyntaxExtension of (Prims.string * Prims.string * - FStarC_Compiler_Range_Type.range * FStarC_Compiler_Range_Type.range) + FStarC_Range_Type.range * FStarC_Range_Type.range) | UseLangDecls of Prims.string | DeclToBeDesugared of to_be_desugared | Unparseable and decl = { d: decl' ; - drange: FStarC_Compiler_Range_Type.range ; + drange: FStarC_Range_Type.range ; quals: qualifiers ; attrs: attributes_ ; interleaved: Prims.bool } @@ -1055,8 +1051,8 @@ let (uu___is_DeclSyntaxExtension : decl' -> Prims.bool) = match projectee with | DeclSyntaxExtension _0 -> true | uu___ -> false let (__proj__DeclSyntaxExtension__item___0 : decl' -> - (Prims.string * Prims.string * FStarC_Compiler_Range_Type.range * - FStarC_Compiler_Range_Type.range)) + (Prims.string * Prims.string * FStarC_Range_Type.range * + FStarC_Range_Type.range)) = fun projectee -> match projectee with | DeclSyntaxExtension _0 -> _0 let (uu___is_UseLangDecls : decl' -> Prims.bool) = fun projectee -> @@ -1074,8 +1070,7 @@ let (uu___is_Unparseable : decl' -> Prims.bool) = let (__proj__Mkdecl__item__d : decl -> decl') = fun projectee -> match projectee with | { d; drange; quals; attrs; interleaved;_} -> d -let (__proj__Mkdecl__item__drange : decl -> FStarC_Compiler_Range_Type.range) - = +let (__proj__Mkdecl__item__drange : decl -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { d; drange; quals; attrs; interleaved;_} -> drange @@ -1141,14 +1136,12 @@ let (check_id : FStarC_Ident.ident -> unit) = fun id -> let first_char = let uu___ = FStarC_Ident.string_of_id id in - FStarC_Compiler_String.substring uu___ Prims.int_zero Prims.int_one in - if - Prims.op_Negation - ((FStarC_Compiler_String.lowercase first_char) = first_char) + FStarC_String.substring uu___ Prims.int_zero Prims.int_one in + if Prims.op_Negation ((FStarC_String.lowercase first_char) = first_char) then let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Ident.showable_ident id in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Invalid identifer '%s'; expected a symbol that begins with a lower-case character" uu___1 in FStarC_Errors.raise_error FStarC_Ident.hasrange_ident id @@ -1159,7 +1152,7 @@ let (check_id : FStarC_Ident.ident -> unit) = let at_most_one : 'uuuuu . Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> 'uuuuu Prims.list -> 'uuuuu FStar_Pervasives_Native.option = fun s -> @@ -1170,16 +1163,15 @@ let at_most_one : | [] -> FStar_Pervasives_Native.None | uu___ -> let uu___1 = - FStarC_Compiler_Util.format1 - "At most one %s is allowed on declarations" s in + FStarC_Util.format1 "At most one %s is allowed on declarations" + s in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_MoreThanOneDeclaration () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___1) let (mk_binder_with_attrs : binder' -> - FStarC_Compiler_Range_Type.range -> - level -> aqual -> term Prims.list -> binder) + FStarC_Range_Type.range -> level -> aqual -> term Prims.list -> binder) = fun b -> fun r -> @@ -1188,14 +1180,12 @@ let (mk_binder_with_attrs : fun attrs -> { b; brange = r; blevel = l; aqual = i; battributes = attrs } let (mk_binder : - binder' -> FStarC_Compiler_Range_Type.range -> level -> aqual -> binder) = + binder' -> FStarC_Range_Type.range -> level -> aqual -> binder) = fun b -> fun r -> fun l -> fun i -> mk_binder_with_attrs b r l i [] -let (mk_term : term' -> FStarC_Compiler_Range_Type.range -> level -> term) = +let (mk_term : term' -> FStarC_Range_Type.range -> level -> term) = fun t -> fun r -> fun l -> { tm = t; range = r; level = l } let (mk_uminus : - term -> - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> level -> term) + term -> FStarC_Range_Type.range -> FStarC_Range_Type.range -> level -> term) = fun t -> fun rminus -> @@ -1218,18 +1208,17 @@ let (mk_uminus : (uu___2, [t]) in Op uu___1 in mk_term t1 r l -let (mk_pattern : pattern' -> FStarC_Compiler_Range_Type.range -> pattern) = +let (mk_pattern : pattern' -> FStarC_Range_Type.range -> pattern) = fun p -> fun r -> { pat = p; prange = r } let (un_curry_abs : pattern Prims.list -> term -> term') = fun ps -> fun body -> match body.tm with - | Abs (p', body') -> Abs ((FStarC_Compiler_List.op_At ps p'), body') + | Abs (p', body') -> Abs ((FStarC_List.op_At ps p'), body') | uu___ -> Abs (ps, body) let (mk_function : branch Prims.list -> - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> term) + FStarC_Range_Type.range -> FStarC_Range_Type.range -> term) = fun branches -> fun r1 -> fun r2 -> mk_term (Function (branches, r1)) r2 Expr @@ -1245,8 +1234,7 @@ let (un_function : FStar_Pervasives_Native.Some uu___1 | uu___ -> FStar_Pervasives_Native.None let (mkApp : - term -> (term * imp) Prims.list -> FStarC_Compiler_Range_Type.range -> term) - = + term -> (term * imp) Prims.list -> FStarC_Range_Type.range -> term) = fun t -> fun args -> fun r -> @@ -1256,14 +1244,13 @@ let (mkApp : (match t.tm with | Name s -> mk_term (Construct (s, args)) r Un | uu___1 -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun t1 -> fun uu___2 -> match uu___2 with | (a, imp1) -> mk_term (App (t1, a, imp1)) r Un) t args) -let (consPat : - FStarC_Compiler_Range_Type.range -> pattern -> pattern -> pattern') = +let (consPat : FStarC_Range_Type.range -> pattern -> pattern -> pattern') = fun r -> fun hd -> fun tl -> @@ -1271,7 +1258,7 @@ let (consPat : let uu___1 = mk_pattern (PatName FStarC_Parser_Const.cons_lid) r in (uu___1, [hd; tl]) in PatApp uu___ -let (consTerm : FStarC_Compiler_Range_Type.range -> term -> term -> term) = +let (consTerm : FStarC_Range_Type.range -> term -> term -> term) = fun r -> fun hd -> fun tl -> @@ -1279,11 +1266,11 @@ let (consTerm : FStarC_Compiler_Range_Type.range -> term -> term -> term) = (Construct (FStarC_Parser_Const.cons_lid, [(hd, Nothing); (tl, Nothing)])) r Expr -let (mkListLit : FStarC_Compiler_Range_Type.range -> term Prims.list -> term) - = fun r -> fun elts -> mk_term (ListLiteral elts) r Expr -let (mkSeqLit : FStarC_Compiler_Range_Type.range -> term Prims.list -> term) - = fun r -> fun elts -> mk_term (SeqLiteral elts) r Expr -let (unit_const : FStarC_Compiler_Range_Type.range -> term) = +let (mkListLit : FStarC_Range_Type.range -> term Prims.list -> term) = + fun r -> fun elts -> mk_term (ListLiteral elts) r Expr +let (mkSeqLit : FStarC_Range_Type.range -> term Prims.list -> term) = + fun r -> fun elts -> mk_term (SeqLiteral elts) r Expr +let (unit_const : FStarC_Range_Type.range -> term) = fun r -> mk_term (Const FStarC_Const.Const_unit) r Expr let (ml_comp : term -> term) = fun t -> @@ -1294,8 +1281,7 @@ let (tot_comp : term -> term) = fun t -> let ml = mk_term (Name FStarC_Parser_Const.effect_Tot_lid) t.range Expr in let t1 = mk_term (App (ml, t, Nothing)) t.range Expr in t1 -let (mkRefSet : FStarC_Compiler_Range_Type.range -> term Prims.list -> term) - = +let (mkRefSet : FStarC_Range_Type.range -> term Prims.list -> term) = fun r -> fun elts -> let uu___ = @@ -1324,7 +1310,7 @@ let (mkRefSet : FStarC_Compiler_Range_Type.range -> term Prims.list -> term) let uu___2 = FStarC_Ident.set_lid_range union_lid r in Var uu___2 in mk_term uu___1 r Expr in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun e -> fun tl -> let e1 = mkApp addr_of [(e, Nothing)] r in @@ -1332,7 +1318,7 @@ let (mkRefSet : FStarC_Compiler_Range_Type.range -> term Prims.list -> term) mkApp union [(single_e, Nothing); (tl, Nothing)] r) elts empty let (mkExplicitApp : - term -> term Prims.list -> FStarC_Compiler_Range_Type.range -> term) = + term -> term Prims.list -> FStarC_Range_Type.range -> term) = fun t -> fun args -> fun r -> @@ -1344,15 +1330,15 @@ let (mkExplicitApp : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map (fun a -> (a, Nothing)) args in + FStarC_List.map (fun a -> (a, Nothing)) args in (s, uu___3) in Construct uu___2 in mk_term uu___1 r Un | uu___1 -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun t1 -> fun a -> mk_term (App (t1, a, Nothing)) r Un) t args) -let (mkAdmitMagic : FStarC_Compiler_Range_Type.range -> term) = +let (mkAdmitMagic : FStarC_Range_Type.range -> term) = fun r -> let admit = let admit_name = @@ -1375,7 +1361,7 @@ let (mkAdmitMagic : FStarC_Compiler_Range_Type.range -> term) = let admit_magic = mk_term (Seq (admit, magic)) r Expr in admit_magic let mkWildAdmitMagic : 'uuuuu . - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (pattern * 'uuuuu FStar_Pervasives_Native.option * term) = fun r -> @@ -1386,13 +1372,13 @@ let focusBranches : 'uuuuu . (Prims.bool * (pattern * 'uuuuu FStar_Pervasives_Native.option * term)) Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (pattern * 'uuuuu FStar_Pervasives_Native.option * term) Prims.list = fun branches -> fun r -> let should_filter = - FStarC_Compiler_Util.for_some FStar_Pervasives_Native.fst branches in + FStarC_Util.for_some FStar_Pervasives_Native.fst branches in if should_filter then (FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range r @@ -1401,20 +1387,19 @@ let focusBranches : (Obj.magic "Focusing on only some cases"); (let focussed = let uu___1 = - FStarC_Compiler_List.filter FStar_Pervasives_Native.fst - branches in - FStarC_Compiler_List.map FStar_Pervasives_Native.snd uu___1 in + FStarC_List.filter FStar_Pervasives_Native.fst branches in + FStarC_List.map FStar_Pervasives_Native.snd uu___1 in let uu___1 = let uu___2 = mkWildAdmitMagic r in [uu___2] in - FStarC_Compiler_List.op_At focussed uu___1)) - else FStarC_Compiler_List.map FStar_Pervasives_Native.snd branches + FStarC_List.op_At focussed uu___1)) + else FStarC_List.map FStar_Pervasives_Native.snd branches let (focusLetBindings : (Prims.bool * (pattern * term)) Prims.list -> - FStarC_Compiler_Range_Type.range -> (pattern * term) Prims.list) + FStarC_Range_Type.range -> (pattern * term) Prims.list) = fun lbs -> fun r -> let should_filter = - FStarC_Compiler_Util.for_some FStar_Pervasives_Native.fst lbs in + FStarC_Util.for_some FStar_Pervasives_Native.fst lbs in if should_filter then (FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range r @@ -1422,7 +1407,7 @@ let (focusLetBindings : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic "Focusing on only some cases in this (mutually) recursive definition"); - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (f, lb) -> @@ -1431,18 +1416,18 @@ let (focusLetBindings : else (let uu___3 = mkAdmitMagic r in ((FStar_Pervasives_Native.fst lb), uu___3))) lbs) - else FStarC_Compiler_List.map FStar_Pervasives_Native.snd lbs + else FStarC_List.map FStar_Pervasives_Native.snd lbs let (focusAttrLetBindings : (attributes_ FStar_Pervasives_Native.option * (Prims.bool * (pattern * term))) Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (attributes_ FStar_Pervasives_Native.option * (pattern * term)) Prims.list) = fun lbs -> fun r -> let should_filter = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___ -> match uu___ with | (attr, (focus, uu___1)) -> focus) lbs in if should_filter @@ -1452,7 +1437,7 @@ let (focusAttrLetBindings : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic "Focusing on only some cases in this (mutually) recursive definition"); - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (attr, (f, lb)) -> @@ -1464,42 +1449,38 @@ let (focusAttrLetBindings : ((FStar_Pervasives_Native.fst lb), uu___4) in (attr, uu___3))) lbs) else - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (attr, (uu___2, lb)) -> (attr, lb)) lbs -let (mkFsTypApp : - term -> term Prims.list -> FStarC_Compiler_Range_Type.range -> term) = +let (mkFsTypApp : term -> term Prims.list -> FStarC_Range_Type.range -> term) + = fun t -> fun args -> fun r -> - let uu___ = FStarC_Compiler_List.map (fun a -> (a, FsTypApp)) args in + let uu___ = FStarC_List.map (fun a -> (a, FsTypApp)) args in mkApp t uu___ r -let (mkTuple : term Prims.list -> FStarC_Compiler_Range_Type.range -> term) = +let (mkTuple : term Prims.list -> FStarC_Range_Type.range -> term) = fun args -> fun r -> let cons = - FStarC_Parser_Const.mk_tuple_data_lid - (FStarC_Compiler_List.length args) r in + FStarC_Parser_Const.mk_tuple_data_lid (FStarC_List.length args) r in let uu___ = mk_term (Name cons) r Expr in - let uu___1 = FStarC_Compiler_List.map (fun x -> (x, Nothing)) args in + let uu___1 = FStarC_List.map (fun x -> (x, Nothing)) args in mkApp uu___ uu___1 r -let (mkDTuple : term Prims.list -> FStarC_Compiler_Range_Type.range -> term) - = +let (mkDTuple : term Prims.list -> FStarC_Range_Type.range -> term) = fun args -> fun r -> let cons = - FStarC_Parser_Const.mk_dtuple_data_lid - (FStarC_Compiler_List.length args) r in + FStarC_Parser_Const.mk_dtuple_data_lid (FStarC_List.length args) r in let uu___ = mk_term (Name cons) r Expr in - let uu___1 = FStarC_Compiler_List.map (fun x -> (x, Nothing)) args in + let uu___1 = FStarC_List.map (fun x -> (x, Nothing)) args in mkApp uu___ uu___1 r let (mkRefinedBinder : FStarC_Ident.ident -> term -> Prims.bool -> term FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> - aqual -> term Prims.list -> binder) + FStarC_Range_Type.range -> aqual -> term Prims.list -> binder) = fun id -> fun t -> @@ -1540,8 +1521,7 @@ let (mkRefinedPattern : term -> Prims.bool -> term FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> pattern) + FStarC_Range_Type.range -> FStarC_Range_Type.range -> pattern) = fun pat -> fun t -> @@ -1646,8 +1626,7 @@ let rec (as_mlist : match uu___ with | ((m_name, m_decl), cur1) -> (match ds with - | [] -> - Module (m_name, (m_decl :: (FStarC_Compiler_List.rev cur1))) + | [] -> Module (m_name, (m_decl :: (FStarC_List.rev cur1))) | d::ds1 -> (match d.d with | TopLevelModule m' -> @@ -1662,7 +1641,7 @@ let (as_frag : decl Prims.list -> inputFragment) = let uu___ = match ds with | d::ds1 -> (d, ds1) - | [] -> FStarC_Compiler_Effect.raise FStarC_Errors.Empty_frag in + | [] -> FStarC_Effect.raise FStarC_Errors.Empty_frag in match uu___ with | (d, ds1) -> (match d.d with @@ -1670,7 +1649,7 @@ let (as_frag : decl Prims.list -> inputFragment) = let m1 = as_mlist ((m, d), []) ds1 in FStar_Pervasives.Inl m1 | uu___1 -> let ds2 = d :: ds1 in - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun uu___3 -> match uu___3 with | { d = TopLevelModule uu___4; drange = r; quals = uu___5; @@ -1688,17 +1667,14 @@ let (strip_prefix : = fun prefix -> fun s -> - if FStarC_Compiler_Util.starts_with s prefix + if FStarC_Util.starts_with s prefix then let uu___ = - FStarC_Compiler_Util.substring_from s - (FStarC_Compiler_String.length prefix) in + FStarC_Util.substring_from s (FStarC_String.length prefix) in FStar_Pervasives_Native.Some uu___ else FStar_Pervasives_Native.None let (compile_op : - Prims.int -> - Prims.string -> FStarC_Compiler_Range_Type.range -> Prims.string) - = + Prims.int -> Prims.string -> FStarC_Range_Type.range -> Prims.string) = fun arity -> fun s -> fun r -> @@ -1727,8 +1703,7 @@ let (compile_op : | 46 -> "Dot" | c -> let uu___1 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_Util.int_of_char c) in + FStarC_Util.string_of_int (FStarC_Util.int_of_char c) in Prims.strcat "u" uu___1 in match s with | ".[]<-" -> "op_String_Assignment" @@ -1742,29 +1717,27 @@ let (compile_op : | uu___ -> let uu___1 = if - (FStarC_Compiler_Util.starts_with s "let") || - (FStarC_Compiler_Util.starts_with s "and") + (FStarC_Util.starts_with s "let") || + (FStarC_Util.starts_with s "and") then let uu___2 = let uu___3 = - FStarC_Compiler_Util.substring s Prims.int_zero - (Prims.of_int (3)) in + FStarC_Util.substring s Prims.int_zero (Prims.of_int (3)) in Prims.strcat uu___3 "_" in - let uu___3 = - FStarC_Compiler_Util.substring_from s (Prims.of_int (3)) in + let uu___3 = FStarC_Util.substring_from s (Prims.of_int (3)) in (uu___2, uu___3) else if - (FStarC_Compiler_Util.starts_with s "exists") || - (FStarC_Compiler_Util.starts_with s "forall") + (FStarC_Util.starts_with s "exists") || + (FStarC_Util.starts_with s "forall") then (let uu___3 = let uu___4 = - FStarC_Compiler_Util.substring s Prims.int_zero + FStarC_Util.substring s Prims.int_zero (Prims.of_int (6)) in Prims.strcat uu___4 "_" in let uu___4 = - FStarC_Compiler_Util.substring_from s (Prims.of_int (6)) in + FStarC_Util.substring_from s (Prims.of_int (6)) in (uu___3, uu___4)) else ("", s) in (match uu___1 with @@ -1772,13 +1745,12 @@ let (compile_op : let uu___2 = let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_String.list_of_string s1 in - FStarC_Compiler_List.map name_of_char uu___5 in - FStarC_Compiler_String.concat "_" uu___4 in + let uu___5 = FStarC_String.list_of_string s1 in + FStarC_List.map name_of_char uu___5 in + FStarC_String.concat "_" uu___4 in Prims.strcat prefix uu___3 in Prims.strcat "op_" uu___2) -let (compile_op' : - Prims.string -> FStarC_Compiler_Range_Type.range -> Prims.string) = +let (compile_op' : Prims.string -> FStarC_Range_Type.range -> Prims.string) = fun s -> fun r -> compile_op (Prims.of_int (-1)) s r let (string_to_op : Prims.string -> @@ -1864,31 +1836,29 @@ let (string_to_op : | "op_Lens_Access" -> FStar_Pervasives_Native.Some (".(||)", FStar_Pervasives_Native.None) | uu___ -> - if FStarC_Compiler_Util.starts_with s "op_" + if FStarC_Util.starts_with s "op_" then let frags = let uu___1 = - FStarC_Compiler_Util.substring_from s - (FStarC_Compiler_String.length "op_") in - FStarC_Compiler_Util.split uu___1 "_" in + FStarC_Util.substring_from s (FStarC_String.length "op_") in + FStarC_Util.split uu___1 "_" in (match frags with | op::[] -> - if FStarC_Compiler_Util.starts_with op "u" + if FStarC_Util.starts_with op "u" then let uu___1 = - let uu___2 = - FStarC_Compiler_Util.substring_from op Prims.int_one in - FStarC_Compiler_Util.safe_int_of_string uu___2 in - FStarC_Compiler_Util.map_opt uu___1 + let uu___2 = FStarC_Util.substring_from op Prims.int_one in + FStarC_Util.safe_int_of_string uu___2 in + FStarC_Util.map_opt uu___1 (fun op1 -> - ((FStarC_Compiler_Util.string_of_char - (FStarC_Compiler_Util.char_of_int op1)), + ((FStarC_Util.string_of_char + (FStarC_Util.char_of_int op1)), FStar_Pervasives_Native.None)) else name_of_op op | uu___1 -> let maybeop = - let uu___2 = FStarC_Compiler_List.map name_of_op frags in - FStarC_Compiler_List.fold_left + let uu___2 = FStarC_List.map name_of_op frags in + FStarC_List.fold_left (fun acc -> fun x -> match acc with @@ -1902,7 +1872,7 @@ let (string_to_op : | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None)) (FStar_Pervasives_Native.Some "") uu___2 in - FStarC_Compiler_Util.map_opt maybeop + FStarC_Util.map_opt maybeop (fun o -> (o, FStar_Pervasives_Native.None))) else FStar_Pervasives_Native.None let (string_of_fsdoc : @@ -1913,11 +1883,11 @@ let (string_of_fsdoc : | (comment, keywords) -> let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (k, v) -> Prims.strcat k (Prims.strcat "->" v)) keywords in - FStarC_Compiler_String.concat "," uu___2 in + FStarC_String.concat "," uu___2 in Prims.strcat comment uu___1 let (string_of_let_qualifier : let_qualifier -> Prims.string) = fun uu___ -> match uu___ with | NoLetQualifier -> "" | Rec -> "rec" @@ -1929,8 +1899,7 @@ let to_string_l : fun sep -> fun f -> fun l -> - let uu___ = FStarC_Compiler_List.map f l in - FStarC_Compiler_String.concat sep uu___ + let uu___ = FStarC_List.map f l in FStarC_String.concat sep uu___ let (imp_to_string : imp -> Prims.string) = fun uu___ -> match uu___ with | Hash -> "#" | uu___1 -> "" let rec (term_to_string : term -> Prims.string) = @@ -1943,34 +1912,33 @@ let rec (term_to_string : term -> Prims.string) = | [] -> " " | hd::tl -> let uu___1 = term_to_string hd in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun s -> fun t -> let uu___2 = let uu___3 = term_to_string t in Prims.strcat "; " uu___3 in Prims.strcat s uu___2) uu___1 tl in - FStarC_Compiler_Util.format1 "%[%s]" uu___ + FStarC_Util.format1 "%[%s]" uu___ | Decreases (t, uu___) -> let uu___1 = term_to_string t in - FStarC_Compiler_Util.format1 "(decreases %s)" uu___1 + FStarC_Util.format1 "(decreases %s)" uu___1 | Requires (t, uu___) -> let uu___1 = term_to_string t in - FStarC_Compiler_Util.format1 "(requires %s)" uu___1 + FStarC_Util.format1 "(requires %s)" uu___1 | Ensures (t, uu___) -> let uu___1 = term_to_string t in - FStarC_Compiler_Util.format1 "(ensures %s)" uu___1 + FStarC_Util.format1 "(ensures %s)" uu___1 | Labeled (t, l, uu___) -> let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "(labeled %s %s)" l uu___1 + FStarC_Util.format2 "(labeled %s %s)" l uu___1 | Const c -> FStarC_Parser_Const.const_to_string c | Op (s, xs) -> let uu___ = FStarC_Ident.string_of_id s in let uu___1 = - let uu___2 = - FStarC_Compiler_List.map (fun x1 -> term_to_string x1) xs in - FStarC_Compiler_String.concat ", " uu___2 in - FStarC_Compiler_Util.format2 "%s(%s)" uu___ uu___1 + let uu___2 = FStarC_List.map (fun x1 -> term_to_string x1) xs in + FStarC_String.concat ", " uu___2 in + FStarC_Util.format2 "%s(%s)" uu___ uu___1 | Tvar id -> FStarC_Ident.string_of_id id | Uvar id -> FStarC_Ident.string_of_id id | Var l -> FStarC_Ident.string_of_lid l @@ -1978,7 +1946,7 @@ let rec (term_to_string : term -> Prims.string) = | Projector (rec_lid, field_id) -> let uu___ = FStarC_Ident.string_of_lid rec_lid in let uu___1 = FStarC_Ident.string_of_id field_id in - FStarC_Compiler_Util.format2 "%s?.%s" uu___ uu___1 + FStarC_Util.format2 "%s?.%s" uu___ uu___1 | Construct (l, args) -> let uu___ = FStarC_Ident.string_of_lid l in let uu___1 = @@ -1987,9 +1955,9 @@ let rec (term_to_string : term -> Prims.string) = match uu___2 with | (a, imp1) -> let uu___3 = term_to_string a in - FStarC_Compiler_Util.format2 "%s%s" (imp_to_string imp1) - uu___3) args in - FStarC_Compiler_Util.format2 "(%s %s)" uu___ uu___1 + FStarC_Util.format2 "%s%s" (imp_to_string imp1) uu___3) + args in + FStarC_Util.format2 "(%s %s)" uu___ uu___1 | Function (branches, r) -> let uu___ = to_string_l " | " @@ -1998,24 +1966,22 @@ let rec (term_to_string : term -> Prims.string) = | (p, w, e) -> let uu___2 = pat_to_string p in let uu___3 = term_to_string e in - FStarC_Compiler_Util.format2 "%s -> %s" uu___2 uu___3) - branches in - FStarC_Compiler_Util.format1 "(function %s)" uu___ + FStarC_Util.format2 "%s -> %s" uu___2 uu___3) branches in + FStarC_Util.format1 "(function %s)" uu___ | Abs (pats, t) -> let uu___ = to_string_l " " pat_to_string pats in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "(fun %s -> %s)" uu___ uu___1 + FStarC_Util.format2 "(fun %s -> %s)" uu___ uu___1 | App (t1, t2, imp1) -> let uu___ = term_to_string t1 in let uu___1 = term_to_string t2 in - FStarC_Compiler_Util.format3 "%s %s%s" uu___ (imp_to_string imp1) - uu___1 + FStarC_Util.format3 "%s %s%s" uu___ (imp_to_string imp1) uu___1 | Let (Rec, (a, (p, b))::lbs, body) -> let uu___ = attrs_opt_to_string a in let uu___1 = let uu___2 = pat_to_string p in let uu___3 = term_to_string b in - FStarC_Compiler_Util.format2 "%s=%s" uu___2 uu___3 in + FStarC_Util.format2 "%s=%s" uu___2 uu___3 in let uu___2 = to_string_l " " (fun uu___3 -> @@ -2024,19 +1990,18 @@ let rec (term_to_string : term -> Prims.string) = let uu___4 = attrs_opt_to_string a1 in let uu___5 = pat_to_string p1 in let uu___6 = term_to_string b1 in - FStarC_Compiler_Util.format3 "%sand %s=%s" uu___4 uu___5 - uu___6) lbs in + FStarC_Util.format3 "%sand %s=%s" uu___4 uu___5 uu___6) + lbs in let uu___3 = term_to_string body in - FStarC_Compiler_Util.format4 "%slet rec %s%s in %s" uu___ uu___1 - uu___2 uu___3 + FStarC_Util.format4 "%slet rec %s%s in %s" uu___ uu___1 uu___2 uu___3 | Let (q, (attrs, (pat, tm))::[], body) -> let uu___ = attrs_opt_to_string attrs in let uu___1 = string_of_let_qualifier q in let uu___2 = pat_to_string pat in let uu___3 = term_to_string tm in let uu___4 = term_to_string body in - FStarC_Compiler_Util.format5 "%slet %s %s = %s in %s" uu___ uu___1 - uu___2 uu___3 uu___4 + FStarC_Util.format5 "%slet %s %s = %s in %s" uu___ uu___1 uu___2 + uu___3 uu___4 | Let (uu___, uu___1, uu___2) -> FStarC_Errors.raise_error hasRange_term x FStarC_Errors_Codes.Fatal_EmptySurfaceLet () @@ -2045,16 +2010,16 @@ let rec (term_to_string : term -> Prims.string) = | LetOpen (lid, t) -> let uu___ = FStarC_Ident.string_of_lid lid in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "let open %s in %s" uu___ uu___1 + FStarC_Util.format2 "let open %s in %s" uu___ uu___1 | Seq (t1, t2) -> let uu___ = term_to_string t1 in let uu___1 = term_to_string t2 in - FStarC_Compiler_Util.format2 "%s; %s" uu___ uu___1 + FStarC_Util.format2 "%s; %s" uu___ uu___1 | Bind (id, t1, t2) -> let uu___ = FStarC_Ident.string_of_id id in let uu___1 = term_to_string t1 in let uu___2 = term_to_string t2 in - FStarC_Compiler_Util.format3 "%s <- %s; %s" uu___ uu___1 uu___2 + FStarC_Util.format3 "%s <- %s; %s" uu___ uu___1 uu___2 | If (t1, op_opt, ret_opt, t2, t3) -> let uu___ = match op_opt with @@ -2071,13 +2036,13 @@ let rec (term_to_string : term -> Prims.string) = | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some as_ident -> let uu___4 = FStarC_Ident.string_of_id as_ident in - FStarC_Compiler_Util.format1 " as %s " uu___4 in + FStarC_Util.format1 " as %s " uu___4 in let uu___4 = term_to_string ret in - FStarC_Compiler_Util.format3 "%s%s %s " uu___3 s uu___4 in + FStarC_Util.format3 "%s%s %s " uu___3 s uu___4 in let uu___3 = term_to_string t2 in let uu___4 = term_to_string t3 in - FStarC_Compiler_Util.format5 "if%s %s %sthen %s else %s" uu___ uu___1 - uu___2 uu___3 uu___4 + FStarC_Util.format5 "if%s %s %sthen %s else %s" uu___ uu___1 uu___2 + uu___3 uu___4 | Match (t, op_opt, ret_opt, branches) -> try_or_match_to_string x t branches op_opt ret_opt | TryWith (t, branches) -> @@ -2087,13 +2052,13 @@ let rec (term_to_string : term -> Prims.string) = let s = if flag then "$:" else "<:" in let uu___ = term_to_string t1 in let uu___1 = term_to_string t2 in - FStarC_Compiler_Util.format3 "(%s %s %s)" uu___ s uu___1 + FStarC_Util.format3 "(%s %s %s)" uu___ s uu___1 | Ascribed (t1, t2, FStar_Pervasives_Native.Some tac, flag) -> let s = if flag then "$:" else "<:" in let uu___ = term_to_string t1 in let uu___1 = term_to_string t2 in let uu___2 = term_to_string tac in - FStarC_Compiler_Util.format4 "(%s %s %s by %s)" uu___ s uu___1 uu___2 + FStarC_Util.format4 "(%s %s %s by %s)" uu___ s uu___1 uu___2 | Record (FStar_Pervasives_Native.Some e, fields) -> let uu___ = term_to_string e in let uu___1 = @@ -2103,8 +2068,8 @@ let rec (term_to_string : term -> Prims.string) = | (l, e1) -> let uu___3 = FStarC_Ident.string_of_lid l in let uu___4 = term_to_string e1 in - FStarC_Compiler_Util.format2 "%s=%s" uu___3 uu___4) fields in - FStarC_Compiler_Util.format2 "{%s with %s}" uu___ uu___1 + FStarC_Util.format2 "%s=%s" uu___3 uu___4) fields in + FStarC_Util.format2 "{%s with %s}" uu___ uu___1 | Record (FStar_Pervasives_Native.None, fields) -> let uu___ = to_string_l " " @@ -2113,12 +2078,12 @@ let rec (term_to_string : term -> Prims.string) = | (l, e) -> let uu___2 = FStarC_Ident.string_of_lid l in let uu___3 = term_to_string e in - FStarC_Compiler_Util.format2 "%s=%s" uu___2 uu___3) fields in - FStarC_Compiler_Util.format1 "{%s}" uu___ + FStarC_Util.format2 "%s=%s" uu___2 uu___3) fields in + FStarC_Util.format1 "{%s}" uu___ | Project (e, l) -> let uu___ = term_to_string e in let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format2 "%s.%s" uu___ uu___1 + FStarC_Util.format2 "%s.%s" uu___ uu___1 | Product ([], t) -> term_to_string t | Product (b::hd::tl, t) -> let uu___ = @@ -2132,116 +2097,106 @@ let rec (term_to_string : term -> Prims.string) = | Product (b::[], t) when x.level = Type_level -> let uu___ = binder_to_string b in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "%s -> %s" uu___ uu___1 + FStarC_Util.format2 "%s -> %s" uu___ uu___1 | Product (b::[], t) when x.level = Kind -> let uu___ = binder_to_string b in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "%s => %s" uu___ uu___1 + FStarC_Util.format2 "%s => %s" uu___ uu___1 | Sum (binders, t) -> let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | FStar_Pervasives.Inl b -> binder_to_string b | FStar_Pervasives.Inr t1 -> term_to_string t1) - (FStarC_Compiler_List.op_At binders [FStar_Pervasives.Inr t]) in - FStarC_Compiler_String.concat " & " uu___ + (FStarC_List.op_At binders [FStar_Pervasives.Inr t]) in + FStarC_String.concat " & " uu___ | QForall (bs, (uu___, pats), t) -> let uu___1 = to_string_l " " binder_to_string bs in let uu___2 = to_string_l " \\/ " (to_string_l "; " term_to_string) pats in let uu___3 = term_to_string t in - FStarC_Compiler_Util.format3 "forall %s.{:pattern %s} %s" uu___1 - uu___2 uu___3 + FStarC_Util.format3 "forall %s.{:pattern %s} %s" uu___1 uu___2 uu___3 | QExists (bs, (uu___, pats), t) -> let uu___1 = to_string_l " " binder_to_string bs in let uu___2 = to_string_l " \\/ " (to_string_l "; " term_to_string) pats in let uu___3 = term_to_string t in - FStarC_Compiler_Util.format3 "exists %s.{:pattern %s} %s" uu___1 - uu___2 uu___3 + FStarC_Util.format3 "exists %s.{:pattern %s} %s" uu___1 uu___2 uu___3 | QuantOp (i, bs, (uu___, []), t) -> let uu___1 = FStarC_Ident.string_of_id i in let uu___2 = to_string_l " " binder_to_string bs in let uu___3 = term_to_string t in - FStarC_Compiler_Util.format3 "%s %s. %s" uu___1 uu___2 uu___3 + FStarC_Util.format3 "%s %s. %s" uu___1 uu___2 uu___3 | QuantOp (i, bs, (uu___, pats), t) -> let uu___1 = FStarC_Ident.string_of_id i in let uu___2 = to_string_l " " binder_to_string bs in let uu___3 = to_string_l " \\/ " (to_string_l "; " term_to_string) pats in let uu___4 = term_to_string t in - FStarC_Compiler_Util.format4 "%s %s.{:pattern %s} %s" uu___1 uu___2 - uu___3 uu___4 + FStarC_Util.format4 "%s %s.{:pattern %s} %s" uu___1 uu___2 uu___3 + uu___4 | Refine (b, t) -> let uu___ = binder_to_string b in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "%s:{%s}" uu___ uu___1 + FStarC_Util.format2 "%s:{%s}" uu___ uu___1 | NamedTyp (x1, t) -> let uu___ = FStarC_Ident.string_of_id x1 in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "%s:%s" uu___ uu___1 + FStarC_Util.format2 "%s:%s" uu___ uu___1 | Paren t -> - let uu___ = term_to_string t in - FStarC_Compiler_Util.format1 "(%s)" uu___ + let uu___ = term_to_string t in FStarC_Util.format1 "(%s)" uu___ | Product (bs, t) -> let uu___ = - let uu___1 = FStarC_Compiler_List.map binder_to_string bs in - FStarC_Compiler_String.concat "," uu___1 in + let uu___1 = FStarC_List.map binder_to_string bs in + FStarC_String.concat "," uu___1 in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "Unidentified product: [%s] %s" uu___ - uu___1 + FStarC_Util.format2 "Unidentified product: [%s] %s" uu___ uu___1 | Discrim lid -> let uu___ = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format1 "%s?" uu___ + FStarC_Util.format1 "%s?" uu___ | Attributes ts -> let uu___ = - let uu___1 = FStarC_Compiler_List.map term_to_string ts in - FStarC_Compiler_String.concat " " uu___1 in - FStarC_Compiler_Util.format1 "(attributes %s)" uu___ + let uu___1 = FStarC_List.map term_to_string ts in + FStarC_String.concat " " uu___1 in + FStarC_Util.format1 "(attributes %s)" uu___ | Antiquote t -> - let uu___ = term_to_string t in - FStarC_Compiler_Util.format1 "(`#%s)" uu___ + let uu___ = term_to_string t in FStarC_Util.format1 "(`#%s)" uu___ | Quote (t, Static) -> - let uu___ = term_to_string t in - FStarC_Compiler_Util.format1 "(`(%s))" uu___ + let uu___ = term_to_string t in FStarC_Util.format1 "(`(%s))" uu___ | Quote (t, Dynamic) -> let uu___ = term_to_string t in - FStarC_Compiler_Util.format1 "quote (%s)" uu___ + FStarC_Util.format1 "quote (%s)" uu___ | VQuote t -> - let uu___ = term_to_string t in - FStarC_Compiler_Util.format1 "`%%%s" uu___ + let uu___ = term_to_string t in FStarC_Util.format1 "`%%%s" uu___ | CalcProof (rel, init, steps) -> let uu___ = term_to_string rel in let uu___1 = term_to_string init in let uu___2 = - let uu___3 = FStarC_Compiler_List.map calc_step_to_string steps in - FStarC_Compiler_String.concat " " uu___3 in - FStarC_Compiler_Util.format3 "calc (%s) { %s %s }" uu___ uu___1 - uu___2 + let uu___3 = FStarC_List.map calc_step_to_string steps in + FStarC_String.concat " " uu___3 in + FStarC_Util.format3 "calc (%s) { %s %s }" uu___ uu___1 uu___2 | ElimForall (bs, t, vs) -> let uu___ = binders_to_string " " bs in let uu___1 = term_to_string t in let uu___2 = - let uu___3 = FStarC_Compiler_List.map term_to_string vs in - FStarC_Compiler_String.concat " " uu___3 in - FStarC_Compiler_Util.format3 "_elim_ forall %s. %s using %s" uu___ - uu___1 uu___2 + let uu___3 = FStarC_List.map term_to_string vs in + FStarC_String.concat " " uu___3 in + FStarC_Util.format3 "_elim_ forall %s. %s using %s" uu___ uu___1 + uu___2 | ElimExists (bs, p, q, b, e) -> let uu___ = binders_to_string " " bs in let uu___1 = term_to_string p in let uu___2 = term_to_string q in let uu___3 = binder_to_string b in let uu___4 = term_to_string e in - FStarC_Compiler_Util.format5 - "_elim_ exists %s. %s _to_ %s\n\\with %s. %s" uu___ uu___1 uu___2 - uu___3 uu___4 + FStarC_Util.format5 "_elim_ exists %s. %s _to_ %s\n\\with %s. %s" + uu___ uu___1 uu___2 uu___3 uu___4 | ElimImplies (p, q, e) -> let uu___ = term_to_string p in let uu___1 = term_to_string q in let uu___2 = term_to_string e in - FStarC_Compiler_Util.format3 "_elim_ %s ==> %s with %s" uu___ uu___1 - uu___2 + FStarC_Util.format3 "_elim_ %s ==> %s with %s" uu___ uu___1 uu___2 | ElimOr (p, q, r, x1, e, y, e') -> let uu___ = let uu___1 = term_to_string p in @@ -2263,7 +2218,7 @@ let rec (term_to_string : term -> Prims.string) = uu___5 :: uu___6 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStarC_Compiler_Util.format + FStarC_Util.format "_elim_ %s \\/ %s _to_ %s\n\\with %s. %s\n\\and %s.%s" uu___ | ElimAnd (p, q, r, x1, y, e) -> let uu___ = @@ -2282,54 +2237,53 @@ let rec (term_to_string : term -> Prims.string) = uu___5 :: uu___6 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStarC_Compiler_Util.format - "_elim_ %s /\\ %s _to_ %s\n\\with %s %s. %s" uu___ + FStarC_Util.format "_elim_ %s /\\ %s _to_ %s\n\\with %s %s. %s" uu___ | IntroForall (xs, p, e) -> let uu___ = binders_to_string " " xs in let uu___1 = term_to_string p in let uu___2 = term_to_string e in - FStarC_Compiler_Util.format3 "_intro_ forall %s. %s with %s" uu___ - uu___1 uu___2 + FStarC_Util.format3 "_intro_ forall %s. %s with %s" uu___ uu___1 + uu___2 | IntroExists (xs, t, vs, e) -> let uu___ = binders_to_string " " xs in let uu___1 = term_to_string t in let uu___2 = - let uu___3 = FStarC_Compiler_List.map term_to_string vs in - FStarC_Compiler_String.concat " " uu___3 in + let uu___3 = FStarC_List.map term_to_string vs in + FStarC_String.concat " " uu___3 in let uu___3 = term_to_string e in - FStarC_Compiler_Util.format4 "_intro_ exists %s. %s using %s with %s" - uu___ uu___1 uu___2 uu___3 + FStarC_Util.format4 "_intro_ exists %s. %s using %s with %s" uu___ + uu___1 uu___2 uu___3 | IntroImplies (p, q, x1, e) -> let uu___ = term_to_string p in let uu___1 = term_to_string q in let uu___2 = binder_to_string x1 in let uu___3 = term_to_string p in - FStarC_Compiler_Util.format4 "_intro_ %s ==> %s with %s. %s" uu___ - uu___1 uu___2 uu___3 + FStarC_Util.format4 "_intro_ %s ==> %s with %s. %s" uu___ uu___1 + uu___2 uu___3 | IntroOr (b, p, q, r) -> let uu___ = term_to_string p in let uu___1 = term_to_string q in let uu___2 = term_to_string r in - FStarC_Compiler_Util.format4 "_intro_ %s \\/ %s using %s with %s" - uu___ uu___1 (if b then "Left" else "Right") uu___2 + FStarC_Util.format4 "_intro_ %s \\/ %s using %s with %s" uu___ uu___1 + (if b then "Left" else "Right") uu___2 | IntroAnd (p, q, e1, e2) -> let uu___ = term_to_string p in let uu___1 = term_to_string q in let uu___2 = term_to_string e1 in let uu___3 = term_to_string e2 in - FStarC_Compiler_Util.format4 "_intro_ %s /\\ %s with %s and %s" uu___ - uu___1 uu___2 uu___3 + FStarC_Util.format4 "_intro_ %s /\\ %s with %s and %s" uu___ uu___1 + uu___2 uu___3 | ListLiteral ts -> let uu___ = to_string_l "; " term_to_string ts in - FStarC_Compiler_Util.format1 "[%s]" uu___ + FStarC_Util.format1 "[%s]" uu___ | SeqLiteral ts -> let uu___ = to_string_l "; " term_to_string ts in - FStarC_Compiler_Util.format1 "seq![%s]" uu___ + FStarC_Util.format1 "seq![%s]" uu___ and (binders_to_string : Prims.string -> binder Prims.list -> Prims.string) = fun sep -> fun bs -> - let uu___ = FStarC_Compiler_List.map binder_to_string bs in - FStarC_Compiler_String.concat sep uu___ + let uu___ = FStarC_List.map binder_to_string bs in + FStarC_String.concat sep uu___ and (try_or_match_to_string : term -> term -> @@ -2364,9 +2318,9 @@ and (try_or_match_to_string : | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some as_ident -> let uu___4 = FStarC_Ident.string_of_id as_ident in - FStarC_Compiler_Util.format1 "as %s " uu___4 in + FStarC_Util.format1 "as %s " uu___4 in let uu___4 = term_to_string ret in - FStarC_Compiler_Util.format3 "%s%s %s " s1 uu___3 uu___4 in + FStarC_Util.format3 "%s%s %s " s1 uu___3 uu___4 in let uu___3 = to_string_l " | " (fun uu___4 -> @@ -2378,12 +2332,12 @@ and (try_or_match_to_string : | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some e1 -> let uu___7 = term_to_string e1 in - FStarC_Compiler_Util.format1 "when %s" uu___7 in + FStarC_Util.format1 "when %s" uu___7 in let uu___7 = term_to_string e in - FStarC_Compiler_Util.format3 "%s %s -> %s" uu___5 - uu___6 uu___7) branches in - FStarC_Compiler_Util.format5 "%s%s %s %swith %s" s uu___ uu___1 - uu___2 uu___3 + FStarC_Util.format3 "%s %s -> %s" uu___5 uu___6 uu___7) + branches in + FStarC_Util.format5 "%s%s %s %swith %s" s uu___ uu___1 uu___2 + uu___3 and (calc_step_to_string : calc_step -> Prims.string) = fun uu___ -> match uu___ with @@ -2391,7 +2345,7 @@ and (calc_step_to_string : calc_step -> Prims.string) = let uu___1 = term_to_string rel in let uu___2 = term_to_string just in let uu___3 = term_to_string next in - FStarC_Compiler_Util.format3 "%s{ %s } %s" uu___1 uu___2 uu___3 + FStarC_Util.format3 "%s{ %s } %s" uu___1 uu___2 uu___3 and (binder_to_string : binder -> Prims.string) = fun x -> let pr x1 = @@ -2400,19 +2354,19 @@ and (binder_to_string : binder -> Prims.string) = | Variable i -> FStarC_Ident.string_of_id i | TVariable i -> let uu___ = FStarC_Ident.string_of_id i in - FStarC_Compiler_Util.format1 "%s:_" uu___ + FStarC_Util.format1 "%s:_" uu___ | TAnnotated (i, t) -> let uu___ = FStarC_Ident.string_of_id i in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "%s:%s" uu___ uu___1 + FStarC_Util.format2 "%s:%s" uu___ uu___1 | Annotated (i, t) -> let uu___ = FStarC_Ident.string_of_id i in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "%s:%s" uu___ uu___1 + FStarC_Util.format2 "%s:%s" uu___ uu___1 | NoName t -> term_to_string t in let uu___ = aqual_to_string x1.aqual in let uu___1 = attr_list_to_string x1.battributes in - FStarC_Compiler_Util.format3 "%s%s%s" uu___ uu___1 s in + FStarC_Util.format3 "%s%s%s" uu___ uu___1 s in match x.aqual with | FStar_Pervasives_Native.Some (TypeClassArg) -> let uu___ = let uu___1 = pr x in Prims.strcat uu___1 " |}" in @@ -2445,32 +2399,31 @@ and (pat_to_string : pattern -> Prims.string) = Prims.strcat "#" uu___1 | PatConst c -> FStarC_Parser_Const.const_to_string c | PatVQuote t -> - let uu___ = term_to_string t in - FStarC_Compiler_Util.format1 "`%%%s" uu___ + let uu___ = term_to_string t in FStarC_Util.format1 "`%%%s" uu___ | PatApp (p, ps) -> let uu___ = pat_to_string p in let uu___1 = to_string_l " " pat_to_string ps in - FStarC_Compiler_Util.format2 "(%s %s)" uu___ uu___1 + FStarC_Util.format2 "(%s %s)" uu___ uu___1 | PatTvar (i, aq, attrs) -> let uu___ = aqual_to_string aq in let uu___1 = attr_list_to_string attrs in let uu___2 = FStarC_Ident.string_of_id i in - FStarC_Compiler_Util.format3 "%s%s%s" uu___ uu___1 uu___2 + FStarC_Util.format3 "%s%s%s" uu___ uu___1 uu___2 | PatVar (i, aq, attrs) -> let uu___ = aqual_to_string aq in let uu___1 = attr_list_to_string attrs in let uu___2 = FStarC_Ident.string_of_id i in - FStarC_Compiler_Util.format3 "%s%s%s" uu___ uu___1 uu___2 + FStarC_Util.format3 "%s%s%s" uu___ uu___1 uu___2 | PatName l -> FStarC_Ident.string_of_lid l | PatList l -> let uu___ = to_string_l "; " pat_to_string l in - FStarC_Compiler_Util.format1 "[%s]" uu___ + FStarC_Util.format1 "[%s]" uu___ | PatTuple (l, false) -> let uu___ = to_string_l ", " pat_to_string l in - FStarC_Compiler_Util.format1 "(%s)" uu___ + FStarC_Util.format1 "(%s)" uu___ | PatTuple (l, true) -> let uu___ = to_string_l ", " pat_to_string l in - FStarC_Compiler_Util.format1 "(|%s|)" uu___ + FStarC_Util.format1 "(|%s|)" uu___ | PatRecord l -> let uu___ = to_string_l "; " @@ -2479,21 +2432,21 @@ and (pat_to_string : pattern -> Prims.string) = | (f, e) -> let uu___2 = FStarC_Ident.string_of_lid f in let uu___3 = pat_to_string e in - FStarC_Compiler_Util.format2 "%s=%s" uu___2 uu___3) l in - FStarC_Compiler_Util.format1 "{%s}" uu___ + FStarC_Util.format2 "%s=%s" uu___2 uu___3) l in + FStarC_Util.format1 "{%s}" uu___ | PatOr l -> to_string_l "|\n " pat_to_string l | PatOp op -> let uu___ = FStarC_Ident.string_of_id op in - FStarC_Compiler_Util.format1 "(%s)" uu___ + FStarC_Util.format1 "(%s)" uu___ | PatAscribed (p, (t, FStar_Pervasives_Native.None)) -> let uu___ = pat_to_string p in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format2 "(%s:%s)" uu___ uu___1 + FStarC_Util.format2 "(%s:%s)" uu___ uu___1 | PatAscribed (p, (t, FStar_Pervasives_Native.Some tac)) -> let uu___ = pat_to_string p in let uu___1 = term_to_string t in let uu___2 = term_to_string tac in - FStarC_Compiler_Util.format3 "(%s:%s by %s)" uu___ uu___1 uu___2 + FStarC_Util.format3 "(%s:%s by %s)" uu___ uu___1 uu___2 and (attrs_opt_to_string : term Prims.list FStar_Pervasives_Native.option -> Prims.string) = fun uu___ -> @@ -2501,9 +2454,9 @@ and (attrs_opt_to_string : | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some attrs -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map term_to_string attrs in - FStarC_Compiler_String.concat "; " uu___2 in - FStarC_Compiler_Util.format1 "[@ %s]" uu___1 + let uu___2 = FStarC_List.map term_to_string attrs in + FStarC_String.concat "; " uu___2 in + FStarC_Util.format1 "[@ %s]" uu___1 let rec (head_id_of_pat : pattern -> FStarC_Ident.lident Prims.list) = fun p -> match p.pat with @@ -2516,7 +2469,7 @@ let rec (head_id_of_pat : pattern -> FStarC_Ident.lident Prims.list) = let (lids_of_let : (pattern * term) Prims.list -> FStarC_Ident.lident Prims.list) = fun defs -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___ -> match uu___ with | (p, uu___1) -> head_id_of_pat p) defs let (id_of_tycon : tycon -> Prims.string) = fun uu___ -> @@ -2530,13 +2483,11 @@ let (string_of_pragma : pragma -> Prims.string) = fun uu___ -> match uu___ with | ShowOptions -> "show-options" - | SetOptions s -> FStarC_Compiler_Util.format1 "set-options \"%s\"" s + | SetOptions s -> FStarC_Util.format1 "set-options \"%s\"" s | ResetOptions s -> - FStarC_Compiler_Util.format1 "reset-options \"%s\"" - (FStarC_Compiler_Util.dflt "" s) + FStarC_Util.format1 "reset-options \"%s\"" (FStarC_Util.dflt "" s) | PushOptions s -> - FStarC_Compiler_Util.format1 "push-options \"%s\"" - (FStarC_Compiler_Util.dflt "" s) + FStarC_Util.format1 "push-options \"%s\"" (FStarC_Util.dflt "" s) | PopOptions -> "pop-options" | RestartSolver -> "restart-solver" | PrintEffectsGraph -> "print-effects-graph" @@ -2549,21 +2500,21 @@ let (restriction_to_string : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (id, renamed) -> let uu___5 = FStarC_Ident.string_of_id id in let uu___6 = let uu___7 = - FStarC_Compiler_Util.map_opt renamed + FStarC_Util.map_opt renamed (fun renamed1 -> let uu___8 = FStarC_Ident.string_of_id renamed1 in Prims.strcat " as " uu___8) in - FStarC_Compiler_Util.dflt "" uu___7 in + FStarC_Util.dflt "" uu___7 in Prims.strcat uu___5 uu___6) allow_list in - FStarC_Compiler_String.concat ", " uu___3 in + FStarC_String.concat ", " uu___3 in Prims.strcat uu___2 "}" in Prims.strcat " {" uu___1 let rec (decl_to_string : decl -> Prims.string) = @@ -2588,22 +2539,21 @@ let rec (decl_to_string : decl -> Prims.string) = | ModuleAbbrev (i, l) -> let uu___ = FStarC_Ident.string_of_id i in let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format2 "module %s = %s" uu___ uu___1 + FStarC_Util.format2 "module %s = %s" uu___ uu___1 | TopLevelLet (uu___, pats) -> let uu___1 = let uu___2 = let uu___3 = lids_of_let pats in - FStarC_Compiler_List.map (fun l -> FStarC_Ident.string_of_lid l) - uu___3 in - FStarC_Compiler_String.concat ", " uu___2 in + FStarC_List.map (fun l -> FStarC_Ident.string_of_lid l) uu___3 in + FStarC_String.concat ", " uu___2 in Prims.strcat "let " uu___1 | Assume (i, uu___) -> let uu___1 = FStarC_Ident.string_of_id i in Prims.strcat "assume " uu___1 | Tycon (uu___, uu___1, tys) -> let uu___2 = - let uu___3 = FStarC_Compiler_List.map id_of_tycon tys in - FStarC_Compiler_String.concat ", " uu___3 in + let uu___3 = FStarC_List.map id_of_tycon tys in + FStarC_String.concat ", " uu___3 in Prims.strcat "type " uu___2 | Val (i, uu___) -> let uu___1 = FStarC_Ident.string_of_id i in @@ -2627,22 +2577,20 @@ let rec (decl_to_string : decl -> Prims.string) = let uu___1 = FStarC_Ident.string_of_lid l1 in let uu___2 = FStarC_Ident.string_of_lid l2 in let uu___3 = FStarC_Ident.string_of_lid l3 in - FStarC_Compiler_Util.format3 "polymonadic_bind (%s, %s) |> %s" uu___1 - uu___2 uu___3 + FStarC_Util.format3 "polymonadic_bind (%s, %s) |> %s" uu___1 uu___2 + uu___3 | Polymonadic_subcomp (l1, l2, uu___) -> let uu___1 = FStarC_Ident.string_of_lid l1 in let uu___2 = FStarC_Ident.string_of_lid l2 in - FStarC_Compiler_Util.format2 "polymonadic_subcomp %s <: %s" uu___1 - uu___2 + FStarC_Util.format2 "polymonadic_subcomp %s <: %s" uu___1 uu___2 | Splice (is_typed, ids, t) -> let uu___ = let uu___1 = let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.map - (fun i -> FStarC_Ident.string_of_id i) ids in - FStarC_Compiler_String.concat ";" uu___4 in + FStarC_List.map (fun i -> FStarC_Ident.string_of_id i) ids in + FStarC_String.concat ";" uu___4 in let uu___4 = let uu___5 = let uu___6 = term_to_string t in Prims.strcat uu___6 ")" in @@ -2661,17 +2609,17 @@ let rec (decl_to_string : decl -> Prims.string) = let uu___ = let uu___1 = tbs.to_string tbs.blob in Prims.strcat uu___1 ")" in Prims.strcat "(to_be_desugared: " uu___ - | UseLangDecls str -> FStarC_Compiler_Util.format1 "#lang-%s" str + | UseLangDecls str -> FStarC_Util.format1 "#lang-%s" str | Unparseable -> "unparseable" let (modul_to_string : modul -> Prims.string) = fun m -> match m with | Module (uu___, decls) -> - let uu___1 = FStarC_Compiler_List.map decl_to_string decls in - FStarC_Compiler_String.concat "\n" uu___1 + let uu___1 = FStarC_List.map decl_to_string decls in + FStarC_String.concat "\n" uu___1 | Interface (uu___, decls, uu___1) -> - let uu___2 = FStarC_Compiler_List.map decl_to_string decls in - FStarC_Compiler_String.concat "\n" uu___2 + let uu___2 = FStarC_List.map decl_to_string decls in + FStarC_String.concat "\n" uu___2 let (decl_is_val : FStarC_Ident.ident -> decl -> Prims.bool) = fun id -> fun decl1 -> @@ -2684,7 +2632,7 @@ let (thunk : term -> term) = mk_pattern (PatWild (FStar_Pervasives_Native.None, [])) ens.range in mk_term (Abs ([wildpat], ens)) ens.range Expr let (ident_of_binder : - FStarC_Compiler_Range_Type.range -> binder -> FStarC_Ident.ident) = + FStarC_Range_Type.range -> binder -> FStarC_Ident.ident) = fun r -> fun b -> match b.b with @@ -2699,8 +2647,8 @@ let (ident_of_binder : (Obj.magic "Wildcard binders in quantifiers are not allowed") let (idents_of_binders : binder Prims.list -> - FStarC_Compiler_Range_Type.range -> FStarC_Ident.ident Prims.list) - = fun bs -> fun r -> FStarC_Compiler_List.map (ident_of_binder r) bs + FStarC_Range_Type.range -> FStarC_Ident.ident Prims.list) + = fun bs -> fun r -> FStarC_List.map (ident_of_binder r) bs let (showable_decl : decl FStarC_Class_Show.showable) = { FStarC_Class_Show.show = decl_to_string } let (showable_term : term FStarC_Class_Show.showable) = @@ -2709,21 +2657,20 @@ let (add_decorations : decl -> decoration Prims.list -> decl) = fun d -> fun decorations -> let decorations1 = - let uu___ = - FStarC_Compiler_List.partition uu___is_DeclAttributes decorations in + let uu___ = FStarC_List.partition uu___is_DeclAttributes decorations in match uu___ with | (attrs, quals) -> let attrs1 = match (attrs, (d.attrs)) with | (attrs2, []) -> attrs2 | ((DeclAttributes a)::[], attrs2) -> - [DeclAttributes (FStarC_Compiler_List.op_At a attrs2)] + [DeclAttributes (FStarC_List.op_At a attrs2)] | ([], attrs2) -> [DeclAttributes attrs2] | uu___1 -> let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | DeclAttributes a -> @@ -2731,13 +2678,13 @@ let (add_decorations : decl -> decoration Prims.list -> decl) = (FStarC_Class_Show.show_list showable_term) a | uu___6 -> "") attrs in - FStarC_Compiler_String.concat ", " uu___4 in + FStarC_String.concat ", " uu___4 in let uu___4 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show showable_term) d.attrs in - FStarC_Compiler_String.concat ", " uu___5 in - FStarC_Compiler_Util.format2 + FStarC_String.concat ", " uu___5 in + FStarC_Util.format2 "At most one attribute set is allowed on declarations\n got %s;\n and %s" uu___3 uu___4 in FStarC_Errors.raise_error hasRange_decl d @@ -2745,21 +2692,19 @@ let (add_decorations : decl -> decoration Prims.list -> decl) = (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2) in let uu___1 = - FStarC_Compiler_List.map (fun uu___2 -> Qualifier uu___2) - d.quals in - FStarC_Compiler_List.op_At uu___1 - (FStarC_Compiler_List.op_At quals attrs1) in + FStarC_List.map (fun uu___2 -> Qualifier uu___2) d.quals in + FStarC_List.op_At uu___1 (FStarC_List.op_At quals attrs1) in let attributes_1 = let uu___ = - FStarC_Compiler_List.choose + FStarC_List.choose (fun uu___1 -> match uu___1 with | DeclAttributes a -> FStar_Pervasives_Native.Some a | uu___2 -> FStar_Pervasives_Native.None) decorations1 in at_most_one "attribute set" d.drange uu___ in - let attributes_2 = FStarC_Compiler_Util.dflt [] attributes_1 in + let attributes_2 = FStarC_Util.dflt [] attributes_1 in let qualifiers1 = - FStarC_Compiler_List.choose + FStarC_List.choose (fun uu___ -> match uu___ with | Qualifier q -> FStar_Pervasives_Native.Some q @@ -2772,8 +2717,7 @@ let (add_decorations : decl -> decoration Prims.list -> decl) = interleaved = (d.interleaved) } let (mk_decl : - decl' -> FStarC_Compiler_Range_Type.range -> decoration Prims.list -> decl) - = + decl' -> FStarC_Range_Type.range -> decoration Prims.list -> decl) = fun d -> fun r -> fun decorations -> diff --git a/stage0/fstar-lib/generated/FStarC_Parser_AST_Util.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_AST_Util.ml similarity index 89% rename from stage0/fstar-lib/generated/FStarC_Parser_AST_Util.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_AST_Util.ml index 2e021cd4abc..006c5bec98d 100644 --- a/stage0/fstar-lib/generated/FStarC_Parser_AST_Util.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_AST_Util.ml @@ -8,8 +8,8 @@ let eq_list : fun f -> fun t1 -> fun t2 -> - ((FStarC_Compiler_List.length t1) = (FStarC_Compiler_List.length t2)) - && (FStarC_Compiler_List.forall2 f t1 t2) + ((FStarC_List.length t1) = (FStarC_List.length t2)) && + (FStarC_List.forall2 f t1 t2) let eq_option : 'a . ('a -> 'a -> Prims.bool) -> @@ -677,7 +677,7 @@ let concat_map : unit -> ('uuuuu -> 'uuuuu1 Prims.list) -> 'uuuuu Prims.list -> 'uuuuu1 Prims.list - = fun uu___ -> FStarC_Compiler_List.collect + = fun uu___ -> FStarC_List.collect let opt_map : 'uuuuu 'a . ('a -> 'uuuuu Prims.list) -> @@ -713,12 +713,10 @@ and (lidents_of_term' : (concat_map ()) lidents_of_branch brs | FStarC_Parser_AST.Abs (ps, t1) -> let uu___ = (concat_map ()) lidents_of_pattern ps in - let uu___1 = lidents_of_term t1 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___1 = lidents_of_term t1 in FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.App (t1, t2, uu___) -> let uu___1 = lidents_of_term t1 in - let uu___2 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___1 uu___2 + let uu___2 = lidents_of_term t2 in FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.Let (uu___, lbs, t1) -> let uu___1 = (concat_map ()) @@ -727,9 +725,8 @@ and (lidents_of_term' : | (uu___3, (p, t2)) -> let uu___4 = lidents_of_pattern p in let uu___5 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___4 uu___5) lbs in - let uu___2 = lidents_of_term t1 in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___4 uu___5) lbs in + let uu___2 = lidents_of_term t1 in FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.LetOperator (lbs, t1) -> let uu___ = (concat_map ()) @@ -738,57 +735,50 @@ and (lidents_of_term' : | (uu___2, p, t2) -> let uu___3 = lidents_of_pattern p in let uu___4 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___3 uu___4) lbs in - let uu___1 = lidents_of_term t1 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___3 uu___4) lbs in + let uu___1 = lidents_of_term t1 in FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.LetOpen (lid, t1) -> let uu___ = lidents_of_term t1 in lid :: uu___ | FStarC_Parser_AST.LetOpenRecord (t1, t2, t3) -> let uu___ = lidents_of_term t1 in let uu___1 = let uu___2 = lidents_of_term t2 in - let uu___3 = lidents_of_term t3 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___3 = lidents_of_term t3 in FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.Seq (t1, t2) -> let uu___ = lidents_of_term t1 in - let uu___1 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___1 = lidents_of_term t2 in FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.Bind (uu___, t1, t2) -> let uu___1 = lidents_of_term t1 in - let uu___2 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___1 uu___2 + let uu___2 = lidents_of_term t2 in FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.If (t1, uu___, uu___1, t2, t3) -> let uu___2 = lidents_of_term t1 in let uu___3 = let uu___4 = lidents_of_term t2 in - let uu___5 = lidents_of_term t3 in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.op_At uu___2 uu___3 + let uu___5 = lidents_of_term t3 in FStarC_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___2 uu___3 | FStarC_Parser_AST.Match (t1, uu___, uu___1, bs) -> let uu___2 = lidents_of_term t1 in let uu___3 = (concat_map ()) lidents_of_branch bs in - FStarC_Compiler_List.op_At uu___2 uu___3 + FStarC_List.op_At uu___2 uu___3 | FStarC_Parser_AST.TryWith (t1, bs) -> let uu___ = lidents_of_term t1 in let uu___1 = (concat_map ()) lidents_of_branch bs in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.Ascribed (t1, t2, uu___, uu___1) -> let uu___2 = lidents_of_term t1 in - let uu___3 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___2 uu___3 + let uu___3 = lidents_of_term t2 in FStarC_List.op_At uu___2 uu___3 | FStarC_Parser_AST.Record (t1, ts) -> let uu___ = (concat_map ()) (fun uu___1 -> match uu___1 with | (uu___2, t2) -> lidents_of_term t2) ts in let uu___1 = opt_map lidents_of_term t1 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.Project (t1, uu___) -> lidents_of_term t1 | FStarC_Parser_AST.Product (ts, t1) -> let uu___ = (concat_map ()) lidents_of_binder ts in - let uu___1 = lidents_of_term t1 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___1 = lidents_of_term t1 in FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.Sum (ts, t1) -> let uu___ = (concat_map ()) @@ -796,8 +786,7 @@ and (lidents_of_term' : match uu___1 with | FStar_Pervasives.Inl b -> lidents_of_binder b | FStar_Pervasives.Inr t2 -> lidents_of_term t2) ts in - let uu___1 = lidents_of_term t1 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___1 = lidents_of_term t1 in FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.QForall (bs, _pats, t1) -> lidents_of_term t1 | FStarC_Parser_AST.QExists (bs, _pats, t1) -> lidents_of_term t1 | FStarC_Parser_AST.QuantOp (i, bs, pats, t1) -> lidents_of_term t1 @@ -809,8 +798,7 @@ and (lidents_of_term' : | FStarC_Parser_AST.LexList ts -> (concat_map ()) lidents_of_term ts | FStarC_Parser_AST.WFOrder (t1, t2) -> let uu___ = lidents_of_term t1 in - let uu___1 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___1 = lidents_of_term t2 in FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.Decreases (t1, uu___) -> lidents_of_term t1 | FStarC_Parser_AST.Labeled (t1, uu___, uu___1) -> lidents_of_term t1 | FStarC_Parser_AST.Discrim lid -> [lid] @@ -823,33 +811,29 @@ and (lidents_of_term' : let uu___1 = let uu___2 = lidents_of_term t2 in let uu___3 = (concat_map ()) lidents_of_calc_step ts in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.IntroForall (bs, t1, t2) -> let uu___ = lidents_of_term t1 in - let uu___1 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___1 = lidents_of_term t2 in FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.IntroExists (bs, t1, ts, t2) -> let uu___ = lidents_of_term t1 in let uu___1 = let uu___2 = (concat_map ()) lidents_of_term ts in - let uu___3 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___3 = lidents_of_term t2 in FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.IntroImplies (t1, t2, b, t3) -> let uu___ = lidents_of_term t1 in let uu___1 = let uu___2 = lidents_of_term t2 in - let uu___3 = lidents_of_term t3 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___3 = lidents_of_term t3 in FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.IntroOr (b, t1, t2, t3) -> let uu___ = lidents_of_term t1 in let uu___1 = let uu___2 = lidents_of_term t2 in - let uu___3 = lidents_of_term t3 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___3 = lidents_of_term t3 in FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.IntroAnd (t1, t2, t3, t4) -> let uu___ = lidents_of_term t1 in let uu___1 = @@ -857,16 +841,16 @@ and (lidents_of_term' : let uu___3 = let uu___4 = lidents_of_term t3 in let uu___5 = lidents_of_term t4 in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.ElimForall (bs, t1, ts) -> let uu___ = (concat_map ()) lidents_of_binder bs in let uu___1 = let uu___2 = lidents_of_term t1 in let uu___3 = (concat_map ()) lidents_of_term ts in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.ElimExists (bs, t1, t2, b, t3) -> let uu___ = (concat_map ()) lidents_of_binder bs in let uu___1 = @@ -874,16 +858,15 @@ and (lidents_of_term' : let uu___3 = let uu___4 = lidents_of_term t2 in let uu___5 = lidents_of_term t3 in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.ElimImplies (t1, t2, t3) -> let uu___ = lidents_of_term t1 in let uu___1 = let uu___2 = lidents_of_term t2 in - let uu___3 = lidents_of_term t3 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___3 = lidents_of_term t3 in FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.ElimOr (t1, t2, t3, b1, t4, b2, t5) -> let uu___ = lidents_of_term t1 in let uu___1 = @@ -893,10 +876,10 @@ and (lidents_of_term' : let uu___5 = let uu___6 = lidents_of_term t4 in let uu___7 = lidents_of_term t5 in - FStarC_Compiler_List.op_At uu___6 uu___7 in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___6 uu___7 in + FStarC_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.ElimAnd (t1, t2, t3, b1, b2, t4) -> let uu___ = lidents_of_term t1 in let uu___1 = @@ -904,9 +887,9 @@ and (lidents_of_term' : let uu___3 = let uu___4 = lidents_of_term t3 in let uu___5 = lidents_of_term t4 in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.ListLiteral ts -> (concat_map ()) lidents_of_term ts | FStarC_Parser_AST.SeqLiteral ts -> (concat_map ()) lidents_of_term ts and (lidents_of_branch : @@ -918,8 +901,7 @@ and (lidents_of_branch : match uu___ with | (p, uu___1, t) -> let uu___2 = lidents_of_pattern p in - let uu___3 = lidents_of_term t in - FStarC_Compiler_List.op_At uu___2 uu___3 + let uu___3 = lidents_of_term t in FStarC_List.op_At uu___2 uu___3 and (lidents_of_calc_step : FStarC_Parser_AST.calc_step -> FStarC_Ident.lident Prims.list) = fun uu___ -> @@ -928,9 +910,8 @@ and (lidents_of_calc_step : let uu___1 = lidents_of_term t1 in let uu___2 = let uu___3 = lidents_of_term t2 in - let uu___4 = lidents_of_term t3 in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + let uu___4 = lidents_of_term t3 in FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 and (lidents_of_pattern : FStarC_Parser_AST.pattern -> FStarC_Ident.lident Prims.list) = fun p -> @@ -940,7 +921,7 @@ and (lidents_of_pattern : | FStarC_Parser_AST.PatApp (p1, ps) -> let uu___ = lidents_of_pattern p1 in let uu___1 = (concat_map ()) lidents_of_pattern ps in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.PatVar (i, uu___, uu___1) -> let uu___2 = FStarC_Ident.lid_of_ids [i] in [uu___2] | FStarC_Parser_AST.PatName lid -> [lid] @@ -957,8 +938,8 @@ and (lidents_of_pattern : let uu___1 = let uu___2 = lidents_of_term t1 in let uu___3 = opt_map lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Parser_AST.PatOr ps -> (concat_map ()) lidents_of_pattern ps | FStarC_Parser_AST.PatOp uu___ -> [] | FStarC_Parser_AST.PatVQuote t -> lidents_of_term t @@ -987,8 +968,7 @@ let (lidents_of_constructor_payload : (concat_map ()) lidents_of_tycon_record tc | FStarC_Parser_AST.VpRecord (tc, FStar_Pervasives_Native.Some t1) -> let uu___ = (concat_map ()) lidents_of_tycon_record tc in - let uu___1 = lidents_of_term t1 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___1 = lidents_of_term t1 in FStarC_List.op_At uu___ uu___1 let (lidents_of_tycon_variant : (FStarC_Ident.ident * FStarC_Parser_AST.constructor_payload FStar_Pervasives_Native.option * FStarC_Parser_AST.attributes_) -> @@ -1006,28 +986,27 @@ let (lidents_of_tycon : | FStarC_Parser_AST.TyconAbstract (uu___, bs, k) -> let uu___1 = (concat_map ()) lidents_of_binder bs in let uu___2 = opt_map lidents_of_term k in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.TyconAbbrev (uu___, bs, k, t) -> let uu___1 = (concat_map ()) lidents_of_binder bs in let uu___2 = let uu___3 = opt_map lidents_of_term k in - let uu___4 = lidents_of_term t in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + let uu___4 = lidents_of_term t in FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.TyconRecord (uu___, bs, k, uu___1, tcs) -> let uu___2 = (concat_map ()) lidents_of_binder bs in let uu___3 = let uu___4 = opt_map lidents_of_term k in let uu___5 = (concat_map ()) lidents_of_tycon_record tcs in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.op_At uu___2 uu___3 + FStarC_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___2 uu___3 | FStarC_Parser_AST.TyconVariant (uu___, bs, k, tcs) -> let uu___1 = (concat_map ()) lidents_of_binder bs in let uu___2 = let uu___3 = opt_map lidents_of_term k in let uu___4 = (concat_map ()) lidents_of_tycon_variant tcs in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 let (lidents_of_lift : FStarC_Parser_AST.lift -> FStarC_Ident.lident Prims.list) = fun l -> @@ -1036,10 +1015,9 @@ let (lidents_of_lift : | FStarC_Parser_AST.NonReifiableLift t -> lidents_of_term t | FStarC_Parser_AST.ReifiableLift (t1, t2) -> let uu___1 = lidents_of_term t1 in - let uu___2 = lidents_of_term t2 in - FStarC_Compiler_List.op_At uu___1 uu___2 + let uu___2 = lidents_of_term t2 in FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.LiftForFree t -> lidents_of_term t in - FStarC_Compiler_List.op_At + FStarC_List.op_At [l.FStarC_Parser_AST.msource; l.FStarC_Parser_AST.mdest] uu___ let rec (lidents_of_decl : FStarC_Parser_AST.decl -> FStarC_Ident.lident Prims.list) = @@ -1057,7 +1035,7 @@ let rec (lidents_of_decl : | (p, t) -> let uu___1 = lidents_of_pattern p in let uu___2 = lidents_of_term t in - FStarC_Compiler_List.op_At uu___1 uu___2) lbs + FStarC_List.op_At uu___1 uu___2) lbs | FStarC_Parser_AST.Tycon (uu___, uu___1, tcs) -> (concat_map ()) lidents_of_tycon tcs | FStarC_Parser_AST.Val (uu___, t) -> lidents_of_term t @@ -1089,12 +1067,11 @@ and (lidents_of_effect_decl : let uu___2 = let uu___3 = lidents_of_term t in let uu___4 = (concat_map ()) lidents_of_decl ds in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.RedefineEffect (uu___, bs, t) -> let uu___1 = (concat_map ()) lidents_of_binder bs in - let uu___2 = lidents_of_term t in - FStarC_Compiler_List.op_At uu___1 uu___2 + let uu___2 = lidents_of_term t in FStarC_List.op_At uu___1 uu___2 type open_namespaces_and_abbreviations = { open_namespaces: FStarC_Ident.lident Prims.list ; @@ -1112,32 +1089,31 @@ let (__proj__Mkopen_namespaces_and_abbreviations__item__module_abbreviations fun projectee -> match projectee with | { open_namespaces; module_abbreviations;_} -> module_abbreviations -type error_message = - { +type error_message = { message: Prims.string ; - range: FStarC_Compiler_Range_Type.range } + range: FStarC_Range_Type.range } let (__proj__Mkerror_message__item__message : error_message -> Prims.string) = fun projectee -> match projectee with | { message; range;_} -> message let (__proj__Mkerror_message__item__range : - error_message -> FStarC_Compiler_Range_Type.range) = + error_message -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { message; range;_} -> range type extension_parser = { parse_decl_name: Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (error_message, FStarC_Ident.ident) FStar_Pervasives.either ; parse_decl: open_namespaces_and_abbreviations -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (error_message, FStarC_Parser_AST.decl) FStar_Pervasives.either } let (__proj__Mkextension_parser__item__parse_decl_name : extension_parser -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (error_message, FStarC_Ident.ident) FStar_Pervasives.either) = fun projectee -> @@ -1147,47 +1123,45 @@ let (__proj__Mkextension_parser__item__parse_decl : extension_parser -> open_namespaces_and_abbreviations -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (error_message, FStarC_Parser_AST.decl) FStar_Pervasives.either) = fun projectee -> match projectee with | { parse_decl_name; parse_decl;_} -> parse_decl -let (extension_parser_table : extension_parser FStarC_Compiler_Util.smap) = - FStarC_Compiler_Util.smap_create (Prims.of_int (20)) +let (extension_parser_table : extension_parser FStarC_Util.smap) = + FStarC_Util.smap_create (Prims.of_int (20)) let (register_extension_parser : Prims.string -> extension_parser -> unit) = fun ext -> - fun parser -> - FStarC_Compiler_Util.smap_add extension_parser_table ext parser + fun parser -> FStarC_Util.smap_add extension_parser_table ext parser let (lookup_extension_parser : Prims.string -> extension_parser FStar_Pervasives_Native.option) = fun ext -> - let do1 uu___ = - FStarC_Compiler_Util.smap_try_find extension_parser_table ext in + let do1 uu___ = FStarC_Util.smap_try_find extension_parser_table ext in let uu___ = do1 () in match uu___ with | FStar_Pervasives_Native.None -> - let uu___1 = FStarC_Compiler_Plugins.autoload_plugin ext in + let uu___1 = FStarC_Plugins.autoload_plugin ext in if uu___1 then do1 () else FStar_Pervasives_Native.None | r -> r type extension_lang_parser = { parse_decls: Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (error_message, FStarC_Parser_AST.decl Prims.list) FStar_Pervasives.either } let (__proj__Mkextension_lang_parser__item__parse_decls : extension_lang_parser -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (error_message, FStarC_Parser_AST.decl Prims.list) FStar_Pervasives.either) = fun projectee -> match projectee with | { parse_decls;_} -> parse_decls let (as_open_namespaces_and_abbrevs : FStarC_Parser_AST.decl Prims.list -> open_namespaces_and_abbreviations) = fun ls -> - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun d -> fun out -> match d.FStarC_Parser_AST.d with @@ -1204,31 +1178,27 @@ let (as_open_namespaces_and_abbrevs : } | uu___ -> out) ls { open_namespaces = []; module_abbreviations = [] } -let (extension_lang_parser_table : - extension_lang_parser FStarC_Compiler_Util.smap) = - FStarC_Compiler_Util.smap_create (Prims.of_int (20)) +let (extension_lang_parser_table : extension_lang_parser FStarC_Util.smap) = + FStarC_Util.smap_create (Prims.of_int (20)) let (register_extension_lang_parser : Prims.string -> extension_lang_parser -> unit) = fun ext -> - fun parser -> - FStarC_Compiler_Util.smap_add extension_lang_parser_table ext parser + fun parser -> FStarC_Util.smap_add extension_lang_parser_table ext parser let (lookup_extension_lang_parser : Prims.string -> extension_lang_parser FStar_Pervasives_Native.option) = fun ext -> - let r = - FStarC_Compiler_Util.smap_try_find extension_lang_parser_table ext in + let r = FStarC_Util.smap_try_find extension_lang_parser_table ext in match r with | FStar_Pervasives_Native.None -> - let uu___ = FStarC_Compiler_Plugins.autoload_plugin ext in + let uu___ = FStarC_Plugins.autoload_plugin ext in if uu___ - then - FStarC_Compiler_Util.smap_try_find extension_lang_parser_table ext + then FStarC_Util.smap_try_find extension_lang_parser_table ext else FStar_Pervasives_Native.None | uu___ -> r let (parse_extension_lang : Prims.string -> Prims.string -> - FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.decl Prims.list) + FStarC_Range_Type.range -> FStarC_Parser_AST.decl Prims.list) = fun lang_name -> fun raw_text -> @@ -1237,8 +1207,7 @@ let (parse_extension_lang : match extension_parser1 with | FStar_Pervasives_Native.None -> let uu___ = - FStarC_Compiler_Util.format1 "Unknown language extension %s" - lang_name in + FStarC_Util.format1 "Unknown language extension %s" lang_name in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range raw_text_pos FStarC_Errors_Codes.Fatal_SyntaxError () (Obj.magic FStarC_Errors_Msg.is_error_message_string) diff --git a/stage0/fstar-lib/generated/FStarC_Parser_Const.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Const.ml similarity index 88% rename from stage0/fstar-lib/generated/FStarC_Parser_Const.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Const.ml index 10cebd248a7..c466291ed0b 100644 --- a/stage0/fstar-lib/generated/FStarC_Parser_Const.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Const.ml @@ -1,6 +1,6 @@ open Prims let (p2l : FStarC_Ident.path -> FStarC_Ident.lident) = - fun l -> FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange + fun l -> FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange let (pconst : Prims.string -> FStarC_Ident.lident) = fun s -> p2l ["Prims"; s] let (psconst : Prims.string -> FStarC_Ident.lident) = @@ -229,29 +229,25 @@ let (ef_base : unit -> Prims.string Prims.list) = if uu___1 then let uu___2 = FStarC_Options.ml_ish_effect () in - FStar_String.split [46] uu___2 + FStarC_String.split [46] uu___2 else ["FStar"; "All"] let (effect_ALL_lid : unit -> FStarC_Ident.lident) = fun uu___ -> - let uu___1 = - let uu___2 = ef_base () in FStarC_Compiler_List.op_At uu___2 ["ALL"] in + let uu___1 = let uu___2 = ef_base () in FStarC_List.op_At uu___2 ["ALL"] in p2l uu___1 let (effect_ML_lid : unit -> FStarC_Ident.lident) = fun uu___ -> - let uu___1 = - let uu___2 = ef_base () in FStarC_Compiler_List.op_At uu___2 ["ML"] in + let uu___1 = let uu___2 = ef_base () in FStarC_List.op_At uu___2 ["ML"] in p2l uu___1 let (failwith_lid : unit -> FStarC_Ident.lident) = fun uu___ -> let uu___1 = - let uu___2 = ef_base () in - FStarC_Compiler_List.op_At uu___2 ["failwith"] in + let uu___2 = ef_base () in FStarC_List.op_At uu___2 ["failwith"] in p2l uu___1 let (try_with_lid : unit -> FStarC_Ident.lident) = fun uu___ -> let uu___1 = - let uu___2 = ef_base () in - FStarC_Compiler_List.op_At uu___2 ["try_with"] in + let uu___2 = ef_base () in FStarC_List.op_At uu___2 ["try_with"] in p2l uu___1 let (as_requires : FStarC_Ident.lident) = pconst "as_requires" let (as_ensures : FStarC_Ident.lident) = pconst "as_ensures" @@ -286,6 +282,7 @@ let (steps_delta : FStarC_Ident.lident) = psconst "delta" let (steps_reify : FStarC_Ident.lident) = psconst "reify_" let (steps_norm_debug : FStarC_Ident.lident) = psconst "norm_debug" let (steps_unfoldonly : FStarC_Ident.lident) = psconst "delta_only" +let (steps_unfoldonce : FStarC_Ident.lident) = psconst "delta_once" let (steps_unfoldfully : FStarC_Ident.lident) = psconst "delta_fully" let (steps_unfoldattr : FStarC_Ident.lident) = psconst "delta_attr" let (steps_unfoldqual : FStarC_Ident.lident) = psconst "delta_qualifier" @@ -365,10 +362,9 @@ let (desugar_of_variant_record_lid : FStarC_Ident.lident) = let (well_founded_relation_lid : FStarC_Ident.lident) = p2l ["FStar"; "WellFounded"; "well_founded_relation"] let (gen_reset : ((unit -> Prims.int) * (unit -> unit))) = - let x = FStarC_Compiler_Util.mk_ref Prims.int_zero in - let gen uu___ = FStarC_Compiler_Util.incr x; FStarC_Compiler_Util.read x in - let reset uu___ = FStarC_Compiler_Util.write x Prims.int_zero in - (gen, reset) + let x = FStarC_Util.mk_ref Prims.int_zero in + let gen uu___ = FStarC_Util.incr x; FStarC_Util.read x in + let reset uu___ = FStarC_Util.write x Prims.int_zero in (gen, reset) let (next_id : unit -> Prims.int) = FStar_Pervasives_Native.fst gen_reset let (sli : FStarC_Ident.lident -> Prims.string) = fun l -> @@ -385,14 +381,11 @@ let (const_to_string : FStarC_Const.sconst -> Prims.string) = | FStarC_Const.Const_unit -> "()" | FStarC_Const.Const_bool b -> if b then "true" else "false" | FStarC_Const.Const_real r -> Prims.strcat r "R" - | FStarC_Const.Const_string (s, uu___) -> - FStarC_Compiler_Util.format1 "\"%s\"" s + | FStarC_Const.Const_string (s, uu___) -> FStarC_Util.format1 "\"%s\"" s | FStarC_Const.Const_int (x1, uu___) -> x1 | FStarC_Const.Const_char c -> - Prims.strcat "'" - (Prims.strcat (FStarC_Compiler_Util.string_of_char c) "'") - | FStarC_Const.Const_range r -> - FStarC_Compiler_Range_Ops.string_of_range r + Prims.strcat "'" (Prims.strcat (FStarC_Util.string_of_char c) "'") + | FStarC_Const.Const_range r -> FStarC_Range_Ops.string_of_range r | FStarC_Const.Const_range_of -> "range_of" | FStarC_Const.Const_set_range_of -> "set_range_of" | FStarC_Const.Const_reify lopt -> @@ -401,29 +394,28 @@ let (const_to_string : FStarC_Const.sconst -> Prims.string) = | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some l -> let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 "<%s>" uu___1 in - FStarC_Compiler_Util.format1 "reify%s" uu___ + FStarC_Util.format1 "<%s>" uu___1 in + FStarC_Util.format1 "reify%s" uu___ | FStarC_Const.Const_reflect l -> - let uu___ = sli l in - FStarC_Compiler_Util.format1 "[[%s.reflect]]" uu___ + let uu___ = sli l in FStarC_Util.format1 "[[%s.reflect]]" uu___ let (mk_tuple_lid : - Prims.int -> FStarC_Compiler_Range_Type.range -> FStarC_Ident.lident) = + Prims.int -> FStarC_Range_Type.range -> FStarC_Ident.lident) = fun n -> fun r -> let t = - let uu___ = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "tuple%s" uu___ in + let uu___ = FStarC_Util.string_of_int n in + FStarC_Util.format1 "tuple%s" uu___ in let uu___ = psnconst t in FStarC_Ident.set_lid_range uu___ r let (lid_tuple2 : FStarC_Ident.lident) = - mk_tuple_lid (Prims.of_int (2)) FStarC_Compiler_Range_Type.dummyRange + mk_tuple_lid (Prims.of_int (2)) FStarC_Range_Type.dummyRange let (lid_tuple3 : FStarC_Ident.lident) = - mk_tuple_lid (Prims.of_int (3)) FStarC_Compiler_Range_Type.dummyRange + mk_tuple_lid (Prims.of_int (3)) FStarC_Range_Type.dummyRange let (lid_tuple4 : FStarC_Ident.lident) = - mk_tuple_lid (Prims.of_int (4)) FStarC_Compiler_Range_Type.dummyRange + mk_tuple_lid (Prims.of_int (4)) FStarC_Range_Type.dummyRange let (lid_tuple5 : FStarC_Ident.lident) = - mk_tuple_lid (Prims.of_int (5)) FStarC_Compiler_Range_Type.dummyRange + mk_tuple_lid (Prims.of_int (5)) FStarC_Range_Type.dummyRange let (is_tuple_constructor_string : Prims.string -> Prims.bool) = - fun s -> FStarC_Compiler_Util.starts_with s "FStar.Pervasives.Native.tuple" + fun s -> FStarC_Util.starts_with s "FStar.Pervasives.Native.tuple" let (is_tuple_constructor_id : FStarC_Ident.ident -> Prims.bool) = fun id -> let uu___ = FStarC_Ident.string_of_id id in @@ -433,24 +425,23 @@ let (is_tuple_constructor_lid : FStarC_Ident.lident -> Prims.bool) = let uu___ = FStarC_Ident.string_of_lid lid in is_tuple_constructor_string uu___ let (mk_tuple_data_lid : - Prims.int -> FStarC_Compiler_Range_Type.range -> FStarC_Ident.lident) = + Prims.int -> FStarC_Range_Type.range -> FStarC_Ident.lident) = fun n -> fun r -> let t = - let uu___ = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "Mktuple%s" uu___ in + let uu___ = FStarC_Util.string_of_int n in + FStarC_Util.format1 "Mktuple%s" uu___ in let uu___ = psnconst t in FStarC_Ident.set_lid_range uu___ r let (lid_Mktuple2 : FStarC_Ident.lident) = - mk_tuple_data_lid (Prims.of_int (2)) FStarC_Compiler_Range_Type.dummyRange + mk_tuple_data_lid (Prims.of_int (2)) FStarC_Range_Type.dummyRange let (lid_Mktuple3 : FStarC_Ident.lident) = - mk_tuple_data_lid (Prims.of_int (3)) FStarC_Compiler_Range_Type.dummyRange + mk_tuple_data_lid (Prims.of_int (3)) FStarC_Range_Type.dummyRange let (lid_Mktuple4 : FStarC_Ident.lident) = - mk_tuple_data_lid (Prims.of_int (4)) FStarC_Compiler_Range_Type.dummyRange + mk_tuple_data_lid (Prims.of_int (4)) FStarC_Range_Type.dummyRange let (lid_Mktuple5 : FStarC_Ident.lident) = - mk_tuple_data_lid (Prims.of_int (5)) FStarC_Compiler_Range_Type.dummyRange + mk_tuple_data_lid (Prims.of_int (5)) FStarC_Range_Type.dummyRange let (is_tuple_datacon_string : Prims.string -> Prims.bool) = - fun s -> - FStarC_Compiler_Util.starts_with s "FStar.Pervasives.Native.Mktuple" + fun s -> FStarC_Util.starts_with s "FStar.Pervasives.Native.Mktuple" let (is_tuple_datacon_id : FStarC_Ident.ident -> Prims.bool) = fun id -> let uu___ = FStarC_Ident.string_of_id id in is_tuple_datacon_string uu___ @@ -461,7 +452,7 @@ let (is_tuple_datacon_lid : FStarC_Ident.lident -> Prims.bool) = let (is_tuple_data_lid : FStarC_Ident.lident -> Prims.int -> Prims.bool) = fun f -> fun n -> - let uu___ = mk_tuple_data_lid n FStarC_Compiler_Range_Type.dummyRange in + let uu___ = mk_tuple_data_lid n FStarC_Range_Type.dummyRange in FStarC_Ident.lid_equals f uu___ let (is_tuple_data_lid' : FStarC_Ident.lident -> Prims.bool) = fun f -> @@ -469,39 +460,39 @@ let (is_tuple_data_lid' : FStarC_Ident.lident -> Prims.bool) = let (mod_prefix_dtuple : Prims.int -> Prims.string -> FStarC_Ident.lident) = fun n -> if n = (Prims.of_int (2)) then pconst else psconst let (mk_dtuple_lid : - Prims.int -> FStarC_Compiler_Range_Type.range -> FStarC_Ident.lident) = + Prims.int -> FStarC_Range_Type.range -> FStarC_Ident.lident) = fun n -> fun r -> let t = - let uu___ = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "dtuple%s" uu___ in + let uu___ = FStarC_Util.string_of_int n in + FStarC_Util.format1 "dtuple%s" uu___ in let uu___ = let uu___1 = mod_prefix_dtuple n in uu___1 t in FStarC_Ident.set_lid_range uu___ r let (is_dtuple_constructor_string : Prims.string -> Prims.bool) = fun s -> (s = "Prims.dtuple2") || - (FStarC_Compiler_Util.starts_with s "FStar.Pervasives.dtuple") + (FStarC_Util.starts_with s "FStar.Pervasives.dtuple") let (is_dtuple_constructor_lid : FStarC_Ident.lident -> Prims.bool) = fun lid -> let uu___ = FStarC_Ident.string_of_lid lid in is_dtuple_constructor_string uu___ let (mk_dtuple_data_lid : - Prims.int -> FStarC_Compiler_Range_Type.range -> FStarC_Ident.lident) = + Prims.int -> FStarC_Range_Type.range -> FStarC_Ident.lident) = fun n -> fun r -> let t = - let uu___ = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "Mkdtuple%s" uu___ in + let uu___ = FStarC_Util.string_of_int n in + FStarC_Util.format1 "Mkdtuple%s" uu___ in let uu___ = let uu___1 = mod_prefix_dtuple n in uu___1 t in FStarC_Ident.set_lid_range uu___ r let (is_dtuple_datacon_string : Prims.string -> Prims.bool) = fun s -> (s = "Prims.Mkdtuple2") || - (FStarC_Compiler_Util.starts_with s "FStar.Pervasives.Mkdtuple") + (FStarC_Util.starts_with s "FStar.Pervasives.Mkdtuple") let (is_dtuple_data_lid : FStarC_Ident.lident -> Prims.int -> Prims.bool) = fun f -> fun n -> - let uu___ = mk_dtuple_data_lid n FStarC_Compiler_Range_Type.dummyRange in + let uu___ = mk_dtuple_data_lid n FStarC_Range_Type.dummyRange in FStarC_Ident.lid_equals f uu___ let (is_dtuple_data_lid' : FStarC_Ident.lident -> Prims.bool) = fun f -> @@ -513,21 +504,20 @@ let (is_name : FStarC_Ident.lident -> Prims.bool) = let uu___ = let uu___1 = FStarC_Ident.ident_of_lid lid in FStarC_Ident.string_of_id uu___1 in - FStarC_Compiler_Util.char_at uu___ Prims.int_zero in - FStarC_Compiler_Util.is_upper c + FStarC_Util.char_at uu___ Prims.int_zero in + FStarC_Util.is_upper c let (term_view_lid : FStarC_Ident.lident) = p2l ["FStar"; "Reflection"; "V1"; "Data"; "term_view"] let (fstar_tactics_lid' : Prims.string Prims.list -> FStarC_Ident.lid) = fun s -> - FStarC_Ident.lid_of_path - (FStarC_Compiler_List.op_At ["FStar"; "Tactics"] s) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Ident.lid_of_path (FStarC_List.op_At ["FStar"; "Tactics"] s) + FStarC_Range_Type.dummyRange let (fstar_stubs_tactics_lid' : Prims.string Prims.list -> FStarC_Ident.lid) = fun s -> FStarC_Ident.lid_of_path - (FStarC_Compiler_List.op_At ["FStar"; "Stubs"; "Tactics"] s) - FStarC_Compiler_Range_Type.dummyRange + (FStarC_List.op_At ["FStar"; "Stubs"; "Tactics"] s) + FStarC_Range_Type.dummyRange let (fstar_tactics_lid : Prims.string -> FStarC_Ident.lid) = fun s -> fstar_tactics_lid' [s] let (tac_lid : FStarC_Ident.lid) = fstar_tactics_lid' ["Effect"; "tac"] @@ -564,17 +554,17 @@ let (fstar_syntax_syntax_term : FStarC_Ident.lident) = let (binder_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["FStar"; "Stubs"; "Reflection"; "Types"; "binder"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (binders_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["FStar"; "Stubs"; "Reflection"; "Types"; "binders"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (bv_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["FStar"; "Stubs"; "Reflection"; "Types"; "bv"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (fv_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["FStar"; "Stubs"; "Reflection"; "Types"; "fv"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (norm_step_lid : FStarC_Ident.lident) = psconst "norm_step" let (postprocess_with : FStarC_Ident.lident) = p2l ["FStar"; "Tactics"; "Effect"; "postprocess_with"] @@ -590,22 +580,21 @@ let (universe_uvar_lid : FStarC_Ident.lident) = p2l ["FStar"; "Stubs"; "Reflection"; "Types"; "universe_uvar"] let (check_with_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["FStar"; "Stubs"; "VConfig"; "check_with"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (decls_lid : FStarC_Ident.lident) = p2l ["FStar"; "Stubs"; "Reflection"; "Types"; "decls"] let (dsl_typing_builtin : Prims.string -> FStarC_Ident.lident) = fun s -> FStarC_Ident.lid_of_path - (FStarC_Compiler_List.op_At - ["FStar"; "Reflection"; "Typing"; "Builtins"] [s]) - FStarC_Compiler_Range_Type.dummyRange + (FStarC_List.op_At ["FStar"; "Reflection"; "Typing"; "Builtins"] [s]) + FStarC_Range_Type.dummyRange let (dsl_tac_typ_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["FStar"; "Reflection"; "Typing"; "dsl_tac_t"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (calc_lid : Prims.string -> FStarC_Ident.lid) = fun i -> FStarC_Ident.lid_of_path ["FStar"; "Calc"; i] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (calc_init_lid : FStarC_Ident.lid) = calc_lid "calc_init" let (calc_step_lid : FStarC_Ident.lid) = calc_lid "calc_step" let (calc_finish_lid : FStarC_Ident.lid) = calc_lid "calc_finish" @@ -613,7 +602,7 @@ let (calc_push_impl_lid : FStarC_Ident.lid) = calc_lid "calc_push_impl" let (classical_sugar_lid : Prims.string -> FStarC_Ident.lid) = fun i -> FStarC_Ident.lid_of_path ["FStar"; "Classical"; "Sugar"; i] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (forall_intro_lid : FStarC_Ident.lid) = classical_sugar_lid "forall_intro" let (exists_intro_lid : FStarC_Ident.lid) = @@ -635,29 +624,29 @@ let (match_returns_def_name : Prims.string) = Prims.strcat FStarC_Ident.reserved_prefix "_ret_" let (steel_memory_inv_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["Steel"; "Memory"; "inv"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (steel_new_invariant_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["Steel"; "Effect"; "Atomic"; "new_invariant"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (steel_st_new_invariant_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["Steel"; "ST"; "Util"; "new_invariant"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (steel_with_invariant_g_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["Steel"; "Effect"; "Atomic"; "with_invariant_g"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (steel_st_with_invariant_g_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["Steel"; "ST"; "Util"; "with_invariant_g"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (steel_with_invariant_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["Steel"; "Effect"; "Atomic"; "with_invariant"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (steel_st_with_invariant_lid : FStarC_Ident.lident) = FStarC_Ident.lid_of_path ["Steel"; "ST"; "Util"; "with_invariant"] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (fext_lid : Prims.string -> FStarC_Ident.lident) = fun s -> FStarC_Ident.lid_of_path ["FStar"; "FunctionalExtensionality"; s] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (fext_on_domain_lid : FStarC_Ident.lident) = fext_lid "on_domain" let (fext_on_dom_lid : FStarC_Ident.lident) = fext_lid "on_dom" let (fext_on_domain_g_lid : FStarC_Ident.lident) = fext_lid "on_domain_g" diff --git a/stage0/fstar-lib/generated/FStarC_Parser_Dep.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Dep.ml similarity index 77% rename from stage0/fstar-lib/generated/FStarC_Parser_Dep.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Dep.ml index 9be029dad40..867c7a5a349 100644 --- a/stage0/fstar-lib/generated/FStarC_Parser_Dep.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Dep.ml @@ -9,25 +9,24 @@ let (uu___is_Open_namespace : open_kind -> Prims.bool) = fun projectee -> match projectee with | Open_namespace -> true | uu___ -> false type module_name = Prims.string -let (dbg : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Dep" -let (dbg_CheckedFiles : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "CheckedFiles" +let (dbg : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Dep" +let (dbg_CheckedFiles : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "CheckedFiles" let profile : 'uuuuu . (unit -> 'uuuuu) -> Prims.string -> 'uuuuu = fun f -> fun c -> FStarC_Profiling.profile f FStar_Pervasives_Native.None c let with_file_outchannel : - 'a . Prims.string -> (FStarC_Compiler_Util.out_channel -> 'a) -> 'a = + 'a . Prims.string -> (FStarC_Util.out_channel -> 'a) -> 'a = fun fn -> fun k -> - let outc = FStarC_Compiler_Util.open_file_for_writing fn in + let outc = FStarC_Util.open_file_for_writing fn in let r = try (fun uu___ -> match () with | () -> k outc) () with | uu___ -> - (FStarC_Compiler_Util.close_out_channel outc; - FStarC_Compiler_Util.delete_file fn; - FStarC_Compiler_Effect.raise uu___) in - FStarC_Compiler_Util.close_out_channel outc; r + (FStarC_Util.close_out_channel outc; + FStarC_Util.delete_file fn; + FStarC_Effect.raise uu___) in + FStarC_Util.close_out_channel outc; r type verify_mode = | VerifyAll | VerifyUserList @@ -43,7 +42,7 @@ let (uu___is_VerifyFigureItOut : verify_mode -> Prims.bool) = type intf_and_impl = (Prims.string FStar_Pervasives_Native.option * Prims.string FStar_Pervasives_Native.option) -type files_for_module_name = intf_and_impl FStarC_Compiler_Util.smap +type files_for_module_name = intf_and_impl FStarC_Util.smap let (intf_and_impl_to_string : (Prims.string FStar_Pervasives_Native.option * Prims.string FStar_Pervasives_Native.option) -> Prims.string) @@ -60,17 +59,15 @@ let (intf_and_impl_to_string : -> Prims.strcat intf (Prims.strcat ", " impl) let (files_for_module_name_to_string : files_for_module_name -> unit) = fun m -> - FStarC_Compiler_Util.print_string "Printing the file system map {\n"; + FStarC_Util.print_string "Printing the file system map {\n"; (let str_opt_to_string sopt = match sopt with | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some s -> s in - FStarC_Compiler_Util.smap_iter m + FStarC_Util.smap_iter m (fun k -> - fun v -> - FStarC_Compiler_Util.print2 "%s:%s\n" k - (intf_and_impl_to_string v)); - FStarC_Compiler_Util.print_string "}\n") + fun v -> FStarC_Util.print2 "%s:%s\n" k (intf_and_impl_to_string v)); + FStarC_Util.print_string "}\n") type color = | White | Gray @@ -86,23 +83,20 @@ let (check_and_strip_suffix : fun f -> let suffixes = [".fsti"; ".fst"; ".fsi"; ".fs"] in let matches = - FStarC_Compiler_List.map + FStarC_List.map (fun ext -> - let lext = FStarC_Compiler_String.length ext in - let l = FStarC_Compiler_String.length f in + let lext = FStarC_String.length ext in + let l = FStarC_String.length f in let uu___ = (l > lext) && - (let uu___1 = - FStarC_Compiler_String.substring f (l - lext) lext in + (let uu___1 = FStarC_String.substring f (l - lext) lext in uu___1 = ext) in if uu___ then - let uu___1 = - FStarC_Compiler_String.substring f Prims.int_zero (l - lext) in + let uu___1 = FStarC_String.substring f Prims.int_zero (l - lext) in FStar_Pervasives_Native.Some uu___1 else FStar_Pervasives_Native.None) suffixes in - let uu___ = - FStarC_Compiler_List.filter FStarC_Compiler_Util.is_some matches in + let uu___ = FStarC_List.filter FStarC_Util.is_some matches in match uu___ with | (FStar_Pervasives_Native.Some m)::uu___1 -> FStar_Pervasives_Native.Some m @@ -110,8 +104,7 @@ let (check_and_strip_suffix : let (is_interface : Prims.string -> Prims.bool) = fun f -> let uu___ = - FStarC_Compiler_String.get f - ((FStarC_Compiler_String.length f) - Prims.int_one) in + FStarC_String.get f ((FStarC_String.length f) - Prims.int_one) in uu___ = 105 let (is_implementation : Prims.string -> Prims.bool) = fun f -> let uu___ = is_interface f in Prims.op_Negation uu___ @@ -129,13 +122,10 @@ let list_of_pair : fun uu___ -> match uu___ with | (intf, impl) -> - FStarC_Compiler_List.op_At (list_of_option intf) - (list_of_option impl) + FStarC_List.op_At (list_of_option intf) (list_of_option impl) let (maybe_module_name_of_file : Prims.string -> Prims.string FStar_Pervasives_Native.option) = - fun f -> - let uu___ = FStarC_Compiler_Util.basename f in - check_and_strip_suffix uu___ + fun f -> let uu___ = FStarC_Util.basename f in check_and_strip_suffix uu___ let (module_name_of_file : Prims.string -> Prims.string) = fun f -> let uu___ = maybe_module_name_of_file f in @@ -146,13 +136,11 @@ let (module_name_of_file : Prims.string -> Prims.string) = let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_Util.format1 "Not a valid FStar file: '%s'" f in + FStarC_Util.format1 "Not a valid FStar file: '%s'" f in FStarC_Errors_Msg.text uu___4 in [uu___3] in let uu___3 = - if - (FStarC_Platform.system = FStarC_Platform.Windows) && - (f = "..") + if FStarC_Platform.windows && (f = "..") then let uu___4 = FStarC_Errors_Msg.text @@ -164,21 +152,19 @@ let (module_name_of_file : Prims.string -> Prims.string) = [uu___6] in uu___4 :: uu___5 else [] in - FStarC_Compiler_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___2 uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_NotValidFStarFile () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___1) let (lowercase_module_name : Prims.string -> Prims.string) = - fun f -> - let uu___ = module_name_of_file f in - FStarC_Compiler_String.lowercase uu___ + fun f -> let uu___ = module_name_of_file f in FStarC_String.lowercase uu___ let (namespace_of_module : Prims.string -> FStarC_Ident.lident FStar_Pervasives_Native.option) = fun f -> let lid = let uu___ = FStarC_Ident.path_of_text f in - FStarC_Ident.lid_of_path uu___ FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path uu___ FStarC_Range_Type.dummyRange in let uu___ = FStarC_Ident.ns_of_lid lid in match uu___ with | [] -> FStar_Pervasives_Native.None @@ -231,11 +217,10 @@ let (__proj__Mkdep_node__item__color : dep_node -> color) = fun projectee -> match projectee with | { edges; color = color1;_} -> color1 type dependence_graph = - | Deps of dep_node FStarC_Compiler_Util.smap + | Deps of dep_node FStarC_Util.smap let (uu___is_Deps : dependence_graph -> Prims.bool) = fun projectee -> true -let (__proj__Deps__item___0 : - dependence_graph -> dep_node FStarC_Compiler_Util.smap) = - fun projectee -> match projectee with | Deps _0 -> _0 +let (__proj__Deps__item___0 : dependence_graph -> dep_node FStarC_Util.smap) + = fun projectee -> match projectee with | Deps _0 -> _0 type parsing_data_elt = | P_begin_module of FStarC_Ident.lident | P_open of (Prims.bool * FStarC_Ident.lident) @@ -301,7 +286,7 @@ let (str_of_parsing_data_elt : parsing_data_elt -> Prims.string) = Prims.strcat "P_begin_module (" uu___ | P_open (b, lid) -> let uu___ = - let uu___1 = FStarC_Compiler_Util.string_of_bool b in + let uu___1 = FStarC_Util.string_of_bool b in let uu___2 = let uu___3 = let uu___4 = FStarC_Ident.string_of_lid lid in @@ -323,7 +308,7 @@ let (str_of_parsing_data_elt : parsing_data_elt -> Prims.string) = let uu___1 = FStarC_Ident.string_of_lid lid in let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_bool b in + let uu___4 = FStarC_Util.string_of_bool b in Prims.strcat uu___4 ")" in Prims.strcat ", " uu___3 in Prims.strcat uu___1 uu___2 in @@ -348,7 +333,7 @@ let (str_of_parsing_data : parsing_data -> Prims.string) = fun uu___ -> match uu___ with | Mk_pd l -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun s -> fun elt -> let uu___1 = @@ -360,7 +345,7 @@ let (friends : parsing_data -> FStarC_Ident.lident Prims.list) = let uu___ = p in match uu___ with | Mk_pd p1 -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___1 -> match uu___1 with | P_dep (true, l) -> [l] | uu___2 -> []) p1 let (parsing_data_elt_eq : @@ -392,7 +377,7 @@ type deps = cmd_line_files: file_name Prims.list ; all_files: file_name Prims.list ; interfaces_with_inlining: module_name Prims.list ; - parse_results: parsing_data FStarC_Compiler_Util.smap } + parse_results: parsing_data FStarC_Util.smap } let (__proj__Mkdeps__item__dep_graph : deps -> dependence_graph) = fun projectee -> match projectee with @@ -421,7 +406,7 @@ let (__proj__Mkdeps__item__interfaces_with_inlining : interfaces_with_inlining; parse_results;_} -> interfaces_with_inlining let (__proj__Mkdeps__item__parse_results : - deps -> parsing_data FStarC_Compiler_Util.smap) = + deps -> parsing_data FStarC_Util.smap) = fun projectee -> match projectee with | { dep_graph; file_system_map; cmd_line_files; all_files; @@ -430,26 +415,21 @@ let (deps_try_find : dependence_graph -> Prims.string -> dep_node FStar_Pervasives_Native.option) = fun uu___ -> - fun k -> - match uu___ with | Deps m -> FStarC_Compiler_Util.smap_try_find m k + fun k -> match uu___ with | Deps m -> FStarC_Util.smap_try_find m k let (deps_add_dep : dependence_graph -> Prims.string -> dep_node -> unit) = fun uu___ -> - fun k -> - fun v -> - match uu___ with | Deps m -> FStarC_Compiler_Util.smap_add m k v + fun k -> fun v -> match uu___ with | Deps m -> FStarC_Util.smap_add m k v let (deps_keys : dependence_graph -> Prims.string Prims.list) = - fun uu___ -> match uu___ with | Deps m -> FStarC_Compiler_Util.smap_keys m + fun uu___ -> match uu___ with | Deps m -> FStarC_Util.smap_keys m let (deps_empty : unit -> dependence_graph) = fun uu___ -> - let uu___1 = FStarC_Compiler_Util.smap_create (Prims.of_int (41)) in - Deps uu___1 + let uu___1 = FStarC_Util.smap_create (Prims.of_int (41)) in Deps uu___1 let (mk_deps : dependence_graph -> files_for_module_name -> file_name Prims.list -> file_name Prims.list -> - module_name Prims.list -> - parsing_data FStarC_Compiler_Util.smap -> deps) + module_name Prims.list -> parsing_data FStarC_Util.smap -> deps) = fun dg -> fun fs -> @@ -467,8 +447,8 @@ let (mk_deps : } let (empty_deps : deps) = let uu___ = deps_empty () in - let uu___1 = FStarC_Compiler_Util.smap_create Prims.int_zero in - let uu___2 = FStarC_Compiler_Util.smap_create Prims.int_zero in + let uu___1 = FStarC_Util.smap_create Prims.int_zero in + let uu___2 = FStarC_Util.smap_create Prims.int_zero in mk_deps uu___ uu___1 [] [] [] uu___2 let (module_name_of_dep : dependence -> module_name) = fun uu___ -> @@ -483,7 +463,7 @@ let (resolve_module_name : = fun file_system_map -> fun key -> - let uu___ = FStarC_Compiler_Util.smap_try_find file_system_map key in + let uu___ = FStarC_Util.smap_try_find file_system_map key in match uu___ with | FStar_Pervasives_Native.Some (FStar_Pervasives_Native.Some fn, uu___1) -> @@ -500,7 +480,7 @@ let (interface_of_internal : = fun file_system_map -> fun key -> - let uu___ = FStarC_Compiler_Util.smap_try_find file_system_map key in + let uu___ = FStarC_Util.smap_try_find file_system_map key in match uu___ with | FStar_Pervasives_Native.Some (FStar_Pervasives_Native.Some iface, uu___1) -> @@ -512,7 +492,7 @@ let (implementation_of_internal : = fun file_system_map -> fun key -> - let uu___ = FStarC_Compiler_Util.smap_try_find file_system_map key in + let uu___ = FStarC_Util.smap_try_find file_system_map key in match uu___ with | FStar_Pervasives_Native.Some (uu___1, FStar_Pervasives_Native.Some impl) -> @@ -529,13 +509,13 @@ let (has_interface : files_for_module_name -> module_name -> Prims.bool) = fun file_system_map -> fun key -> let uu___ = interface_of_internal file_system_map key in - FStarC_Compiler_Option.isSome uu___ + FStarC_Option.isSome uu___ let (has_implementation : files_for_module_name -> module_name -> Prims.bool) = fun file_system_map -> fun key -> let uu___ = implementation_of_internal file_system_map key in - FStarC_Compiler_Option.isSome uu___ + FStarC_Option.isSome uu___ let (cache_file_name : Prims.string -> Prims.string) = let checked_file_and_exists_flag fn = let cache_fn = @@ -545,23 +525,22 @@ let (cache_file_name : Prims.string -> Prims.string) = else Prims.strcat fn ".checked" in let mname = module_name_of_file fn in let uu___ = - let uu___1 = FStarC_Compiler_Util.basename cache_fn in + let uu___1 = FStarC_Util.basename cache_fn in FStarC_Find.find_file uu___1 in match uu___ with | FStar_Pervasives_Native.Some path -> let expected_cache_file = FStarC_Find.prepend_cache_dir cache_fn in ((let uu___2 = ((let uu___3 = FStarC_Options.dep () in - FStarC_Compiler_Option.isSome uu___3) && + FStarC_Option.isSome uu___3) && (let uu___3 = FStarC_Options.should_be_already_cached mname in Prims.op_Negation uu___3)) && ((Prims.op_Negation - (FStarC_Compiler_Util.file_exists expected_cache_file)) + (FStarC_Util.file_exists expected_cache_file)) || (let uu___3 = - FStarC_Compiler_Util.paths_to_same_file path - expected_cache_file in + FStarC_Util.paths_to_same_file path expected_cache_file in Prims.op_Negation uu___3)) in if uu___2 then @@ -598,17 +577,15 @@ let (cache_file_name : Prims.string -> Prims.string) = (Obj.magic uu___3) else ()); (let uu___2 = - (FStarC_Compiler_Util.file_exists expected_cache_file) && - (FStarC_Compiler_Util.paths_to_same_file path - expected_cache_file) in + (FStarC_Util.file_exists expected_cache_file) && + (FStarC_Util.paths_to_same_file path expected_cache_file) in if uu___2 then expected_cache_file else path)) | FStar_Pervasives_Native.None -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_CheckedFiles in + ((let uu___2 = FStarC_Effect.op_Bang dbg_CheckedFiles in if uu___2 then - let uu___3 = FStarC_Compiler_Util.basename cache_fn in - FStarC_Compiler_Util.print1 "find_file(%s) returned None\n" - uu___3 + let uu___3 = FStarC_Util.basename cache_fn in + FStarC_Util.print1 "find_file(%s) returned None\n" uu___3 else ()); (let uu___3 = FStarC_Options.should_be_already_cached mname in if uu___3 @@ -616,7 +593,7 @@ let (cache_file_name : Prims.string -> Prims.string) = let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Expected %s to be already checked but could not find it." mname in FStarC_Errors_Msg.text uu___6 in @@ -627,19 +604,19 @@ let (cache_file_name : Prims.string -> Prims.string) = (Obj.magic uu___4) else ()); FStarC_Find.prepend_cache_dir cache_fn) in - let memo = FStarC_Compiler_Util.smap_create (Prims.of_int (100)) in + let memo = FStarC_Util.smap_create (Prims.of_int (100)) in let memo1 f x = - let uu___ = FStarC_Compiler_Util.smap_try_find memo x in + let uu___ = FStarC_Util.smap_try_find memo x in match uu___ with | FStar_Pervasives_Native.Some res -> res | FStar_Pervasives_Native.None -> - let res = f x in (FStarC_Compiler_Util.smap_add memo x res; res) in + let res = f x in (FStarC_Util.smap_add memo x res; res) in memo1 checked_file_and_exists_flag let (parsing_data_of : deps -> Prims.string -> parsing_data) = fun deps1 -> fun fn -> - let uu___ = FStarC_Compiler_Util.smap_try_find deps1.parse_results fn in - FStarC_Compiler_Util.must uu___ + let uu___ = FStarC_Util.smap_try_find deps1.parse_results fn in + FStarC_Util.must uu___ let (file_of_dep_aux : Prims.bool -> files_for_module_name -> file_name Prims.list -> dependence -> file_name) @@ -649,7 +626,7 @@ let (file_of_dep_aux : fun all_cmd_line_files -> fun d -> let cmd_line_has_impl key = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun fn -> (is_implementation fn) && (let uu___ = lowercase_module_name fn in key = uu___)) @@ -662,7 +639,7 @@ let (file_of_dep_aux : (match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Expected an interface for module %s, but couldn't find one" key in FStarC_Errors.raise_error0 @@ -674,7 +651,7 @@ let (file_of_dep_aux : let uu___ = (cmd_line_has_impl key) && (let uu___1 = FStarC_Options.dep () in - FStarC_Compiler_Option.isNone uu___1) in + FStarC_Option.isNone uu___1) in if uu___ then let uu___1 = FStarC_Options.expose_interfaces () in @@ -683,7 +660,7 @@ let (file_of_dep_aux : let uu___2 = let uu___3 = implementation_of_internal file_system_map key in - FStarC_Compiler_Option.get uu___3 in + FStarC_Option.get uu___3 in maybe_use_cache_of uu___2 else (let uu___3 = @@ -692,12 +669,12 @@ let (file_of_dep_aux : let uu___6 = let uu___7 = implementation_of_internal file_system_map key in - FStarC_Compiler_Option.get uu___7 in + FStarC_Option.get uu___7 in let uu___7 = let uu___8 = interface_of_internal file_system_map key in - FStarC_Compiler_Option.get uu___8 in - FStarC_Compiler_Util.format3 + FStarC_Option.get uu___8 in + FStarC_Util.format3 "You may have a cyclic dependence on module %s: use --dep full to confirm. Alternatively, invoking fstar with %s on the command line breaks the abstraction imposed by its interface %s." key uu___6 uu___7 in FStarC_Errors_Msg.text uu___5 in @@ -715,14 +692,14 @@ let (file_of_dep_aux : else (let uu___2 = let uu___3 = interface_of_internal file_system_map key in - FStarC_Compiler_Option.get uu___3 in + FStarC_Option.get uu___3 in maybe_use_cache_of uu___2) | PreferInterface key -> let uu___ = implementation_of_internal file_system_map key in (match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Expected an implementation of module %s, but couldn't find one" key in FStarC_Errors.raise_error0 @@ -735,7 +712,7 @@ let (file_of_dep_aux : (match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Expected an implementation of module %s, but couldn't find one" key in FStarC_Errors.raise_error0 @@ -748,7 +725,7 @@ let (file_of_dep_aux : (match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Expected an implementation of module %s, but couldn't find one" key in FStarC_Errors.raise_error0 @@ -774,118 +751,126 @@ let (dependences_of : | FStar_Pervasives_Native.Some { edges = deps2; color = uu___1;_} -> let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (file_of_dep file_system_map all_cmd_line_files) deps2 in - FStarC_Compiler_List.filter (fun k -> k <> fn) uu___2 + FStarC_List.filter (fun k -> k <> fn) uu___2 let (print_graph : - FStarC_Compiler_Util.out_channel -> - Prims.string -> dependence_graph -> unit) + FStarC_Util.out_channel -> + Prims.string -> + dependence_graph -> + files_for_module_name -> file_name Prims.list -> unit) = fun outc -> fun fn -> fun graph -> - (let uu___1 = - let uu___2 = FStarC_Options.silent () in Prims.op_Negation uu___2 in - if uu___1 - then - (FStarC_Compiler_Util.print1 - "A DOT-format graph has been dumped in the current directory as `%s`\n" - fn; - FStarC_Compiler_Util.print1 - "With GraphViz installed, try: fdp -Tpng -odep.png %s\n" fn; - FStarC_Compiler_Util.print1 - "Hint: cat %s | grep -v _ | grep -v prims\n" fn) - else ()); - (let s = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = deps_keys graph in - FStarC_Compiler_List.unique uu___5 in - FStarC_Compiler_List.collect - (fun k -> - let deps1 = - let uu___5 = - let uu___6 = deps_try_find graph k in - FStarC_Compiler_Util.must uu___6 in - uu___5.edges in - let r s1 = FStarC_Compiler_Util.replace_char s1 46 95 in - let print dep = - let uu___5 = - let uu___6 = lowercase_module_name k in r uu___6 in - FStarC_Compiler_Util.format2 " \"%s\" -> \"%s\"" - uu___5 (r (module_name_of_dep dep)) in - FStarC_Compiler_List.map print deps1) uu___4 in - FStarC_Compiler_String.concat "\n" uu___3 in - Prims.strcat uu___2 "\n}\n" in - Prims.strcat "digraph {\n" uu___1 in - FStarC_Compiler_Util.fprint outc "%s" [s]) + fun file_system_map -> + fun cmd_lined_files -> + (let uu___1 = + let uu___2 = FStarC_Options.silent () in + Prims.op_Negation uu___2 in + if uu___1 + then + (FStarC_Util.print1 + "A DOT-format graph has been dumped in the current directory as `%s`\n" + fn; + FStarC_Util.print1 + "With GraphViz installed, try: fdp -Tpng -odep.png %s\n" fn; + FStarC_Util.print1 + "Hint: cat %s | grep -v _ | grep -v prims\n" fn) + else ()); + (let sb = FStarC_StringBuffer.create (Prims.of_int (10000)) in + let pr str = let uu___1 = FStarC_StringBuffer.add str sb in () in + pr "digraph {\n"; + (let uu___3 = + let uu___4 = deps_keys graph in FStarC_List.unique uu___4 in + FStarC_List.iter + (fun k -> + let deps1 = + let uu___4 = + let uu___5 = deps_try_find graph k in + FStarC_Util.must uu___5 in + uu___4.edges in + FStarC_List.iter + (fun dep -> + let l = FStarC_Util.basename k in + let r = + let uu___4 = + file_of_dep file_system_map cmd_lined_files dep in + FStarC_Util.basename uu___4 in + let uu___4 = + let uu___5 = + FStarC_Options.should_be_already_cached + (module_name_of_dep dep) in + Prims.op_Negation uu___5 in + if uu___4 + then + let uu___5 = + FStarC_Util.format2 " \"%s\" -> \"%s\"\n" l r in + pr uu___5 + else ()) deps1) uu___3); + pr "}\n"; + (let uu___4 = + let uu___5 = FStarC_StringBuffer.contents sb in [uu___5] in + FStarC_Util.fprint outc "%s" uu___4)) let (safe_readdir_for_include : Prims.string -> Prims.string Prims.list) = fun d -> - try - (fun uu___ -> match () with | () -> FStarC_Compiler_Util.readdir d) () + try (fun uu___ -> match () with | () -> FStarC_Util.readdir d) () with | uu___ -> [] let (build_inclusion_candidates_list : unit -> (Prims.string * Prims.string) Prims.list) = fun uu___ -> let include_directories = FStarC_Find.include_path () in let include_directories1 = - FStarC_Compiler_List.map FStarC_Compiler_Util.normalize_file_path - include_directories in - let include_directories2 = - FStarC_Compiler_List.unique include_directories1 in + FStarC_List.map FStarC_Util.normalize_file_path include_directories in + let include_directories2 = FStarC_List.unique include_directories1 in let cwd = - let uu___1 = FStarC_Compiler_Util.getcwd () in - FStarC_Compiler_Util.normalize_file_path uu___1 in - FStarC_Compiler_List.concatMap + let uu___1 = FStarC_Util.getcwd () in + FStarC_Util.normalize_file_path uu___1 in + FStarC_List.concatMap (fun d -> let files = safe_readdir_for_include d in - FStarC_Compiler_List.filter_map + FStarC_List.filter_map (fun f -> - let f1 = FStarC_Compiler_Util.basename f in + let f1 = FStarC_Util.basename f in let uu___1 = check_and_strip_suffix f1 in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun longname -> let full_path = - if d = cwd - then f1 - else FStarC_Compiler_Util.join_paths d f1 in + if d = cwd then f1 else FStarC_Util.join_paths d f1 in (longname, full_path)) uu___1) files) include_directories2 let (build_map : Prims.string Prims.list -> files_for_module_name) = fun filenames -> - let map = FStarC_Compiler_Util.smap_create (Prims.of_int (41)) in + let map = FStarC_Util.smap_create (Prims.of_int (41)) in let add_entry key full_path = - let uu___ = FStarC_Compiler_Util.smap_try_find map key in + let uu___ = FStarC_Util.smap_try_find map key in match uu___ with | FStar_Pervasives_Native.Some (intf, impl) -> let uu___1 = is_interface full_path in if uu___1 then - FStarC_Compiler_Util.smap_add map key + FStarC_Util.smap_add map key ((FStar_Pervasives_Native.Some full_path), impl) else - FStarC_Compiler_Util.smap_add map key + FStarC_Util.smap_add map key (intf, (FStar_Pervasives_Native.Some full_path)) | FStar_Pervasives_Native.None -> let uu___1 = is_interface full_path in if uu___1 then - FStarC_Compiler_Util.smap_add map key + FStarC_Util.smap_add map key ((FStar_Pervasives_Native.Some full_path), FStar_Pervasives_Native.None) else - FStarC_Compiler_Util.smap_add map key + FStarC_Util.smap_add map key (FStar_Pervasives_Native.None, (FStar_Pervasives_Native.Some full_path)) in (let uu___1 = build_inclusion_candidates_list () in - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___2 -> match uu___2 with | (longname, full_path) -> - add_entry (FStarC_Compiler_String.lowercase longname) full_path) - uu___1); - FStarC_Compiler_List.iter + add_entry (FStarC_String.lowercase longname) full_path) uu___1); + FStarC_List.iter (fun f -> let uu___2 = lowercase_module_name f in add_entry uu___2 f) filenames; map @@ -903,22 +888,20 @@ let (string_of_lid : FStarC_Ident.lident -> Prims.bool -> Prims.string) = let names = let uu___ = let uu___1 = FStarC_Ident.ns_of_lid l in - FStarC_Compiler_List.map (fun x -> FStarC_Ident.string_of_id x) - uu___1 in - FStarC_Compiler_List.op_At uu___ suffix in - FStarC_Compiler_String.concat "." names + FStarC_List.map (fun x -> FStarC_Ident.string_of_id x) uu___1 in + FStarC_List.op_At uu___ suffix in + FStarC_String.concat "." names let (lowercase_join_longident : FStarC_Ident.lident -> Prims.bool -> Prims.string) = fun l -> fun last -> - let uu___ = string_of_lid l last in - FStarC_Compiler_String.lowercase uu___ + let uu___ = string_of_lid l last in FStarC_String.lowercase uu___ let (namespace_of_lid : FStarC_Ident.lident -> Prims.string) = fun l -> let uu___ = let uu___1 = FStarC_Ident.ns_of_lid l in - FStarC_Compiler_List.map FStarC_Ident.string_of_id uu___1 in - FStarC_Compiler_String.concat "_" uu___ + FStarC_List.map FStarC_Ident.string_of_id uu___1 in + FStarC_String.concat "_" uu___ let (check_module_declaration_against_filename : FStarC_Ident.lident -> Prims.string -> unit) = fun lid -> @@ -927,9 +910,9 @@ let (check_module_declaration_against_filename : let uu___ = let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Util.basename filename in + let uu___3 = FStarC_Util.basename filename in check_and_strip_suffix uu___3 in - FStarC_Compiler_Util.must uu___2 in + FStarC_Util.must uu___2 in uu___1 <> k' in if uu___ then @@ -937,7 +920,7 @@ let (check_module_declaration_against_filename : let uu___2 = let uu___3 = let uu___4 = string_of_lid lid true in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "The module declaration \"module %s\" found in file %s does not match its filename." uu___4 filename in FStarC_Errors_Msg.text uu___3 in @@ -956,17 +939,7 @@ exception Exit let (uu___is_Exit : Prims.exn -> Prims.bool) = fun projectee -> match projectee with | Exit -> true | uu___ -> false let (core_modules : unit -> Prims.string Prims.list) = - fun uu___ -> - let uu___1 = - let uu___2 = FStarC_Basefiles.prims_basename () in - let uu___3 = - let uu___4 = FStarC_Basefiles.pervasives_basename () in - let uu___5 = - let uu___6 = FStarC_Basefiles.pervasives_native_basename () in - [uu___6] in - uu___4 :: uu___5 in - uu___2 :: uu___3 in - FStarC_Compiler_List.map module_name_of_file uu___1 + fun uu___ -> ["Prims"; "FStar.Pervasives"; "FStar.Pervasives.Native"] let (implicit_ns_deps : FStarC_Ident.lident Prims.list) = [FStarC_Parser_Const.fstar_ns_lid] let (implicit_module_deps : FStarC_Ident.lident Prims.list) = @@ -974,16 +947,14 @@ let (implicit_module_deps : FStarC_Ident.lident Prims.list) = let (hard_coded_dependencies : Prims.string -> (FStarC_Ident.lident * open_kind) Prims.list) = fun full_filename -> - let filename = FStarC_Compiler_Util.basename full_filename in + let filename = FStarC_Util.basename full_filename in let implicit_module_deps1 = - FStarC_Compiler_List.map (fun l -> (l, Open_module)) - implicit_module_deps in + FStarC_List.map (fun l -> (l, Open_module)) implicit_module_deps in let implicit_ns_deps1 = - FStarC_Compiler_List.map (fun l -> (l, Open_namespace)) - implicit_ns_deps in + FStarC_List.map (fun l -> (l, Open_namespace)) implicit_ns_deps in let uu___ = let uu___1 = module_name_of_file filename in - let uu___2 = core_modules () in FStarC_Compiler_List.mem uu___1 uu___2 in + let uu___2 = core_modules () in FStarC_List.mem uu___1 uu___2 in if uu___ then [] else @@ -992,11 +963,10 @@ let (hard_coded_dependencies : namespace_of_module uu___3 in match uu___2 with | FStar_Pervasives_Native.None -> - FStarC_Compiler_List.op_At implicit_ns_deps1 implicit_module_deps1 + FStarC_List.op_At implicit_ns_deps1 implicit_module_deps1 | FStar_Pervasives_Native.Some ns -> - FStarC_Compiler_List.op_At implicit_ns_deps1 - (FStarC_Compiler_List.op_At implicit_module_deps1 - [(ns, Open_namespace)])) + FStarC_List.op_At implicit_ns_deps1 + (FStarC_List.op_At implicit_module_deps1 [(ns, Open_namespace)])) let (dep_subsumed_by : dependence -> dependence -> Prims.bool) = fun d -> fun d' -> @@ -1011,31 +981,29 @@ let (enter_namespace : fun working_map -> fun sprefix -> fun implicit_open -> - let found = FStarC_Compiler_Util.mk_ref false in + let found = FStarC_Util.mk_ref false in let sprefix1 = Prims.strcat sprefix "." in let suffix_exists mopt = match mopt with | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some (intf, impl) -> - (FStarC_Compiler_Util.is_some intf) || - (FStarC_Compiler_Util.is_some impl) in - FStarC_Compiler_Util.smap_iter original_map + (FStarC_Util.is_some intf) || (FStarC_Util.is_some impl) in + FStarC_Util.smap_iter original_map (fun k -> fun uu___1 -> - if FStarC_Compiler_Util.starts_with k sprefix1 + if FStarC_Util.starts_with k sprefix1 then let suffix = - FStarC_Compiler_String.substring k - (FStarC_Compiler_String.length sprefix1) - ((FStarC_Compiler_String.length k) - - (FStarC_Compiler_String.length sprefix1)) in + FStarC_String.substring k + (FStarC_String.length sprefix1) + ((FStarC_String.length k) - + (FStarC_String.length sprefix1)) in ((let suffix_filename = - FStarC_Compiler_Util.smap_try_find original_map suffix in + FStarC_Util.smap_try_find original_map suffix in if implicit_open && (suffix_exists suffix_filename) then let str = - let uu___3 = - FStarC_Compiler_Util.must suffix_filename in + let uu___3 = FStarC_Util.must suffix_filename in intf_and_impl_to_string uu___3 in let uu___3 = let uu___4 = @@ -1096,14 +1064,12 @@ let (enter_namespace : (Obj.magic uu___3) else ()); (let filename = - let uu___3 = - FStarC_Compiler_Util.smap_try_find original_map k in - FStarC_Compiler_Util.must uu___3 in - FStarC_Compiler_Util.smap_add working_map suffix - filename; - FStarC_Compiler_Effect.op_Colon_Equals found true)) + let uu___3 = FStarC_Util.smap_try_find original_map k in + FStarC_Util.must uu___3 in + FStarC_Util.smap_add working_map suffix filename; + FStarC_Effect.op_Colon_Equals found true)) else ()); - FStarC_Compiler_Effect.op_Bang found + FStarC_Effect.op_Bang found let (collect_one : files_for_module_name -> Prims.string -> @@ -1115,8 +1081,8 @@ let (collect_one : fun filename -> fun get_parsing_data_from_cache -> let from_parsing_data pd original_map1 filename1 = - let deps1 = FStarC_Compiler_Util.mk_ref [] in - let has_inline_for_extraction = FStarC_Compiler_Util.mk_ref false in + let deps1 = FStarC_Util.mk_ref [] in + let has_inline_for_extraction = FStarC_Util.mk_ref false in let mo_roots = let mname = lowercase_module_name filename1 in let uu___ = @@ -1125,31 +1091,28 @@ let (collect_one : if uu___ then [UseImplementation mname] else [] in let auto_open = let uu___ = hard_coded_dependencies filename1 in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (lid, k) -> P_implicit_open_module_or_namespace (k, lid)) uu___ in - let working_map = FStarC_Compiler_Util.smap_copy original_map1 in + let working_map = FStarC_Util.smap_copy original_map1 in let set_interface_inlining uu___ = let uu___1 = is_interface filename1 in if uu___1 - then - FStarC_Compiler_Effect.op_Colon_Equals - has_inline_for_extraction true + then FStarC_Effect.op_Colon_Equals has_inline_for_extraction true else () in let add_dep deps2 d = let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang deps2 in - FStarC_Compiler_List.existsML (dep_subsumed_by d) uu___2 in + let uu___2 = FStarC_Effect.op_Bang deps2 in + FStarC_List.existsML (dep_subsumed_by d) uu___2 in Prims.op_Negation uu___1 in if uu___ then let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang deps2 in d :: - uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals deps2 uu___1 + let uu___2 = FStarC_Effect.op_Bang deps2 in d :: uu___2 in + FStarC_Effect.op_Colon_Equals deps2 uu___1 else () in let dep_edge module_name1 is_friend = if is_friend @@ -1174,8 +1137,7 @@ let (collect_one : then (let uu___3 = let uu___4 = string_of_lid lid true in - FStarC_Compiler_Util.format1 "Module not found: %s" - uu___4 in + FStarC_Util.format1 "Module not found: %s" uu___4 in FStarC_Errors.log_issue FStarC_Ident.hasrange_lident lid FStarC_Errors_Codes.Warning_ModuleOrFileNotFoundWarning () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -1190,7 +1152,7 @@ let (collect_one : then let uu___ = let uu___1 = string_of_lid lid true in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "No modules in namespace %s and no file with that name either" uu___1 in FStarC_Errors.log_issue FStarC_Ident.hasrange_lident lid @@ -1216,14 +1178,12 @@ let (collect_one : let record_module_alias ident lid = let key = let uu___ = FStarC_Ident.string_of_id ident in - FStarC_Compiler_String.lowercase uu___ in + FStarC_String.lowercase uu___ in let alias = lowercase_join_longident lid true in - let uu___ = - FStarC_Compiler_Util.smap_try_find original_map1 alias in + let uu___ = FStarC_Util.smap_try_find original_map1 alias in match uu___ with | FStar_Pervasives_Native.Some deps_of_aliased_module -> - (FStarC_Compiler_Util.smap_add working_map key - deps_of_aliased_module; + (FStarC_Util.smap_add working_map key deps_of_aliased_module; (let uu___3 = let uu___4 = lowercase_join_longident lid true in dep_edge uu___4 false in @@ -1231,8 +1191,8 @@ let (collect_one : true) | FStar_Pervasives_Native.None -> ((let uu___2 = - FStarC_Compiler_Util.format1 - "module not found in search path: %s" alias in + FStarC_Util.format1 "module not found in search path: %s" + alias in FStarC_Errors.log_issue FStarC_Ident.hasrange_lident lid FStarC_Errors_Codes.Warning_ModuleOrFileNotFoundWarning () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -1244,15 +1204,14 @@ let (collect_one : if uu___ then () else - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___2 = FStarC_Effect.op_Bang dbg in if uu___2 then let uu___3 = let uu___4 = FStarC_Class_Show.show FStarC_Ident.showable_lident module_name1 in - FStarC_Compiler_Util.format1 "Unbound module reference %s" - uu___4 in + FStarC_Util.format1 "Unbound module reference %s" uu___4 in FStarC_Errors.log_issue FStarC_Ident.hasrange_lident module_name1 FStarC_Errors_Codes.Warning_UnboundModuleReference () @@ -1270,7 +1229,7 @@ let (collect_one : let uu___ = let uu___1 = let uu___2 = FStarC_Ident.ns_of_lid lid in - FStarC_Compiler_List.length uu___2 in + FStarC_List.length uu___2 in uu___1 > Prims.int_zero in if uu___ then @@ -1281,7 +1240,7 @@ let (collect_one : else () in (match pd with | Mk_pd l -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun elt -> match elt with | P_begin_module lid -> begin_module lid @@ -1293,48 +1252,45 @@ let (collect_one : let uu___1 = record_module_alias id lid in () | P_lid lid -> record_lid lid | P_inline_for_extraction -> set_interface_inlining ()) - (FStarC_Compiler_List.op_At auto_open l)); - (let uu___1 = FStarC_Compiler_Effect.op_Bang deps1 in - let uu___2 = - FStarC_Compiler_Effect.op_Bang has_inline_for_extraction in + (FStarC_List.op_At auto_open l)); + (let uu___1 = FStarC_Effect.op_Bang deps1 in + let uu___2 = FStarC_Effect.op_Bang has_inline_for_extraction in (uu___1, uu___2, mo_roots)) in let data_from_cache = get_parsing_data_from_cache filename in - if FStarC_Compiler_Util.is_some data_from_cache + if FStarC_Util.is_some data_from_cache then let uu___ = - let uu___1 = FStarC_Compiler_Util.must data_from_cache in + let uu___1 = FStarC_Util.must data_from_cache in from_parsing_data uu___1 original_map filename in match uu___ with | (deps1, has_inline_for_extraction, mo_roots) -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___2 = FStarC_Effect.op_Bang dbg in if uu___2 then let uu___3 = FStarC_Class_Show.show (FStarC_Class_Show.show_list showable_dependence) deps1 in - FStarC_Compiler_Util.print2 - "Reading the parsing data for %s from its checked file .. found [%s]\n" + FStarC_Util.print2 + "Reading the parsing data for %s from its checked file .. found %s\n" filename uu___3 else ()); - (let uu___2 = FStarC_Compiler_Util.must data_from_cache in + (let uu___2 = FStarC_Util.must data_from_cache in (uu___2, deps1, has_inline_for_extraction, mo_roots))) else - (let num_of_toplevelmods = - FStarC_Compiler_Util.mk_ref Prims.int_zero in - let pd = FStarC_Compiler_Util.mk_ref [] in + (let num_of_toplevelmods = FStarC_Util.mk_ref Prims.int_zero in + let pd = FStarC_Util.mk_ref [] in let add_to_parsing_data elt = let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang pd in - FStarC_Compiler_List.existsML - (fun e -> parsing_data_elt_eq e elt) uu___3 in + let uu___3 = FStarC_Effect.op_Bang pd in + FStarC_List.existsML (fun e -> parsing_data_elt_eq e elt) + uu___3 in Prims.op_Negation uu___2 in if uu___1 then let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang pd in elt :: - uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals pd uu___2 + let uu___3 = FStarC_Effect.op_Bang pd in elt :: uu___3 in + FStarC_Effect.op_Colon_Equals pd uu___2 else () in let rec collect_module uu___1 = match uu___1 with @@ -1347,13 +1303,12 @@ let (collect_one : add_to_parsing_data (P_begin_module lid); collect_decls decls) and collect_decls decls = - FStarC_Compiler_List.iter + FStarC_List.iter (fun x -> collect_decl x.FStarC_Parser_AST.d; - FStarC_Compiler_List.iter collect_term - x.FStarC_Parser_AST.attrs; + FStarC_List.iter collect_term x.FStarC_Parser_AST.attrs; if - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Parser_AST.Inline_for_extraction x.FStarC_Parser_AST.quals then add_to_parsing_data P_inline_for_extraction @@ -1376,7 +1331,7 @@ let (collect_one : | FStarC_Parser_AST.ModuleAbbrev (ident, lid) -> add_to_parsing_data (P_alias (ident, lid)) | FStarC_Parser_AST.TopLevelLet (uu___1, patterms) -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___2 -> match uu___2 with | (pat, t) -> (collect_pattern pat; collect_term t)) @@ -1411,9 +1366,9 @@ let (collect_one : add_to_parsing_data (P_lid FStarC_Parser_Const.tcclass_lid) else (); - FStarC_Compiler_List.iter collect_tycon ts) + FStarC_List.iter collect_tycon ts) | FStarC_Parser_AST.Exception (uu___1, t) -> - FStarC_Compiler_Util.iter_opt t collect_term + FStarC_Util.iter_opt t collect_term | FStarC_Parser_AST.NewEffect ed -> collect_effect_decl ed | FStarC_Parser_AST.LayeredEffect ed -> collect_effect_decl ed | FStarC_Parser_AST.Polymonadic_bind (uu___1, uu___2, uu___3, t) @@ -1436,16 +1391,15 @@ let (collect_one : | FStarC_Parser_AST.DeclSyntaxExtension uu___1 -> () | FStarC_Parser_AST.Unparseable -> () | FStarC_Parser_AST.TopLevelModule lid -> - (FStarC_Compiler_Util.incr num_of_toplevelmods; + (FStarC_Util.incr num_of_toplevelmods; (let uu___2 = - let uu___3 = - FStarC_Compiler_Effect.op_Bang num_of_toplevelmods in + let uu___3 = FStarC_Effect.op_Bang num_of_toplevelmods in uu___3 > Prims.int_one in if uu___2 then let uu___3 = let uu___4 = string_of_lid lid true in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Automatic dependency analysis demands one module per file (module %s not supported)" uu___4 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident @@ -1457,40 +1411,39 @@ let (collect_one : match uu___1 with | FStarC_Parser_AST.TyconAbstract (uu___2, binders, k) -> (collect_binders binders; - FStarC_Compiler_Util.iter_opt k collect_term) + FStarC_Util.iter_opt k collect_term) | FStarC_Parser_AST.TyconAbbrev (uu___2, binders, k, t) -> (collect_binders binders; - FStarC_Compiler_Util.iter_opt k collect_term; + FStarC_Util.iter_opt k collect_term; collect_term t) | FStarC_Parser_AST.TyconRecord (uu___2, binders, k, uu___3, identterms) -> (collect_binders binders; - FStarC_Compiler_Util.iter_opt k collect_term; + FStarC_Util.iter_opt k collect_term; collect_tycon_record identterms) | FStarC_Parser_AST.TyconVariant (uu___2, binders, k, identterms) -> (collect_binders binders; - FStarC_Compiler_Util.iter_opt k collect_term; + FStarC_Util.iter_opt k collect_term; (let uu___5 = - FStarC_Compiler_List.filter_map + FStarC_List.filter_map FStar_Pervasives_Native.__proj__Mktuple3__item___2 identterms in - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___6 -> match uu___6 with | FStarC_Parser_AST.VpOfNotation t -> collect_term t | FStarC_Parser_AST.VpArbitrary t -> collect_term t | FStarC_Parser_AST.VpRecord (record, t) -> (collect_tycon_record record; - FStarC_Compiler_Util.iter_opt t collect_term)) - uu___5)) + FStarC_Util.iter_opt t collect_term)) uu___5)) and collect_tycon_record r = - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___1 -> match uu___1 with | (uu___2, aq, attrs, t) -> (collect_aqual aq; - FStarC_Compiler_List.iter collect_term attrs; + FStarC_List.iter collect_term attrs; collect_term t)) r and collect_effect_decl uu___1 = match uu___1 with @@ -1501,11 +1454,10 @@ let (collect_one : | FStarC_Parser_AST.RedefineEffect (uu___2, binders, t) -> (collect_binders binders; collect_term t) and collect_binders binders = - FStarC_Compiler_List.iter collect_binder binders + FStarC_List.iter collect_binder binders and collect_binder b = collect_aqual b.FStarC_Parser_AST.aqual; - FStarC_Compiler_List.iter collect_term - b.FStarC_Parser_AST.battributes; + FStarC_List.iter collect_term b.FStarC_Parser_AST.battributes; (match b with | { FStarC_Parser_AST.b = FStarC_Parser_AST.Annotated @@ -1565,8 +1517,7 @@ let (collect_one : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = - FStarC_Compiler_Util.format2 "fstar.%sint%s" u w in + let uu___6 = FStarC_Util.format2 "fstar.%sint%s" u w in FStarC_Ident.lid_of_str uu___6 in (false, uu___5) in P_dep uu___4 in @@ -1593,19 +1544,23 @@ let (collect_one : P_dep uu___3 in add_to_parsing_data uu___2 | FStarC_Const.Const_real uu___2 -> - let uu___3 = - let uu___4 = - let uu___5 = FStarC_Ident.lid_of_str "fstar.real" in - (false, uu___5) in - P_dep uu___4 in - add_to_parsing_data uu___3 + let mm = maybe_module_name_of_file filename in + if mm <> (FStar_Pervasives_Native.Some "FStar.Real") + then + let uu___3 = + let uu___4 = + let uu___5 = FStarC_Ident.lid_of_str "fstar.real" in + (false, uu___5) in + P_dep uu___4 in + add_to_parsing_data uu___3 + else () | uu___2 -> () and collect_term' uu___1 = match uu___1 with | FStarC_Parser_AST.Wild -> () | FStarC_Parser_AST.Const c -> collect_constant c | FStarC_Parser_AST.Op (uu___2, ts) -> - FStarC_Compiler_List.iter collect_term ts + FStarC_List.iter collect_term ts | FStarC_Parser_AST.Tvar uu___2 -> () | FStarC_Parser_AST.Uvar uu___2 -> () | FStarC_Parser_AST.Var lid -> add_to_parsing_data (P_lid lid) @@ -1616,7 +1571,7 @@ let (collect_one : | FStarC_Parser_AST.Name lid -> add_to_parsing_data (P_lid lid) | FStarC_Parser_AST.Construct (lid, termimps) -> (add_to_parsing_data (P_lid lid); - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___3 -> match uu___3 with | (t, uu___4) -> collect_term t) termimps) @@ -1627,19 +1582,19 @@ let (collect_one : | FStarC_Parser_AST.App (t1, t2, uu___2) -> (collect_term t1; collect_term t2) | FStarC_Parser_AST.Let (uu___2, patterms, t) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun uu___4 -> match uu___4 with | (attrs_opt, (pat, t1)) -> ((let uu___6 = - FStarC_Compiler_Util.map_opt attrs_opt - (FStarC_Compiler_List.iter collect_term) in + FStarC_Util.map_opt attrs_opt + (FStarC_List.iter collect_term) in ()); collect_pattern pat; collect_term t1)) patterms; collect_term t) | FStarC_Parser_AST.LetOperator (lets, body) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun uu___3 -> match uu___3 with | (ident, pat, def) -> @@ -1677,8 +1632,8 @@ let (collect_one : (t1, t2, FStar_Pervasives_Native.Some tac, uu___2) -> (collect_term t1; collect_term t2; collect_term tac) | FStarC_Parser_AST.Record (t, idterms) -> - (FStarC_Compiler_Util.iter_opt t collect_term; - FStarC_Compiler_List.iter + (FStarC_Util.iter_opt t collect_term; + FStarC_List.iter (fun uu___3 -> match uu___3 with | (fn, t1) -> (collect_fieldname fn; collect_term t1)) @@ -1688,7 +1643,7 @@ let (collect_one : | FStarC_Parser_AST.Product (binders, t) -> (collect_binders binders; collect_term t) | FStarC_Parser_AST.Sum (binders, t) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun uu___3 -> match uu___3 with | FStar_Pervasives.Inl b -> collect_binder b @@ -1696,19 +1651,16 @@ let (collect_one : collect_term t) | FStarC_Parser_AST.QForall (binders, (uu___2, ts), t) -> (collect_binders binders; - FStarC_Compiler_List.iter - (FStarC_Compiler_List.iter collect_term) ts; + FStarC_List.iter (FStarC_List.iter collect_term) ts; collect_term t) | FStarC_Parser_AST.QExists (binders, (uu___2, ts), t) -> (collect_binders binders; - FStarC_Compiler_List.iter - (FStarC_Compiler_List.iter collect_term) ts; + FStarC_List.iter (FStarC_List.iter collect_term) ts; collect_term t) | FStarC_Parser_AST.QuantOp (uu___2, binders, (uu___3, ts), t) -> (collect_binders binders; - FStarC_Compiler_List.iter - (FStarC_Compiler_List.iter collect_term) ts; + FStarC_List.iter (FStarC_List.iter collect_term) ts; collect_term t) | FStarC_Parser_AST.Refine (binder, t) -> (collect_binder binder; collect_term t) @@ -1718,8 +1670,7 @@ let (collect_one : | FStarC_Parser_AST.Ensures (t, uu___2) -> collect_term t | FStarC_Parser_AST.Labeled (t, uu___2, uu___3) -> collect_term t - | FStarC_Parser_AST.LexList l -> - FStarC_Compiler_List.iter collect_term l + | FStarC_Parser_AST.LexList l -> FStarC_List.iter collect_term l | FStarC_Parser_AST.WFOrder (t1, t2) -> ((let uu___3 = let uu___4 = @@ -1735,7 +1686,7 @@ let (collect_one : | FStarC_Parser_AST.Antiquote t -> collect_term t | FStarC_Parser_AST.VQuote t -> collect_term t | FStarC_Parser_AST.Attributes cattributes -> - FStarC_Compiler_List.iter collect_term cattributes + FStarC_List.iter collect_term cattributes | FStarC_Parser_AST.CalcProof (rel, init, steps) -> ((let uu___3 = let uu___4 = @@ -1745,7 +1696,7 @@ let (collect_one : add_to_parsing_data uu___3); collect_term rel; collect_term init; - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___5 -> match uu___5 with | FStarC_Parser_AST.CalcStep (rel1, just, next) -> @@ -1773,7 +1724,7 @@ let (collect_one : add_to_parsing_data uu___3); collect_binders bs; collect_term t; - FStarC_Compiler_List.iter collect_term vs; + FStarC_List.iter collect_term vs; collect_term e) | FStarC_Parser_AST.IntroImplies (p, q, x, e) -> ((let uu___3 = @@ -1820,7 +1771,7 @@ let (collect_one : add_to_parsing_data uu___3); collect_binders bs; collect_term p; - FStarC_Compiler_List.iter collect_term vs) + FStarC_List.iter collect_term vs) | FStarC_Parser_AST.ElimExists (bs, p, q, b, e) -> ((let uu___3 = let uu___4 = @@ -1875,7 +1826,7 @@ let (collect_one : collect_term e; collect_term e') | FStarC_Parser_AST.ListLiteral ts -> - FStarC_Compiler_List.iter collect_term ts + FStarC_List.iter collect_term ts | FStarC_Parser_AST.SeqLiteral ts -> ((let uu___3 = let uu___4 = @@ -1883,21 +1834,17 @@ let (collect_one : (false, uu___5) in P_dep uu___4 in add_to_parsing_data uu___3); - FStarC_Compiler_List.iter collect_term ts) - and collect_patterns ps = - FStarC_Compiler_List.iter collect_pattern ps + FStarC_List.iter collect_term ts) + and collect_patterns ps = FStarC_List.iter collect_pattern ps and collect_pattern p = collect_pattern' p.FStarC_Parser_AST.pat and collect_pattern' uu___1 = match uu___1 with | FStarC_Parser_AST.PatVar (uu___2, aqual, attrs) -> - (collect_aqual aqual; - FStarC_Compiler_List.iter collect_term attrs) + (collect_aqual aqual; FStarC_List.iter collect_term attrs) | FStarC_Parser_AST.PatTvar (uu___2, aqual, attrs) -> - (collect_aqual aqual; - FStarC_Compiler_List.iter collect_term attrs) + (collect_aqual aqual; FStarC_List.iter collect_term attrs) | FStarC_Parser_AST.PatWild (aqual, attrs) -> - (collect_aqual aqual; - FStarC_Compiler_List.iter collect_term attrs) + (collect_aqual aqual; FStarC_List.iter collect_term attrs) | FStarC_Parser_AST.PatOp uu___2 -> () | FStarC_Parser_AST.PatConst uu___2 -> () | FStarC_Parser_AST.PatVQuote t -> collect_term t @@ -1908,7 +1855,7 @@ let (collect_one : | FStarC_Parser_AST.PatOr ps -> collect_patterns ps | FStarC_Parser_AST.PatTuple (ps, uu___2) -> collect_patterns ps | FStarC_Parser_AST.PatRecord lidpats -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___2 -> match uu___2 with | (uu___3, p) -> collect_pattern p) lidpats @@ -1918,13 +1865,12 @@ let (collect_one : | FStarC_Parser_AST.PatAscribed (p, (t, FStar_Pervasives_Native.Some tac)) -> (collect_pattern p; collect_term t; collect_term tac) - and collect_branches bs = - FStarC_Compiler_List.iter collect_branch bs + and collect_branches bs = FStarC_List.iter collect_branch bs and collect_branch uu___1 = match uu___1 with | (pat, t1, t2) -> (collect_pattern pat; - FStarC_Compiler_Util.iter_opt t1 collect_term; + FStarC_Util.iter_opt t1 collect_term; collect_term t2) and collect_fieldname fn = let uu___1 = let uu___2 = FStarC_Ident.nsstr fn in uu___2 <> "" in @@ -1945,8 +1891,8 @@ let (collect_one : (collect_module ast; (let pd1 = let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang pd in - FStarC_Compiler_List.rev uu___5 in + let uu___5 = FStarC_Effect.op_Bang pd in + FStarC_List.rev uu___5 in Mk_pd uu___4 in let uu___4 = from_parsing_data pd1 original_map filename in match uu___4 with @@ -1954,20 +1900,19 @@ let (collect_one : (pd1, deps1, has_inline_for_extraction, mo_roots)))) let (collect_one_cache : (dependence Prims.list * dependence Prims.list * Prims.bool) - FStarC_Compiler_Util.smap FStarC_Compiler_Effect.ref) + FStarC_Util.smap FStarC_Effect.ref) = - let uu___ = FStarC_Compiler_Util.smap_create Prims.int_zero in - FStarC_Compiler_Util.mk_ref uu___ + let uu___ = FStarC_Util.smap_create Prims.int_zero in + FStarC_Util.mk_ref uu___ let (set_collect_one_cache : (dependence Prims.list * dependence Prims.list * Prims.bool) - FStarC_Compiler_Util.smap -> unit) - = - fun cache -> FStarC_Compiler_Effect.op_Colon_Equals collect_one_cache cache + FStarC_Util.smap -> unit) + = fun cache -> FStarC_Effect.op_Colon_Equals collect_one_cache cache let (dep_graph_copy : dependence_graph -> dependence_graph) = fun dep_graph -> let uu___ = dep_graph in match uu___ with - | Deps g -> let uu___1 = FStarC_Compiler_Util.smap_copy g in Deps uu___1 + | Deps g -> let uu___1 = FStarC_Util.smap_copy g in Deps uu___1 let (widen_deps : module_name Prims.list -> dependence_graph -> @@ -1977,7 +1922,7 @@ let (widen_deps : fun dep_graph -> fun file_system_map -> fun widened -> - let widened1 = FStarC_Compiler_Util.mk_ref widened in + let widened1 = FStarC_Util.mk_ref widened in let uu___ = dep_graph in match uu___ with | Deps dg -> @@ -1985,27 +1930,25 @@ let (widen_deps : (match uu___1 with | Deps dg' -> let widen_one deps1 = - FStarC_Compiler_List.map + FStarC_List.map (fun d -> match d with | PreferInterface m when - (FStarC_Compiler_List.contains m friends1) && + (FStarC_List.contains m friends1) && (has_implementation file_system_map m) -> - (FStarC_Compiler_Effect.op_Colon_Equals - widened1 true; + (FStarC_Effect.op_Colon_Equals widened1 true; FriendImplementation m) | uu___2 -> d) deps1 in - (FStarC_Compiler_Util.smap_fold dg + (FStarC_Util.smap_fold dg (fun filename -> fun dep_node1 -> fun uu___3 -> let uu___4 = let uu___5 = widen_one dep_node1.edges in { edges = uu___5; color = White } in - FStarC_Compiler_Util.smap_add dg' filename - uu___4) (); - (let uu___3 = FStarC_Compiler_Effect.op_Bang widened1 in + FStarC_Util.smap_add dg' filename uu___4) (); + (let uu___3 = FStarC_Effect.op_Bang widened1 in (uu___3, (Deps dg'))))) let (topological_dependences_of' : files_for_module_name -> @@ -2024,21 +1967,21 @@ let (topological_dependences_of' : | (all_friends, all_files) -> let dep_node1 = let uu___1 = deps_try_find dep_graph1 filename in - FStarC_Compiler_Util.must uu___1 in + FStarC_Util.must uu___1 in (match dep_node1.color with | Gray -> failwith "Impossible: cycle detected after cycle detection has passed" | Black -> (all_friends, all_files) | White -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___2 = FStarC_Effect.op_Bang dbg in if uu___2 then let uu___3 = FStarC_Class_Show.show (FStarC_Class_Show.show_list showable_dependence) dep_node1.edges in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Visiting %s: direct deps are %s\n" filename uu___3 else ()); @@ -2054,25 +1997,21 @@ let (topological_dependences_of' : | (all_friends1, all_files1) -> (deps_add_dep dep_graph1 filename { edges = (dep_node1.edges); color = Black }; - (let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg in + (let uu___6 = FStarC_Effect.op_Bang dbg in if uu___6 - then - FStarC_Compiler_Util.print1 "Adding %s\n" - filename + then FStarC_Util.print1 "Adding %s\n" filename else ()); (let uu___6 = let uu___7 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___8 -> match uu___8 with | FriendImplementation m -> [m] | d -> []) dep_node1.edges in - FStarC_Compiler_List.op_At uu___7 - all_friends1 in + FStarC_List.op_At uu___7 all_friends1 in (uu___6, (filename :: all_files1))))))) and all_friend_deps dep_graph1 cycle all_friends filenames = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun all_friends1 -> fun k -> all_friend_deps_1 dep_graph1 (k :: cycle) all_friends1 k) @@ -2080,41 +2019,39 @@ let (topological_dependences_of' : let uu___ = all_friend_deps dep_graph [] ([], []) root_files in match uu___ with | (friends1, all_files_0) -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___2 = FStarC_Effect.op_Bang dbg in if uu___2 then let uu___3 = let uu___4 = - FStarC_Compiler_Util.remove_dups - (fun x -> fun y -> x = y) friends1 in - FStarC_Compiler_String.concat ", " uu___4 in - FStarC_Compiler_Util.print3 + FStarC_Util.remove_dups (fun x -> fun y -> x = y) + friends1 in + FStarC_String.concat ", " uu___4 in + FStarC_Util.print3 "Phase1 complete:\n\tall_files = %s\n\tall_friends=%s\n\tinterfaces_with_inlining=%s\n" - (FStarC_Compiler_String.concat ", " all_files_0) uu___3 - (FStarC_Compiler_String.concat ", " - interfaces_needing_inlining) + (FStarC_String.concat ", " all_files_0) uu___3 + (FStarC_String.concat ", " interfaces_needing_inlining) else ()); (let uu___2 = widen_deps friends1 dep_graph file_system_map widened in match uu___2 with | (widened1, dep_graph1) -> let uu___3 = - (let uu___5 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___5 = FStarC_Effect.op_Bang dbg in if uu___5 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "==============Phase2==================\n" else ()); all_friend_deps dep_graph1 [] ([], []) root_files in (match uu___3 with | (uu___4, all_files) -> - ((let uu___6 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___6 = FStarC_Effect.op_Bang dbg in if uu___6 then - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Phase2 complete: all_files = %s\n" - (FStarC_Compiler_String.concat ", " - all_files) + (FStarC_String.concat ", " all_files) else ()); (all_files, widened1))))) let (phase1 : @@ -2126,10 +2063,10 @@ let (phase1 : fun dep_graph -> fun interfaces_needing_inlining -> fun for_extraction -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___1 = FStarC_Effect.op_Bang dbg in if uu___1 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "==============Phase1==================\n" else ()); (let widened = false in @@ -2161,17 +2098,16 @@ let (topological_dependences_of : let (all_files_in_include_paths : unit -> Prims.string Prims.list) = fun uu___ -> let paths = FStarC_Find.include_path () in - FStarC_Compiler_List.collect + FStarC_List.collect (fun path -> let files = safe_readdir_for_include path in let files1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun f -> - (FStarC_Compiler_Util.ends_with f ".fst") || - (FStarC_Compiler_Util.ends_with f ".fsti")) files in - FStarC_Compiler_List.map - (fun file -> FStarC_Compiler_Util.join_paths path file) files1) - paths + (FStarC_Util.ends_with f ".fst") || + (FStarC_Util.ends_with f ".fsti")) files in + FStarC_List.map (fun file -> FStarC_Util.join_paths path file) + files1) paths let (collect : Prims.string Prims.list -> (Prims.string -> parsing_data FStar_Pervasives_Native.option) -> @@ -2184,14 +2120,13 @@ let (collect : | [] -> all_files_in_include_paths () | uu___ -> all_cmd_line_files in let all_cmd_line_files2 = - FStarC_Compiler_List.map + FStarC_List.map (fun fn -> let uu___ = FStarC_Find.find_file fn in match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 "File %s could not be found" - fn in + FStarC_Util.format1 "File %s could not be found" fn in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_ModuleOrFileNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -2199,17 +2134,14 @@ let (collect : | FStar_Pervasives_Native.Some fn1 -> fn1) all_cmd_line_files1 in let dep_graph = deps_empty () in let file_system_map = build_map all_cmd_line_files2 in - let interfaces_needing_inlining = FStarC_Compiler_Util.mk_ref [] in + let interfaces_needing_inlining = FStarC_Util.mk_ref [] in let add_interface_for_inlining l = let l1 = lowercase_module_name l in let uu___ = - let uu___1 = - FStarC_Compiler_Effect.op_Bang interfaces_needing_inlining in + let uu___1 = FStarC_Effect.op_Bang interfaces_needing_inlining in l1 :: uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals interfaces_needing_inlining - uu___ in - let parse_results = - FStarC_Compiler_Util.smap_create (Prims.of_int (40)) in + FStarC_Effect.op_Colon_Equals interfaces_needing_inlining uu___ in + let parse_results = FStarC_Util.smap_create (Prims.of_int (40)) in let rec discover_one file_name1 = let uu___ = let uu___1 = deps_try_find dep_graph file_name1 in @@ -2218,8 +2150,8 @@ let (collect : then let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang collect_one_cache in - FStarC_Compiler_Util.smap_try_find uu___3 file_name1 in + let uu___3 = FStarC_Effect.op_Bang collect_one_cache in + FStarC_Util.smap_try_find uu___3 file_name1 in match uu___2 with | FStar_Pervasives_Native.Some cached -> ((Mk_pd []), cached) | FStar_Pervasives_Native.None -> @@ -2236,45 +2168,43 @@ let (collect : (if needs_interface_inlining then add_interface_for_inlining file_name1 else (); - FStarC_Compiler_Util.smap_add parse_results file_name1 - parsing_data1; + FStarC_Util.smap_add parse_results file_name1 parsing_data1; (let deps2 = let module_name1 = lowercase_module_name file_name1 in let uu___4 = (is_implementation file_name1) && (has_interface file_system_map module_name1) in if uu___4 - then - FStarC_Compiler_List.op_At deps1 - [UseInterface module_name1] + then FStarC_List.op_At deps1 [UseInterface module_name1] else deps1 in let dep_node1 = - let uu___4 = FStarC_Compiler_List.unique deps2 in + let uu___4 = FStarC_List.unique deps2 in { edges = uu___4; color = White } in deps_add_dep dep_graph file_name1 dep_node1; (let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (file_of_dep file_system_map all_cmd_line_files2) - (FStarC_Compiler_List.op_At deps2 mo_roots) in - FStarC_Compiler_List.iter discover_one uu___5))) + (FStarC_List.op_At deps2 mo_roots) in + FStarC_List.iter discover_one uu___5))) else () in profile - (fun uu___1 -> - FStarC_Compiler_List.iter discover_one all_cmd_line_files2) + (fun uu___1 -> FStarC_List.iter discover_one all_cmd_line_files2) "FStarC.Parser.Dep.discover"; (let cycle_detected dep_graph1 cycle filename = - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "The cycle contains a subset of the modules in:\n%s \n" - (FStarC_Compiler_String.concat "\n`used by` " cycle); + (FStarC_String.concat "\n`used by` " cycle); (let fn = "dep.graph" in with_file_outchannel fn - (fun outc -> print_graph outc fn dep_graph1); - FStarC_Compiler_Util.print_string "\n"; + (fun outc -> + print_graph outc fn dep_graph1 file_system_map + all_cmd_line_files2); + FStarC_Util.print_string "\n"; (let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.format1 - "Recursive dependency on module %s." filename in + FStarC_Util.format1 "Recursive dependency on module %s." + filename in FStarC_Errors_Msg.text uu___6 in let uu___6 = let uu___7 = @@ -2288,7 +2218,7 @@ let (collect : (Obj.magic uu___4))) in let full_cycle_detection all_command_line_files file_system_map1 = let dep_graph1 = dep_graph_copy dep_graph in - let mo_files = FStarC_Compiler_Util.mk_ref [] in + let mo_files = FStarC_Util.mk_ref [] in let rec aux cycle filename = let node = let uu___1 = deps_try_find dep_graph1 filename in @@ -2296,11 +2226,11 @@ let (collect : | FStar_Pervasives_Native.Some node1 -> node1 | FStar_Pervasives_Native.None -> let uu___2 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: Failed to find dependencies of %s" filename in failwith uu___2 in let direct_deps = - FStarC_Compiler_List.collect + FStarC_List.collect (fun x -> match x with | UseInterface f -> @@ -2329,8 +2259,7 @@ let (collect : (let uu___3 = dependences_of file_system_map1 dep_graph1 all_command_line_files filename in - FStarC_Compiler_List.iter (fun k -> aux (k :: cycle) k) - uu___3); + FStarC_List.iter (fun k -> aux (k :: cycle) k) uu___3); deps_add_dep dep_graph1 filename { edges = direct_deps; color = Black }; (let uu___4 = is_interface filename in @@ -2339,31 +2268,28 @@ let (collect : let uu___5 = let uu___6 = lowercase_module_name filename in implementation_of_internal file_system_map1 uu___6 in - FStarC_Compiler_Util.iter_opt uu___5 + FStarC_Util.iter_opt uu___5 (fun impl -> if Prims.op_Negation - (FStarC_Compiler_List.contains impl - all_command_line_files) + (FStarC_List.contains impl all_command_line_files) then let uu___6 = - let uu___7 = - FStarC_Compiler_Effect.op_Bang mo_files in + let uu___7 = FStarC_Effect.op_Bang mo_files in impl :: uu___7 in - FStarC_Compiler_Effect.op_Colon_Equals mo_files - uu___6 + FStarC_Effect.op_Colon_Equals mo_files uu___6 else ()) else ())) in - FStarC_Compiler_List.iter (aux []) all_command_line_files; - (let uu___2 = FStarC_Compiler_Effect.op_Bang mo_files in - FStarC_Compiler_List.iter (aux []) uu___2) in + FStarC_List.iter (aux []) all_command_line_files; + (let uu___2 = FStarC_Effect.op_Bang mo_files in + FStarC_List.iter (aux []) uu___2) in full_cycle_detection all_cmd_line_files2 file_system_map; - FStarC_Compiler_List.iter + FStarC_List.iter (fun f -> let m = lowercase_module_name f in FStarC_Options.add_verify_module m) all_cmd_line_files2; (let inlining_ifaces = - FStarC_Compiler_Effect.op_Bang interfaces_needing_inlining in + FStarC_Effect.op_Bang interfaces_needing_inlining in let uu___3 = profile (fun uu___4 -> @@ -2375,12 +2301,11 @@ let (collect : "FStarC.Parser.Dep.topological_dependences_of" in match uu___3 with | (all_files, uu___4) -> - ((let uu___6 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___6 = FStarC_Effect.op_Bang dbg in if uu___6 then - FStarC_Compiler_Util.print1 - "Interfaces needing inlining: %s\n" - (FStarC_Compiler_String.concat ", " inlining_ifaces) + FStarC_Util.print1 "Interfaces needing inlining: %s\n" + (FStarC_String.concat ", " inlining_ifaces) else ()); (all_files, (mk_deps dep_graph file_system_map all_cmd_line_files2 @@ -2395,59 +2320,57 @@ let (deps_of_modul : deps -> module_name -> module_name Prims.list) = fun m -> let aux fopt = let uu___ = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun f -> let uu___1 = deps_of deps1 f in - FStarC_Compiler_List.map module_name_of_file uu___1) fopt in - FStarC_Compiler_Util.dflt [] uu___ in + FStarC_List.map module_name_of_file uu___1) fopt in + FStarC_Util.dflt [] uu___ in let uu___ = let uu___1 = - FStarC_Compiler_Util.smap_try_find deps1.file_system_map - (FStarC_Compiler_String.lowercase m) in - FStarC_Compiler_Util.map_option + FStarC_Util.smap_try_find deps1.file_system_map + (FStarC_String.lowercase m) in + FStarC_Util.map_option (fun uu___2 -> match uu___2 with | (intf_opt, impl_opt) -> let uu___3 = let uu___4 = aux intf_opt in let uu___5 = aux impl_opt in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_Util.remove_dups (fun x -> fun y -> x = y) - uu___3) uu___1 in - FStarC_Compiler_Util.dflt [] uu___ + FStarC_List.op_At uu___4 uu___5 in + FStarC_Util.remove_dups (fun x -> fun y -> x = y) uu___3) + uu___1 in + FStarC_Util.dflt [] uu___ let (print_digest : (Prims.string * Prims.string) Prims.list -> Prims.string) = fun dig -> let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (m, d) -> - let uu___2 = FStarC_Compiler_Util.base64_encode d in - FStarC_Compiler_Util.format2 "%s:%s" m uu___2) dig in - FStarC_Compiler_String.concat "\n" uu___ -let (print_make : FStarC_Compiler_Util.out_channel -> deps -> unit) = + let uu___2 = FStarC_Util.base64_encode d in + FStarC_Util.format2 "%s:%s" m uu___2) dig in + FStarC_String.concat "\n" uu___ +let (print_make : FStarC_Util.out_channel -> deps -> unit) = fun outc -> fun deps1 -> let file_system_map = deps1.file_system_map in let all_cmd_line_files = deps1.cmd_line_files in let deps2 = deps1.dep_graph in let keys = deps_keys deps2 in - FStarC_Compiler_List.iter + FStarC_List.iter (fun f -> let dep_node1 = - let uu___ = deps_try_find deps2 f in - FStarC_Compiler_Option.get uu___ in + let uu___ = deps_try_find deps2 f in FStarC_Option.get uu___ in let files = - FStarC_Compiler_List.map - (file_of_dep file_system_map all_cmd_line_files) + FStarC_List.map (file_of_dep file_system_map all_cmd_line_files) dep_node1.edges in let files1 = - FStarC_Compiler_List.map - (fun s -> FStarC_Compiler_Util.replace_chars s 32 "\\ ") files in - FStarC_Compiler_Util.print2 "%s: %s\n\n" f - (FStarC_Compiler_String.concat " " files1)) keys -let (print_raw : FStarC_Compiler_Util.out_channel -> deps -> unit) = + FStarC_List.map (fun s -> FStarC_Util.replace_chars s 32 "\\ ") + files in + FStarC_Util.print2 "%s: %s\n\n" f + (FStarC_String.concat " " files1)) keys +let (print_raw : FStarC_Util.out_channel -> deps -> unit) = fun outc -> fun deps1 -> let uu___ = deps1.dep_graph in @@ -2455,57 +2378,49 @@ let (print_raw : FStarC_Compiler_Util.out_channel -> deps -> unit) = | Deps deps2 -> let uu___1 = let uu___2 = - FStarC_Compiler_Util.smap_fold deps2 + FStarC_Util.smap_fold deps2 (fun k -> fun dep_node1 -> fun out -> let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_List.map dep_to_string - dep_node1.edges in - FStarC_Compiler_String.concat ";\n\t" uu___5 in - FStarC_Compiler_Util.format2 "%s -> [\n\t%s\n] " k - uu___4 in + FStarC_List.map dep_to_string dep_node1.edges in + FStarC_String.concat ";\n\t" uu___5 in + FStarC_Util.format2 "%s -> [\n\t%s\n] " k uu___4 in uu___3 :: out) [] in - FStarC_Compiler_String.concat ";;\n" uu___2 in - FStarC_Compiler_Util.fprint outc "%s\n" [uu___1] -let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = + FStarC_String.concat ";;\n" uu___2 in + FStarC_Util.fprint outc "%s\n" [uu___1] +let (print_full : FStarC_Util.out_channel -> deps -> unit) = fun outc -> fun deps1 -> let pre_tag = FStarC_Options_Ext.get "dep_pretag" in let sort_output_files orig_output_file_map = - let order = FStarC_Compiler_Util.mk_ref [] in + let order = FStarC_Util.mk_ref [] in let remaining_output_files = - FStarC_Compiler_Util.smap_copy orig_output_file_map in + FStarC_Util.smap_copy orig_output_file_map in let visited_other_modules = - FStarC_Compiler_Util.smap_create (Prims.of_int (41)) in + FStarC_Util.smap_create (Prims.of_int (41)) in let should_visit lc_module_name = (let uu___ = - FStarC_Compiler_Util.smap_try_find remaining_output_files - lc_module_name in - FStarC_Compiler_Option.isSome uu___) || + FStarC_Util.smap_try_find remaining_output_files lc_module_name in + FStarC_Option.isSome uu___) || (let uu___ = - FStarC_Compiler_Util.smap_try_find visited_other_modules - lc_module_name in - FStarC_Compiler_Option.isNone uu___) in + FStarC_Util.smap_try_find visited_other_modules lc_module_name in + FStarC_Option.isNone uu___) in let mark_visiting lc_module_name = let ml_file_opt = - FStarC_Compiler_Util.smap_try_find remaining_output_files - lc_module_name in - FStarC_Compiler_Util.smap_remove remaining_output_files - lc_module_name; - FStarC_Compiler_Util.smap_add visited_other_modules lc_module_name - true; + FStarC_Util.smap_try_find remaining_output_files lc_module_name in + FStarC_Util.smap_remove remaining_output_files lc_module_name; + FStarC_Util.smap_add visited_other_modules lc_module_name true; ml_file_opt in let emit_output_file_opt ml_file_opt = match ml_file_opt with | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some ml_file -> let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang order in ml_file - :: uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals order uu___ in + let uu___1 = FStarC_Effect.op_Bang order in ml_file :: uu___1 in + FStarC_Effect.op_Colon_Equals order uu___ in let rec aux uu___ = match uu___ with | [] -> () @@ -2518,16 +2433,16 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = (match uu___1 with | FStar_Pervasives_Native.None -> let uu___2 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: module %s: %s not found" lc_module_name file_name1 in failwith uu___2 | FStar_Pervasives_Native.Some { edges = immediate_deps; color = uu___2;_} -> let immediate_deps1 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> - FStarC_Compiler_String.lowercase + FStarC_String.lowercase (module_name_of_dep x)) immediate_deps in aux immediate_deps1) in ((let uu___2 = should_visit lc_module_name in @@ -2542,13 +2457,10 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = else ()); aux modules_to_extract) in let all_extracted_modules = - FStarC_Compiler_Util.smap_keys orig_output_file_map in + FStarC_Util.smap_keys orig_output_file_map in aux all_extracted_modules; - (let uu___1 = FStarC_Compiler_Effect.op_Bang order in - FStarC_Compiler_List.rev uu___1) in - let sb = - let uu___ = FStarC_BigInt.of_int_fs (Prims.of_int (10000)) in - FStarC_StringBuffer.create uu___ in + (let uu___1 = FStarC_Effect.op_Bang order in FStarC_List.rev uu___1) in + let sb = FStarC_StringBuffer.create (Prims.of_int (10000)) in let pr str = let uu___ = FStarC_StringBuffer.add str sb in () in let print_entry target first_dep all_deps = pr target; pr ": "; pr first_dep; pr "\\\n\t"; pr all_deps; pr "\n\n" in @@ -2556,32 +2468,29 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = let no_fstar_stubs_file s = let s1 = "FStar.Stubs." in let s2 = "FStar." in - let l1 = FStarC_Compiler_String.length s1 in + let l1 = FStarC_String.length s1 in let uu___ = - ((FStarC_Compiler_String.length s) >= l1) && - (let uu___1 = - FStarC_Compiler_String.substring s Prims.int_zero l1 in + ((FStarC_String.length s) >= l1) && + (let uu___1 = FStarC_String.substring s Prims.int_zero l1 in uu___1 = s1) in if uu___ then let uu___1 = - FStarC_Compiler_String.substring s l1 - ((FStarC_Compiler_String.length s) - l1) in + FStarC_String.substring s l1 ((FStarC_String.length s) - l1) in Prims.strcat s2 uu___1 else s in let output_file ext fst_file = let basename = let uu___ = - let uu___1 = FStarC_Compiler_Util.basename fst_file in + let uu___1 = FStarC_Util.basename fst_file in check_and_strip_suffix uu___1 in - FStarC_Compiler_Option.get uu___ in + FStarC_Option.get uu___ in let basename1 = no_fstar_stubs_file basename in - let ml_base_name = - FStarC_Compiler_Util.replace_chars basename1 46 "_" in + let ml_base_name = FStarC_Util.replace_chars basename1 46 "_" in FStarC_Find.prepend_output_dir (Prims.strcat ml_base_name ext) in let norm_path s = - FStarC_Compiler_Util.replace_chars - (FStarC_Compiler_Util.replace_chars s 92 "/") 32 "\\ " in + FStarC_Util.replace_chars (FStarC_Util.replace_chars s 92 "/") 32 + "\\ " in let output_fs_file f = let uu___ = output_file ".fs" f in norm_path uu___ in let output_ml_file f = @@ -2597,13 +2506,13 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = match uu___ with | (widened, dep_graph) -> let all_checked_files = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun all_checked_files1 -> fun file_name1 -> let process_one_key uu___1 = let dep_node1 = let uu___2 = deps_try_find deps1.dep_graph file_name1 in - FStarC_Compiler_Option.get uu___2 in + FStarC_Option.get uu___2 in let uu___2 = let uu___3 = is_interface file_name1 in if uu___3 @@ -2624,24 +2533,24 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = let uu___8 = let uu___9 = deps_try_find deps1.dep_graph iface in - FStarC_Compiler_Option.get uu___9 in + FStarC_Option.get uu___9 in uu___8.edges in FStar_Pervasives_Native.Some uu___7 in ((FStar_Pervasives_Native.Some iface), uu___6)) in match uu___2 with | (iface_fn, iface_deps) -> let iface_deps1 = - FStarC_Compiler_Util.map_opt iface_deps - (FStarC_Compiler_List.filter + FStarC_Util.map_opt iface_deps + (FStarC_List.filter (fun iface_dep -> let uu___3 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (dep_subsumed_by iface_dep) dep_node1.edges in Prims.op_Negation uu___3)) in let norm_f = norm_path file_name1 in let files = - FStarC_Compiler_List.map + FStarC_List.map (file_of_dep_aux true deps1.file_system_map deps1.cmd_line_files) dep_node1.edges in let files1 = @@ -2649,29 +2558,25 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = | FStar_Pervasives_Native.None -> files | FStar_Pervasives_Native.Some iface_deps2 -> let iface_files = - FStarC_Compiler_List.map + FStarC_List.map (file_of_dep_aux true deps1.file_system_map deps1.cmd_line_files) iface_deps2 in - FStarC_Compiler_Util.remove_dups + FStarC_Util.remove_dups (fun x -> fun y -> x = y) - (FStarC_Compiler_List.op_At files - iface_files) in + (FStarC_List.op_At files iface_files) in let files2 = - if FStarC_Compiler_Util.is_some iface_fn + if FStarC_Util.is_some iface_fn then - let iface_fn1 = - FStarC_Compiler_Util.must iface_fn in + let iface_fn1 = FStarC_Util.must iface_fn in let uu___3 = - FStarC_Compiler_List.filter - (fun f -> f <> iface_fn1) files1 in + FStarC_List.filter (fun f -> f <> iface_fn1) + files1 in let uu___4 = cache_file_name iface_fn1 in uu___4 :: uu___3 else files1 in - let files3 = - FStarC_Compiler_List.map norm_path files2 in - let files4 = - FStarC_Compiler_String.concat "\\\n\t" files3 in + let files3 = FStarC_List.map norm_path files2 in + let files4 = FStarC_String.concat "\\\n\t" files3 in let cache_file_name1 = cache_file file_name1 in let all_checked_files2 = let uu___3 = @@ -2700,7 +2605,7 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = "FStarC.Parser.Dep.topological_dependences_of_2" else (let maybe_widen_deps f_deps = - FStarC_Compiler_List.map + FStarC_List.map (fun dep -> file_of_dep_aux false deps1.file_system_map @@ -2713,18 +2618,17 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = | FStar_Pervasives_Native.Some iface_deps2 -> maybe_widen_deps iface_deps2 in let uu___6 = - FStarC_Compiler_Util.remove_dups + FStarC_Util.remove_dups (fun x -> fun y -> x = y) - (FStarC_Compiler_List.op_At fst_files + (FStarC_List.op_At fst_files fst_files_from_iface) in (uu___6, false)) in (match uu___3 with | (all_fst_files_dep, widened1) -> let all_checked_fst_dep_files = - FStarC_Compiler_List.map cache_file - all_fst_files_dep in + FStarC_List.map cache_file all_fst_files_dep in let all_checked_fst_dep_files_string = - FStarC_Compiler_String.concat " \\\n\t" + FStarC_String.concat " \\\n\t" all_checked_fst_dep_files in ((let uu___5 = is_implementation file_name1 in if uu___5 @@ -2777,7 +2681,7 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = ""))); (let cmx_files = let extracted_fst_files = - FStarC_Compiler_List.filter + FStarC_List.filter (fun df -> (let uu___7 = lowercase_module_name df in @@ -2790,8 +2694,8 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = FStarC_Options.should_extract uu___7 FStarC_Options.OCaml)) all_fst_files_dep in - FStarC_Compiler_List.map - output_cmx_file extracted_fst_files in + FStarC_List.map output_cmx_file + extracted_fst_files in let uu___7 = let uu___8 = lowercase_module_name file_name1 in @@ -2800,8 +2704,8 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = if uu___7 then let cmx_files1 = - FStarC_Compiler_String.concat - "\\\n\t" cmx_files in + FStarC_String.concat "\\\n\t" + cmx_files in let uu___8 = output_cmx_file file_name1 in let uu___9 = output_ml_file file_name1 in print_entry uu___8 uu___9 cmx_files1 @@ -2836,17 +2740,14 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = profile process_one_key "FStarC.Parser.Dep.process_one_key") [] keys in let all_fst_files = - let uu___1 = FStarC_Compiler_List.filter is_implementation keys in - FStarC_Compiler_Util.sort_with FStarC_Compiler_String.compare - uu___1 in + let uu___1 = FStarC_List.filter is_implementation keys in + FStarC_Util.sort_with FStarC_String.compare uu___1 in let all_fsti_files = - let uu___1 = FStarC_Compiler_List.filter is_interface keys in - FStarC_Compiler_Util.sort_with FStarC_Compiler_String.compare - uu___1 in + let uu___1 = FStarC_List.filter is_interface keys in + FStarC_Util.sort_with FStarC_String.compare uu___1 in let all_ml_files = - let ml_file_map = - FStarC_Compiler_Util.smap_create (Prims.of_int (41)) in - FStarC_Compiler_List.iter + let ml_file_map = FStarC_Util.smap_create (Prims.of_int (41)) in + FStarC_List.iter (fun fst_file -> let mname = lowercase_module_name fst_file in let uu___2 = @@ -2854,13 +2755,12 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = if uu___2 then let uu___3 = output_ml_file fst_file in - FStarC_Compiler_Util.smap_add ml_file_map mname uu___3 + FStarC_Util.smap_add ml_file_map mname uu___3 else ()) all_fst_files; sort_output_files ml_file_map in let all_fs_files = - let fs_file_map = - FStarC_Compiler_Util.smap_create (Prims.of_int (41)) in - FStarC_Compiler_List.iter + let fs_file_map = FStarC_Util.smap_create (Prims.of_int (41)) in + FStarC_List.iter (fun fst_file -> let mname = lowercase_module_name fst_file in let uu___2 = @@ -2868,13 +2768,12 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = if uu___2 then let uu___3 = output_fs_file fst_file in - FStarC_Compiler_Util.smap_add fs_file_map mname uu___3 + FStarC_Util.smap_add fs_file_map mname uu___3 else ()) all_fst_files; sort_output_files fs_file_map in let all_krml_files = - let krml_file_map = - FStarC_Compiler_Util.smap_create (Prims.of_int (41)) in - FStarC_Compiler_List.iter + let krml_file_map = FStarC_Util.smap_create (Prims.of_int (41)) in + FStarC_List.iter (fun fst_file -> let mname = lowercase_module_name fst_file in let uu___2 = @@ -2882,24 +2781,23 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = if uu___2 then let uu___3 = output_krml_file fst_file in - FStarC_Compiler_Util.smap_add krml_file_map mname uu___3 + FStarC_Util.smap_add krml_file_map mname uu___3 else ()) keys; sort_output_files krml_file_map in let print_all tag files = pr (Prims.strcat pre_tag tag); pr "=\\\n\t"; - FStarC_Compiler_List.iter - (fun f -> pr (norm_path f); pr " \\\n\t") files; + FStarC_List.iter (fun f -> pr (norm_path f); pr " \\\n\t") files; pr "\n" in - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun fsti -> let mn = lowercase_module_name fsti in let range_of_file fsti1 = let r = - FStarC_Compiler_Range_Ops.set_file_of_range - FStarC_Compiler_Range_Type.dummyRange fsti1 in - let uu___2 = FStarC_Compiler_Range_Type.def_range r in - FStarC_Compiler_Range_Type.set_use_range r uu___2 in + FStarC_Range_Ops.set_file_of_range + FStarC_Range_Type.dummyRange fsti1 in + let uu___2 = FStarC_Range_Type.def_range r in + FStarC_Range_Type.set_use_range r uu___2 in let uu___2 = let uu___3 = has_implementation deps1.file_system_map mn in Prims.op_Negation uu___3 in @@ -2908,7 +2806,7 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = let uu___3 = range_of_file fsti in let uu___4 = let uu___5 = module_name_of_file fsti in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Interface %s is admitted without an implementation" uu___5 in FStarC_Errors.log_issue @@ -2924,49 +2822,45 @@ let (print_full : FStarC_Compiler_Util.out_channel -> deps -> unit) = print_all "ALL_ML_FILES" all_ml_files; print_all "ALL_KRML_FILES" all_krml_files; FStarC_StringBuffer.output_channel outc sb) -let (do_print : - FStarC_Compiler_Util.out_channel -> Prims.string -> deps -> unit) = +let (do_print : FStarC_Util.out_channel -> Prims.string -> deps -> unit) = fun outc -> fun fn -> fun deps1 -> let pref uu___ = (let uu___2 = - let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options._version in + let uu___3 = FStarC_Effect.op_Bang FStarC_Options._version in [uu___3] in - FStarC_Compiler_Util.fprint outc - "# This .depend was generated by F* %s\n" uu___2); + FStarC_Util.fprint outc "# This .depend was generated by F* %s\n" + uu___2); (let uu___3 = let uu___4 = FStarC_Class_Show.show FStarC_Class_Show.showable_string - FStarC_Compiler_Util.exec_name in + FStarC_Util.exec_name in [uu___4] in - FStarC_Compiler_Util.fprint outc "# Executable: %s\n" uu___3); + FStarC_Util.fprint outc "# Executable: %s\n" uu___3); (let uu___4 = - let uu___5 = - FStarC_Compiler_Effect.op_Bang FStarC_Options._commit in + let uu___5 = FStarC_Effect.op_Bang FStarC_Options._commit in [uu___5] in - FStarC_Compiler_Util.fprint outc "# Hash: %s\n" uu___4); + FStarC_Util.fprint outc "# Hash: %s\n" uu___4); (let uu___5 = let uu___6 = let uu___7 = - let uu___8 = FStarC_Compiler_Util.getcwd () in - FStarC_Compiler_Util.normalize_file_path uu___8 in + let uu___8 = FStarC_Util.getcwd () in + FStarC_Util.normalize_file_path uu___8 in FStarC_Class_Show.show FStarC_Class_Show.showable_string uu___7 in [uu___6] in - FStarC_Compiler_Util.fprint outc "# Running in directory %s\n" - uu___5); + FStarC_Util.fprint outc "# Running in directory %s\n" uu___5); (let uu___6 = let uu___7 = - let uu___8 = FStarC_Compiler_Util.get_cmd_args () in + let uu___8 = FStarC_Util.get_cmd_args () in FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Class_Show.showable_string) uu___8 in [uu___7] in - FStarC_Compiler_Util.fprint outc - "# Command line arguments: \"%s\"\n" uu___6); - FStarC_Compiler_Util.fprint outc "\n" [] in + FStarC_Util.fprint outc "# Command line arguments: \"%s\"\n" + uu___6); + FStarC_Util.fprint outc "\n" [] in let uu___ = FStarC_Options.dep () in match uu___ with | FStar_Pervasives_Native.Some "make" -> @@ -2976,7 +2870,8 @@ let (do_print : profile (fun uu___2 -> print_full outc deps1) "FStarC.Parser.Deps.print_full_deps") | FStar_Pervasives_Native.Some "graph" -> - print_graph outc fn deps1.dep_graph + print_graph outc fn deps1.dep_graph deps1.file_system_map + deps1.cmd_line_files | FStar_Pervasives_Native.Some "raw" -> print_raw outc deps1 | FStar_Pervasives_Native.Some uu___1 -> FStarC_Errors.raise_error0 @@ -2985,7 +2880,7 @@ let (do_print : (Obj.magic "unknown tool for --dep\n") | FStar_Pervasives_Native.None -> () let (do_print_stdout : deps -> unit) = - fun deps1 -> do_print FStarC_Compiler_Util.stdout "" deps1 + fun deps1 -> do_print FStarC_Util.stdout "" deps1 let (do_print_file : deps -> Prims.string -> unit) = fun deps1 -> fun fn -> with_file_outchannel fn (fun outc -> do_print outc fn deps1) @@ -3004,18 +2899,18 @@ let (module_has_interface : deps -> FStarC_Ident.lident -> Prims.bool) = fun module_name1 -> let uu___ = let uu___1 = FStarC_Ident.string_of_lid module_name1 in - FStarC_Compiler_String.lowercase uu___1 in + FStarC_String.lowercase uu___1 in has_interface deps1.file_system_map uu___ let (deps_has_implementation : deps -> FStarC_Ident.lident -> Prims.bool) = fun deps1 -> fun module_name1 -> let m = let uu___ = FStarC_Ident.string_of_lid module_name1 in - FStarC_Compiler_String.lowercase uu___ in - FStarC_Compiler_Util.for_some + FStarC_String.lowercase uu___ in + FStarC_Util.for_some (fun f -> (is_implementation f) && (let uu___ = let uu___1 = module_name_of_file f in - FStarC_Compiler_String.lowercase uu___1 in + FStarC_String.lowercase uu___1 in uu___ = m)) deps1.all_files \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Parser_Driver.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Driver.ml similarity index 86% rename from stage0/fstar-lib/generated/FStarC_Parser_Driver.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Driver.ml index 9a9f5e39a21..1ff5470648c 100644 --- a/stage0/fstar-lib/generated/FStarC_Parser_Driver.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_Driver.ml @@ -1,8 +1,6 @@ open Prims let (is_cache_file : Prims.string -> Prims.bool) = - fun fn -> - let uu___ = FStarC_Compiler_Util.get_file_extension fn in - uu___ = ".cache" + fun fn -> let uu___ = FStarC_Util.get_file_extension fn in uu___ = ".cache" type fragment = | Empty | Modul of FStarC_Parser_AST.modul @@ -63,10 +61,10 @@ let (maybe_dump_module : FStarC_Parser_AST.modul -> unit) = let uu___1 = FStarC_Ident.string_of_lid l in let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Parser_AST.showable_decl) ds in - FStarC_Compiler_String.concat "\n" uu___3 in - FStarC_Compiler_Util.print2 "Parsed module %s\n%s\n" uu___1 uu___2 + FStarC_String.concat "\n" uu___3 in + FStarC_Util.print2 "Parsed module %s\n%s\n" uu___1 uu___2 else () | FStarC_Parser_AST.Interface (l, ds, uu___) -> let uu___1 = @@ -77,15 +75,15 @@ let (maybe_dump_module : FStarC_Parser_AST.modul -> unit) = let uu___2 = FStarC_Ident.string_of_lid l in let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Parser_AST.showable_decl) ds in - FStarC_Compiler_String.concat "\n" uu___4 in - FStarC_Compiler_Util.print2 "Parsed module %s\n%s\n" uu___2 uu___3 + FStarC_String.concat "\n" uu___4 in + FStarC_Util.print2 "Parsed module %s\n%s\n" uu___2 uu___3 else () let (parse_file : Prims.string -> - (FStarC_Parser_AST.file * (Prims.string * - FStarC_Compiler_Range_Type.range) Prims.list)) + (FStarC_Parser_AST.file * (Prims.string * FStarC_Range_Type.range) + Prims.list)) = fun fn -> let uu___ = @@ -96,8 +94,8 @@ let (parse_file : -> (ast, comments) | FStarC_Parser_ParseIt.ASTFragment (FStar_Pervasives.Inr uu___1, uu___2) -> - let msg = FStarC_Compiler_Util.format1 "%s: expected a module\n" fn in - let r = FStarC_Compiler_Range_Type.dummyRange in + let msg = FStarC_Util.format1 "%s: expected a module\n" fn in + let r = FStarC_Range_Type.dummyRange in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_ModuleExpected () (Obj.magic FStarC_Errors_Msg.is_error_message_string) diff --git a/stage0/fstar-lib/generated/FStarC_Parser_ToDocument.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_ToDocument.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Parser_ToDocument.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_ToDocument.ml index 2b37ac8df0d..77db9c6c187 100644 --- a/stage0/fstar-lib/generated/FStarC_Parser_ToDocument.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Parser_ToDocument.ml @@ -33,7 +33,7 @@ let map_if_all : | FStar_Pervasives_Native.Some r -> aux xs (r :: acc) | FStar_Pervasives_Native.None -> []) in let r = aux l [] in - if (FStarC_Compiler_List.length l) = (FStarC_Compiler_List.length r) + if (FStarC_List.length l) = (FStarC_List.length r) then FStar_Pervasives_Native.Some r else FStar_Pervasives_Native.None let rec all : 'a . ('a -> Prims.bool) -> 'a Prims.list -> Prims.bool = @@ -46,8 +46,8 @@ let (all1_explicit : (FStarC_Parser_AST.term * FStarC_Parser_AST.imp) Prims.list -> Prims.bool) = fun args -> - (Prims.op_Negation (FStarC_Compiler_List.isEmpty args)) && - (FStarC_Compiler_Util.for_all + (Prims.op_Negation (FStarC_List.isEmpty args)) && + (FStarC_Util.for_all (fun uu___ -> match uu___ with | (uu___1, FStarC_Parser_AST.Nothing) -> true @@ -121,10 +121,10 @@ let precede_break_separate_map : fun l -> let uu___ = let uu___1 = FStarC_Pprint.op_Hat_Hat prec FStarC_Pprint.space in - let uu___2 = let uu___3 = FStarC_Compiler_List.hd l in f uu___3 in + let uu___2 = let uu___3 = FStarC_List.hd l in f uu___3 in FStarC_Pprint.precede uu___1 uu___2 in let uu___1 = - let uu___2 = FStarC_Compiler_List.tl l in + let uu___2 = FStarC_List.tl l in FStarC_Pprint.concat_map (fun x -> let uu___3 = @@ -234,10 +234,10 @@ let separate_map_last : fun sep -> fun f -> fun es -> - let l = FStarC_Compiler_List.length es in + let l = FStarC_List.length es in let es1 = - FStarC_Compiler_List.mapi - (fun i -> fun e -> f (i <> (l - Prims.int_one)) e) es in + FStarC_List.mapi (fun i -> fun e -> f (i <> (l - Prims.int_one)) e) + es in FStarC_Pprint.separate sep es1 let separate_break_map_last : 'uuuuu . @@ -263,7 +263,7 @@ let separate_map_or_flow : fun sep -> fun f -> fun l -> - if (FStarC_Compiler_List.length l) < (Prims.of_int (10)) + if (FStarC_List.length l) < (Prims.of_int (10)) then FStarC_Pprint.separate_map sep f l else FStarC_Pprint.flow_map sep f l let flow_map_last : @@ -275,10 +275,10 @@ let flow_map_last : fun sep -> fun f -> fun es -> - let l = FStarC_Compiler_List.length es in + let l = FStarC_List.length es in let es1 = - FStarC_Compiler_List.mapi - (fun i -> fun e -> f (i <> (l - Prims.int_one)) e) es in + FStarC_List.mapi (fun i -> fun e -> f (i <> (l - Prims.int_one)) e) + es in FStarC_Pprint.flow sep es1 let separate_map_or_flow_last : 'uuuuu . @@ -289,7 +289,7 @@ let separate_map_or_flow_last : fun sep -> fun f -> fun l -> - if (FStarC_Compiler_List.length l) < (Prims.of_int (10)) + if (FStarC_List.length l) < (Prims.of_int (10)) then separate_map_last sep f l else flow_map_last sep f l let (separate_or_flow : @@ -465,11 +465,11 @@ let rec (extract_from_ref_set : -> let uu___5 = extract_from_ref_set e1 in let uu___6 = extract_from_ref_set e2 in - FStarC_Compiler_List.op_At uu___5 uu___6 + FStarC_List.op_At uu___5 uu___6 | uu___ -> let uu___1 = let uu___2 = FStarC_Parser_AST.term_to_string e in - FStarC_Compiler_Util.format1 "Not a ref set %s" uu___2 in + FStarC_Util.format1 "Not a ref set %s" uu___2 in failwith uu___1 let (is_general_application : FStarC_Parser_AST.term -> Prims.bool) = fun e -> @@ -482,7 +482,7 @@ let (is_general_prefix_op : FStarC_Ident.ident -> Prims.bool) = fun op -> let op_starting_char = let uu___ = FStarC_Ident.string_of_id op in - FStarC_Compiler_Util.char_at uu___ Prims.int_zero in + FStarC_Util.char_at uu___ Prims.int_zero in ((op_starting_char = 33) || (op_starting_char = 63)) || ((op_starting_char = 126) && (let uu___ = FStarC_Ident.string_of_id op in uu___ <> "~")) @@ -528,22 +528,20 @@ type associativity_level = (associativity * token Prims.list) let (token_to_string : token -> Prims.string) = fun uu___ -> match uu___ with - | StartsWith c -> - Prims.strcat (FStarC_Compiler_Util.string_of_char c) ".*" + | StartsWith c -> Prims.strcat (FStarC_Util.string_of_char c) ".*" | Exact s -> s | UnicodeOperator -> "" let (is_non_latin_char : FStar_Char.char -> Prims.bool) = - fun s -> (FStarC_Compiler_Util.int_of_char s) > (Prims.of_int (0x024f)) + fun s -> (FStarC_Util.int_of_char s) > (Prims.of_int (0x024f)) let (matches_token : Prims.string -> token -> Prims.bool) = fun s -> fun uu___ -> match uu___ with | StartsWith c -> - let uu___1 = FStarC_Compiler_String.get s Prims.int_zero in - uu___1 = c + let uu___1 = FStarC_String.get s Prims.int_zero in uu___1 = c | Exact s' -> s = s' | UnicodeOperator -> - let uu___1 = FStarC_Compiler_String.get s Prims.int_zero in + let uu___1 = FStarC_String.get s Prims.int_zero in is_non_latin_char uu___1 let matches_level : 'uuuuu . Prims.string -> ('uuuuu * token Prims.list) -> Prims.bool = @@ -551,7 +549,7 @@ let matches_level : fun uu___ -> match uu___ with | (assoc_levels, tokens) -> - let uu___1 = FStarC_Compiler_List.tryFind (matches_token s) tokens in + let uu___1 = FStarC_List.tryFind (matches_token s) tokens in uu___1 <> FStar_Pervasives_Native.None let (opinfix4 : associativity_level) = (Right, [Exact "**"; UnicodeOperator]) let (opinfix3 : associativity_level) = @@ -590,7 +588,7 @@ let (level_table : | Left -> (l, l, (l - Prims.int_one)) | Right -> ((l - Prims.int_one), l, l) | NonAssoc -> ((l - Prims.int_one), l, (l - Prims.int_one)) in - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___ -> match uu___ with @@ -602,7 +600,7 @@ let (assign_levels : = fun token_associativity_spec -> fun s -> - let uu___ = FStarC_Compiler_List.tryFind (matches_level s) level_table in + let uu___ = FStarC_List.tryFind (matches_level s) level_table in match uu___ with | FStar_Pervasives_Native.Some (assoc_levels, uu___1) -> assoc_levels | uu___1 -> failwith (Prims.strcat "Unrecognized operator " s) @@ -611,7 +609,7 @@ let max_level : 'uuuuu . ('uuuuu * token Prims.list) Prims.list -> Prims.int fun l -> let find_level_and_max n level = let uu___ = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | (uu___2, tokens) -> @@ -623,13 +621,12 @@ let max_level : 'uuuuu . ('uuuuu * token Prims.list) Prims.list -> Prims.int let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map token_to_string + FStarC_List.map token_to_string (FStar_Pervasives_Native.snd level) in - FStarC_Compiler_String.concat "," uu___3 in - FStarC_Compiler_Util.format1 "Undefined associativity level %s" - uu___2 in + FStarC_String.concat "," uu___3 in + FStarC_Util.format1 "Undefined associativity level %s" uu___2 in failwith uu___1 in - FStarC_Compiler_List.fold_left find_level_and_max Prims.int_zero l + FStarC_List.fold_left find_level_and_max Prims.int_zero l let (levels : Prims.string -> (Prims.int * Prims.int * Prims.int)) = fun op -> let uu___ = assign_levels level_associativity_spec op in @@ -645,7 +642,7 @@ let (is_operatorInfix0ad12 : FStarC_Ident.ident -> Prims.bool) = let uu___ = let uu___1 = let uu___2 = FStarC_Ident.string_of_id op in matches_level uu___2 in - FStarC_Compiler_List.tryFind uu___1 operatorInfix0ad12 in + FStarC_List.tryFind uu___1 operatorInfix0ad12 in uu___ <> FStar_Pervasives_Native.None let (is_operatorInfix34 : FStarC_Ident.ident -> Prims.bool) = let opinfix34 = [opinfix3; opinfix4] in @@ -653,19 +650,19 @@ let (is_operatorInfix34 : FStarC_Ident.ident -> Prims.bool) = let uu___ = let uu___1 = let uu___2 = FStarC_Ident.string_of_id op in matches_level uu___2 in - FStarC_Compiler_List.tryFind uu___1 opinfix34 in + FStarC_List.tryFind uu___1 opinfix34 in uu___ <> FStar_Pervasives_Native.None let (handleable_args_length : FStarC_Ident.ident -> Prims.int) = fun op -> let op_s = FStarC_Ident.string_of_id op in let uu___ = - (is_general_prefix_op op) || (FStarC_Compiler_List.mem op_s ["-"; "~"]) in + (is_general_prefix_op op) || (FStarC_List.mem op_s ["-"; "~"]) in if uu___ then Prims.int_one else (let uu___2 = ((is_operatorInfix0ad12 op) || (is_operatorInfix34 op)) || - (FStarC_Compiler_List.mem op_s + (FStarC_List.mem op_s ["<==>"; "==>"; "\\/"; @@ -680,25 +677,23 @@ let (handleable_args_length : FStarC_Ident.ident -> Prims.int) = if uu___2 then (Prims.of_int (2)) else - if - FStarC_Compiler_List.mem op_s - [".()<-"; ".[]<-"; ".(||)<-"; ".[||]<-"] + if FStarC_List.mem op_s [".()<-"; ".[]<-"; ".(||)<-"; ".[||]<-"] then (Prims.of_int (3)) else Prims.int_zero) let handleable_op : 'uuuuu . FStarC_Ident.ident -> 'uuuuu Prims.list -> Prims.bool = fun op -> fun args -> - match FStarC_Compiler_List.length args with + match FStarC_List.length args with | uu___ when uu___ = Prims.int_zero -> true | uu___ when uu___ = Prims.int_one -> (is_general_prefix_op op) || (let uu___1 = FStarC_Ident.string_of_id op in - FStarC_Compiler_List.mem uu___1 ["-"; "~"]) + FStarC_List.mem uu___1 ["-"; "~"]) | uu___ when uu___ = (Prims.of_int (2)) -> ((is_operatorInfix0ad12 op) || (is_operatorInfix34 op)) || (let uu___1 = FStarC_Ident.string_of_id op in - FStarC_Compiler_List.mem uu___1 + FStarC_List.mem uu___1 ["<==>"; "==>"; "\\/"; @@ -712,8 +707,7 @@ let handleable_op : ".[||]"]) | uu___ when uu___ = (Prims.of_int (3)) -> let uu___1 = FStarC_Ident.string_of_id op in - FStarC_Compiler_List.mem uu___1 - [".()<-"; ".[]<-"; ".(||)<-"; ".[||]<-"] + FStarC_List.mem uu___1 [".()<-"; ".[]<-"; ".(||)<-"; ".[||]<-"] | uu___ -> false type annotation_style = | Binders of (Prims.int * Prims.int * Prims.bool) @@ -736,9 +730,9 @@ let (all_binders_annot : FStarC_Parser_AST.term -> Prims.bool) = let rec all_binders e1 l = match e1.FStarC_Parser_AST.tm with | FStarC_Parser_AST.Product (bs, tgt) -> - let uu___ = FStarC_Compiler_List.for_all is_binder_annot bs in + let uu___ = FStarC_List.for_all is_binder_annot bs in if uu___ - then all_binders tgt (l + (FStarC_Compiler_List.length bs)) + then all_binders tgt (l + (FStarC_List.length bs)) else (false, Prims.int_zero) | uu___ -> (true, (l + Prims.int_one)) in let uu___ = all_binders e Prims.int_zero in @@ -754,16 +748,14 @@ let (cat_with_colon : let uu___ = FStarC_Pprint.op_Hat_Slash_Hat FStarC_Pprint.colon y in FStarC_Pprint.op_Hat_Hat x uu___ let (comment_stack : - (Prims.string * FStarC_Compiler_Range_Type.range) Prims.list - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref [] + (Prims.string * FStarC_Range_Type.range) Prims.list FStarC_Effect.ref) = + FStarC_Util.mk_ref [] type decl_meta = { - r: FStarC_Compiler_Range_Type.range ; + r: FStarC_Range_Type.range ; has_qs: Prims.bool ; has_attrs: Prims.bool } -let (__proj__Mkdecl_meta__item__r : - decl_meta -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mkdecl_meta__item__r : decl_meta -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { r; has_qs; has_attrs;_} -> r let (__proj__Mkdecl_meta__item__has_qs : decl_meta -> Prims.bool) = fun projectee -> match projectee with | { r; has_qs; has_attrs;_} -> has_qs @@ -771,44 +763,38 @@ let (__proj__Mkdecl_meta__item__has_attrs : decl_meta -> Prims.bool) = fun projectee -> match projectee with | { r; has_qs; has_attrs;_} -> has_attrs let (dummy_meta : decl_meta) = - { - r = FStarC_Compiler_Range_Type.dummyRange; - has_qs = false; - has_attrs = false - } + { r = FStarC_Range_Type.dummyRange; has_qs = false; has_attrs = false } let with_comment : 'uuuuu . ('uuuuu -> FStarC_Pprint.document) -> - 'uuuuu -> FStarC_Compiler_Range_Type.range -> FStarC_Pprint.document + 'uuuuu -> FStarC_Range_Type.range -> FStarC_Pprint.document = fun printer -> fun tm -> fun tmrange -> let rec comments_before_pos acc print_pos lookahead_pos = - let uu___ = FStarC_Compiler_Effect.op_Bang comment_stack in + let uu___ = FStarC_Effect.op_Bang comment_stack in match uu___ with | [] -> (acc, false) | (c, crange)::cs -> let comment = let uu___1 = str c in FStarC_Pprint.op_Hat_Hat uu___1 FStarC_Pprint.hardline in - let uu___1 = - FStarC_Compiler_Range_Ops.range_before_pos crange print_pos in + let uu___1 = FStarC_Range_Ops.range_before_pos crange print_pos in if uu___1 then - (FStarC_Compiler_Effect.op_Colon_Equals comment_stack cs; + (FStarC_Effect.op_Colon_Equals comment_stack cs; (let uu___3 = FStarC_Pprint.op_Hat_Hat acc comment in comments_before_pos uu___3 print_pos lookahead_pos)) else (let uu___3 = - FStarC_Compiler_Range_Ops.range_before_pos crange - lookahead_pos in + FStarC_Range_Ops.range_before_pos crange lookahead_pos in (acc, uu___3)) in let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Range_Ops.start_of_range tmrange in - FStarC_Compiler_Range_Ops.end_of_line uu___2 in - let uu___2 = FStarC_Compiler_Range_Ops.end_of_range tmrange in + let uu___2 = FStarC_Range_Ops.start_of_range tmrange in + FStarC_Range_Ops.end_of_line uu___2 in + let uu___2 = FStarC_Range_Ops.end_of_range tmrange in comments_before_pos FStarC_Pprint.empty uu___1 uu___2 in match uu___ with | (comments, has_lookahead) -> @@ -816,7 +802,7 @@ let with_comment : let comments1 = if has_lookahead then - let pos = FStarC_Compiler_Range_Ops.end_of_range tmrange in + let pos = FStarC_Range_Ops.end_of_range tmrange in let uu___1 = comments_before_pos comments pos pos in FStar_Pervasives_Native.fst uu___1 else comments in @@ -828,24 +814,21 @@ let with_comment : let with_comment_sep : 'uuuuu 'uuuuu1 . ('uuuuu -> 'uuuuu1) -> - 'uuuuu -> - FStarC_Compiler_Range_Type.range -> - (FStarC_Pprint.document * 'uuuuu1) + 'uuuuu -> FStarC_Range_Type.range -> (FStarC_Pprint.document * 'uuuuu1) = fun printer -> fun tm -> fun tmrange -> let rec comments_before_pos acc print_pos lookahead_pos = - let uu___ = FStarC_Compiler_Effect.op_Bang comment_stack in + let uu___ = FStarC_Effect.op_Bang comment_stack in match uu___ with | [] -> (acc, false) | (c, crange)::cs -> let comment = str c in - let uu___1 = - FStarC_Compiler_Range_Ops.range_before_pos crange print_pos in + let uu___1 = FStarC_Range_Ops.range_before_pos crange print_pos in if uu___1 then - (FStarC_Compiler_Effect.op_Colon_Equals comment_stack cs; + (FStarC_Effect.op_Colon_Equals comment_stack cs; (let uu___3 = if acc = FStarC_Pprint.empty then comment @@ -857,14 +840,13 @@ let with_comment_sep : comments_before_pos uu___3 print_pos lookahead_pos)) else (let uu___3 = - FStarC_Compiler_Range_Ops.range_before_pos crange - lookahead_pos in + FStarC_Range_Ops.range_before_pos crange lookahead_pos in (acc, uu___3)) in let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Range_Ops.start_of_range tmrange in - FStarC_Compiler_Range_Ops.end_of_line uu___2 in - let uu___2 = FStarC_Compiler_Range_Ops.end_of_range tmrange in + let uu___2 = FStarC_Range_Ops.start_of_range tmrange in + FStarC_Range_Ops.end_of_line uu___2 in + let uu___2 = FStarC_Range_Ops.end_of_range tmrange in comments_before_pos FStarC_Pprint.empty uu___1 uu___2 in match uu___ with | (comments, has_lookahead) -> @@ -872,7 +854,7 @@ let with_comment_sep : let comments1 = if has_lookahead then - let pos = FStarC_Compiler_Range_Ops.end_of_range tmrange in + let pos = FStarC_Range_Ops.end_of_range tmrange in let uu___1 = comments_before_pos comments pos pos in FStar_Pervasives_Native.fst uu___1 else comments in @@ -880,7 +862,7 @@ let with_comment_sep : let rec (place_comments_until_pos : Prims.int -> Prims.int -> - FStarC_Compiler_Range_Type.pos -> + FStarC_Range_Type.pos -> decl_meta -> FStarC_Pprint.document -> Prims.bool -> Prims.bool -> FStarC_Pprint.document) @@ -892,17 +874,17 @@ let rec (place_comments_until_pos : fun doc -> fun r -> fun init -> - let uu___ = FStarC_Compiler_Effect.op_Bang comment_stack in + let uu___ = FStarC_Effect.op_Bang comment_stack in match uu___ with | (comment, crange)::cs when - FStarC_Compiler_Range_Ops.range_before_pos crange pos -> - (FStarC_Compiler_Effect.op_Colon_Equals comment_stack cs; + FStarC_Range_Ops.range_before_pos crange pos -> + (FStarC_Effect.op_Colon_Equals comment_stack cs; (let lnum = let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_Range_Ops.start_of_range crange in - FStarC_Compiler_Range_Ops.line_of_pos uu___4 in + FStarC_Range_Ops.start_of_range crange in + FStarC_Range_Ops.line_of_pos uu___4 in uu___3 - lbegin in max k uu___2 in let lnum1 = min (Prims.of_int (2)) lnum in @@ -914,9 +896,8 @@ let rec (place_comments_until_pos : FStarC_Pprint.op_Hat_Hat uu___3 uu___4 in FStarC_Pprint.op_Hat_Hat doc uu___2 in let uu___2 = - let uu___3 = - FStarC_Compiler_Range_Ops.end_of_range crange in - FStarC_Compiler_Range_Ops.line_of_pos uu___3 in + let uu___3 = FStarC_Range_Ops.end_of_range crange in + FStarC_Range_Ops.line_of_pos uu___3 in place_comments_until_pos Prims.int_one uu___2 pos meta_decl doc1 true init)) | uu___1 -> @@ -924,8 +905,7 @@ let rec (place_comments_until_pos : then FStarC_Pprint.empty else (let lnum = - let uu___3 = - FStarC_Compiler_Range_Ops.line_of_pos pos in + let uu___3 = FStarC_Range_Ops.line_of_pos pos in uu___3 - lbegin in let lnum1 = min (Prims.of_int (3)) lnum in let lnum2 = @@ -960,33 +940,32 @@ let separate_map_with_comments : let meta_decl = extract_meta x in let r = meta_decl.r in let doc1 = - let uu___1 = FStarC_Compiler_Range_Ops.start_of_range r in + let uu___1 = FStarC_Range_Ops.start_of_range r in place_comments_until_pos Prims.int_one last_line uu___1 meta_decl doc false false in let uu___1 = - let uu___2 = FStarC_Compiler_Range_Ops.end_of_range r in - FStarC_Compiler_Range_Ops.line_of_pos uu___2 in + let uu___2 = FStarC_Range_Ops.end_of_range r in + FStarC_Range_Ops.line_of_pos uu___2 in let uu___2 = let uu___3 = let uu___4 = f x in FStarC_Pprint.op_Hat_Hat sep uu___4 in FStarC_Pprint.op_Hat_Hat doc1 uu___3 in (uu___1, uu___2) in let uu___ = - let uu___1 = FStarC_Compiler_List.hd xs in - let uu___2 = FStarC_Compiler_List.tl xs in (uu___1, uu___2) in + let uu___1 = FStarC_List.hd xs in + let uu___2 = FStarC_List.tl xs in (uu___1, uu___2) in match uu___ with | (x, xs1) -> let init = let meta_decl = extract_meta x in let uu___1 = - let uu___2 = - FStarC_Compiler_Range_Ops.end_of_range meta_decl.r in - FStarC_Compiler_Range_Ops.line_of_pos uu___2 in + let uu___2 = FStarC_Range_Ops.end_of_range meta_decl.r in + FStarC_Range_Ops.line_of_pos uu___2 in let uu___2 = let uu___3 = f x in FStarC_Pprint.op_Hat_Hat prefix uu___3 in (uu___1, uu___2) in - let uu___1 = FStarC_Compiler_List.fold_left fold_fun init xs1 in + let uu___1 = FStarC_List.fold_left fold_fun init xs1 in FStar_Pervasives_Native.snd uu___1 let separate_map_with_comments_kw : 'uuuuu 'uuuuu1 . @@ -1007,29 +986,28 @@ let separate_map_with_comments_kw : let meta_decl = extract_meta x in let r = meta_decl.r in let doc1 = - let uu___1 = FStarC_Compiler_Range_Ops.start_of_range r in + let uu___1 = FStarC_Range_Ops.start_of_range r in place_comments_until_pos Prims.int_one last_line uu___1 meta_decl doc false false in let uu___1 = - let uu___2 = FStarC_Compiler_Range_Ops.end_of_range r in - FStarC_Compiler_Range_Ops.line_of_pos uu___2 in + let uu___2 = FStarC_Range_Ops.end_of_range r in + FStarC_Range_Ops.line_of_pos uu___2 in let uu___2 = let uu___3 = f sep x in FStarC_Pprint.op_Hat_Hat doc1 uu___3 in (uu___1, uu___2) in let uu___ = - let uu___1 = FStarC_Compiler_List.hd xs in - let uu___2 = FStarC_Compiler_List.tl xs in (uu___1, uu___2) in + let uu___1 = FStarC_List.hd xs in + let uu___2 = FStarC_List.tl xs in (uu___1, uu___2) in match uu___ with | (x, xs1) -> let init = let meta_decl = extract_meta x in let uu___1 = - let uu___2 = - FStarC_Compiler_Range_Ops.end_of_range meta_decl.r in - FStarC_Compiler_Range_Ops.line_of_pos uu___2 in + let uu___2 = FStarC_Range_Ops.end_of_range meta_decl.r in + FStarC_Range_Ops.line_of_pos uu___2 in let uu___2 = f prefix x in (uu___1, uu___2) in - let uu___1 = FStarC_Compiler_List.fold_left fold_fun init xs1 in + let uu___1 = FStarC_List.fold_left fold_fun init xs1 in FStar_Pervasives_Native.snd uu___1 let p_lidentOrOperator' : 'uuuuu . @@ -1041,7 +1019,7 @@ let p_lidentOrOperator' : fun s_l -> fun p_l -> let lstr = s_l l in - if FStarC_Compiler_Util.starts_with lstr "op_" + if FStarC_Util.starts_with lstr "op_" then let uu___ = FStarC_Parser_AST.string_to_op lstr in match uu___ with @@ -1074,7 +1052,7 @@ let (p_char_literal' : | 11 -> "\\v" | 0 -> "\\0" | c1 -> - let s = FStarC_Compiler_Util.string_of_char c1 in + let s = FStarC_Util.string_of_char c1 in if quote_char = c1 then Prims.strcat "\\" s else s) let (p_char_literal : FStarC_BaseTypes.char -> FStarC_Pprint.document) = fun c -> let uu___ = p_char_literal' 39 c in FStarC_Pprint.squotes uu___ @@ -1090,8 +1068,7 @@ let (string_of_id_or_underscore : fun lid -> let uu___ = (let uu___1 = FStarC_Ident.string_of_id lid in - FStarC_Compiler_Util.starts_with uu___1 FStarC_Ident.reserved_prefix) - && + FStarC_Util.starts_with uu___1 FStarC_Ident.reserved_prefix) && (let uu___1 = FStarC_Options.print_real_names () in Prims.op_Negation uu___1) in if uu___ @@ -1104,8 +1081,7 @@ let (text_of_lid_or_underscore : (let uu___1 = let uu___2 = FStarC_Ident.ident_of_lid lid in FStarC_Ident.string_of_id uu___2 in - FStarC_Compiler_Util.starts_with uu___1 FStarC_Ident.reserved_prefix) - && + FStarC_Util.starts_with uu___1 FStarC_Ident.reserved_prefix) && (let uu___1 = FStarC_Options.print_real_names () in Prims.op_Negation uu___1) in if uu___ @@ -1136,8 +1112,8 @@ let rec (p_decl : FStarC_Parser_AST.decl -> FStarC_Pprint.document) = let uu___1 = let uu___2 = let uu___3 = FStarC_Ident.string_of_id id in - FStarC_Compiler_Util.char_at uu___3 Prims.int_zero in - FStarC_Compiler_Util.is_upper uu___2 in + FStarC_Util.char_at uu___3 Prims.int_zero in + FStarC_Util.is_upper uu___2 in if uu___1 then let uu___2 = p_qualifier FStarC_Parser_AST.Assumption in @@ -1163,8 +1139,8 @@ and (p_attributes : let uu___6 = let uu___7 = str "; " in let uu___8 = - FStarC_Compiler_List.map - (p_noSeqTermAndComment false false) attrs in + FStarC_List.map (p_noSeqTermAndComment false false) + attrs in FStarC_Pprint.flow uu___7 uu___8 in FStarC_Pprint.op_Hat_Hat uu___6 FStarC_Pprint.rbracket in FStarC_Pprint.align uu___5 in @@ -1308,10 +1284,9 @@ and (p_rawDecl : FStarC_Parser_AST.decl -> FStarC_Pprint.document) = | FStarC_Parser_AST.Tycon (false, tc, tcdefs) -> let s = if tc then str "class" else str "type" in let uu___ = - let uu___1 = FStarC_Compiler_List.hd tcdefs in - p_typeDeclWithKw s uu___1 in + let uu___1 = FStarC_List.hd tcdefs in p_typeDeclWithKw s uu___1 in let uu___1 = - let uu___2 = FStarC_Compiler_List.tl tcdefs in + let uu___2 = FStarC_List.tl tcdefs in FStarC_Pprint.concat_map (fun x -> let uu___3 = @@ -1329,8 +1304,8 @@ and (p_rawDecl : FStarC_Parser_AST.decl -> FStarC_Pprint.document) = match uu___1 with | (p, t) -> let uu___2 = - FStarC_Compiler_Range_Ops.union_ranges - p.FStarC_Parser_AST.prange t.FStarC_Parser_AST.range in + FStarC_Range_Ops.union_ranges p.FStarC_Parser_AST.prange + t.FStarC_Parser_AST.range in { r = uu___2; has_qs = false; has_attrs = false }) | FStarC_Parser_AST.Val (lid, t) -> let uu___ = @@ -1348,8 +1323,8 @@ and (p_rawDecl : FStarC_Parser_AST.decl -> FStarC_Pprint.document) = let uu___ = let uu___1 = let uu___2 = FStarC_Ident.string_of_id id in - FStarC_Compiler_Util.char_at uu___2 Prims.int_zero in - FStarC_Compiler_Util.is_upper uu___1 in + FStarC_Util.char_at uu___2 Prims.int_zero in + FStarC_Util.is_upper uu___1 in if uu___ then FStarC_Pprint.empty else @@ -1554,7 +1529,7 @@ and (p_typeDecl : let uu___2 = let uu___3 = FStarC_Ident.range_of_id uid in let uu___4 = - FStarC_Compiler_Util.bind_opt payload + FStarC_Util.bind_opt payload (fun uu___5 -> match uu___5 with | FStarC_Parser_AST.VpOfNotation t -> @@ -1565,8 +1540,8 @@ and (p_typeDecl : (t.FStarC_Parser_AST.range) | FStarC_Parser_AST.VpRecord (record, uu___6) -> FStar_Pervasives_Native.None) in - FStarC_Compiler_Util.dflt uu___3 uu___4 in - FStarC_Compiler_Range_Ops.extend_to_end_of_line uu___2 in + FStarC_Util.dflt uu___3 uu___4 in + FStarC_Range_Ops.extend_to_end_of_line uu___2 in let uu___2 = with_comment_sep p_constructorBranch (uid, payload, attrs) range in @@ -1586,7 +1561,7 @@ and (p_typeDeclRecord : | (lid, aq, attrs, t) -> let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.extend_to_end_of_line + FStarC_Range_Ops.extend_to_end_of_line t.FStarC_Parser_AST.range in with_comment_sep (p_recordFieldDecl ps) (lid, aq, attrs, t) uu___2 in @@ -1932,7 +1907,7 @@ and (p_effectDecl : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Parser_AST.showable_decl d in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Not a declaration of an effect member... or at least I hope so : %s" uu___2 in failwith uu___1 @@ -1999,7 +1974,7 @@ and (p_qualifiers : FStarC_Parser_AST.qualifiers -> FStarC_Pprint.document) = FStarC_Pprint.op_Hat_Hat uu___ FStarC_Pprint.hardline | uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map p_qualifier qs in + let uu___2 = FStarC_List.map p_qualifier qs in FStarC_Pprint.flow break1 uu___2 in FStarC_Pprint.op_Hat_Hat uu___1 FStarC_Pprint.hardline and (p_letqualifier : @@ -2218,7 +2193,7 @@ and (p_atomicPattern : FStarC_Parser_AST.pattern -> FStarC_Pprint.document) = | uu___ -> let uu___1 = let uu___2 = FStarC_Parser_AST.pat_to_string p in - FStarC_Compiler_Util.format1 "Invalid pattern %s" uu___2 in + FStarC_Util.format1 "Invalid pattern %s" uu___2 in failwith uu___1 and (is_typ_tuple : FStarC_Parser_AST.term -> Prims.bool) = fun e -> @@ -2427,8 +2402,7 @@ and (p_refinement' : and (p_binders_list : Prims.bool -> FStarC_Parser_AST.binder Prims.list -> FStarC_Pprint.document Prims.list) - = - fun is_atomic -> fun bs -> FStarC_Compiler_List.map (p_binder is_atomic) bs + = fun is_atomic -> fun bs -> FStarC_List.map (p_binder is_atomic) bs and (p_binders : Prims.bool -> FStarC_Parser_AST.binder Prims.list -> FStarC_Pprint.document) = @@ -2746,11 +2720,11 @@ and (p_noSeqTerm' : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.map_opt op_opt + FStarC_Util.map_opt op_opt FStarC_Ident.string_of_id in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (FStarC_Parser_AST.strip_prefix "let") in - FStarC_Compiler_Util.dflt "" uu___5 in + FStarC_Util.dflt "" uu___5 in Prims.strcat "if" uu___4 in str uu___3 in let uu___3 = p_noSeqTermAndComment false false e1 in @@ -2843,11 +2817,10 @@ and (p_noSeqTerm' : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_Util.map_opt op_opt - FStarC_Ident.string_of_id in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.map_opt op_opt FStarC_Ident.string_of_id in + FStarC_Util.bind_opt uu___3 (FStarC_Parser_AST.strip_prefix "let") in - FStarC_Compiler_Util.dflt "" uu___2 in + FStarC_Util.dflt "" uu___2 in Prims.strcat "match" uu___1 in str uu___ in let uu___ = @@ -2936,7 +2909,7 @@ and (p_noSeqTerm' : let uu___3 = FStarC_Ident.string_of_id pid in let uu___4 = let uu___5 = FStarC_Ident.path_of_lid tid in - FStarC_Compiler_List.last uu___5 in + FStarC_List.last uu___5 in uu___3 = uu___4 -> let uu___3 = if is_last then str "in" else FStarC_Pprint.empty in @@ -2946,7 +2919,7 @@ and (p_noSeqTerm' : let uu___3 = FStarC_Ident.string_of_id pid in let uu___4 = let uu___5 = FStarC_Ident.path_of_lid tid in - FStarC_Compiler_List.last uu___5 in + FStarC_List.last uu___5 in uu___3 = uu___4 -> let uu___3 = if is_last then str "in" else FStarC_Pprint.empty in @@ -2971,9 +2944,9 @@ and (p_noSeqTerm' : FStarC_Pprint.flow break1 [doc_pat; FStarC_Pprint.equals; doc_expr1] in FStarC_Pprint.hang (Prims.of_int (2)) uu___4))) in - let l = FStarC_Compiler_List.length lets in + let l = FStarC_List.length lets in let lets_docs = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun lb -> let uu___ = p_let lb (i = (l - Prims.int_one)) in @@ -3029,9 +3002,9 @@ and (p_noSeqTerm' : [doc_pat; FStarC_Pprint.equals; doc_expr1] in FStarC_Pprint.hang (Prims.of_int (2)) uu___4) in FStarC_Pprint.op_Hat_Hat attrs uu___2) in - let l = FStarC_Compiler_List.length lbs in + let l = FStarC_List.length lbs in let lbs_docs = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun lb -> if i = Prims.int_zero @@ -3773,10 +3746,8 @@ and (collapse_pats : (match uu___1 with | (b2s, t2, tc2, j2) -> if ((t1 = t2) && j1) && j2 - then - ((FStarC_Compiler_List.op_At b2s [b1]), t1, false, - true) - :: tl + then ((FStarC_List.op_At b2s [b1]), t1, false, true) :: + tl else ([b1], t1, tc1, j1) :: hd :: tl)) in let p_collapsed_binder cb = let uu___ = cb in @@ -3787,7 +3758,7 @@ and (collapse_pats : | [] -> failwith "Impossible" | hd::tl -> let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun x -> fun y -> let uu___3 = @@ -3795,9 +3766,7 @@ and (collapse_pats : FStarC_Pprint.op_Hat_Hat x uu___3) hd tl in cat_with_colon uu___2 typ in if istcarg then tc_arg body else soft_parens_with_nesting body in - let binders = - FStarC_Compiler_List.fold_left fold_fun [] - (FStarC_Compiler_List.rev pats) in + let binders = FStarC_List.fold_left fold_fun [] (FStarC_List.rev pats) in map_rev p_collapsed_binder binders and (pats_as_binders_if_possible : FStarC_Parser_AST.pattern Prims.list -> @@ -3856,7 +3825,7 @@ and (pats_as_binders_if_possible : let uu___1 = collapse_pats bs in (uu___1, (Binders ((Prims.of_int (4)), Prims.int_zero, true))) | FStar_Pervasives_Native.None -> - let uu___1 = FStarC_Compiler_List.map p_atomicPattern pats in + let uu___1 = FStarC_List.map p_atomicPattern pats in (uu___1, (Binders ((Prims.of_int (4)), Prims.int_zero, false))) and (p_quantifier : FStarC_Parser_AST.term -> FStarC_Pprint.document) = fun e -> @@ -4028,7 +3997,7 @@ and (p_patternBranch : else op_Hat_Slash_Plus_Hat branch doc in (match pat.FStarC_Parser_AST.pat with | FStarC_Parser_AST.PatOr pats -> - (match FStarC_Compiler_List.rev pats with + (match FStarC_List.rev pats with | hd::tl -> let last_pat_branch = one_pattern_branch hd in let uu___1 = @@ -4041,7 +4010,7 @@ and (p_patternBranch : FStarC_Pprint.space in FStarC_Pprint.op_Hat_Hat break1 uu___6 in FStarC_Pprint.separate_map uu___5 p_tuplePattern - (FStarC_Compiler_List.rev tl) in + (FStarC_List.rev tl) in FStarC_Pprint.op_Hat_Slash_Hat uu___4 last_pat_branch in FStarC_Pprint.op_Hat_Hat FStarC_Pprint.space uu___3 in @@ -4103,7 +4072,7 @@ and (format_sig : | (n, last_n, sep, last_op) -> let last_op1 = if - ((FStarC_Compiler_List.length terms) > Prims.int_zero) && + ((FStarC_List.length terms) > Prims.int_zero) && (Prims.op_Negation no_last_op) then last_op else FStarC_Pprint.empty in @@ -4119,7 +4088,7 @@ and (format_sig : if flat_space then FStarC_Pprint.space else FStarC_Pprint.empty in - (match FStarC_Compiler_List.length terms with + (match FStarC_List.length terms with | uu___1 when uu___1 = Prims.int_zero -> ret_d | uu___1 -> let uu___2 = @@ -4145,7 +4114,7 @@ and (format_sig : FStarC_Pprint.op_Hat_Hat sep single_line_arg_indent in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___13 = FStarC_Pprint.hang @@ -4191,11 +4160,10 @@ and (p_tmArrow' : fun e -> match e.FStarC_Parser_AST.tm with | FStarC_Parser_AST.Product (bs, tgt) -> - let bs_ds = FStarC_Compiler_List.map (fun b -> p_binder false b) bs in + let bs_ds = FStarC_List.map (fun b -> p_binder false b) bs in let uu___ = p_tmArrow' p_Tm tgt in (match uu___ with - | (bs_ds', ret) -> - ((FStarC_Compiler_List.op_At bs_ds bs_ds'), ret)) + | (bs_ds', ret) -> ((FStarC_List.op_At bs_ds bs_ds'), ret)) | uu___ -> let uu___1 = p_Tm e in ([], uu___1) and (collapse_binders : annotation_style -> @@ -4216,7 +4184,7 @@ and (collapse_binders : match e1.FStarC_Parser_AST.tm with | FStarC_Parser_AST.Product (bs, tgt) -> let bs_ds = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___ = p_binder' true false b in let uu___1 = is_tc_binder b in @@ -4224,8 +4192,7 @@ and (collapse_binders : (uu___, uu___1, uu___2)) bs in let uu___ = accumulate_binders p_Tm1 tgt in (match uu___ with - | (bs_ds', ret) -> - ((FStarC_Compiler_List.op_At bs_ds bs_ds'), ret)) + | (bs_ds', ret) -> ((FStarC_List.op_At bs_ds bs_ds'), ret)) | uu___ -> let uu___1 = p_Tm1 e1 in ([], uu___1) in let fold_fun bs x = let uu___ = x in @@ -4241,8 +4208,7 @@ and (collapse_binders : | (FStar_Pervasives_Native.Some (typ1, catf1), FStar_Pervasives_Native.Some (typ2, uu___2)) when ((typ1 = typ2) && j1) && j2 -> - ((FStarC_Compiler_List.op_At b2s [b1]), t1, - false, true) + ((FStarC_List.op_At b2s [b1]), t1, false, true) :: tl | uu___2 -> ([b1], t1, tc1, j1) :: bs))) in let p_collapsed_binder cb = @@ -4260,7 +4226,7 @@ and (collapse_binders : | hd::tl -> let uu___2 = let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun x -> fun y -> let uu___4 = @@ -4272,7 +4238,7 @@ and (collapse_binders : let uu___ = accumulate_binders p_Tm e in match uu___ with | (bs_ds, ret_d) -> - let binders = FStarC_Compiler_List.fold_left fold_fun [] bs_ds in + let binders = FStarC_List.fold_left fold_fun [] bs_ds in let uu___1 = map_rev p_collapsed_binder binders in (uu___1, ret_d) and (p_tmFormula : FStarC_Parser_AST.term -> FStarC_Pprint.document) = @@ -4298,7 +4264,7 @@ and (p_tmDisjunction : let uu___ = FStarC_Ident.string_of_id id in uu___ = "\\/" -> let uu___ = p_tmDisjunction e1 in let uu___1 = let uu___2 = p_tmConjunction e2 in [uu___2] in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___ uu___1 | uu___ -> let uu___1 = p_tmConjunction e in [uu___1] and (p_tmConjunction : FStarC_Parser_AST.term -> FStarC_Pprint.document Prims.list) = @@ -4308,7 +4274,7 @@ and (p_tmConjunction : let uu___ = FStarC_Ident.string_of_id id in uu___ = "/\\" -> let uu___ = p_tmConjunction e1 in let uu___1 = let uu___2 = p_tmTuple e2 in [uu___2] in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___ uu___1 | uu___ -> let uu___1 = p_tmTuple e in [uu___1] and (p_tmTuple : FStarC_Parser_AST.term -> FStarC_Pprint.document) = fun e -> with_comment p_tmTuple' e e.FStarC_Parser_AST.range @@ -4342,8 +4308,7 @@ and (p_tmEqWith : fun e -> let n = max_level - (FStarC_Compiler_List.op_At [colon_equals; pipe_right] - operatorInfix0ad12) in + (FStarC_List.op_At [colon_equals; pipe_right] operatorInfix0ad12) in p_tmEqWith' p_X n e and (p_tmEqWith' : (FStarC_Parser_AST.term -> FStarC_Pprint.document) -> @@ -4552,14 +4517,14 @@ and (p_refinedBinder : | FStarC_Parser_AST.TVariable uu___ -> let uu___1 = let uu___2 = FStarC_Parser_AST.binder_to_string b in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: a refined binder ought to be annotated (%s)" uu___2 in failwith uu___1 | FStarC_Parser_AST.NoName uu___ -> let uu___1 = let uu___2 = FStarC_Parser_AST.binder_to_string b in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: a refined binder ought to be annotated (%s)" uu___2 in failwith uu___1 @@ -4872,8 +4837,7 @@ and (p_projectionLHS : FStarC_Parser_AST.term -> FStarC_Pprint.document) = let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length args) in + FStarC_Util.string_of_int (FStarC_List.length args) in Prims.strcat uu___5 " arguments couldn't be handled by the pretty printer" in Prims.strcat " with " uu___4 in @@ -5001,8 +4965,7 @@ and (p_constant : FStarC_Const.sconst -> FStarC_Pprint.document) = | FStarC_Const.Const_range_of -> str "range_of" | FStarC_Const.Const_set_range_of -> str "set_range_of" | FStarC_Const.Const_range r -> - let uu___1 = FStarC_Compiler_Range_Ops.string_of_range r in - str uu___1 + let uu___1 = FStarC_Range_Ops.string_of_range r in str uu___1 | FStarC_Const.Const_reify uu___1 -> str "reify" | FStarC_Const.Const_reflect lid -> let uu___1 = p_quident lid in @@ -5049,8 +5012,8 @@ and (p_universeFrom : FStarC_Parser_AST.term -> FStarC_Pprint.document) = | uu___2 -> let uu___3 = let uu___4 = FStarC_Parser_AST.term_to_string u in - FStarC_Compiler_Util.format1 - "Invalid term in universe context %s" uu___4 in + FStarC_Util.format1 "Invalid term in universe context %s" + uu___4 in failwith uu___3)) | uu___ -> p_atomicUniverse u and (p_atomicUniverse : FStarC_Parser_AST.term -> FStarC_Pprint.document) = @@ -5071,8 +5034,7 @@ and (p_atomicUniverse : FStarC_Parser_AST.term -> FStarC_Pprint.document) = | uu___ -> let uu___1 = let uu___2 = FStarC_Parser_AST.term_to_string u in - FStarC_Compiler_Util.format1 "Invalid term in universe context %s" - uu___2 in + FStarC_Util.format1 "Invalid term in universe context %s" uu___2 in failwith uu___1 let (term_to_document : FStarC_Parser_AST.term -> FStarC_Pprint.document) = fun e -> p_term false false e @@ -5088,13 +5050,13 @@ let (modul_to_document : FStarC_Parser_AST.modul -> FStarC_Pprint.document) = fun m -> match m with | FStarC_Parser_AST.Module (uu___, decls) -> - let uu___1 = FStarC_Compiler_List.map decl_to_document decls in + let uu___1 = FStarC_List.map decl_to_document decls in FStarC_Pprint.separate FStarC_Pprint.hardline uu___1 | FStarC_Parser_AST.Interface (uu___, decls, uu___1) -> - let uu___2 = FStarC_Compiler_List.map decl_to_document decls in + let uu___2 = FStarC_List.map decl_to_document decls in FStarC_Pprint.separate FStarC_Pprint.hardline uu___2 let (comments_to_document : - (Prims.string * FStarC_Compiler_Range_Type.range) Prims.list -> + (Prims.string * FStarC_Range_Type.range) Prims.list -> FStarC_Pprint.document) = fun comments -> @@ -5113,14 +5075,13 @@ let (extract_decl_range : FStarC_Parser_AST.decl -> decl_meta) = r = (d.FStarC_Parser_AST.drange); has_qs; has_attrs = - (Prims.op_Negation - (FStarC_Compiler_List.isEmpty d.FStarC_Parser_AST.attrs)) + (Prims.op_Negation (FStarC_List.isEmpty d.FStarC_Parser_AST.attrs)) } let (decls_with_comments_to_document : FStarC_Parser_AST.decl Prims.list -> - (Prims.string * FStarC_Compiler_Range_Type.range) Prims.list -> - (FStarC_Pprint.document * (Prims.string * - FStarC_Compiler_Range_Type.range) Prims.list)) + (Prims.string * FStarC_Range_Type.range) Prims.list -> + (FStarC_Pprint.document * (Prims.string * FStarC_Range_Type.range) + Prims.list)) = fun decls -> fun comments -> @@ -5130,24 +5091,23 @@ let (decls_with_comments_to_document : let uu___ = ((d :: ds), (d.FStarC_Parser_AST.drange)) in (match uu___ with | (decls1, first_range) -> - (FStarC_Compiler_Effect.op_Colon_Equals comment_stack comments; + (FStarC_Effect.op_Colon_Equals comment_stack comments; (let initial_comment = - let uu___2 = - FStarC_Compiler_Range_Ops.start_of_range first_range in + let uu___2 = FStarC_Range_Ops.start_of_range first_range in place_comments_until_pos Prims.int_zero Prims.int_one uu___2 dummy_meta FStarC_Pprint.empty false true in let doc = separate_map_with_comments FStarC_Pprint.empty FStarC_Pprint.empty p_decl decls1 extract_decl_range in - let comments1 = FStarC_Compiler_Effect.op_Bang comment_stack in - FStarC_Compiler_Effect.op_Colon_Equals comment_stack []; + let comments1 = FStarC_Effect.op_Bang comment_stack in + FStarC_Effect.op_Colon_Equals comment_stack []; (let uu___3 = FStarC_Pprint.op_Hat_Hat initial_comment doc in (uu___3, comments1))))) let (modul_with_comments_to_document : FStarC_Parser_AST.modul -> - (Prims.string * FStarC_Compiler_Range_Type.range) Prims.list -> - (FStarC_Pprint.document * (Prims.string * - FStarC_Compiler_Range_Type.range) Prims.list)) + (Prims.string * FStarC_Range_Type.range) Prims.list -> + (FStarC_Pprint.document * (Prims.string * FStarC_Range_Type.range) + Prims.list)) = fun m -> fun comments -> @@ -5158,7 +5118,7 @@ let (modul_with_comments_to_document : decls_with_comments_to_document decls comments let (decl_with_comments_to_document : FStarC_Parser_AST.decl -> - (Prims.string * FStarC_Compiler_Range_Type.range) Prims.list -> - (FStarC_Pprint.document * (Prims.string * - FStarC_Compiler_Range_Type.range) Prims.list)) + (Prims.string * FStarC_Range_Type.range) Prims.list -> + (FStarC_Pprint.document * (Prims.string * FStarC_Range_Type.range) + Prims.list)) = fun d -> fun comments -> decls_with_comments_to_document [d] comments \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Path.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Path.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Compiler_Path.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Path.ml diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_Platform.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Platform.ml new file mode 100644 index 00000000000..c22ef52757c --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Platform.ml @@ -0,0 +1,20 @@ +open Prims +let (showable_sys : FStarC_Platform_Base.sys FStarC_Class_Show.showable) = + { + FStarC_Class_Show.show = + (fun uu___ -> + match uu___ with + | FStarC_Platform_Base.Unix -> "Unix" + | FStarC_Platform_Base.Win32 -> "Win32" + | FStarC_Platform_Base.Cygwin -> "Cygwin") + } +let (windows : Prims.bool) = + FStarC_Platform_Base.system = FStarC_Platform_Base.Win32 +let (cygwin : Prims.bool) = + FStarC_Platform_Base.system = FStarC_Platform_Base.Cygwin +let (unix : Prims.bool) = + (FStarC_Platform_Base.system = FStarC_Platform_Base.Unix) || + (FStarC_Platform_Base.system = FStarC_Platform_Base.Cygwin) +let (exe : Prims.string -> Prims.string) = + fun s -> if windows then Prims.strcat s ".exe" else s +let (ocamlpath_sep : Prims.string) = if windows then ";" else ":" \ No newline at end of file diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_Plugins.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Plugins.ml new file mode 100644 index 00000000000..d1fe6f9e4a1 --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Plugins.ml @@ -0,0 +1,200 @@ +open Prims +let (loaded : Prims.string Prims.list FStarC_Effect.ref) = + FStarC_Util.mk_ref [] +let (loaded_plugin_lib : Prims.bool FStarC_Effect.ref) = + FStarC_Util.mk_ref false +let (pout : Prims.string -> unit) = + fun s -> + let uu___ = FStarC_Debug.any () in + if uu___ then FStarC_Util.print_string s else () +let (pout1 : Prims.string -> Prims.string -> unit) = + fun s -> + fun x -> + let uu___ = FStarC_Debug.any () in + if uu___ then FStarC_Util.print1 s x else () +let (perr : Prims.string -> unit) = + fun s -> + let uu___ = FStarC_Debug.any () in + if uu___ then FStarC_Util.print_error s else () +let (perr1 : Prims.string -> Prims.string -> unit) = + fun s -> + fun x -> + let uu___ = FStarC_Debug.any () in + if uu___ then FStarC_Util.print1_error s x else () +let (do_dynlink : Prims.string -> unit) = + fun fname -> + try + (fun uu___ -> + match () with | () -> FStarC_Plugins_Base.dynlink_loadfile fname) () + with + | FStarC_Plugins_Base.DynlinkError e -> + ((let uu___2 = + let uu___3 = + let uu___4 = + FStarC_Util.format1 "Failed to load plugin file %s" fname in + FStarC_Errors_Msg.text uu___4 in + let uu___4 = + let uu___5 = + let uu___6 = FStarC_Errors_Msg.text "Reason:" in + let uu___7 = FStarC_Errors_Msg.text e in + FStarC_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___6 + uu___7 in + let uu___6 = + let uu___7 = + let uu___8 = + let uu___9 = + let uu___10 = + FStarC_Errors.errno + FStarC_Errors_Codes.Error_PluginDynlink in + FStarC_Class_Show.show FStarC_Class_Show.showable_int + uu___10 in + FStarC_Util.format1 + "Remove the `--load` option or use `--warn_error -%s` to ignore and continue." + uu___9 in + FStarC_Errors_Msg.text uu___8 in + [uu___7] in + uu___5 :: uu___6 in + uu___3 :: uu___4 in + FStarC_Errors.log_issue0 FStarC_Errors_Codes.Error_PluginDynlink () + (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) + (Obj.magic uu___2)); + FStarC_Errors.stop_if_err ()) +let (dynlink : Prims.string -> unit) = + fun fname -> + let uu___ = + let uu___1 = FStarC_Effect.op_Bang loaded in + FStarC_List.mem fname uu___1 in + if uu___ + then pout1 "Plugin %s already loaded, skipping\n" fname + else + (pout (Prims.strcat "Attempting to load " (Prims.strcat fname "\n")); + do_dynlink fname; + (let uu___5 = + let uu___6 = FStarC_Effect.op_Bang loaded in fname :: uu___6 in + FStarC_Effect.op_Colon_Equals loaded uu___5); + pout1 "Loaded %s\n" fname) +let (load_plugin : Prims.string -> unit) = + fun tac -> + (let uu___1 = + let uu___2 = FStarC_Effect.op_Bang loaded_plugin_lib in + Prims.op_Negation uu___2 in + if uu___1 + then + (pout "Loading fstar.pluginlib before first plugin\n"; + (let uu___4 = + let uu___5 = + let uu___6 = FStarC_Util.get_exec_dir () in + Prims.strcat uu___6 + "/../lib/fstar/pluginlib/fstar_pluginlib.cmxs" in + FStarC_Util.normalize_file_path uu___5 in + do_dynlink uu___4); + pout "Loaded fstar.pluginlib OK\n"; + FStarC_Effect.op_Colon_Equals loaded_plugin_lib true) + else ()); + dynlink tac +let (load_plugins : Prims.string Prims.list -> unit) = + fun tacs -> FStarC_List.iter load_plugin tacs +let (load_plugins_dir : Prims.string -> unit) = + fun dir -> + let uu___ = + let uu___1 = + let uu___2 = FStarC_Util.readdir dir in + FStarC_List.filter + (fun s -> + ((FStarC_String.length s) >= (Prims.of_int (5))) && + ((FStar_String.sub s + ((FStarC_String.length s) - (Prims.of_int (5))) + (Prims.of_int (5))) + = ".cmxs")) uu___2 in + FStarC_List.map (fun s -> Prims.strcat dir (Prims.strcat "/" s)) uu___1 in + load_plugins uu___ +let (compile_modules : Prims.string -> Prims.string Prims.list -> unit) = + fun dir -> + fun ms -> + let compile m = + let packages = ["fstar.pluginlib"] in + let pkg pname = Prims.strcat "-package " pname in + let args = + let uu___ = + let uu___1 = + let uu___2 = + let uu___3 = FStarC_List.map pkg packages in + FStar_List_Tot_Base.append uu___3 + ["-o"; Prims.strcat m ".cmxs"; Prims.strcat m ".ml"] in + FStar_List_Tot_Base.append ["-w"; "-8-11-20-21-26-28"] uu___2 in + FStar_List_Tot_Base.append ["-I"; dir] uu___1 in + FStar_List_Tot_Base.append ["ocamlopt"; "-shared"] uu___ in + let old_ocamlpath = + let uu___ = FStarC_Util.expand_environment_variable "OCAMLPATH" in + match uu___ with + | FStar_Pervasives_Native.Some s -> s + | FStar_Pervasives_Native.None -> "" in + let env_setter = + let uu___ = FStarC_Find.locate_ocaml () in + FStarC_Util.format3 "env OCAMLPATH=\"%s%s%s\"" uu___ + FStarC_Platform.ocamlpath_sep old_ocamlpath in + let cmd = + FStarC_String.concat " " (env_setter :: "ocamlfind" :: args) in + let rc = FStarC_Util.system_run cmd in + if rc <> Prims.int_zero + then + let uu___ = + let uu___1 = + FStarC_Errors_Msg.text "Failed to compile native tactic." in + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + FStarC_Class_Show.show FStarC_Class_Show.showable_int rc in + FStarC_Util.format2 + "Command\n`%s`\nreturned with exit code %s" cmd uu___5 in + FStarC_Errors_Msg.text uu___4 in + [uu___3] in + uu___1 :: uu___2 in + FStarC_Errors.raise_error0 + FStarC_Errors_Codes.Fatal_FailToCompileNativeTactic () + (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) + (Obj.magic uu___) + else () in + try + (fun uu___ -> + match () with + | () -> + let uu___1 = + FStarC_List.map + (fun m -> Prims.strcat dir (Prims.strcat "/" m)) ms in + FStarC_List.iter compile uu___1) () + with + | uu___ -> + ((let uu___2 = + let uu___3 = FStarC_Util.print_exn uu___ in + FStarC_Util.format1 "Failed to load native tactic: %s\n" uu___3 in + perr uu___2); + FStarC_Effect.raise uu___) +let (autoload_plugin : Prims.string -> Prims.bool) = + fun ext -> + let uu___ = FStarC_Options_Ext.enabled "noautoload" in + if uu___ + then false + else + ((let uu___3 = FStarC_Debug.any () in + if uu___3 + then + FStarC_Util.print1 "Trying to find a plugin for extension %s\n" ext + else ()); + (let uu___3 = FStarC_Find.find_file (Prims.strcat ext ".cmxs") in + match uu___3 with + | FStar_Pervasives_Native.Some fn -> + let uu___4 = + let uu___5 = FStarC_Effect.op_Bang loaded in + FStarC_List.mem fn uu___5 in + if uu___4 + then false + else + ((let uu___7 = FStarC_Debug.any () in + if uu___7 + then FStarC_Util.print1 "Autoloading plugin %s ...\n" fn + else ()); + load_plugin fn; + true) + | FStar_Pervasives_Native.None -> false)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Prettyprint.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Prettyprint.ml similarity index 70% rename from stage0/fstar-lib/generated/FStarC_Prettyprint.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Prettyprint.ml index 149c1a9b16d..701792be877 100644 --- a/stage0/fstar-lib/generated/FStarC_Prettyprint.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Prettyprint.ml @@ -12,7 +12,7 @@ let (uu___is_FromTempToFile : printing_mode -> Prims.bool) = fun projectee -> match projectee with | FromTempToFile -> true | uu___ -> false let (temp_file_name : Prims.string -> Prims.string) = - fun f -> FStarC_Compiler_Util.format1 "%s.print_.fst" f + fun f -> FStarC_Util.format1 "%s.print_.fst" f let (generate : printing_mode -> Prims.string Prims.list -> unit) = fun m -> fun filenames -> @@ -24,16 +24,15 @@ let (generate : printing_mode -> Prims.string Prims.list -> unit) = match m1 with | FromTempToStdout -> FStar_Pervasives_Native.None | FromTempToFile -> - let outf1 = - FStarC_Compiler_Util.open_file_for_writing filename in + let outf1 = FStarC_Util.open_file_for_writing filename in FStar_Pervasives_Native.Some outf1 | ToTempFile -> let outf1 = let uu___1 = temp_file_name filename in - FStarC_Compiler_Util.open_file_for_writing uu___1 in + FStarC_Util.open_file_for_writing uu___1 in FStar_Pervasives_Native.Some outf1 in let leftover_comments = - let comments1 = FStarC_Compiler_List.rev comments in + let comments1 = FStarC_List.rev comments in let uu___1 = FStarC_Parser_ToDocument.modul_with_comments_to_document modul comments1 in @@ -43,19 +42,16 @@ let (generate : printing_mode -> Prims.string Prims.list -> unit) = | FStar_Pervasives_Native.Some f -> let uu___3 = FStarC_Pprint.pretty_string - (FStarC_Compiler_Util.float_of_string "1.0") + (FStarC_Util.float_of_string "1.0") (Prims.of_int (100)) doc in - FStarC_Compiler_Util.append_to_file f uu___3 + FStarC_Util.append_to_file f uu___3 | FStar_Pervasives_Native.None -> FStarC_Pprint.pretty_out_channel - (FStarC_Compiler_Util.float_of_string "1.0") - (Prims.of_int (100)) doc - FStarC_Compiler_Util.stdout); + (FStarC_Util.float_of_string "1.0") + (Prims.of_int (100)) doc FStarC_Util.stdout); comments2) in let left_over_doc = - if - Prims.op_Negation - (FStarC_Compiler_List.isEmpty leftover_comments) + if Prims.op_Negation (FStarC_List.isEmpty leftover_comments) then let uu___1 = let uu___2 = @@ -76,14 +72,13 @@ let (generate : printing_mode -> Prims.string Prims.list -> unit) = (match outf with | FStar_Pervasives_Native.None -> FStarC_Pprint.pretty_out_channel - (FStarC_Compiler_Util.float_of_string "1.0") - (Prims.of_int (100)) left_over_doc - FStarC_Compiler_Util.stdout + (FStarC_Util.float_of_string "1.0") (Prims.of_int (100)) + left_over_doc FStarC_Util.stdout | FStar_Pervasives_Native.Some outf1 -> ((let uu___2 = FStarC_Pprint.pretty_string - (FStarC_Compiler_Util.float_of_string "1.0") + (FStarC_Util.float_of_string "1.0") (Prims.of_int (100)) left_over_doc in - FStarC_Compiler_Util.append_to_file outf1 uu___2); - FStarC_Compiler_Util.close_out_channel outf1)) in - FStarC_Compiler_List.iter (parse_and_prettyprint m) filenames \ No newline at end of file + FStarC_Util.append_to_file outf1 uu___2); + FStarC_Util.close_out_channel outf1)) in + FStarC_List.iter (parse_and_prettyprint m) filenames \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Profiling.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Profiling.ml similarity index 59% rename from stage0/fstar-lib/generated/FStarC_Profiling.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Profiling.ml index b5b601569f6..2d9fcf0db9f 100644 --- a/stage0/fstar-lib/generated/FStarC_Profiling.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Profiling.ml @@ -2,24 +2,24 @@ open Prims type counter = { cid: Prims.string ; - total_time: Prims.int FStarC_Compiler_Effect.ref ; - running: Prims.bool FStarC_Compiler_Effect.ref ; - undercount: Prims.bool FStarC_Compiler_Effect.ref } + total_time: Prims.int FStarC_Effect.ref ; + running: Prims.bool FStarC_Effect.ref ; + undercount: Prims.bool FStarC_Effect.ref } let (__proj__Mkcounter__item__cid : counter -> Prims.string) = fun projectee -> match projectee with | { cid; total_time; running; undercount;_} -> cid let (__proj__Mkcounter__item__total_time : - counter -> Prims.int FStarC_Compiler_Effect.ref) = + counter -> Prims.int FStarC_Effect.ref) = fun projectee -> match projectee with | { cid; total_time; running; undercount;_} -> total_time let (__proj__Mkcounter__item__running : - counter -> Prims.bool FStarC_Compiler_Effect.ref) = + counter -> Prims.bool FStarC_Effect.ref) = fun projectee -> match projectee with | { cid; total_time; running; undercount;_} -> running let (__proj__Mkcounter__item__undercount : - counter -> Prims.bool FStarC_Compiler_Effect.ref) = + counter -> Prims.bool FStarC_Effect.ref) = fun projectee -> match projectee with | { cid; total_time; running; undercount;_} -> undercount @@ -29,19 +29,19 @@ let (json_of_counter : counter -> FStarC_Json.json) = let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang c.total_time in + let uu___4 = FStarC_Effect.op_Bang c.total_time in FStarC_Json.JsonInt uu___4 in ("total_time", uu___3) in let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_Effect.op_Bang c.running in + let uu___6 = FStarC_Effect.op_Bang c.running in FStarC_Json.JsonBool uu___6 in ("running", uu___5) in let uu___5 = let uu___6 = let uu___7 = - let uu___8 = FStarC_Compiler_Effect.op_Bang c.undercount in + let uu___8 = FStarC_Effect.op_Bang c.undercount in FStarC_Json.JsonBool uu___8 in ("undercount", uu___7) in [uu___6] in @@ -51,20 +51,20 @@ let (json_of_counter : counter -> FStarC_Json.json) = FStarC_Json.JsonAssoc uu___ let (new_counter : Prims.string -> counter) = fun cid -> - let uu___ = FStarC_Compiler_Util.mk_ref Prims.int_zero in - let uu___1 = FStarC_Compiler_Util.mk_ref false in - let uu___2 = FStarC_Compiler_Util.mk_ref false in + let uu___ = FStarC_Util.mk_ref Prims.int_zero in + let uu___1 = FStarC_Util.mk_ref false in + let uu___2 = FStarC_Util.mk_ref false in { cid; total_time = uu___; running = uu___1; undercount = uu___2 } -let (all_counters : counter FStarC_Compiler_Util.smap) = - FStarC_Compiler_Util.smap_create (Prims.of_int (20)) +let (all_counters : counter FStarC_Util.smap) = + FStarC_Util.smap_create (Prims.of_int (20)) let (create_or_lookup_counter : Prims.string -> counter) = fun cid -> - let uu___ = FStarC_Compiler_Util.smap_try_find all_counters cid in + let uu___ = FStarC_Util.smap_try_find all_counters cid in match uu___ with | FStar_Pervasives_Native.Some c -> c | FStar_Pervasives_Native.None -> let c = new_counter cid in - (FStarC_Compiler_Util.smap_add all_counters cid c; c) + (FStarC_Util.smap_add all_counters cid c; c) let profile : 'a . (unit -> 'a) -> @@ -77,7 +77,7 @@ let profile : if uu___ then let c = create_or_lookup_counter cid in - let uu___1 = FStarC_Compiler_Effect.op_Bang c.running in + let uu___1 = FStarC_Effect.op_Bang c.running in (if uu___1 then f () else @@ -85,25 +85,23 @@ let profile : (fun uu___3 -> match () with | () -> - (FStarC_Compiler_Effect.op_Colon_Equals c.running true; - (let uu___5 = FStarC_Compiler_Util.record_time_ns f in + (FStarC_Effect.op_Colon_Equals c.running true; + (let uu___5 = FStarC_Util.record_time_ns f in match uu___5 with | (res, elapsed) -> ((let uu___7 = let uu___8 = - FStarC_Compiler_Effect.op_Bang - c.total_time in + FStarC_Effect.op_Bang c.total_time in uu___8 + elapsed in - FStarC_Compiler_Effect.op_Colon_Equals - c.total_time uu___7); - FStarC_Compiler_Effect.op_Colon_Equals - c.running false; + FStarC_Effect.op_Colon_Equals c.total_time + uu___7); + FStarC_Effect.op_Colon_Equals c.running false; res)))) () with | uu___3 -> - (FStarC_Compiler_Effect.op_Colon_Equals c.running false; - FStarC_Compiler_Effect.op_Colon_Equals c.undercount true; - FStarC_Compiler_Effect.raise uu___3))) + (FStarC_Effect.op_Colon_Equals c.running false; + FStarC_Effect.op_Colon_Equals c.undercount true; + FStarC_Effect.raise uu___3))) else f () let (report_json : Prims.string -> counter -> unit) = fun tag -> @@ -113,27 +111,26 @@ let (report_json : Prims.string -> counter -> unit) = FStarC_Json.string_of_json (FStarC_Json.JsonAssoc [("tag", (FStarC_Json.JsonStr tag)); ("counter", counter1)]) in - FStarC_Compiler_Util.print1_error "%s\n" uu___ + FStarC_Util.print1_error "%s\n" uu___ let (report_human : Prims.string -> counter -> unit) = fun tag -> fun c -> let warn = - let uu___ = FStarC_Compiler_Effect.op_Bang c.running in + let uu___ = FStarC_Effect.op_Bang c.running in if uu___ then " (Warning, this counter is still running)" else - (let uu___2 = FStarC_Compiler_Effect.op_Bang c.undercount in + (let uu___2 = FStarC_Effect.op_Bang c.undercount in if uu___2 then " (Warning, some operations raised exceptions and we not accounted for)" else "") in let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang c.total_time in + let uu___2 = FStarC_Effect.op_Bang c.total_time in uu___2 / (Prims.parse_int "1000000") in - FStarC_Compiler_Util.string_of_int uu___1 in - FStarC_Compiler_Util.print4 "%s, profiled %s:\t %s ms%s\n" tag - c.cid uu___ warn + FStarC_Util.string_of_int uu___1 in + FStarC_Util.print4 "%s, profiled %s:\t %s ms%s\n" tag c.cid uu___ warn let (report : Prims.string -> counter -> unit) = fun tag -> fun c -> @@ -144,14 +141,14 @@ let (report : Prims.string -> counter -> unit) = let (report_and_clear : Prims.string -> unit) = fun tag -> let ctrs = - FStarC_Compiler_Util.smap_fold all_counters + FStarC_Util.smap_fold all_counters (fun uu___ -> fun v -> fun l -> v :: l) [] in - FStarC_Compiler_Util.smap_clear all_counters; + FStarC_Util.smap_clear all_counters; (let ctrs1 = - FStarC_Compiler_Util.sort_with + FStarC_Util.sort_with (fun c1 -> fun c2 -> - let uu___1 = FStarC_Compiler_Effect.op_Bang c2.total_time in - let uu___2 = FStarC_Compiler_Effect.op_Bang c1.total_time in + let uu___1 = FStarC_Effect.op_Bang c2.total_time in + let uu___2 = FStarC_Effect.op_Bang c1.total_time in uu___1 - uu___2) ctrs in - FStarC_Compiler_List.iter (report tag) ctrs1) \ No newline at end of file + FStarC_List.iter (report tag) ctrs1) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_RBSet.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_RBSet.ml similarity index 97% rename from stage0/fstar-lib/generated/FStarC_Compiler_RBSet.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_RBSet.ml index c468c9444fa..b3631f09beb 100644 --- a/stage0/fstar-lib/generated/FStarC_Compiler_RBSet.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_RBSet.ml @@ -193,15 +193,12 @@ let rec for_any : 'a . ('a -> Prims.bool) -> 'a rbset -> Prims.bool = | N (uu___, a1, x, b) -> ((p x) || (for_any p a1)) || (for_any p b) let from_list : 'a . 'a FStarC_Class_Ord.ord -> 'a Prims.list -> 'a rbset = fun uu___ -> - fun xs -> - FStarC_Compiler_List.fold_left (fun s -> fun e -> add uu___ e s) L xs + fun xs -> FStarC_List.fold_left (fun s -> fun e -> add uu___ e s) L xs let addn : 'a . 'a FStarC_Class_Ord.ord -> 'a Prims.list -> 'a rbset -> 'a rbset = fun uu___ -> fun xs -> - fun s -> - FStarC_Compiler_List.fold_left (fun s1 -> fun e -> add uu___ e s1) s - xs + fun s -> FStarC_List.fold_left (fun s1 -> fun e -> add uu___ e s1) s xs let collect : 'a . 'a FStarC_Class_Ord.ord -> ('a -> 'a rbset) -> 'a Prims.list -> 'a rbset @@ -209,7 +206,7 @@ let collect : fun uu___ -> fun f -> fun l -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun s -> fun e -> let uu___1 = f e in union uu___ uu___1 s) L l let setlike_rbset : 'a . 'a FStarC_Class_Ord.ord -> ('a, 'a t) FStarC_Class_Setlike.setlike = diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_Range_Ops.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Range_Ops.ml new file mode 100644 index 00000000000..277a9809744 --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Range_Ops.ml @@ -0,0 +1,237 @@ +open Prims +let (union_rng : + FStarC_Range_Type.rng -> FStarC_Range_Type.rng -> FStarC_Range_Type.rng) = + fun r1 -> + fun r2 -> + if r1.FStarC_Range_Type.file_name <> r2.FStarC_Range_Type.file_name + then r2 + else + (let start_pos = + FStarC_Class_Ord.min FStarC_Range_Type.ord_pos + r1.FStarC_Range_Type.start_pos r2.FStarC_Range_Type.start_pos in + let end_pos = + FStarC_Class_Ord.max FStarC_Range_Type.ord_pos + r1.FStarC_Range_Type.end_pos r2.FStarC_Range_Type.end_pos in + FStarC_Range_Type.mk_rng r1.FStarC_Range_Type.file_name start_pos + end_pos) +let (union_ranges : + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Range_Type.range) + = + fun r1 -> + fun r2 -> + let uu___ = + union_rng r1.FStarC_Range_Type.def_range + r2.FStarC_Range_Type.def_range in + let uu___1 = + union_rng r1.FStarC_Range_Type.use_range + r2.FStarC_Range_Type.use_range in + { + FStarC_Range_Type.def_range = uu___; + FStarC_Range_Type.use_range = uu___1 + } +let (rng_included : + FStarC_Range_Type.rng -> FStarC_Range_Type.rng -> Prims.bool) = + fun r1 -> + fun r2 -> + if r1.FStarC_Range_Type.file_name <> r2.FStarC_Range_Type.file_name + then false + else + (FStarC_Class_Ord.op_Less_Equals_Question FStarC_Range_Type.ord_pos + r2.FStarC_Range_Type.start_pos r1.FStarC_Range_Type.start_pos) + && + (FStarC_Class_Ord.op_Greater_Equals_Question + FStarC_Range_Type.ord_pos r2.FStarC_Range_Type.end_pos + r1.FStarC_Range_Type.end_pos) +let (string_of_pos : FStarC_Range_Type.pos -> Prims.string) = + fun pos -> + let uu___ = FStarC_Util.string_of_int pos.FStarC_Range_Type.line in + let uu___1 = FStarC_Util.string_of_int pos.FStarC_Range_Type.col in + FStarC_Util.format2 "%s,%s" uu___ uu___1 +let (file_of_range : FStarC_Range_Type.range -> Prims.string) = + fun r -> + let f = (r.FStarC_Range_Type.def_range).FStarC_Range_Type.file_name in + FStarC_Range_Type.string_of_file_name f +let (set_file_of_range : + FStarC_Range_Type.range -> Prims.string -> FStarC_Range_Type.range) = + fun r -> + fun f -> + { + FStarC_Range_Type.def_range = + (let uu___ = r.FStarC_Range_Type.def_range in + { + FStarC_Range_Type.file_name = f; + FStarC_Range_Type.start_pos = + (uu___.FStarC_Range_Type.start_pos); + FStarC_Range_Type.end_pos = (uu___.FStarC_Range_Type.end_pos) + }); + FStarC_Range_Type.use_range = (r.FStarC_Range_Type.use_range) + } +let (string_of_rng : FStarC_Range_Type.rng -> Prims.string) = + fun r -> + let uu___ = + FStarC_Range_Type.string_of_file_name r.FStarC_Range_Type.file_name in + let uu___1 = string_of_pos r.FStarC_Range_Type.start_pos in + let uu___2 = string_of_pos r.FStarC_Range_Type.end_pos in + FStarC_Util.format3 "%s(%s-%s)" uu___ uu___1 uu___2 +let (string_of_def_range : FStarC_Range_Type.range -> Prims.string) = + fun r -> string_of_rng r.FStarC_Range_Type.def_range +let (string_of_use_range : FStarC_Range_Type.range -> Prims.string) = + fun r -> string_of_rng r.FStarC_Range_Type.use_range +let (string_of_range : FStarC_Range_Type.range -> Prims.string) = + fun r -> string_of_def_range r +let (start_of_range : FStarC_Range_Type.range -> FStarC_Range_Type.pos) = + fun r -> (r.FStarC_Range_Type.def_range).FStarC_Range_Type.start_pos +let (end_of_range : FStarC_Range_Type.range -> FStarC_Range_Type.pos) = + fun r -> (r.FStarC_Range_Type.def_range).FStarC_Range_Type.end_pos +let (file_of_use_range : FStarC_Range_Type.range -> Prims.string) = + fun r -> (r.FStarC_Range_Type.use_range).FStarC_Range_Type.file_name +let (start_of_use_range : FStarC_Range_Type.range -> FStarC_Range_Type.pos) = + fun r -> (r.FStarC_Range_Type.use_range).FStarC_Range_Type.start_pos +let (end_of_use_range : FStarC_Range_Type.range -> FStarC_Range_Type.pos) = + fun r -> (r.FStarC_Range_Type.use_range).FStarC_Range_Type.end_pos +let (line_of_pos : FStarC_Range_Type.pos -> Prims.int) = + fun p -> p.FStarC_Range_Type.line +let (col_of_pos : FStarC_Range_Type.pos -> Prims.int) = + fun p -> p.FStarC_Range_Type.col +let (end_range : FStarC_Range_Type.range -> FStarC_Range_Type.range) = + fun r -> + FStarC_Range_Type.mk_range + (r.FStarC_Range_Type.def_range).FStarC_Range_Type.file_name + (r.FStarC_Range_Type.def_range).FStarC_Range_Type.end_pos + (r.FStarC_Range_Type.def_range).FStarC_Range_Type.end_pos +let (compare_rng : + FStarC_Range_Type.rng -> FStarC_Range_Type.rng -> Prims.int) = + fun r1 -> + fun r2 -> + let fcomp = + FStar_String.compare r1.FStarC_Range_Type.file_name + r2.FStarC_Range_Type.file_name in + if fcomp = Prims.int_zero + then + let start1 = r1.FStarC_Range_Type.start_pos in + let start2 = r2.FStarC_Range_Type.start_pos in + let lcomp = + start1.FStarC_Range_Type.line - start2.FStarC_Range_Type.line in + (if lcomp = Prims.int_zero + then start1.FStarC_Range_Type.col - start2.FStarC_Range_Type.col + else lcomp) + else fcomp +let (compare : + FStarC_Range_Type.range -> FStarC_Range_Type.range -> Prims.int) = + fun r1 -> + fun r2 -> + compare_rng r1.FStarC_Range_Type.def_range + r2.FStarC_Range_Type.def_range +let (compare_use_range : + FStarC_Range_Type.range -> FStarC_Range_Type.range -> Prims.int) = + fun r1 -> + fun r2 -> + compare_rng r1.FStarC_Range_Type.use_range + r2.FStarC_Range_Type.use_range +let (range_before_pos : + FStarC_Range_Type.range -> FStarC_Range_Type.pos -> Prims.bool) = + fun m1 -> + fun p -> + let uu___ = end_of_range m1 in + FStarC_Class_Ord.op_Greater_Equals_Question FStarC_Range_Type.ord_pos p + uu___ +let (end_of_line : FStarC_Range_Type.pos -> FStarC_Range_Type.pos) = + fun p -> + { + FStarC_Range_Type.line = (p.FStarC_Range_Type.line); + FStarC_Range_Type.col = FStarC_Util.max_int + } +let (extend_to_end_of_line : + FStarC_Range_Type.range -> FStarC_Range_Type.range) = + fun r -> + let uu___ = file_of_range r in + let uu___1 = start_of_range r in + let uu___2 = let uu___3 = end_of_range r in end_of_line uu___3 in + FStarC_Range_Type.mk_range uu___ uu___1 uu___2 +let (json_of_pos : FStarC_Range_Type.pos -> FStarC_Json.json) = + fun pos -> + let uu___ = + let uu___1 = let uu___2 = line_of_pos pos in FStarC_Json.JsonInt uu___2 in + let uu___2 = + let uu___3 = + let uu___4 = col_of_pos pos in FStarC_Json.JsonInt uu___4 in + [uu___3] in + uu___1 :: uu___2 in + FStarC_Json.JsonList uu___ +let (json_of_range_fields : + Prims.string -> + FStarC_Range_Type.pos -> FStarC_Range_Type.pos -> FStarC_Json.json) + = + fun file -> + fun b -> + fun e -> + let uu___ = + let uu___1 = + let uu___2 = let uu___3 = json_of_pos b in ("beg", uu___3) in + let uu___3 = + let uu___4 = let uu___5 = json_of_pos e in ("end", uu___5) in + [uu___4] in + uu___2 :: uu___3 in + ("fname", (FStarC_Json.JsonStr file)) :: uu___1 in + FStarC_Json.JsonAssoc uu___ +let (json_of_use_range : FStarC_Range_Type.range -> FStarC_Json.json) = + fun r -> + let uu___ = file_of_use_range r in + let uu___1 = start_of_use_range r in + let uu___2 = end_of_use_range r in + json_of_range_fields uu___ uu___1 uu___2 +let (json_of_def_range : FStarC_Range_Type.range -> FStarC_Json.json) = + fun r -> + let uu___ = file_of_range r in + let uu___1 = start_of_range r in + let uu___2 = end_of_range r in json_of_range_fields uu___ uu___1 uu___2 +let (intersect_rng : + FStarC_Range_Type.rng -> FStarC_Range_Type.rng -> FStarC_Range_Type.rng) = + fun r1 -> + fun r2 -> + if r1.FStarC_Range_Type.file_name <> r2.FStarC_Range_Type.file_name + then r2 + else + (let start_pos = + FStarC_Class_Ord.max FStarC_Range_Type.ord_pos + r1.FStarC_Range_Type.start_pos r2.FStarC_Range_Type.start_pos in + let end_pos = + FStarC_Class_Ord.min FStarC_Range_Type.ord_pos + r1.FStarC_Range_Type.end_pos r2.FStarC_Range_Type.end_pos in + let uu___1 = + FStarC_Class_Ord.op_Greater_Equals_Question + FStarC_Range_Type.ord_pos start_pos end_pos in + if uu___1 + then r2 + else + FStarC_Range_Type.mk_rng r1.FStarC_Range_Type.file_name start_pos + end_pos) +let (intersect_ranges : + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Range_Type.range) + = + fun r1 -> + fun r2 -> + let uu___ = + intersect_rng r1.FStarC_Range_Type.def_range + r2.FStarC_Range_Type.def_range in + let uu___1 = + intersect_rng r1.FStarC_Range_Type.use_range + r2.FStarC_Range_Type.use_range in + { + FStarC_Range_Type.def_range = uu___; + FStarC_Range_Type.use_range = uu___1 + } +let (bound_range : + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Range_Type.range) + = fun r -> fun bound -> intersect_ranges r bound +let (showable_range : FStarC_Range_Type.range FStarC_Class_Show.showable) = + { FStarC_Class_Show.show = string_of_range } +let (pretty_range : FStarC_Range_Type.range FStarC_Class_PP.pretty) = + { + FStarC_Class_PP.pp = + (fun r -> + let uu___ = string_of_range r in FStarC_Pprint.doc_of_string uu___) + } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Range_Type.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Range_Type.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_Compiler_Range_Type.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Range_Type.ml index 2f47269e8fa..15a98908742 100644 --- a/stage0/fstar-lib/generated/FStarC_Compiler_Range_Type.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Range_Type.ml @@ -9,12 +9,12 @@ let (__proj__Mkpos__item__col : pos -> Prims.int) = fun projectee -> match projectee with | { line; col;_} -> col let (max : Prims.int -> Prims.int -> Prims.int) = fun i -> fun j -> if i < j then j else i -let (compare_pos : pos -> pos -> FStarC_Compiler_Order.order) = +let (compare_pos : pos -> pos -> FStarC_Order.order) = fun p1 -> fun p2 -> let uu___ = FStarC_Class_Ord.cmp FStarC_Class_Ord.ord_int p1.line p2.line in - FStarC_Compiler_Order.lex uu___ + FStarC_Order.lex uu___ (fun uu___1 -> FStarC_Class_Ord.cmp FStarC_Class_Ord.ord_int p1.col p2.col) let (deq_pos : pos FStarC_Class_Deq.deq) = @@ -77,11 +77,9 @@ let (mk_range : Prims.string -> pos -> pos -> range) = fun f -> fun b -> fun e -> let r = mk_rng f b e in range_of_rng r r let (string_of_file_name : Prims.string -> Prims.string) = fun f -> - let uu___ = - let uu___1 = FStarC_Options_Ext.get "fstar:no_absolute_paths" in - uu___1 = "1" in + let uu___ = FStarC_Options_Ext.enabled "fstar:no_absolute_paths" in if uu___ - then FStarC_Compiler_Util.basename f + then FStarC_Util.basename f else (let uu___2 = FStarC_Options.ide () in if uu___2 @@ -91,7 +89,7 @@ let (string_of_file_name : Prims.string -> Prims.string) = match () with | () -> let uu___4 = - let uu___5 = FStarC_Compiler_Util.basename f in + let uu___5 = FStarC_Util.basename f in FStarC_Find.find_file uu___5 in (match uu___4 with | FStar_Pervasives_Native.None -> f diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Real.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Real.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Compiler_Real.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Real.ml diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Builtins.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Builtins.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_Reflection_V1_Builtins.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Builtins.ml index 3b560474794..c695d9a34a8 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Builtins.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Builtins.ml @@ -2,8 +2,7 @@ open Prims let (get_env : unit -> FStarC_TypeChecker_Env.env) = fun uu___ -> let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_TypeChecker_Normalize.reflection_env_hook in + FStarC_Effect.op_Bang FStarC_TypeChecker_Normalize.reflection_env_hook in match uu___1 with | FStar_Pervasives_Native.None -> failwith "impossible: env_hook unset in reflection" @@ -78,8 +77,7 @@ let (pack_fv : Prims.string Prims.list -> FStarC_Syntax_Syntax.fv) = let uu___1 = FStarC_Parser_Const.p2l ns in FStarC_Syntax_Syntax.lid_as_fv uu___1 quals in let uu___ = - FStarC_Compiler_Effect.op_Bang - FStarC_TypeChecker_Normalize.reflection_env_hook in + FStarC_Effect.op_Bang FStarC_TypeChecker_Normalize.reflection_env_hook in match uu___ with | FStar_Pervasives_Native.None -> fallback () | FStar_Pervasives_Native.Some env -> @@ -124,7 +122,7 @@ let (inspect_const : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c in - FStarC_Compiler_Util.format1 "unknown constant: %s" uu___2 in + FStarC_Util.format1 "unknown constant: %s" uu___2 in failwith uu___1 let (inspect_universe : FStarC_Syntax_Syntax.universe -> FStarC_Reflection_V1_Data.universe_view) = @@ -291,7 +289,7 @@ let rec (inspect_ln : | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, ps) -> let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (p1, b) -> @@ -300,12 +298,11 @@ let rec (inspect_ln : FStarC_Reflection_V1_Data.Pat_Cons uu___1 | FStarC_Syntax_Syntax.Pat_var bv -> FStarC_Reflection_V1_Data.Pat_Var - (bv, - (FStarC_Compiler_Sealed.seal bv.FStarC_Syntax_Syntax.sort)) + (bv, (FStarC_Sealed.seal bv.FStarC_Syntax_Syntax.sort)) | FStarC_Syntax_Syntax.Pat_dot_term eopt -> FStarC_Reflection_V1_Data.Pat_Dot_Term eopt in let brs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (pat, uu___2, t3) -> @@ -320,7 +317,7 @@ let rec (inspect_ln : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "inspect_ln: outside of expected syntax (%s, %s)" uu___3 uu___4 in FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) t1 FStarC_Errors_Codes.Warning_CantInspect () @@ -332,7 +329,7 @@ let (inspect_comp : fun c -> let get_dec flags = let uu___ = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.DECREASES uu___2 -> true @@ -346,7 +343,7 @@ let (inspect_comp : ((let uu___3 = let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "inspect_comp: inspecting comp with wf decreases clause is not yet supported: %s skipping the decreases clause" uu___4 in FStarC_Errors.log_issue @@ -362,10 +359,10 @@ let (inspect_comp : | FStarC_Syntax_Syntax.Comp ct -> let uopt = if - (FStarC_Compiler_List.length ct.FStarC_Syntax_Syntax.comp_univs) - = Prims.int_zero + (FStarC_List.length ct.FStarC_Syntax_Syntax.comp_univs) = + Prims.int_zero then FStarC_Syntax_Syntax.U_unknown - else FStarC_Compiler_List.hd ct.FStarC_Syntax_Syntax.comp_univs in + else FStarC_List.hd ct.FStarC_Syntax_Syntax.comp_univs in let uu___ = FStarC_Ident.lid_equals ct.FStarC_Syntax_Syntax.effect_name FStarC_Parser_Const.effect_Lemma_lid in @@ -384,7 +381,7 @@ let (inspect_comp : let uu___3 = FStarC_Ident.path_of_lid ct.FStarC_Syntax_Syntax.effect_name in let uu___4 = - FStarC_Compiler_List.map inspect_arg + FStarC_List.map inspect_arg ct.FStarC_Syntax_Syntax.effect_args in let uu___5 = get_dec ct.FStarC_Syntax_Syntax.flags in ((ct.FStarC_Syntax_Syntax.comp_univs), uu___3, @@ -427,15 +424,15 @@ let (pack_comp : match uu___ with | (a, q) -> let uu___1 = pack_aqual q in (a, uu___1) in let flags = - if (FStarC_Compiler_List.length decrs) = Prims.int_zero + if (FStarC_List.length decrs) = Prims.int_zero then [] else [FStarC_Syntax_Syntax.DECREASES (FStarC_Syntax_Syntax.Decreases_lex decrs)] in let ct = let uu___ = - FStarC_Ident.lid_of_path ef FStarC_Compiler_Range_Type.dummyRange in - let uu___1 = FStarC_Compiler_List.map pack_arg args in + FStarC_Ident.lid_of_path ef FStarC_Range_Type.dummyRange in + let uu___1 = FStarC_List.map pack_arg args in { FStarC_Syntax_Syntax.comp_univs = us; FStarC_Syntax_Syntax.effect_name = uu___; @@ -457,13 +454,12 @@ let (pack_const : | FStarC_Reflection_V1_Data.C_True -> FStarC_Const.Const_bool true | FStarC_Reflection_V1_Data.C_False -> FStarC_Const.Const_bool false | FStarC_Reflection_V1_Data.C_String s -> - FStarC_Const.Const_string (s, FStarC_Compiler_Range_Type.dummyRange) + FStarC_Const.Const_string (s, FStarC_Range_Type.dummyRange) | FStarC_Reflection_V1_Data.C_Range r -> FStarC_Const.Const_range r | FStarC_Reflection_V1_Data.C_Reify -> FStarC_Const.Const_reify FStar_Pervasives_Native.None | FStarC_Reflection_V1_Data.C_Reflect ns -> - let uu___ = - FStarC_Ident.lid_of_path ns FStarC_Compiler_Range_Type.dummyRange in + let uu___ = FStarC_Ident.lid_of_path ns FStarC_Range_Type.dummyRange in FStarC_Const.Const_reflect uu___ let (pack_ln : FStarC_Reflection_V1_Data.term_view -> FStarC_Syntax_Syntax.term) = @@ -495,7 +491,7 @@ let (pack_ln : }) c.FStarC_Syntax_Syntax.pos | FStarC_Reflection_V1_Data.Tv_Type u -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_Refine (bv, sort, t) -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_refine @@ -514,10 +510,10 @@ let (pack_ln : let uu___ = let uu___1 = pack_const c in FStarC_Syntax_Syntax.Tm_constant uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_Uvar (u, ctx_u_s) -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_uvar ctx_u_s) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_Let (false, attrs, bv, ty, t1, t2) -> let bv1 = { @@ -528,13 +524,13 @@ let (pack_ln : let lb = FStarC_Syntax_Util.mk_letbinding (FStar_Pervasives.Inl bv1) [] bv1.FStarC_Syntax_Syntax.sort FStarC_Parser_Const.effect_Tot_lid - t1 attrs FStarC_Compiler_Range_Type.dummyRange in + t1 attrs FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_let { FStarC_Syntax_Syntax.lbs = (false, [lb]); FStarC_Syntax_Syntax.body1 = t2 - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_Let (true, attrs, bv, ty, t1, t2) -> let bv1 = { @@ -545,18 +541,18 @@ let (pack_ln : let lb = FStarC_Syntax_Util.mk_letbinding (FStar_Pervasives.Inl bv1) [] bv1.FStarC_Syntax_Syntax.sort FStarC_Parser_Const.effect_Tot_lid - t1 attrs FStarC_Compiler_Range_Type.dummyRange in + t1 attrs FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_let { FStarC_Syntax_Syntax.lbs = (true, [lb]); FStarC_Syntax_Syntax.body1 = t2 - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_Match (t, ret_opt, brs) -> let wrap v = { FStarC_Syntax_Syntax.v = v; - FStarC_Syntax_Syntax.p = FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.p = FStarC_Range_Type.dummyRange } in let rec pack_pat p = match p with @@ -569,7 +565,7 @@ let (pack_ln : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (p1, b) -> let uu___4 = pack_pat p1 in (uu___4, b)) @@ -582,7 +578,7 @@ let (pack_ln : | FStarC_Reflection_V1_Data.Pat_Dot_Term eopt -> wrap (FStarC_Syntax_Syntax.Pat_dot_term eopt) in let brs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (pat, t1) -> @@ -595,7 +591,7 @@ let (pack_ln : FStarC_Syntax_Syntax.ret_opt = ret_opt; FStarC_Syntax_Syntax.brs = brs1; FStarC_Syntax_Syntax.rc_opt1 = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_AscribedT (e, t, tacopt, use_eq) -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_ascribed @@ -604,7 +600,7 @@ let (pack_ln : FStarC_Syntax_Syntax.asc = ((FStar_Pervasives.Inl t), tacopt, use_eq); FStarC_Syntax_Syntax.eff_opt = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_AscribedC (e, c, tacopt, use_eq) -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_ascribed @@ -613,24 +609,24 @@ let (pack_ln : FStarC_Syntax_Syntax.asc = ((FStar_Pervasives.Inr c), tacopt, use_eq); FStarC_Syntax_Syntax.eff_opt = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_Unknown -> FStarC_Syntax_Syntax.mk FStarC_Syntax_Syntax.Tm_unknown - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Tv_Unsupp -> (FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_CantInspect () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic "packing a Tv_Unsupp into Tm_unknown"); FStarC_Syntax_Syntax.mk FStarC_Syntax_Syntax.Tm_unknown - FStarC_Compiler_Range_Type.dummyRange) + FStarC_Range_Type.dummyRange) let (compare_bv : - FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.bv -> FStar_Order.order) = + FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.bv -> FStarC_Order.order) = fun x -> fun y -> let n = FStarC_Syntax_Syntax.order_bv x y in if n < Prims.int_zero - then FStar_Order.Lt - else if n = Prims.int_zero then FStar_Order.Eq else FStar_Order.Gt + then FStarC_Order.Lt + else if n = Prims.int_zero then FStarC_Order.Eq else FStarC_Order.Gt let (lookup_attr : FStarC_Syntax_Syntax.term -> FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.fv Prims.list) @@ -647,7 +643,7 @@ let (lookup_attr : let uu___2 = FStarC_Syntax_Syntax.lid_of_fv fv in FStarC_Ident.string_of_lid uu___2 in FStarC_TypeChecker_Env.lookup_attr env uu___1 in - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun se -> let uu___1 = FStarC_Syntax_Util.lid_of_sigelt se in match uu___1 with @@ -662,7 +658,7 @@ let (all_defs_in_env : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.fv Prims.list) = fun env -> let uu___ = FStarC_TypeChecker_Env.lidents env in - FStarC_Compiler_List.map + FStarC_List.map (fun l -> FStarC_Syntax_Syntax.lid_as_fv l FStar_Pervasives_Native.None) uu___ let (defs_in_module : @@ -672,12 +668,12 @@ let (defs_in_module : fun env -> fun modul -> let uu___ = FStarC_TypeChecker_Env.lidents env in - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun l -> let ns = let uu___1 = let uu___2 = FStarC_Ident.ids_of_lid l in init uu___2 in - FStarC_Compiler_List.map FStarC_Ident.string_of_id uu___1 in + FStarC_List.map FStarC_Ident.string_of_id uu___1 in if ns = modul then let uu___1 = @@ -739,34 +735,29 @@ let (rd_to_syntax_qual : | FStarC_Reflection_V1_Data.Logic -> FStarC_Syntax_Syntax.Logic | FStarC_Reflection_V1_Data.Reifiable -> FStarC_Syntax_Syntax.Reifiable | FStarC_Reflection_V1_Data.Reflectable l -> - let uu___1 = - FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange in + let uu___1 = FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.Reflectable uu___1 | FStarC_Reflection_V1_Data.Discriminator l -> - let uu___1 = - FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange in + let uu___1 = FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.Discriminator uu___1 | FStarC_Reflection_V1_Data.Projector (l, i) -> let uu___1 = let uu___2 = - FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange in let uu___3 = pack_ident i in (uu___2, uu___3) in FStarC_Syntax_Syntax.Projector uu___1 | FStarC_Reflection_V1_Data.RecordType (l1, l2) -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map pack_ident l1 in - let uu___3 = FStarC_Compiler_List.map pack_ident l2 in - (uu___2, uu___3) in + let uu___2 = FStarC_List.map pack_ident l1 in + let uu___3 = FStarC_List.map pack_ident l2 in (uu___2, uu___3) in FStarC_Syntax_Syntax.RecordType uu___1 | FStarC_Reflection_V1_Data.RecordConstructor (l1, l2) -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map pack_ident l1 in - let uu___3 = FStarC_Compiler_List.map pack_ident l2 in - (uu___2, uu___3) in + let uu___2 = FStarC_List.map pack_ident l1 in + let uu___3 = FStarC_List.map pack_ident l2 in (uu___2, uu___3) in FStarC_Syntax_Syntax.RecordConstructor uu___1 | FStarC_Reflection_V1_Data.Action l -> - let uu___1 = - FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange in + let uu___1 = FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.Action uu___1 | FStarC_Reflection_V1_Data.ExceptionConstructor -> FStarC_Syntax_Syntax.ExceptionConstructor @@ -809,15 +800,13 @@ let (syntax_to_rd_qual : FStarC_Reflection_V1_Data.Projector uu___1 | FStarC_Syntax_Syntax.RecordType (l1, l2) -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map inspect_ident l1 in - let uu___3 = FStarC_Compiler_List.map inspect_ident l2 in - (uu___2, uu___3) in + let uu___2 = FStarC_List.map inspect_ident l1 in + let uu___3 = FStarC_List.map inspect_ident l2 in (uu___2, uu___3) in FStarC_Reflection_V1_Data.RecordType uu___1 | FStarC_Syntax_Syntax.RecordConstructor (l1, l2) -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map inspect_ident l1 in - let uu___3 = FStarC_Compiler_List.map inspect_ident l2 in - (uu___2, uu___3) in + let uu___2 = FStarC_List.map inspect_ident l1 in + let uu___3 = FStarC_List.map inspect_ident l2 in (uu___2, uu___3) in FStarC_Reflection_V1_Data.RecordConstructor uu___1 | FStarC_Syntax_Syntax.Action l -> let uu___1 = FStarC_Ident.path_of_lid l in @@ -833,15 +822,14 @@ let (sigelt_quals : FStarC_Reflection_V1_Data.qualifier Prims.list) = fun se -> - FStarC_Compiler_List.map syntax_to_rd_qual - se.FStarC_Syntax_Syntax.sigquals + FStarC_List.map syntax_to_rd_qual se.FStarC_Syntax_Syntax.sigquals let (set_sigelt_quals : FStarC_Reflection_V1_Data.qualifier Prims.list -> FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.sigelt) = fun quals -> fun se -> - let uu___ = FStarC_Compiler_List.map rd_to_syntax_qual quals in + let uu___ = FStarC_List.map rd_to_syntax_qual quals in { FStarC_Syntax_Syntax.sigel = (se.FStarC_Syntax_Syntax.sigel); FStarC_Syntax_Syntax.sigrng = (se.FStarC_Syntax_Syntax.sigrng); @@ -861,7 +849,7 @@ let (embed_vconfig : FStarC_VConfig.vconfig -> FStarC_Syntax_Syntax.term) = let uu___ = FStarC_Syntax_Embeddings_Base.embed FStarC_Syntax_Embeddings.e_vconfig vcfg in - uu___ FStarC_Compiler_Range_Type.dummyRange FStar_Pervasives_Native.None + uu___ FStarC_Range_Type.dummyRange FStar_Pervasives_Native.None FStarC_Syntax_Embeddings_Base.id_norm_cb let (inspect_sigelt : FStarC_Syntax_Syntax.sigelt -> FStarC_Reflection_V1_Data.sigelt_view) = @@ -889,8 +877,7 @@ let (inspect_sigelt : FStarC_Syntax_Util.mk_letbinding nm us1 typ1 eff def1 attrs pos) in let uu___1 = - let uu___2 = FStarC_Compiler_List.map inspect_letbinding lbs in - (r, uu___2) in + let uu___2 = FStarC_List.map inspect_letbinding lbs in (r, uu___2) in FStarC_Reflection_V1_Data.Sg_Let uu___1 | FStarC_Syntax_Syntax.Sig_inductive_typ { FStarC_Syntax_Syntax.lid = lid; FStarC_Syntax_Syntax.us = us; @@ -940,9 +927,7 @@ let (inspect_sigelt : nparam cty1 in (match uu___15 with | (param_ctor_bs, c) -> - (if - (FStarC_Compiler_List.length param_ctor_bs) - <> nparam + (if (FStarC_List.length param_ctor_bs) <> nparam then failwith "impossible: inspect_sigelt: could not obtain sufficient ctor param binders" @@ -958,7 +943,7 @@ let (inspect_sigelt : else ()); (let cty2 = FStarC_Syntax_Util.comp_result c in let s' = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b1 -> fun b2 -> let uu___18 = @@ -978,8 +963,8 @@ let (inspect_sigelt : failwith "impossible: inspect_sigelt: did not find ctor" in let uu___5 = - let uu___6 = FStarC_Compiler_List.map inspect_ident us1 in - let uu___7 = FStarC_Compiler_List.map inspect_ctor c_lids in + let uu___6 = FStarC_List.map inspect_ident us1 in + let uu___7 = FStarC_List.map inspect_ctor c_lids in (nm, uu___6, param_bs2, ty2, uu___7) in FStarC_Reflection_V1_Data.Sg_Inductive uu___5)) | FStarC_Syntax_Syntax.Sig_declare_typ @@ -991,7 +976,7 @@ let (inspect_sigelt : (match uu___ with | (us1, ty1) -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map inspect_ident us1 in + let uu___2 = FStarC_List.map inspect_ident us1 in (nm, uu___2, ty1) in FStarC_Reflection_V1_Data.Sg_Val uu___1) | uu___ -> FStarC_Reflection_V1_Data.Unk @@ -1002,7 +987,7 @@ let (pack_sigelt : let uu___ = let uu___1 = let uu___2 = FStarC_Ident.path_of_lid lid in - FStarC_Compiler_List.length uu___2 in + FStarC_List.length uu___2 in uu___1 <= Prims.int_one in if uu___ then @@ -1040,11 +1025,9 @@ let (pack_sigelt : FStarC_Syntax_Util.mk_letbinding nm us typ1 eff def1 attrs pos in (lid, lb1))) in - let packed = FStarC_Compiler_List.map pack_letbinding lbs in - let lbs1 = - FStarC_Compiler_List.map FStar_Pervasives_Native.snd packed in - let lids = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst packed in + let packed = FStarC_List.map pack_letbinding lbs in + let lbs1 = FStarC_List.map FStar_Pervasives_Native.snd packed in + let lids = FStarC_List.map FStar_Pervasives_Native.fst packed in FStarC_Syntax_Syntax.mk_sigelt (FStarC_Syntax_Syntax.Sig_let { @@ -1053,20 +1036,19 @@ let (pack_sigelt : }) | FStarC_Reflection_V1_Data.Sg_Inductive (nm, us_names, param_bs, ty, ctors) -> - let us_names1 = FStarC_Compiler_List.map pack_ident us_names in + let us_names1 = FStarC_List.map pack_ident us_names in let ind_lid = - FStarC_Ident.lid_of_path nm FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path nm FStarC_Range_Type.dummyRange in (check_lid ind_lid; (let s = FStarC_Syntax_Subst.univ_var_closing us_names1 in - let nparam = FStarC_Compiler_List.length param_bs in + let nparam = FStarC_List.length param_bs in let injective_type_params = false in let pack_ctor c = let uu___1 = c in match uu___1 with | (nm1, ty1) -> let lid = - FStarC_Ident.lid_of_path nm1 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path nm1 FStarC_Range_Type.dummyRange in let ty2 = let uu___2 = FStarC_Syntax_Syntax.mk_Total ty1 in FStarC_Syntax_Util.arrow param_bs uu___2 in @@ -1083,12 +1065,12 @@ let (pack_sigelt : FStarC_Syntax_Syntax.injective_type_params1 = injective_type_params }) in - let ctor_ses = FStarC_Compiler_List.map pack_ctor ctors in + let ctor_ses = FStarC_List.map pack_ctor ctors in let c_lids = - FStarC_Compiler_List.map + FStarC_List.map (fun se -> let uu___1 = FStarC_Syntax_Util.lid_of_sigelt se in - FStarC_Compiler_Util.must uu___1) ctor_ses in + FStarC_Util.must uu___1) ctor_ses in let ind_se = let param_bs1 = FStarC_Syntax_Subst.close_binders param_bs in let ty1 = FStarC_Syntax_Subst.close param_bs1 ty in @@ -1128,9 +1110,9 @@ let (pack_sigelt : FStarC_Syntax_Syntax.sigopts = (se.FStarC_Syntax_Syntax.sigopts) })) | FStarC_Reflection_V1_Data.Sg_Val (nm, us_names, ty) -> - let us_names1 = FStarC_Compiler_List.map pack_ident us_names in + let us_names1 = FStarC_List.map pack_ident us_names in let val_lid = - FStarC_Ident.lid_of_path nm FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path nm FStarC_Range_Type.dummyRange in (check_lid val_lid; (let typ = FStarC_Syntax_Subst.close_univ_vars us_names1 ty in FStarC_Syntax_Syntax.mk_sigelt @@ -1156,7 +1138,7 @@ let (inspect_lb : | (s, us1) -> let typ1 = FStarC_Syntax_Subst.subst s typ in let def1 = FStarC_Syntax_Subst.subst s def in - let us2 = FStarC_Compiler_List.map inspect_ident us1 in + let us2 = FStarC_List.map inspect_ident us1 in (match nm with | FStar_Pervasives.Inr fv -> { @@ -1175,13 +1157,13 @@ let (pack_lb : FStarC_Reflection_V1_Data.lb_us = us; FStarC_Reflection_V1_Data.lb_typ = typ; FStarC_Reflection_V1_Data.lb_def = def;_} -> - let us1 = FStarC_Compiler_List.map pack_ident us in + let us1 = FStarC_List.map pack_ident us in let s = FStarC_Syntax_Subst.univ_var_closing us1 in let typ1 = FStarC_Syntax_Subst.subst s typ in let def1 = FStarC_Syntax_Subst.subst s def in FStarC_Syntax_Util.mk_letbinding (FStar_Pervasives.Inr fv) us1 typ1 FStarC_Parser_Const.effect_Tot_lid def1 [] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (inspect_bv : FStarC_Syntax_Syntax.bv -> FStarC_Reflection_V1_Data.bv_view) = fun bv -> @@ -1196,7 +1178,7 @@ let (inspect_bv : let uu___4 = FStarC_Class_Show.show FStarC_Class_Show.showable_int bv.FStarC_Syntax_Syntax.index in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "inspect_bv: index is negative (%s : %s), index = %s" uu___2 uu___3 uu___4 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_CantInspect () @@ -1205,7 +1187,7 @@ let (inspect_bv : else (); (let uu___1 = let uu___2 = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Sealed.seal uu___2 in + FStarC_Sealed.seal uu___2 in let uu___2 = FStarC_BigInt.of_int_fs bv.FStarC_Syntax_Syntax.index in { FStarC_Reflection_V1_Data.bv_ppname = uu___1; @@ -1225,19 +1207,17 @@ let (pack_bv : FStarC_Reflection_V1_Data.bv_view -> FStarC_Syntax_Syntax.bv) let uu___4 = FStarC_BigInt.to_int_fs bvv.FStarC_Reflection_V1_Data.bv_index in FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___4 in - FStarC_Compiler_Util.format2 - "pack_bv: index is negative (%s), index = %s" - (FStarC_Compiler_Sealed.unseal - bvv.FStarC_Reflection_V1_Data.bv_ppname) uu___3 in + FStarC_Util.format2 "pack_bv: index is negative (%s), index = %s" + (FStarC_Sealed.unseal bvv.FStarC_Reflection_V1_Data.bv_ppname) + uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_CantInspect () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2) else ()); (let uu___1 = FStarC_Ident.mk_ident - ((FStarC_Compiler_Sealed.unseal - bvv.FStarC_Reflection_V1_Data.bv_ppname), - FStarC_Compiler_Range_Type.dummyRange) in + ((FStarC_Sealed.unseal bvv.FStarC_Reflection_V1_Data.bv_ppname), + FStarC_Range_Type.dummyRange) in let uu___2 = FStarC_BigInt.to_int_fs bvv.FStarC_Reflection_V1_Data.bv_index in { @@ -1292,12 +1272,12 @@ let (env_open_modules : fun e -> let uu___ = FStarC_Syntax_DsEnv.open_modules e.FStarC_TypeChecker_Env.dsenv in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (l, m) -> let uu___2 = FStarC_Ident.ids_of_lid l in - FStarC_Compiler_List.map FStarC_Ident.string_of_id uu___2) uu___ + FStarC_List.map FStarC_Ident.string_of_id uu___2) uu___ let (binders_of_env : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.binders) = fun e -> FStarC_TypeChecker_Env.all_binders e @@ -1516,12 +1496,11 @@ and (univs_eq : FStarC_Syntax_Syntax.universe Prims.list -> Prims.bool) = fun us1 -> fun us2 -> (eqlist ()) univ_eq us1 us2 let (implode_qn : Prims.string Prims.list -> Prims.string) = - fun ns -> FStarC_Compiler_String.concat "." ns + fun ns -> FStarC_String.concat "." ns let (explode_qn : Prims.string -> Prims.string Prims.list) = - fun s -> FStarC_Compiler_String.split [46] s + fun s -> FStarC_String.split [46] s let (compare_string : Prims.string -> Prims.string -> FStarC_BigInt.t) = - fun s1 -> - fun s2 -> FStarC_BigInt.of_int_fs (FStarC_Compiler_String.compare s1 s2) + fun s1 -> fun s2 -> FStarC_BigInt.of_int_fs (FStarC_String.compare s1 s2) let (push_binder : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.binder -> FStarC_TypeChecker_Env.env) @@ -1538,9 +1517,8 @@ let (close_term : FStarC_Syntax_Syntax.binder -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun b -> fun t -> FStarC_Syntax_Subst.close [b] t -let (range_of_term : - FStarC_Syntax_Syntax.term -> FStarC_Compiler_Range_Type.range) = +let (range_of_term : FStarC_Syntax_Syntax.term -> FStarC_Range_Type.range) = fun t -> t.FStarC_Syntax_Syntax.pos let (range_of_sigelt : - FStarC_Syntax_Syntax.sigelt -> FStarC_Compiler_Range_Type.range) = + FStarC_Syntax_Syntax.sigelt -> FStarC_Range_Type.range) = fun s -> s.FStarC_Syntax_Syntax.sigrng \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Constants.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Constants.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Reflection_V1_Constants.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Constants.ml index 572c68fd2dc..dcc30b516bf 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Constants.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Constants.ml @@ -19,8 +19,8 @@ let (refl_constant_term : refl_constant -> FStarC_Syntax_Syntax.term) = let (fstar_refl_lid : Prims.string Prims.list -> FStarC_Ident.lident) = fun s -> FStarC_Ident.lid_of_path - (FStarC_Compiler_List.op_At ["FStar"; "Stubs"; "Reflection"] s) - FStarC_Compiler_Range_Type.dummyRange + (FStar_List_Tot_Base.append ["FStar"; "Stubs"; "Reflection"] s) + FStarC_Range_Type.dummyRange let (fstar_refl_types_lid : Prims.string -> FStarC_Ident.lident) = fun s -> fstar_refl_lid ["Types"; s] let (fstar_refl_builtins_lid : Prims.string -> FStarC_Ident.lident) = @@ -233,12 +233,10 @@ let (ref_Mk_bv : refl_constant) = let uu___8 = fstar_refl_data_lid "bv_view" in let uu___9 = let uu___10 = - FStarC_Ident.mk_ident - ("bv_ppname", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("bv_ppname", FStarC_Range_Type.dummyRange) in let uu___11 = let uu___12 = - FStarC_Ident.mk_ident - ("bv_index", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("bv_index", FStarC_Range_Type.dummyRange) in [uu___12] in uu___10 :: uu___11 in (uu___8, uu___9) in @@ -253,20 +251,19 @@ let (ref_Mk_binder : refl_constant) = let uu___8 = fstar_refl_data_lid "binder_view" in let uu___9 = let uu___10 = - FStarC_Ident.mk_ident - ("binder_bv", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("binder_bv", FStarC_Range_Type.dummyRange) in let uu___11 = let uu___12 = FStarC_Ident.mk_ident - ("binder_qual", FStarC_Compiler_Range_Type.dummyRange) in + ("binder_qual", FStarC_Range_Type.dummyRange) in let uu___13 = let uu___14 = FStarC_Ident.mk_ident - ("binder_attrs", FStarC_Compiler_Range_Type.dummyRange) in + ("binder_attrs", FStarC_Range_Type.dummyRange) in let uu___15 = let uu___16 = FStarC_Ident.mk_ident - ("binder_sort", FStarC_Compiler_Range_Type.dummyRange) in + ("binder_sort", FStarC_Range_Type.dummyRange) in [uu___16] in uu___14 :: uu___15 in uu___12 :: uu___13 in @@ -283,20 +280,17 @@ let (ref_Mk_lb : refl_constant) = let uu___8 = fstar_refl_data_lid "lb_view" in let uu___9 = let uu___10 = - FStarC_Ident.mk_ident - ("lb_fv", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("lb_fv", FStarC_Range_Type.dummyRange) in let uu___11 = let uu___12 = - FStarC_Ident.mk_ident - ("lb_us", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("lb_us", FStarC_Range_Type.dummyRange) in let uu___13 = let uu___14 = - FStarC_Ident.mk_ident - ("lb_typ", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("lb_typ", FStarC_Range_Type.dummyRange) in let uu___15 = let uu___16 = FStarC_Ident.mk_ident - ("lb_def", FStarC_Compiler_Range_Type.dummyRange) in + ("lb_def", FStarC_Range_Type.dummyRange) in [uu___16] in uu___14 :: uu___15 in uu___12 :: uu___13 in diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Data.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Data.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_Reflection_V1_Data.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Data.ml index 14c35308b76..f3d0db911f2 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Data.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Data.ml @@ -2,7 +2,7 @@ open Prims type name = Prims.string Prims.list type typ = FStarC_Syntax_Syntax.term type binders = FStarC_Syntax_Syntax.binder Prims.list -type ident = (Prims.string * FStarC_Compiler_Range_Type.range) +type ident = (Prims.string * FStarC_Range_Type.range) type univ_name = ident type vconst = | C_Unit @@ -10,7 +10,7 @@ type vconst = | C_True | C_False | C_String of Prims.string - | C_Range of FStarC_Compiler_Range_Type.range + | C_Range of FStarC_Range_Type.range | C_Reify | C_Reflect of name let (uu___is_C_Unit : vconst -> Prims.bool) = @@ -30,8 +30,8 @@ let (__proj__C_String__item___0 : vconst -> Prims.string) = fun projectee -> match projectee with | C_String _0 -> _0 let (uu___is_C_Range : vconst -> Prims.bool) = fun projectee -> match projectee with | C_Range _0 -> true | uu___ -> false -let (__proj__C_Range__item___0 : vconst -> FStarC_Compiler_Range_Type.range) - = fun projectee -> match projectee with | C_Range _0 -> _0 +let (__proj__C_Range__item___0 : vconst -> FStarC_Range_Type.range) = + fun projectee -> match projectee with | C_Range _0 -> _0 let (uu___is_C_Reify : vconst -> Prims.bool) = fun projectee -> match projectee with | C_Reify -> true | uu___ -> false let (uu___is_C_Reflect : vconst -> Prims.bool) = @@ -45,8 +45,7 @@ type pattern = | Pat_Cons of (FStarC_Syntax_Syntax.fv * FStarC_Syntax_Syntax.universe Prims.list FStar_Pervasives_Native.option * (pattern * Prims.bool) Prims.list) - | Pat_Var of (FStarC_Syntax_Syntax.bv * typ FStarC_Compiler_Sealed.sealed) - + | Pat_Var of (FStarC_Syntax_Syntax.bv * typ FStarC_Sealed.sealed) | Pat_Dot_Term of FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option let (uu___is_Pat_Constant : pattern -> Prims.bool) = fun projectee -> @@ -64,7 +63,7 @@ let (__proj__Pat_Cons__item___0 : let (uu___is_Pat_Var : pattern -> Prims.bool) = fun projectee -> match projectee with | Pat_Var _0 -> true | uu___ -> false let (__proj__Pat_Var__item___0 : - pattern -> (FStarC_Syntax_Syntax.bv * typ FStarC_Compiler_Sealed.sealed)) = + pattern -> (FStarC_Syntax_Syntax.bv * typ FStarC_Sealed.sealed)) = fun projectee -> match projectee with | Pat_Var _0 -> _0 let (uu___is_Pat_Dot_Term : pattern -> Prims.bool) = fun projectee -> @@ -86,9 +85,8 @@ let (uu___is_Q_Meta : aqualv -> Prims.bool) = let (__proj__Q_Meta__item___0 : aqualv -> FStarC_Syntax_Syntax.term) = fun projectee -> match projectee with | Q_Meta _0 -> _0 type argv = (FStarC_Syntax_Syntax.term * aqualv) -type ppname_t = Prims.string FStarC_Compiler_Sealed.sealed -let (as_ppname : Prims.string -> ppname_t) = - fun x -> FStarC_Compiler_Sealed.seal x +type ppname_t = Prims.string FStarC_Sealed.sealed +let (as_ppname : Prims.string -> ppname_t) = fun x -> FStarC_Sealed.seal x type bv_view = { bv_ppname: ppname_t ; bv_index: FStarC_BigInt.t } @@ -127,7 +125,7 @@ type universe_view = | Uv_Succ of FStarC_Syntax_Syntax.universe | Uv_Max of universes | Uv_BVar of FStarC_BigInt.t - | Uv_Name of (Prims.string * FStarC_Compiler_Range_Type.range) + | Uv_Name of (Prims.string * FStarC_Range_Type.range) | Uv_Unif of FStarC_Syntax_Syntax.universe_uvar | Uv_Unk let (uu___is_Uv_Zero : universe_view -> Prims.bool) = @@ -148,7 +146,7 @@ let (__proj__Uv_BVar__item___0 : universe_view -> FStarC_BigInt.t) = let (uu___is_Uv_Name : universe_view -> Prims.bool) = fun projectee -> match projectee with | Uv_Name _0 -> true | uu___ -> false let (__proj__Uv_Name__item___0 : - universe_view -> (Prims.string * FStarC_Compiler_Range_Type.range)) = + universe_view -> (Prims.string * FStarC_Range_Type.range)) = fun projectee -> match projectee with | Uv_Name _0 -> _0 let (uu___is_Uv_Unif : universe_view -> Prims.bool) = fun projectee -> match projectee with | Uv_Unif _0 -> true | uu___ -> false diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Embeddings.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Embeddings.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Reflection_V1_Embeddings.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Embeddings.ml index cb8f5cb85d5..4015906eb06 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Embeddings.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Embeddings.ml @@ -2,8 +2,7 @@ open Prims let (noaqs : FStarC_Syntax_Syntax.antiquotations) = (Prims.int_zero, []) let mk_emb : 'uuuuu . - (FStarC_Compiler_Range_Type.range -> 'uuuuu -> FStarC_Syntax_Syntax.term) - -> + (FStarC_Range_Type.range -> 'uuuuu -> FStarC_Syntax_Syntax.term) -> (FStarC_Syntax_Syntax.term -> 'uuuuu FStar_Pervasives_Native.option) -> FStarC_Syntax_Syntax.term -> 'uuuuu FStarC_Syntax_Embeddings_Base.embedding @@ -18,7 +17,7 @@ let mk_emb : let embed : 'a . 'a FStarC_Syntax_Embeddings_Base.embedding -> - FStarC_Compiler_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term + FStarC_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term = fun uu___ -> fun r -> @@ -75,7 +74,7 @@ let (e_aqualv : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_Q_Meta.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange in + uu___ FStarC_Range_Type.dummyRange in { FStarC_Syntax_Syntax.n = (r.FStarC_Syntax_Syntax.n); FStarC_Syntax_Syntax.pos = rng; @@ -110,7 +109,7 @@ let (e_aqualv : FStarC_Reflection_V1_Constants.ref_Q_Meta.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed e_term t2 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun t3 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Q_Meta t3)) @@ -205,7 +204,7 @@ let (e_universe_view : -> let uu___3 = unembed FStarC_Reflection_V2_Embeddings.e_universe u in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun u1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Uv_Succ u1)) @@ -217,7 +216,7 @@ let (e_universe_view : unembed (FStarC_Syntax_Embeddings.e_list FStarC_Reflection_V2_Embeddings.e_universe) us in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun us1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Uv_Max us1)) @@ -226,7 +225,7 @@ let (e_universe_view : FStarC_Reflection_V1_Constants.ref_Uv_BVar.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Syntax_Embeddings.e_int n in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun n1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Uv_BVar n1)) @@ -235,7 +234,7 @@ let (e_universe_view : FStarC_Reflection_V1_Constants.ref_Uv_Name.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed e_ident i in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun i1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Uv_Name i1)) @@ -297,7 +296,7 @@ let (e_const : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_C_Int.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.C_String s -> let uu___ = let uu___1 = @@ -306,7 +305,7 @@ let (e_const : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_C_String.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.C_Range r1 -> let uu___ = let uu___1 = @@ -315,7 +314,7 @@ let (e_const : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_C_Range.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.C_Reify -> FStarC_Reflection_V1_Constants.ref_C_Reify.FStarC_Reflection_V1_Constants.t | FStarC_Reflection_V1_Data.C_Reflect ns -> @@ -327,7 +326,7 @@ let (e_const : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_C_Reflect.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange in + uu___ FStarC_Range_Type.dummyRange in { FStarC_Syntax_Syntax.n = (r.FStarC_Syntax_Syntax.n); FStarC_Syntax_Syntax.pos = rng; @@ -363,7 +362,7 @@ let (e_const : FStarC_Reflection_V1_Constants.ref_C_Int.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Syntax_Embeddings.e_int i in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun i1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Int i1)) @@ -372,7 +371,7 @@ let (e_const : FStarC_Reflection_V1_Constants.ref_C_String.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Syntax_Embeddings.e_string s in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun s1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_String s1)) @@ -381,7 +380,7 @@ let (e_const : FStarC_Reflection_V1_Constants.ref_C_Range.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Syntax_Embeddings.e_range r in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun r1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Range r1)) @@ -395,7 +394,7 @@ let (e_const : FStarC_Reflection_V1_Constants.ref_C_Reflect.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Syntax_Embeddings.e_string_list ns in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ns1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Reflect ns1)) @@ -492,7 +491,7 @@ let rec e_pattern_aq : FStarC_Reflection_V1_Constants.ref_Pat_Constant.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed e_const c in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun c1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Pat_Constant c1)) @@ -502,7 +501,7 @@ let rec e_pattern_aq : FStarC_Reflection_V1_Constants.ref_Pat_Cons.FStarC_Reflection_V1_Constants.lid -> let uu___5 = unembed FStarC_Reflection_V2_Embeddings.e_fv f in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun f1 -> let uu___6 = unembed @@ -510,7 +509,7 @@ let rec e_pattern_aq : (FStarC_Syntax_Embeddings.e_list FStarC_Reflection_V2_Embeddings.e_universe)) us_opt in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun us_opt1 -> let uu___7 = let uu___8 = @@ -520,7 +519,7 @@ let rec e_pattern_aq : FStarC_Syntax_Embeddings.e_bool in FStarC_Syntax_Embeddings.e_list uu___9 in unembed uu___8 ps in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun ps1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Pat_Cons @@ -531,11 +530,11 @@ let rec e_pattern_aq : FStarC_Reflection_V1_Constants.ref_Pat_Var.FStarC_Reflection_V1_Constants.lid -> let uu___4 = unembed e_bv bv in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun bv1 -> let uu___5 = unembed (FStarC_Syntax_Embeddings.e_sealed e_term) sort in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun sort1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Pat_Var (bv1, sort1)))) @@ -545,7 +544,7 @@ let rec e_pattern_aq : -> let uu___3 = unembed (FStarC_Syntax_Embeddings.e_option e_term) eopt in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun eopt1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Pat_Dot_Term eopt1)) @@ -907,7 +906,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Var.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed e_bv b in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun b1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Var b1)) @@ -916,7 +915,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_BVar.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed e_bv b in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun b1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_BVar b1)) @@ -925,7 +924,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_FVar.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Reflection_V2_Embeddings.e_fv f in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun f1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_FVar f1)) @@ -935,13 +934,13 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_UInst.FStarC_Reflection_V1_Constants.lid -> let uu___4 = unembed FStarC_Reflection_V2_Embeddings.e_fv f in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun f1 -> let uu___5 = unembed (FStarC_Syntax_Embeddings.e_list FStarC_Reflection_V2_Embeddings.e_universe) us in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun us1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_UInst (f1, us1)))) @@ -951,10 +950,10 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_App.FStarC_Reflection_V1_Constants.lid -> let uu___4 = unembed e_term l in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun l1 -> let uu___5 = unembed e_argv r in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun r1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_App (l1, r1)))) @@ -965,10 +964,10 @@ let (e_term_view_aq : -> let uu___4 = unembed FStarC_Reflection_V2_Embeddings.e_binder b in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun b1 -> let uu___5 = unembed e_term t1 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Abs (b1, t2)))) @@ -979,11 +978,11 @@ let (e_term_view_aq : -> let uu___4 = unembed FStarC_Reflection_V2_Embeddings.e_binder b in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun b1 -> let uu___5 = unembed FStarC_Reflection_V2_Embeddings.e_comp t1 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun c -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Arrow (b1, c)))) @@ -993,7 +992,7 @@ let (e_term_view_aq : -> let uu___3 = unembed FStarC_Reflection_V2_Embeddings.e_universe u in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun u1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Type u1)) @@ -1003,13 +1002,13 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Refine.FStarC_Reflection_V1_Constants.lid -> let uu___5 = unembed e_bv b in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun b1 -> let uu___6 = unembed e_term sort in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun sort1 -> let uu___7 = unembed e_term t1 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Refine @@ -1019,7 +1018,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Const.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed e_const c in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun c1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Const c1)) @@ -1029,7 +1028,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Uvar.FStarC_Reflection_V1_Constants.lid -> let uu___4 = unembed FStarC_Syntax_Embeddings.e_int u in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun u1 -> let ctx_u_s = FStarC_Syntax_Util.unlazy_as_t @@ -1043,23 +1042,23 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Let.FStarC_Reflection_V1_Constants.lid -> let uu___8 = unembed FStarC_Syntax_Embeddings.e_bool r in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun r1 -> let uu___9 = unembed (FStarC_Syntax_Embeddings.e_list e_term) attrs in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun attrs1 -> let uu___10 = unembed e_bv b in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun b1 -> let uu___11 = unembed e_term ty in - FStarC_Compiler_Util.bind_opt uu___11 + FStarC_Util.bind_opt uu___11 (fun ty1 -> let uu___12 = unembed e_term t1 in - FStarC_Compiler_Util.bind_opt uu___12 + FStarC_Util.bind_opt uu___12 (fun t11 -> let uu___13 = unembed e_term t2 in - FStarC_Compiler_Util.bind_opt uu___13 + FStarC_Util.bind_opt uu___13 (fun t21 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Let @@ -1071,15 +1070,15 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Match.FStarC_Reflection_V1_Constants.lid -> let uu___5 = unembed e_term t1 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun t2 -> let uu___6 = unembed e_match_returns_annotation ret_opt in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun ret_opt1 -> let uu___7 = unembed (FStarC_Syntax_Embeddings.e_list e_branch) brs in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun brs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Match @@ -1091,20 +1090,20 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_AscT.FStarC_Reflection_V1_Constants.lid -> let uu___6 = unembed e_term e in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun e1 -> let uu___7 = unembed e_term t1 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun t2 -> let uu___8 = unembed (FStarC_Syntax_Embeddings.e_option e_term) tacopt in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun tacopt1 -> let uu___9 = unembed FStarC_Syntax_Embeddings.e_bool use_eq in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun use_eq1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_AscribedT @@ -1116,20 +1115,20 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_AscC.FStarC_Reflection_V1_Constants.lid -> let uu___6 = unembed e_term e in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun e1 -> let uu___7 = unembed e_comp c in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun c1 -> let uu___8 = unembed (FStarC_Syntax_Embeddings.e_option e_term) tacopt in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun tacopt1 -> let uu___9 = unembed FStarC_Syntax_Embeddings.e_bool use_eq in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun use_eq1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_AscribedC @@ -1198,10 +1197,10 @@ let (e_bv_view : unembed (FStarC_Syntax_Embeddings.e_sealed FStarC_Syntax_Embeddings.e_string) nm in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun nm1 -> let uu___5 = unembed FStarC_Syntax_Embeddings.e_int idx in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun idx1 -> FStar_Pervasives_Native.Some { @@ -1268,16 +1267,16 @@ let (e_binder_view : FStarC_Reflection_V1_Constants.ref_Mk_binder.FStarC_Reflection_V1_Constants.lid -> let uu___6 = unembed e_bv bv in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun bv1 -> let uu___7 = unembed e_aqualv q in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun q1 -> let uu___8 = unembed e_attributes attrs in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun attrs1 -> let uu___9 = unembed e_term sort in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun sort1 -> FStar_Pervasives_Native.Some { @@ -1387,7 +1386,7 @@ let (e_comp_view : FStarC_Reflection_V1_Constants.ref_C_Total.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed e_term t2 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun t3 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Total t3)) @@ -1396,7 +1395,7 @@ let (e_comp_view : FStarC_Reflection_V1_Constants.ref_C_GTotal.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed e_term t2 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun t3 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_GTotal t3)) @@ -1406,13 +1405,13 @@ let (e_comp_view : FStarC_Reflection_V1_Constants.ref_C_Lemma.FStarC_Reflection_V1_Constants.lid -> let uu___5 = unembed e_term pre in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun pre1 -> let uu___6 = unembed e_term post in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun post1 -> let uu___7 = unembed e_term pats in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun pats1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Lemma @@ -1427,26 +1426,26 @@ let (e_comp_view : unembed (FStarC_Syntax_Embeddings.e_list FStarC_Reflection_V2_Embeddings.e_universe) us in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun us1 -> let uu___8 = unembed FStarC_Syntax_Embeddings.e_string_list eff in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun eff1 -> let uu___9 = unembed e_term res in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun res1 -> let uu___10 = unembed (FStarC_Syntax_Embeddings.e_list e_argv) args1 in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun args2 -> let uu___11 = unembed (FStarC_Syntax_Embeddings.e_list e_term) decrs in - FStarC_Compiler_Util.bind_opt uu___11 + FStarC_Util.bind_opt uu___11 (fun decrs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Eff @@ -1532,17 +1531,17 @@ let (e_lb_view : FStarC_Reflection_V1_Constants.ref_Mk_lb.FStarC_Reflection_V1_Constants.lid -> let uu___6 = unembed FStarC_Reflection_V2_Embeddings.e_fv fv' in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun fv'1 -> let uu___7 = unembed (FStarC_Syntax_Embeddings.e_list e_ident) us in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun us1 -> let uu___8 = unembed e_term typ in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun typ1 -> let uu___9 = unembed e_term def in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun def1 -> FStar_Pervasives_Native.Some { @@ -1685,24 +1684,24 @@ let (e_sigelt_view : FStarC_Reflection_V1_Constants.ref_Sg_Inductive.FStarC_Reflection_V1_Constants.lid -> let uu___7 = unembed FStarC_Syntax_Embeddings.e_string_list nm in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun nm1 -> let uu___8 = unembed (FStarC_Syntax_Embeddings.e_list e_ident) us in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun us1 -> let uu___9 = unembed FStarC_Reflection_V2_Embeddings.e_binders bs in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun bs1 -> let uu___10 = unembed e_term t2 in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun t3 -> let uu___11 = unembed (FStarC_Syntax_Embeddings.e_list e_ctor) dcs in - FStarC_Compiler_Util.bind_opt uu___11 + FStarC_Util.bind_opt uu___11 (fun dcs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Sg_Inductive @@ -1713,13 +1712,13 @@ let (e_sigelt_view : FStarC_Reflection_V1_Constants.ref_Sg_Let.FStarC_Reflection_V1_Constants.lid -> let uu___4 = unembed FStarC_Syntax_Embeddings.e_bool r in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun r1 -> let uu___5 = unembed (FStarC_Syntax_Embeddings.e_list FStarC_Reflection_V2_Embeddings.e_letbinding) lbs in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun lbs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Sg_Let (r1, lbs1)))) @@ -1729,14 +1728,14 @@ let (e_sigelt_view : FStarC_Reflection_V1_Constants.ref_Sg_Val.FStarC_Reflection_V1_Constants.lid -> let uu___5 = unembed FStarC_Syntax_Embeddings.e_string_list nm in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun nm1 -> let uu___6 = unembed (FStarC_Syntax_Embeddings.e_list e_ident) us in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun us1 -> let uu___7 = unembed e_term t2 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun t3 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Sg_Val @@ -1798,7 +1797,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_qual_Reflectable.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Discriminator l -> let uu___ = let uu___1 = @@ -1807,7 +1806,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_qual_Discriminator.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Action l -> let uu___ = let uu___1 = @@ -1816,7 +1815,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_qual_Action.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.Projector (l, i) -> let uu___ = let uu___1 = @@ -1829,7 +1828,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_qual_Projector.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.RecordType (ids1, ids2) -> let uu___ = let uu___1 = @@ -1843,7 +1842,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_qual_RecordType.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V1_Data.RecordConstructor (ids1, ids2) -> let uu___ = let uu___1 = @@ -1857,7 +1856,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V1_Constants.ref_qual_RecordConstructor.FStarC_Reflection_V1_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange in + uu___ FStarC_Range_Type.dummyRange in { FStarC_Syntax_Syntax.n = (r.FStarC_Syntax_Syntax.n); FStarC_Syntax_Syntax.pos = rng; @@ -1975,7 +1974,7 @@ let (e_qualifier : FStarC_Reflection_V1_Constants.ref_qual_Reflectable.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Syntax_Embeddings.e_string_list l in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Reflectable l1)) @@ -1984,7 +1983,7 @@ let (e_qualifier : FStarC_Reflection_V1_Constants.ref_qual_Discriminator.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Syntax_Embeddings.e_string_list l in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Discriminator l1)) @@ -1993,7 +1992,7 @@ let (e_qualifier : FStarC_Reflection_V1_Constants.ref_qual_Action.FStarC_Reflection_V1_Constants.lid -> let uu___3 = unembed FStarC_Syntax_Embeddings.e_string_list l in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Action l1)) @@ -2005,7 +2004,7 @@ let (e_qualifier : unembed (FStarC_Syntax_Embeddings.e_tuple2 FStarC_Syntax_Embeddings.e_string_list e_ident) payload in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun uu___4 -> match uu___4 with | (l, i) -> @@ -2020,7 +2019,7 @@ let (e_qualifier : (FStarC_Syntax_Embeddings.e_tuple2 (FStarC_Syntax_Embeddings.e_list e_ident) (FStarC_Syntax_Embeddings.e_list e_ident)) payload in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun uu___4 -> match uu___4 with | (ids1, ids2) -> @@ -2035,7 +2034,7 @@ let (e_qualifier : (FStarC_Syntax_Embeddings.e_tuple2 (FStarC_Syntax_Embeddings.e_list e_ident) (FStarC_Syntax_Embeddings.e_list e_ident)) payload in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun uu___4 -> match uu___4 with | (ids1, ids2) -> diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Interpreter.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Interpreter.ml similarity index 99% rename from stage0/fstar-lib/generated/FStarC_Reflection_V1_Interpreter.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Interpreter.ml index 8b2db5db7c5..d06bc6dd8f4 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V1_Interpreter.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_Interpreter.ml @@ -558,5 +558,5 @@ let (reflection_primops : uu___41 :: uu___42 in uu___ :: uu___40 let (uu___40 : unit) = - FStarC_Compiler_List.iter FStarC_TypeChecker_Cfg.register_extra_step + FStarC_List.iter FStarC_TypeChecker_Cfg.register_extra_step reflection_primops \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V1_NBEEmbeddings.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_NBEEmbeddings.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_Reflection_V1_NBEEmbeddings.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_NBEEmbeddings.ml index 6dd3c51c3f8..413597c8f7e 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V1_NBEEmbeddings.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V1_NBEEmbeddings.ml @@ -9,8 +9,8 @@ let (mkFV : fun fv -> fun us -> fun ts -> - FStarC_TypeChecker_NBETerm.mkFV fv (FStarC_Compiler_List.rev us) - (FStarC_Compiler_List.rev ts) + FStarC_TypeChecker_NBETerm.mkFV fv (FStarC_List.rev us) + (FStarC_List.rev ts) let (mkConstruct : FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.universe Prims.list -> @@ -20,8 +20,8 @@ let (mkConstruct : fun fv -> fun us -> fun ts -> - FStarC_TypeChecker_NBETerm.mkConstruct fv - (FStarC_Compiler_List.rev us) (FStarC_Compiler_List.rev ts) + FStarC_TypeChecker_NBETerm.mkConstruct fv (FStarC_List.rev us) + (FStarC_List.rev ts) let (fv_as_emb_typ : FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.emb_typ) = fun fv -> @@ -65,8 +65,7 @@ let mk_lazy : FStarC_Syntax_Syntax.blob = uu___; FStarC_Syntax_Syntax.lkind = kind; FStarC_Syntax_Syntax.ltyp = ty; - FStarC_Syntax_Syntax.rng = - FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.rng = FStarC_Range_Type.dummyRange } in let thunk = FStarC_Thunk.mk @@ -95,7 +94,7 @@ let (e_bv : FStarC_Syntax_Syntax.bv FStarC_TypeChecker_NBETerm.embedding) = | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded bv: %s" uu___3 in + FStarC_Util.format1 "Not an embedded bv: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -121,7 +120,7 @@ let (e_binder : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded binder: %s" uu___3 in + FStarC_Util.format1 "Not an embedded binder: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -139,10 +138,10 @@ let rec mapM_opt : | [] -> FStar_Pervasives_Native.Some [] | x::xs -> let uu___ = f x in - FStarC_Compiler_Util.bind_opt uu___ + FStarC_Util.bind_opt uu___ (fun x1 -> let uu___1 = mapM_opt f xs in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun xs1 -> FStar_Pervasives_Native.Some (x1 :: xs1))) let (e_term_aq : (Prims.int * FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax @@ -165,7 +164,7 @@ let (e_term_aq : FStarC_Reflection_V1_Embeddings.e_term_aq (Prims.int_zero, []) in let uu___1 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_quoted (tm, qi)) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Syntax_Embeddings_Base.unembed uu___ uu___1 FStarC_Syntax_Embeddings_Base.id_norm_cb | uu___ -> FStar_Pervasives_Native.None in @@ -182,13 +181,12 @@ let (e_term_aq : let (e_term : FStarC_Syntax_Syntax.term FStarC_TypeChecker_NBETerm.embedding) = e_term_aq (Prims.int_zero, []) let (e_sort : - FStarC_Syntax_Syntax.term FStarC_Compiler_Sealed.sealed + FStarC_Syntax_Syntax.term FStarC_Sealed.sealed FStarC_TypeChecker_NBETerm.embedding) = FStarC_TypeChecker_NBETerm.e_sealed e_term let (e_ppname : - Prims.string FStarC_Compiler_Sealed.sealed - FStarC_TypeChecker_NBETerm.embedding) - = FStarC_TypeChecker_NBETerm.e_sealed FStarC_TypeChecker_NBETerm.e_string + Prims.string FStarC_Sealed.sealed FStarC_TypeChecker_NBETerm.embedding) = + FStarC_TypeChecker_NBETerm.e_sealed FStarC_TypeChecker_NBETerm.e_string let (e_aqualv : FStarC_Reflection_V1_Data.aqualv FStarC_TypeChecker_NBETerm.embedding) = let embed_aqualv cb q = @@ -225,14 +223,14 @@ let (e_aqualv : FStarC_Reflection_V1_Constants.ref_Q_Meta.FStarC_Reflection_V1_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Q_Meta t2)) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded aqualv: %s" uu___3 in + FStarC_Util.format1 "Not an embedded aqualv: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -264,7 +262,7 @@ let (e_fv : FStarC_Syntax_Syntax.fv FStarC_TypeChecker_NBETerm.embedding) = | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded fvar: %s" uu___3 in + FStarC_Util.format1 "Not an embedded fvar: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -290,7 +288,7 @@ let (e_comp : FStarC_Syntax_Syntax.comp FStarC_TypeChecker_NBETerm.embedding) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded comp: %s" uu___3 in + FStarC_Util.format1 "Not an embedded comp: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -317,7 +315,7 @@ let (e_env : FStarC_TypeChecker_Env.env FStarC_TypeChecker_NBETerm.embedding) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded env: %s" uu___3 in + FStarC_Util.format1 "Not an embedded env: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -410,7 +408,7 @@ let (e_const : let uu___1 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb i in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun i1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Int i1)) @@ -421,7 +419,7 @@ let (e_const : let uu___1 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_string cb s in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun s1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_String s1)) @@ -432,7 +430,7 @@ let (e_const : let uu___1 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_range cb r in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun r1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Range r1)) @@ -447,14 +445,14 @@ let (e_const : let uu___1 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_string_list cb ns in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun ns1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Reflect ns1)) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded vconst: %s" uu___3 in + FStarC_Util.format1 "Not an embedded vconst: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -481,8 +479,7 @@ let (e_universe : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded universe: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded universe: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -568,7 +565,7 @@ let rec e_pattern_aq : FStarC_Reflection_V1_Constants.ref_Pat_Constant.FStarC_Reflection_V1_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_const cb c in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun c1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Pat_Constant c1)) @@ -578,14 +575,14 @@ let rec e_pattern_aq : FStarC_Reflection_V1_Constants.ref_Pat_Cons.FStarC_Reflection_V1_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_fv cb f in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun f1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_option (FStarC_TypeChecker_NBETerm.e_list e_universe)) cb us_opt in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun us -> let uu___5 = let uu___6 = @@ -595,7 +592,7 @@ let rec e_pattern_aq : FStarC_TypeChecker_NBETerm.e_bool in FStarC_TypeChecker_NBETerm.e_list uu___7 in FStarC_TypeChecker_NBETerm.unembed uu___6 cb ps in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ps1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Pat_Cons (f1, us, ps1))))) @@ -605,10 +602,10 @@ let rec e_pattern_aq : FStarC_Reflection_V1_Constants.ref_Pat_Var.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_bv cb bv in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun bv1 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_sort cb sort in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun sort1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Pat_Var (bv1, sort1)))) @@ -619,15 +616,14 @@ let rec e_pattern_aq : let uu___1 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_option e_term) cb eopt in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun eopt1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Pat_Dot_Term eopt1)) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded pattern: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded pattern: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -772,7 +768,7 @@ let (e_universe_view : FStarC_Reflection_V1_Constants.ref_Uv_Succ.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_universe cb u in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun u1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Uv_Succ u1)) @@ -783,7 +779,7 @@ let (e_universe_view : let uu___2 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_universe) cb us in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun us1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Uv_Max us1)) @@ -794,7 +790,7 @@ let (e_universe_view : let uu___2 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb n in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun n1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Uv_BVar n1)) @@ -807,7 +803,7 @@ let (e_universe_view : (FStarC_TypeChecker_NBETerm.e_tuple2 FStarC_TypeChecker_NBETerm.e_string FStarC_TypeChecker_NBETerm.e_range) cb i in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun i1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Uv_Name i1)) @@ -824,8 +820,7 @@ let (e_universe_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded universe view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded universe view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1134,7 +1129,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Var.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_bv cb b in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun b1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Var b1)) @@ -1144,7 +1139,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_BVar.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_bv cb b in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun b1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_BVar b1)) @@ -1154,7 +1149,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_FVar.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_fv cb f in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun f1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_FVar f1)) @@ -1164,12 +1159,12 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_UInst.FStarC_Reflection_V1_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_fv cb f in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun f1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_universe) cb us in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun us1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_UInst (f1, us1)))) @@ -1179,10 +1174,10 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_App.FStarC_Reflection_V1_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_term cb l in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun l1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_argv cb r in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun r1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_App (l1, r1)))) @@ -1192,10 +1187,10 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Abs.FStarC_Reflection_V1_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_binder cb b in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun b1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Abs (b1, t2)))) @@ -1205,10 +1200,10 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Arrow.FStarC_Reflection_V1_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_binder cb b in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun b1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_comp cb t1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun c -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Arrow (b1, c)))) @@ -1218,7 +1213,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Type.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_universe cb u in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun u1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Type u1)) @@ -1228,14 +1223,14 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Refine.FStarC_Reflection_V1_Constants.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_bv cb b in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun b1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb sort in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun sort1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Refine @@ -1246,7 +1241,7 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Const.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_const cb c in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun c1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Const c1)) @@ -1258,7 +1253,7 @@ let (e_term_view_aq : let uu___3 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb u in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun u1 -> let ctx_u_s = unlazy_as_t FStarC_Syntax_Syntax.Lazy_uvar l in FStar_Pervasives_Native.Some @@ -1275,29 +1270,29 @@ let (e_term_view_aq : let uu___7 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_bool cb r in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun r1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_term) cb attrs in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun attrs1 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e_bv cb b in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun b1 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e_term cb ty in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun ty1 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___11 + FStarC_Util.bind_opt uu___11 (fun t11 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e_term cb t2 in - FStarC_Compiler_Util.bind_opt uu___12 + FStarC_Util.bind_opt uu___12 (fun t21 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Let @@ -1309,17 +1304,17 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_Match.FStarC_Reflection_V1_Constants.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun t2 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_branch) cb brs in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun brs1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_match_returns_annotation cb ret_opt in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun ret_opt1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_Match @@ -1332,21 +1327,21 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_AscT.FStarC_Reflection_V1_Constants.lid -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb e in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun e1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun t2 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_option e_term) cb tacopt in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun tacopt1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_bool cb use_eq in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun use_eq1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_AscribedT @@ -1359,21 +1354,21 @@ let (e_term_view_aq : FStarC_Reflection_V1_Constants.ref_Tv_AscC.FStarC_Reflection_V1_Constants.lid -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb e in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun e1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_comp cb c in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun c1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_option e_term) cb tacopt in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun tacopt1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_bool cb use_eq in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun use_eq1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Tv_AscribedC @@ -1390,8 +1385,7 @@ let (e_term_view_aq : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded term_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded term_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1434,12 +1428,12 @@ let (e_bv_view : FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_sealed FStarC_TypeChecker_NBETerm.e_string) cb nm in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun nm1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb idx in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun idx1 -> FStar_Pervasives_Native.Some { @@ -1449,7 +1443,7 @@ let (e_bv_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded bv_view: %s" uu___3 in + FStarC_Util.format1 "Not an embedded bv_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1508,18 +1502,18 @@ let (e_binder_view : FStarC_Reflection_V1_Constants.ref_Mk_binder.FStarC_Reflection_V1_Constants.lid -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_bv cb bv in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun bv1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_aqualv cb q in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun q1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e_attributes cb attrs in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun attrs1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_term cb sort in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun sort1 -> FStar_Pervasives_Native.Some { @@ -1532,8 +1526,7 @@ let (e_binder_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded binder_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded binder_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1625,7 +1618,7 @@ let (e_comp_view : FStarC_Reflection_V1_Constants.ref_C_Total.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Total t2)) @@ -1634,7 +1627,7 @@ let (e_comp_view : FStarC_Reflection_V1_Constants.ref_C_GTotal.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_GTotal t2)) @@ -1644,14 +1637,14 @@ let (e_comp_view : FStarC_Reflection_V1_Constants.ref_C_Lemma.FStarC_Reflection_V1_Constants.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_term cb pre in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun pre1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb post in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun post1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_term cb pats in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun pats1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Lemma @@ -1667,27 +1660,27 @@ let (e_comp_view : let uu___6 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_universe) cb us in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun us1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_string_list cb eff in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun eff1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_term cb res in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun res1 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_argv) cb args in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun args1 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_term) cb decrs in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun decrs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.C_Eff @@ -1695,8 +1688,7 @@ let (e_comp_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded comp_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded comp_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1723,7 +1715,7 @@ let (e_sigelt : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded sigelt: %s" uu___3 in + FStarC_Util.format1 "Not an embedded sigelt: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1788,19 +1780,19 @@ let (e_lb_view : FStarC_Reflection_V1_Constants.ref_Mk_lb.FStarC_Reflection_V1_Constants.lid -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_fv cb fv' in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun fv'1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_univ_names cb us in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun us1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e_term cb typ in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun typ1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_term cb def in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun def1 -> FStar_Pervasives_Native.Some { @@ -1812,7 +1804,7 @@ let (e_lb_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded lb_view: %s" uu___3 in + FStarC_Util.format1 "Not an embedded lb_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1825,9 +1817,8 @@ let (e_lid : FStarC_Ident.lid FStarC_TypeChecker_NBETerm.embedding) = FStarC_TypeChecker_NBETerm.embed e_string_list rng uu___ in let unembed cb t = let uu___ = FStarC_TypeChecker_NBETerm.unembed e_string_list cb t in - FStarC_Compiler_Util.map_opt uu___ - (fun p -> - FStarC_Ident.lid_of_path p FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Util.map_opt uu___ + (fun p -> FStarC_Ident.lid_of_path p FStarC_Range_Type.dummyRange) in FStarC_TypeChecker_NBETerm.mk_emb embed unembed (fun uu___ -> mkConstruct FStarC_Reflection_V1_Constants.fstar_refl_aqualv_fv [] []) @@ -1853,8 +1844,7 @@ let (e_letbinding : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded letbinding: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded letbinding: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1951,25 +1941,25 @@ let (e_sigelt_view : FStarC_Reflection_V1_Constants.ref_Sg_Inductive.FStarC_Reflection_V1_Constants.lid -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_string_list cb nm in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun nm1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e_univ_names cb us in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun us1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_binders cb bs in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun bs1 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun t2 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_ctor) cb dcs in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun dcs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Sg_Inductive @@ -1982,12 +1972,12 @@ let (e_sigelt_view : let uu___3 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_bool cb r in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun r1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_letbinding) cb lbs in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun lbs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Sg_Let (r1, lbs1)))) @@ -1997,15 +1987,15 @@ let (e_sigelt_view : FStarC_Reflection_V1_Constants.ref_Sg_Val.FStarC_Reflection_V1_Constants.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_string_list cb nm in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun nm1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_univ_names cb us in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun us1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Sg_Val (nm1, us1, t2))))) @@ -2016,8 +2006,7 @@ let (e_sigelt_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded sigelt_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded sigelt_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2260,7 +2249,7 @@ let (e_qualifier : FStarC_Reflection_V1_Constants.ref_qual_Reflectable.FStarC_Reflection_V1_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_name cb l in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Reflectable l1)) @@ -2269,7 +2258,7 @@ let (e_qualifier : FStarC_Reflection_V1_Constants.ref_qual_Discriminator.FStarC_Reflection_V1_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_name cb l in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Discriminator l1)) @@ -2278,7 +2267,7 @@ let (e_qualifier : FStarC_Reflection_V1_Constants.ref_qual_Action.FStarC_Reflection_V1_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_name cb l in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Action l1)) @@ -2288,10 +2277,10 @@ let (e_qualifier : FStarC_Reflection_V1_Constants.ref_qual_Projector.FStarC_Reflection_V1_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_ident cb i in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun i1 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_name cb l in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.Projector (l1, i1)))) @@ -2303,12 +2292,12 @@ let (e_qualifier : let uu___2 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_ident) cb ids1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun ids11 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_ident) cb ids2 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ids21 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.RecordType (ids11, ids21)))) @@ -2320,12 +2309,12 @@ let (e_qualifier : let uu___2 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_ident) cb ids1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun ids11 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_ident) cb ids2 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ids21 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V1_Data.RecordConstructor @@ -2333,8 +2322,7 @@ let (e_qualifier : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded qualifier: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded qualifier: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2349,8 +2337,7 @@ let (e_qualifiers : FStarC_Reflection_V1_Data.qualifier Prims.list FStarC_TypeChecker_NBETerm.embedding) = FStarC_TypeChecker_NBETerm.e_list e_qualifier -let (e_vconfig : - FStarC_Compiler_Order.order FStarC_TypeChecker_NBETerm.embedding) = +let (e_vconfig : FStarC_Order.order FStarC_TypeChecker_NBETerm.embedding) = let emb cb o = failwith "emb vconfig NBE" in let unemb cb t = failwith "unemb vconfig NBE" in let uu___ = diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Builtins.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Builtins.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_Reflection_V2_Builtins.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Builtins.ml index 5c880154fc7..df7a0d18991 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Builtins.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Builtins.ml @@ -2,8 +2,7 @@ open Prims let (get_env : unit -> FStarC_TypeChecker_Env.env) = fun uu___ -> let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_TypeChecker_Normalize.reflection_env_hook in + FStarC_Effect.op_Bang FStarC_TypeChecker_Normalize.reflection_env_hook in match uu___1 with | FStar_Pervasives_Native.None -> failwith "impossible: env_hook unset in reflection" @@ -80,8 +79,7 @@ let (pack_fv : Prims.string Prims.list -> FStarC_Syntax_Syntax.fv) = let uu___1 = FStarC_Parser_Const.p2l ns in FStarC_Syntax_Syntax.lid_as_fv uu___1 quals in let uu___ = - FStarC_Compiler_Effect.op_Bang - FStarC_TypeChecker_Normalize.reflection_env_hook in + FStarC_Effect.op_Bang FStarC_TypeChecker_Normalize.reflection_env_hook in match uu___ with | FStar_Pervasives_Native.None -> fallback () | FStar_Pervasives_Native.Some env -> @@ -127,7 +125,7 @@ let (inspect_const : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c in - FStarC_Compiler_Util.format1 "unknown constant: %s" uu___2 in + FStarC_Util.format1 "unknown constant: %s" uu___2 in failwith uu___1 let (inspect_universe : FStarC_Syntax_Syntax.universe -> FStarC_Reflection_V2_Data.universe_view) = @@ -164,7 +162,7 @@ let rec (inspect_pat : FStarC_Reflection_V2_Data.Pat_Constant uu___ | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, ps) -> let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (p1, b) -> let uu___2 = inspect_pat p1 in (uu___2, b)) ps in @@ -173,9 +171,9 @@ let rec (inspect_pat : let uu___ = let uu___1 = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Sealed.seal uu___1 in + FStarC_Sealed.seal uu___1 in FStarC_Reflection_V2_Data.Pat_Var - ((FStarC_Compiler_Sealed.seal bv.FStarC_Syntax_Syntax.sort), uu___) + ((FStarC_Sealed.seal bv.FStarC_Syntax_Syntax.sort), uu___) | FStarC_Syntax_Syntax.Pat_dot_term eopt -> FStarC_Reflection_V2_Data.Pat_Dot_Term eopt let rec (inspect_ln : @@ -291,7 +289,7 @@ let rec (inspect_ln : FStarC_Syntax_Syntax.rc_opt1 = uu___;_} -> let brs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (pat, uu___2, t3) -> @@ -306,7 +304,7 @@ let rec (inspect_ln : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "inspect_ln: outside of expected syntax (%s, %s)" uu___3 uu___4 in FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) t1 FStarC_Errors_Codes.Warning_CantInspect () @@ -318,7 +316,7 @@ let (inspect_comp : fun c -> let get_dec flags = let uu___ = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.DECREASES uu___2 -> true @@ -332,7 +330,7 @@ let (inspect_comp : ((let uu___3 = let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "inspect_comp: inspecting comp with wf decreases clause is not yet supported: %s skipping the decreases clause" uu___4 in FStarC_Errors.log_issue @@ -348,10 +346,10 @@ let (inspect_comp : | FStarC_Syntax_Syntax.Comp ct -> let uopt = if - (FStarC_Compiler_List.length ct.FStarC_Syntax_Syntax.comp_univs) - = Prims.int_zero + (FStarC_List.length ct.FStarC_Syntax_Syntax.comp_univs) = + Prims.int_zero then FStarC_Syntax_Syntax.U_unknown - else FStarC_Compiler_List.hd ct.FStarC_Syntax_Syntax.comp_univs in + else FStarC_List.hd ct.FStarC_Syntax_Syntax.comp_univs in let uu___ = FStarC_Ident.lid_equals ct.FStarC_Syntax_Syntax.effect_name FStarC_Parser_Const.effect_Lemma_lid in @@ -370,7 +368,7 @@ let (inspect_comp : let uu___3 = FStarC_Ident.path_of_lid ct.FStarC_Syntax_Syntax.effect_name in let uu___4 = - FStarC_Compiler_List.map inspect_arg + FStarC_List.map inspect_arg ct.FStarC_Syntax_Syntax.effect_args in let uu___5 = get_dec ct.FStarC_Syntax_Syntax.flags in ((ct.FStarC_Syntax_Syntax.comp_univs), uu___3, @@ -413,15 +411,15 @@ let (pack_comp : match uu___ with | (a, q) -> let uu___1 = pack_aqual q in (a, uu___1) in let flags = - if (FStarC_Compiler_List.length decrs) = Prims.int_zero + if (FStarC_List.length decrs) = Prims.int_zero then [] else [FStarC_Syntax_Syntax.DECREASES (FStarC_Syntax_Syntax.Decreases_lex decrs)] in let ct = let uu___ = - FStarC_Ident.lid_of_path ef FStarC_Compiler_Range_Type.dummyRange in - let uu___1 = FStarC_Compiler_List.map pack_arg args in + FStarC_Ident.lid_of_path ef FStarC_Range_Type.dummyRange in + let uu___1 = FStarC_List.map pack_arg args in { FStarC_Syntax_Syntax.comp_univs = us; FStarC_Syntax_Syntax.effect_name = uu___; @@ -443,13 +441,12 @@ let (pack_const : | FStarC_Reflection_V2_Data.C_True -> FStarC_Const.Const_bool true | FStarC_Reflection_V2_Data.C_False -> FStarC_Const.Const_bool false | FStarC_Reflection_V2_Data.C_String s -> - FStarC_Const.Const_string (s, FStarC_Compiler_Range_Type.dummyRange) + FStarC_Const.Const_string (s, FStarC_Range_Type.dummyRange) | FStarC_Reflection_V2_Data.C_Range r -> FStarC_Const.Const_range r | FStarC_Reflection_V2_Data.C_Reify -> FStarC_Const.Const_reify FStar_Pervasives_Native.None | FStarC_Reflection_V2_Data.C_Reflect ns -> - let uu___ = - FStarC_Ident.lid_of_path ns FStarC_Compiler_Range_Type.dummyRange in + let uu___ = FStarC_Ident.lid_of_path ns FStarC_Range_Type.dummyRange in FStarC_Const.Const_reflect uu___ | FStarC_Reflection_V2_Data.C_Real r -> FStarC_Const.Const_real r let rec (pack_pat : @@ -458,7 +455,7 @@ let rec (pack_pat : let wrap v = { FStarC_Syntax_Syntax.v = v; - FStarC_Syntax_Syntax.p = FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.p = FStarC_Range_Type.dummyRange } in match p with | FStarC_Reflection_V2_Data.Pat_Constant c -> @@ -470,7 +467,7 @@ let rec (pack_pat : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (p1, b) -> let uu___4 = pack_pat p1 in (uu___4, b)) @@ -480,8 +477,8 @@ let rec (pack_pat : wrap uu___ | FStarC_Reflection_V2_Data.Pat_Var (sort, ppname) -> let bv = - FStarC_Syntax_Syntax.gen_bv (FStarC_Compiler_Sealed.unseal ppname) - FStar_Pervasives_Native.None (FStarC_Compiler_Sealed.unseal sort) in + FStarC_Syntax_Syntax.gen_bv (FStarC_Sealed.unseal ppname) + FStar_Pervasives_Native.None (FStarC_Sealed.unseal sort) in wrap (FStarC_Syntax_Syntax.Pat_var bv) | FStarC_Reflection_V2_Data.Pat_Dot_Term eopt -> wrap (FStarC_Syntax_Syntax.Pat_dot_term eopt) @@ -525,7 +522,7 @@ let (pack_ln : }) c.FStarC_Syntax_Syntax.pos | FStarC_Reflection_V2_Data.Tv_Type u -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Tv_Refine (b, t) -> let bv = b.FStarC_Syntax_Syntax.binder_bv in FStarC_Syntax_Syntax.mk @@ -536,25 +533,25 @@ let (pack_ln : let uu___ = let uu___1 = pack_const c in FStarC_Syntax_Syntax.Tm_constant uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Tv_Uvar (u, ctx_u_s) -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_uvar ctx_u_s) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Tv_Let (isrec, attrs, b, t1, t2) -> let bv = b.FStarC_Syntax_Syntax.binder_bv in let lb = FStarC_Syntax_Util.mk_letbinding (FStar_Pervasives.Inl bv) [] bv.FStarC_Syntax_Syntax.sort FStarC_Parser_Const.effect_Tot_lid - t1 attrs FStarC_Compiler_Range_Type.dummyRange in + t1 attrs FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_let { FStarC_Syntax_Syntax.lbs = (isrec, [lb]); FStarC_Syntax_Syntax.body1 = t2 - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Tv_Match (t, ret_opt, brs) -> let brs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (pat, t1) -> @@ -567,7 +564,7 @@ let (pack_ln : FStarC_Syntax_Syntax.ret_opt = ret_opt; FStarC_Syntax_Syntax.brs = brs1; FStarC_Syntax_Syntax.rc_opt1 = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Tv_AscribedT (e, t, tacopt, use_eq) -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_ascribed @@ -576,7 +573,7 @@ let (pack_ln : FStarC_Syntax_Syntax.asc = ((FStar_Pervasives.Inl t), tacopt, use_eq); FStarC_Syntax_Syntax.eff_opt = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Tv_AscribedC (e, c, tacopt, use_eq) -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_ascribed @@ -585,34 +582,34 @@ let (pack_ln : FStarC_Syntax_Syntax.asc = ((FStar_Pervasives.Inr c), tacopt, use_eq); FStarC_Syntax_Syntax.eff_opt = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange + }) FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Tv_Unknown -> FStarC_Syntax_Syntax.mk FStarC_Syntax_Syntax.Tm_unknown - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Tv_Unsupp -> (FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_CantInspect () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic "packing a Tv_Unsupp into Tm_unknown"); FStarC_Syntax_Syntax.mk FStarC_Syntax_Syntax.Tm_unknown - FStarC_Compiler_Range_Type.dummyRange) + FStarC_Range_Type.dummyRange) let (compare_bv : - FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.bv -> FStar_Order.order) = + FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.bv -> FStarC_Order.order) = fun x -> fun y -> let n = FStarC_Syntax_Syntax.order_bv x y in if n < Prims.int_zero - then FStar_Order.Lt - else if n = Prims.int_zero then FStar_Order.Eq else FStar_Order.Gt + then FStarC_Order.Lt + else if n = Prims.int_zero then FStarC_Order.Eq else FStarC_Order.Gt let (compare_namedv : FStarC_Reflection_V2_Data.namedv -> - FStarC_Reflection_V2_Data.namedv -> FStar_Order.order) + FStarC_Reflection_V2_Data.namedv -> FStarC_Order.order) = fun x -> fun y -> let n = FStarC_Syntax_Syntax.order_bv x y in if n < Prims.int_zero - then FStar_Order.Lt - else if n = Prims.int_zero then FStar_Order.Eq else FStar_Order.Gt + then FStarC_Order.Lt + else if n = Prims.int_zero then FStarC_Order.Eq else FStarC_Order.Gt let (lookup_attr_ses : FStarC_Syntax_Syntax.term -> FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.sigelt Prims.list) @@ -636,7 +633,7 @@ let (lookup_attr : fun attr -> fun env -> let ses = lookup_attr_ses attr env in - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun se -> let uu___ = FStarC_Syntax_Util.lid_of_sigelt se in match uu___ with @@ -650,7 +647,7 @@ let (all_defs_in_env : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.fv Prims.list) = fun env -> let uu___ = FStarC_TypeChecker_Env.lidents env in - FStarC_Compiler_List.map + FStarC_List.map (fun l -> FStarC_Syntax_Syntax.lid_as_fv l FStar_Pervasives_Native.None) uu___ let (defs_in_module : @@ -660,12 +657,12 @@ let (defs_in_module : fun env -> fun modul -> let uu___ = FStarC_TypeChecker_Env.lidents env in - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun l -> let ns = let uu___1 = let uu___2 = FStarC_Ident.ids_of_lid l in init uu___2 in - FStarC_Compiler_List.map FStarC_Ident.string_of_id uu___1 in + FStarC_List.map FStarC_Ident.string_of_id uu___1 in if ns = modul then let uu___1 = @@ -723,17 +720,15 @@ let (rd_to_syntax_qual : | FStarC_Reflection_V2_Data.Logic -> FStarC_Syntax_Syntax.Logic | FStarC_Reflection_V2_Data.Reifiable -> FStarC_Syntax_Syntax.Reifiable | FStarC_Reflection_V2_Data.Reflectable l -> - let uu___1 = - FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange in + let uu___1 = FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.Reflectable uu___1 | FStarC_Reflection_V2_Data.Discriminator l -> - let uu___1 = - FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange in + let uu___1 = FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.Discriminator uu___1 | FStarC_Reflection_V2_Data.Projector (l, i) -> let uu___1 = let uu___2 = - FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange in (uu___2, i) in FStarC_Syntax_Syntax.Projector uu___1 | FStarC_Reflection_V2_Data.RecordType (l1, l2) -> @@ -741,8 +736,7 @@ let (rd_to_syntax_qual : | FStarC_Reflection_V2_Data.RecordConstructor (l1, l2) -> FStarC_Syntax_Syntax.RecordConstructor (l1, l2) | FStarC_Reflection_V2_Data.Action l -> - let uu___1 = - FStarC_Ident.lid_of_path l FStarC_Compiler_Range_Type.dummyRange in + let uu___1 = FStarC_Ident.lid_of_path l FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.Action uu___1 | FStarC_Reflection_V2_Data.ExceptionConstructor -> FStarC_Syntax_Syntax.ExceptionConstructor @@ -795,27 +789,26 @@ let (syntax_to_rd_qual : | FStarC_Syntax_Syntax.Effect -> FStarC_Reflection_V2_Data.Effect | FStarC_Syntax_Syntax.OnlyName -> FStarC_Reflection_V2_Data.OnlyName let (inspect_ident : - FStarC_Ident.ident -> (Prims.string * FStarC_Compiler_Range_Type.range)) = + FStarC_Ident.ident -> (Prims.string * FStarC_Range_Type.range)) = fun i -> let uu___ = FStarC_Ident.string_of_id i in let uu___1 = FStarC_Ident.range_of_id i in (uu___, uu___1) let (pack_ident : - (Prims.string * FStarC_Compiler_Range_Type.range) -> FStarC_Ident.ident) = + (Prims.string * FStarC_Range_Type.range) -> FStarC_Ident.ident) = fun i -> FStarC_Ident.mk_ident i let (sigelt_quals : FStarC_Syntax_Syntax.sigelt -> FStarC_Reflection_V2_Data.qualifier Prims.list) = fun se -> - FStarC_Compiler_List.map syntax_to_rd_qual - se.FStarC_Syntax_Syntax.sigquals + FStarC_List.map syntax_to_rd_qual se.FStarC_Syntax_Syntax.sigquals let (set_sigelt_quals : FStarC_Reflection_V2_Data.qualifier Prims.list -> FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.sigelt) = fun quals -> fun se -> - let uu___ = FStarC_Compiler_List.map rd_to_syntax_qual quals in + let uu___ = FStarC_List.map rd_to_syntax_qual quals in { FStarC_Syntax_Syntax.sigel = (se.FStarC_Syntax_Syntax.sigel); FStarC_Syntax_Syntax.sigrng = (se.FStarC_Syntax_Syntax.sigrng); @@ -835,7 +828,7 @@ let (embed_vconfig : FStarC_VConfig.vconfig -> FStarC_Syntax_Syntax.term) = let uu___ = FStarC_Syntax_Embeddings_Base.embed FStarC_Syntax_Embeddings.e_vconfig vcfg in - uu___ FStarC_Compiler_Range_Type.dummyRange FStar_Pervasives_Native.None + uu___ FStarC_Range_Type.dummyRange FStar_Pervasives_Native.None FStarC_Syntax_Embeddings_Base.id_norm_cb let (inspect_sigelt : FStarC_Syntax_Syntax.sigelt -> FStarC_Reflection_V2_Data.sigelt_view) = @@ -880,7 +873,7 @@ let (inspect_sigelt : | uu___4 -> failwith "impossible: inspect_sigelt: did not find ctor" in let uu___3 = - let uu___4 = FStarC_Compiler_List.map inspect_ctor c_lids in + let uu___4 = FStarC_List.map inspect_ctor c_lids in (nm, us, param_bs, ty, uu___4) in FStarC_Reflection_V2_Data.Sg_Inductive uu___3 | FStarC_Syntax_Syntax.Sig_declare_typ @@ -897,7 +890,7 @@ let (pack_sigelt : let uu___ = let uu___1 = let uu___2 = FStarC_Ident.path_of_lid lid in - FStarC_Compiler_List.length uu___2 in + FStarC_List.length uu___2 in uu___1 <= Prims.int_one in if uu___ then @@ -928,11 +921,9 @@ let (pack_sigelt : failwith "impossible: pack_sigelt: bv in toplevel let binding" in (check_lid lid; (lid, lb)) in - let packed = FStarC_Compiler_List.map pack_letbinding lbs in - let lbs1 = - FStarC_Compiler_List.map FStar_Pervasives_Native.snd packed in - let lids = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst packed in + let packed = FStarC_List.map pack_letbinding lbs in + let lbs1 = FStarC_List.map FStar_Pervasives_Native.snd packed in + let lids = FStarC_List.map FStar_Pervasives_Native.fst packed in FStarC_Syntax_Syntax.mk_sigelt (FStarC_Syntax_Syntax.Sig_let { @@ -942,17 +933,16 @@ let (pack_sigelt : | FStarC_Reflection_V2_Data.Sg_Inductive (nm, us_names, param_bs, ty, ctors) -> let ind_lid = - FStarC_Ident.lid_of_path nm FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path nm FStarC_Range_Type.dummyRange in (check_lid ind_lid; - (let nparam = FStarC_Compiler_List.length param_bs in + (let nparam = FStarC_List.length param_bs in let injective_type_params = false in let pack_ctor c = let uu___1 = c in match uu___1 with | (nm1, ty1) -> let lid = - FStarC_Ident.lid_of_path nm1 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path nm1 FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.mk_sigelt (FStarC_Syntax_Syntax.Sig_datacon { @@ -965,12 +955,12 @@ let (pack_sigelt : FStarC_Syntax_Syntax.injective_type_params1 = injective_type_params }) in - let ctor_ses = FStarC_Compiler_List.map pack_ctor ctors in + let ctor_ses = FStarC_List.map pack_ctor ctors in let c_lids = - FStarC_Compiler_List.map + FStarC_List.map (fun se -> let uu___1 = FStarC_Syntax_Util.lid_of_sigelt se in - FStarC_Compiler_Util.must uu___1) ctor_ses in + FStarC_Util.must uu___1) ctor_ses in let ind_se = FStarC_Syntax_Syntax.mk_sigelt (FStarC_Syntax_Syntax.Sig_inductive_typ @@ -1007,7 +997,7 @@ let (pack_sigelt : })) | FStarC_Reflection_V2_Data.Sg_Val (nm, us_names, ty) -> let val_lid = - FStarC_Ident.lid_of_path nm FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path nm FStarC_Range_Type.dummyRange in (check_lid val_lid; FStarC_Syntax_Syntax.mk_sigelt (FStarC_Syntax_Syntax.Sig_declare_typ @@ -1049,7 +1039,7 @@ let (pack_lb : FStarC_Reflection_V2_Data.lb_def = def;_} -> FStarC_Syntax_Util.mk_letbinding (FStar_Pervasives.Inr fv) us typ FStarC_Parser_Const.effect_Tot_lid def [] - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (inspect_namedv : FStarC_Reflection_V2_Data.namedv -> FStarC_Reflection_V2_Data.namedv_view) = @@ -1061,7 +1051,7 @@ let (inspect_namedv : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term v.FStarC_Syntax_Syntax.sort in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "inspect_namedv: uniq is negative (%s : %s), uniq = %s" uu___2 uu___3 (Prims.string_of_int v.FStarC_Syntax_Syntax.index) in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_CantInspect () @@ -1071,11 +1061,11 @@ let (inspect_namedv : (let uu___1 = FStarC_BigInt.of_int_fs v.FStarC_Syntax_Syntax.index in let uu___2 = let uu___3 = FStarC_Ident.string_of_id v.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Sealed.seal uu___3 in + FStarC_Sealed.seal uu___3 in { FStarC_Reflection_V2_Data.uniq = uu___1; FStarC_Reflection_V2_Data.sort = - (FStarC_Compiler_Sealed.seal v.FStarC_Syntax_Syntax.sort); + (FStarC_Sealed.seal v.FStarC_Syntax_Syntax.sort); FStarC_Reflection_V2_Data.ppname = uu___2 }) let (pack_namedv : @@ -1092,24 +1082,22 @@ let (pack_namedv : let uu___4 = FStarC_BigInt.to_int_fs vv.FStarC_Reflection_V2_Data.uniq in FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___4 in - FStarC_Compiler_Util.format2 - "pack_namedv: uniq is negative (%s), uniq = %s" - (FStarC_Compiler_Sealed.unseal vv.FStarC_Reflection_V2_Data.ppname) - uu___3 in + FStarC_Util.format2 "pack_namedv: uniq is negative (%s), uniq = %s" + (FStarC_Sealed.unseal vv.FStarC_Reflection_V2_Data.ppname) uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_CantInspect () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2) else ()); (let uu___1 = FStarC_Ident.mk_ident - ((FStarC_Compiler_Sealed.unseal vv.FStarC_Reflection_V2_Data.ppname), - FStarC_Compiler_Range_Type.dummyRange) in + ((FStarC_Sealed.unseal vv.FStarC_Reflection_V2_Data.ppname), + FStarC_Range_Type.dummyRange) in let uu___2 = FStarC_BigInt.to_int_fs vv.FStarC_Reflection_V2_Data.uniq in { FStarC_Syntax_Syntax.ppname = uu___1; FStarC_Syntax_Syntax.index = uu___2; FStarC_Syntax_Syntax.sort = - (FStarC_Compiler_Sealed.unseal vv.FStarC_Reflection_V2_Data.sort) + (FStarC_Sealed.unseal vv.FStarC_Reflection_V2_Data.sort) }) let (inspect_bv : FStarC_Syntax_Syntax.bv -> FStarC_Reflection_V2_Data.bv_view) = @@ -1122,7 +1110,7 @@ let (inspect_bv : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term bv.FStarC_Syntax_Syntax.sort in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "inspect_bv: index is negative (%s : %s), index = %s" uu___2 uu___3 (Prims.string_of_int bv.FStarC_Syntax_Syntax.index) in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_CantInspect () @@ -1132,11 +1120,11 @@ let (inspect_bv : (let uu___1 = FStarC_BigInt.of_int_fs bv.FStarC_Syntax_Syntax.index in let uu___2 = let uu___3 = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Sealed.seal uu___3 in + FStarC_Sealed.seal uu___3 in { FStarC_Reflection_V2_Data.index = uu___1; FStarC_Reflection_V2_Data.sort1 = - (FStarC_Compiler_Sealed.seal bv.FStarC_Syntax_Syntax.sort); + (FStarC_Sealed.seal bv.FStarC_Syntax_Syntax.sort); FStarC_Reflection_V2_Data.ppname1 = uu___2 }) let (pack_bv : FStarC_Reflection_V2_Data.bv_view -> FStarC_Syntax_Syntax.bv) @@ -1153,25 +1141,23 @@ let (pack_bv : FStarC_Reflection_V2_Data.bv_view -> FStarC_Syntax_Syntax.bv) let uu___4 = FStarC_BigInt.to_int_fs bvv.FStarC_Reflection_V2_Data.index in FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___4 in - FStarC_Compiler_Util.format2 - "pack_bv: index is negative (%s), index = %s" - (FStarC_Compiler_Sealed.unseal - bvv.FStarC_Reflection_V2_Data.ppname1) uu___3 in + FStarC_Util.format2 "pack_bv: index is negative (%s), index = %s" + (FStarC_Sealed.unseal bvv.FStarC_Reflection_V2_Data.ppname1) + uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_CantInspect () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2) else ()); (let uu___1 = FStarC_Ident.mk_ident - ((FStarC_Compiler_Sealed.unseal - bvv.FStarC_Reflection_V2_Data.ppname1), - FStarC_Compiler_Range_Type.dummyRange) in + ((FStarC_Sealed.unseal bvv.FStarC_Reflection_V2_Data.ppname1), + FStarC_Range_Type.dummyRange) in let uu___2 = FStarC_BigInt.to_int_fs bvv.FStarC_Reflection_V2_Data.index in { FStarC_Syntax_Syntax.ppname = uu___1; FStarC_Syntax_Syntax.index = uu___2; FStarC_Syntax_Syntax.sort = - (FStarC_Compiler_Sealed.unseal bvv.FStarC_Reflection_V2_Data.sort1) + (FStarC_Sealed.unseal bvv.FStarC_Reflection_V2_Data.sort1) }) let (inspect_binder : FStarC_Syntax_Syntax.binder -> FStarC_Reflection_V2_Data.binder_view) = @@ -1185,7 +1171,7 @@ let (inspect_binder : let uu___2 = FStarC_Ident.string_of_id (b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Sealed.seal uu___2 in + FStarC_Sealed.seal uu___2 in { FStarC_Reflection_V2_Data.sort2 = ((b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort); @@ -1204,9 +1190,8 @@ let (pack_binder : let uu___1 = let uu___2 = FStarC_Ident.mk_ident - ((FStarC_Compiler_Sealed.unseal - bview.FStarC_Reflection_V2_Data.ppname2), - FStarC_Compiler_Range_Type.dummyRange) in + ((FStarC_Sealed.unseal bview.FStarC_Reflection_V2_Data.ppname2), + FStarC_Range_Type.dummyRange) in { FStarC_Syntax_Syntax.ppname = uu___2; FStarC_Syntax_Syntax.index = Prims.int_zero; @@ -1227,19 +1212,19 @@ let (env_open_modules : fun e -> let uu___ = FStarC_Syntax_DsEnv.open_modules e.FStarC_TypeChecker_Env.dsenv in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (l, m) -> let uu___2 = FStarC_Ident.ids_of_lid l in - FStarC_Compiler_List.map FStarC_Ident.string_of_id uu___2) uu___ + FStarC_List.map FStarC_Ident.string_of_id uu___2) uu___ let (bv_to_binding : FStarC_Syntax_Syntax.bv -> FStarC_Reflection_V2_Data.binding) = fun bv -> let uu___ = FStarC_BigInt.of_int_fs bv.FStarC_Syntax_Syntax.index in let uu___1 = let uu___2 = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Sealed.seal uu___2 in + FStarC_Sealed.seal uu___2 in { FStarC_Reflection_V2_Data.uniq1 = uu___; FStarC_Reflection_V2_Data.sort3 = (bv.FStarC_Syntax_Syntax.sort); @@ -1250,8 +1235,8 @@ let (vars_of_env : = fun e -> let uu___ = FStarC_TypeChecker_Env.all_binders e in - FStarC_Compiler_List.map - (fun b -> bv_to_binding b.FStarC_Syntax_Syntax.binder_bv) uu___ + FStarC_List.map (fun b -> bv_to_binding b.FStarC_Syntax_Syntax.binder_bv) + uu___ let eqopt : 'uuuuu . unit -> @@ -1464,12 +1449,11 @@ and (univs_eq : FStarC_Syntax_Syntax.universe Prims.list -> Prims.bool) = fun us1 -> fun us2 -> (eqlist ()) univ_eq us1 us2 let (implode_qn : Prims.string Prims.list -> Prims.string) = - fun ns -> FStarC_Compiler_String.concat "." ns + fun ns -> FStarC_String.concat "." ns let (explode_qn : Prims.string -> Prims.string Prims.list) = - fun s -> FStarC_Compiler_String.split [46] s + fun s -> FStarC_String.split [46] s let (compare_string : Prims.string -> Prims.string -> FStarC_BigInt.t) = - fun s1 -> - fun s2 -> FStarC_BigInt.of_int_fs (FStarC_Compiler_String.compare s1 s2) + fun s1 -> fun s2 -> FStarC_BigInt.of_int_fs (FStarC_String.compare s1 s2) let (push_binder : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.binder -> FStarC_TypeChecker_Env.env) @@ -1490,9 +1474,8 @@ let (subst_comp : FStarC_Syntax_Syntax.subst_elt Prims.list -> FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.comp) = fun s -> fun c -> FStarC_Syntax_Subst.subst_comp s c -let (range_of_term : - FStarC_Syntax_Syntax.term -> FStarC_Compiler_Range_Type.range) = +let (range_of_term : FStarC_Syntax_Syntax.term -> FStarC_Range_Type.range) = fun t -> t.FStarC_Syntax_Syntax.pos let (range_of_sigelt : - FStarC_Syntax_Syntax.sigelt -> FStarC_Compiler_Range_Type.range) = + FStarC_Syntax_Syntax.sigelt -> FStarC_Range_Type.range) = fun s -> s.FStarC_Syntax_Syntax.sigrng \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Constants.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Constants.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_Reflection_V2_Constants.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Constants.ml index dd1d3d50405..8bb4fd054cd 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Constants.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Constants.ml @@ -20,13 +20,13 @@ let (fstar_syntax_syntax_lid : Prims.string Prims.list -> FStarC_Ident.lident) = fun s -> FStarC_Ident.lid_of_path - (FStarC_Compiler_List.op_At ["FStar"; "Stubs"; "Syntax"; "Syntax"] s) - FStarC_Compiler_Range_Type.dummyRange + (FStar_List_Tot_Base.append ["FStar"; "Stubs"; "Syntax"; "Syntax"] s) + FStarC_Range_Type.dummyRange let (fstar_refl_lid : Prims.string Prims.list -> FStarC_Ident.lident) = fun s -> FStarC_Ident.lid_of_path - (FStarC_Compiler_List.op_At ["FStar"; "Stubs"; "Reflection"] s) - FStarC_Compiler_Range_Type.dummyRange + (FStar_List_Tot_Base.append ["FStar"; "Stubs"; "Reflection"] s) + FStarC_Range_Type.dummyRange let (fstar_refl_types_lid : Prims.string -> FStarC_Ident.lident) = fun s -> fstar_refl_lid ["Types"; s] let (fstar_refl_builtins_lid : Prims.string -> FStarC_Ident.lident) = @@ -292,16 +292,13 @@ let (ref_Mk_namedv_view : refl_constant) = let uu___9 = fstar_refl_data_lid "namedv_view" in let uu___10 = let uu___11 = - FStarC_Ident.mk_ident - ("uniq", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("uniq", FStarC_Range_Type.dummyRange) in let uu___12 = let uu___13 = - FStarC_Ident.mk_ident - ("sort", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("sort", FStarC_Range_Type.dummyRange) in let uu___14 = let uu___15 = - FStarC_Ident.mk_ident - ("ppname", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("ppname", FStarC_Range_Type.dummyRange) in [uu___15] in uu___13 :: uu___14 in uu___11 :: uu___12 in @@ -317,16 +314,13 @@ let (ref_Mk_bv_view : refl_constant) = let uu___9 = fstar_refl_data_lid "bv_view" in let uu___10 = let uu___11 = - FStarC_Ident.mk_ident - ("index", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("index", FStarC_Range_Type.dummyRange) in let uu___12 = let uu___13 = - FStarC_Ident.mk_ident - ("sort", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("sort", FStarC_Range_Type.dummyRange) in let uu___14 = let uu___15 = - FStarC_Ident.mk_ident - ("ppname", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("ppname", FStarC_Range_Type.dummyRange) in [uu___15] in uu___13 :: uu___14 in uu___11 :: uu___12 in @@ -342,16 +336,13 @@ let (ref_Mk_binding : refl_constant) = let uu___9 = fstar_refl_data_lid "binding" in let uu___10 = let uu___11 = - FStarC_Ident.mk_ident - ("uniq", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("uniq", FStarC_Range_Type.dummyRange) in let uu___12 = let uu___13 = - FStarC_Ident.mk_ident - ("sort", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("sort", FStarC_Range_Type.dummyRange) in let uu___14 = let uu___15 = - FStarC_Ident.mk_ident - ("ppname", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("ppname", FStarC_Range_Type.dummyRange) in [uu___15] in uu___13 :: uu___14 in uu___11 :: uu___12 in @@ -367,20 +358,17 @@ let (ref_Mk_binder_view : refl_constant) = let uu___9 = fstar_refl_data_lid "binder_view" in let uu___10 = let uu___11 = - FStarC_Ident.mk_ident - ("sort", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("sort", FStarC_Range_Type.dummyRange) in let uu___12 = let uu___13 = - FStarC_Ident.mk_ident - ("qual", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("qual", FStarC_Range_Type.dummyRange) in let uu___14 = let uu___15 = - FStarC_Ident.mk_ident - ("attrs", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("attrs", FStarC_Range_Type.dummyRange) in let uu___16 = let uu___17 = FStarC_Ident.mk_ident - ("ppname", FStarC_Compiler_Range_Type.dummyRange) in + ("ppname", FStarC_Range_Type.dummyRange) in [uu___17] in uu___15 :: uu___16 in uu___13 :: uu___14 in @@ -397,20 +385,17 @@ let (ref_Mk_lb : refl_constant) = let uu___9 = fstar_refl_data_lid "lb_view" in let uu___10 = let uu___11 = - FStarC_Ident.mk_ident - ("lb_fv", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("lb_fv", FStarC_Range_Type.dummyRange) in let uu___12 = let uu___13 = - FStarC_Ident.mk_ident - ("lb_us", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("lb_us", FStarC_Range_Type.dummyRange) in let uu___14 = let uu___15 = - FStarC_Ident.mk_ident - ("lb_typ", FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident ("lb_typ", FStarC_Range_Type.dummyRange) in let uu___16 = let uu___17 = FStarC_Ident.mk_ident - ("lb_def", FStarC_Compiler_Range_Type.dummyRange) in + ("lb_def", FStarC_Range_Type.dummyRange) in [uu___17] in uu___15 :: uu___16 in uu___13 :: uu___14 in diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Data.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Data.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_Reflection_V2_Data.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Data.ml index 2c7f1951df8..c6e72a0d22f 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Data.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Data.ml @@ -2,11 +2,10 @@ open Prims type name = Prims.string Prims.list type typ = FStarC_Syntax_Syntax.term type binders = FStarC_Syntax_Syntax.binder Prims.list -type ppname_t = Prims.string FStarC_Compiler_Sealed.sealed -let (as_ppname : Prims.string -> ppname_t) = - fun x -> FStarC_Compiler_Sealed.seal x +type ppname_t = Prims.string FStarC_Sealed.sealed +let (as_ppname : Prims.string -> ppname_t) = fun x -> FStarC_Sealed.seal x type simple_binder = FStarC_Syntax_Syntax.binder -type ident_view = (Prims.string * FStarC_Compiler_Range_Type.range) +type ident_view = (Prims.string * FStarC_Range_Type.range) type namedv = FStarC_Syntax_Syntax.bv type vconst = | C_Unit @@ -14,7 +13,7 @@ type vconst = | C_True | C_False | C_String of Prims.string - | C_Range of FStarC_Compiler_Range_Type.range + | C_Range of FStarC_Range_Type.range | C_Reify | C_Reflect of name | C_Real of Prims.string @@ -35,8 +34,8 @@ let (__proj__C_String__item___0 : vconst -> Prims.string) = fun projectee -> match projectee with | C_String _0 -> _0 let (uu___is_C_Range : vconst -> Prims.bool) = fun projectee -> match projectee with | C_Range _0 -> true | uu___ -> false -let (__proj__C_Range__item___0 : vconst -> FStarC_Compiler_Range_Type.range) - = fun projectee -> match projectee with | C_Range _0 -> _0 +let (__proj__C_Range__item___0 : vconst -> FStarC_Range_Type.range) = + fun projectee -> match projectee with | C_Range _0 -> _0 let (uu___is_C_Reify : vconst -> Prims.bool) = fun projectee -> match projectee with | C_Reify -> true | uu___ -> false let (uu___is_C_Reflect : vconst -> Prims.bool) = @@ -53,8 +52,7 @@ type pattern = | Pat_Constant of vconst | Pat_Cons of FStarC_Syntax_Syntax.fv * universes FStar_Pervasives_Native.option * (pattern * Prims.bool) Prims.list - | Pat_Var of FStarC_Syntax_Syntax.term FStarC_Compiler_Sealed.sealed * - ppname_t + | Pat_Var of FStarC_Syntax_Syntax.term FStarC_Sealed.sealed * ppname_t | Pat_Dot_Term of FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option let (uu___is_Pat_Constant : pattern -> Prims.bool) = fun projectee -> @@ -81,7 +79,7 @@ let (uu___is_Pat_Var : pattern -> Prims.bool) = fun projectee -> match projectee with | Pat_Var (sort, ppname) -> true | uu___ -> false let (__proj__Pat_Var__item__sort : - pattern -> FStarC_Syntax_Syntax.term FStarC_Compiler_Sealed.sealed) = + pattern -> FStarC_Syntax_Syntax.term FStarC_Sealed.sealed) = fun projectee -> match projectee with | Pat_Var (sort, ppname) -> sort let (__proj__Pat_Var__item__ppname : pattern -> ppname_t) = fun projectee -> match projectee with | Pat_Var (sort, ppname) -> ppname @@ -111,26 +109,25 @@ type argv = (FStarC_Syntax_Syntax.term * aqualv) type namedv_view = { uniq: FStarC_BigInt.t ; - sort: typ FStarC_Compiler_Sealed.sealed ; + sort: typ FStarC_Sealed.sealed ; ppname: ppname_t } let (__proj__Mknamedv_view__item__uniq : namedv_view -> FStarC_BigInt.t) = fun projectee -> match projectee with | { uniq; sort; ppname;_} -> uniq let (__proj__Mknamedv_view__item__sort : - namedv_view -> typ FStarC_Compiler_Sealed.sealed) = + namedv_view -> typ FStarC_Sealed.sealed) = fun projectee -> match projectee with | { uniq; sort; ppname;_} -> sort let (__proj__Mknamedv_view__item__ppname : namedv_view -> ppname_t) = fun projectee -> match projectee with | { uniq; sort; ppname;_} -> ppname type bv_view = { index: FStarC_BigInt.t ; - sort1: typ FStarC_Compiler_Sealed.sealed ; + sort1: typ FStarC_Sealed.sealed ; ppname1: ppname_t } let (__proj__Mkbv_view__item__index : bv_view -> FStarC_BigInt.t) = fun projectee -> match projectee with | { index; sort1 = sort; ppname1 = ppname;_} -> index -let (__proj__Mkbv_view__item__sort : - bv_view -> typ FStarC_Compiler_Sealed.sealed) = +let (__proj__Mkbv_view__item__sort : bv_view -> typ FStarC_Sealed.sealed) = fun projectee -> match projectee with | { index; sort1 = sort; ppname1 = ppname;_} -> sort let (__proj__Mkbv_view__item__ppname : bv_view -> ppname_t) = diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Embeddings.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Embeddings.ml similarity index 99% rename from stage0/fstar-lib/generated/FStarC_Reflection_V2_Embeddings.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Embeddings.ml index 812023039c1..27287ebda9e 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Embeddings.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Embeddings.ml @@ -2,8 +2,7 @@ open Prims type namedv = FStarC_Syntax_Syntax.bv let mk_emb : 'uuuuu . - (FStarC_Compiler_Range_Type.range -> 'uuuuu -> FStarC_Syntax_Syntax.term) - -> + (FStarC_Range_Type.range -> 'uuuuu -> FStarC_Syntax_Syntax.term) -> (FStarC_Syntax_Syntax.term -> 'uuuuu FStar_Pervasives_Native.option) -> FStarC_Syntax_Syntax.term -> 'uuuuu FStarC_Syntax_Embeddings_Base.embedding @@ -18,7 +17,7 @@ let mk_emb : let embed : 'a . 'a FStarC_Syntax_Embeddings_Base.embedding -> - FStarC_Compiler_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term + FStarC_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term = fun uu___ -> fun r -> @@ -133,10 +132,10 @@ let rec mapM_opt : | [] -> FStar_Pervasives_Native.Some [] | x::xs -> let uu___ = f x in - FStarC_Compiler_Util.bind_opt uu___ + FStarC_Util.bind_opt uu___ (fun x1 -> let uu___1 = mapM_opt f xs in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun xs1 -> FStar_Pervasives_Native.Some (x1 :: xs1))) let (e_term_aq : FStarC_Syntax_Syntax.antiquotations -> @@ -155,13 +154,13 @@ let (e_term_aq : let uu___ = aq1 in match uu___ with | (shift, aqs) -> - let aqs1 = FStarC_Compiler_List.rev aqs in + let aqs1 = FStarC_List.rev aqs in let uu___1 = mapM_opt unembed_term aqs1 in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun aq_ts -> let uu___2 = let uu___3 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun at -> let x = @@ -170,7 +169,7 @@ let (e_term_aq : FStarC_Syntax_Syntax.t_term in ((FStarC_Syntax_Syntax.DB ((shift + i), x)), (FStarC_Syntax_Syntax.NT (x, at)))) aq_ts in - FStarC_Compiler_List.unzip uu___3 in + FStarC_List.unzip uu___3 in match uu___2 with | (subst_open, subst) -> let uu___3 = @@ -190,7 +189,7 @@ let (e_term : FStarC_Syntax_Syntax.term FStarC_Syntax_Embeddings_Base.embedding) = e_term_aq noaqs let (e_sort : - FStarC_Syntax_Syntax.term FStarC_Compiler_Sealed.sealed + FStarC_Syntax_Syntax.term FStarC_Sealed.sealed FStarC_Syntax_Embeddings_Base.embedding) = FStarC_Syntax_Embeddings.e_sealed e_term let (e_ppname : @@ -215,7 +214,7 @@ let (e_aqualv : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_Q_Meta.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange in + uu___ FStarC_Range_Type.dummyRange in { FStarC_Syntax_Syntax.n = (r.FStarC_Syntax_Syntax.n); FStarC_Syntax_Syntax.pos = rng; @@ -427,7 +426,7 @@ let (e_vconst : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_C_Int.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.C_String s -> let uu___ = let uu___1 = @@ -436,7 +435,7 @@ let (e_vconst : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_C_String.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.C_Range r1 -> let uu___ = let uu___1 = @@ -445,7 +444,7 @@ let (e_vconst : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_C_Range.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.C_Reify -> FStarC_Reflection_V2_Constants.ref_C_Reify.FStarC_Reflection_V2_Constants.t | FStarC_Reflection_V2_Data.C_Reflect ns -> @@ -457,7 +456,7 @@ let (e_vconst : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_C_Reflect.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.C_Real s -> let uu___ = let uu___1 = @@ -466,7 +465,7 @@ let (e_vconst : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_C_Real.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange in + uu___ FStarC_Range_Type.dummyRange in { FStarC_Syntax_Syntax.n = (r.FStarC_Syntax_Syntax.n); FStarC_Syntax_Syntax.pos = rng; @@ -2213,7 +2212,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_qual_Reflectable.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Discriminator l -> let uu___ = let uu___1 = @@ -2222,7 +2221,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_qual_Discriminator.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Action l -> let uu___ = let uu___1 = @@ -2231,7 +2230,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_qual_Action.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.Projector (l, i) -> let uu___ = let uu___1 = @@ -2244,7 +2243,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_qual_Projector.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.RecordType (ids1, ids2) -> let uu___ = let uu___1 = @@ -2258,7 +2257,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_qual_RecordType.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange + uu___ FStarC_Range_Type.dummyRange | FStarC_Reflection_V2_Data.RecordConstructor (ids1, ids2) -> let uu___ = let uu___1 = @@ -2272,7 +2271,7 @@ let (e_qualifier : [uu___1] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Reflection_V2_Constants.ref_qual_RecordConstructor.FStarC_Reflection_V2_Constants.t - uu___ FStarC_Compiler_Range_Type.dummyRange in + uu___ FStarC_Range_Type.dummyRange in { FStarC_Syntax_Syntax.n = (r.FStarC_Syntax_Syntax.n); FStarC_Syntax_Syntax.pos = rng; diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V2_Interpreter.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Interpreter.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Reflection_V2_Interpreter.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_Interpreter.ml diff --git a/stage0/fstar-lib/generated/FStarC_Reflection_V2_NBEEmbeddings.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_NBEEmbeddings.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_Reflection_V2_NBEEmbeddings.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_NBEEmbeddings.ml index 124043e7c4c..c36af30f21a 100644 --- a/stage0/fstar-lib/generated/FStarC_Reflection_V2_NBEEmbeddings.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Reflection_V2_NBEEmbeddings.ml @@ -9,8 +9,8 @@ let (mkFV : fun fv -> fun us -> fun ts -> - FStarC_TypeChecker_NBETerm.mkFV fv (FStarC_Compiler_List.rev us) - (FStarC_Compiler_List.rev ts) + FStarC_TypeChecker_NBETerm.mkFV fv (FStarC_List.rev us) + (FStarC_List.rev ts) let (mkConstruct : FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.universe Prims.list -> @@ -20,8 +20,8 @@ let (mkConstruct : fun fv -> fun us -> fun ts -> - FStarC_TypeChecker_NBETerm.mkConstruct fv - (FStarC_Compiler_List.rev us) (FStarC_Compiler_List.rev ts) + FStarC_TypeChecker_NBETerm.mkConstruct fv (FStarC_List.rev us) + (FStarC_List.rev ts) let (fv_as_emb_typ : FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.emb_typ) = fun fv -> @@ -65,8 +65,7 @@ let mk_lazy : FStarC_Syntax_Syntax.blob = uu___; FStarC_Syntax_Syntax.lkind = kind; FStarC_Syntax_Syntax.ltyp = ty; - FStarC_Syntax_Syntax.rng = - FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.rng = FStarC_Range_Type.dummyRange } in let thunk = FStarC_Thunk.mk @@ -95,7 +94,7 @@ let (e_bv : FStarC_Syntax_Syntax.bv FStarC_TypeChecker_NBETerm.embedding) = | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded bv: %s" uu___3 in + FStarC_Util.format1 "Not an embedded bv: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -121,7 +120,7 @@ let (e_namedv : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded namedv: %s" uu___3 in + FStarC_Util.format1 "Not an embedded namedv: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -148,7 +147,7 @@ let (e_binder : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded binder: %s" uu___3 in + FStarC_Util.format1 "Not an embedded binder: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -166,10 +165,10 @@ let rec mapM_opt : | [] -> FStar_Pervasives_Native.Some [] | x::xs -> let uu___ = f x in - FStarC_Compiler_Util.bind_opt uu___ + FStarC_Util.bind_opt uu___ (fun x1 -> let uu___1 = mapM_opt f xs in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun xs1 -> FStar_Pervasives_Native.Some (x1 :: xs1))) let (e_term_aq : (Prims.int * FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax @@ -192,7 +191,7 @@ let (e_term_aq : FStarC_Reflection_V2_Embeddings.e_term_aq (Prims.int_zero, []) in let uu___1 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_quoted (tm, qi)) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Syntax_Embeddings_Base.unembed uu___ uu___1 FStarC_Syntax_Embeddings_Base.id_norm_cb | uu___ -> FStar_Pervasives_Native.None in @@ -209,13 +208,12 @@ let (e_term_aq : let (e_term : FStarC_Syntax_Syntax.term FStarC_TypeChecker_NBETerm.embedding) = e_term_aq (Prims.int_zero, []) let (e_sort : - FStarC_Syntax_Syntax.term FStarC_Compiler_Sealed.sealed + FStarC_Syntax_Syntax.term FStarC_Sealed.sealed FStarC_TypeChecker_NBETerm.embedding) = FStarC_TypeChecker_NBETerm.e_sealed e_term let (e_ppname : - Prims.string FStarC_Compiler_Sealed.sealed - FStarC_TypeChecker_NBETerm.embedding) - = FStarC_TypeChecker_NBETerm.e_sealed FStarC_TypeChecker_NBETerm.e_string + Prims.string FStarC_Sealed.sealed FStarC_TypeChecker_NBETerm.embedding) = + FStarC_TypeChecker_NBETerm.e_sealed FStarC_TypeChecker_NBETerm.e_string let (e_aqualv : FStarC_Reflection_V2_Data.aqualv FStarC_TypeChecker_NBETerm.embedding) = let embed_aqualv cb q = @@ -252,14 +250,14 @@ let (e_aqualv : FStarC_Reflection_V2_Constants.ref_Q_Meta.FStarC_Reflection_V2_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Q_Meta t2)) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded aqualv: %s" uu___3 in + FStarC_Util.format1 "Not an embedded aqualv: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -291,7 +289,7 @@ let (e_fv : FStarC_Syntax_Syntax.fv FStarC_TypeChecker_NBETerm.embedding) = | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded fvar: %s" uu___3 in + FStarC_Util.format1 "Not an embedded fvar: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -317,7 +315,7 @@ let (e_comp : FStarC_Syntax_Syntax.comp FStarC_TypeChecker_NBETerm.embedding) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded comp: %s" uu___3 in + FStarC_Util.format1 "Not an embedded comp: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -344,7 +342,7 @@ let (e_env : FStarC_TypeChecker_Env.env FStarC_TypeChecker_NBETerm.embedding) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded env: %s" uu___3 in + FStarC_Util.format1 "Not an embedded env: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -437,7 +435,7 @@ let (e_vconst : let uu___1 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb i in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun i1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.C_Int i1)) @@ -448,7 +446,7 @@ let (e_vconst : let uu___1 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_string cb s in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun s1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.C_String s1)) @@ -459,7 +457,7 @@ let (e_vconst : let uu___1 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_range cb r in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun r1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.C_Range r1)) @@ -474,14 +472,14 @@ let (e_vconst : let uu___1 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_string_list cb ns in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun ns1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.C_Reflect ns1)) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded vconst: %s" uu___3 in + FStarC_Util.format1 "Not an embedded vconst: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -508,8 +506,7 @@ let (e_universe : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded universe: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded universe: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -596,7 +593,7 @@ let rec e_pattern_aq : FStarC_Reflection_V2_Constants.ref_Pat_Constant.FStarC_Reflection_V2_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_vconst cb c in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun c1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Pat_Constant c1)) @@ -606,14 +603,14 @@ let rec e_pattern_aq : FStarC_Reflection_V2_Constants.ref_Pat_Cons.FStarC_Reflection_V2_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_fv cb f in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun f1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_option (FStarC_TypeChecker_NBETerm.e_list e_universe)) cb us_opt in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun us -> let uu___5 = let uu___6 = @@ -623,7 +620,7 @@ let rec e_pattern_aq : FStarC_TypeChecker_NBETerm.e_bool in FStarC_TypeChecker_NBETerm.e_list uu___7 in FStarC_TypeChecker_NBETerm.unembed uu___6 cb ps in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ps1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Pat_Cons (f1, us, ps1))))) @@ -633,11 +630,11 @@ let rec e_pattern_aq : FStarC_Reflection_V2_Constants.ref_Pat_Var.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_sort cb sort in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun sort1 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_ppname cb ppname in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ppname1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Pat_Var (sort1, ppname1)))) @@ -648,15 +645,14 @@ let rec e_pattern_aq : let uu___1 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_option e_term) cb eopt in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun eopt1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Pat_Dot_Term eopt1)) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded pattern: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded pattern: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -736,7 +732,7 @@ let (e_ident : FStarC_Ident.ident FStarC_TypeChecker_NBETerm.embedding) = | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded ident: %s" uu___3 in + FStarC_Util.format1 "Not an embedded ident: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -826,7 +822,7 @@ let (e_universe_view : FStarC_Reflection_V2_Constants.ref_Uv_Succ.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_universe cb u in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun u1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Uv_Succ u1)) @@ -837,7 +833,7 @@ let (e_universe_view : let uu___2 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_universe) cb us in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun us1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Uv_Max us1)) @@ -848,7 +844,7 @@ let (e_universe_view : let uu___2 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb n in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun n1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Uv_BVar n1)) @@ -857,7 +853,7 @@ let (e_universe_view : FStarC_Reflection_V2_Constants.ref_Uv_Name.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_ident cb i in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun i1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Uv_Name i1)) @@ -874,8 +870,7 @@ let (e_universe_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded universe view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded universe view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -978,10 +973,10 @@ let (e_subst_elt : let uu___2 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb i in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun i1 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_namedv cb x in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun x1 -> let uu___4 = let uu___5 = @@ -994,12 +989,12 @@ let (e_subst_elt : FStarC_Reflection_V2_Constants.ref_NM.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_namedv cb x in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun x1 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb i in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun i1 -> let uu___4 = let uu___5 = @@ -1012,10 +1007,10 @@ let (e_subst_elt : FStarC_Reflection_V2_Constants.ref_NT.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_namedv cb x in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun x1 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.NT (x1, t2)))) @@ -1027,10 +1022,10 @@ let (e_subst_elt : let uu___2 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb i in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun i1 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_universe cb u in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun u1 -> let uu___4 = let uu___5 = @@ -1043,12 +1038,12 @@ let (e_subst_elt : FStarC_Reflection_V2_Constants.ref_UD.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_univ_name cb n in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun n1 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb i in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun i1 -> let uu___4 = let uu___5 = @@ -1058,7 +1053,7 @@ let (e_subst_elt : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded vconst: %s" uu___3 in + FStarC_Util.format1 "Not an embedded vconst: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1359,7 +1354,7 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_Var.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_bv cb b in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun b1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_Var b1)) @@ -1369,7 +1364,7 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_BVar.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_bv cb b in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun b1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_BVar b1)) @@ -1379,7 +1374,7 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_FVar.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_fv cb f in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun f1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_FVar f1)) @@ -1389,12 +1384,12 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_UInst.FStarC_Reflection_V2_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_fv cb f in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun f1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_universe) cb us in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun us1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_UInst (f1, us1)))) @@ -1404,10 +1399,10 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_App.FStarC_Reflection_V2_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_term cb l in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun l1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_argv cb r in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun r1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_App (l1, r1)))) @@ -1417,10 +1412,10 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_Abs.FStarC_Reflection_V2_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_binder cb b in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun b1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_Abs (b1, t2)))) @@ -1430,10 +1425,10 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_Arrow.FStarC_Reflection_V2_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_binder cb b in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun b1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_comp cb t1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun c -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_Arrow (b1, c)))) @@ -1443,7 +1438,7 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_Type.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_universe cb u in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun u1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_Type u1)) @@ -1453,10 +1448,10 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_Refine.FStarC_Reflection_V2_Constants.lid -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e_binder cb b in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun b1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_Refine (b1, t2)))) @@ -1466,7 +1461,7 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_Const.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_vconst cb c in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun c1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_Const c1)) @@ -1478,7 +1473,7 @@ let (e_term_view_aq : let uu___3 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb u in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun u1 -> let ctx_u_s = unlazy_as_t FStarC_Syntax_Syntax.Lazy_uvar l in FStar_Pervasives_Native.Some @@ -1494,25 +1489,25 @@ let (e_term_view_aq : let uu___6 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_bool cb r in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun r1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_term) cb attrs in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun attrs1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_binder cb b in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun b1 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun t11 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e_term cb t2 in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun t21 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_Let @@ -1524,17 +1519,17 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_Match.FStarC_Reflection_V2_Constants.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun t2 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_branch) cb brs in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun brs1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_match_returns_annotation cb ret_opt in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun ret_opt1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_Match @@ -1547,21 +1542,21 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_AscT.FStarC_Reflection_V2_Constants.lid -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb e in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun e1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun t2 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_option e_term) cb tacopt in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun tacopt1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_bool cb use_eq in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun use_eq1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_AscribedT @@ -1574,21 +1569,21 @@ let (e_term_view_aq : FStarC_Reflection_V2_Constants.ref_Tv_AscC.FStarC_Reflection_V2_Constants.lid -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb e in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun e1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_comp cb c in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun c1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_option e_term) cb tacopt in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun tacopt1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_bool cb use_eq in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun use_eq1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Tv_AscribedC @@ -1605,8 +1600,7 @@ let (e_term_view_aq : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded term_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded term_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1655,15 +1649,15 @@ let (e_namedv_view : let uu___4 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb uniq in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun uniq1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_ppname cb ppname in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ppname1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_sort cb sort in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun sort1 -> let r = { @@ -1675,8 +1669,7 @@ let (e_namedv_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded namedv_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded namedv_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1720,15 +1713,15 @@ let (e_bv_view : let uu___4 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb idx in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun idx1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_ppname cb ppname in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ppname1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_sort cb sort in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun sort1 -> let r = { @@ -1740,7 +1733,7 @@ let (e_bv_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded bv_view: %s" uu___3 in + FStarC_Util.format1 "Not an embedded bv_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1792,14 +1785,14 @@ let (e_binding : let uu___4 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_int cb uniq in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun uniq1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb sort in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun sort1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_ppname cb ppname in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun ppname1 -> let r = { @@ -1854,19 +1847,19 @@ let (e_binder_view : FStarC_Reflection_V2_Constants.ref_Mk_binder_view.FStarC_Reflection_V2_Constants.lid -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb sort in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun sort1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_aqualv cb q in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun q1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e_attributes cb attrs in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun attrs1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_ppname cb ppname in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun ppname1 -> let r = { @@ -1879,8 +1872,7 @@ let (e_binder_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded binder_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded binder_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -1972,7 +1964,7 @@ let (e_comp_view : FStarC_Reflection_V2_Constants.ref_C_Total.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.C_Total t2)) @@ -1981,7 +1973,7 @@ let (e_comp_view : FStarC_Reflection_V2_Constants.ref_C_GTotal.FStarC_Reflection_V2_Constants.lid -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.C_GTotal t2)) @@ -1991,14 +1983,14 @@ let (e_comp_view : FStarC_Reflection_V2_Constants.ref_C_Lemma.FStarC_Reflection_V2_Constants.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_term cb pre in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun pre1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_term cb post in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun post1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_term cb pats in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun pats1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.C_Lemma @@ -2014,27 +2006,27 @@ let (e_comp_view : let uu___6 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_universe) cb us in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun us1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_string_list cb eff in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun eff1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_term cb res in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun res1 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_argv) cb args in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun args1 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_term) cb decrs in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun decrs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.C_Eff @@ -2042,8 +2034,7 @@ let (e_comp_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded comp_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded comp_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2070,7 +2061,7 @@ let (e_sigelt : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded sigelt: %s" uu___3 in + FStarC_Util.format1 "Not an embedded sigelt: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2128,19 +2119,19 @@ let (e_lb_view : FStarC_Reflection_V2_Constants.ref_Mk_lb.FStarC_Reflection_V2_Constants.lid -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_fv cb fv' in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun fv'1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_univ_names cb us in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun us1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e_term cb typ in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun typ1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_term cb def in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun def1 -> FStar_Pervasives_Native.Some { @@ -2152,7 +2143,7 @@ let (e_lb_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded lb_view: %s" uu___3 in + FStarC_Util.format1 "Not an embedded lb_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2165,9 +2156,8 @@ let (e_lid : FStarC_Ident.lid FStarC_TypeChecker_NBETerm.embedding) = FStarC_TypeChecker_NBETerm.embed e_string_list rng uu___ in let unembed cb t = let uu___ = FStarC_TypeChecker_NBETerm.unembed e_string_list cb t in - FStarC_Compiler_Util.map_opt uu___ - (fun p -> - FStarC_Ident.lid_of_path p FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Util.map_opt uu___ + (fun p -> FStarC_Ident.lid_of_path p FStarC_Range_Type.dummyRange) in FStarC_TypeChecker_NBETerm.mk_emb embed unembed (fun uu___ -> mkConstruct FStarC_Reflection_V2_Constants.fstar_refl_aqualv_fv [] []) @@ -2193,8 +2183,7 @@ let (e_letbinding : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded letbinding: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded letbinding: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2291,25 +2280,25 @@ let (e_sigelt_view : FStarC_Reflection_V2_Constants.ref_Sg_Inductive.FStarC_Reflection_V2_Constants.lid -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_string_list cb nm in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun nm1 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e_univ_names cb us in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun us1 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e_binders cb bs in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun bs1 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun t2 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_ctor) cb dcs in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun dcs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Sg_Inductive @@ -2322,12 +2311,12 @@ let (e_sigelt_view : let uu___3 = FStarC_TypeChecker_NBETerm.unembed FStarC_TypeChecker_NBETerm.e_bool cb r in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun r1 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_list e_letbinding) cb lbs in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun lbs1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Sg_Let (r1, lbs1)))) @@ -2337,15 +2326,15 @@ let (e_sigelt_view : FStarC_Reflection_V2_Constants.ref_Sg_Val.FStarC_Reflection_V2_Constants.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_string_list cb nm in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun nm1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_univ_names cb us in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun us1 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e_term cb t1 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun t2 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Sg_Val (nm1, us1, t2))))) @@ -2356,8 +2345,7 @@ let (e_sigelt_view : | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded sigelt_view: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded sigelt_view: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2588,7 +2576,7 @@ let (e_qualifier : FStarC_Reflection_V2_Constants.ref_qual_Reflectable.FStarC_Reflection_V2_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_name cb l in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Reflectable l1)) @@ -2597,7 +2585,7 @@ let (e_qualifier : FStarC_Reflection_V2_Constants.ref_qual_Discriminator.FStarC_Reflection_V2_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_name cb l in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Discriminator l1)) @@ -2606,7 +2594,7 @@ let (e_qualifier : FStarC_Reflection_V2_Constants.ref_qual_Action.FStarC_Reflection_V2_Constants.lid -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e_name cb l in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun l1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Action l1)) @@ -2617,7 +2605,7 @@ let (e_qualifier : let uu___1 = FStarC_TypeChecker_NBETerm.unembed (FStarC_TypeChecker_NBETerm.e_tuple2 e_name e_ident) cb li in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun li1 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.Projector li1)) @@ -2630,7 +2618,7 @@ let (e_qualifier : (FStarC_TypeChecker_NBETerm.e_tuple2 (FStarC_TypeChecker_NBETerm.e_list e_ident) (FStarC_TypeChecker_NBETerm.e_list e_ident)) cb ids12 in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun ids121 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.RecordType ids121)) @@ -2643,15 +2631,14 @@ let (e_qualifier : (FStarC_TypeChecker_NBETerm.e_tuple2 (FStarC_TypeChecker_NBETerm.e_list e_ident) (FStarC_TypeChecker_NBETerm.e_list e_ident)) cb ids12 in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun ids121 -> FStar_Pervasives_Native.Some (FStarC_Reflection_V2_Data.RecordConstructor ids121)) | uu___ -> ((let uu___2 = let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded qualifier: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded qualifier: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2666,8 +2653,7 @@ let (e_qualifiers : FStarC_Reflection_V2_Data.qualifier Prims.list FStarC_TypeChecker_NBETerm.embedding) = FStarC_TypeChecker_NBETerm.e_list e_qualifier -let (e_vconfig : - FStarC_Compiler_Order.order FStarC_TypeChecker_NBETerm.embedding) = +let (e_vconfig : FStarC_Order.order FStarC_TypeChecker_NBETerm.embedding) = let emb cb o = failwith "emb vconfig NBE" in let unemb cb t = failwith "unemb vconfig NBE" in let uu___ = diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Encode.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Encode.ml similarity index 95% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_Encode.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Encode.ml index 5a4f2ae8d2b..6bf2f0bb04b 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Encode.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Encode.ml @@ -1,11 +1,11 @@ open Prims type encoding_depth = (Prims.int * Prims.int) -let (dbg_SMTEncoding : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SMTEncoding" -let (dbg_SMTQuery : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SMTQuery" -let (dbg_Time : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Time" +let (dbg_SMTEncoding : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SMTEncoding" +let (dbg_SMTQuery : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SMTQuery" +let (dbg_Time : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Time" let (norm_before_encoding : FStarC_SMTEncoding_Env.env_t -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) @@ -148,8 +148,7 @@ let (prims : prims_t) = let xname_decl = let uu___3 = let uu___4 = - FStarC_Compiler_List.map - FStarC_SMTEncoding_Term.fv_sort vars in + FStarC_List.map FStarC_SMTEncoding_Term.fv_sort vars in (x1, uu___4, FStarC_SMTEncoding_Term.Term_sort, FStar_Pervasives_Native.None) in FStarC_SMTEncoding_Term.DeclFun uu___3 in @@ -161,8 +160,7 @@ let (prims : prims_t) = let xapp = let uu___3 = let uu___4 = - FStarC_Compiler_List.map - FStarC_SMTEncoding_Util.mkFreeV vars in + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars in (x1, uu___4) in FStarC_SMTEncoding_Util.mkApp uu___3 in let xtok1 = FStarC_SMTEncoding_Util.mkApp (xtok, []) in @@ -170,8 +168,7 @@ let (prims : prims_t) = FStarC_SMTEncoding_EncodeTerm.mk_Apply xtok1 vars in let tot_fun_axioms = let all_vars_but_one = - FStar_Pervasives_Native.fst - (FStarC_Compiler_Util.prefix vars) in + FStar_Pervasives_Native.fst (FStarC_Util.prefix vars) in let axiom_name = Prims.strcat "primitive_tot_fun_" x1 in let tot_fun_axiom_for_x = let uu___3 = @@ -180,7 +177,7 @@ let (prims : prims_t) = (uu___4, FStar_Pervasives_Native.None, axiom_name) in FStarC_SMTEncoding_Util.mkAssume uu___3 in let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun var -> match uu___4 with @@ -188,13 +185,12 @@ let (prims : prims_t) = let app1 = FStarC_SMTEncoding_EncodeTerm.mk_Apply app [var] in - let vars2 = - FStarC_Compiler_List.op_At vars1 [var] in + let vars2 = FStarC_List.op_At vars1 [var] in let axiom_name1 = Prims.strcat axiom_name (Prims.strcat "." (Prims.string_of_int - (FStarC_Compiler_List.length vars2))) in + (FStarC_List.length vars2))) in let uu___5 = let uu___6 = let uu___7 = @@ -213,8 +209,7 @@ let (prims : prims_t) = (uu___5, app1, vars2)) ([tot_fun_axiom_for_x], xtok1, []) all_vars_but_one in match uu___3 with - | (axioms, uu___4, uu___5) -> - FStarC_Compiler_List.rev axioms in + | (axioms, uu___4, uu___5) -> FStarC_List.rev axioms in let rel_body = let rel_body1 = rel_type_f rel (xapp, body) in match precondition with @@ -253,22 +248,22 @@ let (prims : prims_t) = (Prims.strcat "token_correspondence_" x1)) in FStarC_SMTEncoding_Util.mkAssume uu___8 in [uu___7] in - FStarC_Compiler_List.op_At tot_fun_axioms uu___6 in - FStarC_Compiler_List.op_At uu___4 uu___5 in - (xtok1, (FStarC_Compiler_List.length vars), uu___3) in + FStarC_List.op_At tot_fun_axioms uu___6 in + FStarC_List.op_At uu___4 uu___5 in + (xtok1, (FStarC_List.length vars), uu___3) in let quant rel vars body = quant_with_pre rel vars FStar_Pervasives_Native.None body in let axy = - FStarC_Compiler_List.map FStarC_SMTEncoding_Term.mk_fv + FStarC_List.map FStarC_SMTEncoding_Term.mk_fv [(asym, FStarC_SMTEncoding_Term.Term_sort); (xsym, FStarC_SMTEncoding_Term.Term_sort); (ysym, FStarC_SMTEncoding_Term.Term_sort)] in let xy = - FStarC_Compiler_List.map FStarC_SMTEncoding_Term.mk_fv + FStarC_List.map FStarC_SMTEncoding_Term.mk_fv [(xsym, FStarC_SMTEncoding_Term.Term_sort); (ysym, FStarC_SMTEncoding_Term.Term_sort)] in let qx = - FStarC_Compiler_List.map FStarC_SMTEncoding_Term.mk_fv + FStarC_List.map FStarC_SMTEncoding_Term.mk_fv [(xsym, FStarC_SMTEncoding_Term.Term_sort)] in let prims1 = let uu___3 = @@ -761,7 +756,7 @@ let (prims : prims_t) = x in FStarC_SMTEncoding_Term.mkRealOfInt uu___53 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_SMTEncoding_Term.boxReal uu___52 in quant Eq @@ -798,27 +793,27 @@ let (prims : prims_t) = let mk l v = let uu___3 = let uu___4 = - FStarC_Compiler_List.find + FStarC_List.find (fun uu___5 -> match uu___5 with | (l', uu___6) -> FStarC_Ident.lid_equals l l') prims1 in - FStarC_Compiler_Option.map + FStarC_Option.map (fun uu___5 -> match uu___5 with | (uu___6, b) -> let uu___7 = FStarC_Ident.range_of_lid l in b uu___7 v) uu___4 in - FStarC_Compiler_Option.get uu___3 in + FStarC_Option.get uu___3 in let is l = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | (l', uu___4) -> FStarC_Ident.lid_equals l l') prims1 in { mk; is })) let (pretype_axiom : Prims.bool -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_SMTEncoding_Env.env_t -> FStarC_SMTEncoding_Term.term -> FStarC_SMTEncoding_Term.fv Prims.list -> @@ -895,8 +890,7 @@ let (pretype_axiom : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_Util.digest_of_string - tapp_hash in + FStarC_Util.digest_of_string tapp_hash in Prims.strcat "_pretyping_" uu___7 in Prims.strcat module_name uu___6 in FStarC_SMTEncoding_Env.varops.FStarC_SMTEncoding_Env.mk_unique @@ -1452,7 +1446,7 @@ let (primitive_type_axioms : fun s -> fun tt -> let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | (l, uu___2) -> FStarC_Ident.lid_equals l t) prims1 in @@ -1489,7 +1483,7 @@ let (encode_smt_lemma : FStarC_SMTEncoding_Util.mkAssume uu___4 in [uu___3] in FStarC_SMTEncoding_Term.mk_decls_trivial uu___2 in - FStarC_Compiler_List.op_At decls uu___1 + FStarC_List.op_At decls uu___1 let (encode_free_var : Prims.bool -> FStarC_SMTEncoding_Env.env_t -> @@ -1527,11 +1521,11 @@ let (encode_free_var : { FStarC_Syntax_Syntax.bs1 = binders; FStarC_Syntax_Syntax.comp = uu___2;_} -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> FStarC_SMTEncoding_Term.Term_sort) binders | uu___2 -> [] in - let arity = FStarC_Compiler_List.length arg_sorts in + let arity = FStarC_List.length arg_sorts in let uu___1 = FStarC_SMTEncoding_Env.new_term_constant_and_tok_from_lid env lid arity in @@ -1711,19 +1705,20 @@ let (encode_free_var : tcenv_comp comp1 in (args, uu___6) else - (args, - (FStar_Pervasives_Native.None, - (FStarC_Syntax_Util.comp_result comp1))) in + (let uu___7 = + let uu___8 = + FStarC_Syntax_Util.comp_result comp1 in + (FStar_Pervasives_Native.None, uu___8) in + (args, uu___7)) in match uu___4 with | (formals, (pre_opt, res_t)) -> let mk_disc_proj_axioms guard encoded_res_t vapp vars = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___5 -> match uu___5 with | FStarC_Syntax_Syntax.Discriminator d -> - let uu___6 = - FStarC_Compiler_Util.prefix vars in + let uu___6 = FStarC_Util.prefix vars in (match uu___6 with | (uu___7, xxv) -> let xx = @@ -1782,8 +1777,7 @@ let (encode_free_var : uu___9 in [uu___8]) | FStarC_Syntax_Syntax.Projector (d, f) -> - let uu___6 = - FStarC_Compiler_Util.prefix vars in + let uu___6 = FStarC_Util.prefix vars in (match uu___6 with | (uu___7, xxv) -> let xx = @@ -1855,8 +1849,7 @@ let (encode_free_var : FStarC_SMTEncoding_Util.mk_and_l (g :: guards) in (uu___9, - (FStarC_Compiler_List.op_At decls1 - ds))) in + (FStarC_List.op_At decls1 ds))) in (match uu___7 with | (guard, decls11) -> let dummy_var = @@ -1865,7 +1858,7 @@ let (encode_free_var : FStarC_SMTEncoding_Term.dummy_sort) in let dummy_tm = FStarC_SMTEncoding_Term.mkFreeV dummy_var - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let should_thunk uu___8 = let is_type t = let uu___9 = @@ -1923,7 +1916,7 @@ let (encode_free_var : (((let uu___9 = FStarC_Ident.nsstr lid in uu___9 <> "Prims") && (Prims.op_Negation - (FStarC_Compiler_List.contains + (FStarC_List.contains FStarC_Syntax_Syntax.Logic quals))) && @@ -1939,16 +1932,14 @@ let (encode_free_var : | uu___9 -> (false, vars) in (match uu___8 with | (thunked, vars1) -> - let arity = - FStarC_Compiler_List.length formals in + let arity = FStarC_List.length formals in let uu___9 = FStarC_SMTEncoding_Env.new_term_constant_and_tok_from_lid_maybe_thunked env lid arity thunked in (match uu___9 with | (vname, vtok_opt, env1) -> let get_vtok uu___10 = - FStarC_Compiler_Option.get - vtok_opt in + FStarC_Option.get vtok_opt in let vtok_tm = match formals with | [] when @@ -1971,7 +1962,7 @@ let (encode_free_var : let vapp = let uu___10 = let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars1 in (vname, uu___11) in @@ -1981,7 +1972,7 @@ let (encode_free_var : let vname_decl = let uu___11 = let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_sort vars1 in (vname, uu___12, @@ -2057,7 +2048,7 @@ let (encode_free_var : let uu___14 = FStarC_SMTEncoding_Term.mk_decls_trivial [tok_typing1] in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls2 uu___14 in let uu___14 = let uu___15 = @@ -2163,7 +2154,7 @@ let (encode_free_var : [vtok_decl; name_tok_corr; tok_typing1] in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls2 uu___15 in (uu___14, env1) in (match uu___12 with @@ -2172,7 +2163,7 @@ let (encode_free_var : let uu___14 = FStarC_SMTEncoding_Term.mk_decls_trivial [vname_decl] in - FStarC_Compiler_List.op_At + FStarC_List.op_At uu___14 tok_decl in (uu___13, env2)) in (match uu___10 with @@ -2221,7 +2212,7 @@ let (encode_free_var : uu___12 in let freshness = if - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Syntax_Syntax.New quals then @@ -2231,7 +2222,7 @@ let (encode_free_var : fv in let uu___14 = let uu___15 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_sort vars1 in let uu___16 = @@ -2270,16 +2261,16 @@ let (encode_free_var : vars1 in typingAx :: uu___17 in - FStarC_Compiler_List.op_At + FStarC_List.op_At freshness uu___16 in FStarC_SMTEncoding_Term.mk_decls_trivial uu___15 in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls3 uu___14 in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls2 uu___13 in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls11 uu___12 in (g, env2))))))))) let (declare_top_level_let : @@ -2348,7 +2339,7 @@ let (encode_top_level_val : then let uu___2 = let uu___3 = encode_smt_lemma env1 fv tt in - FStarC_Compiler_List.op_At decls uu___3 in + FStarC_List.op_At decls uu___3 in (uu___2, env1) else (decls, env1) let (encode_top_level_vals : @@ -2362,24 +2353,22 @@ let (encode_top_level_vals : fun bindings -> fun quals -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun lb -> match uu___1 with | (decls, env1) -> let uu___2 = let uu___3 = - FStarC_Compiler_Util.right - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in encode_top_level_val false env1 lb.FStarC_Syntax_Syntax.lbunivs uu___3 lb.FStarC_Syntax_Syntax.lbtyp quals in (match uu___2 with | (decls', env2) -> - ((FStarC_Compiler_List.rev_append decls' decls), - env2))) ([], env) bindings in - match uu___ with - | (decls, env1) -> ((FStarC_Compiler_List.rev decls), env1) + ((FStarC_List.rev_append decls' decls), env2))) + ([], env) bindings in + match uu___ with | (decls, env1) -> ((FStarC_List.rev decls), env1) exception Let_rec_unencodeable let (uu___is_Let_rec_unencodeable : Prims.exn -> Prims.bool) = fun projectee -> @@ -2387,8 +2376,7 @@ let (uu___is_Let_rec_unencodeable : Prims.exn -> Prims.bool) = let (copy_env : FStarC_SMTEncoding_Env.env_t -> FStarC_SMTEncoding_Env.env_t) = fun en -> - let uu___ = - FStarC_Compiler_Util.smap_copy en.FStarC_SMTEncoding_Env.global_cache in + let uu___ = FStarC_Util.smap_copy en.FStarC_SMTEncoding_Env.global_cache in { FStarC_SMTEncoding_Env.bvar_bindings = (en.FStarC_SMTEncoding_Env.bvar_bindings); @@ -2420,12 +2408,12 @@ let (encode_top_level_let : match uu___ with | (is_rec, bindings) -> let eta_expand binders formals body t = - let nbinders = FStarC_Compiler_List.length binders in - let uu___1 = FStarC_Compiler_Util.first_N nbinders formals in + let nbinders = FStarC_List.length binders in + let uu___1 = FStarC_Util.first_N nbinders formals in match uu___1 with | (formals1, extra_formals) -> let subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___2 -> fun uu___3 -> match (uu___2, uu___3) with @@ -2448,7 +2436,7 @@ let (encode_top_level_let : binders in let extra_formals1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___3 = let uu___4 = b.FStarC_Syntax_Syntax.binder_bv in @@ -2480,8 +2468,7 @@ let (encode_top_level_let : FStar_Pervasives_Native.snd uu___4 in FStarC_Syntax_Syntax.extend_app_n uu___2 uu___3 body.FStarC_Syntax_Syntax.pos in - ((FStarC_Compiler_List.op_At binders extra_formals1), - body1) in + ((FStarC_List.op_At binders extra_formals1), body1) in let destruct_bound_function t e = let tcenv = let uu___1 = env.FStarC_SMTEncoding_Env.tcenv in @@ -2592,7 +2579,7 @@ let (encode_top_level_let : } in let subst_comp formals actuals comp = let subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -2649,13 +2636,13 @@ let (encode_top_level_let : | uu___3 -> arrow_formals_comp_norm false t1 in (match uu___2 with | (formals, comp) -> - let nformals = FStarC_Compiler_List.length formals in - let nbinders = FStarC_Compiler_List.length binders in + let nformals = FStarC_List.length formals in + let nbinders = FStarC_List.length binders in let uu___3 = if nformals < nbinders then let uu___4 = - FStarC_Compiler_Util.first_N nformals binders in + FStarC_Util.first_N nformals binders in match uu___4 with | (bs0, rest) -> let body1 = @@ -2666,8 +2653,9 @@ let (encode_top_level_let : if nformals > nbinders then (let uu___5 = - eta_expand binders formals body - (FStarC_Syntax_Util.comp_result comp) in + let uu___6 = + FStarC_Syntax_Util.comp_result comp in + eta_expand binders formals body uu___6 in match uu___5 with | (binders1, body1) -> let uu___6 = @@ -2702,23 +2690,26 @@ let (encode_top_level_let : let uu___4 = aux comp1 body1 in match uu___4 with | (more_binders, body2, comp2) -> - ((FStarC_Compiler_List.op_At binders more_binders), - body2, comp2) + ((FStarC_List.op_At binders more_binders), body2, + comp2) else (binders, body, comp) in (match uu___2 with | (binders1, body1, comp1) -> let uu___3 = - FStarC_Syntax_Util.ascribe body1 - ((FStar_Pervasives.Inl - (FStarC_Syntax_Util.comp_result comp1)), - FStar_Pervasives_Native.None, false) in + let uu___4 = + let uu___5 = + let uu___6 = + FStarC_Syntax_Util.comp_result comp1 in + FStar_Pervasives.Inl uu___6 in + (uu___5, FStar_Pervasives_Native.None, false) in + FStarC_Syntax_Util.ascribe body1 uu___4 in (binders1, uu___3, comp1)) in (try (fun uu___1 -> match () with | () -> let uu___2 = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun lb -> FStarC_Syntax_Util.is_lemma lb.FStarC_Syntax_Syntax.lbtyp) bindings in @@ -2726,7 +2717,7 @@ let (encode_top_level_let : then encode_top_level_vals env bindings quals else (let uu___4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___5 -> fun lb -> match uu___5 with @@ -2736,7 +2727,7 @@ let (encode_top_level_let : lb.FStarC_Syntax_Syntax.lbtyp in if uu___7 then - FStarC_Compiler_Effect.raise + FStarC_Effect.raise Let_rec_unencodeable else ()); (let t_norm = @@ -2751,7 +2742,7 @@ let (encode_top_level_let : lb.FStarC_Syntax_Syntax.lbtyp in let uu___7 = let uu___8 = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in declare_top_level_let env1 uu___8 lb.FStarC_Syntax_Syntax.lbtyp @@ -2763,12 +2754,11 @@ let (encode_top_level_let : ([], [], [], env) bindings in match uu___4 with | (toks, typs, decls, env1) -> - let toks_fvbs = FStarC_Compiler_List.rev toks in + let toks_fvbs = FStarC_List.rev toks in let decls1 = - FStarC_Compiler_List.flatten - (FStarC_Compiler_List.rev decls) in + FStarC_List.flatten (FStarC_List.rev decls) in let env_decls = copy_env env1 in - let typs1 = FStarC_Compiler_List.rev typs in + let typs1 = FStarC_List.rev typs in let encode_non_rec_lbdef bindings1 typs2 toks1 env2 = match (bindings1, typs2, toks1) with @@ -2839,7 +2829,7 @@ let (encode_top_level_let : FStarC_Syntax_Util.comp_result t_body_comp in ((let uu___12 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___12 then @@ -2852,7 +2842,7 @@ let (encode_top_level_let : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term body in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Encoding let : binders=[%s], body=%s\n" uu___13 uu___14 else ()); @@ -2875,7 +2865,7 @@ let (encode_top_level_let : let dummy_tm = FStarC_SMTEncoding_Term.mkFreeV dummy_var - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let app = let uu___15 = FStarC_Syntax_Syntax.range_of_lbname @@ -2891,7 +2881,7 @@ let (encode_top_level_let : FStarC_Syntax_Syntax.range_of_lbname lbn in let uu___18 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars in FStarC_SMTEncoding_EncodeTerm.maybe_curry_fvb @@ -2917,7 +2907,7 @@ let (encode_top_level_let : let is_smt_theory_symbol = let fv = - FStarC_Compiler_Util.right + FStarC_Util.right lbn in FStarC_TypeChecker_Env.fv_has_attr env2.FStarC_SMTEncoding_Env.tcenv @@ -2932,7 +2922,7 @@ let (encode_top_level_let : (Prims.op_Negation is_smt_theory_symbol) && - ((FStarC_Compiler_List.contains + ((FStarC_List.contains FStarC_Syntax_Syntax.Logic quals) || is_logical) in @@ -2959,7 +2949,7 @@ let (encode_top_level_let : let uu___19 = FStarC_Ident.string_of_lid flid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Equation for %s" uu___19 in FStar_Pervasives_Native.Some @@ -2993,10 +2983,10 @@ let (encode_top_level_let : && (let uu___18 = - FStarC_Options_Ext.get + FStarC_Options_Ext.enabled "retain_old_prop_typing" in - uu___18 = - "") in + Prims.op_Negation + uu___18) in (if uu___17 then let uu___18 @@ -3042,7 +3032,7 @@ let (encode_top_level_let : = FStarC_Ident.string_of_lid flid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Prop-typing for %s" uu___23 in FStar_Pervasives_Native.Some @@ -3127,7 +3117,7 @@ let (encode_top_level_let : body1 in ([logical_eqn; basic_eqn], - (FStarC_Compiler_List.op_At + (FStarC_List.op_At decls2 decls21))) else @@ -3150,18 +3140,18 @@ let (encode_top_level_let : flid fvb.FStarC_SMTEncoding_Env.smt_id app in - FStarC_Compiler_List.op_At + FStarC_List.op_At eqns uu___21 in FStarC_SMTEncoding_Term.mk_decls_trivial uu___20 in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls2 uu___19 in - FStarC_Compiler_List.op_At + FStarC_List.op_At binder_decls uu___18 in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls1 uu___17 in (uu___16, env2))))))) @@ -3181,7 +3171,7 @@ let (encode_top_level_let : FStarC_SMTEncoding_Util.mkFreeV fuel in let env0 = env2 in let uu___5 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___6 -> fun fvb -> match uu___6 with @@ -3216,8 +3206,7 @@ let (encode_top_level_let : ([], env2) toks1 in match uu___5 with | (gtoks, env3) -> - let gtoks1 = - FStarC_Compiler_List.rev gtoks in + let gtoks1 = FStarC_List.rev gtoks in let encode_one_binding env01 uu___6 t_norm uu___7 = match (uu___6, uu___7) with @@ -3284,7 +3273,7 @@ let (encode_top_level_let : (match uu___12 with | (env', e1, t_norm1) -> ((let uu___14 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___14 then @@ -3302,7 +3291,7 @@ let (encode_top_level_let : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e1 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Encoding let rec %s : %s = %s\n" uu___15 uu___16 uu___17 else ()); @@ -3315,7 +3304,7 @@ let (encode_top_level_let : let curry = fvb.FStarC_SMTEncoding_Env.smt_arity <> - (FStarC_Compiler_List.length + (FStarC_List.length binders) in let uu___15 = FStarC_TypeChecker_Util.pure_or_ghost_pre_and_post @@ -3324,7 +3313,7 @@ let (encode_top_level_let : (match uu___15 with | (pre_opt, tres) -> ((let uu___17 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___17 then @@ -3347,7 +3336,7 @@ let (encode_top_level_let : FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp tres_comp in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Encoding let rec %s: \n\tbinders=[%s], \n\tbody=%s, \n\ttres=%s\n" uu___18 uu___19 @@ -3389,7 +3378,7 @@ let (encode_top_level_let : let uu___21 = FStarC_SMTEncoding_Util.mk_and_l - (FStarC_Compiler_List.op_At + (FStarC_List.op_At guards [guard]) in (uu___21, @@ -3401,7 +3390,7 @@ let (encode_top_level_let : -> let binder_decls1 = - FStarC_Compiler_List.op_At + FStarC_List.op_At binder_decls guard_decls in let decl_g @@ -3416,12 +3405,12 @@ let (encode_top_level_let : = let uu___24 = - FStarC_Compiler_Util.first_N + FStarC_Util.first_N fvb.FStarC_SMTEncoding_Env.smt_arity vars in FStar_Pervasives_Native.fst uu___24 in - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_sort uu___23 in FStarC_SMTEncoding_Term.Fuel_sort @@ -3450,7 +3439,7 @@ let (encode_top_level_let : g gtok in let vars_tm = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars in let rng = @@ -3459,7 +3448,7 @@ let (encode_top_level_let : let app = let uu___20 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars in FStarC_SMTEncoding_EncodeTerm.maybe_curry_fvb @@ -3558,7 +3547,7 @@ let (encode_top_level_let : = FStarC_Ident.string_of_lid fvb.FStarC_SMTEncoding_Env.fvar_lid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Equation for fuel-instrumented recursive function: %s" uu___25 in FStar_Pervasives_Native.Some @@ -3691,7 +3680,7 @@ let (encode_top_level_let : vars in let guards1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___22 -> @@ -3803,7 +3792,7 @@ let (encode_top_level_let : typing_corr) -> (aux_decls, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At typing_corr [tok_corr])) in (match uu___21 @@ -3823,19 +3812,19 @@ let (encode_top_level_let : FStarC_SMTEncoding_Term.mk_decls_trivial [decl_g; decl_g_tok] in - FStarC_Compiler_List.op_At + FStarC_List.op_At aux_decls uu___25 in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls2 uu___24 in - FStarC_Compiler_List.op_At + FStarC_List.op_At binder_decls1 uu___23 in let uu___23 = FStarC_SMTEncoding_Term.mk_decls_trivial - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [eqn_g; eqn_g'; eqn_f] @@ -3845,9 +3834,9 @@ let (encode_top_level_let : env02)))))))))) in let uu___6 = let uu___7 = - FStarC_Compiler_List.zip3 gtoks1 typs2 + FStarC_List.zip3 gtoks1 typs2 bindings1 in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___8 -> fun uu___9 -> match (uu___8, uu___9) with @@ -3859,7 +3848,7 @@ let (encode_top_level_let : (match uu___10 with | (decls', eqns', env02) -> ((decls' :: decls2), - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eqns' eqns), env02))) ([decls1], [], env0) uu___7 in (match uu___6 with @@ -3871,38 +3860,38 @@ let (encode_top_level_let : uu___9 -> true | uu___9 -> false in let uu___8 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___9 -> fun elt -> match uu___9 with | (prefix_decls, elts, rest) -> let uu___10 = - (FStarC_Compiler_Util.is_some + (FStarC_Util.is_some elt.FStarC_SMTEncoding_Term.key) && - (FStarC_Compiler_List.existsb + (FStarC_List.existsb isDeclFun elt.FStarC_SMTEncoding_Term.decls) in if uu___10 then (prefix_decls, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At elts [elt]), rest) else (let uu___12 = - FStarC_Compiler_List.partition + FStarC_List.partition isDeclFun elt.FStarC_SMTEncoding_Term.decls in match uu___12 with | (elt_decl_funs, elt_rest) -> - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At prefix_decls elt_decl_funs), elts, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At rest [{ FStarC_SMTEncoding_Term.sym_name @@ -3919,8 +3908,7 @@ let (encode_top_level_let : (elt.FStarC_SMTEncoding_Term.a_names) }])))) ([], [], []) - (FStarC_Compiler_List.flatten - decls2) in + (FStarC_List.flatten decls2) in match uu___8 with | (prefix_decls, elts, rest) -> let uu___9 = @@ -3929,23 +3917,20 @@ let (encode_top_level_let : (uu___9, elts, rest) in (match uu___7 with | (prefix_decls, elts, rest) -> - let eqns1 = - FStarC_Compiler_List.rev eqns in - ((FStarC_Compiler_List.op_At - prefix_decls - (FStarC_Compiler_List.op_At - elts - (FStarC_Compiler_List.op_At - rest eqns1))), env01))) in + let eqns1 = FStarC_List.rev eqns in + ((FStarC_List.op_At prefix_decls + (FStarC_List.op_At elts + (FStarC_List.op_At rest + eqns1))), env01))) in let uu___5 = - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___6 -> match uu___6 with | FStarC_Syntax_Syntax.HasMaskedEffect -> true | uu___7 -> false) quals) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun t -> let uu___6 = (FStarC_Syntax_Util.is_pure_or_ghost_function @@ -3973,11 +3958,10 @@ let (encode_top_level_let : | FStarC_SMTEncoding_Env.Inner_let_rec names -> let plural = - (FStarC_Compiler_List.length names) > + (FStarC_List.length names) > Prims.int_one in let r = - let uu___8 = - FStarC_Compiler_List.hd names in + let uu___8 = FStarC_List.hd names in FStar_Pervasives_Native.snd uu___8 in ((let uu___9 = let uu___10 = @@ -3986,12 +3970,12 @@ let (encode_top_level_let : let uu___13 = let uu___14 = let uu___15 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst names in - FStarC_Compiler_String.concat - "," uu___15 in - FStarC_Compiler_Util.format3 + FStarC_String.concat "," + uu___15 in + FStarC_Util.format3 "Definitions of inner let-rec%s %s and %s enclosing top-level letbinding are not encoded to the solver, you will only be able to reason with their types" (if plural then "s" else "") uu___14 @@ -4013,14 +3997,14 @@ let (encode_top_level_let : | Let_rec_unencodeable -> let msg = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> FStarC_Class_Show.show (FStarC_Class_Show.show_either FStarC_Syntax_Print.showable_bv FStarC_Syntax_Print.showable_fv) lb.FStarC_Syntax_Syntax.lbname) bindings in - FStarC_Compiler_String.concat " and " uu___2 in + FStarC_String.concat " and " uu___2 in let decl = FStarC_SMTEncoding_Term.Caption (Prims.strcat "let rec unencodeable: Skipping: " msg) in @@ -4050,7 +4034,7 @@ let (encode_sig_inductive : let tcenv = env.FStarC_SMTEncoding_Env.tcenv in let quals = se.FStarC_Syntax_Syntax.sigquals in let is_logical = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.Logic -> true @@ -4062,7 +4046,7 @@ let (encode_sig_inductive : let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun f -> f.FStarC_SMTEncoding_Term.field_sort) c.FStarC_SMTEncoding_Term.constr_fields in ((c.FStarC_SMTEncoding_Term.constr_name), uu___5, @@ -4075,12 +4059,12 @@ let (encode_sig_inductive : FStarC_SMTEncoding_Term.constructor_to_decl uu___4 c) in let inversion_axioms env1 tapp vars = let uu___3 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun l -> let uu___4 = FStarC_TypeChecker_Env.try_lookup_lid env1.FStarC_SMTEncoding_Env.tcenv l in - FStarC_Compiler_Option.isNone uu___4) datas in + FStarC_Option.isNone uu___4) datas in if uu___3 then [] else @@ -4091,7 +4075,7 @@ let (encode_sig_inductive : match uu___5 with | (xxsym, xx) -> let uu___6 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___7 -> fun l -> match uu___7 with @@ -4102,10 +4086,8 @@ let (encode_sig_inductive : let uu___8 = let uu___9 = injective_type_params || - (let uu___10 = - FStarC_Options_Ext.get - "compat:injectivity" in - uu___10 <> "") in + (FStarC_Options_Ext.enabled + "compat:injectivity") in if uu___9 then let uu___10 = @@ -4125,7 +4107,7 @@ let (encode_sig_inductive : FStar_Pervasives_Native.snd uu___13 in let env2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env3 -> fun uu___13 -> match uu___13 with @@ -4156,15 +4138,15 @@ let (encode_sig_inductive : (match uu___13 with | (indices1, decls') -> (if - (FStarC_Compiler_List.length + (FStarC_List.length indices1) <> - (FStarC_Compiler_List.length + (FStarC_List.length vars) then failwith "Impossible" else (); (let eqs = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun v -> fun a -> let uu___15 = @@ -4191,8 +4173,7 @@ let (encode_sig_inductive : FStarC_SMTEncoding_Util.mkOr (out, inversion_case) in (uu___9, - (FStarC_Compiler_List.op_At decls - decls')))) + (FStarC_List.op_At decls decls')))) (FStarC_SMTEncoding_Util.mkFalse, []) datas in (match uu___6 with | (data_ax, decls) -> @@ -4205,8 +4186,7 @@ let (encode_sig_inductive : let fuel_guarded_inversion = let xx_has_type_sfuel = if - (FStarC_Compiler_List.length datas) > - Prims.int_one + (FStarC_List.length datas) > Prims.int_one then let uu___8 = FStarC_SMTEncoding_Util.mkApp @@ -4255,7 +4235,7 @@ let (encode_sig_inductive : let uu___8 = FStarC_SMTEncoding_Term.mk_decls_trivial [fuel_guarded_inversion] in - FStarC_Compiler_List.op_At decls uu___8))) in + FStarC_List.op_At decls uu___8))) in let uu___3 = let k1 = match tps with @@ -4279,7 +4259,7 @@ let (encode_sig_inductive : FStar_Pervasives_Native.None formals env in (match uu___4 with | (vars, guards, env', binder_decls, uu___5) -> - let arity = FStarC_Compiler_List.length vars in + let arity = FStarC_List.length vars in let uu___6 = FStarC_SMTEncoding_Env.new_term_constant_and_tok_from_lid env t arity in @@ -4291,7 +4271,7 @@ let (encode_sig_inductive : let tapp = let uu___7 = let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars in (tname, uu___8) in FStarC_SMTEncoding_Util.mkApp uu___7 in @@ -4299,7 +4279,7 @@ let (encode_sig_inductive : let tname_decl = let uu___8 = let uu___9 = - FStarC_Compiler_List.map + FStarC_List.map (fun fv -> let uu___10 = let uu___11 = @@ -4383,8 +4363,8 @@ let (encode_sig_inductive : env1) in match uu___8 with | (tok_decls, env2) -> - ((FStarC_Compiler_List.op_At tname_decl - tok_decls), env2) in + ((FStarC_List.op_At tname_decl tok_decls), + env2) in (match uu___7 with | (decls, env2) -> let kindingAx = @@ -4396,8 +4376,8 @@ let (encode_sig_inductive : | (k1, decls1) -> let karr = if - (FStarC_Compiler_List.length formals) - > Prims.int_zero + (FStarC_List.length formals) > + Prims.int_zero then let uu___9 = let uu___10 = @@ -4419,7 +4399,7 @@ let (encode_sig_inductive : let rng = FStarC_Ident.range_of_lid t in let tot_fun_axioms = let uu___9 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___10 -> FStarC_SMTEncoding_Util.mkTrue) vars in @@ -4450,11 +4430,10 @@ let (encode_sig_inductive : FStarC_SMTEncoding_Util.mkAssume uu___13 in [uu___12] in - FStarC_Compiler_List.op_At karr - uu___11 in + FStarC_List.op_At karr uu___11 in FStarC_SMTEncoding_Term.mk_decls_trivial uu___10 in - FStarC_Compiler_List.op_At decls1 uu___9 in + FStarC_List.op_At decls1 uu___9 in let aux = let uu___8 = let uu___9 = @@ -4471,15 +4450,14 @@ let (encode_sig_inductive : [uu___12] in FStarC_SMTEncoding_Term.mk_decls_trivial uu___11 in - FStarC_Compiler_List.op_At uu___9 uu___10 in - FStarC_Compiler_List.op_At kindingAx uu___8 in + FStarC_List.op_At uu___9 uu___10 in + FStarC_List.op_At kindingAx uu___8 in let uu___8 = let uu___9 = FStarC_SMTEncoding_Term.mk_decls_trivial decls in - FStarC_Compiler_List.op_At uu___9 - (FStarC_Compiler_List.op_At binder_decls - aux) in + FStarC_List.op_At uu___9 + (FStarC_List.op_At binder_decls aux) in (uu___8, env2))))) let (encode_datacon : FStarC_SMTEncoding_Env.env_t -> @@ -4504,7 +4482,7 @@ let (encode_datacon : let uu___2 = FStarC_Syntax_Util.arrow_formals t1 in (match uu___2 with | (formals, t_res) -> - let arity = FStarC_Compiler_List.length formals in + let arity = FStarC_List.length formals in let uu___3 = FStarC_SMTEncoding_Env.new_term_constant_and_tok_from_lid env d arity in @@ -4527,12 +4505,10 @@ let (encode_datacon : | (vars, guards, env', binder_decls, names) -> let injective_type_params1 = injective_type_params || - (let uu___6 = - FStarC_Options_Ext.get - "compat:injectivity" in - uu___6 <> "") in + (FStarC_Options_Ext.enabled + "compat:injectivity") in let fields = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun n -> fun x -> let field_projectible = @@ -4578,7 +4554,7 @@ let (encode_datacon : let guard = FStarC_SMTEncoding_Util.mk_and_l guards in let xvars = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars in let dapp = FStarC_SMTEncoding_Util.mkApp @@ -4685,10 +4661,10 @@ let (encode_datacon : arg_decls) -> let uu___16 = let uu___17 = - FStarC_Compiler_List.zip + FStarC_List.zip args encoded_args in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___18 -> fun uu___19 -> match @@ -4746,10 +4722,10 @@ let (encode_datacon : elim_eqns_or_guards, uu___18) -> let arg_vars1 = - FStarC_Compiler_List.rev + FStarC_List.rev arg_vars in let uu___19 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt n_tps arg_vars1 in (match uu___19 @@ -4758,7 +4734,7 @@ let (encode_datacon : uu___20) -> let uu___21 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt n_tps vars in (match uu___21 @@ -4772,10 +4748,10 @@ let (encode_datacon : let uu___23 = FStarC_SMTEncoding_Util.mk_and_l - (FStarC_Compiler_List.op_At + (FStarC_List.op_At elim_eqns_or_guards guards) in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun elim_eqns_and_guards1 -> @@ -4799,7 +4775,7 @@ let (encode_datacon : arg_vars1 in let xvars1 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars in let dapp1 @@ -4815,7 +4791,7 @@ let (encode_datacon : dapp1 ty in let arg_binders = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_of_term arg_vars1 in let typing_inversion @@ -4839,7 +4815,7 @@ let (encode_datacon : FStarC_SMTEncoding_Term.Fuel_sort) in FStarC_SMTEncoding_Env.add_fuel uu___28 - (FStarC_Compiler_List.op_At + (FStarC_List.op_At vars arg_binders) in let uu___28 @@ -4884,7 +4860,7 @@ let (encode_datacon : = let uu___23 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun v -> if @@ -4904,7 +4880,7 @@ let (encode_datacon : dapp1 in [uu___25])) vars in - FStarC_Compiler_List.flatten + FStarC_List.flatten uu___23 in let uu___23 = @@ -4925,7 +4901,7 @@ let (encode_datacon : FStarC_SMTEncoding_Term.Fuel_sort) in FStarC_SMTEncoding_Env.add_fuel uu___28 - (FStarC_Compiler_List.op_At + (FStarC_List.op_At vars arg_binders) in let uu___28 @@ -4959,7 +4935,7 @@ let (encode_datacon : = let uu___24 = - FStarC_Compiler_Util.first_N + FStarC_Util.first_N n_tps formals in match uu___24 @@ -4970,7 +4946,7 @@ let (encode_datacon : -> let uu___26 = - FStarC_Compiler_Util.first_N + FStarC_Util.first_N n_tps vars in (match uu___26 @@ -5017,7 +4993,7 @@ let (encode_datacon : uu___29) in let uu___28 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___29 -> @@ -5091,9 +5067,12 @@ let (encode_datacon : FStar_Pervasives_Native.None else (let t4 = + let uu___36 + = + FStarC_Syntax_Util.comp_result + c in FStarC_Syntax_Util.unrefine - (FStarC_Syntax_Util.comp_result - c) in + uu___36 in let t5 = norm t4 in let uu___36 @@ -5131,7 +5110,7 @@ let (encode_datacon : fv1 -> let uu___41 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_Syntax_Syntax.fv_eq_lid fv1) mutuals in @@ -5143,12 +5122,8 @@ let (encode_datacon : else (let uu___43 = - let uu___44 - = - FStarC_Options_Ext.get + FStarC_Options_Ext.enabled "compat:2954" in - uu___44 - <> "" in if uu___43 then @@ -5163,12 +5138,8 @@ let (encode_datacon : -> let uu___42 = - let uu___43 - = - FStarC_Options_Ext.get + FStarC_Options_Ext.enabled "compat:2954" in - uu___43 - <> "" in if uu___42 then @@ -5346,7 +5317,7 @@ let (encode_datacon : :: codomain_prec_l in (uu___33, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At bs_decls cod_decls))))) ([], []) @@ -5390,7 +5361,7 @@ let (encode_datacon : FStarC_SMTEncoding_Term.Fuel_sort) in FStarC_SMTEncoding_Env.add_fuel uu___37 - (FStarC_Compiler_List.op_At + (FStarC_List.op_At vars arg_binders) in let uu___37 @@ -5421,10 +5392,10 @@ let (encode_datacon : (codomain_ordering, codomain_decls) -> - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At arg_decls codomain_decls), - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [typing_inversion; subterm_ordering] codomain_ordering))))))) @@ -5442,10 +5413,10 @@ let (encode_datacon : arg_decls) -> let uu___12 = let uu___13 = - FStarC_Compiler_List.zip + FStarC_List.zip args encoded_args in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___14 -> fun uu___15 -> match @@ -5503,10 +5474,10 @@ let (encode_datacon : elim_eqns_or_guards, uu___14) -> let arg_vars1 = - FStarC_Compiler_List.rev + FStarC_List.rev arg_vars in let uu___15 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt n_tps arg_vars1 in (match uu___15 @@ -5515,7 +5486,7 @@ let (encode_datacon : uu___16) -> let uu___17 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt n_tps vars in (match uu___17 @@ -5529,10 +5500,10 @@ let (encode_datacon : let uu___19 = FStarC_SMTEncoding_Util.mk_and_l - (FStarC_Compiler_List.op_At + (FStarC_List.op_At elim_eqns_or_guards guards) in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun elim_eqns_and_guards1 -> @@ -5556,7 +5527,7 @@ let (encode_datacon : arg_vars1 in let xvars1 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV vars in let dapp1 @@ -5572,7 +5543,7 @@ let (encode_datacon : dapp1 ty in let arg_binders = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_of_term arg_vars1 in let typing_inversion @@ -5596,7 +5567,7 @@ let (encode_datacon : FStarC_SMTEncoding_Term.Fuel_sort) in FStarC_SMTEncoding_Env.add_fuel uu___24 - (FStarC_Compiler_List.op_At + (FStarC_List.op_At vars arg_binders) in let uu___24 @@ -5641,7 +5612,7 @@ let (encode_datacon : = let uu___19 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun v -> if @@ -5661,7 +5632,7 @@ let (encode_datacon : dapp1 in [uu___21])) vars in - FStarC_Compiler_List.flatten + FStarC_List.flatten uu___19 in let uu___19 = @@ -5682,7 +5653,7 @@ let (encode_datacon : FStarC_SMTEncoding_Term.Fuel_sort) in FStarC_SMTEncoding_Env.add_fuel uu___24 - (FStarC_Compiler_List.op_At + (FStarC_List.op_At vars arg_binders) in let uu___24 @@ -5716,7 +5687,7 @@ let (encode_datacon : = let uu___20 = - FStarC_Compiler_Util.first_N + FStarC_Util.first_N n_tps formals in match uu___20 @@ -5727,7 +5698,7 @@ let (encode_datacon : -> let uu___22 = - FStarC_Compiler_Util.first_N + FStarC_Util.first_N n_tps vars in (match uu___22 @@ -5774,7 +5745,7 @@ let (encode_datacon : uu___25) in let uu___24 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___25 -> @@ -5848,9 +5819,12 @@ let (encode_datacon : FStar_Pervasives_Native.None else (let t4 = + let uu___32 + = + FStarC_Syntax_Util.comp_result + c in FStarC_Syntax_Util.unrefine - (FStarC_Syntax_Util.comp_result - c) in + uu___32 in let t5 = norm t4 in let uu___32 @@ -5888,7 +5862,7 @@ let (encode_datacon : fv1 -> let uu___37 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_Syntax_Syntax.fv_eq_lid fv1) mutuals in @@ -5900,12 +5874,8 @@ let (encode_datacon : else (let uu___39 = - let uu___40 - = - FStarC_Options_Ext.get + FStarC_Options_Ext.enabled "compat:2954" in - uu___40 - <> "" in if uu___39 then @@ -5920,12 +5890,8 @@ let (encode_datacon : -> let uu___38 = - let uu___39 - = - FStarC_Options_Ext.get + FStarC_Options_Ext.enabled "compat:2954" in - uu___39 - <> "" in if uu___38 then @@ -6103,7 +6069,7 @@ let (encode_datacon : :: codomain_prec_l in (uu___29, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At bs_decls cod_decls))))) ([], []) @@ -6147,7 +6113,7 @@ let (encode_datacon : FStarC_SMTEncoding_Term.Fuel_sort) in FStarC_SMTEncoding_Env.add_fuel uu___33 - (FStarC_Compiler_List.op_At + (FStarC_List.op_At vars arg_binders) in let uu___33 @@ -6178,10 +6144,10 @@ let (encode_datacon : (codomain_ordering, codomain_decls) -> - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At arg_decls codomain_decls), - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [typing_inversion; subterm_ordering] codomain_ordering))))))) @@ -6195,7 +6161,7 @@ let (encode_datacon : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term head in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Constructor %s builds an unexpected type %s" uu___14 uu___15 in FStarC_Errors.log_issue @@ -6218,13 +6184,13 @@ let (encode_datacon : | FStarC_SMTEncoding_Term.App (op, args) -> let uu___10 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt n_tps args in (match uu___10 with | (targs, iargs) -> let uu___11 = let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> FStarC_SMTEncoding_Env.fresh_fvar @@ -6232,7 +6198,7 @@ let (encode_datacon : "i" FStarC_SMTEncoding_Term.Term_sort) iargs in - FStarC_Compiler_List.split + FStarC_List.split uu___12 in (match uu___11 with | (fresh_ivars, @@ -6241,7 +6207,7 @@ let (encode_datacon : = let uu___12 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun a -> fun fresh_a @@ -6263,7 +6229,7 @@ let (encode_datacon : = (FStarC_SMTEncoding_Term.App (op, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At targs fresh_iargs))); FStarC_SMTEncoding_Term.freevars @@ -6276,13 +6242,13 @@ let (encode_datacon : let uu___13 = let uu___14 = - FStarC_Compiler_List.map + FStarC_List.map (fun s -> FStarC_SMTEncoding_Term.mk_fv (s, FStarC_SMTEncoding_Term.Term_sort)) fresh_ivars in - FStarC_Compiler_List.op_At + FStarC_List.op_At vars uu___14 in let uu___14 = @@ -6343,7 +6309,7 @@ let (encode_datacon : FStarC_Class_Show.show FStarC_Ident.showable_lident d in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "data constructor proxy: %s" uu___19 in FStar_Pervasives_Native.Some @@ -6354,7 +6320,7 @@ let (encode_datacon : FStarC_SMTEncoding_Term.DeclFun uu___16 in [uu___15] in - FStarC_Compiler_List.op_At + FStarC_List.op_At uu___14 proxy_fresh in FStarC_SMTEncoding_Term.mk_decls_trivial @@ -6406,26 +6372,25 @@ let (encode_datacon : data_cons_typing_intro_decl] in uu___17 :: uu___18 in - FStarC_Compiler_List.op_At + FStarC_List.op_At uu___16 elim in FStarC_SMTEncoding_Term.mk_decls_trivial uu___15 in - FStarC_Compiler_List.op_At + FStarC_List.op_At decls_pred uu___14 in - FStarC_Compiler_List.op_At + FStarC_List.op_At uu___12 uu___13 in - FStarC_Compiler_List.op_At - decls3 uu___11 in - FStarC_Compiler_List.op_At - decls2 uu___10 in - FStarC_Compiler_List.op_At - binder_decls uu___9 in + FStarC_List.op_At decls3 + uu___11 in + FStarC_List.op_At decls2 + uu___10 in + FStarC_List.op_At binder_decls + uu___9 in let uu___9 = let uu___10 = FStarC_SMTEncoding_Term.mk_decls_trivial datacons in - FStarC_Compiler_List.op_At - uu___10 g in + FStarC_List.op_At uu___10 g in (uu___9, env1)))))))) let rec (encode_sigelt : FStarC_SMTEncoding_Env.env_t -> @@ -6438,23 +6403,21 @@ let rec (encode_sigelt : let uu___ = let uu___1 = let uu___2 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.format1 - "While encoding top-level declaration `%s`" uu___2 in + FStarC_Util.format1 "While encoding top-level declaration `%s`" + uu___2 in FStarC_Errors.with_ctx uu___1 (fun uu___2 -> encode_sigelt' env se) in match uu___ with | (g, env1) -> let g1 = match g with | [] -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + ((let uu___2 = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___2 - then - FStarC_Compiler_Util.print1 "Skipped encoding of %s\n" nm + then FStarC_Util.print1 "Skipped encoding of %s\n" nm else ()); (let uu___2 = let uu___3 = - let uu___4 = - FStarC_Compiler_Util.format1 "" nm in + let uu___4 = FStarC_Util.format1 "" nm in FStarC_SMTEncoding_Term.Caption uu___4 in [uu___3] in FStarC_SMTEncoding_Term.mk_decls_trivial uu___2)) @@ -6463,7 +6426,7 @@ let rec (encode_sigelt : let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_Util.format1 "" nm in + FStarC_Util.format1 "" nm in FStarC_SMTEncoding_Term.Caption uu___5 in [uu___4] in FStarC_SMTEncoding_Term.mk_decls_trivial uu___3 in @@ -6472,13 +6435,12 @@ let rec (encode_sigelt : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_Util.format1 "" - nm in + FStarC_Util.format1 "" nm in FStarC_SMTEncoding_Term.Caption uu___7 in [uu___6] in FStarC_SMTEncoding_Term.mk_decls_trivial uu___5 in - FStarC_Compiler_List.op_At g uu___4 in - FStarC_Compiler_List.op_At uu___2 uu___3 in + FStarC_List.op_At g uu___4 in + FStarC_List.op_At uu___2 uu___3 in (g1, env1) and (encode_sigelt' : FStarC_SMTEncoding_Env.env_t -> @@ -6487,12 +6449,12 @@ and (encode_sigelt' : = fun env -> fun se -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + (let uu___1 = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt se in - FStarC_Compiler_Util.print1 "@@@Encoding sigelt %s\n" uu___2 + FStarC_Util.print1 "@@@Encoding sigelt %s\n" uu___2 else ()); (let is_opaque_to_smt t = let uu___1 = @@ -6535,19 +6497,24 @@ and (encode_sigelt' : match ed.FStarC_Syntax_Syntax.binders with | [] -> tm | uu___3 -> - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_abs - { - FStarC_Syntax_Syntax.bs = - (ed.FStarC_Syntax_Syntax.binders); - FStarC_Syntax_Syntax.body = tm; - FStarC_Syntax_Syntax.rc_opt = - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.mk_residual_comp - FStarC_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None - [FStarC_Syntax_Syntax.TOTAL])) - }) tm.FStarC_Syntax_Syntax.pos in + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + FStarC_Syntax_Util.mk_residual_comp + FStarC_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None + [FStarC_Syntax_Syntax.TOTAL] in + FStar_Pervasives_Native.Some uu___7 in + { + FStarC_Syntax_Syntax.bs = + (ed.FStarC_Syntax_Syntax.binders); + FStarC_Syntax_Syntax.body = tm; + FStarC_Syntax_Syntax.rc_opt = uu___6 + } in + FStarC_Syntax_Syntax.Tm_abs uu___5 in + FStarC_Syntax_Syntax.mk uu___4 + tm.FStarC_Syntax_Syntax.pos in let encode_action env1 a = let action_defn = let uu___3 = @@ -6558,7 +6525,7 @@ and (encode_sigelt' : a.FStarC_Syntax_Syntax.action_typ in match uu___3 with | (formals, uu___4) -> - let arity = FStarC_Compiler_List.length formals in + let arity = FStarC_List.length formals in let uu___5 = FStarC_SMTEncoding_Env.new_term_constant_and_tok_from_lid env1 a.FStarC_Syntax_Syntax.action_name arity in @@ -6573,7 +6540,7 @@ and (encode_sigelt' : let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___10 -> FStarC_SMTEncoding_Term.Term_sort) formals in @@ -6610,7 +6577,7 @@ and (encode_sigelt' : FStarC_SMTEncoding_Term.Term_sort) in uu___15 :: acc_sorts in (env4, uu___14, (xx :: acc))) in - FStarC_Compiler_List.fold_right aux formals + FStarC_List.fold_right aux formals (env2, [], []) in (match uu___7 with | (uu___8, xs_sorts, xs) -> @@ -6671,16 +6638,15 @@ and (encode_sigelt' : let uu___9 = let uu___10 = FStarC_SMTEncoding_Term.mk_decls_trivial - (FStarC_Compiler_List.op_At a_decls + (FStarC_List.op_At a_decls [a_eq; tok_correspondence]) in - FStarC_Compiler_List.op_At decls uu___10 in + FStarC_List.op_At decls uu___10 in (env2, uu___9)))) in let uu___3 = - FStarC_Compiler_Util.fold_map encode_action env + FStarC_Util.fold_map encode_action env ed.FStarC_Syntax_Syntax.actions in match uu___3 with - | (env1, decls2) -> - ((FStarC_Compiler_List.flatten decls2), env1)) + | (env1, decls2) -> ((FStarC_List.flatten decls2), env1)) | FStarC_Syntax_Syntax.Sig_declare_typ { FStarC_Syntax_Syntax.lid2 = lid; FStarC_Syntax_Syntax.us2 = uu___1; @@ -6698,7 +6664,7 @@ and (encode_sigelt' : let quals = se.FStarC_Syntax_Syntax.sigquals in let will_encode_definition = let uu___1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Assumption -> true @@ -6715,7 +6681,7 @@ and (encode_sigelt' : FStar_Pervasives_Native.None in let uu___2 = let uu___3 = - FStarC_Compiler_Util.for_some is_uninterpreted_by_smt + FStarC_Util.for_some is_uninterpreted_by_smt se.FStarC_Syntax_Syntax.sigattrs in encode_top_level_val uu___3 env us fv t quals in match uu___2 with @@ -6724,14 +6690,14 @@ and (encode_sigelt' : let tsym = let uu___3 = FStarC_SMTEncoding_Env.try_lookup_free_var env1 lid in - FStarC_Compiler_Option.get uu___3 in + FStarC_Option.get uu___3 in let uu___3 = let uu___4 = let uu___5 = primitive_type_axioms env1.FStarC_SMTEncoding_Env.tcenv lid tname tsym in FStarC_SMTEncoding_Term.mk_decls_trivial uu___5 in - FStarC_Compiler_List.op_At decls uu___4 in + FStarC_List.op_At decls uu___4 in (uu___3, env1)) | FStarC_Syntax_Syntax.Sig_assume { FStarC_Syntax_Syntax.lid3 = l; FStarC_Syntax_Syntax.us3 = us; @@ -6781,8 +6747,7 @@ and (encode_sigelt' : let uu___8 = FStarC_Class_Show.show FStarC_Ident.showable_lident l in - FStarC_Compiler_Util.format1 - "Assumption: %s" uu___8 in + FStarC_Util.format1 "Assumption: %s" uu___8 in FStar_Pervasives_Native.Some uu___7 in let uu___7 = let uu___8 = @@ -6794,34 +6759,33 @@ and (encode_sigelt' : FStarC_SMTEncoding_Util.mkAssume uu___5 in [uu___4] in FStarC_SMTEncoding_Term.mk_decls_trivial uu___3 in - ((FStarC_Compiler_List.op_At decls g), env1))) + ((FStarC_List.op_At decls g), env1))) | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = lbs; FStarC_Syntax_Syntax.lids1 = uu___1;_} when - (FStarC_Compiler_List.contains FStarC_Syntax_Syntax.Irreducible + (FStarC_List.contains FStarC_Syntax_Syntax.Irreducible se.FStarC_Syntax_Syntax.sigquals) || - (FStarC_Compiler_Util.for_some is_opaque_to_smt + (FStarC_Util.for_some is_opaque_to_smt se.FStarC_Syntax_Syntax.sigattrs) -> let attrs = se.FStarC_Syntax_Syntax.sigattrs in let uu___2 = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun env1 -> fun lb -> let lid = let uu___3 = let uu___4 = - FStarC_Compiler_Util.right - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in uu___4.FStarC_Syntax_Syntax.fv_name in uu___3.FStarC_Syntax_Syntax.v in let uu___3 = let uu___4 = FStarC_TypeChecker_Env.try_lookup_val_decl env1.FStarC_SMTEncoding_Env.tcenv lid in - FStarC_Compiler_Option.isNone uu___4 in + FStarC_Option.isNone uu___4 in if uu___3 then let val_decl = @@ -6853,7 +6817,7 @@ and (encode_sigelt' : match uu___4 with | (decls, env2) -> (env2, decls) else (env1, [])) env (FStar_Pervasives_Native.snd lbs) in (match uu___2 with - | (env1, decls) -> ((FStarC_Compiler_List.flatten decls), env1)) + | (env1, decls) -> ((FStarC_List.flatten decls), env1)) | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = @@ -6940,59 +6904,58 @@ and (encode_sigelt' : let uu___10 = FStarC_SMTEncoding_Term.mk_decls_trivial decls in (uu___10, env1)) | FStarC_Syntax_Syntax.Sig_let uu___1 when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Discriminator uu___3 -> true | uu___3 -> false) se.FStarC_Syntax_Syntax.sigquals -> - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + ((let uu___3 = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___3 then let uu___4 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.print1 - "Not encoding discriminator '%s'\n" uu___4 + FStarC_Util.print1 "Not encoding discriminator '%s'\n" uu___4 else ()); ([], env)) | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = uu___1; FStarC_Syntax_Syntax.lids1 = lids;_} when - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun l -> let uu___2 = let uu___3 = let uu___4 = FStarC_Ident.ns_of_lid l in - FStarC_Compiler_List.hd uu___4 in + FStarC_List.hd uu___4 in FStarC_Ident.string_of_id uu___3 in uu___2 = "Prims") lids) && - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Unfold_for_unification_and_vcgen -> true | uu___3 -> false) se.FStarC_Syntax_Syntax.sigquals) -> - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + ((let uu___3 = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___3 then let uu___4 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.print1 - "Not encoding unfold let from Prims '%s'\n" uu___4 + FStarC_Util.print1 "Not encoding unfold let from Prims '%s'\n" + uu___4 else ()); ([], env)) | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = (false, lb::[]); FStarC_Syntax_Syntax.lids1 = uu___1;_} when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Projector uu___3 -> true | uu___3 -> false) se.FStarC_Syntax_Syntax.sigquals -> - let fv = FStarC_Compiler_Util.right lb.FStarC_Syntax_Syntax.lbname in + let fv = FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let l = (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in let uu___2 = FStarC_SMTEncoding_Env.try_lookup_free_var env l in (match uu___2 with @@ -7028,7 +6991,7 @@ and (encode_sigelt' : FStarC_Syntax_Syntax.lids1 = uu___1;_} -> let bindings1 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let def = norm_before_encoding_us env @@ -7059,7 +7022,7 @@ and (encode_sigelt' : FStarC_Syntax_Syntax.lids = uu___1;_} -> let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun se1 -> match uu___3 with @@ -7072,19 +7035,18 @@ and (encode_sigelt' : encode_datacon env1 se1 | uu___5 -> encode_sigelt env1 se1 in (match uu___4 with - | (g', env2) -> - ((FStarC_Compiler_List.op_At g g'), env2))) + | (g', env2) -> ((FStarC_List.op_At g g'), env2))) ([], env) ses in (match uu___2 with | (g, env1) -> let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun elt -> match uu___4 with | (g', inversions) -> let uu___5 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___6 -> match uu___6 with | FStarC_SMTEncoding_Term.Assume @@ -7105,7 +7067,7 @@ and (encode_sigelt' : elt.FStarC_SMTEncoding_Term.decls in (match uu___5 with | (elt_g', elt_inversions) -> - ((FStarC_Compiler_List.op_At g' + ((FStarC_List.op_At g' [{ FStarC_SMTEncoding_Term.sym_name = (elt.FStarC_SMTEncoding_Term.sym_name); @@ -7116,21 +7078,21 @@ and (encode_sigelt' : FStarC_SMTEncoding_Term.a_names = (elt.FStarC_SMTEncoding_Term.a_names) }]), - (FStarC_Compiler_List.op_At inversions + (FStarC_List.op_At inversions elt_inversions)))) ([], []) g in (match uu___3 with | (g', inversions) -> let uu___4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___5 -> fun elt -> match uu___5 with | (decls, elts, rest) -> let uu___6 = - (FStarC_Compiler_Util.is_some + (FStarC_Util.is_some elt.FStarC_SMTEncoding_Term.key) && - (FStarC_Compiler_List.existsb + (FStarC_List.existsb (fun uu___7 -> match uu___7 with | FStarC_SMTEncoding_Term.DeclFun @@ -7139,12 +7101,11 @@ and (encode_sigelt' : elt.FStarC_SMTEncoding_Term.decls) in if uu___6 then - (decls, - (FStarC_Compiler_List.op_At elts [elt]), + (decls, (FStarC_List.op_At elts [elt]), rest) else (let uu___8 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___9 -> match uu___9 with | FStarC_SMTEncoding_Term.DeclFun @@ -7153,9 +7114,9 @@ and (encode_sigelt' : elt.FStarC_SMTEncoding_Term.decls in match uu___8 with | (elt_decls, elt_rest) -> - ((FStarC_Compiler_List.op_At decls - elt_decls), elts, - (FStarC_Compiler_List.op_At rest + ((FStarC_List.op_At decls elt_decls), + elts, + (FStarC_List.op_At rest [{ FStarC_SMTEncoding_Term.sym_name = @@ -7179,9 +7140,9 @@ and (encode_sigelt' : let uu___9 = FStarC_SMTEncoding_Term.mk_decls_trivial inversions in - FStarC_Compiler_List.op_At rest uu___9 in - FStarC_Compiler_List.op_At elts uu___8 in - FStarC_Compiler_List.op_At uu___6 uu___7 in + FStarC_List.op_At rest uu___9 in + FStarC_List.op_At elts uu___8 in + FStarC_List.op_At uu___6 uu___7 in (uu___5, env1))))) let (encode_env_bindings : FStarC_SMTEncoding_Env.env_t -> @@ -7199,8 +7160,7 @@ let (encode_env_bindings : | FStarC_Syntax_Syntax.Binding_var x -> let t1 = norm_before_encoding env1 x.FStarC_Syntax_Syntax.sort in - ((let uu___2 = - FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + ((let uu___2 = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___2 then let uu___3 = @@ -7213,8 +7173,8 @@ let (encode_env_bindings : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print3 "Normalized %s : %s to %s\n" - uu___3 uu___4 uu___5 + FStarC_Util.print3 "Normalized %s : %s to %s\n" uu___3 + uu___4 uu___5 else ()); (let uu___2 = FStarC_SMTEncoding_EncodeTerm.encode_term t1 env1 in @@ -7224,8 +7184,7 @@ let (encode_env_bindings : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = - FStarC_Compiler_Util.digest_of_string t_hash in + let uu___6 = FStarC_Util.digest_of_string t_hash in Prims.strcat uu___6 (Prims.strcat "_" (Prims.string_of_int i)) in Prims.strcat "x_" uu___5 in @@ -7251,8 +7210,8 @@ let (encode_env_bindings : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format3 "%s : %s (%s)" - uu___6 uu___7 uu___8 in + FStarC_Util.format3 "%s : %s (%s)" uu___6 + uu___7 uu___8 in FStar_Pervasives_Native.Some uu___5 else FStar_Pervasives_Native.None in let ax = @@ -7271,10 +7230,10 @@ let (encode_env_bindings : let uu___6 = FStarC_SMTEncoding_Term.mk_decls_trivial [ax] in - FStarC_Compiler_List.op_At decls' uu___6 in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.op_At decls' uu___6 in + FStarC_List.op_At uu___4 uu___5 in ((i + Prims.int_one), - (FStarC_Compiler_List.op_At decls g), env')))) + (FStarC_List.op_At decls g), env')))) | FStarC_Syntax_Syntax.Binding_lid (x, (uu___1, t)) -> let t_norm = norm_before_encoding env1 t in let fv = @@ -7283,10 +7242,10 @@ let (encode_env_bindings : let uu___2 = encode_free_var false env1 fv t t_norm [] in (match uu___2 with | (g, env') -> - ((i + Prims.int_one), - (FStarC_Compiler_List.op_At decls g), env'))) in + ((i + Prims.int_one), (FStarC_List.op_At decls g), + env'))) in let uu___ = - FStarC_Compiler_List.fold_right encode_binding bindings + FStarC_List.fold_right encode_binding bindings (Prims.int_zero, [], env) in match uu___ with | (uu___1, decls, env1) -> (decls, env1) let (encode_labels : @@ -7296,7 +7255,7 @@ let (encode_labels : = fun labs -> let prefix = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (l, uu___1, uu___2) -> @@ -7306,7 +7265,7 @@ let (encode_labels : FStar_Pervasives_Native.None) in FStarC_SMTEncoding_Term.DeclFun uu___3) labs in let suffix = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___ -> match uu___ with | (l, uu___1, uu___2) -> @@ -7320,20 +7279,18 @@ let (encode_labels : [uu___5] in uu___3 :: uu___4) labs in (prefix, suffix) -let (last_env : - FStarC_SMTEncoding_Env.env_t Prims.list FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref [] +let (last_env : FStarC_SMTEncoding_Env.env_t Prims.list FStarC_Effect.ref) = + FStarC_Util.mk_ref [] let (init_env : FStarC_TypeChecker_Env.env -> unit) = fun tcenv -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.psmap_empty () in - let uu___3 = - let uu___4 = FStarC_Compiler_Util.psmap_empty () in (uu___4, []) in + let uu___2 = FStarC_Util.psmap_empty () in + let uu___3 = let uu___4 = FStarC_Util.psmap_empty () in (uu___4, []) in let uu___4 = let uu___5 = FStarC_TypeChecker_Env.current_module tcenv in FStarC_Ident.string_of_lid uu___5 in - let uu___5 = FStarC_Compiler_Util.smap_create (Prims.of_int (100)) in + let uu___5 = FStarC_Util.smap_create (Prims.of_int (100)) in { FStarC_SMTEncoding_Env.bvar_bindings = uu___2; FStarC_SMTEncoding_Env.fvar_bindings = uu___3; @@ -7348,14 +7305,14 @@ let (init_env : FStarC_TypeChecker_Env.env -> unit) = FStarC_SMTEncoding_Env.global_cache = uu___5 } in [uu___1] in - FStarC_Compiler_Effect.op_Colon_Equals last_env uu___ + FStarC_Effect.op_Colon_Equals last_env uu___ let (get_env : FStarC_Ident.lident -> FStarC_TypeChecker_Env.env -> FStarC_SMTEncoding_Env.env_t) = fun cmn -> fun tcenv -> - let uu___ = FStarC_Compiler_Effect.op_Bang last_env in + let uu___ = FStarC_Effect.op_Bang last_env in match uu___ with | [] -> failwith "No env; call init first!" | e::uu___1 -> @@ -7382,11 +7339,10 @@ let (get_env : } let (set_env : FStarC_SMTEncoding_Env.env_t -> unit) = fun env -> - let uu___ = FStarC_Compiler_Effect.op_Bang last_env in + let uu___ = FStarC_Effect.op_Bang last_env in match uu___ with | [] -> failwith "Empty env stack" - | uu___1::tl -> - FStarC_Compiler_Effect.op_Colon_Equals last_env (env :: tl) + | uu___1::tl -> FStarC_Effect.op_Colon_Equals last_env (env :: tl) let (get_current_env : FStarC_TypeChecker_Env.env -> FStarC_SMTEncoding_Env.env_t) = fun tcenv -> @@ -7394,18 +7350,18 @@ let (get_current_env : get_env uu___ tcenv let (push_env : unit -> unit) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang last_env in + let uu___1 = FStarC_Effect.op_Bang last_env in match uu___1 with | [] -> failwith "Empty env stack" | hd::tl -> let top = copy_env hd in - FStarC_Compiler_Effect.op_Colon_Equals last_env (top :: hd :: tl) + FStarC_Effect.op_Colon_Equals last_env (top :: hd :: tl) let (pop_env : unit -> unit) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang last_env in + let uu___1 = FStarC_Effect.op_Bang last_env in match uu___1 with | [] -> failwith "Popping an empty stack" - | uu___2::tl -> FStarC_Compiler_Effect.op_Colon_Equals last_env tl + | uu___2::tl -> FStarC_Effect.op_Colon_Equals last_env tl let (snapshot_env : unit -> (Prims.int * unit)) = fun uu___ -> FStarC_Common.snapshot push_env last_env () let (rollback_env : Prims.int FStar_Pervasives_Native.option -> unit) = @@ -7416,7 +7372,7 @@ let (init : FStarC_TypeChecker_Env.env -> unit) = FStarC_SMTEncoding_Z3.giveZ3 [FStarC_SMTEncoding_Term.DefPrelude] let (snapshot_encoding : Prims.string -> encoding_depth) = fun msg -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> let uu___1 = snapshot_env () in match uu___1 with @@ -7430,7 +7386,7 @@ let (rollback_encoding : Prims.string -> encoding_depth FStar_Pervasives_Native.option -> unit) = fun msg -> fun depth -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> let uu___1 = match depth with @@ -7484,7 +7440,7 @@ let (place_decl_elt_in_fact_dbs : fun fact_db_ids -> fun elt -> let uu___ = - FStarC_Compiler_List.map (place_decl_in_fact_dbs env fact_db_ids) + FStarC_List.map (place_decl_in_fact_dbs env fact_db_ids) elt.FStarC_SMTEncoding_Term.decls in { FStarC_SMTEncoding_Term.sym_name = @@ -7517,14 +7473,13 @@ let (encode_top_level_facts : fun env -> fun se -> let fact_db_ids = - FStarC_Compiler_List.collect (fact_dbs_for_lid env) - (FStarC_Syntax_Util.lids_of_sigelt se) in + let uu___ = FStarC_Syntax_Util.lids_of_sigelt se in + FStarC_List.collect (fact_dbs_for_lid env) uu___ in let uu___ = encode_sigelt env se in match uu___ with | (g, env1) -> let g1 = - FStarC_Compiler_List.map - (place_decl_elt_in_fact_dbs env1 fact_db_ids) g in + FStarC_List.map (place_decl_elt_in_fact_dbs env1 fact_db_ids) g in (g1, env1) let (recover_caching_and_update_env : FStarC_SMTEncoding_Env.env_t -> @@ -7532,15 +7487,14 @@ let (recover_caching_and_update_env : = fun env -> fun decls -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun elt -> if elt.FStarC_SMTEncoding_Term.key = FStar_Pervasives_Native.None then [elt] else (let uu___1 = - let uu___2 = - FStarC_Compiler_Util.must elt.FStarC_SMTEncoding_Term.key in - FStarC_Compiler_Util.smap_try_find + let uu___2 = FStarC_Util.must elt.FStarC_SMTEncoding_Term.key in + FStarC_Util.smap_try_find env.FStarC_SMTEncoding_Env.global_cache uu___2 in match uu___1 with | FStar_Pervasives_Native.Some cache_elt -> @@ -7549,9 +7503,8 @@ let (recover_caching_and_update_env : (cache_elt.FStarC_SMTEncoding_Term.a_names)] | FStar_Pervasives_Native.None -> ((let uu___3 = - FStarC_Compiler_Util.must - elt.FStarC_SMTEncoding_Term.key in - FStarC_Compiler_Util.smap_add + FStarC_Util.must elt.FStarC_SMTEncoding_Term.key in + FStarC_Util.smap_add env.FStarC_SMTEncoding_Env.global_cache uu___3 elt); [elt]))) decls let (encode_sig : @@ -7569,12 +7522,12 @@ let (encode_sig : FStarC_SMTEncoding_Term.Caption uu___2 in uu___1 :: decls else decls in - (let uu___1 = FStarC_Compiler_Debug.medium () in + (let uu___1 = FStarC_Debug.medium () in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt se in - FStarC_Compiler_Util.print1 "+++++++++++Encoding sigelt %s\n" uu___2 + FStarC_Util.print1 "+++++++++++Encoding sigelt %s\n" uu___2 else ()); (let env = let uu___1 = FStarC_TypeChecker_Env.current_module tcenv in @@ -7603,8 +7556,8 @@ let (give_decls_to_z3_and_set_env : let msg = Prims.strcat "Externals for " name in [FStarC_SMTEncoding_Term.Module (name, - (FStarC_Compiler_List.op_At - ((FStarC_SMTEncoding_Term.Caption msg) :: decls1) + (FStarC_List.op_At ((FStarC_SMTEncoding_Term.Caption msg) :: + decls1) [FStarC_SMTEncoding_Term.Caption (Prims.strcat "End " msg)]))] else [FStarC_SMTEncoding_Term.Module (name, decls1)] in @@ -7658,18 +7611,18 @@ let (encode_modul : (let name = let uu___4 = FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.format2 "%s %s" + FStarC_Util.format2 "%s %s" (if modul.FStarC_Syntax_Syntax.is_interface then "interface" else "module") uu___4 in - (let uu___5 = FStarC_Compiler_Debug.medium () in + (let uu___5 = FStarC_Debug.medium () in if uu___5 then - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "+++++++++++Encoding externals for %s ... %s declarations\n" name (Prims.string_of_int - (FStarC_Compiler_List.length + (FStarC_List.length modul.FStarC_Syntax_Syntax.declarations)) else ()); (let env = @@ -7677,7 +7630,7 @@ let (encode_modul : FStarC_SMTEncoding_Env.reset_current_module_fvbs uu___5 in let encode_signature env1 ses = let uu___5 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___6 -> fun se -> match uu___6 with @@ -7685,10 +7638,10 @@ let (encode_modul : let uu___7 = encode_top_level_facts env2 se in (match uu___7 with | (g', env3) -> - ((FStarC_Compiler_List.rev_append g' g), - env3))) ([], env1) ses in + ((FStarC_List.rev_append g' g), env3))) + ([], env1) ses in match uu___5 with - | (g', env2) -> ((FStarC_Compiler_List.rev g'), env2) in + | (g', env2) -> ((FStarC_List.rev g'), env2) in let uu___5 = encode_signature { @@ -7717,11 +7670,11 @@ let (encode_modul : match uu___5 with | (decls, env1) -> (give_decls_to_z3_and_set_env env1 name decls; - (let uu___8 = FStarC_Compiler_Debug.medium () in + (let uu___8 = FStarC_Debug.medium () in if uu___8 then - FStarC_Compiler_Util.print1 - "Done encoding externals for %s\n" name + FStarC_Util.print1 "Done encoding externals for %s\n" + name else ()); (decls, (FStarC_SMTEncoding_Env.get_current_module_fvbs env1))))))) @@ -7747,32 +7700,31 @@ let (encode_modul_from_cache : let name = let uu___3 = FStarC_Ident.string_of_lid tcmod.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.format2 "%s %s" + FStarC_Util.format2 "%s %s" (if tcmod.FStarC_Syntax_Syntax.is_interface then "interface" else "module") uu___3 in - (let uu___4 = FStarC_Compiler_Debug.medium () in + (let uu___4 = FStarC_Debug.medium () in if uu___4 then - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "+++++++++++Encoding externals from cache for %s ... %s decls\n" - name - (Prims.string_of_int (FStarC_Compiler_List.length decls)) + name (Prims.string_of_int (FStarC_List.length decls)) else ()); (let env = let uu___4 = get_env tcmod.FStarC_Syntax_Syntax.name tcenv1 in FStarC_SMTEncoding_Env.reset_current_module_fvbs uu___4 in let env1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun fvb -> FStarC_SMTEncoding_Env.add_fvar_binding_to_env fvb - env2) env (FStarC_Compiler_List.rev fvbs) in + env2) env (FStarC_List.rev fvbs) in give_decls_to_z3_and_set_env env1 name decls; - (let uu___5 = FStarC_Compiler_Debug.medium () in + (let uu___5 = FStarC_Debug.medium () in if uu___5 then - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Done encoding externals from cache for %s\n" name else ()))) let (encode_query : @@ -7843,7 +7795,7 @@ let (encode_query : | (closing, bindings) -> let uu___4 = FStarC_Syntax_Util.close_forall_no_univs - (FStarC_Compiler_List.rev closing) q in + (FStarC_List.rev closing) q in (uu___4, bindings) in match uu___2 with | (q1, bindings) -> @@ -7851,19 +7803,19 @@ let (encode_query : (match uu___3 with | (env_decls, env1) -> ((let uu___5 = - ((FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding)) - || (FStarC_Compiler_Effect.op_Bang dbg_SMTQuery) in + ((FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_SMTEncoding)) + || (FStarC_Effect.op_Bang dbg_SMTQuery) in if uu___5 then let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term q1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Encoding query formula {: %s\n" uu___6 else ()); (let uu___5 = - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___6 -> FStarC_SMTEncoding_EncodeTerm.encode_formula q1 env1) in @@ -7903,8 +7855,8 @@ let (encode_query : let uu___13 = let uu___14 = FStarC_Errors.get_ctx () in - FStarC_Compiler_String.concat - "\n" uu___14 in + FStarC_String.concat "\n" + uu___14 in Prims.strcat "Context: " uu___13 in FStarC_SMTEncoding_Term.Caption @@ -7923,12 +7875,12 @@ let (encode_query : let uu___13 = FStarC_SMTEncoding_Term.mk_decls_trivial caption in - FStarC_Compiler_List.op_At - qdecls uu___13 in - FStarC_Compiler_List.op_At - uu___11 uu___12 in - FStarC_Compiler_List.op_At - env_decls uu___10 in + FStarC_List.op_At qdecls + uu___13 in + FStarC_List.op_At uu___11 + uu___12 in + FStarC_List.op_At env_decls + uu___10 in recover_caching_and_update_env env1 uu___9 in FStarC_SMTEncoding_Term.decls_list_of @@ -7947,39 +7899,35 @@ let (encode_query : FStarC_SMTEncoding_Util.mkAssume uu___8 in let suffix = - FStarC_Compiler_List.op_At + FStarC_List.op_At [FStarC_SMTEncoding_Term.Echo ""] - (FStarC_Compiler_List.op_At - label_suffix + (FStarC_List.op_At label_suffix [FStarC_SMTEncoding_Term.Echo ""; FStarC_SMTEncoding_Term.Echo "Done!"]) in ((let uu___9 = - ((FStarC_Compiler_Debug.medium ()) - || - (FStarC_Compiler_Effect.op_Bang + ((FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_SMTEncoding)) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Effect.op_Bang dbg_SMTQuery) in if uu___9 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "} Done encoding\n" else ()); (let uu___10 = - ((FStarC_Compiler_Debug.medium ()) - || - (FStarC_Compiler_Effect.op_Bang + ((FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_SMTEncoding)) || - (FStarC_Compiler_Effect.op_Bang - dbg_Time) in + (FStarC_Effect.op_Bang dbg_Time) in if uu___10 then - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Encoding took %sms\n" (Prims.string_of_int ms) else ()); diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_EncodeTerm.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_EncodeTerm.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_EncodeTerm.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_EncodeTerm.ml index 1107daa68ae..908a1b19886 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_EncodeTerm.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_EncodeTerm.ml @@ -1,14 +1,14 @@ open Prims -let (dbg_PartialApp : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "PartialApp" -let (dbg_SMTEncoding : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SMTEncoding" -let (dbg_SMTEncodingReify : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SMTEncodingReify" +let (dbg_PartialApp : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "PartialApp" +let (dbg_SMTEncoding : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SMTEncoding" +let (dbg_SMTEncodingReify : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SMTEncodingReify" let mkForall_fuel' : 'uuuuu . Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> 'uuuuu -> (FStarC_SMTEncoding_Term.pat Prims.list Prims.list * FStarC_SMTEncoding_Term.fvs * FStarC_SMTEncoding_Term.term) -> @@ -32,7 +32,7 @@ let mkForall_fuel' : match uu___3 with | (fsym, fterm) -> let add_fuel tms = - FStarC_Compiler_List.map + FStarC_List.map (fun p -> match p.FStarC_SMTEncoding_Term.tm with | FStarC_SMTEncoding_Term.App @@ -41,7 +41,7 @@ let mkForall_fuel' : FStarC_SMTEncoding_Util.mkApp ("HasTypeFuel", (fterm :: args)) | uu___4 -> p) tms in - let pats1 = FStarC_Compiler_List.map add_fuel pats in + let pats1 = FStarC_List.map add_fuel pats in let body1 = match body.FStarC_SMTEncoding_Term.tm with | FStarC_SMTEncoding_Term.App @@ -54,7 +54,7 @@ let mkForall_fuel' : FStarC_SMTEncoding_Util.mk_and_l uu___4 | uu___4 -> let uu___5 = add_fuel [guard] in - FStarC_Compiler_List.hd uu___5 in + FStarC_List.hd uu___5 in FStarC_SMTEncoding_Util.mkImp (guard1, body') | uu___4 -> body in let vars1 = @@ -65,7 +65,7 @@ let mkForall_fuel' : FStarC_SMTEncoding_Term.mkForall r (pats1, vars1, body1)) let (mkForall_fuel : Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_SMTEncoding_Term.pat Prims.list Prims.list * FStarC_SMTEncoding_Term.fvs * FStarC_SMTEncoding_Term.term) -> FStarC_SMTEncoding_Term.term) @@ -88,7 +88,7 @@ let (head_normal : [FStarC_TypeChecker_Env.Eager_unfolding_only] env.FStarC_SMTEncoding_Env.tcenv (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Option.isNone uu___ + FStarC_Option.isNone uu___ | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = @@ -103,7 +103,7 @@ let (head_normal : [FStarC_TypeChecker_Env.Eager_unfolding_only] env.FStarC_SMTEncoding_Env.tcenv (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Option.isNone uu___4 + FStarC_Option.isNone uu___4 | uu___ -> false let (head_redex : FStarC_SMTEncoding_Env.env_t -> FStarC_Syntax_Syntax.term -> Prims.bool) = @@ -124,7 +124,7 @@ let (head_redex : (FStarC_Ident.lid_equals rc.FStarC_Syntax_Syntax.residual_effect FStarC_Parser_Const.effect_GTot_lid)) || - (FStarC_Compiler_List.existsb + (FStarC_List.existsb (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.TOTAL -> true @@ -135,7 +135,7 @@ let (head_redex : [FStarC_TypeChecker_Env.Eager_unfolding_only] env.FStarC_SMTEncoding_Env.tcenv (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Option.isSome uu___1 + FStarC_Option.isSome uu___1 | uu___1 -> false let (norm_with_steps : FStarC_TypeChecker_Env.steps -> @@ -228,7 +228,7 @@ let (mk_Apply : = fun e -> fun vars -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun out -> fun var -> let uu___ = FStarC_SMTEncoding_Term.fv_sort var in @@ -245,12 +245,10 @@ let (mk_Apply_args : = fun e -> fun args -> - FStarC_Compiler_List.fold_left FStarC_SMTEncoding_Util.mk_ApplyTT e - args + FStarC_List.fold_left FStarC_SMTEncoding_Util.mk_ApplyTT e args let raise_arity_mismatch : 'a . - Prims.string -> - Prims.int -> Prims.int -> FStarC_Compiler_Range_Type.range -> 'a + Prims.string -> Prims.int -> Prims.int -> FStarC_Range_Type.range -> 'a = fun head -> fun arity -> @@ -261,7 +259,7 @@ let raise_arity_mismatch : FStarC_Class_Show.show FStarC_Class_Show.showable_int arity in let uu___2 = FStarC_Class_Show.show FStarC_Class_Show.showable_int n_args in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Head symbol %s expects at least %s arguments; got only %s" head uu___1 uu___2 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range rng @@ -269,7 +267,7 @@ let raise_arity_mismatch : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___) let (isTotFun_axioms : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_SMTEncoding_Term.term -> FStarC_SMTEncoding_Term.fvs -> FStarC_SMTEncoding_Term.term Prims.list -> @@ -309,7 +307,7 @@ let (isTotFun_axioms : FStarC_SMTEncoding_Util.mkImp uu___1 in maybe_mkForall [[head1]] ctx uu___ in let app = mk_Apply head1 [x] in - let ctx1 = FStarC_Compiler_List.op_At ctx [x] in + let ctx1 = FStarC_List.op_At ctx [x] in let ctx_guard1 = FStarC_SMTEncoding_Util.mkAnd (ctx_guard, g_x) in let rest = @@ -319,7 +317,7 @@ let (isTotFun_axioms : is_tot_fun_axioms [] FStarC_SMTEncoding_Util.mkTrue head vars guards let (maybe_curry_app : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_SMTEncoding_Term.op, FStarC_SMTEncoding_Term.term) FStar_Pervasives.either -> Prims.int -> @@ -330,7 +328,7 @@ let (maybe_curry_app : fun head -> fun arity -> fun args -> - let n_args = FStarC_Compiler_List.length args in + let n_args = FStarC_List.length args in match head with | FStar_Pervasives.Inr head1 -> mk_Apply_args head1 args | FStar_Pervasives.Inl head1 -> @@ -339,7 +337,7 @@ let (maybe_curry_app : else if n_args > arity then - (let uu___1 = FStarC_Compiler_Util.first_N arity args in + (let uu___1 = FStarC_Util.first_N arity args in match uu___1 with | (args1, rest) -> let head2 = @@ -349,7 +347,7 @@ let (maybe_curry_app : (let uu___2 = FStarC_SMTEncoding_Term.op_to_string head1 in raise_arity_mismatch uu___2 arity n_args rng) let (maybe_curry_fvb : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_SMTEncoding_Env.fvar_binding -> FStarC_SMTEncoding_Term.term Prims.list -> FStarC_SMTEncoding_Term.term) = @@ -382,7 +380,7 @@ let check_pattern_vars : fun vars -> fun pats -> let pats1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (x, uu___1) -> @@ -396,7 +394,7 @@ let check_pattern_vars : | hd::tl -> let pat_vars = let uu___ = FStarC_Syntax_Free.names hd in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun uu___1 -> (fun out -> @@ -405,12 +403,12 @@ let check_pattern_vars : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic out) (Obj.magic uu___1))) uu___2 uu___1) uu___ tl in let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | { FStarC_Syntax_Syntax.binder_bv = b; @@ -420,7 +418,7 @@ let check_pattern_vars : let uu___5 = FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) b (Obj.magic pat_vars) in Prims.op_Negation uu___5) vars in @@ -433,16 +431,16 @@ let check_pattern_vars : FStarC_Syntax_Syntax.binder_attrs = uu___3;_} -> let pos = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun out -> fun t -> - FStarC_Compiler_Range_Ops.union_ranges out + FStarC_Range_Ops.union_ranges out t.FStarC_Syntax_Syntax.pos) hd.FStarC_Syntax_Syntax.pos tl in let uu___4 = let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "SMT pattern misses at least one bound variable: %s" uu___5 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range @@ -450,8 +448,7 @@ let check_pattern_vars : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4)) type label = - (FStarC_SMTEncoding_Term.fv * Prims.string * - FStarC_Compiler_Range_Type.range) + (FStarC_SMTEncoding_Term.fv * Prims.string * FStarC_Range_Type.range) type labels = label Prims.list type pattern = { @@ -509,13 +506,13 @@ let (as_function_typ : else (let uu___2 = let uu___3 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range t0.FStarC_Syntax_Syntax.pos in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t0 in - FStarC_Compiler_Util.format2 - "(%s) Expected a function typ; got %s" uu___3 uu___4 in + FStarC_Util.format2 "(%s) Expected a function typ; got %s" + uu___3 uu___4 in failwith uu___2) in aux true t0 let rec (curried_arrow_formals_comp : @@ -599,8 +596,7 @@ let (getInteger : FStarC_Syntax_Syntax.term' -> Prims.int) = fun tm -> match tm with | FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_int - (n, FStar_Pervasives_Native.None)) -> - FStarC_Compiler_Util.int_of_string n + (n, FStar_Pervasives_Native.None)) -> FStarC_Util.int_of_string n | uu___ -> failwith "Expected an Integer term" let is_BitVector_primitive : 'uuuuu . @@ -702,7 +698,7 @@ let rec (encode_const : let uu___4 = let uu___5 = FStarC_SMTEncoding_Util.mkInteger' - (FStarC_Compiler_Util.int_of_char c1) in + (FStarC_Util.int_of_char c1) in FStarC_SMTEncoding_Term.boxInt uu___5 in [uu___4] in ("FStar.Char.__char_of_int", uu___3) in @@ -718,7 +714,7 @@ let rec (encode_const : let syntax_term = FStarC_ToSyntax_ToSyntax.desugar_machine_integer (env.FStarC_SMTEncoding_Env.tcenv).FStarC_TypeChecker_Env.dsenv - repr sw FStarC_Compiler_Range_Type.dummyRange in + repr sw FStarC_Range_Type.dummyRange in encode_term syntax_term env | FStarC_Const.Const_string (s, uu___1) -> let uu___2 = @@ -740,7 +736,7 @@ let rec (encode_const : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c1 in - FStarC_Compiler_Util.format1 "Unhandled constant: %s" uu___2 in + FStarC_Util.format1 "Unhandled constant: %s" uu___2 in failwith uu___1) and (encode_binders : FStarC_SMTEncoding_Term.term FStar_Pervasives_Native.option -> @@ -754,17 +750,17 @@ and (encode_binders : fun fuel_opt -> fun bs -> fun env -> - (let uu___1 = FStarC_Compiler_Debug.medium () in + (let uu___1 = FStarC_Debug.medium () in if uu___1 then let uu___2 = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) bs in - FStarC_Compiler_Util.print1 "Encoding binders %s\n" uu___2 + FStarC_Util.print1 "Encoding binders %s\n" uu___2 else ()); (let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun b -> match uu___2 with @@ -789,13 +785,12 @@ and (encode_binders : (match uu___3 with | (v, g, env2, decls', n) -> ((v :: vars), (g :: guards), env2, - (FStarC_Compiler_List.op_At decls decls'), (n :: - names)))) ([], [], env, [], []) bs in + (FStarC_List.op_At decls decls'), (n :: names)))) + ([], [], env, [], []) bs in match uu___1 with | (vars, guards, env1, decls, names) -> - ((FStarC_Compiler_List.rev vars), - (FStarC_Compiler_List.rev guards), env1, decls, - (FStarC_Compiler_List.rev names))) + ((FStarC_List.rev vars), (FStarC_List.rev guards), env1, decls, + (FStarC_List.rev names))) and (encode_term_pred : FStarC_SMTEncoding_Term.term FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.typ -> @@ -830,14 +825,14 @@ and (encode_arith_term : | FStarC_Syntax_Syntax.Tm_fvar fv -> fv | uu___1 -> failwith "Impossible" in let unary unbox arg_tms1 = - let uu___1 = FStarC_Compiler_List.hd arg_tms1 in unbox uu___1 in + let uu___1 = FStarC_List.hd arg_tms1 in unbox uu___1 in let binary unbox arg_tms1 = let uu___1 = - let uu___2 = FStarC_Compiler_List.hd arg_tms1 in unbox uu___2 in + let uu___2 = FStarC_List.hd arg_tms1 in unbox uu___2 in let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_List.tl arg_tms1 in - FStarC_Compiler_List.hd uu___4 in + let uu___4 = FStarC_List.tl arg_tms1 in + FStarC_List.hd uu___4 in unbox uu___3 in (uu___1, uu___2) in let mk_default uu___1 = @@ -846,7 +841,7 @@ and (encode_arith_term : head_fv.FStarC_Syntax_Syntax.fv_name in match uu___2 with | (fname, fuel_args, arity) -> - let args = FStarC_Compiler_List.op_At fuel_args arg_tms in + let args = FStarC_List.op_At fuel_args arg_tms in maybe_curry_app head.FStarC_Syntax_Syntax.pos fname arity args in let mk_l box op mk_args ts = @@ -934,12 +929,12 @@ and (encode_arith_term : (binary FStarC_SMTEncoding_Term.unboxReal)))] in let uu___1 = let uu___2 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___3 -> match uu___3 with | (l, uu___4) -> FStarC_Syntax_Syntax.fv_eq_lid head_fv l) ops in - FStarC_Compiler_Util.must uu___2 in + FStarC_Util.must uu___2 in (match uu___1 with | (uu___2, op) -> let uu___3 = op arg_tms in (uu___3, decls)) and (encode_BitVector_term : @@ -954,14 +949,13 @@ and (encode_BitVector_term : fun env -> fun head -> fun args_e -> - let uu___ = FStarC_Compiler_List.hd args_e in + let uu___ = FStarC_List.hd args_e in match uu___ with | (tm_sz, uu___1) -> let uu___2 = uu___ in let sz = getInteger tm_sz.FStarC_Syntax_Syntax.n in let sz_key = - FStarC_Compiler_Util.format1 "BitVector_%s" - (Prims.string_of_int sz) in + FStarC_Util.format1 "BitVector_%s" (Prims.string_of_int sz) in let sz_decls = let uu___3 = FStarC_SMTEncoding_Term.mkBvConstructor sz in match uu___3 with @@ -1012,9 +1006,8 @@ and (encode_BitVector_term : | (decls, typing_inversion) -> let uu___5 = FStarC_SMTEncoding_Term.mk_decls "" sz_key - (FStarC_Compiler_List.op_At t_decls - [typing_inversion]) [] in - FStarC_Compiler_List.op_At decls uu___5) in + (FStarC_List.op_At t_decls [typing_inversion]) [] in + FStarC_List.op_At decls uu___5) in let uu___3 = match ((head.FStarC_Syntax_Syntax.n), args_e) with | (FStarC_Syntax_Syntax.Tm_fvar fv, @@ -1024,8 +1017,8 @@ and (encode_BitVector_term : && (isInteger sz_arg.FStarC_Syntax_Syntax.n) -> let uu___7 = - let uu___8 = FStarC_Compiler_List.tail args_e in - FStarC_Compiler_List.tail uu___8 in + let uu___8 = FStarC_List.tail args_e in + FStarC_List.tail uu___8 in let uu___8 = let uu___9 = getInteger sz_arg.FStarC_Syntax_Syntax.n in FStar_Pervasives_Native.Some uu___9 in @@ -1039,11 +1032,11 @@ and (encode_BitVector_term : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term sz_arg in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Not a constant bitvector extend size: %s" uu___8 in failwith uu___7 | uu___4 -> - let uu___5 = FStarC_Compiler_List.tail args_e in + let uu___5 = FStarC_List.tail args_e in (uu___5, FStar_Pervasives_Native.None) in (match uu___3 with | (arg_tms, ext_sz) -> @@ -1055,29 +1048,29 @@ and (encode_BitVector_term : | FStarC_Syntax_Syntax.Tm_fvar fv -> fv | uu___5 -> failwith "Impossible" in let unary arg_tms2 = - let uu___5 = FStarC_Compiler_List.hd arg_tms2 in + let uu___5 = FStarC_List.hd arg_tms2 in FStarC_SMTEncoding_Term.unboxBitVec sz uu___5 in let unary_arith arg_tms2 = - let uu___5 = FStarC_Compiler_List.hd arg_tms2 in + let uu___5 = FStarC_List.hd arg_tms2 in FStarC_SMTEncoding_Term.unboxInt uu___5 in let binary arg_tms2 = let uu___5 = - let uu___6 = FStarC_Compiler_List.hd arg_tms2 in + let uu___6 = FStarC_List.hd arg_tms2 in FStarC_SMTEncoding_Term.unboxBitVec sz uu___6 in let uu___6 = let uu___7 = - let uu___8 = FStarC_Compiler_List.tl arg_tms2 in - FStarC_Compiler_List.hd uu___8 in + let uu___8 = FStarC_List.tl arg_tms2 in + FStarC_List.hd uu___8 in FStarC_SMTEncoding_Term.unboxBitVec sz uu___7 in (uu___5, uu___6) in let binary_arith arg_tms2 = let uu___5 = - let uu___6 = FStarC_Compiler_List.hd arg_tms2 in + let uu___6 = FStarC_List.hd arg_tms2 in FStarC_SMTEncoding_Term.unboxBitVec sz uu___6 in let uu___6 = let uu___7 = - let uu___8 = FStarC_Compiler_List.tl arg_tms2 in - FStarC_Compiler_List.hd uu___8 in + let uu___8 = FStarC_List.tl arg_tms2 in + FStarC_List.hd uu___8 in FStarC_SMTEncoding_Term.unboxInt uu___7 in (uu___5, uu___6) in let mk_bv op mk_args resBox ts = @@ -1179,18 +1172,17 @@ and (encode_BitVector_term : (FStarC_Parser_Const.nat_to_bv_lid, bv_to)] in let uu___5 = let uu___6 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___7 -> match uu___7 with | (l, uu___8) -> FStarC_Syntax_Syntax.fv_eq_lid head_fv l) ops in - FStarC_Compiler_Util.must uu___6 in + FStarC_Util.must uu___6 in (match uu___5 with | (uu___6, op) -> let uu___7 = op arg_tms1 in - (uu___7, - (FStarC_Compiler_List.op_At sz_decls decls))))) + (uu___7, (FStarC_List.op_At sz_decls decls))))) and (encode_deeply_embedded_quantifier : FStarC_Syntax_Syntax.term -> FStarC_SMTEncoding_Env.env_t -> @@ -1277,8 +1269,7 @@ and (encode_deeply_embedded_quantifier : let ax = let uu___3 = let uu___4 = - let uu___5 = - FStarC_Compiler_Util.digest_of_string tkey_hash in + let uu___5 = FStarC_Util.digest_of_string tkey_hash in Prims.strcat "l_quant_interp_" uu___5 in (interp, (FStar_Pervasives_Native.Some @@ -1289,9 +1280,9 @@ and (encode_deeply_embedded_quantifier : let uu___4 = let uu___5 = FStarC_SMTEncoding_Term.mk_decls "" tkey_hash - [ax] (FStarC_Compiler_List.op_At decls decls') in - FStarC_Compiler_List.op_At decls' uu___5 in - FStarC_Compiler_List.op_At decls uu___4 in + [ax] (FStarC_List.op_At decls decls') in + FStarC_List.op_At decls' uu___5 in + FStarC_List.op_At decls uu___4 in (tm, uu___3))) and (encode_term : FStarC_Syntax_Syntax.typ -> @@ -1306,61 +1297,58 @@ and (encode_term : env.FStarC_SMTEncoding_Env.tcenv t; (let t1 = FStarC_Syntax_Subst.compress t in let t0 = t1 in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + (let uu___2 = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___2 then let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print2 "(%s) %s\n" uu___3 uu___4 + FStarC_Util.print2 "(%s) %s\n" uu___3 uu___4 else ()); (match t1.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_delayed uu___2 -> let uu___3 = let uu___4 = - FStarC_Compiler_Range_Ops.string_of_range - t1.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.string_of_range t1.FStarC_Syntax_Syntax.pos in let uu___5 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format3 "(%s) Impossible: %s\n%s\n" uu___4 - uu___5 uu___6 in + FStarC_Util.format3 "(%s) Impossible: %s\n%s\n" uu___4 uu___5 + uu___6 in failwith uu___3 | FStarC_Syntax_Syntax.Tm_unknown -> let uu___2 = let uu___3 = - FStarC_Compiler_Range_Ops.string_of_range - t1.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.string_of_range t1.FStarC_Syntax_Syntax.pos in let uu___4 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format3 "(%s) Impossible: %s\n%s\n" uu___3 - uu___4 uu___5 in + FStarC_Util.format3 "(%s) Impossible: %s\n%s\n" uu___3 uu___4 + uu___5 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_lazy i -> let e = FStarC_Syntax_Util.unfold_lazy i in - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + ((let uu___3 = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___3 then let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print2 ">> Unfolded (%s) ~> (%s)\n" - uu___4 uu___5 + FStarC_Util.print2 ">> Unfolded (%s) ~> (%s)\n" uu___4 uu___5 else ()); encode_term e env) | FStarC_Syntax_Syntax.Tm_bvar x -> let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in - FStarC_Compiler_Util.format1 - "Impossible: locally nameless; got %s" uu___3 in + FStarC_Util.format1 "Impossible: locally nameless; got %s" + uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_ascribed { FStarC_Syntax_Syntax.tm = t2; @@ -1382,15 +1370,15 @@ and (encode_term : FStarC_Reflection_V2_Embeddings.e_term_view uu___4 in uu___3 t1.FStarC_Syntax_Syntax.pos FStar_Pervasives_Native.None FStarC_Syntax_Embeddings_Base.id_norm_cb in - ((let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + ((let uu___4 = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___4 then let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t0 in let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tv in - FStarC_Compiler_Util.print2 ">> Inspected (%s) ~> (%s)\n" - uu___5 uu___6 + FStarC_Util.print2 ">> Inspected (%s) ~> (%s)\n" uu___5 + uu___6 else ()); (let t2 = let uu___4 = @@ -1450,8 +1438,7 @@ and (encode_term : match tok.FStarC_SMTEncoding_Term.tm with | FStarC_SMTEncoding_Term.FreeV uu___4 -> let sym_name = - let uu___5 = - FStarC_Compiler_Util.digest_of_string tkey_hash in + let uu___5 = FStarC_Util.digest_of_string tkey_hash in Prims.strcat "@kick_partial_app_" uu___5 in let uu___5 = let uu___6 = @@ -1466,8 +1453,7 @@ and (encode_term : (uu___5, sym_name) | FStarC_SMTEncoding_Term.App (uu___4, []) -> let sym_name = - let uu___5 = - FStarC_Compiler_Util.digest_of_string tkey_hash in + let uu___5 = FStarC_Util.digest_of_string tkey_hash in Prims.strcat "@kick_partial_app_" uu___5 in let uu___5 = let uu___6 = @@ -1691,7 +1677,7 @@ and (encode_term : let uu___9 = FStarC_SMTEncoding_Term.free_variables t_interp1 in - FStarC_Compiler_List.filter + FStarC_List.filter (fun x -> let uu___10 = FStarC_SMTEncoding_Term.fv_name @@ -1715,11 +1701,11 @@ and (encode_term : Prims.strcat prefix uu___9 in let tsym = let uu___9 = - FStarC_Compiler_Util.digest_of_string + FStarC_Util.digest_of_string tkey_hash in Prims.strcat prefix uu___9 in let cvar_sorts = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_sort cvars in let caption = @@ -1732,8 +1718,8 @@ and (encode_term : FStarC_TypeChecker_Normalize.term_to_string env.FStarC_SMTEncoding_Env.tcenv t0 in - FStarC_Compiler_Util.replace_char - uu___11 10 32 in + FStarC_Util.replace_char uu___11 + 10 32 in FStar_Pervasives_Native.Some uu___10 else FStar_Pervasives_Native.None in @@ -1745,7 +1731,7 @@ and (encode_term : let t2 = let uu___9 = let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV cvars in (tsym, uu___10) in @@ -1837,16 +1823,13 @@ and (encode_term : let uu___12 = FStarC_SMTEncoding_Term.mk_decls tsym tkey_hash t_decls - (FStarC_Compiler_List.op_At - decls - (FStarC_Compiler_List.op_At - decls' guard_decls)) in - FStarC_Compiler_List.op_At - guard_decls uu___12 in - FStarC_Compiler_List.op_At decls' - uu___11 in - FStarC_Compiler_List.op_At decls - uu___10 in + (FStarC_List.op_At decls + (FStarC_List.op_At decls' + guard_decls)) in + FStarC_List.op_At guard_decls + uu___12 in + FStarC_List.op_At decls' uu___11 in + FStarC_List.op_At decls uu___10 in (t2, uu___9))))) else (let tkey_hash = @@ -1864,8 +1847,8 @@ and (encode_term : uu___9 res in FStarC_Syntax_Syntax.mk_Comp uu___8 in let uu___8 = - encode_term (FStarC_Syntax_Util.comp_result c1) - env_bs in + let uu___9 = FStarC_Syntax_Util.comp_result c1 in + encode_term uu___9 env_bs in (match uu___8 with | (ct, uu___9) -> let uu___10 = @@ -1878,10 +1861,9 @@ and (encode_term : let uu___12 = let uu___13 = FStarC_SMTEncoding_Util.mk_and_l - (FStarC_Compiler_List.op_At - guards_l - (FStarC_Compiler_List.op_At - [ct] effect_args)) in + (FStarC_List.op_At guards_l + (FStarC_List.op_At [ct] + effect_args)) in ([], vars, uu___13) in FStarC_SMTEncoding_Term.mkForall t1.FStarC_Syntax_Syntax.pos uu___12 in @@ -1892,15 +1874,16 @@ and (encode_term : tkey in let uu___14 = let uu___15 = + let uu___16 = + FStarC_Syntax_Util.comp_effect_name + c1 in FStarC_Ident.string_of_lid - (FStarC_Syntax_Util.comp_effect_name - c1) in + uu___16 in Prims.strcat "@Effect=" uu___15 in Prims.strcat uu___13 uu___14 in Prims.strcat "Non_total_Tm_arrow" uu___12 in - FStarC_Compiler_Util.digest_of_string - tkey_hash1)) in + FStarC_Util.digest_of_string tkey_hash1)) in let tsym = Prims.strcat "Non_total_Tm_arrow_" tkey_hash in let env0 = env in let uu___5 = @@ -1908,7 +1891,7 @@ and (encode_term : let uu___6 = FStarC_Syntax_Free.names t0 in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___6) in let getfreeV t2 = @@ -1918,7 +1901,7 @@ and (encode_term : failwith "Impossible: getfreeV: gen_term_var should always returns a FreeV" in let uu___6 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___7 -> fun bv -> match uu___7 with @@ -1942,21 +1925,21 @@ and (encode_term : (match uu___11 with | (guard, decls') -> (env2, - (FStarC_Compiler_List.op_At - decls' decls), (fv :: - vars), (smt_tm :: tms), - (guard :: guards)))))) + (FStarC_List.op_At decls' + decls), (fv :: vars), + (smt_tm :: tms), (guard + :: guards)))))) (env, [], [], [], []) fvs in (fvs, uu___6) in match uu___5 with | (fstar_fvs, (env1, fv_decls, fv_vars, fv_tms, fv_guards)) -> - let fv_decls1 = FStarC_Compiler_List.rev fv_decls in - let fv_vars1 = FStarC_Compiler_List.rev fv_vars in - let fv_tms1 = FStarC_Compiler_List.rev fv_tms in - let fv_guards1 = FStarC_Compiler_List.rev fv_guards in + let fv_decls1 = FStarC_List.rev fv_decls in + let fv_vars1 = FStarC_List.rev fv_vars in + let fv_tms1 = FStarC_List.rev fv_tms in + let fv_guards1 = FStarC_List.rev fv_guards in let arg_sorts = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> FStarC_SMTEncoding_Term.Term_sort) fv_tms1 in let tdecl = @@ -2003,7 +1986,7 @@ and (encode_term : let tapp_concrete = let uu___6 = let uu___7 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_SMTEncoding_Env.lookup_term_var env0) fstar_fvs in (tsym, uu___7) in @@ -2012,7 +1995,7 @@ and (encode_term : let uu___7 = FStarC_SMTEncoding_Term.mk_decls tsym tkey_hash [tdecl; t_kinding] [] in - FStarC_Compiler_List.op_At fv_decls1 uu___7 in + FStarC_List.op_At fv_decls1 uu___7 in (tapp_concrete, uu___6))) | FStarC_Syntax_Syntax.Tm_refine uu___2 -> let uu___3 = @@ -2039,7 +2022,7 @@ and (encode_term : (match uu___8 with | (b, f1) -> let uu___9 = - let uu___10 = FStarC_Compiler_List.hd b in + let uu___10 = FStarC_List.hd b in uu___10.FStarC_Syntax_Syntax.binder_bv in (uu___9, f1)) | uu___5 -> failwith "impossible" in @@ -2075,12 +2058,11 @@ and (encode_term : let uu___10 = FStarC_SMTEncoding_Term.free_variables tm_has_type_with_fuel in - FStarC_Compiler_List.op_At uu___9 - uu___10 in - FStarC_Compiler_Util.remove_dups + FStarC_List.op_At uu___9 uu___10 in + FStarC_Util.remove_dups FStarC_SMTEncoding_Term.fv_eq uu___8 in let cvars1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun y -> (let uu___8 = FStarC_SMTEncoding_Term.fv_name @@ -2107,7 +2089,7 @@ and (encode_term : FStarC_SMTEncoding_Term.hash_of_term tkey in ((let uu___9 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___9 then @@ -2116,19 +2098,19 @@ and (encode_term : FStarC_Syntax_Print.showable_term f in let uu___11 = - FStarC_Compiler_Util.digest_of_string + FStarC_Util.digest_of_string tkey_hash in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Encoding Tm_refine %s with tkey_hash %s and digest %s\n" uu___10 tkey_hash uu___11 else ()); (let tsym = let uu___9 = - FStarC_Compiler_Util.digest_of_string + FStarC_Util.digest_of_string tkey_hash in Prims.strcat "Tm_refine_" uu___9 in let cvar_sorts = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_sort cvars1 in let tdecl = @@ -2139,7 +2121,7 @@ and (encode_term : let t2 = let uu___9 = let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV cvars1 in (tsym, uu___10) in @@ -2224,12 +2206,10 @@ and (encode_term : let uu___11 = FStarC_SMTEncoding_Term.mk_decls tsym tkey_hash t_decls - (FStarC_Compiler_List.op_At - decls decls') in - FStarC_Compiler_List.op_At decls' - uu___11 in - FStarC_Compiler_List.op_At decls - uu___10 in + (FStarC_List.op_At decls + decls') in + FStarC_List.op_At decls' uu___11 in + FStarC_List.op_At decls uu___10 in (t2, uu___9)))))))) | FStarC_Syntax_Syntax.Tm_uvar (uv, uu___2) -> let ttm = @@ -2250,8 +2230,8 @@ and (encode_term : let uu___8 = FStarC_Syntax_Unionfind.uvar_id uv.FStarC_Syntax_Syntax.ctx_uvar_head in - FStarC_Compiler_Util.string_of_int uu___8 in - FStarC_Compiler_Util.format1 "uvar_typing_%s" uu___7 in + FStarC_Util.string_of_int uu___8 in + FStarC_Util.format1 "uvar_typing_%s" uu___7 in FStarC_SMTEncoding_Env.varops.FStarC_SMTEncoding_Env.mk_unique uu___6 in (t_has_k, (FStar_Pervasives_Native.Some "Uvar typing"), @@ -2259,7 +2239,7 @@ and (encode_term : FStarC_SMTEncoding_Util.mkAssume uu___4 in let uu___4 = let uu___5 = FStarC_SMTEncoding_Term.mk_decls_trivial [d] in - FStarC_Compiler_List.op_At decls uu___5 in + FStarC_List.op_At decls uu___5 in (ttm, uu___4)) | FStarC_Syntax_Syntax.Tm_app uu___2 -> let uu___3 = FStarC_Syntax_Util.head_and_args t0 in @@ -2300,7 +2280,7 @@ and (encode_term : (let uu___7 = FStarC_Syntax_Formula.destruct_typ_as_formula arg in - FStarC_Compiler_Option.isSome uu___7) + FStarC_Option.isSome uu___7) -> let dummy = FStarC_Syntax_Syntax.new_bv @@ -2326,7 +2306,7 @@ and (encode_term : (let uu___11 = FStarC_Syntax_Formula.destruct_typ_as_formula arg in - FStarC_Compiler_Option.isSome uu___11) + FStarC_Option.isSome uu___11) -> let dummy = FStarC_Syntax_Syntax.new_bv @@ -2408,7 +2388,7 @@ and (encode_term : let uu___8 = let uu___9 = let uu___10 = - FStarC_Compiler_List.hd args_e1 in + FStarC_List.hd args_e1 in FStar_Pervasives_Native.fst uu___10 in FStarC_Syntax_Util.mk_reify uu___9 lopt in @@ -2416,7 +2396,7 @@ and (encode_term : env.FStarC_SMTEncoding_Env.tcenv [] uu___8 in ((let uu___9 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_SMTEncodingReify in if uu___9 then @@ -2424,7 +2404,7 @@ and (encode_term : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e0 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Result of normalization %s\n" uu___10 else ()); @@ -2432,8 +2412,7 @@ and (encode_term : let uu___9 = FStarC_TypeChecker_Util.remove_reify e0 in - let uu___10 = - FStarC_Compiler_List.tl args_e1 in + let uu___10 = FStarC_List.tl args_e1 in FStarC_Syntax_Syntax.mk_Tm_app uu___9 uu___10 t0.FStarC_Syntax_Syntax.pos in encode_term e env))) @@ -2485,8 +2464,7 @@ and (encode_term : let app_tm = mk_Apply_args smt_head args in (app_tm, - (FStarC_Compiler_List.op_At decls - decls')) in + (FStarC_List.op_At decls decls')) in let encode_full_app fv = let uu___8 = FStarC_SMTEncoding_Env.lookup_free_var_sym @@ -2497,8 +2475,8 @@ and (encode_term : maybe_curry_app t0.FStarC_Syntax_Syntax.pos fname arity - (FStarC_Compiler_List.op_At - fuel_args args) in + (FStarC_List.op_At fuel_args + args) in (tm, decls) in let head2 = FStarC_Syntax_Subst.compress head1 in @@ -2574,8 +2552,10 @@ and (encode_term : FStarC_Syntax_Syntax.eff_opt = uu___11;_} -> + let uu___12 = + FStarC_Syntax_Util.comp_result c in FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.comp_result c) + uu___12 | uu___8 -> FStar_Pervasives_Native.None in (match head_type with @@ -2601,11 +2581,9 @@ and (encode_term : match uu___9 with | (formals, c) -> if - (FStarC_Compiler_List.length - formals) + (FStarC_List.length formals) < - (FStarC_Compiler_List.length - args) + (FStarC_List.length args) then let head_type3 = let uu___10 = @@ -2630,7 +2608,7 @@ and (encode_term : (match uu___8 with | (head_type2, formals, c) -> ((let uu___10 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_PartialApp in if uu___10 then @@ -2650,7 +2628,7 @@ and (encode_term : FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) args_e1 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Encoding partial application, head_type = %s, formals = %s, args = %s\n" uu___11 uu___12 uu___13 else ()); @@ -2670,30 +2648,30 @@ and (encode_term : = uu___12;_}, uu___13) when - (FStarC_Compiler_List.length + (FStarC_List.length formals) = - (FStarC_Compiler_List.length + (FStarC_List.length args) -> encode_full_app fv.FStarC_Syntax_Syntax.fv_name | FStarC_Syntax_Syntax.Tm_fvar fv when - (FStarC_Compiler_List.length + (FStarC_List.length formals) = - (FStarC_Compiler_List.length + (FStarC_List.length args) -> encode_full_app fv.FStarC_Syntax_Syntax.fv_name | uu___10 -> if - (FStarC_Compiler_List.length + (FStarC_List.length formals) > - (FStarC_Compiler_List.length + (FStarC_List.length args) then encode_partial_app @@ -2716,14 +2694,14 @@ and (encode_term : let uu___5 = FStarC_Syntax_Free.names t0 in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___5) in let tms = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_SMTEncoding_Env.lookup_term_var env) fvs in let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> FStarC_SMTEncoding_Term.Term_sort) fvs in (uu___5, tms) in @@ -2887,9 +2865,9 @@ and (encode_term : let uu___12 = FStarC_SMTEncoding_Term.free_variables t2 in - FStarC_Compiler_List.op_At - uu___12 cvars in - FStarC_Compiler_Util.remove_dups + FStarC_List.op_At uu___12 + cvars in + FStarC_Util.remove_dups FStarC_SMTEncoding_Term.fv_eq uu___11 in let uu___11 = @@ -2906,31 +2884,31 @@ and (encode_term : FStarC_SMTEncoding_Term.hash_of_term tkey in ((let uu___11 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_PartialApp in if uu___11 then let uu___12 = let uu___13 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_name vars in - FStarC_Compiler_String.concat - ", " uu___13 in + FStarC_String.concat ", " + uu___13 in let uu___13 = FStarC_SMTEncoding_Term.print_smt_term body3 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Checking eta expansion of\n\tvars={%s}\n\tbody=%s\n" uu___12 uu___13 else ()); (let cvar_sorts = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Term.fv_sort cvars1 in let fsym = let uu___11 = - FStarC_Compiler_Util.digest_of_string + FStarC_Util.digest_of_string tkey_hash in Prims.strcat "Tm_abs_" uu___11 in @@ -2942,7 +2920,7 @@ and (encode_term : let f = let uu___11 = let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV cvars1 in (fsym, uu___12) in @@ -2956,7 +2934,7 @@ and (encode_term : let tot_fun_ax = let ax = let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___12 -> FStarC_SMTEncoding_Util.mkTrue) vars in @@ -3013,7 +2991,7 @@ and (encode_term : FStarC_SMTEncoding_Util.mkEq (app, body3) in ([[app]], - (FStarC_Compiler_List.op_At + (FStarC_List.op_At vars cvars1), uu___14) in FStarC_SMTEncoding_Term.mkForall @@ -3025,9 +3003,8 @@ and (encode_term : FStarC_SMTEncoding_Util.mkAssume uu___11 in let f_decls = - FStarC_Compiler_List.op_At - (fdecl :: typing_f) - [interp_f] in + FStarC_List.op_At (fdecl :: + typing_f) [interp_f] in let uu___11 = let uu___12 = let uu___13 = @@ -3035,16 +3012,16 @@ and (encode_term : FStarC_SMTEncoding_Term.mk_decls fsym tkey_hash f_decls - (FStarC_Compiler_List.op_At + (FStarC_List.op_At decls - (FStarC_Compiler_List.op_At + (FStarC_List.op_At decls' decls'')) in - FStarC_Compiler_List.op_At - decls'' uu___14 in - FStarC_Compiler_List.op_At - decls' uu___13 in - FStarC_Compiler_List.op_At - decls uu___12 in + FStarC_List.op_At decls'' + uu___14 in + FStarC_List.op_At decls' + uu___13 in + FStarC_List.op_At decls + uu___12 in (f, uu___11))))))))) | FStarC_Syntax_Syntax.Tm_let { @@ -3082,7 +3059,7 @@ and (encode_term : FStarC_Syntax_Syntax.body1 = uu___3;_} -> let names = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___4 = lb in match uu___4 with @@ -3093,14 +3070,13 @@ and (encode_term : FStarC_Syntax_Syntax.lbdef = uu___8; FStarC_Syntax_Syntax.lbattrs = uu___9; FStarC_Syntax_Syntax.lbpos = uu___10;_} -> - let x = FStarC_Compiler_Util.left lbname in + let x = FStarC_Util.left lbname in let uu___11 = FStarC_Ident.string_of_id x.FStarC_Syntax_Syntax.ppname in let uu___12 = FStarC_Syntax_Syntax.range_of_bv x in (uu___11, uu___12)) lbs in - FStarC_Compiler_Effect.raise - (FStarC_SMTEncoding_Env.Inner_let_rec names) + FStarC_Effect.raise (FStarC_SMTEncoding_Env.Inner_let_rec names) | FStarC_Syntax_Syntax.Tm_match { FStarC_Syntax_Syntax.scrutinee = e; FStarC_Syntax_Syntax.ret_opt = uu___2; @@ -3145,14 +3121,14 @@ and (encode_let : (match uu___1 with | (xs, e21) -> let x1 = - let uu___2 = FStarC_Compiler_List.hd xs in + let uu___2 = FStarC_List.hd xs in uu___2.FStarC_Syntax_Syntax.binder_bv in let env' = FStarC_SMTEncoding_Env.push_term_var env x1 ee1 in let uu___2 = encode_body e21 env' in (match uu___2 with | (ee2, decls2) -> - (ee2, (FStarC_Compiler_List.op_At decls1 decls2)))) + (ee2, (FStarC_List.op_At decls1 decls2)))) and (encode_match : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.branch Prims.list -> @@ -3174,7 +3150,7 @@ and (encode_match : let uu___1 = let uu___2 = FStarC_Syntax_Syntax.mk FStarC_Syntax_Syntax.Tm_unknown - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.null_bv uu___2 in FStarC_SMTEncoding_Env.gen_term_var env uu___1 in match uu___ with @@ -3196,7 +3172,7 @@ and (encode_match : let projections = pattern1.projections scr' in let env2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env3 -> fun uu___6 -> match uu___6 with @@ -3235,11 +3211,10 @@ and (encode_match : FStarC_SMTEncoding_Util.mkITE (guard1, br1, else_case) in (uu___8, - (FStarC_Compiler_List.op_At - decls1 - (FStarC_Compiler_List.op_At + (FStarC_List.op_At decls1 + (FStarC_List.op_At decls2 decls3))))))) in - FStarC_Compiler_List.fold_right encode_branch pats + FStarC_List.fold_right encode_branch pats (default_case, decls) in (match uu___2 with | (match_tm, decls1) -> @@ -3255,7 +3230,7 @@ and (encode_match : [uu___6] in (uu___5, match_tm) in FStarC_SMTEncoding_Term.mkLet' uu___4 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in (uu___3, decls1))) and (encode_pat : FStarC_SMTEncoding_Env.env_t -> @@ -3263,18 +3238,18 @@ and (encode_pat : = fun env -> fun pat -> - (let uu___1 = FStarC_Compiler_Debug.medium () in + (let uu___1 = FStarC_Debug.medium () in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat pat in - FStarC_Compiler_Util.print1 "Encoding pattern %s\n" uu___2 + FStarC_Util.print1 "Encoding pattern %s\n" uu___2 else ()); (let uu___1 = FStarC_TypeChecker_Util.decorated_pattern_as_term pat in match uu___1 with | (vars, pat_term) -> let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun v -> match uu___3 with @@ -3326,7 +3301,7 @@ and (encode_pat : (f.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v scrutinee in let sub_term_guards = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___4 -> match uu___4 with @@ -3349,7 +3324,7 @@ and (encode_pat : | FStarC_Syntax_Syntax.Pat_constant uu___3 -> [] | FStarC_Syntax_Syntax.Pat_cons (f, uu___3, args) -> let uu___4 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___5 -> match uu___5 with @@ -3363,7 +3338,7 @@ and (encode_pat : FStarC_SMTEncoding_Util.mkApp (proj, [scrutinee]) in mk_projections arg uu___7) args in - FStarC_Compiler_List.flatten uu___4 in + FStarC_List.flatten uu___4 in let pat_term1 uu___3 = encode_term pat_term env1 in let pattern1 = { @@ -3382,7 +3357,7 @@ and (encode_args : fun l -> fun env -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -3390,11 +3365,9 @@ and (encode_args : let uu___4 = encode_term t env in (match uu___4 with | (t1, decls') -> - ((t1 :: tms), - (FStarC_Compiler_List.op_At decls decls')))) + ((t1 :: tms), (FStarC_List.op_At decls decls')))) ([], []) l in - match uu___ with - | (l1, decls) -> ((FStarC_Compiler_List.rev l1), decls) + match uu___ with | (l1, decls) -> ((FStarC_List.rev l1), decls) and (encode_smt_patterns : FStarC_Syntax_Syntax.arg Prims.list Prims.list -> FStarC_SMTEncoding_Env.env_t -> @@ -3443,16 +3416,15 @@ and (encode_smt_patterns : | (t2, decls') -> let uu___6 = FStarC_SMTEncoding_Term.mk_HasType x1 t2 in - (uu___6, - (FStarC_Compiler_List.op_At decls decls')))) + (uu___6, (FStarC_List.op_At decls decls')))) | uu___1 -> encode_term t env1) in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun pats -> fun uu___ -> match uu___ with | (pats_l1, decls) -> let uu___1 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___2 -> fun uu___3 -> match (uu___2, uu___3) with @@ -3466,8 +3438,7 @@ and (encode_smt_patterns : (match uu___6 with | FStar_Pervasives_Native.None -> ((t :: pats1), - (FStarC_Compiler_List.op_At d - decls1)) + (FStarC_List.op_At d decls1)) | FStar_Pervasives_Native.Some illegal_subterm -> ((let uu___8 = @@ -3479,7 +3450,7 @@ and (encode_smt_patterns : FStarC_Class_Show.show FStarC_SMTEncoding_Term.showable_smt_term illegal_subterm in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Pattern %s contains illegal sub-term (%s); dropping it" uu___9 uu___10 in FStarC_Errors.log_issue @@ -3491,8 +3462,8 @@ and (encode_smt_patterns : FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___8)); (pats1, - (FStarC_Compiler_List.op_At d - decls1)))))) pats ([], decls) in + (FStarC_List.op_At d decls1)))))) + pats ([], decls) in (match uu___1 with | (pats1, decls1) -> ((pats1 :: pats_l1), decls1))) pats_l ([], []) @@ -3504,24 +3475,23 @@ and (encode_formula : fun phi -> fun env -> let debug phi1 = - let uu___ = FStarC_Compiler_Effect.op_Bang dbg_SMTEncoding in + let uu___ = FStarC_Effect.op_Bang dbg_SMTEncoding in if uu___ then let uu___1 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term phi1 in let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term phi1 in - FStarC_Compiler_Util.print2 "Formula (%s) %s\n" uu___1 uu___2 + FStarC_Util.print2 "Formula (%s) %s\n" uu___1 uu___2 else () in let enc f r l = let uu___ = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun decls -> fun x -> let uu___1 = encode_term (FStar_Pervasives_Native.fst x) env in match uu___1 with - | (t, decls') -> - ((FStarC_Compiler_List.op_At decls decls'), t)) [] l in + | (t, decls') -> ((FStarC_List.op_At decls decls'), t)) [] l in match uu___ with | (decls, args) -> let uu___1 = @@ -3535,14 +3505,14 @@ and (encode_formula : } in (uu___1, decls) in let const_op f r uu___ = let uu___1 = f r in (uu___1, []) in - let un_op f l = let uu___ = FStarC_Compiler_List.hd l in f uu___ in + let un_op f l = let uu___ = FStarC_List.hd l in f uu___ in let bin_op f uu___ = match uu___ with | t1::t2::[] -> f (t1, t2) | uu___1 -> failwith "Impossible" in let enc_prop_c f r l = let uu___ = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun decls -> fun uu___1 -> match uu___1 with @@ -3550,8 +3520,7 @@ and (encode_formula : let uu___3 = encode_formula t env in (match uu___3 with | (phi1, decls') -> - ((FStarC_Compiler_List.op_At decls decls'), phi1))) - [] l in + ((FStarC_List.op_At decls decls'), phi1))) [] l in match uu___ with | (decls, phis) -> let uu___1 = @@ -3566,7 +3535,7 @@ and (encode_formula : (uu___1, decls) in let eq_op r args = let rf = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___ -> match uu___ with | (a, q) -> @@ -3576,12 +3545,12 @@ and (encode_formula : FStarC_Syntax_Syntax.aqual_attributes = uu___1;_} -> false | uu___1 -> true)) args in - if (FStarC_Compiler_List.length rf) <> (Prims.of_int (2)) + if (FStarC_List.length rf) <> (Prims.of_int (2)) then let uu___ = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "eq_op: got %s non-implicit arguments instead of 2?" - (Prims.string_of_int (FStarC_Compiler_List.length rf)) in + (Prims.string_of_int (FStarC_List.length rf)) in failwith uu___ else (let uu___1 = enc (bin_op FStarC_SMTEncoding_Util.mkEq) in @@ -3602,8 +3571,7 @@ and (encode_formula : | (l2, decls2) -> let uu___6 = FStarC_SMTEncoding_Term.mkImp (l2, l1) r in - (uu___6, - (FStarC_Compiler_List.op_At decls1 decls2))))) + (uu___6, (FStarC_List.op_At decls1 decls2))))) | uu___1 -> failwith "impossible" in let mk_ite r uu___ = match uu___ with @@ -3620,12 +3588,11 @@ and (encode_formula : let res = FStarC_SMTEncoding_Term.mkITE (g, t, e) r in (res, - (FStarC_Compiler_List.op_At decls1 - (FStarC_Compiler_List.op_At decls2 decls3)))))) + (FStarC_List.op_At decls1 + (FStarC_List.op_At decls2 decls3)))))) | uu___1 -> failwith "impossible" in let unboxInt_l f l = - let uu___ = - FStarC_Compiler_List.map FStarC_SMTEncoding_Term.unboxInt l in + let uu___ = FStarC_List.map FStarC_SMTEncoding_Term.unboxInt l in f uu___ in let connectives = let uu___ = @@ -3720,8 +3687,7 @@ and (encode_formula : | (t1, decls') -> let uu___5 = FStarC_SMTEncoding_Term.mk_HasType x1 t1 in - (uu___5, - (FStarC_Compiler_List.op_At decls decls')))) + (uu___5, (FStarC_List.op_At decls decls')))) | (FStarC_Syntax_Syntax.Tm_fvar fv, uu___::(phi2, uu___1)::[]) when FStarC_Syntax_Syntax.fv_eq_lid fv @@ -3820,13 +3786,12 @@ and (encode_formula : let tt1 = let uu___3 = let uu___4 = - FStarC_Compiler_Range_Type.use_range + FStarC_Range_Type.use_range tt.FStarC_SMTEncoding_Term.rng in let uu___5 = - FStarC_Compiler_Range_Type.use_range + FStarC_Range_Type.use_range phi1.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_Range_Ops.rng_included uu___4 - uu___5 in + FStarC_Range_Ops.rng_included uu___4 uu___5 in if uu___3 then tt else @@ -3856,12 +3821,12 @@ and (encode_formula : let tt1 = let uu___2 = let uu___3 = - FStarC_Compiler_Range_Type.use_range + FStarC_Range_Type.use_range tt.FStarC_SMTEncoding_Term.rng in let uu___4 = - FStarC_Compiler_Range_Type.use_range + FStarC_Range_Type.use_range phi1.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_Range_Ops.rng_included uu___3 uu___4 in + FStarC_Range_Ops.rng_included uu___3 uu___4 in if uu___2 then tt else @@ -3901,8 +3866,8 @@ and (encode_formula : | uu___4 -> guards in let uu___4 = FStarC_SMTEncoding_Util.mk_and_l guards1 in (vars, pats, uu___4, body1, - (FStarC_Compiler_List.op_At decls - (FStarC_Compiler_List.op_At decls' decls''))))) in + (FStarC_List.op_At decls + (FStarC_List.op_At decls' decls''))))) in debug phi; (let phi1 = FStarC_Syntax_Util.unascribe phi in let uu___1 = FStarC_Syntax_Formula.destruct_typ_as_formula phi1 in @@ -3911,7 +3876,7 @@ and (encode_formula : | FStar_Pervasives_Native.Some (FStarC_Syntax_Formula.BaseConn (op, arms)) -> let uu___2 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___3 -> match uu___3 with | (l, uu___4) -> FStarC_Ident.lid_equals op l) connectives in @@ -3921,7 +3886,7 @@ and (encode_formula : f phi1.FStarC_Syntax_Syntax.pos arms) | FStar_Pervasives_Native.Some (FStarC_Syntax_Formula.QAll (vars, pats, body)) -> - (FStarC_Compiler_List.iter (check_pattern_vars env vars) pats; + (FStarC_List.iter (check_pattern_vars env vars) pats; (let uu___3 = encode_q_body env vars pats body in match uu___3 with | (vars1, pats1, guard, body1, decls) -> @@ -3935,7 +3900,7 @@ and (encode_formula : (tm, decls))) | FStar_Pervasives_Native.Some (FStarC_Syntax_Formula.QEx (vars, pats, body)) -> - (FStarC_Compiler_List.iter (check_pattern_vars env vars) pats; + (FStarC_List.iter (check_pattern_vars env vars) pats; (let uu___3 = encode_q_body env vars pats body in match uu___3 with | (vars1, pats1, guard, body1, decls) -> @@ -3955,8 +3920,7 @@ let (encode_function_type_as_formula : fun t -> fun env -> let universe_of_binders binders = - FStarC_Compiler_List.map (fun uu___ -> FStarC_Syntax_Syntax.U_zero) - binders in + FStarC_List.map (fun uu___ -> FStarC_Syntax_Syntax.U_zero) binders in let quant = FStarC_Syntax_Util.smt_lemma_as_forall t universe_of_binders in let env1 = diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Env.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Env.ml similarity index 88% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_Env.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Env.ml index bb2fa21a1c8..05ed6782c1d 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Env.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Env.ml @@ -1,14 +1,14 @@ open Prims -let (dbg_PartialApp : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "PartialApp" -exception Inner_let_rec of (Prims.string * FStarC_Compiler_Range_Type.range) +let (dbg_PartialApp : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "PartialApp" +exception Inner_let_rec of (Prims.string * FStarC_Range_Type.range) Prims.list let (uu___is_Inner_let_rec : Prims.exn -> Prims.bool) = fun projectee -> match projectee with | Inner_let_rec uu___ -> true | uu___ -> false let (__proj__Inner_let_rec__item__uu___ : - Prims.exn -> (Prims.string * FStarC_Compiler_Range_Type.range) Prims.list) - = fun projectee -> match projectee with | Inner_let_rec uu___ -> uu___ + Prims.exn -> (Prims.string * FStarC_Range_Type.range) Prims.list) = + fun projectee -> match projectee with | Inner_let_rec uu___ -> uu___ let add_fuel : 'uuuuu . 'uuuuu -> 'uuuuu Prims.list -> 'uuuuu Prims.list = fun x -> fun tl -> @@ -24,13 +24,13 @@ let vargs : (('uuuuu, 'uuuuu1) FStar_Pervasives.either * 'uuuuu2) Prims.list = fun args -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___ -> match uu___ with | (FStar_Pervasives.Inl uu___1, uu___2) -> false | uu___1 -> true) args let (escape : Prims.string -> Prims.string) = - fun s -> FStarC_Compiler_Util.replace_char s 39 95 + fun s -> FStarC_Util.replace_char s 39 95 let (mk_term_projector_name : FStarC_Ident.lident -> FStarC_Syntax_Syntax.bv -> Prims.string) = fun lid -> @@ -38,7 +38,7 @@ let (mk_term_projector_name : let uu___ = let uu___1 = FStarC_Ident.string_of_lid lid in let uu___2 = FStarC_Ident.string_of_id a.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Util.format2 "%s_%s" uu___1 uu___2 in + FStarC_Util.format2 "%s_%s" uu___1 uu___2 in escape uu___ let (primitive_projector_by_pos : FStarC_TypeChecker_Env.env -> @@ -50,7 +50,7 @@ let (primitive_projector_by_pos : let fail uu___ = let uu___1 = let uu___2 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Projector %s on data constructor %s not found" (Prims.string_of_int i) uu___2 in failwith uu___1 in @@ -70,10 +70,10 @@ let (primitive_projector_by_pos : | (binders, uu___4) -> if (i < Prims.int_zero) || - (i >= (FStarC_Compiler_List.length binders)) + (i >= (FStarC_List.length binders)) then fail () else - (let b = FStarC_Compiler_List.nth binders i in + (let b = FStarC_List.nth binders i in mk_term_projector_name lid b.FStarC_Syntax_Syntax.binder_bv)) | uu___3 -> fail ()) @@ -83,7 +83,7 @@ let (mk_term_projector_name_by_pos : fun i -> let uu___ = let uu___1 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format2 "%s_%s" uu___1 (Prims.string_of_int i) in + FStarC_Util.format2 "%s_%s" uu___1 (Prims.string_of_int i) in escape uu___ let (mk_term_projector : FStarC_Ident.lident -> @@ -195,32 +195,31 @@ let (__proj__Mkvarops_t__item__mk_unique : next_id; mk_unique;_} -> mk_unique let (varops : varops_t) = let initial_ctr = (Prims.of_int (100)) in - let ctr = FStarC_Compiler_Util.mk_ref initial_ctr in - let new_scope uu___ = FStarC_Compiler_Util.smap_create (Prims.of_int (100)) in + let ctr = FStarC_Util.mk_ref initial_ctr in + let new_scope uu___ = FStarC_Util.smap_create (Prims.of_int (100)) in let scopes = let uu___ = let uu___1 = new_scope () in [uu___1] in - FStarC_Compiler_Util.mk_ref uu___ in + FStarC_Util.mk_ref uu___ in let mk_unique y = let y1 = escape y in let y2 = let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang scopes in - FStarC_Compiler_Util.find_map uu___1 - (fun names -> FStarC_Compiler_Util.smap_try_find names y1) in + let uu___1 = FStarC_Effect.op_Bang scopes in + FStarC_Util.find_map uu___1 + (fun names -> FStarC_Util.smap_try_find names y1) in match uu___ with | FStar_Pervasives_Native.None -> y1 | FStar_Pervasives_Native.Some uu___1 -> - (FStarC_Compiler_Util.incr ctr; + (FStarC_Util.incr ctr; (let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang ctr in + let uu___5 = FStarC_Effect.op_Bang ctr in Prims.string_of_int uu___5 in Prims.strcat "__" uu___4 in Prims.strcat y1 uu___3)) in let top_scope = - let uu___ = FStarC_Compiler_Effect.op_Bang scopes in - FStarC_Compiler_List.hd uu___ in - FStarC_Compiler_Util.smap_add top_scope y2 true; y2 in + let uu___ = FStarC_Effect.op_Bang scopes in FStarC_List.hd uu___ in + FStarC_Util.smap_add top_scope y2 true; y2 in let new_var pp rn = let uu___ = let uu___1 = FStarC_Ident.string_of_id pp in @@ -228,23 +227,20 @@ let (varops : varops_t) = mk_unique uu___ in let new_fvar lid = let uu___ = FStarC_Ident.string_of_lid lid in mk_unique uu___ in - let next_id uu___ = - FStarC_Compiler_Util.incr ctr; FStarC_Compiler_Effect.op_Bang ctr in + let next_id uu___ = FStarC_Util.incr ctr; FStarC_Effect.op_Bang ctr in let fresh mname pfx = let uu___ = let uu___1 = next_id () in Prims.string_of_int uu___1 in - FStarC_Compiler_Util.format3 "%s_%s_%s" pfx mname uu___ in - let reset_fresh uu___ = - FStarC_Compiler_Effect.op_Colon_Equals ctr initial_ctr in + FStarC_Util.format3 "%s_%s_%s" pfx mname uu___ in + let reset_fresh uu___ = FStarC_Effect.op_Colon_Equals ctr initial_ctr in let push uu___ = let uu___1 = let uu___2 = new_scope () in - let uu___3 = FStarC_Compiler_Effect.op_Bang scopes in uu___2 :: uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals scopes uu___1 in + let uu___3 = FStarC_Effect.op_Bang scopes in uu___2 :: uu___3 in + FStarC_Effect.op_Colon_Equals scopes uu___1 in let pop uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang scopes in - FStarC_Compiler_List.tl uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals scopes uu___1 in + let uu___2 = FStarC_Effect.op_Bang scopes in FStarC_List.tl uu___2 in + FStarC_Effect.op_Colon_Equals scopes uu___1 in let snapshot uu___ = FStarC_Common.snapshot push scopes () in let rollback depth = FStarC_Common.rollback pop scopes depth in { @@ -321,34 +317,33 @@ let (fvb_to_string : fvar_binding -> Prims.string) = | FStar_Pervasives_Native.Some (s0, s1) -> let uu___1 = FStarC_SMTEncoding_Term.print_smt_term s0 in let uu___2 = FStarC_SMTEncoding_Term.print_smt_term s1 in - FStarC_Compiler_Util.format2 "(%s, %s)" uu___1 uu___2 in + FStarC_Util.format2 "(%s, %s)" uu___1 uu___2 in let uu___ = FStarC_Ident.string_of_lid fvb.fvar_lid in let uu___1 = term_opt_to_string fvb.smt_token in let uu___2 = term_pair_opt_to_string fvb.smt_fuel_partial_app in - let uu___3 = FStarC_Compiler_Util.string_of_bool fvb.fvb_thunked in - FStarC_Compiler_Util.format6 + let uu___3 = FStarC_Util.string_of_bool fvb.fvb_thunked in + FStarC_Util.format6 "{ lid = %s;\n smt_arity = %s;\n smt_id = %s;\n smt_token = %s;\n smt_fuel_partial_app = %s;\n fvb_thunked = %s }" uu___ (Prims.string_of_int fvb.smt_arity) fvb.smt_id uu___1 uu___2 uu___3 let (check_valid_fvb : fvar_binding -> unit) = fun fvb -> if - ((FStarC_Compiler_Option.isSome fvb.smt_token) || - (FStarC_Compiler_Option.isSome fvb.smt_fuel_partial_app)) + ((FStarC_Option.isSome fvb.smt_token) || + (FStarC_Option.isSome fvb.smt_fuel_partial_app)) && fvb.fvb_thunked then (let uu___1 = let uu___2 = FStarC_Ident.string_of_lid fvb.fvar_lid in - FStarC_Compiler_Util.format1 "Unexpected thunked SMT symbol: %s" - uu___2 in + FStarC_Util.format1 "Unexpected thunked SMT symbol: %s" uu___2 in failwith uu___1) else if fvb.fvb_thunked && (fvb.smt_arity <> Prims.int_zero) then (let uu___2 = let uu___3 = FStarC_Ident.string_of_lid fvb.fvar_lid in - FStarC_Compiler_Util.format1 - "Unexpected arity of thunked SMT symbol: %s" uu___3 in + FStarC_Util.format1 "Unexpected arity of thunked SMT symbol: %s" + uu___3 in failwith uu___2) else (); (match fvb.smt_token with @@ -359,7 +354,7 @@ let (check_valid_fvb : fvar_binding -> unit) = -> let uu___4 = let uu___5 = fvb_to_string fvb in - FStarC_Compiler_Util.format1 "bad fvb\n%s" uu___5 in + FStarC_Util.format1 "bad fvb\n%s" uu___5 in failwith uu___4 | uu___1 -> ()) let binder_of_eithervar : @@ -370,10 +365,9 @@ type env_t = { bvar_bindings: (FStarC_Syntax_Syntax.bv * FStarC_SMTEncoding_Term.term) - FStarC_Compiler_Util.pimap FStarC_Compiler_Util.psmap + FStarC_Util.pimap FStarC_Util.psmap ; - fvar_bindings: - (fvar_binding FStarC_Compiler_Util.psmap * fvar_binding Prims.list) ; + fvar_bindings: (fvar_binding FStarC_Util.psmap * fvar_binding Prims.list) ; depth: Prims.int ; tcenv: FStarC_TypeChecker_Env.env ; warn: Prims.bool ; @@ -382,11 +376,11 @@ type env_t = encode_non_total_function_typ: Prims.bool ; current_module_name: Prims.string ; encoding_quantifier: Prims.bool ; - global_cache: FStarC_SMTEncoding_Term.decls_elt FStarC_Compiler_Util.smap } + global_cache: FStarC_SMTEncoding_Term.decls_elt FStarC_Util.smap } let (__proj__Mkenv_t__item__bvar_bindings : env_t -> (FStarC_Syntax_Syntax.bv * FStarC_SMTEncoding_Term.term) - FStarC_Compiler_Util.pimap FStarC_Compiler_Util.psmap) + FStarC_Util.pimap FStarC_Util.psmap) = fun projectee -> match projectee with @@ -394,9 +388,7 @@ let (__proj__Mkenv_t__item__bvar_bindings : use_zfuel_name; encode_non_total_function_typ; current_module_name; encoding_quantifier; global_cache;_} -> bvar_bindings let (__proj__Mkenv_t__item__fvar_bindings : - env_t -> - (fvar_binding FStarC_Compiler_Util.psmap * fvar_binding Prims.list)) - = + env_t -> (fvar_binding FStarC_Util.psmap * fvar_binding Prims.list)) = fun projectee -> match projectee with | { bvar_bindings; fvar_bindings; depth; tcenv; warn; nolabels; @@ -452,7 +444,7 @@ let (__proj__Mkenv_t__item__encoding_quantifier : env_t -> Prims.bool) = use_zfuel_name; encode_non_total_function_typ; current_module_name; encoding_quantifier; global_cache;_} -> encoding_quantifier let (__proj__Mkenv_t__item__global_cache : - env_t -> FStarC_SMTEncoding_Term.decls_elt FStarC_Compiler_Util.smap) = + env_t -> FStarC_SMTEncoding_Term.decls_elt FStarC_Util.smap) = fun projectee -> match projectee with | { bvar_bindings; fvar_bindings; depth; tcenv; warn; nolabels; @@ -461,11 +453,11 @@ let (__proj__Mkenv_t__item__global_cache : let (print_env : env_t -> Prims.string) = fun e -> let bvars = - FStarC_Compiler_Util.psmap_fold e.bvar_bindings + FStarC_Util.psmap_fold e.bvar_bindings (fun _k -> fun pi -> fun acc -> - FStarC_Compiler_Util.pimap_fold pi + FStarC_Util.pimap_fold pi (fun _i -> fun uu___ -> fun acc1 -> @@ -476,16 +468,15 @@ let (print_env : env_t -> Prims.string) = FStarC_Syntax_Print.showable_bv x in uu___1 :: acc1) acc) [] in let allvars = - FStarC_Compiler_Util.psmap_fold - (FStar_Pervasives_Native.fst e.fvar_bindings) + FStarC_Util.psmap_fold (FStar_Pervasives_Native.fst e.fvar_bindings) (fun _k -> fun fvb -> fun acc -> (fvb.fvar_lid) :: acc) [] in let last_fvar = - match FStarC_Compiler_List.rev allvars with + match FStarC_List.rev allvars with | [] -> "" | l::uu___ -> let uu___1 = FStarC_Class_Show.show FStarC_Ident.showable_lident l in Prims.strcat "...," uu___1 in - FStarC_Compiler_String.concat ", " (last_fvar :: bvars) + FStarC_String.concat ", " (last_fvar :: bvars) let (lookup_bvar_binding : env_t -> FStarC_Syntax_Syntax.bv -> @@ -496,11 +487,10 @@ let (lookup_bvar_binding : fun bv -> let uu___ = let uu___1 = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Util.psmap_try_find env.bvar_bindings uu___1 in + FStarC_Util.psmap_try_find env.bvar_bindings uu___1 in match uu___ with | FStar_Pervasives_Native.Some bvs -> - FStarC_Compiler_Util.pimap_try_find bvs - bv.FStarC_Syntax_Syntax.index + FStarC_Util.pimap_try_find bvs bv.FStarC_Syntax_Syntax.index | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None let (lookup_fvar_binding : env_t -> FStarC_Ident.lident -> fvar_binding FStar_Pervasives_Native.option) @@ -508,32 +498,32 @@ let (lookup_fvar_binding : fun env -> fun lid -> let uu___ = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.psmap_try_find + FStarC_Util.psmap_try_find (FStar_Pervasives_Native.fst env.fvar_bindings) uu___ let add_bvar_binding : 'uuuuu . (FStarC_Syntax_Syntax.bv * 'uuuuu) -> - (FStarC_Syntax_Syntax.bv * 'uuuuu) FStarC_Compiler_Util.pimap - FStarC_Compiler_Util.psmap -> - (FStarC_Syntax_Syntax.bv * 'uuuuu) FStarC_Compiler_Util.pimap - FStarC_Compiler_Util.psmap + (FStarC_Syntax_Syntax.bv * 'uuuuu) FStarC_Util.pimap FStarC_Util.psmap + -> + (FStarC_Syntax_Syntax.bv * 'uuuuu) FStarC_Util.pimap + FStarC_Util.psmap = fun bvb -> fun bvbs -> let uu___ = FStarC_Ident.string_of_id (FStar_Pervasives_Native.fst bvb).FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Util.psmap_modify bvbs uu___ + FStarC_Util.psmap_modify bvbs uu___ (fun pimap_opt -> let uu___1 = - let uu___2 = FStarC_Compiler_Util.pimap_empty () in - FStarC_Compiler_Util.dflt uu___2 pimap_opt in - FStarC_Compiler_Util.pimap_add uu___1 + let uu___2 = FStarC_Util.pimap_empty () in + FStarC_Util.dflt uu___2 pimap_opt in + FStarC_Util.pimap_add uu___1 (FStar_Pervasives_Native.fst bvb).FStarC_Syntax_Syntax.index bvb) let (add_fvar_binding : fvar_binding -> - (fvar_binding FStarC_Compiler_Util.psmap * fvar_binding Prims.list) -> - (fvar_binding FStarC_Compiler_Util.psmap * fvar_binding Prims.list)) + (fvar_binding FStarC_Util.psmap * fvar_binding Prims.list) -> + (fvar_binding FStarC_Util.psmap * fvar_binding Prims.list)) = fun fvb -> fun uu___ -> @@ -541,7 +531,7 @@ let (add_fvar_binding : | (fvb_map, fvb_list) -> let uu___1 = let uu___2 = FStarC_Ident.string_of_lid fvb.fvar_lid in - FStarC_Compiler_Util.psmap_add fvb_map uu___2 fvb in + FStarC_Util.psmap_add fvb_map uu___2 fvb in (uu___1, (fvb :: fvb_list)) let (fresh_fvar : Prims.string -> @@ -676,7 +666,7 @@ let (lookup_term_var : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv a in let uu___3 = print_env env in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Bound term variable not found %s in environment: %s" uu___2 uu___3 in failwith uu___1 @@ -757,7 +747,7 @@ let (new_term_constant_and_tok_from_lid : let uu___ = new_term_constant_and_tok_from_lid_aux env x arity false in match uu___ with | (fname, ftok_name_opt, env1) -> - let uu___1 = FStarC_Compiler_Option.get ftok_name_opt in + let uu___1 = FStarC_Option.get ftok_name_opt in (fname, uu___1, env1) let (new_term_constant_and_tok_from_lid_maybe_thunked : env_t -> @@ -780,23 +770,23 @@ let fail_fvar_lookup : 'uuuuu . env_t -> FStarC_Ident.lident -> 'uuuuu = let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Ident.showable_lident a in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Name %s not found in the smtencoding and typechecker env" uu___1 in failwith uu___ | uu___ -> let quals = FStarC_TypeChecker_Env.quals_of_qninfo q in let uu___1 = - (FStarC_Compiler_Util.is_some quals) && - (let uu___2 = FStarC_Compiler_Util.must quals in - FStarC_Compiler_List.contains + (FStarC_Util.is_some quals) && + (let uu___2 = FStarC_Util.must quals in + FStarC_List.contains FStarC_Syntax_Syntax.Unfold_for_unification_and_vcgen uu___2) in if uu___1 then let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident a in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Name %s not found in the smtencoding env (the symbol is marked unfold, expected it to reduce)" uu___3 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident a @@ -807,8 +797,8 @@ let fail_fvar_lookup : 'uuuuu . env_t -> FStarC_Ident.lident -> 'uuuuu = (let uu___3 = let uu___4 = FStarC_Class_Show.show FStarC_Ident.showable_lident a in - FStarC_Compiler_Util.format1 - "Name %s not found in the smtencoding env" uu___4 in + FStarC_Util.format1 "Name %s not found in the smtencoding env" + uu___4 in failwith uu___3) let (lookup_lid : env_t -> FStarC_Ident.lident -> fvar_binding) = fun env -> @@ -935,13 +925,12 @@ let (try_lookup_free_var : match uu___ with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some fvb -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_PartialApp in + ((let uu___2 = FStarC_Effect.op_Bang dbg_PartialApp in if uu___2 then let uu___3 = FStarC_Ident.string_of_lid l in let uu___4 = fvb_to_string fvb in - FStarC_Compiler_Util.print2 "Looked up %s found\n%s\n" uu___3 - uu___4 + FStarC_Util.print2 "Looked up %s found\n%s\n" uu___3 uu___4 else ()); if fvb.fvb_thunked then @@ -961,7 +950,7 @@ let (try_lookup_free_var : let uu___7 = FStarC_SMTEncoding_Term.fv_of_term fuel in FStarC_SMTEncoding_Term.fv_name uu___7 in - FStarC_Compiler_Util.starts_with uu___6 "fuel" in + FStarC_Util.starts_with uu___6 "fuel" in if uu___5 then let uu___6 = @@ -1039,7 +1028,7 @@ let (tok_of_name : fun env -> fun nm -> let uu___ = - FStarC_Compiler_Util.psmap_find_map + FStarC_Util.psmap_find_map (FStar_Pervasives_Native.fst env.fvar_bindings) (fun uu___1 -> fun fvb -> @@ -1050,10 +1039,10 @@ let (tok_of_name : match uu___ with | FStar_Pervasives_Native.Some b -> FStar_Pervasives_Native.Some b | FStar_Pervasives_Native.None -> - FStarC_Compiler_Util.psmap_find_map env.bvar_bindings + FStarC_Util.psmap_find_map env.bvar_bindings (fun uu___1 -> fun pi -> - FStarC_Compiler_Util.pimap_fold pi + FStarC_Util.pimap_fold pi (fun uu___2 -> fun y -> fun res -> diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_ErrorReporting.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_ErrorReporting.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_ErrorReporting.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_ErrorReporting.ml index b858a5bbe14..b001fe32699 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_ErrorReporting.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_ErrorReporting.ml @@ -12,47 +12,46 @@ let (__proj__Not_a_wp_implication__item__uu___ : Prims.exn -> Prims.string) = let (sort_labels : (FStarC_SMTEncoding_Term.error_label * Prims.bool) Prims.list -> ((FStarC_SMTEncoding_Term.fv * FStarC_Errors_Msg.error_message * - FStarC_Compiler_Range_Type.range) * Prims.bool) Prims.list) + FStarC_Range_Type.range) * Prims.bool) Prims.list) = fun l -> - FStarC_Compiler_List.sortWith + FStarC_List.sortWith (fun uu___ -> fun uu___1 -> match (uu___, uu___1) with | (((uu___2, uu___3, r1), uu___4), ((uu___5, uu___6, r2), uu___7)) - -> FStarC_Compiler_Range_Ops.compare r1 r2) l + -> FStarC_Range_Ops.compare r1 r2) l let (remove_dups : labels -> (FStarC_SMTEncoding_Term.fv * FStarC_Errors_Msg.error_message * - FStarC_Compiler_Range_Type.range) Prims.list) + FStarC_Range_Type.range) Prims.list) = fun l -> - FStarC_Compiler_Util.remove_dups + FStarC_Util.remove_dups (fun uu___ -> fun uu___1 -> match (uu___, uu___1) with | ((uu___2, m1, r1), (uu___3, m2, r2)) -> (r1 = r2) && (m1 = m2)) l -type msg = (Prims.string * FStarC_Compiler_Range_Type.range) +type msg = (Prims.string * FStarC_Range_Type.range) type ranges = - (Prims.string FStar_Pervasives_Native.option * - FStarC_Compiler_Range_Type.range) Prims.list -let (__ctr : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero + (Prims.string FStar_Pervasives_Native.option * FStarC_Range_Type.range) + Prims.list +let (__ctr : Prims.int FStarC_Effect.ref) = FStarC_Util.mk_ref Prims.int_zero let (fresh_label : FStarC_Errors_Msg.error_message -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_SMTEncoding_Term.term -> (label * FStarC_SMTEncoding_Term.term)) = fun message -> fun range -> fun t -> let l = - FStarC_Compiler_Util.incr __ctr; + FStarC_Util.incr __ctr; (let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang __ctr in - FStarC_Compiler_Util.string_of_int uu___2 in - FStarC_Compiler_Util.format1 "label_%s" uu___1) in + let uu___2 = FStarC_Effect.op_Bang __ctr in + FStarC_Util.string_of_int uu___2 in + FStarC_Util.format1 "label_%s" uu___1) in let lvar = FStarC_SMTEncoding_Term.mk_fv (l, FStarC_SMTEncoding_Term.Bool_sort) in @@ -62,7 +61,7 @@ let (fresh_label : (label1, lt) let (label_goals : (unit -> Prims.string) FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_SMTEncoding_Term.term -> (labels * FStarC_SMTEncoding_Term.term)) = fun use_env_msg -> @@ -104,7 +103,7 @@ let (label_goals : -> true | uu___ -> false in let is_a_named_continuation lhs = - FStarC_Compiler_Util.for_some is_guard_free (conjuncts lhs) in + FStarC_Util.for_some is_guard_free (conjuncts lhs) in let uu___ = match use_env_msg with | FStar_Pervasives_Native.None -> (false, FStarC_Pprint.empty) @@ -130,14 +129,14 @@ let (label_goals : | FStar_Pervasives_Native.None -> rng | FStar_Pervasives_Native.Some r1 -> let uu___1 = - let uu___2 = FStarC_Compiler_Range_Type.use_range rng in - let uu___3 = FStarC_Compiler_Range_Type.use_range r1 in - FStarC_Compiler_Range_Ops.rng_included uu___2 uu___3 in + let uu___2 = FStarC_Range_Type.use_range rng in + let uu___3 = FStarC_Range_Type.use_range r1 in + FStarC_Range_Ops.rng_included uu___2 uu___3 in if uu___1 then rng else - (let uu___3 = FStarC_Compiler_Range_Type.def_range rng in - FStarC_Compiler_Range_Type.set_def_range r1 uu___3) in + (let uu___3 = FStarC_Range_Type.def_range rng in + FStarC_Range_Type.set_def_range r1 uu___3) in fresh_label msg2 rng1 t in let rec aux default_msg ropt post_name_opt labels1 q1 = match q1.FStarC_SMTEncoding_Term.tm with @@ -174,22 +173,21 @@ let (label_goals : let post_name = let uu___3 = let uu___4 = FStarC_GenSym.next_id () in - FStarC_Compiler_Util.string_of_int - uu___4 in + FStarC_Util.string_of_int uu___4 in Prims.strcat "^^post_condition_" uu___3 in let names = let uu___3 = FStarC_SMTEncoding_Term.mk_fv (post_name, post) in let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun s -> let uu___5 = let uu___6 = let uu___7 = let uu___8 = FStarC_GenSym.next_id () in - FStarC_Compiler_Util.string_of_int + FStarC_Util.string_of_int uu___8 in Prims.strcat "^^" uu___7 in (uu___6, s) in @@ -197,7 +195,7 @@ let (label_goals : uu___5) sorts in uu___3 :: uu___4 in let instantiation = - FStarC_Compiler_List.map + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV names in let uu___3 = let uu___4 = @@ -217,8 +215,7 @@ let (label_goals : clauses_lhs) -> let uu___5 = - FStarC_Compiler_Util.prefix - clauses_lhs in + FStarC_Util.prefix clauses_lhs in (match uu___5 with | (req, ens) -> (match ens.FStarC_SMTEncoding_Term.tm @@ -293,7 +290,7 @@ let (label_goals : FStarC_SMTEncoding_Term.mk (FStarC_SMTEncoding_Term.App (FStarC_SMTEncoding_Term.And, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At req [ens1]))) lhs1.FStarC_SMTEncoding_Term.rng in @@ -322,7 +319,7 @@ let (label_goals : uu___11 in Not_a_wp_implication uu___10 in - FStarC_Compiler_Effect.raise + FStarC_Effect.raise uu___9) | uu___6 -> let uu___7 = @@ -343,7 +340,7 @@ let (label_goals : uu___9 in Not_a_wp_implication uu___8 in - FStarC_Compiler_Effect.raise + FStarC_Effect.raise uu___7)) | uu___5 -> let uu___6 = @@ -355,8 +352,7 @@ let (label_goals : "LHS not a conjunct: " uu___8 in Not_a_wp_implication uu___7 in - FStarC_Compiler_Effect.raise - uu___6 in + FStarC_Effect.raise uu___6 in (match uu___4 with | (labels2, lhs2) -> let uu___5 = @@ -398,24 +394,23 @@ let (label_goals : FStarC_SMTEncoding_Term.freevars = uu___1; FStarC_SMTEncoding_Term.rng = rng;_}) when is_a_named_continuation lhs -> - let uu___2 = FStarC_Compiler_Util.prefix sorts in + let uu___2 = FStarC_Util.prefix sorts in (match uu___2 with | (sorts', post) -> let new_post_name = let uu___3 = let uu___4 = FStarC_GenSym.next_id () in - FStarC_Compiler_Util.string_of_int uu___4 in + FStarC_Util.string_of_int uu___4 in Prims.strcat "^^post_condition_" uu___3 in let names = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun s -> let uu___4 = let uu___5 = let uu___6 = let uu___7 = FStarC_GenSym.next_id () in - FStarC_Compiler_Util.string_of_int - uu___7 in + FStarC_Util.string_of_int uu___7 in Prims.strcat "^^" uu___6 in (uu___5, s) in FStarC_SMTEncoding_Term.mk_fv uu___4) sorts' in @@ -424,10 +419,10 @@ let (label_goals : FStarC_SMTEncoding_Term.mk_fv (new_post_name, post) in [uu___5] in - FStarC_Compiler_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___3 uu___4 in let instantiation = - FStarC_Compiler_List.map - FStarC_SMTEncoding_Util.mkFreeV names in + FStarC_List.map FStarC_SMTEncoding_Util.mkFreeV + names in let uu___3 = let uu___4 = FStarC_SMTEncoding_Term.inst instantiation lhs in @@ -437,7 +432,7 @@ let (label_goals : (match uu___3 with | (lhs1, rhs1) -> let uu___4 = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun labels2 -> fun tm -> match tm.FStarC_SMTEncoding_Term.tm with @@ -538,8 +533,8 @@ let (label_goals : | FStarC_SMTEncoding_Term.App (FStarC_SMTEncoding_Term.And, conjuncts1) -> let uu___1 = - FStarC_Compiler_Util.fold_map - (aux default_msg ropt post_name_opt) labels1 conjuncts1 in + FStarC_Util.fold_map (aux default_msg ropt post_name_opt) + labels1 conjuncts1 in (match uu___1 with | (labels2, conjuncts2) -> let uu___2 = @@ -738,7 +733,7 @@ let (label_goals : FStarC_SMTEncoding_Term.mkLet (es, body1) q1.FStarC_SMTEncoding_Term.rng in (labels2, uu___2)) in - (FStarC_Compiler_Effect.op_Colon_Equals __ctr Prims.int_zero; + (FStarC_Effect.op_Colon_Equals __ctr Prims.int_zero; (let uu___2 = FStarC_Errors_Msg.mkmsg "Assertion failed" in aux uu___2 FStar_Pervasives_Native.None FStar_Pervasives_Native.None [] q)) @@ -758,24 +753,22 @@ let (detail_errors : let msg1 = let uu___1 = let uu___2 = FStarC_TypeChecker_Env.get_range env in - FStarC_Compiler_Range_Ops.string_of_range uu___2 in - let uu___2 = - FStarC_Compiler_Util.string_of_int (Prims.of_int (5)) in + FStarC_Range_Ops.string_of_range uu___2 in + let uu___2 = FStarC_Util.string_of_int (Prims.of_int (5)) in let uu___3 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length all_labels) in - FStarC_Compiler_Util.format4 + FStarC_Util.string_of_int (FStarC_List.length all_labels) in + FStarC_Util.format4 "Detailed %s report follows for %s\nTaking %s seconds per proof obligation (%s proofs in total)\n" (if hint_replay then "hint replay" else "error") uu___1 uu___2 uu___3 in - FStarC_Compiler_Util.print_error msg1 in + FStarC_Util.print_error msg1 in let print_result uu___ = match uu___ with | ((uu___1, msg1, r), success) -> if success then - let uu___2 = FStarC_Compiler_Range_Ops.string_of_range r in - FStarC_Compiler_Util.print1 + let uu___2 = FStarC_Range_Ops.string_of_range r in + FStarC_Util.print1 "OK: proof obligation at %s was proven in isolation\n" uu___2 else @@ -798,19 +791,19 @@ let (detail_errors : let uu___7 = let uu___8 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range r in - FStarC_Compiler_Util.format1 + FStarC_Range_Ops.showable_range r in + FStarC_Util.format1 "XX: proof obligation at %s failed." uu___8 in FStarC_Errors_Msg.text uu___7 in [uu___6] in - FStarC_Compiler_List.op_At uu___5 msg1 in + FStarC_List.op_At uu___5 msg1 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Error_ProofObligationFailed () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___4)) in let elim labs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (l, uu___1, uu___2) -> @@ -848,20 +841,18 @@ let (detail_errors : | [] -> let results = let uu___1 = - FStarC_Compiler_List.map (fun x -> (x, true)) eliminated in - let uu___2 = - FStarC_Compiler_List.map (fun x -> (x, false)) errors in - FStarC_Compiler_List.op_At uu___1 uu___2 in + FStarC_List.map (fun x -> (x, true)) eliminated in + let uu___2 = FStarC_List.map (fun x -> (x, false)) errors in + FStarC_List.op_At uu___1 uu___2 in sort_labels results | hd::tl -> ((let uu___2 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length active) in - FStarC_Compiler_Util.print1 "%s, " uu___2); + FStarC_Util.string_of_int (FStarC_List.length active) in + FStarC_Util.print1 "%s, " uu___2); (let decls = elim - (FStarC_Compiler_List.op_At eliminated - (FStarC_Compiler_List.op_At errors tl)) in + (FStarC_List.op_At eliminated + (FStarC_List.op_At errors tl)) in let result = askZ3 decls in match result.FStarC_SMTEncoding_Z3.z3result_status with | FStarC_SMTEncoding_Z3.UNSAT uu___2 -> @@ -871,12 +862,11 @@ let (detail_errors : FStarC_Options.set_option "z3rlimit" (FStarC_Options.Int (Prims.of_int (5))); (let res = linear_check [] [] all_labels in - FStarC_Compiler_Util.print_string "\n"; - FStarC_Compiler_List.iter print_result res; - (let uu___4 = - FStarC_Compiler_Util.for_all FStar_Pervasives_Native.snd res in + FStarC_Util.print_string "\n"; + FStarC_List.iter print_result res; + (let uu___4 = FStarC_Util.for_all FStar_Pervasives_Native.snd res in if uu___4 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "Failed: the heuristic of trying each proof in isolation failed to identify a precise error\n" else ())) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Pruning.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Pruning.ml similarity index 84% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_Pruning.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Pruning.ml index e944bc5ac95..409f98d3595 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Pruning.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Pruning.ml @@ -1,34 +1,33 @@ open Prims type triggers = Prims.string Prims.list Prims.list -type triggers_set = Prims.string FStarC_Compiler_RBSet.t Prims.list +type triggers_set = Prims.string FStarC_RBSet.t Prims.list let (triggers_as_triggers_set : triggers -> triggers_set) = fun ts -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> (Obj.magic (FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)))) uu___) ts + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)))) + uu___) ts type pruning_state = { - macro_freenames: Prims.string Prims.list FStarC_Compiler_Util.psmap ; + macro_freenames: Prims.string Prims.list FStarC_Util.psmap ; trigger_to_assumption: - FStarC_SMTEncoding_Term.assumption Prims.list FStarC_Compiler_Util.psmap ; - assumption_to_triggers: triggers_set FStarC_Compiler_Util.psmap ; - assumption_name_map: - FStarC_SMTEncoding_Term.decl FStarC_Compiler_Util.psmap ; + FStarC_SMTEncoding_Term.assumption Prims.list FStarC_Util.psmap ; + assumption_to_triggers: triggers_set FStarC_Util.psmap ; + assumption_name_map: FStarC_SMTEncoding_Term.decl FStarC_Util.psmap ; ambients: Prims.string Prims.list ; extra_roots: FStarC_SMTEncoding_Term.assumption Prims.list } let (__proj__Mkpruning_state__item__macro_freenames : - pruning_state -> Prims.string Prims.list FStarC_Compiler_Util.psmap) = + pruning_state -> Prims.string Prims.list FStarC_Util.psmap) = fun projectee -> match projectee with | { macro_freenames; trigger_to_assumption; assumption_to_triggers; assumption_name_map; ambients; extra_roots;_} -> macro_freenames let (__proj__Mkpruning_state__item__trigger_to_assumption : pruning_state -> - FStarC_SMTEncoding_Term.assumption Prims.list FStarC_Compiler_Util.psmap) + FStarC_SMTEncoding_Term.assumption Prims.list FStarC_Util.psmap) = fun projectee -> match projectee with @@ -36,14 +35,14 @@ let (__proj__Mkpruning_state__item__trigger_to_assumption : assumption_name_map; ambients; extra_roots;_} -> trigger_to_assumption let (__proj__Mkpruning_state__item__assumption_to_triggers : - pruning_state -> triggers_set FStarC_Compiler_Util.psmap) = + pruning_state -> triggers_set FStarC_Util.psmap) = fun projectee -> match projectee with | { macro_freenames; trigger_to_assumption; assumption_to_triggers; assumption_name_map; ambients; extra_roots;_} -> assumption_to_triggers let (__proj__Mkpruning_state__item__assumption_name_map : - pruning_state -> FStarC_SMTEncoding_Term.decl FStarC_Compiler_Util.psmap) = + pruning_state -> FStarC_SMTEncoding_Term.decl FStarC_Util.psmap) = fun projectee -> match projectee with | { macro_freenames; trigger_to_assumption; assumption_to_triggers; @@ -62,25 +61,21 @@ let (__proj__Mkpruning_state__item__extra_roots : assumption_name_map; ambients; extra_roots;_} -> extra_roots let (debug : (unit -> unit) -> unit) = fun f -> - let uu___ = - let uu___1 = FStarC_Options_Ext.get "debug_context_pruning" in - uu___1 <> "" in + let uu___ = FStarC_Options_Ext.enabled "debug_context_pruning" in if uu___ then f () else () let (print_pruning_state : pruning_state -> Prims.string) = fun p -> let t_to_a = - FStarC_Compiler_Util.psmap_fold p.trigger_to_assumption - (fun k -> - fun v -> fun acc -> (k, (FStarC_Compiler_List.length v)) :: acc) - [] in + FStarC_Util.psmap_fold p.trigger_to_assumption + (fun k -> fun v -> fun acc -> (k, (FStarC_List.length v)) :: acc) [] in let t_to_a1 = - FStarC_Compiler_Util.sort_with + FStarC_Util.sort_with (fun x -> fun y -> (FStar_Pervasives_Native.snd x) - (FStar_Pervasives_Native.snd y)) t_to_a in let a_to_t = - FStarC_Compiler_Util.psmap_fold p.assumption_to_triggers + FStarC_Util.psmap_fold p.assumption_to_triggers (fun k -> fun v -> fun acc -> @@ -88,12 +83,12 @@ let (print_pruning_state : pruning_state -> Prims.string) = let uu___1 = FStarC_Class_Show.show (FStarC_Class_Show.show_list - (FStarC_Compiler_RBSet.showable_rbset + (FStarC_RBSet.showable_rbset FStarC_Class_Show.showable_string)) v in - FStarC_Compiler_Util.format2 "[%s -> %s]" k uu___1 in + FStarC_Util.format2 "[%s -> %s]" k uu___1 in uu___ :: acc) [] in let macros = - FStarC_Compiler_Util.psmap_fold p.macro_freenames + FStarC_Util.psmap_fold p.macro_freenames (fun k -> fun v -> fun acc -> @@ -102,26 +97,26 @@ let (print_pruning_state : pruning_state -> Prims.string) = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Class_Show.showable_string) v in - FStarC_Compiler_Util.format2 "[%s -> %s]" k uu___1 in + FStarC_Util.format2 "[%s -> %s]" k uu___1 in uu___ :: acc) [] in let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show (FStarC_Class_Show.show_tuple2 FStarC_Class_Show.showable_string FStarC_Class_Show.showable_int)) t_to_a1 in - FStarC_Compiler_String.concat "\n\t" uu___1 in - FStarC_Compiler_Util.format3 + FStarC_String.concat "\n\t" uu___1 in + FStarC_Util.format3 "Pruning state:\n\tTriggers to assumptions:\n\t%s\nAssumptions to triggers:\n\t%s\nMacros:\n\t%s\n" - uu___ (FStarC_Compiler_String.concat "\n\t" a_to_t) - (FStarC_Compiler_String.concat "\n\t" macros) + uu___ (FStarC_String.concat "\n\t" a_to_t) + (FStarC_String.concat "\n\t" macros) let (show_pruning_state : pruning_state FStarC_Class_Show.showable) = { FStarC_Class_Show.show = print_pruning_state } let (init : pruning_state) = - let uu___ = FStarC_Compiler_Util.psmap_empty () in - let uu___1 = FStarC_Compiler_Util.psmap_empty () in - let uu___2 = FStarC_Compiler_Util.psmap_empty () in - let uu___3 = FStarC_Compiler_Util.psmap_empty () in + let uu___ = FStarC_Util.psmap_empty () in + let uu___1 = FStarC_Util.psmap_empty () in + let uu___2 = FStarC_Util.psmap_empty () in + let uu___3 = FStarC_Util.psmap_empty () in { macro_freenames = uu___; trigger_to_assumption = uu___1; @@ -137,12 +132,11 @@ let (add_trigger_to_assumption : fun a -> fun p -> fun trig -> - let uu___ = - FStarC_Compiler_Util.psmap_try_find p.trigger_to_assumption trig in + let uu___ = FStarC_Util.psmap_try_find p.trigger_to_assumption trig in match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.psmap_add p.trigger_to_assumption trig [a] in + FStarC_Util.psmap_add p.trigger_to_assumption trig [a] in { macro_freenames = (p.macro_freenames); trigger_to_assumption = uu___1; @@ -153,8 +147,7 @@ let (add_trigger_to_assumption : } | FStar_Pervasives_Native.Some l -> let uu___1 = - FStarC_Compiler_Util.psmap_add p.trigger_to_assumption trig (a - :: l) in + FStarC_Util.psmap_add p.trigger_to_assumption trig (a :: l) in { macro_freenames = (p.macro_freenames); trigger_to_assumption = uu___1; @@ -163,11 +156,10 @@ let (add_trigger_to_assumption : ambients = (p.ambients); extra_roots = (p.extra_roots) } -let (exclude_names : Prims.string FStarC_Compiler_RBSet.t) = +let (exclude_names : Prims.string FStarC_RBSet.t) = Obj.magic (FStarC_Class_Setlike.from_list () - (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) + (Obj.magic (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) ["SFuel"; "ZFuel"; "HasType"; @@ -178,26 +170,23 @@ let (exclude_names : Prims.string FStarC_Compiler_RBSet.t) = "ApplyTF"; "Prims.lex_t"]) let (free_top_level_names : - FStarC_SMTEncoding_Term.term -> Prims.string FStarC_Compiler_RBSet.t) = + FStarC_SMTEncoding_Term.term -> Prims.string FStarC_RBSet.t) = fun uu___ -> (fun t -> let uu___ = FStarC_SMTEncoding_Term.free_top_level_names t in Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) (Obj.magic uu___) - (Obj.magic exclude_names))) uu___ + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) + (Obj.magic uu___) (Obj.magic exclude_names))) uu___ let (assumption_free_names : - FStarC_SMTEncoding_Term.assumption -> Prims.string FStarC_Compiler_RBSet.t) - = + FStarC_SMTEncoding_Term.assumption -> Prims.string FStarC_RBSet.t) = fun uu___ -> (fun a -> Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) (Obj.magic a.FStarC_SMTEncoding_Term.assumption_free_names) (Obj.magic exclude_names))) uu___ let (triggers_of_term : FStarC_SMTEncoding_Term.term -> triggers_set) = @@ -207,15 +196,15 @@ let (triggers_of_term : FStarC_SMTEncoding_Term.term -> triggers_set) = | FStarC_SMTEncoding_Term.Quant (FStarC_SMTEncoding_Term.Forall, triggers1, uu___, uu___1, uu___2) -> - FStarC_Compiler_List.map + FStarC_List.map (fun disjunct -> let uu___3 = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) ()) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___5 -> fun uu___4 -> (fun out -> @@ -224,7 +213,7 @@ let (triggers_of_term : FStarC_SMTEncoding_Term.term -> triggers_set) = Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) (Obj.magic out) (Obj.magic uu___4))) uu___5 uu___4) uu___3 disjunct) triggers1 @@ -239,7 +228,7 @@ let (maybe_add_ambient : let add_assumption_with_triggers triggers1 = let p1 = let uu___ = - FStarC_Compiler_Util.psmap_add p.assumption_to_triggers + FStarC_Util.psmap_add p.assumption_to_triggers a.FStarC_SMTEncoding_Term.assumption_name triggers1 in { macro_freenames = (p.macro_freenames); @@ -250,24 +239,23 @@ let (maybe_add_ambient : extra_roots = (p.extra_roots) } in let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> (Obj.magic (FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)))) uu___1) triggers1 in - FStarC_Compiler_List.fold_left - (FStarC_Compiler_List.fold_left (add_trigger_to_assumption a)) p1 - uu___ in + FStarC_List.fold_left + (FStarC_List.fold_left (add_trigger_to_assumption a)) p1 uu___ in let is_empty triggers1 = match triggers1 with | [] -> true | t::[] -> FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) (Obj.magic t) + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) + (Obj.magic t) | uu___ -> false in let is_ambient_refinement ty = match ty.FStarC_SMTEncoding_Term.tm with @@ -275,10 +263,10 @@ let (maybe_add_ambient : (FStarC_SMTEncoding_Term.Var "Prims.squash", uu___) -> true | FStarC_SMTEncoding_Term.App (FStarC_SMTEncoding_Term.Var name, uu___) -> - FStarC_Compiler_Util.starts_with name "Tm_refine_" + FStarC_Util.starts_with name "Tm_refine_" | FStarC_SMTEncoding_Term.FreeV (FStarC_SMTEncoding_Term.FV (name, uu___, uu___1)) -> - FStarC_Compiler_Util.starts_with name "Tm_refine_" + FStarC_Util.starts_with name "Tm_refine_" | uu___ -> false in let ambient_refinement_payload ty = match ty.FStarC_SMTEncoding_Term.tm with @@ -303,13 +291,13 @@ let (maybe_add_ambient : with | FStarC_SMTEncoding_Term.App (FStarC_SMTEncoding_Term.Iff, t0::t1::[]) when - FStarC_Compiler_Util.starts_with + FStarC_Util.starts_with a.FStarC_SMTEncoding_Term.assumption_name "l_quant_interp" -> let triggers_lhs = free_top_level_names t0 in add_assumption_with_triggers [triggers_lhs] | uu___ when - FStarC_Compiler_Util.starts_with + FStarC_Util.starts_with a.FStarC_SMTEncoding_Term.assumption_name "assumption_" -> let triggers1 = @@ -360,25 +348,24 @@ let (maybe_add_ambient : match term.FStarC_SMTEncoding_Term.tm with | FStarC_SMTEncoding_Term.FreeV (FStarC_SMTEncoding_Term.FV (token, uu___6, uu___7)) -> - if FStarC_Compiler_Util.ends_with token "@tok" + if FStarC_Util.ends_with token "@tok" then let uu___8 = Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) token) in let uu___9 = let uu___10 = let uu___11 = - FStarC_Compiler_Util.substring token - Prims.int_zero - ((FStarC_Compiler_String.length token) - + FStarC_Util.substring token Prims.int_zero + ((FStarC_String.length token) - (Prims.of_int (4))) in Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) uu___11) in [uu___10] in uu___8 :: uu___9 @@ -387,30 +374,29 @@ let (maybe_add_ambient : Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) token) in [uu___9]) | FStarC_SMTEncoding_Term.App (FStarC_SMTEncoding_Term.Var token, []) -> - if FStarC_Compiler_Util.ends_with token "@tok" + if FStarC_Util.ends_with token "@tok" then let uu___6 = Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) token) in let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Util.substring token - Prims.int_zero - ((FStarC_Compiler_String.length token) - + FStarC_Util.substring token Prims.int_zero + ((FStarC_String.length token) - (Prims.of_int (4))) in Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) uu___9) in [uu___8] in uu___6 :: uu___7 @@ -419,7 +405,7 @@ let (maybe_add_ambient : Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) token) in [uu___7]) | uu___6 -> [] in @@ -442,25 +428,24 @@ let (maybe_add_ambient : match term.FStarC_SMTEncoding_Term.tm with | FStarC_SMTEncoding_Term.FreeV (FStarC_SMTEncoding_Term.FV (token, uu___5, uu___6)) -> - if FStarC_Compiler_Util.ends_with token "@tok" + if FStarC_Util.ends_with token "@tok" then let uu___7 = Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) token) in let uu___8 = let uu___9 = let uu___10 = - FStarC_Compiler_Util.substring token - Prims.int_zero - ((FStarC_Compiler_String.length token) - + FStarC_Util.substring token Prims.int_zero + ((FStarC_String.length token) - (Prims.of_int (4))) in Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) uu___10) in [uu___9] in uu___7 :: uu___8 @@ -469,30 +454,29 @@ let (maybe_add_ambient : Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) token) in [uu___8]) | FStarC_SMTEncoding_Term.App (FStarC_SMTEncoding_Term.Var token, []) -> - if FStarC_Compiler_Util.ends_with token "@tok" + if FStarC_Util.ends_with token "@tok" then let uu___5 = Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) token) in let uu___6 = let uu___7 = let uu___8 = - FStarC_Compiler_Util.substring token - Prims.int_zero - ((FStarC_Compiler_String.length token) - + FStarC_Util.substring token Prims.int_zero + ((FStarC_String.length token) - (Prims.of_int (4))) in Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) uu___8) in [uu___7] in uu___5 :: uu___6 @@ -501,7 +485,7 @@ let (maybe_add_ambient : Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) token) in [uu___6]) | uu___5 -> [] in @@ -535,11 +519,11 @@ let (maybe_add_ambient : let uu___3 = let uu___4 = free_top_level_names term in [uu___4] in add_assumption_with_triggers uu___3 | FStarC_SMTEncoding_Term.App (FStarC_SMTEncoding_Term.And, tms) -> - let t1 = FStarC_Compiler_List.collect triggers_of_term tms in + let t1 = FStarC_List.collect triggers_of_term tms in add_assumption_with_triggers t1 | FStarC_SMTEncoding_Term.App (FStarC_SMTEncoding_Term.Eq, t0::t1::[]) when - FStarC_Compiler_Util.starts_with + FStarC_Util.starts_with a.FStarC_SMTEncoding_Term.assumption_name "equation_" -> let t01 = free_top_level_names t0 in @@ -575,7 +559,7 @@ let (add_assumption_to_triggers : fun trigs -> let p1 = let uu___ = - FStarC_Compiler_Util.psmap_add p.assumption_name_map + FStarC_Util.psmap_add p.assumption_name_map a.FStarC_SMTEncoding_Term.assumption_name (FStarC_SMTEncoding_Term.Assume a) in { @@ -590,7 +574,7 @@ let (add_assumption_to_triggers : | [] -> maybe_add_ambient a p1 | uu___ -> let uu___1 = - FStarC_Compiler_Util.psmap_add p1.assumption_to_triggers + FStarC_Util.psmap_add p1.assumption_to_triggers a.FStarC_SMTEncoding_Term.assumption_name trigs in { macro_freenames = (p1.macro_freenames); @@ -603,8 +587,7 @@ let (add_assumption_to_triggers : let (trigger_reached : pruning_state -> Prims.string -> pruning_state) = fun p -> fun trig -> - let uu___ = - FStarC_Compiler_Util.psmap_remove p.trigger_to_assumption trig in + let uu___ = FStarC_Util.psmap_remove p.trigger_to_assumption trig in { macro_freenames = (p.macro_freenames); trigger_to_assumption = uu___; @@ -620,33 +603,32 @@ let (remove_trigger_for_assumption : fun p -> fun trig -> fun aname -> - let uu___ = - FStarC_Compiler_Util.psmap_try_find p.assumption_to_triggers aname in + let uu___ = FStarC_Util.psmap_try_find p.assumption_to_triggers aname in match uu___ with | FStar_Pervasives_Native.None -> (p, false) | FStar_Pervasives_Native.Some l -> let remaining_triggers = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> (fun ts -> Obj.magic (FStarC_Class_Setlike.remove () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) trig (Obj.magic ts))) uu___1) l in let eligible = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> (Obj.magic (FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)))) uu___1) remaining_triggers in let uu___1 = let uu___2 = - FStarC_Compiler_Util.psmap_add p.assumption_to_triggers aname + FStarC_Util.psmap_add p.assumption_to_triggers aname remaining_triggers in { macro_freenames = (p.macro_freenames); @@ -665,7 +647,7 @@ let rec (assumptions_of_decl : match d with | FStarC_SMTEncoding_Term.Assume a -> [a] | FStarC_SMTEncoding_Term.Module (uu___, ds) -> - FStarC_Compiler_List.collect assumptions_of_decl ds + FStarC_List.collect assumptions_of_decl ds | d1 -> [] let rec (add_decl : FStarC_SMTEncoding_Term.decl -> pruning_state -> pruning_state) = @@ -677,33 +659,30 @@ let rec (add_decl : triggers_of_term a.FStarC_SMTEncoding_Term.assumption_term in let p1 = let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> (Obj.magic (FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)))) uu___1) triggers1 in - FStarC_Compiler_List.fold_left - (FStarC_Compiler_List.fold_left (add_trigger_to_assumption a)) - p uu___ in + FStarC_List.fold_left + (FStarC_List.fold_left (add_trigger_to_assumption a)) p uu___ in add_assumption_to_triggers a p1 triggers1 | FStarC_SMTEncoding_Term.Module (uu___, ds) -> - FStarC_Compiler_List.fold_left (fun p1 -> fun d1 -> add_decl d1 p1) - p ds + FStarC_List.fold_left (fun p1 -> fun d1 -> add_decl d1 p1) p ds | FStarC_SMTEncoding_Term.DefineFun (macro, uu___, uu___1, body, uu___2) -> let free_names = let uu___3 = free_top_level_names body in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) (Obj.magic uu___3) in + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) + (Obj.magic uu___3) in let p1 = let uu___3 = - FStarC_Compiler_Util.psmap_add p.macro_freenames macro - free_names in + FStarC_Util.psmap_add p.macro_freenames macro free_names in { macro_freenames = uu___3; trigger_to_assumption = (p.trigger_to_assumption); @@ -718,10 +697,9 @@ let (add_decls : FStarC_SMTEncoding_Term.decl Prims.list -> pruning_state -> pruning_state) = fun ds -> - fun p -> - FStarC_Compiler_List.fold_left (fun p1 -> fun d -> add_decl d p1) p ds + fun p -> FStarC_List.fold_left (fun p1 -> fun d -> add_decl d p1) p ds type sym = Prims.string -type reached_assumption_names = Prims.string FStarC_Compiler_RBSet.rbset +type reached_assumption_names = Prims.string FStarC_RBSet.rbset type ctxt = { p: pruning_state ; reached: reached_assumption_names } @@ -776,7 +754,7 @@ let (find_assumptions_waiting_on_trigger : (fun ctxt1 -> let ctxt1 = Obj.magic ctxt1 in let uu___ = - FStarC_Compiler_Util.psmap_try_find + FStarC_Util.psmap_try_find (ctxt1.p).trigger_to_assumption x in match uu___ with | FStar_Pervasives_Native.None -> @@ -795,8 +773,8 @@ let (reached_assumption : Prims.string -> unit st) = let p = let uu___ = ctxt1.p in let uu___1 = - FStarC_Compiler_Util.psmap_remove - (ctxt1.p).assumption_to_triggers aname in + FStarC_Util.psmap_remove (ctxt1.p).assumption_to_triggers + aname in { macro_freenames = (uu___.macro_freenames); trigger_to_assumption = (uu___.trigger_to_assumption); @@ -810,7 +788,7 @@ let (reached_assumption : Prims.string -> unit st) = Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) aname (Obj.magic ctxt1.reached)) in { p = (ctxt1.p); reached = uu___1 } in @@ -853,7 +831,7 @@ let (already_reached : Prims.string -> Prims.bool st) = let uu___ = FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) aname (Obj.magic ctxt1.reached) in Obj.magic @@ -955,21 +933,20 @@ let rec (scan : FStarC_SMTEncoding_Term.assumption Prims.list -> unit st) = let ctxt1 = Obj.magic ctxt1 in let macro_expand s = let uu___ = - FStarC_Compiler_Util.psmap_try_find (ctxt1.p).macro_freenames - s in + FStarC_Util.psmap_try_find (ctxt1.p).macro_freenames s in match uu___ with | FStar_Pervasives_Native.None -> [s] | FStar_Pervasives_Native.Some l -> s :: l in let new_syms = - FStarC_Compiler_List.collect + FStarC_List.collect (fun a -> let uu___ = let uu___1 = assumption_free_names a in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) (Obj.magic uu___1) in - FStarC_Compiler_List.collect macro_expand uu___) ds in + FStarC_List.collect macro_expand uu___) ds in let uu___ = trigger_pending_assumptions new_syms in Obj.magic (FStarC_Class_Monad.op_let_Bang st_monad () () @@ -1050,14 +1027,14 @@ let (prune : = fun p -> fun roots -> - let roots1 = FStarC_Compiler_List.collect assumptions_of_decl roots in + let roots1 = FStarC_List.collect assumptions_of_decl roots in let init1 = let uu___ = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) ()) in + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) + ()) in { p; reached = uu___ } in let uu___ = let uu___1 = scan (FStar_List_Tot_Base.op_At roots1 p.extra_roots) in @@ -1067,14 +1044,14 @@ let (prune : let reached_names = FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) (Obj.magic ctxt1.reached) in + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) + (Obj.magic ctxt1.reached) in let reached_assumptions = - FStarC_Compiler_List.collect + FStarC_List.collect (fun name -> let uu___2 = - FStarC_Compiler_Util.psmap_try_find - (ctxt1.p).assumption_name_map name in + FStarC_Util.psmap_try_find (ctxt1.p).assumption_name_map + name in match uu___2 with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some a -> [a]) diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Solver.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Solver.ml similarity index 79% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_Solver.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Solver.ml index a0028b9eefb..e917a1b3c99 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Solver.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Solver.ml @@ -3,10 +3,10 @@ exception SplitQueryAndRetry let (uu___is_SplitQueryAndRetry : Prims.exn -> Prims.bool) = fun projectee -> match projectee with | SplitQueryAndRetry -> true | uu___ -> false -let (dbg_SMTQuery : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SMTQuery" -let (dbg_SMTFail : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SMTFail" +let (dbg_SMTQuery : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SMTQuery" +let (dbg_SMTFail : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SMTFail" let (z3_replay_result : (unit * unit)) = ((), ()) let z3_result_as_replay_result : 'uuuuu 'uuuuu1 'uuuuu2 . @@ -17,111 +17,160 @@ let z3_result_as_replay_result : match uu___ with | FStar_Pervasives.Inl l -> FStar_Pervasives.Inl l | FStar_Pervasives.Inr (r, uu___1) -> FStar_Pervasives.Inr r -let (recorded_hints : - FStarC_Compiler_Hints.hints FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None +let (src_filename : Prims.string FStarC_Effect.ref) = FStarC_Util.mk_ref "" +let (recorded_hints : FStarC_Hints.hints FStarC_Effect.ref) = + FStarC_Util.mk_ref [] let (replaying_hints : - FStarC_Compiler_Hints.hints FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + FStarC_Hints.hints FStar_Pervasives_Native.option FStarC_Effect.ref) = + FStarC_Util.mk_ref FStar_Pervasives_Native.None +let (refreshing_hints : Prims.bool FStarC_Effect.ref) = + FStarC_Util.mk_ref false let (use_hints : unit -> Prims.bool) = + fun uu___ -> FStarC_Options.use_hints () +let (initialize_hints_db : Prims.string -> Prims.bool -> unit) = + fun filename -> + fun refresh -> + FStarC_Effect.op_Colon_Equals recorded_hints []; + FStarC_Effect.op_Colon_Equals refreshing_hints refresh; + (let norm_src_filename = FStarC_Util.normalize_file_path filename in + FStarC_Effect.op_Colon_Equals src_filename norm_src_filename; + (let val_filename = FStarC_Options.hint_file_for_src norm_src_filename in + let uu___3 = FStarC_Hints.read_hints val_filename in + match uu___3 with + | FStarC_Hints.HintsOK hints -> + let expected_digest = + FStarC_Util.digest_of_file norm_src_filename in + ((let uu___5 = FStarC_Options.hint_info () in + if uu___5 + then + FStarC_Util.print3 "(%s) digest is %s from %s.\n" + norm_src_filename + (if hints.FStarC_Hints.module_digest = expected_digest + then "valid; using hints" + else "invalid; using potentially stale hints") + val_filename + else ()); + FStarC_Effect.op_Colon_Equals replaying_hints + (FStar_Pervasives_Native.Some (hints.FStarC_Hints.hints))) + | FStarC_Hints.MalformedJson -> + let uu___5 = use_hints () in + if uu___5 + then + let uu___6 = + let uu___7 = + let uu___8 = + FStarC_Util.format1 + "Malformed JSON hints file: %s; ran without hints" + val_filename in + FStarC_Errors_Msg.text uu___8 in + [uu___7] in + FStarC_Errors.log_issue0 + FStarC_Errors_Codes.Warning_CouldNotReadHints () + (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) + (Obj.magic uu___6) + else () + | FStarC_Hints.UnableToOpen -> + let uu___5 = use_hints () in + if uu___5 + then + let uu___6 = + let uu___7 = + let uu___8 = + FStarC_Util.format1 + "Unable to open hints file: %s; ran without hints" + val_filename in + FStarC_Errors_Msg.text uu___8 in + [uu___7] in + FStarC_Errors.log_issue0 + FStarC_Errors_Codes.Warning_CouldNotReadHints () + (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) + (Obj.magic uu___6) + else ())) +let rec (merge_hints : + FStarC_Hints.hints -> FStarC_Hints.hints -> FStarC_Hints.hints) = + fun prev -> + fun next -> + match (prev, next) with + | ((FStar_Pervasives_Native.None)::prev1, next1) -> + merge_hints prev1 next1 + | (prev1, (FStar_Pervasives_Native.None)::next1) -> + merge_hints prev1 next1 + | ((FStar_Pervasives_Native.Some p)::prev1, + (FStar_Pervasives_Native.Some n)::next1) -> + if + ((FStarC_String.compare p.FStarC_Hints.hint_name + n.FStarC_Hints.hint_name) + < Prims.int_zero) + || + ((p.FStarC_Hints.hint_name = n.FStarC_Hints.hint_name) && + (p.FStarC_Hints.hint_index < n.FStarC_Hints.hint_index)) + then + let uu___ = + merge_hints prev1 ((FStar_Pervasives_Native.Some n) :: next1) in + (FStar_Pervasives_Native.Some p) :: uu___ + else + if + (p.FStarC_Hints.hint_name = n.FStarC_Hints.hint_name) && + (p.FStarC_Hints.hint_index = n.FStarC_Hints.hint_index) + then + (let uu___1 = merge_hints prev1 next1 in + (FStar_Pervasives_Native.Some n) :: uu___1) + else + (let uu___2 = + merge_hints ((FStar_Pervasives_Native.Some p) :: prev1) + next1 in + (FStar_Pervasives_Native.Some n) :: uu___2) + | ([], next1) -> next1 + | (prev1, []) -> prev1 +let (merge_hints_db : + FStarC_Hints.hints_db -> FStarC_Hints.hints_db -> FStarC_Hints.hints_db) = + fun prev -> + fun next -> + let uu___ = merge_hints prev.FStarC_Hints.hints next.FStarC_Hints.hints in + { + FStarC_Hints.module_digest = (next.FStarC_Hints.module_digest); + FStarC_Hints.hints = uu___ + } +let (flush_hints : unit -> unit) = fun uu___ -> - (FStarC_Options.use_hints ()) && - (let uu___1 = FStarC_Options_Ext.get "context_pruning" in uu___1 = "") -let initialize_hints_db : 'uuuuu . Prims.string -> 'uuuuu -> unit = - fun src_filename -> - fun format_filename -> - (let uu___1 = FStarC_Options.record_hints () in - if uu___1 - then - FStarC_Compiler_Effect.op_Colon_Equals recorded_hints - (FStar_Pervasives_Native.Some []) - else ()); - (let norm_src_filename = - FStarC_Compiler_Util.normalize_file_path src_filename in - let val_filename = FStarC_Options.hint_file_for_src norm_src_filename in - let uu___1 = FStarC_Compiler_Hints.read_hints val_filename in - match uu___1 with - | FStarC_Compiler_Hints.HintsOK hints -> - let expected_digest = - FStarC_Compiler_Util.digest_of_file norm_src_filename in - ((let uu___3 = FStarC_Options.hint_info () in - if uu___3 - then - FStarC_Compiler_Util.print3 "(%s) digest is %s from %s.\n" - norm_src_filename - (if - hints.FStarC_Compiler_Hints.module_digest = - expected_digest - then "valid; using hints" - else "invalid; using potentially stale hints") val_filename - else ()); - FStarC_Compiler_Effect.op_Colon_Equals replaying_hints - (FStar_Pervasives_Native.Some - (hints.FStarC_Compiler_Hints.hints))) - | FStarC_Compiler_Hints.MalformedJson -> - let uu___3 = use_hints () in - if uu___3 - then - let uu___4 = - let uu___5 = - let uu___6 = - FStarC_Compiler_Util.format1 - "Malformed JSON hints file: %s; ran without hints" - val_filename in - FStarC_Errors_Msg.text uu___6 in - [uu___5] in - FStarC_Errors.log_issue0 - FStarC_Errors_Codes.Warning_CouldNotReadHints () - (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) - (Obj.magic uu___4) - else () - | FStarC_Compiler_Hints.UnableToOpen -> - let uu___3 = use_hints () in - if uu___3 - then - let uu___4 = - let uu___5 = - let uu___6 = - FStarC_Compiler_Util.format1 - "Unable to open hints file: %s; ran without hints" - val_filename in - FStarC_Errors_Msg.text uu___6 in - [uu___5] in - FStarC_Errors.log_issue0 - FStarC_Errors_Codes.Warning_CouldNotReadHints () - (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) - (Obj.magic uu___4) - else ()) -let (finalize_hints_db : Prims.string -> unit) = - fun src_filename -> - (let uu___1 = FStarC_Options.record_hints () in - if uu___1 - then - let hints = - let uu___2 = FStarC_Compiler_Effect.op_Bang recorded_hints in - FStarC_Compiler_Option.get uu___2 in - let hints_db = - let uu___2 = FStarC_Compiler_Util.digest_of_file src_filename in - { - FStarC_Compiler_Hints.module_digest = uu___2; - FStarC_Compiler_Hints.hints = hints - } in - let norm_src_filename = - FStarC_Compiler_Util.normalize_file_path src_filename in - let val_filename = FStarC_Options.hint_file_for_src norm_src_filename in - FStarC_Compiler_Hints.write_hints val_filename hints_db - else ()); - FStarC_Compiler_Effect.op_Colon_Equals recorded_hints - FStar_Pervasives_Native.None; - FStarC_Compiler_Effect.op_Colon_Equals replaying_hints + let hints = FStarC_Effect.op_Bang recorded_hints in + let src_filename1 = FStarC_Effect.op_Bang src_filename in + if Prims.uu___is_Cons hints + then + (let hints_db = + let uu___2 = FStarC_Util.digest_of_file src_filename1 in + { FStarC_Hints.module_digest = uu___2; FStarC_Hints.hints = hints } in + let val_filename = FStarC_Options.hint_file_for_src src_filename1 in + let hints_db1 = + let uu___2 = FStarC_Effect.op_Bang refreshing_hints in + if uu___2 + then hints_db + else + (let uu___4 = FStarC_Hints.read_hints val_filename in + match uu___4 with + | FStarC_Hints.HintsOK prev_hints -> + merge_hints_db prev_hints hints_db + | uu___5 -> hints_db) in + FStarC_Hints.write_hints val_filename hints_db1) + else (); + FStarC_Effect.op_Colon_Equals recorded_hints []; + FStarC_Effect.op_Colon_Equals replaying_hints FStar_Pervasives_Native.None +let (finalize_hints_db : unit -> unit) = fun uu___ -> flush_hints () let with_hints_db : 'a . Prims.string -> (unit -> 'a) -> 'a = fun fname -> fun f -> - initialize_hints_db fname false; - (let result = f () in finalize_hints_db fname; result) + let uu___ = + let uu___1 = FStarC_Effect.op_Bang src_filename in uu___1 <> "" in + if uu___ + then f () + else + ((let uu___3 = + (FStarC_Options.record_hints ()) && + (let uu___4 = FStarC_Options.interactive () in + Prims.op_Negation uu___4) in + initialize_hints_db fname uu___3); + (let result = f () in finalize_hints_db (); result)) type errors = { error_reason: Prims.string ; @@ -170,14 +219,12 @@ let (error_to_short_string : errors -> Prims.string) = FStarC_Class_Show.show FStarC_Class_Show.showable_int err.error_fuel in let uu___2 = FStarC_Class_Show.show FStarC_Class_Show.showable_int err.error_ifuel in - FStarC_Compiler_Util.format5 "%s (rlimit=%s; fuel=%s; ifuel=%s%s)" + FStarC_Util.format5 "%s (rlimit=%s; fuel=%s; ifuel=%s%s)" err.error_reason uu___ uu___1 uu___2 - (if FStarC_Compiler_Option.isSome err.error_hint - then "; with hint" - else "") + (if FStarC_Option.isSome err.error_hint then "; with hint" else "") let (error_to_is_timeout : errors -> Prims.string Prims.list) = fun err -> - if FStarC_Compiler_Util.ends_with err.error_reason "canceled" + if FStarC_Util.ends_with err.error_reason "canceled" then let uu___ = let uu___1 = @@ -189,12 +236,9 @@ let (error_to_is_timeout : errors -> Prims.string Prims.list) = let uu___3 = FStarC_Class_Show.show FStarC_Class_Show.showable_int err.error_ifuel in - FStarC_Compiler_Util.format5 - "timeout (rlimit=%s; fuel=%s; ifuel=%s; %s)" err.error_reason - uu___1 uu___2 uu___3 - (if FStarC_Compiler_Option.isSome err.error_hint - then "with hint" - else "") in + FStarC_Util.format5 "timeout (rlimit=%s; fuel=%s; ifuel=%s; %s)" + err.error_reason uu___1 uu___2 uu___3 + (if FStarC_Option.isSome err.error_hint then "with hint" else "") in [uu___] else [] type query_settings = @@ -203,7 +247,7 @@ type query_settings = query_decl: FStarC_SMTEncoding_Term.decl ; query_name: Prims.string ; query_index: Prims.int ; - query_range: FStarC_Compiler_Range_Type.range ; + query_range: FStarC_Range_Type.range ; query_fuel: Prims.int ; query_ifuel: Prims.int ; query_rlimit: Prims.int ; @@ -214,7 +258,8 @@ type query_settings = query_suffix: FStarC_SMTEncoding_Term.decl Prims.list ; query_hash: Prims.string FStar_Pervasives_Native.option ; query_can_be_split_and_retried: Prims.bool ; - query_term: FStarC_Syntax_Syntax.term } + query_term: FStarC_Syntax_Syntax.term ; + query_record_hints: Prims.bool } let (__proj__Mkquery_settings__item__query_env : query_settings -> FStarC_SMTEncoding_Env.env_t) = fun projectee -> @@ -222,7 +267,8 @@ let (__proj__Mkquery_settings__item__query_env : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_env + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_env let (__proj__Mkquery_settings__item__query_decl : query_settings -> FStarC_SMTEncoding_Term.decl) = fun projectee -> @@ -230,7 +276,8 @@ let (__proj__Mkquery_settings__item__query_decl : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_decl + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_decl let (__proj__Mkquery_settings__item__query_name : query_settings -> Prims.string) = fun projectee -> @@ -238,7 +285,8 @@ let (__proj__Mkquery_settings__item__query_name : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_name + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_name let (__proj__Mkquery_settings__item__query_index : query_settings -> Prims.int) = fun projectee -> @@ -246,15 +294,17 @@ let (__proj__Mkquery_settings__item__query_index : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_index + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_index let (__proj__Mkquery_settings__item__query_range : - query_settings -> FStarC_Compiler_Range_Type.range) = + query_settings -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_range + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_range let (__proj__Mkquery_settings__item__query_fuel : query_settings -> Prims.int) = fun projectee -> @@ -262,7 +312,8 @@ let (__proj__Mkquery_settings__item__query_fuel : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_fuel + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_fuel let (__proj__Mkquery_settings__item__query_ifuel : query_settings -> Prims.int) = fun projectee -> @@ -270,7 +321,8 @@ let (__proj__Mkquery_settings__item__query_ifuel : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_ifuel + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_ifuel let (__proj__Mkquery_settings__item__query_rlimit : query_settings -> Prims.int) = fun projectee -> @@ -278,7 +330,8 @@ let (__proj__Mkquery_settings__item__query_rlimit : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_rlimit + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_rlimit let (__proj__Mkquery_settings__item__query_hint : query_settings -> FStarC_SMTEncoding_UnsatCore.unsat_core FStar_Pervasives_Native.option) @@ -288,7 +341,8 @@ let (__proj__Mkquery_settings__item__query_hint : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_hint + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_hint let (__proj__Mkquery_settings__item__query_errors : query_settings -> errors Prims.list) = fun projectee -> @@ -296,7 +350,8 @@ let (__proj__Mkquery_settings__item__query_errors : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_errors + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_errors let (__proj__Mkquery_settings__item__query_all_labels : query_settings -> FStarC_SMTEncoding_Term.error_labels) = fun projectee -> @@ -304,7 +359,8 @@ let (__proj__Mkquery_settings__item__query_all_labels : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_all_labels + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_all_labels let (__proj__Mkquery_settings__item__query_suffix : query_settings -> FStarC_SMTEncoding_Term.decl Prims.list) = fun projectee -> @@ -312,7 +368,8 @@ let (__proj__Mkquery_settings__item__query_suffix : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_suffix + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_suffix let (__proj__Mkquery_settings__item__query_hash : query_settings -> Prims.string FStar_Pervasives_Native.option) = fun projectee -> @@ -320,7 +377,8 @@ let (__proj__Mkquery_settings__item__query_hash : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_hash + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_hash let (__proj__Mkquery_settings__item__query_can_be_split_and_retried : query_settings -> Prims.bool) = fun projectee -> @@ -328,7 +386,7 @@ let (__proj__Mkquery_settings__item__query_can_be_split_and_retried : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> + query_can_be_split_and_retried; query_term; query_record_hints;_} -> query_can_be_split_and_retried let (__proj__Mkquery_settings__item__query_term : query_settings -> FStarC_Syntax_Syntax.term) = @@ -337,12 +395,22 @@ let (__proj__Mkquery_settings__item__query_term : | { query_env; query_decl; query_name; query_index; query_range; query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; query_all_labels; query_suffix; query_hash; - query_can_be_split_and_retried; query_term;_} -> query_term + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_term +let (__proj__Mkquery_settings__item__query_record_hints : + query_settings -> Prims.bool) = + fun projectee -> + match projectee with + | { query_env; query_decl; query_name; query_index; query_range; + query_fuel; query_ifuel; query_rlimit; query_hint; query_errors; + query_all_labels; query_suffix; query_hash; + query_can_be_split_and_retried; query_term; query_record_hints;_} -> + query_record_hints let (convert_rlimit : Prims.int -> Prims.int) = fun r -> let uu___ = let uu___1 = FStarC_Options.z3_version () in - FStarC_Compiler_Misc.version_ge uu___1 "4.12.3" in + FStarC_Misc.version_ge uu___1 "4.12.3" in if uu___ then (Prims.parse_int "500000") * r else (Prims.parse_int "544656") * r @@ -359,10 +427,9 @@ let (with_fuel_and_diagnostics : let uu___ = let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Util.string_of_int n in - let uu___4 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format2 "" uu___3 - uu___4 in + let uu___3 = FStarC_Util.string_of_int n in + let uu___4 = FStarC_Util.string_of_int i in + FStarC_Util.format2 "" uu___3 uu___4 in FStarC_SMTEncoding_Term.Caption uu___2 in let uu___2 = let uu___3 = @@ -396,41 +463,47 @@ let (with_fuel_and_diagnostics : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_Util.string_of_int rlimit in + let uu___6 = FStarC_Util.string_of_int rlimit in ("rlimit", uu___6) in FStarC_SMTEncoding_Term.SetOption uu___5 in [uu___4; FStarC_SMTEncoding_Term.CheckSat; FStarC_SMTEncoding_Term.SetOption ("rlimit", "0"); - FStarC_SMTEncoding_Term.GetReasonUnknown; - FStarC_SMTEncoding_Term.GetUnsatCore] in + FStarC_SMTEncoding_Term.GetReasonUnknown] in let uu___4 = let uu___5 = let uu___6 = - (FStarC_Options.print_z3_statistics ()) || - (FStarC_Options.query_stats ()) in - if uu___6 then [FStarC_SMTEncoding_Term.GetStatistics] else [] in - FStarC_Compiler_List.op_At uu___5 settings.query_suffix in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At label_assumptions uu___2 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___7 = + (FStarC_Options.print_z3_statistics ()) || + (FStarC_Options.query_stats ()) in + if uu___7 + then [FStarC_SMTEncoding_Term.GetStatistics] + else [] in + FStarC_List.op_At uu___6 settings.query_suffix in + FStarC_List.op_At + (if settings.query_record_hints + then [FStarC_SMTEncoding_Term.GetUnsatCore] + else []) uu___5 in + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At label_assumptions uu___2 in + FStarC_List.op_At uu___ uu___1 let (used_hint : query_settings -> Prims.bool) = - fun s -> FStarC_Compiler_Option.isSome s.query_hint + fun s -> FStarC_Option.isSome s.query_hint let (get_hint_for : Prims.string -> - Prims.int -> FStarC_Compiler_Hints.hint FStar_Pervasives_Native.option) + Prims.int -> FStarC_Hints.hint FStar_Pervasives_Native.option) = fun qname -> fun qindex -> - let uu___ = FStarC_Compiler_Effect.op_Bang replaying_hints in + let uu___ = FStarC_Effect.op_Bang replaying_hints in match uu___ with | FStar_Pervasives_Native.Some hints -> - FStarC_Compiler_Util.find_map hints + FStarC_Util.find_map hints (fun uu___1 -> match uu___1 with | FStar_Pervasives_Native.Some hint when - (hint.FStarC_Compiler_Hints.hint_name = qname) && - (hint.FStarC_Compiler_Hints.hint_index = qindex) + (hint.FStarC_Hints.hint_name = qname) && + (hint.FStarC_Hints.hint_index = qindex) -> FStar_Pervasives_Native.Some hint | uu___2 -> FStar_Pervasives_Native.None) | uu___1 -> FStar_Pervasives_Native.None @@ -450,7 +523,7 @@ let (query_errors : | (msg, error_labels) -> let err = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (uu___4, x, y) -> @@ -481,10 +554,8 @@ let (detail_hint_replay : let uu___1 = with_fuel_and_diagnostics settings label_assumptions in let uu___2 = - let uu___3 = - FStarC_Compiler_Util.string_of_int settings.query_index in - FStarC_Compiler_Util.format2 "(%s, %s)" settings.query_name - uu___3 in + let uu___3 = FStarC_Util.string_of_int settings.query_index in + FStarC_Util.format2 "(%s, %s)" settings.query_name uu___3 in FStarC_SMTEncoding_Z3.ask settings.query_range settings.query_hash settings.query_all_labels uu___1 uu___2 false FStar_Pervasives_Native.None in @@ -495,7 +566,7 @@ let (detail_hint_replay : let (find_localized_errors : errors Prims.list -> errors FStar_Pervasives_Native.option) = fun errs -> - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun err -> match err.error_messages with | [] -> false | uu___ -> true) errs let (errors_to_report : @@ -547,40 +618,30 @@ let (errors_to_report : then let uu___1 = let uu___2 = - FStarC_Compiler_List.map error_to_short_string - settings.query_errors in - FStarC_Compiler_List.map FStarC_Pprint.doc_of_string uu___2 in + FStarC_List.map error_to_short_string settings.query_errors in + FStarC_List.map FStarC_Pprint.doc_of_string uu___2 in format_smt_error uu___1 else (let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun err -> match uu___3 with | (ic, cc, uc, bc) -> let err1 = - FStarC_Compiler_Util.substring_from - err.error_reason - (FStarC_Compiler_String.length - "unknown because ") in - if - FStarC_Compiler_Util.starts_with err1 - "(incomplete" + FStarC_Util.substring_from err.error_reason + (FStarC_String.length "unknown because ") in + if FStarC_Util.starts_with err1 "(incomplete" then ((ic + Prims.int_one), cc, uc, bc) else if - ((FStarC_Compiler_Util.starts_with err1 - "canceled") - || - (FStarC_Compiler_Util.starts_with err1 - "(resource")) - || - (FStarC_Compiler_Util.starts_with err1 - "timeout") + ((FStarC_Util.starts_with err1 "canceled") || + (FStarC_Util.starts_with err1 "(resource")) + || (FStarC_Util.starts_with err1 "timeout") then (ic, (cc + Prims.int_one), uc, bc) else if - FStarC_Compiler_Util.starts_with err1 + FStarC_Util.starts_with err1 "Overflow encountered when expanding old_vector" then (ic, cc, uc, (bc + Prims.int_one)) else (ic, cc, (uc + Prims.int_one), bc)) @@ -634,7 +695,7 @@ let (errors_to_report : FStarC_Errors_Msg.text "Try with --query_stats to get more details" in [uu___7] in - FStarC_Compiler_List.op_At base recovery_failed_msg))) in + FStarC_List.op_At base recovery_failed_msg))) in let uu___ = let uu___1 = find_localized_errors settings.query_errors in (uu___1, (settings.query_all_labels)) in @@ -654,9 +715,9 @@ let (errors_to_report : recovery_failed_msg | (FStar_Pervasives_Native.None, uu___1) -> if settings.query_can_be_split_and_retried - then FStarC_Compiler_Effect.raise SplitQueryAndRetry + then FStarC_Effect.raise SplitQueryAndRetry else - (let l = FStarC_Compiler_List.length settings.query_all_labels in + (let l = FStarC_List.length settings.query_all_labels in let labels = if l = Prims.int_zero then @@ -696,7 +757,7 @@ let (errors_to_report : else ()); settings.query_all_labels) else settings.query_all_labels in - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___3 -> match uu___3 with | (uu___4, msg, rng) -> @@ -731,16 +792,15 @@ let (errors_to_report : query_hash = (settings.query_hash); query_can_be_split_and_retried = (settings.query_can_be_split_and_retried); - query_term = (settings.query_term) + query_term = (settings.query_term); + query_record_hints = (settings.query_record_hints) } in let ask_z3 label_assumptions = let uu___1 = with_fuel_and_diagnostics initial_fuel label_assumptions in let uu___2 = - let uu___3 = - FStarC_Compiler_Util.string_of_int settings.query_index in - FStarC_Compiler_Util.format2 "(%s, %s)" settings.query_name - uu___3 in + let uu___3 = FStarC_Util.string_of_int settings.query_index in + FStarC_Util.format2 "(%s, %s)" settings.query_name uu___3 in FStarC_SMTEncoding_Z3.ask settings.query_range settings.query_hash settings.query_all_labels uu___1 uu___2 false FStar_Pervasives_Native.None in @@ -770,16 +830,16 @@ let (__proj__Mkunique_string_accumulator__item__clear : fun projectee -> match projectee with | { add; get; clear;_} -> clear let (mk_unique_string_accumulator : unit -> unique_string_accumulator) = fun uu___ -> - let strings = FStarC_Compiler_Util.mk_ref [] in + let strings = FStarC_Util.mk_ref [] in let add m = - let ms = FStarC_Compiler_Effect.op_Bang strings in - if FStarC_Compiler_List.contains m ms + let ms = FStarC_Effect.op_Bang strings in + if FStarC_List.contains m ms then () - else FStarC_Compiler_Effect.op_Colon_Equals strings (m :: ms) in + else FStarC_Effect.op_Colon_Equals strings (m :: ms) in let get uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang strings in - FStarC_Compiler_Util.sort_with FStarC_Compiler_String.compare uu___2 in - let clear uu___1 = FStarC_Compiler_Effect.op_Colon_Equals strings [] in + let uu___2 = FStarC_Effect.op_Bang strings in + FStarC_Util.sort_with FStarC_String.compare uu___2 in + let clear uu___1 = FStarC_Effect.op_Colon_Equals strings [] in { add; get; clear } let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = fun settings -> @@ -795,19 +855,17 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = | { add = add_discarded_name; get = get_discarded_names; clear = uu___3;_} -> let parse_axiom_name s = - let chars = FStarC_Compiler_String.list_of_string s in + let chars = FStarC_String.list_of_string s in let first_upper_index = - FStarC_Compiler_Util.try_find_index - FStarC_Compiler_Util.is_upper chars in + FStarC_Util.try_find_index FStarC_Util.is_upper chars in match first_upper_index with | FStar_Pervasives_Native.None -> (add_discarded_name s; []) | FStar_Pervasives_Native.Some first_upper_index1 -> let name_and_suffix = - FStarC_Compiler_Util.substring_from s - first_upper_index1 in + FStarC_Util.substring_from s first_upper_index1 in let components = - FStarC_Compiler_String.split [46] name_and_suffix in + FStarC_String.split [46] name_and_suffix in let excluded_suffixes = ["fuel_instrumented"; "_pretyping"; @@ -818,15 +876,14 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = "MaxFuel_assumption"; "MaxIFuel_assumption"] in let exclude_suffix s1 = - let s2 = FStarC_Compiler_Util.trim_string s1 in + let s2 = FStarC_Util.trim_string s1 in let sopt = - FStarC_Compiler_Util.find_map excluded_suffixes + FStarC_Util.find_map excluded_suffixes (fun sfx -> - if FStarC_Compiler_Util.contains s2 sfx + if FStarC_Util.contains s2 sfx then let uu___4 = - FStarC_Compiler_List.hd - (FStarC_Compiler_Util.split s2 sfx) in + FStarC_List.hd (FStarC_Util.split s2 sfx) in FStar_Pervasives_Native.Some uu___4 else FStar_Pervasives_Native.None) in match sopt with @@ -838,22 +895,20 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = match components with | [] -> [] | uu___4 -> - let uu___5 = - FStarC_Compiler_Util.prefix components in + let uu___5 = FStarC_Util.prefix components in (match uu___5 with | (lident, last) -> let components2 = let uu___6 = exclude_suffix last in - FStarC_Compiler_List.op_At lident uu___6 in + FStarC_List.op_At lident uu___6 in let module_name = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun s1 -> let uu___6 = let uu___7 = - FStarC_Compiler_Util.char_at s1 + FStarC_Util.char_at s1 Prims.int_zero in - FStarC_Compiler_Util.is_upper - uu___7 in + FStarC_Util.is_upper uu___7 in Prims.op_Negation uu___6) components2 in ((match module_name with @@ -861,12 +916,11 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = | FStar_Pervasives_Native.Some (m, uu___7, uu___8) -> add_module_name1 - (FStarC_Compiler_String.concat "." - m)); + (FStarC_String.concat "." m)); components2)) in if components1 = [] then (add_discarded_name s; []) - else [FStarC_Compiler_String.concat "." components1] in + else [FStarC_String.concat "." components1] in let should_log = (FStarC_Options.hint_info ()) || (FStarC_Options.query_stats ()) in @@ -875,28 +929,26 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = | FStar_Pervasives_Native.None -> maybe_log (fun uu___4 -> - FStarC_Compiler_Util.print_string - "no unsat core\n") + FStarC_Util.print_string "no unsat core\n") | FStar_Pervasives_Native.Some core1 -> - let core2 = - FStarC_Compiler_List.collect parse_axiom_name core1 in + let core2 = FStarC_List.collect parse_axiom_name core1 in maybe_log (fun uu___4 -> (let uu___6 = let uu___7 = get_module_names () in - FStarC_Compiler_String.concat - "\nZ3 Proof Stats:\t" uu___7 in - FStarC_Compiler_Util.print1 + FStarC_String.concat "\nZ3 Proof Stats:\t" + uu___7 in + FStarC_Util.print1 "Z3 Proof Stats: Modules relevant to this proof:\nZ3 Proof Stats:\t%s\n" uu___6); - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Z3 Proof Stats (Detail 1): Specifically:\nZ3 Proof Stats (Detail 1):\t%s\n" - (FStarC_Compiler_String.concat + (FStarC_String.concat "\nZ3 Proof Stats (Detail 1):\t" core2); (let uu___7 = let uu___8 = get_discarded_names () in - FStarC_Compiler_String.concat ", " uu___8 in - FStarC_Compiler_Util.print1 + FStarC_String.concat ", " uu___8 in + FStarC_Util.print1 "Z3 Proof Stats (Detail 2): Note, this report ignored the following names in the context: %s\n" uu___7)))) in let uu___ = @@ -915,12 +967,11 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = let uu___2 = match z3result.FStarC_SMTEncoding_Z3.z3result_status with | FStarC_SMTEncoding_Z3.UNSAT core -> - let uu___3 = - FStarC_Compiler_Util.colorize_green "succeeded" in + let uu___3 = FStarC_Util.colorize_green "succeeded" in (uu___3, core) | uu___3 -> let uu___4 = - FStarC_Compiler_Util.colorize_red + FStarC_Util.colorize_red (Prims.strcat "failed {reason-unknown=" (Prims.strcat status_string "}")) in (uu___4, FStar_Pervasives_Native.None) in @@ -929,8 +980,7 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = let range = let uu___3 = let uu___4 = - FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Class_Show.show FStarC_Range_Ops.showable_range settings.query_range in Prims.strcat uu___4 (Prims.strcat at_log_file ")") in Prims.strcat "(" uu___3 in @@ -945,12 +995,12 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = (Prims.strcat k (Prims.strcat "=" (Prims.strcat v " "))) in let str = - FStarC_Compiler_Util.smap_fold + FStarC_Util.smap_fold z3result.FStarC_SMTEncoding_Z3.z3result_statistics f "statistics={" in let uu___4 = - FStarC_Compiler_Util.substring str Prims.int_zero - ((FStarC_Compiler_String.length str) - Prims.int_one) in + FStarC_Util.substring str Prims.int_zero + ((FStarC_String.length str) - Prims.int_one) in Prims.strcat uu___4 "}" else "" in ((let uu___4 = @@ -991,12 +1041,12 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = uu___7 :: uu___8 in (settings.query_name) :: uu___6 in range :: uu___5 in - FStarC_Compiler_Util.print + FStarC_Util.print "%s\tQuery-stats (%s, %s)\t%s%s in %s milliseconds with fuel %s and ifuel %s and rlimit %s\n" uu___4); (let uu___5 = FStarC_Options.print_z3_statistics () in if uu___5 then process_unsat_core core else ()); - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___5 -> match uu___5 with | (uu___6, msg, range1) -> @@ -1015,25 +1065,18 @@ let (query_info : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic msg1)) errs)) else - (let uu___2 = - let uu___3 = FStarC_Options_Ext.get "profile_context" in - uu___3 <> "" in + (let uu___2 = FStarC_Options_Ext.enabled "profile_context" in if uu___2 then match z3result.FStarC_SMTEncoding_Z3.z3result_status with | FStarC_SMTEncoding_Z3.UNSAT core -> process_unsat_core core | uu___3 -> () else ()) -let (store_hint : FStarC_Compiler_Hints.hint -> unit) = +let (store_hint : FStarC_Hints.hint -> unit) = fun hint -> - let uu___ = FStarC_Compiler_Effect.op_Bang recorded_hints in - match uu___ with - | FStar_Pervasives_Native.Some l -> - FStarC_Compiler_Effect.op_Colon_Equals recorded_hints - (FStar_Pervasives_Native.Some - (FStarC_Compiler_List.op_At l - [FStar_Pervasives_Native.Some hint])) - | uu___1 -> () + let l = FStarC_Effect.op_Bang recorded_hints in + FStarC_Effect.op_Colon_Equals recorded_hints + (FStarC_List.op_At l [FStar_Pervasives_Native.Some hint]) let (record_hint : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) = fun settings -> @@ -1046,13 +1089,13 @@ let (record_hint : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) else (let mk_hint core = { - FStarC_Compiler_Hints.hint_name = (settings.query_name); - FStarC_Compiler_Hints.hint_index = (settings.query_index); - FStarC_Compiler_Hints.fuel = (settings.query_fuel); - FStarC_Compiler_Hints.ifuel = (settings.query_ifuel); - FStarC_Compiler_Hints.unsat_core = core; - FStarC_Compiler_Hints.query_elapsed_time = Prims.int_zero; - FStarC_Compiler_Hints.hash = + FStarC_Hints.hint_name = (settings.query_name); + FStarC_Hints.hint_index = (settings.query_index); + FStarC_Hints.fuel = (settings.query_fuel); + FStarC_Hints.ifuel = (settings.query_ifuel); + FStarC_Hints.unsat_core = core; + FStarC_Hints.query_elapsed_time = Prims.int_zero; + FStarC_Hints.hash = (match z3result.FStarC_SMTEncoding_Z3.z3result_status with | FStarC_SMTEncoding_Z3.UNSAT core1 -> z3result.FStarC_SMTEncoding_Z3.z3result_query_hash @@ -1063,7 +1106,7 @@ let (record_hint : query_settings -> FStarC_SMTEncoding_Z3.z3result -> unit) let uu___2 = let uu___3 = get_hint_for settings.query_name settings.query_index in - FStarC_Compiler_Option.get uu___3 in + FStarC_Option.get uu___3 in store_hint uu___2 | FStarC_SMTEncoding_Z3.UNSAT unsat_core -> if used_hint settings @@ -1107,8 +1150,7 @@ let (full_query_id : query_settings -> Prims.string) = let uu___ = let uu___1 = let uu___2 = - let uu___3 = - FStarC_Compiler_Util.string_of_int settings.query_index in + let uu___3 = FStarC_Util.string_of_int settings.query_index in Prims.strcat uu___3 ")" in Prims.strcat ", " uu___2 in Prims.strcat settings.query_name uu___1 in @@ -1123,7 +1165,7 @@ let collect_dups : 'a . 'a Prims.list -> ('a * Prims.int) Prims.list = if h = x then (h, (n + Prims.int_one)) :: t else (let uu___1 = add_one t x in (h, n) :: uu___1) in - FStarC_Compiler_List.fold_left add_one acc l + FStarC_List.fold_left add_one acc l type answer = { ok: Prims.bool ; @@ -1227,7 +1269,7 @@ let (uu___0 : answer FStarC_Class_Show.showable) = let uu___4 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool ans.tried_recovery in - FStarC_Compiler_Util.format5 + FStarC_Util.format5 "ok=%s nsuccess=%s lo=%s hi=%s tried_recovery=%s" uu___ uu___1 uu___2 uu___3 uu___4) } @@ -1239,7 +1281,7 @@ let (make_solver_configs : FStarC_SMTEncoding_Term.decl -> FStarC_Syntax_Syntax.term -> FStarC_SMTEncoding_Term.decl Prims.list -> - (query_settings Prims.list * FStarC_Compiler_Hints.hint + (query_settings Prims.list * FStarC_Hints.hint FStar_Pervasives_Native.option)) = fun can_split -> @@ -1271,6 +1313,7 @@ let (make_solver_configs : env.FStarC_SMTEncoding_Env.tcenv in let uu___3 = FStarC_Options.initial_fuel () in let uu___4 = FStarC_Options.initial_ifuel () in + let uu___5 = FStarC_Options.record_hints () in { query_env = env; query_decl = query; @@ -1289,37 +1332,35 @@ let (make_solver_configs : | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some - { FStarC_Compiler_Hints.hint_name = uu___5; - FStarC_Compiler_Hints.hint_index = uu___6; - FStarC_Compiler_Hints.fuel = uu___7; - FStarC_Compiler_Hints.ifuel = uu___8; - FStarC_Compiler_Hints.unsat_core = uu___9; - FStarC_Compiler_Hints.query_elapsed_time = - uu___10; - FStarC_Compiler_Hints.hash = h;_} + { FStarC_Hints.hint_name = uu___6; + FStarC_Hints.hint_index = uu___7; + FStarC_Hints.fuel = uu___8; + FStarC_Hints.ifuel = uu___9; + FStarC_Hints.unsat_core = uu___10; + FStarC_Hints.query_elapsed_time = uu___11; + FStarC_Hints.hash = h;_} -> h); query_can_be_split_and_retried = can_split; - query_term + query_term; + query_record_hints = uu___5 } in (default_settings, next_hint) in match uu___ with | (default_settings, next_hint) -> let use_hints_setting = let uu___1 = - (use_hints ()) && - (FStarC_Compiler_Util.is_some next_hint) in + (use_hints ()) && (FStarC_Util.is_some next_hint) in if uu___1 then - let uu___2 = FStarC_Compiler_Util.must next_hint in + let uu___2 = FStarC_Util.must next_hint in match uu___2 with - | { FStarC_Compiler_Hints.hint_name = uu___3; - FStarC_Compiler_Hints.hint_index = uu___4; - FStarC_Compiler_Hints.fuel = i; - FStarC_Compiler_Hints.ifuel = j; - FStarC_Compiler_Hints.unsat_core = + | { FStarC_Hints.hint_name = uu___3; + FStarC_Hints.hint_index = uu___4; + FStarC_Hints.fuel = i; FStarC_Hints.ifuel = j; + FStarC_Hints.unsat_core = FStar_Pervasives_Native.Some core; - FStarC_Compiler_Hints.query_elapsed_time = uu___5; - FStarC_Compiler_Hints.hash = h;_} -> + FStarC_Hints.query_elapsed_time = uu___5; + FStarC_Hints.hash = h;_} -> [{ query_env = (default_settings.query_env); query_decl = (default_settings.query_decl); @@ -1338,7 +1379,9 @@ let (make_solver_configs : query_hash = (default_settings.query_hash); query_can_be_split_and_retried = (default_settings.query_can_be_split_and_retried); - query_term = (default_settings.query_term) + query_term = (default_settings.query_term); + query_record_hints = + (default_settings.query_record_hints) }] else [] in let initial_fuel_max_ifuel = @@ -1367,7 +1410,9 @@ let (make_solver_configs : query_hash = (default_settings.query_hash); query_can_be_split_and_retried = (default_settings.query_can_be_split_and_retried); - query_term = (default_settings.query_term) + query_term = (default_settings.query_term); + query_record_hints = + (default_settings.query_record_hints) } in [uu___2] else [] in @@ -1402,7 +1447,9 @@ let (make_solver_configs : query_hash = (default_settings.query_hash); query_can_be_split_and_retried = (default_settings.query_can_be_split_and_retried); - query_term = (default_settings.query_term) + query_term = (default_settings.query_term); + query_record_hints = + (default_settings.query_record_hints) } in [uu___2] else [] in @@ -1436,7 +1483,9 @@ let (make_solver_configs : query_hash = (default_settings.query_hash); query_can_be_split_and_retried = (default_settings.query_can_be_split_and_retried); - query_term = (default_settings.query_term) + query_term = (default_settings.query_term); + query_record_hints = + (default_settings.query_record_hints) } in [uu___2] else [] in @@ -1444,12 +1493,11 @@ let (make_solver_configs : if is_retry then [default_settings] else - FStarC_Compiler_List.op_At use_hints_setting - (FStarC_Compiler_List.op_At [default_settings] - (FStarC_Compiler_List.op_At - initial_fuel_max_ifuel - (FStarC_Compiler_List.op_At - half_max_fuel_max_ifuel max_fuel_max_ifuel))) in + FStarC_List.op_At use_hints_setting + (FStarC_List.op_At [default_settings] + (FStarC_List.op_At initial_fuel_max_ifuel + (FStarC_List.op_At half_max_fuel_max_ifuel + max_fuel_max_ifuel))) in (cfgs, next_hint) let (__ask_solver : query_settings Prims.list -> @@ -1466,8 +1514,8 @@ let (__ask_solver : else ()); (let uu___1 = with_fuel_and_diagnostics config [] in let uu___2 = - let uu___3 = FStarC_Compiler_Util.string_of_int config.query_index in - FStarC_Compiler_Util.format2 "(%s, %s)" config.query_name uu___3 in + let uu___3 = FStarC_Util.string_of_int config.query_index in + FStarC_Util.format2 "(%s, %s)" config.query_name uu___3 in FStarC_SMTEncoding_Z3.ask config.query_range config.query_hash config.query_all_labels uu___1 uu___2 (used_hint config) config.query_hint) in @@ -1477,7 +1525,7 @@ let (ask_solver_quake : query_settings Prims.list -> answer) = let lo = FStarC_Options.quake_lo () in let hi = FStarC_Options.quake_hi () in let seed = FStarC_Options.z3_seed () in - let default_settings = FStarC_Compiler_List.hd configs in + let default_settings = FStarC_List.hd configs in let name = full_query_id default_settings in let quaking = (hi > Prims.int_one) && @@ -1503,19 +1551,17 @@ let (ask_solver_quake : query_settings Prims.list -> answer) = else (let uu___1 = f acc lo2 in fold_nat' f uu___1 (lo2 + Prims.int_one) hi2) in - let best_fuel = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in - let best_ifuel = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let best_fuel = FStarC_Util.mk_ref FStar_Pervasives_Native.None in + let best_ifuel = FStarC_Util.mk_ref FStar_Pervasives_Native.None in let maybe_improve r n = - let uu___ = FStarC_Compiler_Effect.op_Bang r in + let uu___ = FStarC_Effect.op_Bang r in match uu___ with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.op_Colon_Equals r - (FStar_Pervasives_Native.Some n) + FStarC_Effect.op_Colon_Equals r (FStar_Pervasives_Native.Some n) | FStar_Pervasives_Native.Some m -> if n < m then - FStarC_Compiler_Effect.op_Colon_Equals r - (FStar_Pervasives_Native.Some n) + FStarC_Effect.op_Colon_Equals r (FStar_Pervasives_Native.Some n) else () in let uu___ = fold_nat' @@ -1533,28 +1579,25 @@ let (ask_solver_quake : query_settings Prims.list -> answer) = ((let uu___5 = (quaking_or_retrying && ((FStarC_Options.interactive ()) || - (FStarC_Compiler_Debug.any ()))) + (FStarC_Debug.any ()))) && (n > Prims.int_zero) in if uu___5 then let uu___6 = if quaking then - let uu___7 = - FStarC_Compiler_Util.string_of_int nsucc in - FStarC_Compiler_Util.format1 - "succeeded %s times and " uu___7 + let uu___7 = FStarC_Util.string_of_int nsucc in + FStarC_Util.format1 "succeeded %s times and " + uu___7 else "" in let uu___7 = if quaking - then FStarC_Compiler_Util.string_of_int nfail + then FStarC_Util.string_of_int nfail else - (let uu___9 = - FStarC_Compiler_Util.string_of_int nfail in + (let uu___9 = FStarC_Util.string_of_int nfail in Prims.strcat uu___9 " times") in - let uu___8 = - FStarC_Compiler_Util.string_of_int (hi1 - n) in - FStarC_Compiler_Util.print5 + let uu___8 = FStarC_Util.string_of_int (hi1 - n) in + FStarC_Util.print5 "%s: so far query %s %sfailed %s (%s runs remain)\n" (if quaking then "Quake" else "Retry") name uu___6 uu___7 uu___8 @@ -1578,26 +1621,25 @@ let (ask_solver_quake : query_settings Prims.list -> answer) = then (let fuel_msg = let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang best_fuel in - let uu___4 = FStarC_Compiler_Effect.op_Bang best_ifuel in + let uu___3 = FStarC_Effect.op_Bang best_fuel in + let uu___4 = FStarC_Effect.op_Bang best_ifuel in (uu___3, uu___4) in match uu___2 with | (FStar_Pervasives_Native.Some f, FStar_Pervasives_Native.Some i) -> - let uu___3 = FStarC_Compiler_Util.string_of_int f in - let uu___4 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format2 - " (best fuel=%s, best ifuel=%s)" uu___3 uu___4 + let uu___3 = FStarC_Util.string_of_int f in + let uu___4 = FStarC_Util.string_of_int i in + FStarC_Util.format2 " (best fuel=%s, best ifuel=%s)" uu___3 + uu___4 | (uu___3, uu___4) -> "" in - let uu___2 = FStarC_Compiler_Util.string_of_int nsuccess in - let uu___3 = FStarC_Compiler_Util.string_of_int total_ran in - FStarC_Compiler_Util.print5 - "Quake: query %s succeeded %s/%s times%s%s\n" name uu___2 - uu___3 (if total_ran < hi1 then " (early finish)" else "") - fuel_msg) + let uu___2 = FStarC_Util.string_of_int nsuccess in + let uu___3 = FStarC_Util.string_of_int total_ran in + FStarC_Util.print5 "Quake: query %s succeeded %s/%s times%s%s\n" + name uu___2 uu___3 + (if total_ran < hi1 then " (early finish)" else "") fuel_msg) else (); (let all_errs = - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun uu___2 -> match uu___2 with | FStar_Pervasives.Inr uu___3 -> [] @@ -1650,8 +1692,8 @@ let (ask_solver_recover : query_settings Prims.list -> answer) = (if r.ok then r else - (let restarted = FStarC_Compiler_Util.mk_ref false in - let cfg = FStarC_Compiler_List.last configs in + (let restarted = FStarC_Util.mk_ref false in + let cfg = FStarC_List.last configs in (let uu___3 = let uu___4 = FStarC_Errors_Msg.text @@ -1691,7 +1733,8 @@ let (ask_solver_recover : query_settings Prims.list -> answer) = query_hash = (cfg.query_hash); query_can_be_split_and_retried = (cfg.query_can_be_split_and_retried); - query_term = (cfg.query_term) + query_term = (cfg.query_term); + query_record_hints = (cfg.query_record_hints) } in ask_solver_quake [cfg1]) in let rec try_hammer h = @@ -1755,8 +1798,8 @@ let (ask_solver_recover : query_settings Prims.list -> answer) = IncreaseRLimit (Prims.of_int (8)); RestartAnd (IncreaseRLimit (Prims.of_int (8)))]))) else ask_solver_quake configs -let (failing_query_ctr : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero +let (failing_query_ctr : Prims.int FStarC_Effect.ref) = + FStarC_Util.mk_ref Prims.int_zero let (maybe_save_failing_query : FStarC_SMTEncoding_Env.env_t -> query_settings -> unit) = fun env -> @@ -1771,25 +1814,24 @@ let (maybe_save_failing_query : FStarC_Class_Show.show FStarC_Ident.showable_lident uu___2 in let n = (let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang failing_query_ctr in + let uu___4 = FStarC_Effect.op_Bang failing_query_ctr in uu___4 + Prims.int_one in - FStarC_Compiler_Effect.op_Colon_Equals failing_query_ctr uu___3); - FStarC_Compiler_Effect.op_Bang failing_query_ctr in + FStarC_Effect.op_Colon_Equals failing_query_ctr uu___3); + FStarC_Effect.op_Bang failing_query_ctr in let file_name = let uu___2 = FStarC_Class_Show.show FStarC_Class_Show.showable_int n in - FStarC_Compiler_Util.format2 "failedQueries-%s-%s.smt2" mod1 - uu___2 in + FStarC_Util.format2 "failedQueries-%s-%s.smt2" mod1 uu___2 in let query_str = let uu___2 = with_fuel_and_diagnostics qs [] in let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_int qs.query_index in - FStarC_Compiler_Util.format2 "(%s, %s)" qs.query_name uu___4 in + let uu___4 = FStarC_Util.string_of_int qs.query_index in + FStarC_Util.format2 "(%s, %s)" qs.query_name uu___4 in FStarC_SMTEncoding_Z3.ask_text qs.query_range qs.query_hash qs.query_all_labels uu___2 uu___3 qs.query_hint in - FStarC_Compiler_Util.write_file file_name query_str + FStarC_Util.write_file file_name query_str else ()); - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_SMTFail in + (let uu___2 = FStarC_Effect.op_Bang dbg_SMTFail in if uu___2 then let uu___3 = @@ -1808,13 +1850,13 @@ let (maybe_save_failing_query : let (ask_solver : FStarC_SMTEncoding_Env.env_t -> query_settings Prims.list -> - FStarC_Compiler_Hints.hint FStar_Pervasives_Native.option -> + FStarC_Hints.hint FStar_Pervasives_Native.option -> (query_settings Prims.list * answer)) = fun env -> fun configs -> fun next_hint -> - let default_settings = FStarC_Compiler_List.hd configs in + let default_settings = FStarC_List.hd configs in let skip = ((env.FStarC_SMTEncoding_Env.tcenv).FStarC_TypeChecker_Env.admit || (FStarC_TypeChecker_Env.too_early_in_prims @@ -1823,7 +1865,7 @@ let (ask_solver : (let uu___ = FStarC_Options.admit_except () in match uu___ with | FStar_Pervasives_Native.Some id -> - if FStarC_Compiler_Util.starts_with id "(" + if FStarC_Util.starts_with id "(" then let uu___1 = full_query_id default_settings in uu___1 <> id @@ -1834,16 +1876,15 @@ let (ask_solver : then ((let uu___1 = (FStarC_Options.record_hints ()) && - (FStarC_Compiler_Util.is_some next_hint) in + (FStarC_Util.is_some next_hint) in if uu___1 then - let uu___2 = FStarC_Compiler_Util.must next_hint in - store_hint uu___2 + let uu___2 = FStarC_Util.must next_hint in store_hint uu___2 else ()); ans_ok) else (let ans1 = ask_solver_recover configs in - let cfg = FStarC_Compiler_List.last configs in + let cfg = FStarC_List.last configs in if Prims.op_Negation ans1.ok then maybe_save_failing_query env cfg else (); @@ -1888,12 +1929,13 @@ let (report : FStarC_TypeChecker_Env.env -> query_settings -> answer -> unit) query_hash = (default_settings.query_hash); query_can_be_split_and_retried = (default_settings.query_can_be_split_and_retried); - query_term = (default_settings.query_term) + query_term = (default_settings.query_term); + query_record_hints = (default_settings.query_record_hints) } in - let errs = FStarC_Compiler_List.map errors_to_report1 all_errs in - let errs1 = collect_dups (FStarC_Compiler_List.flatten errs) in + let errs = FStarC_List.map errors_to_report1 all_errs in + let errs1 = collect_dups (FStarC_List.flatten errs) in let errs2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | ((e, m, r, ctx), n) -> @@ -1903,13 +1945,12 @@ let (report : FStarC_TypeChecker_Env.env -> query_settings -> answer -> unit) let uu___2 = let uu___3 = let uu___4 = - let uu___5 = - FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 - "Repeated %s times" uu___5 in + let uu___5 = FStarC_Util.string_of_int n in + FStarC_Util.format1 "Repeated %s times" + uu___5 in FStarC_Pprint.doc_of_string uu___4 in [uu___3] in - FStarC_Compiler_List.op_At m uu___2 + FStarC_List.op_At m uu___2 else m in (e, m1, r, ctx)) errs1 in (FStarC_Errors.add_errors errs2; @@ -1921,18 +1962,16 @@ let (report : FStarC_TypeChecker_Env.env -> query_settings -> answer -> unit) with | FStar_Pervasives_Native.Some (l, uu___2, uu___3) -> FStarC_Ident.range_of_lid l - | uu___2 -> FStarC_Compiler_Range_Type.dummyRange in + | uu___2 -> FStarC_Range_Type.dummyRange in let uu___2 = let uu___3 = let uu___4 = let uu___5 = - let uu___6 = - FStarC_Compiler_Util.string_of_int nsuccess in - let uu___7 = - FStarC_Compiler_Util.string_of_int total_ran in - let uu___8 = FStarC_Compiler_Util.string_of_int lo in - let uu___9 = FStarC_Compiler_Util.string_of_int hi in - FStarC_Compiler_Util.format6 + let uu___6 = FStarC_Util.string_of_int nsuccess in + let uu___7 = FStarC_Util.string_of_int total_ran in + let uu___8 = FStarC_Util.string_of_int lo in + let uu___9 = FStarC_Util.string_of_int hi in + FStarC_Util.format6 "Query %s failed the quake test, %s out of %s attempts succeded, but the threshold was %s out of %s%s" name uu___6 uu___7 uu___8 uu___9 (if total_ran < hi then " (early abort)" else "") in @@ -1960,9 +1999,11 @@ let (report : FStarC_TypeChecker_Env.env -> query_settings -> answer -> unit) query_hash = (default_settings.query_hash); query_can_be_split_and_retried = (default_settings.query_can_be_split_and_retried); - query_term = (default_settings.query_term) + query_term = (default_settings.query_term); + query_record_hints = + (default_settings.query_record_hints) } in - FStarC_Compiler_List.iter report1 all_errs)) + FStarC_List.iter report1 all_errs)) else () type solver_cfg = { @@ -1973,54 +2014,59 @@ type solver_cfg = valid_intro: Prims.bool ; valid_elim: Prims.bool ; z3version: Prims.string ; - context_pruning: Prims.bool } + context_pruning: Prims.bool ; + record_hints: Prims.bool } let (__proj__Mksolver_cfg__item__seed : solver_cfg -> Prims.int) = fun projectee -> match projectee with | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; - context_pruning;_} -> seed + context_pruning; record_hints;_} -> seed let (__proj__Mksolver_cfg__item__cliopt : solver_cfg -> Prims.string Prims.list) = fun projectee -> match projectee with | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; - context_pruning;_} -> cliopt + context_pruning; record_hints;_} -> cliopt let (__proj__Mksolver_cfg__item__smtopt : solver_cfg -> Prims.string Prims.list) = fun projectee -> match projectee with | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; - context_pruning;_} -> smtopt + context_pruning; record_hints;_} -> smtopt let (__proj__Mksolver_cfg__item__facts : solver_cfg -> (Prims.string Prims.list * Prims.bool) Prims.list) = fun projectee -> match projectee with | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; - context_pruning;_} -> facts + context_pruning; record_hints;_} -> facts let (__proj__Mksolver_cfg__item__valid_intro : solver_cfg -> Prims.bool) = fun projectee -> match projectee with | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; - context_pruning;_} -> valid_intro + context_pruning; record_hints;_} -> valid_intro let (__proj__Mksolver_cfg__item__valid_elim : solver_cfg -> Prims.bool) = fun projectee -> match projectee with | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; - context_pruning;_} -> valid_elim + context_pruning; record_hints;_} -> valid_elim let (__proj__Mksolver_cfg__item__z3version : solver_cfg -> Prims.string) = fun projectee -> match projectee with | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; - context_pruning;_} -> z3version + context_pruning; record_hints;_} -> z3version let (__proj__Mksolver_cfg__item__context_pruning : solver_cfg -> Prims.bool) = fun projectee -> match projectee with | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; - context_pruning;_} -> context_pruning -let (_last_cfg : - solver_cfg FStar_Pervasives_Native.option FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + context_pruning; record_hints;_} -> context_pruning +let (__proj__Mksolver_cfg__item__record_hints : solver_cfg -> Prims.bool) = + fun projectee -> + match projectee with + | { seed; cliopt; smtopt; facts; valid_intro; valid_elim; z3version; + context_pruning; record_hints;_} -> record_hints +let (_last_cfg : solver_cfg FStar_Pervasives_Native.option FStarC_Effect.ref) + = FStarC_Util.mk_ref FStar_Pervasives_Native.None let (get_cfg : FStarC_TypeChecker_Env.env -> solver_cfg) = fun env -> let uu___ = FStarC_Options.z3_seed () in @@ -2029,8 +2075,8 @@ let (get_cfg : FStarC_TypeChecker_Env.env -> solver_cfg) = let uu___3 = FStarC_Options.smtencoding_valid_intro () in let uu___4 = FStarC_Options.smtencoding_valid_elim () in let uu___5 = FStarC_Options.z3_version () in - let uu___6 = - let uu___7 = FStarC_Options_Ext.get "context_pruning" in uu___7 <> "" in + let uu___6 = FStarC_Options_Ext.enabled "context_pruning" in + let uu___7 = FStarC_Options.record_hints () in { seed = uu___; cliopt = uu___1; @@ -2039,16 +2085,17 @@ let (get_cfg : FStarC_TypeChecker_Env.env -> solver_cfg) = valid_intro = uu___3; valid_elim = uu___4; z3version = uu___5; - context_pruning = uu___6 + context_pruning = uu___6; + record_hints = uu___7 } let (save_cfg : FStarC_TypeChecker_Env.env -> unit) = fun env -> let uu___ = let uu___1 = get_cfg env in FStar_Pervasives_Native.Some uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals _last_cfg uu___ + FStarC_Effect.op_Colon_Equals _last_cfg uu___ let (maybe_refresh_solver : FStarC_TypeChecker_Env.env -> unit) = fun env -> - let uu___ = FStarC_Compiler_Effect.op_Bang _last_cfg in + let uu___ = FStarC_Effect.op_Bang _last_cfg in match uu___ with | FStar_Pervasives_Native.None -> save_cfg env | FStar_Pervasives_Native.Some cfg -> @@ -2065,7 +2112,7 @@ let finally : 'a . (unit -> unit) -> (unit -> 'a) -> 'a = fun f -> let r = try (fun uu___ -> match () with | () -> f ()) () - with | uu___ -> (h (); FStarC_Compiler_Effect.raise uu___) in + with | uu___ -> (h (); FStarC_Effect.raise uu___) in h (); r let (encode_and_ask : Prims.bool -> @@ -2084,8 +2131,8 @@ let (encode_and_ask : (let msg = let uu___2 = let uu___3 = FStarC_TypeChecker_Env.get_range tcenv in - FStarC_Compiler_Range_Ops.string_of_range uu___3 in - FStarC_Compiler_Util.format1 "Starting query at %s" uu___2 in + FStarC_Range_Ops.string_of_range uu___3 in + FStarC_Util.format1 "Starting query at %s" uu___2 in FStarC_SMTEncoding_Encode.push_encoding_state msg; (let uu___3 = FStarC_SMTEncoding_Encode.encode_query use_env_msg tcenv q in @@ -2097,9 +2144,8 @@ let (encode_and_ask : let uu___6 = let uu___7 = FStarC_TypeChecker_Env.get_range tcenv in - FStarC_Compiler_Range_Ops.string_of_range uu___7 in - FStarC_Compiler_Util.format1 "Ending query at %s" - uu___6 in + FStarC_Range_Ops.string_of_range uu___7 in + FStarC_Util.format1 "Ending query at %s" uu___6 in FStarC_SMTEncoding_Encode.pop_encoding_state msg1; FStarC_SMTEncoding_Z3.finish_query msg1 in finally finish_query @@ -2135,10 +2181,10 @@ let (encode_and_ask : (let uu___9 = FStarC_Options.split_queries () in uu___9 = FStarC_Options.Always)) - && (FStarC_Compiler_Debug.any ()) in + && (FStarC_Debug.any ()) in if uu___8 then - let n = FStarC_Compiler_List.length labels in + let n = FStarC_List.length labels in (if n <> Prims.int_one then let uu___9 = @@ -2153,9 +2199,8 @@ let (encode_and_ask : FStarC_SMTEncoding_Term.declToSmt "" qry in let uu___13 = - FStarC_Compiler_Util.string_of_int - n in - FStarC_Compiler_Util.format3 + FStarC_Util.string_of_int n in + FStarC_Util.format3 "Encoded split query %s\nto %s\nwith %s labels" uu___11 uu___12 uu___13 in FStarC_Errors.diag @@ -2230,10 +2275,10 @@ let (do_solve : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst names in - FStarC_Compiler_String.concat "," uu___7 in - FStarC_Compiler_Util.format1 + FStarC_List.map FStar_Pervasives_Native.fst + names in + FStarC_String.concat "," uu___7 in + FStarC_Util.format1 "Could not encode the query since F* does not support precise smtencoding of inner let-recs yet (in this case %s)" uu___6 in FStarC_Errors_Msg.text uu___5 in @@ -2262,18 +2307,17 @@ let (split_and_solve : fun tcenv -> fun q -> (let uu___1 = - (FStarC_Compiler_Debug.any ()) || - (FStarC_Options.query_stats ()) in + (FStarC_Debug.any ()) || (FStarC_Options.query_stats ()) in if uu___1 then let range = let uu___2 = let uu___3 = let uu___4 = FStarC_TypeChecker_Env.get_range tcenv in - FStarC_Compiler_Range_Ops.string_of_range uu___4 in + FStarC_Range_Ops.string_of_range uu___4 in Prims.strcat uu___3 ")" in Prims.strcat "(" uu___2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "%s\tQuery-stats splitting query because %s\n" range (if retrying then "retrying failed query" @@ -2285,7 +2329,7 @@ let (split_and_solve : | FStar_Pervasives_Native.None -> failwith "Impossible: split_query callback is not set" | FStar_Pervasives_Native.Some goals1 -> goals1 in - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___2 -> match uu___2 with | (env, goal) -> do_solve false retrying use_env_msg env goal) @@ -2387,7 +2431,7 @@ let (solve_sync : then ans_fail else (let go uu___2 = - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_SMTQuery in + (let uu___4 = FStarC_Effect.op_Bang dbg_SMTQuery in if uu___4 then let uu___5 = @@ -2468,7 +2512,7 @@ let (solver : FStarC_TypeChecker_Env.solver_t) = FStarC_TypeChecker_Env.handle_smt_goal = (fun e -> fun g -> [(e, g)]); FStarC_TypeChecker_Env.solve = solve; FStarC_TypeChecker_Env.solve_sync = solve_sync_bool; - FStarC_TypeChecker_Env.finish = (fun uu___ -> ()); + FStarC_TypeChecker_Env.finish = FStarC_SMTEncoding_Z3.stop; FStarC_TypeChecker_Env.refresh = FStarC_SMTEncoding_Z3.refresh } let (dummy : FStarC_TypeChecker_Env.solver_t) = diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_SolverState.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_SolverState.ml similarity index 87% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_SolverState.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_SolverState.ml index f05966fe2d5..1bc13b3513d 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_SolverState.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_SolverState.ml @@ -1,17 +1,17 @@ open Prims type using_facts_from_setting = (Prims.string Prims.list * Prims.bool) Prims.list -type decl_name_set = Prims.bool FStarC_Compiler_Util.psmap -let (empty_decl_names : Prims.bool FStarC_Compiler_Util.psmap) = - FStarC_Compiler_Util.psmap_empty () +type decl_name_set = Prims.bool FStarC_Util.psmap +let (empty_decl_names : Prims.bool FStarC_Util.psmap) = + FStarC_Util.psmap_empty () let (decl_names_contains : Prims.string -> decl_name_set -> Prims.bool) = fun x -> fun s -> - let uu___ = FStarC_Compiler_Util.psmap_try_find s x in + let uu___ = FStarC_Util.psmap_try_find s x in FStar_Pervasives_Native.uu___is_Some uu___ let (add_name : - Prims.string -> decl_name_set -> Prims.bool FStarC_Compiler_Util.psmap) = - fun x -> fun s -> FStarC_Compiler_Util.psmap_add s x true + Prims.string -> decl_name_set -> Prims.bool FStarC_Util.psmap) = + fun x -> fun s -> FStarC_Util.psmap_add s x true type decls_at_level = { pruning_state: FStarC_SMTEncoding_Pruning.pruning_state ; @@ -19,8 +19,7 @@ type decls_at_level = all_decls_at_level_rev: FStarC_SMTEncoding_Term.decl Prims.list Prims.list ; given_some_decls: Prims.bool ; to_flush_rev: FStarC_SMTEncoding_Term.decl Prims.list Prims.list ; - named_assumptions: - FStarC_SMTEncoding_Term.assumption FStarC_Compiler_Util.psmap ; + named_assumptions: FStarC_SMTEncoding_Term.assumption FStarC_Util.psmap ; pruning_roots: FStarC_SMTEncoding_Term.decl Prims.list FStar_Pervasives_Native.option } let (__proj__Mkdecls_at_level__item__pruning_state : @@ -59,9 +58,7 @@ let (__proj__Mkdecls_at_level__item__to_flush_rev : given_some_decls; to_flush_rev; named_assumptions; pruning_roots;_} -> to_flush_rev let (__proj__Mkdecls_at_level__item__named_assumptions : - decls_at_level -> - FStarC_SMTEncoding_Term.assumption FStarC_Compiler_Util.psmap) - = + decls_at_level -> FStarC_SMTEncoding_Term.assumption FStarC_Util.psmap) = fun projectee -> match projectee with | { pruning_state; given_decl_names; all_decls_at_level_rev; @@ -77,7 +74,7 @@ let (__proj__Mkdecls_at_level__item__pruning_roots : given_some_decls; to_flush_rev; named_assumptions; pruning_roots;_} -> pruning_roots let (init_given_decls_at_level : decls_at_level) = - let uu___ = FStarC_Compiler_Util.psmap_empty () in + let uu___ = FStarC_Util.psmap_empty () in { pruning_state = FStarC_SMTEncoding_Pruning.init; given_decl_names = empty_decl_names; @@ -118,22 +115,22 @@ let (__proj__Mksolver_state__item__retain_assumptions : | { levels; pending_flushes_rev; using_facts_from; retain_assumptions;_} -> retain_assumptions let (depth : solver_state -> Prims.int) = - fun s -> FStarC_Compiler_List.length s.levels + fun s -> FStarC_List.length s.levels let (solver_state_to_string : solver_state -> Prims.string) = fun s -> let levels = - FStarC_Compiler_List.map + FStarC_List.map (fun level -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length level.all_decls_at_level_rev) in + (FStarC_List.length level.all_decls_at_level_rev) in let uu___1 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool level.given_some_decls in let uu___2 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length level.to_flush_rev) in - FStarC_Compiler_Util.format3 + (FStarC_List.length level.to_flush_rev) in + FStarC_Util.format3 "Level { all_decls=%s; given_decls=%s; to_flush=%s }" uu___ uu___1 uu___2) s.levels in let uu___ = @@ -142,24 +139,22 @@ let (solver_state_to_string : solver_state -> Prims.string) = levels in let uu___1 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length s.pending_flushes_rev) in - FStarC_Compiler_Util.format2 - "Solver state { levels=%s; pending_flushes=%s }" uu___ uu___1 + (FStarC_List.length s.pending_flushes_rev) in + FStarC_Util.format2 "Solver state { levels=%s; pending_flushes=%s }" + uu___ uu___1 let (showable_solver_state : solver_state FStarC_Class_Show.showable) = { FStarC_Class_Show.show = solver_state_to_string } let (debug : Prims.string -> solver_state -> solver_state -> unit) = fun msg -> fun s0 -> fun s1 -> - let uu___ = - let uu___1 = FStarC_Options_Ext.get "debug_solver_state" in - uu___1 <> "" in + let uu___ = FStarC_Options_Ext.enabled "debug_solver_state" in if uu___ then let uu___1 = solver_state_to_string s0 in let uu___2 = solver_state_to_string s1 in - FStarC_Compiler_Util.print3 - "Debug (%s):{\n\t before=%s\n\t after=%s\n}" msg uu___1 uu___2 + FStarC_Util.print3 "Debug (%s):{\n\t before=%s\n\t after=%s\n}" msg + uu___1 uu___2 else () let (peek : solver_state -> (decls_at_level * decls_at_level Prims.list)) = fun s -> @@ -169,8 +164,7 @@ let (peek : solver_state -> (decls_at_level * decls_at_level Prims.list)) = let (replace_head : decls_at_level -> solver_state -> solver_state) = fun hd -> fun s -> - let uu___ = - let uu___1 = FStarC_Compiler_List.tl s.levels in hd :: uu___1 in + let uu___ = let uu___1 = FStarC_List.tl s.levels in hd :: uu___1 in { levels = uu___; pending_flushes_rev = (s.pending_flushes_rev); @@ -194,7 +188,7 @@ let (push : solver_state -> solver_state) = match uu___ with | (hd, uu___1) -> let push1 = - FStarC_SMTEncoding_Term.Push (FStarC_Compiler_List.length s.levels) in + FStarC_SMTEncoding_Term.Push (FStarC_List.length s.levels) in let next = { pruning_state = (hd.pruning_state); @@ -232,8 +226,7 @@ let (pop : solver_state -> solver_state) = { levels = tl; pending_flushes_rev = - ((FStarC_SMTEncoding_Term.Pop - (FStarC_Compiler_List.length tl)) :: + ((FStarC_SMTEncoding_Term.Pop (FStarC_List.length tl)) :: (s.pending_flushes_rev)); using_facts_from = (s.using_facts_from); retain_assumptions = (s.retain_assumptions) @@ -241,7 +234,7 @@ let (pop : solver_state -> solver_state) = s1)) let (filter_using_facts_from : using_facts_from_setting FStar_Pervasives_Native.option -> - FStarC_SMTEncoding_Term.assumption FStarC_Compiler_Util.psmap -> + FStarC_SMTEncoding_Term.assumption FStarC_Util.psmap -> decl_name_set -> (Prims.string -> Prims.bool) -> FStarC_SMTEncoding_Term.decl Prims.list -> @@ -264,7 +257,7 @@ let (filter_using_facts_from : a.FStarC_SMTEncoding_Term.assumption_name retain_assumptions) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_SMTEncoding_Term.Name lid -> @@ -273,13 +266,13 @@ let (filter_using_facts_from : | uu___2 -> false) a.FStarC_SMTEncoding_Term.assumption_fact_ids) in let already_given_map = - FStarC_Compiler_Util.smap_create (Prims.of_int (1000)) in + FStarC_Util.smap_create (Prims.of_int (1000)) in let add_assumption a = - FStarC_Compiler_Util.smap_add already_given_map + FStarC_Util.smap_add already_given_map a.FStarC_SMTEncoding_Term.assumption_name true in let already_given a = (let uu___ = - FStarC_Compiler_Util.smap_try_find already_given_map + FStarC_Util.smap_try_find already_given_map a.FStarC_SMTEncoding_Term.assumption_name in FStar_Pervasives_Native.uu___is_Some uu___) || (already_given_decl @@ -294,11 +287,11 @@ let (filter_using_facts_from : if uu___ then (add_assumption a; [d]) else [] | FStarC_SMTEncoding_Term.RetainAssumptions names -> let assumptions = - FStarC_Compiler_List.collect + FStarC_List.collect (fun name -> let uu___ = - FStarC_Compiler_Util.psmap_try_find - named_assumptions name in + FStarC_Util.psmap_try_find named_assumptions + name in match uu___ with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some a -> @@ -311,11 +304,11 @@ let (filter_using_facts_from : names in assumptions | uu___ -> [d] in - let ds1 = FStarC_Compiler_List.collect map_decl ds in ds1 + let ds1 = FStarC_List.collect map_decl ds in ds1 let (already_given_decl : solver_state -> Prims.string -> Prims.bool) = fun s -> fun aname -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun level -> decl_names_contains aname level.given_decl_names) s.levels let rec (flatten : @@ -323,21 +316,21 @@ let rec (flatten : fun d -> match d with | FStarC_SMTEncoding_Term.Module (uu___, ds) -> - FStarC_Compiler_List.collect flatten ds + FStarC_List.collect flatten ds | uu___ -> [d] let (add_named_assumptions : - FStarC_SMTEncoding_Term.assumption FStarC_Compiler_Util.psmap -> + FStarC_SMTEncoding_Term.assumption FStarC_Util.psmap -> FStarC_SMTEncoding_Term.decl Prims.list -> - FStarC_SMTEncoding_Term.assumption FStarC_Compiler_Util.psmap) + FStarC_SMTEncoding_Term.assumption FStarC_Util.psmap) = fun named_assumptions -> fun ds -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun named_assumptions1 -> fun d -> match d with | FStarC_SMTEncoding_Term.Assume a -> - FStarC_Compiler_Util.psmap_add named_assumptions1 + FStarC_Util.psmap_add named_assumptions1 a.FStarC_SMTEncoding_Term.assumption_name a | uu___ -> named_assumptions1) named_assumptions ds let (add_retain_assumptions : @@ -345,12 +338,12 @@ let (add_retain_assumptions : fun ds -> fun s -> let ra = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun ra1 -> fun d -> match d with | FStarC_SMTEncoding_Term.RetainAssumptions names -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun ra2 -> fun name -> add_name name ra2) ra1 names | uu___ -> ra1) s.retain_assumptions ds in { @@ -366,10 +359,9 @@ let (give_delay_assumptions : fun resetting -> fun ds -> fun s -> - let decls = FStarC_Compiler_List.collect flatten ds in + let decls = FStarC_List.collect flatten ds in let uu___ = - FStarC_Compiler_List.partition - FStarC_SMTEncoding_Term.uu___is_Assume decls in + FStarC_List.partition FStarC_SMTEncoding_Term.uu___is_Assume decls in match uu___ with | (assumptions, rest) -> let uu___1 = peek s in @@ -425,10 +417,9 @@ let (give_now : fun resetting -> fun ds -> fun s -> - let decls = FStarC_Compiler_List.collect flatten ds in + let decls = FStarC_List.collect flatten ds in let uu___ = - FStarC_Compiler_List.partition - FStarC_SMTEncoding_Term.uu___is_Assume decls in + FStarC_List.partition FStarC_SMTEncoding_Term.uu___is_Assume decls in match uu___ with | (assumptions, uu___1) -> let uu___2 = peek s in @@ -444,7 +435,7 @@ let (give_now : named_assumptions s.retain_assumptions (already_given_decl s) decls in let given = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun given1 -> fun d -> match d with @@ -500,9 +491,7 @@ let (give_aux : fun resetting -> fun ds -> fun s -> - let uu___ = - let uu___1 = FStarC_Options_Ext.get "context_pruning" in - uu___1 <> "" in + let uu___ = FStarC_Options_Ext.enabled "context_pruning" in if uu___ then give_delay_assumptions resetting ds s else give_now resetting ds s @@ -565,7 +554,7 @@ let (reset : retain_assumptions = (s_new2.retain_assumptions) } in let s1 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (if now then give_now true else give_aux true) level.all_decls_at_level_rev s_new3 in let uu___1 = set_pruning_roots level s1 in @@ -596,7 +585,7 @@ let (prune_level : fun s -> let to_give = FStarC_SMTEncoding_Pruning.prune hd.pruning_state roots in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun to_give1 -> match uu___1 with @@ -643,10 +632,9 @@ let (prune_sim : s.retain_assumptions (already_given_decl s) to_give in let uu___1 = let uu___2 = - FStarC_Compiler_List.filter - FStarC_SMTEncoding_Term.uu___is_Assume roots in + FStarC_List.filter FStarC_SMTEncoding_Term.uu___is_Assume roots in FStar_List_Tot_Base.op_At uu___2 can_give in - FStarC_Compiler_List.map name_of_assumption uu___1 + FStarC_List.map name_of_assumption uu___1 let (start_query : Prims.string -> FStarC_SMTEncoding_Term.decl Prims.list -> @@ -716,20 +704,18 @@ let (filter_with_unsat_core : | level::levels1 -> let uu___ = let uu___1 = all_decls levels1 in - [FStarC_SMTEncoding_Term.Push - (FStarC_Compiler_List.length levels1)] + [FStarC_SMTEncoding_Term.Push (FStarC_List.length levels1)] :: uu___1 in FStar_List_Tot_Base.op_At level.all_decls_at_level_rev uu___ in let all_decls1 = all_decls s.levels in - let all_decls2 = - FStarC_Compiler_List.flatten (FStarC_Compiler_List.rev all_decls1) in + let all_decls2 = FStarC_List.flatten (FStarC_List.rev all_decls1) in FStarC_SMTEncoding_UnsatCore.filter core all_decls2 let (would_have_pruned : solver_state -> Prims.string Prims.list FStar_Pervasives_Native.option) = fun s -> let uu___ = - let uu___1 = FStarC_Options_Ext.get "context_pruning_sim" in - uu___1 = "" in + let uu___1 = FStarC_Options_Ext.enabled "context_pruning_sim" in + Prims.op_Negation uu___1 in if uu___ then FStar_Pervasives_Native.None else @@ -747,8 +733,7 @@ let (flush : solver_state -> (FStarC_SMTEncoding_Term.decl Prims.list * solver_state)) = fun s -> let s1 = - let uu___ = - let uu___1 = FStarC_Options_Ext.get "context_pruning" in uu___1 <> "" in + let uu___ = FStarC_Options_Ext.enabled "context_pruning" in if uu___ then let rec aux levels = @@ -771,12 +756,11 @@ let (flush : let to_flush = let uu___ = let uu___1 = - FStarC_Compiler_List.collect (fun level -> level.to_flush_rev) - s1.levels in - FStarC_Compiler_List.rev uu___1 in - FStarC_Compiler_List.flatten uu___ in + FStarC_List.collect (fun level -> level.to_flush_rev) s1.levels in + FStarC_List.rev uu___1 in + FStarC_List.flatten uu___ in let levels = - FStarC_Compiler_List.map + FStarC_List.map (fun level -> { pruning_state = (level.pruning_state); @@ -797,6 +781,6 @@ let (flush : retain_assumptions = (s1.retain_assumptions) } in let flushed = - FStar_List_Tot_Base.op_At - (FStarC_Compiler_List.rev s1.pending_flushes_rev) to_flush in + FStar_List_Tot_Base.op_At (FStarC_List.rev s1.pending_flushes_rev) + to_flush in (flushed, s11) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Solver_Cache.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Solver_Cache.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_Solver_Cache.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Solver_Cache.ml index ef134ecf9a9..1c101d189d8 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Solver_Cache.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Solver_Cache.ml @@ -336,14 +336,14 @@ let (hashable_env : FStarC_Hash.mix uu___ uu___1) } let (query_cache_ref : - FStarC_Hash.hash_code FStarC_Compiler_RBSet.t FStarC_Compiler_Effect.ref) = + FStarC_Hash.hash_code FStarC_RBSet.t FStarC_Effect.ref) = let uu___ = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Hashable.ord_hash_code)) ()) in - FStarC_Compiler_Util.mk_ref uu___ + (FStarC_RBSet.setlike_rbset FStarC_Class_Hashable.ord_hash_code)) + ()) in + FStarC_Util.mk_ref uu___ let (on : unit -> Prims.bool) = fun uu___ -> (FStarC_Options.query_cache ()) && (FStarC_Options.ide ()) let (query_cache_add : @@ -358,14 +358,14 @@ let (query_cache_add : (FStarC_Class_Hashable.hashable_tuple2 hashable_env FStarC_Syntax_Hash.hashable_term) (g, q) in let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang query_cache_ref in + let uu___2 = FStarC_Effect.op_Bang query_cache_ref in Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Hashable.ord_hash_code)) h (Obj.magic uu___2)) in - FStarC_Compiler_Effect.op_Colon_Equals query_cache_ref uu___1 + FStarC_Effect.op_Colon_Equals query_cache_ref uu___1 else () let (try_find_query_cache : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> Prims.bool) = @@ -379,10 +379,10 @@ let (try_find_query_cache : (FStarC_Class_Hashable.hashable_tuple2 hashable_env FStarC_Syntax_Hash.hashable_term) (g, q) in let r = - let uu___1 = FStarC_Compiler_Effect.op_Bang query_cache_ref in + let uu___1 = FStarC_Effect.op_Bang query_cache_ref in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Hashable.ord_hash_code)) h (Obj.magic uu___1) in r else false \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Term.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Term.ml similarity index 80% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_Term.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Term.ml index 2dd4c30aaac..436b7b1159c 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Term.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Term.ml @@ -167,13 +167,13 @@ type term' = FStar_Pervasives_Native.option * sort Prims.list * term) | Let of (term Prims.list * term) | Labeled of (term * FStarC_Errors_Msg.error_message * - FStarC_Compiler_Range_Type.range) + FStarC_Range_Type.range) | LblPos of (term * Prims.string) and term = { tm: term' ; freevars: fv Prims.list FStarC_Syntax_Syntax.memo ; - rng: FStarC_Compiler_Range_Type.range } + rng: FStarC_Range_Type.range } and fv = | FV of (Prims.string * sort * Prims.bool) let (uu___is_Integer : term' -> Prims.bool) = @@ -214,9 +214,7 @@ let (__proj__Let__item___0 : term' -> (term Prims.list * term)) = let (uu___is_Labeled : term' -> Prims.bool) = fun projectee -> match projectee with | Labeled _0 -> true | uu___ -> false let (__proj__Labeled__item___0 : - term' -> - (term * FStarC_Errors_Msg.error_message * - FStarC_Compiler_Range_Type.range)) + term' -> (term * FStarC_Errors_Msg.error_message * FStarC_Range_Type.range)) = fun projectee -> match projectee with | Labeled _0 -> _0 let (uu___is_LblPos : term' -> Prims.bool) = fun projectee -> match projectee with | LblPos _0 -> true | uu___ -> false @@ -227,7 +225,7 @@ let (__proj__Mkterm__item__tm : term -> term') = let (__proj__Mkterm__item__freevars : term -> fv Prims.list FStarC_Syntax_Syntax.memo) = fun projectee -> match projectee with | { tm; freevars; rng;_} -> freevars -let (__proj__Mkterm__item__rng : term -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mkterm__item__rng : term -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { tm; freevars; rng;_} -> rng let (uu___is_FV : fv -> Prims.bool) = fun projectee -> true let (__proj__FV__item___0 : fv -> (Prims.string * sort * Prims.bool)) = @@ -316,7 +314,7 @@ type assumption = assumption_caption: caption ; assumption_name: Prims.string ; assumption_fact_ids: fact_db_id Prims.list ; - assumption_free_names: Prims.string FStarC_Compiler_RBSet.t } + assumption_free_names: Prims.string FStarC_RBSet.t } let (__proj__Mkassumption__item__assumption_term : assumption -> term) = fun projectee -> match projectee with @@ -341,7 +339,7 @@ let (__proj__Mkassumption__item__assumption_fact_ids : | { assumption_term; assumption_caption; assumption_name; assumption_fact_ids; assumption_free_names;_} -> assumption_fact_ids let (__proj__Mkassumption__item__assumption_free_names : - assumption -> Prims.string FStarC_Compiler_RBSet.t) = + assumption -> Prims.string FStarC_RBSet.t) = fun projectee -> match projectee with | { assumption_term; assumption_caption; assumption_name; @@ -449,7 +447,7 @@ let (__proj__Mkdecls_elt__item__a_names : match projectee with | { sym_name; key; decls; a_names;_} -> a_names type decls_t = decls_elt Prims.list let (escape : Prims.string -> Prims.string) = - fun s -> FStarC_Compiler_Util.replace_char s 39 95 + fun s -> FStarC_Util.replace_char s 39 95 let rec (strSort : sort -> Prims.string) = fun x -> match x with @@ -459,16 +457,16 @@ let rec (strSort : sort -> Prims.string) = | String_sort -> "FString" | Fuel_sort -> "Fuel" | BitVec_sort n -> - let uu___ = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "(_ BitVec %s)" uu___ + let uu___ = FStarC_Util.string_of_int n in + FStarC_Util.format1 "(_ BitVec %s)" uu___ | Array (s1, s2) -> let uu___ = strSort s1 in let uu___1 = strSort s2 in - FStarC_Compiler_Util.format2 "(Array %s %s)" uu___ uu___1 + FStarC_Util.format2 "(Array %s %s)" uu___ uu___1 | Arrow (s1, s2) -> let uu___ = strSort s1 in let uu___1 = strSort s2 in - FStarC_Compiler_Util.format2 "(%s -> %s)" uu___ uu___1 + FStarC_Util.format2 "(%s -> %s)" uu___ uu___1 | Sort s -> s let (mk_decls : Prims.string -> @@ -480,19 +478,18 @@ let (mk_decls : fun aux_decls -> let uu___ = let uu___1 = - let sm = FStarC_Compiler_Util.smap_create (Prims.of_int (20)) in - FStarC_Compiler_List.iter + let sm = FStarC_Util.smap_create (Prims.of_int (20)) in + FStarC_List.iter (fun elt -> - FStarC_Compiler_List.iter - (fun s -> FStarC_Compiler_Util.smap_add sm s "0") + FStarC_List.iter (fun s -> FStarC_Util.smap_add sm s "0") elt.a_names) aux_decls; - FStarC_Compiler_List.iter + FStarC_List.iter (fun d -> match d with | Assume a -> - FStarC_Compiler_Util.smap_add sm a.assumption_name "0" + FStarC_Util.smap_add sm a.assumption_name "0" | uu___4 -> ()) decls; - FStarC_Compiler_Util.smap_keys sm in + FStarC_Util.smap_keys sm in { sym_name = (FStar_Pervasives_Native.Some name); key = (FStar_Pervasives_Native.Some key); @@ -504,7 +501,7 @@ let (mk_decls_trivial : decl Prims.list -> decls_t) = fun decls -> let uu___ = let uu___1 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___2 -> match uu___2 with | Assume a -> [a.assumption_name] @@ -517,7 +514,7 @@ let (mk_decls_trivial : decl Prims.list -> decls_t) = } in [uu___] let (decls_list_of : decls_t -> decl Prims.list) = - fun l -> FStarC_Compiler_List.collect (fun elt -> elt.decls) l + fun l -> FStarC_List.collect (fun elt -> elt.decls) l let (mk_fv : (Prims.string * sort) -> fv) = fun uu___ -> match uu___ with | (x, y) -> FV (x, y, false) let (fv_name : fv -> Prims.string) = @@ -538,9 +535,8 @@ let (ord_fv : fv FStarC_Class_Ord.ord) = fun fv2 -> let uu___ = let uu___1 = fv_name fv1 in - let uu___2 = fv_name fv2 in - FStarC_Compiler_Util.compare uu___1 uu___2 in - FStarC_Compiler_Order.order_from_int uu___) + let uu___2 = fv_name fv2 in FStarC_Util.compare uu___1 uu___2 in + FStarC_Order.order_from_int uu___) } let (fv_sort : fv -> sort) = fun x -> @@ -549,7 +545,7 @@ let (fv_force : fv -> Prims.bool) = fun x -> let uu___ = x in match uu___ with | FV (uu___1, uu___2, force) -> force type error_label = - (fv * FStarC_Errors_Msg.error_message * FStarC_Compiler_Range_Type.range) + (fv * FStarC_Errors_Msg.error_message * FStarC_Range_Type.range) type error_labels = error_label Prims.list let (fv_eq : fv -> fv -> Prims.bool) = fun x -> @@ -561,14 +557,14 @@ let (fvs_subset_of : fvs -> fvs -> Prims.bool) = let uu___ = Obj.magic (FStarC_Class_Setlike.from_list () - (Obj.magic (FStarC_Compiler_RBSet.setlike_rbset ord_fv)) x) in + (Obj.magic (FStarC_RBSet.setlike_rbset ord_fv)) x) in let uu___1 = Obj.magic (FStarC_Class_Setlike.from_list () - (Obj.magic (FStarC_Compiler_RBSet.setlike_rbset ord_fv)) y) in + (Obj.magic (FStarC_RBSet.setlike_rbset ord_fv)) y) in FStarC_Class_Setlike.subset () - (Obj.magic (FStarC_Compiler_RBSet.setlike_rbset ord_fv)) - (Obj.magic uu___) (Obj.magic uu___1) + (Obj.magic (FStarC_RBSet.setlike_rbset ord_fv)) (Obj.magic uu___) + (Obj.magic uu___1) let (freevar_eq : term -> term -> Prims.bool) = fun x -> fun y -> @@ -594,24 +590,23 @@ let rec (freevars : term -> fv Prims.list) = | BoundV uu___ -> [] | FreeV fv1 when fv_force fv1 -> [] | FreeV fv1 -> [fv1] - | App (uu___, tms) -> FStarC_Compiler_List.collect freevars tms + | App (uu___, tms) -> FStarC_List.collect freevars tms | Quant (uu___, uu___1, uu___2, uu___3, t1) -> freevars t1 | Labeled (t1, uu___, uu___1) -> freevars t1 | LblPos (t1, uu___) -> freevars t1 - | Let (es, body) -> FStarC_Compiler_List.collect freevars (body :: es) + | Let (es, body) -> FStarC_List.collect freevars (body :: es) let (free_variables : term -> fvs) = fun t -> - let uu___ = FStarC_Compiler_Effect.op_Bang t.freevars in + let uu___ = FStarC_Effect.op_Bang t.freevars in match uu___ with | FStar_Pervasives_Native.Some b -> b | FStar_Pervasives_Native.None -> let fvs1 = - let uu___1 = freevars t in - FStarC_Compiler_Util.remove_dups fv_eq uu___1 in - (FStarC_Compiler_Effect.op_Colon_Equals t.freevars + let uu___1 = freevars t in FStarC_Util.remove_dups fv_eq uu___1 in + (FStarC_Effect.op_Colon_Equals t.freevars (FStar_Pervasives_Native.Some fvs1); fvs1) -let (free_top_level_names : term -> Prims.string FStarC_Compiler_RBSet.t) = +let (free_top_level_names : term -> Prims.string FStarC_RBSet.t) = fun t -> let rec free_top_level_names1 uu___1 uu___ = (fun acc -> @@ -622,7 +617,7 @@ let (free_top_level_names : term -> Prims.string FStarC_Compiler_RBSet.t) = (Obj.repr (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) nm (Obj.magic acc))) | App (Var s, args) -> Obj.magic @@ -631,32 +626,29 @@ let (free_top_level_names : term -> Prims.string FStarC_Compiler_RBSet.t) = Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) s (Obj.magic acc)) in - FStarC_Compiler_List.fold_left free_top_level_names1 - acc1 args)) + FStarC_List.fold_left free_top_level_names1 acc1 args)) | App (uu___, args) -> Obj.magic (Obj.repr - (FStarC_Compiler_List.fold_left free_top_level_names1 acc - args)) + (FStarC_List.fold_left free_top_level_names1 acc args)) | Quant (uu___, pats, uu___1, uu___2, body) -> Obj.magic (Obj.repr (let acc1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc2 -> fun pats1 -> - FStarC_Compiler_List.fold_left - free_top_level_names1 acc2 pats1) acc pats in + FStarC_List.fold_left free_top_level_names1 + acc2 pats1) acc pats in free_top_level_names1 acc1 body)) | Let (tms, t2) -> Obj.magic (Obj.repr (let acc1 = - FStarC_Compiler_List.fold_left free_top_level_names1 - acc tms in + FStarC_List.fold_left free_top_level_names1 acc tms in free_top_level_names1 acc1 t2)) | Labeled (t2, uu___, uu___1) -> Obj.magic (Obj.repr (free_top_level_names1 acc t2)) @@ -667,8 +659,7 @@ let (free_top_level_names : term -> Prims.string FStarC_Compiler_RBSet.t) = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) ()) in + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) ()) in free_top_level_names1 uu___ t let (qop_to_string : qop -> Prims.string) = fun uu___ -> match uu___ with | Forall -> "forall" | Exists -> "exists" @@ -708,11 +699,11 @@ let (op_to_string : op -> Prims.string) = | BvUlt -> "bvult" | BvToNat -> "bv2int" | BvUext n -> - let uu___1 = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "(_ zero_extend %s)" uu___1 + let uu___1 = FStarC_Util.string_of_int n in + FStarC_Util.format1 "(_ zero_extend %s)" uu___1 | NatToBv n -> - let uu___1 = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "(_ int2bv %s)" uu___1 + let uu___1 = FStarC_Util.string_of_int n in + FStarC_Util.format1 "(_ int2bv %s)" uu___1 | Var s -> s let (weightToSmt : Prims.int FStar_Pervasives_Native.option -> Prims.string) = @@ -720,8 +711,8 @@ let (weightToSmt : Prims.int FStar_Pervasives_Native.option -> Prims.string) match uu___ with | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some i -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format1 ":weight %s\n" uu___1 + let uu___1 = FStarC_Util.string_of_int i in + FStarC_Util.format1 ":weight %s\n" uu___1 let rec (hash_of_term' : term' -> Prims.string) = fun t -> match t with @@ -729,8 +720,7 @@ let rec (hash_of_term' : term' -> Prims.string) = | String s -> s | Real r -> r | BoundV i -> - let uu___ = FStarC_Compiler_Util.string_of_int i in - Prims.strcat "@" uu___ + let uu___ = FStarC_Util.string_of_int i in Prims.strcat "@" uu___ | FreeV x -> let uu___ = fv_name x in let uu___1 = @@ -742,8 +732,8 @@ let rec (hash_of_term' : term' -> Prims.string) = let uu___1 = op_to_string op1 in let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_List.map hash_of_term tms in - FStarC_Compiler_String.concat " " uu___4 in + let uu___4 = FStarC_List.map hash_of_term tms in + FStarC_String.concat " " uu___4 in Prims.strcat uu___3 ")" in Prims.strcat uu___1 uu___2 in Prims.strcat "(" uu___ @@ -758,8 +748,8 @@ let rec (hash_of_term' : term' -> Prims.string) = let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_List.map strSort sorts in - FStarC_Compiler_String.concat " " uu___4 in + let uu___4 = FStarC_List.map strSort sorts in + FStarC_String.concat " " uu___4 in let uu___4 = let uu___5 = let uu___6 = hash_of_term body in @@ -770,14 +760,12 @@ let rec (hash_of_term' : term' -> Prims.string) = let uu___11 = let uu___12 = let uu___13 = - FStarC_Compiler_List.map + FStarC_List.map (fun pats1 -> let uu___14 = - FStarC_Compiler_List.map hash_of_term - pats1 in - FStarC_Compiler_String.concat " " uu___14) - pats in - FStarC_Compiler_String.concat "; " uu___13 in + FStarC_List.map hash_of_term pats1 in + FStarC_String.concat " " uu___14) pats in + FStarC_String.concat "; " uu___13 in Prims.strcat uu___12 "))" in Prims.strcat " " uu___11 in Prims.strcat uu___9 uu___10 in @@ -791,8 +779,8 @@ let rec (hash_of_term' : term' -> Prims.string) = | Let (es, body) -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_List.map hash_of_term es in - FStarC_Compiler_String.concat " " uu___2 in + let uu___2 = FStarC_List.map hash_of_term es in + FStarC_String.concat " " uu___2 in let uu___2 = let uu___3 = let uu___4 = hash_of_term body in Prims.strcat uu___4 ")" in @@ -809,7 +797,7 @@ let (boxStringFun : (Prims.string * Prims.string)) = let (boxBitVecFun : Prims.int -> (Prims.string * Prims.string)) = fun sz -> let uu___ = - let uu___1 = FStarC_Compiler_Util.string_of_int sz in + let uu___1 = FStarC_Util.string_of_int sz in Prims.strcat "BoxBitVec" uu___1 in mkBoxFunctions uu___ let (boxRealFun : (Prims.string * Prims.string)) = mkBoxFunctions "BoxReal" @@ -818,57 +806,52 @@ let (isInjective : Prims.string -> Prims.bool) = if (FStar_String.strlen s) >= (Prims.of_int (3)) then (let uu___ = - FStarC_Compiler_String.substring s Prims.int_zero (Prims.of_int (3)) in + FStarC_String.substring s Prims.int_zero (Prims.of_int (3)) in uu___ = "Box") && (let uu___ = - FStarC_Compiler_List.existsML (fun c -> c = 46) + FStarC_List.existsML (fun c -> c = 46) (FStar_String.list_of_string s) in Prims.op_Negation uu___) else false -let (mk : term' -> FStarC_Compiler_Range_Type.range -> term) = +let (mk : term' -> FStarC_Range_Type.range -> term) = fun t -> fun r -> - let uu___ = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let uu___ = FStarC_Util.mk_ref FStar_Pervasives_Native.None in { tm = t; freevars = uu___; rng = r } -let (mkTrue : FStarC_Compiler_Range_Type.range -> term) = +let (mkTrue : FStarC_Range_Type.range -> term) = fun r -> mk (App (TrueOp, [])) r -let (mkFalse : FStarC_Compiler_Range_Type.range -> term) = +let (mkFalse : FStarC_Range_Type.range -> term) = fun r -> mk (App (FalseOp, [])) r let (mkUnreachable : term) = - mk (App ((Var "Unreachable"), [])) FStarC_Compiler_Range_Type.dummyRange -let (mkInteger : Prims.string -> FStarC_Compiler_Range_Type.range -> term) = + mk (App ((Var "Unreachable"), [])) FStarC_Range_Type.dummyRange +let (mkInteger : Prims.string -> FStarC_Range_Type.range -> term) = fun i -> fun r -> - let uu___ = - let uu___1 = FStarC_Compiler_Util.ensure_decimal i in Integer uu___1 in + let uu___ = let uu___1 = FStarC_Util.ensure_decimal i in Integer uu___1 in mk uu___ r -let (mkInteger' : Prims.int -> FStarC_Compiler_Range_Type.range -> term) = +let (mkInteger' : Prims.int -> FStarC_Range_Type.range -> term) = fun i -> - fun r -> - let uu___ = FStarC_Compiler_Util.string_of_int i in mkInteger uu___ r -let (mkReal : Prims.string -> FStarC_Compiler_Range_Type.range -> term) = + fun r -> let uu___ = FStarC_Util.string_of_int i in mkInteger uu___ r +let (mkReal : Prims.string -> FStarC_Range_Type.range -> term) = fun i -> fun r -> mk (Real i) r -let (mkBoundV : Prims.int -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBoundV : Prims.int -> FStarC_Range_Type.range -> term) = fun i -> fun r -> mk (BoundV i) r -let (mkFreeV : fv -> FStarC_Compiler_Range_Type.range -> term) = +let (mkFreeV : fv -> FStarC_Range_Type.range -> term) = fun x -> fun r -> mk (FreeV x) r -let (mkApp' : - (op * term Prims.list) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkApp' : (op * term Prims.list) -> FStarC_Range_Type.range -> term) = fun f -> fun r -> mk (App f) r let (mkApp : - (Prims.string * term Prims.list) -> - FStarC_Compiler_Range_Type.range -> term) - = + (Prims.string * term Prims.list) -> FStarC_Range_Type.range -> term) = fun uu___ -> fun r -> match uu___ with | (s, args) -> mk (App ((Var s), args)) r -let (mkNot : term -> FStarC_Compiler_Range_Type.range -> term) = +let (mkNot : term -> FStarC_Range_Type.range -> term) = fun t -> fun r -> match t.tm with | App (TrueOp, uu___) -> mkFalse r | App (FalseOp, uu___) -> mkTrue r | uu___ -> mkApp' (Not, [t]) r -let (mkAnd : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkAnd : (term * term) -> FStarC_Range_Type.range -> term) = fun uu___ -> fun r -> match uu___ with @@ -879,12 +862,12 @@ let (mkAnd : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = | (App (FalseOp, uu___1), uu___2) -> mkFalse r | (uu___1, App (FalseOp, uu___2)) -> mkFalse r | (App (And, ts1), App (And, ts2)) -> - mkApp' (And, (FStarC_Compiler_List.op_At ts1 ts2)) r + mkApp' (And, (FStarC_List.op_At ts1 ts2)) r | (uu___1, App (And, ts2)) -> mkApp' (And, (t1 :: ts2)) r | (App (And, ts1), uu___1) -> - mkApp' (And, (FStarC_Compiler_List.op_At ts1 [t2])) r + mkApp' (And, (FStarC_List.op_At ts1 [t2])) r | uu___1 -> mkApp' (And, [t1; t2]) r) -let (mkOr : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkOr : (term * term) -> FStarC_Range_Type.range -> term) = fun uu___ -> fun r -> match uu___ with @@ -895,12 +878,12 @@ let (mkOr : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = | (App (FalseOp, uu___1), uu___2) -> t2 | (uu___1, App (FalseOp, uu___2)) -> t1 | (App (Or, ts1), App (Or, ts2)) -> - mkApp' (Or, (FStarC_Compiler_List.op_At ts1 ts2)) r + mkApp' (Or, (FStarC_List.op_At ts1 ts2)) r | (uu___1, App (Or, ts2)) -> mkApp' (Or, (t1 :: ts2)) r | (App (Or, ts1), uu___1) -> - mkApp' (Or, (FStarC_Compiler_List.op_At ts1 [t2])) r + mkApp' (Or, (FStarC_List.op_At ts1 [t2])) r | uu___1 -> mkApp' (Or, [t1; t2]) r) -let (mkImp : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkImp : (term * term) -> FStarC_Range_Type.range -> term) = fun uu___ -> fun r -> match uu___ with @@ -915,33 +898,30 @@ let (mkImp : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = (Imp, uu___3) in mkApp' uu___2 r | uu___1 -> mkApp' (Imp, [t1; t2]) r) -let (mk_bin_op : - op -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mk_bin_op : op -> (term * term) -> FStarC_Range_Type.range -> term) = fun op1 -> fun uu___ -> fun r -> match uu___ with | (t1, t2) -> mkApp' (op1, [t1; t2]) r -let (mkMinus : term -> FStarC_Compiler_Range_Type.range -> term) = +let (mkMinus : term -> FStarC_Range_Type.range -> term) = fun t -> fun r -> mkApp' (Minus, [t]) r -let (mkNatToBv : - Prims.int -> term -> FStarC_Compiler_Range_Type.range -> term) = +let (mkNatToBv : Prims.int -> term -> FStarC_Range_Type.range -> term) = fun sz -> fun t -> fun r -> mkApp' ((NatToBv sz), [t]) r -let (mkBvUext : - Prims.int -> term -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvUext : Prims.int -> term -> FStarC_Range_Type.range -> term) = fun sz -> fun t -> fun r -> mkApp' ((BvUext sz), [t]) r -let (mkBvToNat : term -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvToNat : term -> FStarC_Range_Type.range -> term) = fun t -> fun r -> mkApp' (BvToNat, [t]) r -let (mkBvAnd : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvAnd : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op BvAnd -let (mkBvXor : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvXor : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op BvXor -let (mkBvOr : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvOr : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op BvOr -let (mkBvAdd : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvAdd : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op BvAdd -let (mkBvSub : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvSub : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op BvSub -let (mkBvShl : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvShl : Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) + = fun sz -> fun uu___ -> fun r -> @@ -953,8 +933,8 @@ let (mkBvShl : :: uu___3 in (BvShl, uu___2) in mkApp' uu___1 r -let (mkBvShr : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvShr : Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) + = fun sz -> fun uu___ -> fun r -> @@ -967,7 +947,7 @@ let (mkBvShr : (BvShr, uu___2) in mkApp' uu___1 r let (mkBvUdiv : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = + Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) = fun sz -> fun uu___ -> fun r -> @@ -979,8 +959,8 @@ let (mkBvUdiv : :: uu___3 in (BvUdiv, uu___2) in mkApp' uu___1 r -let (mkBvMod : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvMod : Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) + = fun sz -> fun uu___ -> fun r -> @@ -992,8 +972,8 @@ let (mkBvMod : :: uu___3 in (BvMod, uu___2) in mkApp' uu___1 r -let (mkBvMul : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvMul : Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) + = fun sz -> fun uu___ -> fun r -> @@ -1006,35 +986,35 @@ let (mkBvMul : (BvMul, uu___2) in mkApp' uu___1 r let (mkBvShl' : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = + Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) = fun sz -> fun uu___ -> fun r -> match uu___ with | (t1, t2) -> mkApp' (BvShl, [t1; t2]) r let (mkBvShr' : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = + Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) = fun sz -> fun uu___ -> fun r -> match uu___ with | (t1, t2) -> mkApp' (BvShr, [t1; t2]) r let (mkBvMul' : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = + Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) = fun sz -> fun uu___ -> fun r -> match uu___ with | (t1, t2) -> mkApp' (BvMul, [t1; t2]) r let (mkBvUdivUnsafe : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = + Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) = fun sz -> fun uu___ -> fun r -> match uu___ with | (t1, t2) -> mkApp' (BvUdiv, [t1; t2]) r let (mkBvModUnsafe : - Prims.int -> (term * term) -> FStarC_Compiler_Range_Type.range -> term) = + Prims.int -> (term * term) -> FStarC_Range_Type.range -> term) = fun sz -> fun uu___ -> fun r -> match uu___ with | (t1, t2) -> mkApp' (BvMod, [t1; t2]) r -let (mkBvUlt : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkBvUlt : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op BvUlt -let (mkIff : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkIff : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op Iff -let (mkEq : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkEq : (term * term) -> FStarC_Range_Type.range -> term) = fun uu___ -> fun r -> match uu___ with @@ -1043,30 +1023,27 @@ let (mkEq : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = | (App (Var f1, s1::[]), App (Var f2, s2::[])) when (f1 = f2) && (isInjective f1) -> mk_bin_op Eq (s1, s2) r | uu___1 -> mk_bin_op Eq (t1, t2) r) -let (mkLT : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = - mk_bin_op LT -let (mkLTE : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkLT : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op LT +let (mkLTE : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op LTE -let (mkGT : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = - mk_bin_op GT -let (mkGTE : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkGT : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op GT +let (mkGTE : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op GTE -let (mkAdd : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkAdd : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op Add -let (mkSub : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkSub : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op Sub -let (mkDiv : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkDiv : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op Div -let (mkRealDiv : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkRealDiv : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op RealDiv -let (mkMul : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkMul : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op Mul -let (mkMod : (term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkMod : (term * term) -> FStarC_Range_Type.range -> term) = mk_bin_op Mod -let (mkRealOfInt : term -> FStarC_Compiler_Range_Type.range -> term) = +let (mkRealOfInt : term -> FStarC_Range_Type.range -> term) = fun t -> fun r -> mkApp ("to_real", [t]) r -let (mkITE : - (term * term * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkITE : (term * term * term) -> FStarC_Range_Type.range -> term) = fun uu___ -> fun r -> match uu___ with @@ -1082,14 +1059,14 @@ let (mkITE : mkImp uu___4 r | (uu___2, App (TrueOp, uu___3)) -> mkImp (t1, t2) r | (uu___2, uu___3) -> mkApp' (ITE, [t1; t2; t3]) r)) -let (mkCases : term Prims.list -> FStarC_Compiler_Range_Type.range -> term) = +let (mkCases : term Prims.list -> FStarC_Range_Type.range -> term) = fun t -> fun r -> match t with | [] -> failwith "Impos" | hd::tl -> - FStarC_Compiler_List.fold_left - (fun out -> fun t1 -> mkAnd (out, t1) r) hd tl + FStarC_List.fold_left (fun out -> fun t1 -> mkAnd (out, t1) r) hd + tl let (check_pattern_ok : term -> term FStar_Pervasives_Native.option) = fun t -> let rec aux t1 = @@ -1157,42 +1134,40 @@ let (check_pattern_ok : term -> term FStar_Pervasives_Native.option) = let rec (print_smt_term : term -> Prims.string) = fun t -> match t.tm with - | Integer n -> FStarC_Compiler_Util.format1 "(Integer %s)" n - | String s -> FStarC_Compiler_Util.format1 "(String %s)" s - | Real r -> FStarC_Compiler_Util.format1 "(Real %s)" r + | Integer n -> FStarC_Util.format1 "(Integer %s)" n + | String s -> FStarC_Util.format1 "(String %s)" s + | Real r -> FStarC_Util.format1 "(Real %s)" r | BoundV n -> - let uu___ = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 "(BoundV %s)" uu___ + let uu___ = FStarC_Util.string_of_int n in + FStarC_Util.format1 "(BoundV %s)" uu___ | FreeV fv1 -> - let uu___ = fv_name fv1 in - FStarC_Compiler_Util.format1 "(FreeV %s)" uu___ + let uu___ = fv_name fv1 in FStarC_Util.format1 "(FreeV %s)" uu___ | App (op1, l) -> let uu___ = op_to_string op1 in let uu___1 = print_smt_term_list l in - FStarC_Compiler_Util.format2 "(%s %s)" uu___ uu___1 + FStarC_Util.format2 "(%s %s)" uu___ uu___1 | Labeled (t1, r1, r2) -> let uu___ = FStarC_Errors_Msg.rendermsg r1 in let uu___1 = print_smt_term t1 in - FStarC_Compiler_Util.format2 "(Labeled '%s' %s)" uu___ uu___1 + FStarC_Util.format2 "(Labeled '%s' %s)" uu___ uu___1 | LblPos (t1, s) -> let uu___ = print_smt_term t1 in - FStarC_Compiler_Util.format2 "(LblPos %s %s)" s uu___ + FStarC_Util.format2 "(LblPos %s %s)" s uu___ | Quant (qop1, l, uu___, uu___1, t1) -> let uu___2 = print_smt_term_list_list l in let uu___3 = print_smt_term t1 in - FStarC_Compiler_Util.format3 "(%s %s %s)" (qop_to_string qop1) uu___2 - uu___3 + FStarC_Util.format3 "(%s %s %s)" (qop_to_string qop1) uu___2 uu___3 | Let (es, body) -> let uu___ = print_smt_term_list es in let uu___1 = print_smt_term body in - FStarC_Compiler_Util.format2 "(let %s %s)" uu___ uu___1 + FStarC_Util.format2 "(let %s %s)" uu___ uu___1 and (print_smt_term_list : term Prims.list -> Prims.string) = fun l -> - let uu___ = FStarC_Compiler_List.map print_smt_term l in - FStarC_Compiler_String.concat " " uu___ + let uu___ = FStarC_List.map print_smt_term l in + FStarC_String.concat " " uu___ and (print_smt_term_list_list : term Prims.list Prims.list -> Prims.string) = fun l -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun s -> fun l1 -> let uu___ = @@ -1202,7 +1177,7 @@ and (print_smt_term_list_list : term Prims.list Prims.list -> Prims.string) = Prims.strcat "; [ " uu___1 in Prims.strcat s uu___) "" l let (mkQuant : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> (qop * term Prims.list Prims.list * Prims.int FStar_Pervasives_Native.option * sort Prims.list * term) -> term) @@ -1217,15 +1192,14 @@ let (mkQuant : then pats1 else (let uu___2 = - FStarC_Compiler_Util.find_map pats1 - (fun x -> - FStarC_Compiler_Util.find_map x check_pattern_ok) in + FStarC_Util.find_map pats1 + (fun x -> FStarC_Util.find_map x check_pattern_ok) in match uu___2 with | FStar_Pervasives_Native.None -> pats1 | FStar_Pervasives_Native.Some p -> ((let uu___4 = let uu___5 = print_smt_term p in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Pattern (%s) contains illegal symbols; dropping it" uu___5 in FStarC_Errors.log_issue @@ -1234,7 +1208,7 @@ let (mkQuant : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4)); [])) in - if (FStarC_Compiler_List.length vars) = Prims.int_zero + if (FStarC_List.length vars) = Prims.int_zero then body else (match body.tm with @@ -1246,27 +1220,26 @@ let (mkQuant : (qop1, uu___5, wopt, vars, body) in Quant uu___4 in mk uu___3 r) -let (mkLet : - (term Prims.list * term) -> FStarC_Compiler_Range_Type.range -> term) = +let (mkLet : (term Prims.list * term) -> FStarC_Range_Type.range -> term) = fun uu___ -> fun r -> match uu___ with | (es, body) -> - if (FStarC_Compiler_List.length es) = Prims.int_zero + if (FStarC_List.length es) = Prims.int_zero then body else mk (Let (es, body)) r let (abstr : fv Prims.list -> term -> term) = fun fvs1 -> fun t -> - let nvars = FStarC_Compiler_List.length fvs1 in + let nvars = FStarC_List.length fvs1 in let index_of fv1 = - let uu___ = FStarC_Compiler_Util.try_find_index (fv_eq fv1) fvs1 in + let uu___ = FStarC_Util.try_find_index (fv_eq fv1) fvs1 in match uu___ with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some i -> FStar_Pervasives_Native.Some (nvars - (i + Prims.int_one)) in let rec aux ix t1 = - let uu___ = FStarC_Compiler_Effect.op_Bang t1.freevars in + let uu___ = FStarC_Effect.op_Bang t1.freevars in match uu___ with | FStar_Pervasives_Native.Some [] -> t1 | uu___1 -> @@ -1283,8 +1256,7 @@ let (abstr : fv Prims.list -> term -> term) = mkBoundV (i + ix) t1.rng) | App (op1, tms) -> let uu___2 = - let uu___3 = FStarC_Compiler_List.map (aux ix) tms in - (op1, uu___3) in + let uu___3 = FStarC_List.map (aux ix) tms in (op1, uu___3) in mkApp' uu___2 t1.rng | Labeled (t2, r1, r2) -> let uu___2 = @@ -1297,17 +1269,16 @@ let (abstr : fv Prims.list -> term -> term) = LblPos uu___3 in mk uu___2 t2.rng | Quant (qop1, pats, wopt, vars, body) -> - let n = FStarC_Compiler_List.length vars in + let n = FStarC_List.length vars in let uu___2 = let uu___3 = - FStarC_Compiler_List.map - (FStarC_Compiler_List.map (aux (ix + n))) pats in + FStarC_List.map (FStarC_List.map (aux (ix + n))) pats in let uu___4 = aux (ix + n) body in (qop1, uu___3, wopt, vars, uu___4) in mkQuant t1.rng false uu___2 | Let (es, body) -> let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun e -> match uu___3 with @@ -1319,14 +1290,14 @@ let (abstr : fv Prims.list -> term -> term) = | (ix1, es_rev) -> let uu___3 = let uu___4 = aux ix1 body in - ((FStarC_Compiler_List.rev es_rev), uu___4) in + ((FStarC_List.rev es_rev), uu___4) in mkLet uu___3 t1.rng)) in aux Prims.int_zero t let (inst : term Prims.list -> term -> term) = fun tms -> fun t -> - let tms1 = FStarC_Compiler_List.rev tms in - let n = FStarC_Compiler_List.length tms1 in + let tms1 = FStarC_List.rev tms in + let n = FStarC_List.length tms1 in let rec aux shift t1 = match t1.tm with | Integer uu___ -> t1 @@ -1335,12 +1306,11 @@ let (inst : term Prims.list -> term -> term) = | FreeV uu___ -> t1 | BoundV i -> if (Prims.int_zero <= (i - shift)) && ((i - shift) < n) - then FStarC_Compiler_List.nth tms1 (i - shift) + then FStarC_List.nth tms1 (i - shift) else t1 | App (op1, tms2) -> let uu___ = - let uu___1 = FStarC_Compiler_List.map (aux shift) tms2 in - (op1, uu___1) in + let uu___1 = FStarC_List.map (aux shift) tms2 in (op1, uu___1) in mkApp' uu___ t1.rng | Labeled (t2, r1, r2) -> let uu___ = @@ -1353,18 +1323,17 @@ let (inst : term Prims.list -> term -> term) = LblPos uu___1 in mk uu___ t2.rng | Quant (qop1, pats, wopt, vars, body) -> - let m = FStarC_Compiler_List.length vars in + let m = FStarC_List.length vars in let shift1 = shift + m in let uu___ = let uu___1 = - FStarC_Compiler_List.map - (FStarC_Compiler_List.map (aux shift1)) pats in + FStarC_List.map (FStarC_List.map (aux shift1)) pats in let uu___2 = aux shift1 body in (qop1, uu___1, wopt, vars, uu___2) in mkQuant t1.rng false uu___ | Let (es, body) -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun e -> match uu___1 with @@ -1376,13 +1345,13 @@ let (inst : term Prims.list -> term -> term) = | (shift1, es_rev) -> let uu___1 = let uu___2 = aux shift1 body in - ((FStarC_Compiler_List.rev es_rev), uu___2) in + ((FStarC_List.rev es_rev), uu___2) in mkLet uu___1 t1.rng) in aux Prims.int_zero t let (subst : term -> fv -> term -> term) = fun t -> fun fv1 -> fun s -> let uu___ = abstr [fv1] t in inst [s] uu___ let (mkQuant' : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (qop * term Prims.list Prims.list * Prims.int FStar_Pervasives_Native.option * fv Prims.list * term) -> term) = @@ -1391,16 +1360,13 @@ let (mkQuant' : match uu___ with | (qop1, pats, wopt, vars, body) -> let uu___1 = - let uu___2 = - FStarC_Compiler_List.map - (FStarC_Compiler_List.map (abstr vars)) pats in - let uu___3 = FStarC_Compiler_List.map fv_sort vars in + let uu___2 = FStarC_List.map (FStarC_List.map (abstr vars)) pats in + let uu___3 = FStarC_List.map fv_sort vars in let uu___4 = abstr vars body in (qop1, uu___2, wopt, uu___3, uu___4) in mkQuant r true uu___1 let (mkForall : - FStarC_Compiler_Range_Type.range -> - (pat Prims.list Prims.list * fvs * term) -> term) + FStarC_Range_Type.range -> (pat Prims.list Prims.list * fvs * term) -> term) = fun r -> fun uu___ -> @@ -1408,7 +1374,7 @@ let (mkForall : | (pats, vars, body) -> mkQuant' r (Forall, pats, FStar_Pervasives_Native.None, vars, body) let (mkForall'' : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (pat Prims.list Prims.list * Prims.int FStar_Pervasives_Native.option * sort Prims.list * term) -> term) = @@ -1418,7 +1384,7 @@ let (mkForall'' : | (pats, wopt, sorts, body) -> mkQuant r true (Forall, pats, wopt, sorts, body) let (mkForall' : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (pat Prims.list Prims.list * Prims.int FStar_Pervasives_Native.option * fvs * term) -> term) = @@ -1428,8 +1394,7 @@ let (mkForall' : | (pats, wopt, vars, body) -> mkQuant' r (Forall, pats, wopt, vars, body) let (mkExists : - FStarC_Compiler_Range_Type.range -> - (pat Prims.list Prims.list * fvs * term) -> term) + FStarC_Range_Type.range -> (pat Prims.list Prims.list * fvs * term) -> term) = fun r -> fun uu___ -> @@ -1437,32 +1402,29 @@ let (mkExists : | (pats, vars, body) -> mkQuant' r (Exists, pats, FStar_Pervasives_Native.None, vars, body) let (mkLet' : - ((fv * term) Prims.list * term) -> FStarC_Compiler_Range_Type.range -> term) - = + ((fv * term) Prims.list * term) -> FStarC_Range_Type.range -> term) = fun uu___ -> fun r -> match uu___ with | (bindings, body) -> - let uu___1 = FStarC_Compiler_List.split bindings in + let uu___1 = FStarC_List.split bindings in (match uu___1 with | (vars, es) -> let uu___2 = let uu___3 = abstr vars body in (es, uu___3) in mkLet uu___2 r) -let (norng : FStarC_Compiler_Range_Type.range) = - FStarC_Compiler_Range_Type.dummyRange +let (norng : FStarC_Range_Type.range) = FStarC_Range_Type.dummyRange let (mkDefineFun : (Prims.string * fv Prims.list * sort * term * caption) -> decl) = fun uu___ -> match uu___ with | (nm, vars, s, tm, c) -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map fv_sort vars in + let uu___2 = FStarC_List.map fv_sort vars in let uu___3 = abstr vars tm in (nm, uu___2, s, uu___3, c) in DefineFun uu___1 let (constr_id_of_sort : sort -> Prims.string) = fun sort1 -> - let uu___ = strSort sort1 in - FStarC_Compiler_Util.format1 "%s_constr_id" uu___ + let uu___ = strSort sort1 in FStarC_Util.format1 "%s_constr_id" uu___ let (fresh_token : (Prims.string * sort) -> Prims.int -> decl) = fun uu___ -> fun id -> @@ -1494,27 +1456,27 @@ let (fresh_token : (Prims.string * sort) -> Prims.int -> decl) = } in Assume a let (fresh_constructor : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (Prims.string * sort Prims.list * sort * Prims.int) -> decl) = fun rng -> fun uu___ -> match uu___ with | (name, arg_sorts, sort1, id) -> - let id1 = FStarC_Compiler_Util.string_of_int id in + let id1 = FStarC_Util.string_of_int id in let bvars = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun s -> let uu___1 = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_int i in + let uu___4 = FStarC_Util.string_of_int i in Prims.strcat "x_" uu___4 in (uu___3, s) in mk_fv uu___2 in mkFreeV uu___1 norng) arg_sorts in - let bvar_names = FStarC_Compiler_List.map fv_of_term bvars in + let bvar_names = FStarC_List.map fv_of_term bvars in let capp = mkApp (name, bvars) norng in let cid_app = let uu___1 = @@ -1542,16 +1504,16 @@ let (fresh_constructor : } in Assume a let (injective_constructor : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (Prims.string * constructor_field Prims.list * sort) -> decl Prims.list) = fun rng -> fun uu___ -> match uu___ with | (name, fields, sort1) -> - let n_bvars = FStarC_Compiler_List.length fields in + let n_bvars = FStarC_List.length fields in let bvar_name i = - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in Prims.strcat "x_" uu___1 in let bvar_index i = n_bvars - (i + Prims.int_one) in let bvar i s = @@ -1560,14 +1522,14 @@ let (injective_constructor : mk_fv uu___2 in mkFreeV uu___1 in let bvars = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun f -> let uu___1 = bvar i f.field_sort in uu___1 norng) fields in - let bvar_names = FStarC_Compiler_List.map fv_of_term bvars in + let bvar_names = FStarC_List.map fv_of_term bvars in let capp = mkApp (name, bvars) norng in let uu___1 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___2 -> match uu___2 with @@ -1606,16 +1568,16 @@ let (injective_constructor : } in [proj_name; Assume a] else []) fields in - FStarC_Compiler_List.flatten uu___1 + FStarC_List.flatten uu___1 let (discriminator_name : constructor_t -> Prims.string) = fun constr -> Prims.strcat "is-" constr.constr_name let (constructor_to_decl : - FStarC_Compiler_Range_Type.range -> constructor_t -> decl Prims.list) = + FStarC_Range_Type.range -> constructor_t -> decl Prims.list) = fun rng -> fun constr -> let sort1 = constr.constr_sort in let field_sorts = - FStarC_Compiler_List.map (fun f -> f.field_sort) constr.constr_fields in + FStarC_List.map (fun f -> f.field_sort) constr.constr_fields in let cdecl = DeclFun ((constr.constr_name), field_sorts, (constr.constr_sort), @@ -1634,7 +1596,7 @@ let (constructor_to_decl : let xx = mkFreeV xfv norng in let uu___ = let uu___1 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___2 -> match uu___2 with @@ -1648,17 +1610,16 @@ let (constructor_to_decl : (let fi = let uu___4 = let uu___5 = - let uu___6 = - FStarC_Compiler_Util.string_of_int i in + let uu___6 = FStarC_Util.string_of_int i in Prims.strcat "f_" uu___6 in (uu___5, s) in mk_fv uu___4 in let uu___4 = mkFreeV fi norng in (uu___4, [fi]))) constr.constr_fields in - FStarC_Compiler_List.split uu___1 in + FStarC_List.split uu___1 in match uu___ with | (proj_terms, ex_vars) -> - let ex_vars1 = FStarC_Compiler_List.flatten ex_vars in + let ex_vars1 = FStarC_List.flatten ex_vars in let disc_inv_body = let uu___1 = let uu___2 = mkApp ((constr.constr_name), proj_terms) norng in @@ -1680,7 +1641,7 @@ let (constructor_to_decl : (uu___4, [xx]) in mkApp uu___3 norng in let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_int id in + let uu___4 = FStarC_Util.string_of_int id in mkInteger uu___4 norng in (uu___2, uu___3) in mkEq uu___1 norng in @@ -1699,43 +1660,41 @@ let (constructor_to_decl : else (let arg_sorts = let uu___1 = - FStarC_Compiler_List.filter (fun f -> f.field_projectible) + FStarC_List.filter (fun f -> f.field_projectible) constr.constr_fields in - FStarC_Compiler_List.map (fun uu___2 -> Term_sort) uu___1 in + FStarC_List.map (fun uu___2 -> Term_sort) uu___1 in let base_name = Prims.strcat constr.constr_name "@base" in let decl1 = DeclFun (base_name, arg_sorts, Term_sort, (FStar_Pervasives_Native.Some "Constructor base")) in let formals = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___1 -> let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_int i in + let uu___4 = FStarC_Util.string_of_int i in Prims.strcat "x" uu___4 in (uu___3, Term_sort) in mk_fv uu___2) constr.constr_fields in let constructed_term = let uu___1 = let uu___2 = - FStarC_Compiler_List.map (fun fv1 -> mkFreeV fv1 norng) - formals in + FStarC_List.map (fun fv1 -> mkFreeV fv1 norng) formals in ((constr.constr_name), uu___2) in mkApp uu___1 norng in let inj_formals = let uu___1 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun f -> fun fld -> if fld.field_projectible then [f] else []) formals constr.constr_fields in - FStarC_Compiler_List.flatten uu___1 in + FStarC_List.flatten uu___1 in let base_term = let uu___1 = let uu___2 = - FStarC_Compiler_List.map (fun fv1 -> mkFreeV fv1 norng) - inj_formals in + FStarC_List.map (fun fv1 -> mkFreeV fv1 norng) inj_formals in (base_name, uu___2) in mkApp uu___1 norng in let eq = mkEq (constructed_term, base_term) norng in @@ -1762,8 +1721,7 @@ let (constructor_to_decl : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_Util.format1 "" - constr.constr_name in + FStarC_Util.format1 "" constr.constr_name in Caption uu___2 in [uu___1; cdecl] in let uu___1 = @@ -1773,15 +1731,15 @@ let (constructor_to_decl : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_Util.format1 "" + FStarC_Util.format1 "" constr.constr_name in Caption uu___7 in [uu___6] in - FStarC_Compiler_List.op_At base uu___5 in - FStarC_Compiler_List.op_At [disc] uu___4 in - FStarC_Compiler_List.op_At projs uu___3 in - FStarC_Compiler_List.op_At cid uu___2 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At base uu___5 in + FStarC_List.op_At [disc] uu___4 in + FStarC_List.op_At projs uu___3 in + FStarC_List.op_At cid uu___2 in + FStarC_List.op_At uu___ uu___1 let (name_binders_inner : Prims.string FStar_Pervasives_Native.option -> fv Prims.list -> @@ -1794,7 +1752,7 @@ let (name_binders_inner : fun start -> fun sorts -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun s -> match uu___1 with @@ -1807,18 +1765,17 @@ let (name_binders_inner : | FStar_Pervasives_Native.Some p -> Prims.strcat p prefix in let nm = - let uu___2 = FStarC_Compiler_Util.string_of_int n in + let uu___2 = FStarC_Util.string_of_int n in Prims.strcat prefix1 uu___2 in let names1 = let uu___2 = mk_fv (nm, s) in uu___2 :: names in let b = let uu___2 = strSort s in - FStarC_Compiler_Util.format2 "(%s %s)" nm uu___2 in + FStarC_Util.format2 "(%s %s)" nm uu___2 in (names1, (b :: binders1), (n + Prims.int_one))) (outer_names, [], start) sorts in match uu___ with - | (names, binders1, n) -> - (names, (FStarC_Compiler_List.rev binders1), n) + | (names, binders1, n) -> (names, (FStarC_List.rev binders1), n) let (name_macro_binders : sort Prims.list -> (fv Prims.list * Prims.string Prims.list)) = fun sorts -> @@ -1826,27 +1783,27 @@ let (name_macro_binders : name_binders_inner (FStar_Pervasives_Native.Some "__") [] Prims.int_zero sorts in match uu___ with - | (names, binders1, n) -> ((FStarC_Compiler_List.rev names), binders1) + | (names, binders1, n) -> ((FStarC_List.rev names), binders1) let (termToSmt : Prims.bool -> Prims.string -> term -> Prims.string) = - let string_id_counter = FStarC_Compiler_Util.mk_ref Prims.int_zero in - let string_cache = FStarC_Compiler_Util.smap_create (Prims.of_int (20)) in + let string_id_counter = FStarC_Util.mk_ref Prims.int_zero in + let string_cache = FStarC_Util.smap_create (Prims.of_int (20)) in fun print_ranges -> fun enclosing_name -> fun t -> let next_qid = - let ctr = FStarC_Compiler_Util.mk_ref Prims.int_zero in + let ctr = FStarC_Util.mk_ref Prims.int_zero in fun depth -> - let n = FStarC_Compiler_Effect.op_Bang ctr in - FStarC_Compiler_Util.incr ctr; + let n = FStarC_Effect.op_Bang ctr in + FStarC_Util.incr ctr; if n = Prims.int_zero then enclosing_name else - (let uu___2 = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format2 "%s.%s" enclosing_name uu___2) in + (let uu___2 = FStarC_Util.string_of_int n in + FStarC_Util.format2 "%s.%s" enclosing_name uu___2) in let remove_guard_free pats = - FStarC_Compiler_List.map + FStarC_List.map (fun ps -> - FStarC_Compiler_List.map + FStarC_List.map (fun tm -> match tm.tm with | App @@ -1862,19 +1819,17 @@ let (termToSmt : Prims.bool -> Prims.string -> term -> Prims.string) = | Integer i -> i | Real r -> r | String s -> - let id_opt = FStarC_Compiler_Util.smap_try_find string_cache s in + let id_opt = FStarC_Util.smap_try_find string_cache s in (match id_opt with | FStar_Pervasives_Native.Some id -> id | FStar_Pervasives_Native.None -> let id = - let uu___ = - FStarC_Compiler_Effect.op_Bang string_id_counter in - FStarC_Compiler_Util.string_of_int uu___ in - (FStarC_Compiler_Util.incr string_id_counter; - FStarC_Compiler_Util.smap_add string_cache s id; + let uu___ = FStarC_Effect.op_Bang string_id_counter in + FStarC_Util.string_of_int uu___ in + (FStarC_Util.incr string_id_counter; + FStarC_Util.smap_add string_cache s id; id)) - | BoundV i -> - let uu___ = FStarC_Compiler_List.nth names i in fv_name uu___ + | BoundV i -> let uu___ = FStarC_List.nth names i in fv_name uu___ | FreeV x when fv_force x -> let uu___ = let uu___1 = fv_name x in Prims.strcat uu___1 " Dummy_value)" in @@ -1884,20 +1839,20 @@ let (termToSmt : Prims.bool -> Prims.string -> term -> Prims.string) = | App (op1, tms) -> let uu___ = op_to_string op1 in let uu___1 = - let uu___2 = FStarC_Compiler_List.map (aux1 n names) tms in - FStarC_Compiler_String.concat "\n" uu___2 in - FStarC_Compiler_Util.format2 "(%s %s)" uu___ uu___1 + let uu___2 = FStarC_List.map (aux1 n names) tms in + FStarC_String.concat "\n" uu___2 in + FStarC_Util.format2 "(%s %s)" uu___ uu___1 | Labeled (t2, uu___, uu___1) -> aux1 n names t2 | LblPos (t2, s) -> let uu___ = aux1 n names t2 in - FStarC_Compiler_Util.format2 "(! %s :lblpos %s)" uu___ s + FStarC_Util.format2 "(! %s :lblpos %s)" uu___ s | Quant (qop1, pats, wopt, sorts, body) -> let qid = next_qid () in let uu___ = name_binders_inner FStar_Pervasives_Native.None names n sorts in (match uu___ with | (names1, binders1, n1) -> - let binders2 = FStarC_Compiler_String.concat " " binders1 in + let binders2 = FStarC_String.concat " " binders1 in let pats1 = remove_guard_free pats in let pats_str = match pats1 with @@ -1905,19 +1860,19 @@ let (termToSmt : Prims.bool -> Prims.string -> term -> Prims.string) = | [] -> if print_ranges then ";;no pats" else "" | uu___1 -> let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun pats2 -> let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun p -> let uu___5 = aux1 n1 names1 p in - FStarC_Compiler_Util.format1 "%s" - uu___5) pats2 in - FStarC_Compiler_String.concat " " uu___4 in - FStarC_Compiler_Util.format1 - "\n:pattern (%s)" uu___3) pats1 in - FStarC_Compiler_String.concat "\n" uu___2 in + FStarC_Util.format1 "%s" uu___5) + pats2 in + FStarC_String.concat " " uu___4 in + FStarC_Util.format1 "\n:pattern (%s)" uu___3) + pats1 in + FStarC_String.concat "\n" uu___2 in let uu___1 = let uu___2 = let uu___3 = @@ -1928,40 +1883,38 @@ let (termToSmt : Prims.bool -> Prims.string -> term -> Prims.string) = uu___4 :: uu___5 in binders2 :: uu___3 in (qop_to_string qop1) :: uu___2 in - FStarC_Compiler_Util.format - "(%s (%s)\n (! %s\n %s\n%s\n:qid %s))" uu___1) + FStarC_Util.format "(%s (%s)\n (! %s\n %s\n%s\n:qid %s))" + uu___1) | Let (es, body) -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun e -> match uu___1 with | (names0, binders1, n0) -> let nm = - let uu___2 = - FStarC_Compiler_Util.string_of_int n0 in + let uu___2 = FStarC_Util.string_of_int n0 in Prims.strcat "@lb" uu___2 in let names01 = let uu___2 = mk_fv (nm, Term_sort) in uu___2 :: names0 in let b = let uu___2 = aux1 n names e in - FStarC_Compiler_Util.format2 "(%s %s)" nm uu___2 in + FStarC_Util.format2 "(%s %s)" nm uu___2 in (names01, (b :: binders1), (n0 + Prims.int_one))) (names, [], n) es in (match uu___ with | (names1, binders1, n1) -> let uu___1 = aux1 n1 names1 body in - FStarC_Compiler_Util.format2 "(let (%s)\n%s)" - (FStarC_Compiler_String.concat " " binders1) uu___1) + FStarC_Util.format2 "(let (%s)\n%s)" + (FStarC_String.concat " " binders1) uu___1) and aux depth n names t1 = let s = aux' depth n names t1 in if print_ranges && (t1.rng <> norng) then - let uu___ = FStarC_Compiler_Range_Ops.string_of_range t1.rng in - let uu___1 = FStarC_Compiler_Range_Ops.string_of_use_range t1.rng in - FStarC_Compiler_Util.format3 "\n;; def=%s; use=%s\n%s\n" uu___ - uu___1 s + let uu___ = FStarC_Range_Ops.string_of_range t1.rng in + let uu___1 = FStarC_Range_Ops.string_of_use_range t1.rng in + FStarC_Util.format3 "\n;; def=%s; use=%s\n%s\n" uu___ uu___1 s else s in aux Prims.int_zero Prims.int_zero [] t let (caption_to_string : @@ -1973,9 +1926,9 @@ let (caption_to_string : | FStar_Pervasives_Native.Some c when print_captions -> let c1 = let uu___1 = - FStarC_Compiler_List.map FStarC_Compiler_Util.trim_string - (FStarC_Compiler_String.split [10] c) in - FStarC_Compiler_String.concat " " uu___1 in + FStarC_List.map FStarC_Util.trim_string + (FStarC_String.split [10] c) in + FStarC_String.concat " " uu___1 in Prims.strcat ";;;;;;;;;;;;;;;;" (Prims.strcat c1 "\n") | uu___1 -> "" let rec (declToSmt' : Prims.bool -> Prims.string -> decl -> Prims.string) = @@ -1987,19 +1940,16 @@ let rec (declToSmt' : Prims.bool -> Prims.string -> decl -> Prims.string) = | Module (s, decls) -> let res = let uu___ = - FStarC_Compiler_List.map - (declToSmt' print_captions z3options) decls in - FStarC_Compiler_String.concat "\n" uu___ in + FStarC_List.map (declToSmt' print_captions z3options) decls in + FStarC_String.concat "\n" uu___ in let uu___ = FStarC_Options.keep_query_captions () in if uu___ then let uu___1 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length decls) in + FStarC_Util.string_of_int (FStarC_List.length decls) in let uu___2 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_String.length res) in - FStarC_Compiler_Util.format5 + FStarC_Util.string_of_int (FStarC_String.length res) in + FStarC_Util.format5 "\n;;; Start %s\n%s\n;;; End %s (%s decls; total size %s)" s res s uu___1 uu___2 else res @@ -2008,38 +1958,36 @@ let rec (declToSmt' : Prims.bool -> Prims.string -> decl -> Prims.string) = then let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun s -> Prims.strcat "; " (Prims.strcat s "\n")) - (FStarC_Compiler_Util.splitlines c) in - FStarC_Compiler_String.concat "" uu___1 in + (FStarC_Util.splitlines c) in + FStarC_String.concat "" uu___1 in Prims.strcat "\n" uu___ else "" | DeclFun (f, argsorts, retsort, c) -> - let l = FStarC_Compiler_List.map strSort argsorts in + let l = FStarC_List.map strSort argsorts in let uu___ = caption_to_string print_captions c in let uu___1 = strSort retsort in - FStarC_Compiler_Util.format4 "%s(declare-fun %s (%s) %s)" uu___ f - (FStarC_Compiler_String.concat " " l) uu___1 + FStarC_Util.format4 "%s(declare-fun %s (%s) %s)" uu___ f + (FStarC_String.concat " " l) uu___1 | DefineFun (f, arg_sorts, retsort, body, c) -> let uu___ = name_macro_binders arg_sorts in (match uu___ with | (names, binders1) -> let body1 = let uu___1 = - FStarC_Compiler_List.map (fun x -> mkFreeV x norng) - names in + FStarC_List.map (fun x -> mkFreeV x norng) names in inst uu___1 body in let uu___1 = caption_to_string print_captions c in let uu___2 = strSort retsort in let uu___3 = let uu___4 = escape f in termToSmt print_captions uu___4 body1 in - FStarC_Compiler_Util.format5 - "%s(define-fun %s (%s) %s\n %s)" uu___1 f - (FStarC_Compiler_String.concat " " binders1) uu___2 uu___3) + FStarC_Util.format5 "%s(define-fun %s (%s) %s\n %s)" uu___1 + f (FStarC_String.concat " " binders1) uu___2 uu___3) | Assume a -> let fact_ids_to_string ids = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | Name n -> @@ -2054,18 +2002,18 @@ let rec (declToSmt' : Prims.bool -> Prims.string -> decl -> Prims.string) = then let uu___ = let uu___1 = fact_ids_to_string a.assumption_fact_ids in - FStarC_Compiler_String.concat "; " uu___1 in - FStarC_Compiler_Util.format1 ";;; Fact-ids: %s\n" uu___ + FStarC_String.concat "; " uu___1 in + FStarC_Util.format1 ";;; Fact-ids: %s\n" uu___ else "" in let n = a.assumption_name in let uu___ = caption_to_string print_captions a.assumption_caption in let uu___1 = termToSmt print_captions n a.assumption_term in - FStarC_Compiler_Util.format4 "%s%s(assert (! %s\n:named %s))" - uu___ fids uu___1 n + FStarC_Util.format4 "%s%s(assert (! %s\n:named %s))" uu___ fids + uu___1 n | Eval t -> let uu___ = termToSmt print_captions "eval" t in - FStarC_Compiler_Util.format1 "(eval %s)" uu___ - | Echo s -> FStarC_Compiler_Util.format1 "(echo \"%s\")" s + FStarC_Util.format1 "(eval %s)" uu___ + | Echo s -> FStarC_Util.format1 "(echo \"%s\")" s | RetainAssumptions uu___ -> "" | CheckSat -> "(echo \"\")\n(check-sat)\n(echo \"\")" @@ -2074,13 +2022,12 @@ let rec (declToSmt' : Prims.bool -> Prims.string -> decl -> Prims.string) = | Push n -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_int n in - FStarC_Compiler_Util.format1 "(push) ;; push{%s" uu___ + FStarC_Util.format1 "(push) ;; push{%s" uu___ | Pop n -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_int n in - FStarC_Compiler_Util.format1 "(pop) ;; %s}pop" uu___ - | SetOption (s, v) -> - FStarC_Compiler_Util.format2 "(set-option :%s %s)" s v + FStarC_Util.format1 "(pop) ;; %s}pop" uu___ + | SetOption (s, v) -> FStarC_Util.format2 "(set-option :%s %s)" s v | GetStatistics -> "(echo \"\")\n(get-info :all-statistics)\n(echo \"\")" | GetReasonUnknown -> @@ -2099,7 +2046,7 @@ and (mkPrelude : Prims.string -> Prims.string) = match uu___ with | (name, fields, sort1, id, _injective) -> let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (field_name, field_sort, field_projectible) -> @@ -2112,7 +2059,7 @@ and (mkPrelude : Prims.string -> Prims.string) = constr_base = false } in let constrs = - FStarC_Compiler_List.map as_constr + FStarC_List.map as_constr [("FString_const", [("FString_const_proj_0", Int_sort, true)], String_sort, Prims.int_zero, true); ("Tm_type", [], Term_sort, (Prims.of_int (2)), true); @@ -2133,10 +2080,9 @@ and (mkPrelude : Prims.string -> Prims.string) = Term_sort, (Prims.of_int (10)), true)] in let bcons = let uu___ = - let uu___1 = - FStarC_Compiler_List.collect (constructor_to_decl norng) constrs in - FStarC_Compiler_List.map (declToSmt z3options) uu___1 in - FStarC_Compiler_String.concat "\n" uu___ in + let uu___1 = FStarC_List.collect (constructor_to_decl norng) constrs in + FStarC_List.map (declToSmt z3options) uu___1 in + FStarC_String.concat "\n" uu___ in let precedes_partial_app = "\n(declare-fun Prims.precedes@tok () Term)\n(assert\n(forall ((@x0 Term) (@x1 Term) (@x2 Term) (@x3 Term))\n(! (= (ApplyTT (ApplyTT (ApplyTT (ApplyTT Prims.precedes@tok\n@x0)\n@x1)\n@x2)\n@x3)\n(Prims.precedes @x0 @x1 @x2 @x3))\n\n:pattern ((ApplyTT (ApplyTT (ApplyTT (ApplyTT Prims.precedes@tok\n@x0)\n@x1)\n@x2)\n@x3)))))\n" in let lex_ordering = @@ -2163,8 +2109,8 @@ and (mkPrelude : Prims.string -> Prims.string) = let (declsToSmt : Prims.string -> decl Prims.list -> Prims.string) = fun z3options -> fun decls -> - let uu___ = FStarC_Compiler_List.map (declToSmt z3options) decls in - FStarC_Compiler_String.concat "\n" uu___ + let uu___ = FStarC_List.map (declToSmt z3options) decls in + FStarC_String.concat "\n" uu___ let (declToSmt_no_caps : Prims.string -> decl -> Prims.string) = fun z3options -> fun decl1 -> declToSmt' false z3options decl1 let (mkBvConstructor : @@ -2193,23 +2139,22 @@ let (mkBvConstructor : } in let uu___ = constructor_to_decl norng constr in (uu___, (constr.constr_name), (discriminator_name constr)) -let (__range_c : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero +let (__range_c : Prims.int FStarC_Effect.ref) = + FStarC_Util.mk_ref Prims.int_zero let (mk_Range_const : unit -> term) = fun uu___ -> - let i = FStarC_Compiler_Effect.op_Bang __range_c in + let i = FStarC_Effect.op_Bang __range_c in (let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang __range_c in - uu___3 + Prims.int_one in - FStarC_Compiler_Effect.op_Colon_Equals __range_c uu___2); + let uu___3 = FStarC_Effect.op_Bang __range_c in uu___3 + Prims.int_one in + FStarC_Effect.op_Colon_Equals __range_c uu___2); (let uu___2 = let uu___3 = let uu___4 = mkInteger' i norng in [uu___4] in ("Range_const", uu___3) in mkApp uu___2 norng) let (mk_Term_type : term) = mkApp ("Tm_type", []) norng -let (mk_Term_app : term -> term -> FStarC_Compiler_Range_Type.range -> term) - = fun t1 -> fun t2 -> fun r -> mkApp ("Tm_app", [t1; t2]) r -let (mk_Term_uvar : Prims.int -> FStarC_Compiler_Range_Type.range -> term) = +let (mk_Term_app : term -> term -> FStarC_Range_Type.range -> term) = + fun t1 -> fun t2 -> fun r -> mkApp ("Tm_app", [t1; t2]) r +let (mk_Term_uvar : Prims.int -> FStarC_Range_Type.range -> term) = fun i -> fun r -> let uu___ = @@ -2288,7 +2233,7 @@ let (boxTerm : sort -> term -> term) = | String_sort -> boxString t | BitVec_sort sz -> boxBitVec sz t | Sort "Real" -> boxReal t - | uu___ -> FStarC_Compiler_Effect.raise FStarC_Compiler_Util.Impos + | uu___ -> FStarC_Effect.raise FStarC_Util.Impos let (unboxTerm : sort -> term -> term) = fun sort1 -> fun t -> @@ -2298,14 +2243,14 @@ let (unboxTerm : sort -> term -> term) = | String_sort -> unboxString t | BitVec_sort sz -> unboxBitVec sz t | Sort "Real" -> unboxReal t - | uu___ -> FStarC_Compiler_Effect.raise FStarC_Compiler_Util.Impos + | uu___ -> FStarC_Effect.raise FStarC_Util.Impos let (getBoxedInteger : term -> Prims.int FStar_Pervasives_Native.option) = fun t -> match t.tm with | App (Var s, t2::[]) when s = (FStar_Pervasives_Native.fst boxIntFun) -> (match t2.tm with | Integer n -> - let uu___ = FStarC_Compiler_Util.int_of_string n in + let uu___ = FStarC_Util.int_of_string n in FStar_Pervasives_Native.Some uu___ | uu___ -> FStar_Pervasives_Native.None) | uu___ -> FStar_Pervasives_Native.None @@ -2386,9 +2331,7 @@ let (mk_Valid : term -> term) = (Var "Prims.b2t", { tm = App (Var "FStar.BV.bvult", t0::t1::t2::[]); freevars = uu___; rng = uu___1;_}::[]) - when - let uu___2 = getBoxedInteger t0 in - FStarC_Compiler_Util.is_some uu___2 -> + when let uu___2 = getBoxedInteger t0 in FStarC_Util.is_some uu___2 -> let sz = let uu___2 = getBoxedInteger t0 in match uu___2 with @@ -2402,9 +2345,7 @@ let (mk_Valid : term -> term) = (Var "Prims.equals", uu___::{ tm = App (Var "FStar.BV.bvult", t0::t1::t2::[]); freevars = uu___1; rng = uu___2;_}::uu___3::[]) - when - let uu___4 = getBoxedInteger t0 in - FStarC_Compiler_Util.is_some uu___4 -> + when let uu___4 = getBoxedInteger t0 in FStarC_Util.is_some uu___4 -> let sz = let uu___4 = getBoxedInteger t0 in match uu___4 with @@ -2448,7 +2389,7 @@ let (mk_tester : Prims.string -> term -> term) = fun n -> fun t -> mkApp ((Prims.strcat "is-" n), [t]) t.rng let (mk_ApplyTF : term -> term -> term) = fun t -> fun t' -> mkApp ("ApplyTF", [t; t']) t.rng -let (mk_ApplyTT : term -> term -> FStarC_Compiler_Range_Type.range -> term) = +let (mk_ApplyTT : term -> term -> FStarC_Range_Type.range -> term) = fun t -> fun t' -> fun r -> mkApp ("ApplyTT", [t; t']) r let (kick_partial_app : term -> term) = fun t -> @@ -2456,8 +2397,7 @@ let (kick_partial_app : term -> term) = let uu___1 = mkApp ("__uu__PartialApp", []) t.rng in mk_ApplyTT uu___1 t t.rng in mk_Valid uu___ -let (mk_String_const : - Prims.string -> FStarC_Compiler_Range_Type.range -> term) = +let (mk_String_const : Prims.string -> FStarC_Range_Type.range -> term) = fun s -> fun r -> let uu___ = @@ -2465,7 +2405,7 @@ let (mk_String_const : ("FString_const", uu___1) in mkApp uu___ r let (mk_Precedes : - term -> term -> term -> term -> FStarC_Compiler_Range_Type.range -> term) = + term -> term -> term -> term -> FStarC_Range_Type.range -> term) = fun x1 -> fun x2 -> fun x3 -> @@ -2482,19 +2422,16 @@ let rec (n_fuel : Prims.int -> term) = let uu___2 = let uu___3 = n_fuel (n - Prims.int_one) in [uu___3] in ("SFuel", uu___2) in mkApp uu___1 norng) -let (mk_and_l : term Prims.list -> FStarC_Compiler_Range_Type.range -> term) - = +let (mk_and_l : term Prims.list -> FStarC_Range_Type.range -> term) = fun l -> fun r -> let uu___ = mkTrue r in - FStarC_Compiler_List.fold_right (fun p1 -> fun p2 -> mkAnd (p1, p2) r) - l uu___ -let (mk_or_l : term Prims.list -> FStarC_Compiler_Range_Type.range -> term) = + FStarC_List.fold_right (fun p1 -> fun p2 -> mkAnd (p1, p2) r) l uu___ +let (mk_or_l : term Prims.list -> FStarC_Range_Type.range -> term) = fun l -> fun r -> let uu___ = mkFalse r in - FStarC_Compiler_List.fold_right (fun p1 -> fun p2 -> mkOr (p1, p2) r) l - uu___ + FStarC_List.fold_right (fun p1 -> fun p2 -> mkOr (p1, p2) r) l uu___ let (mk_haseq : term -> term) = fun t -> let uu___ = mkApp ("Prims.hasEq", [t]) t.rng in mk_Valid uu___ let (dummy_sort : sort) = Sort "Dummy_sort" @@ -2506,7 +2443,7 @@ let rec (names_of_decl : decl -> Prims.string Prims.list) = fun d -> match d with | Assume a -> [a.assumption_name] - | Module (uu___, ds) -> FStarC_Compiler_List.collect names_of_decl ds + | Module (uu___, ds) -> FStarC_List.collect names_of_decl ds | uu___ -> [] let (decl_to_string_short : decl -> Prims.string) = fun d -> @@ -2523,10 +2460,10 @@ let (decl_to_string_short : decl -> Prims.string) = | RetainAssumptions uu___ -> "RetainAssumptions" | Push n -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_int n in - FStarC_Compiler_Util.format1 "push %s" uu___ + FStarC_Util.format1 "push %s" uu___ | Pop n -> let uu___ = FStarC_Class_Show.show FStarC_Class_Show.showable_int n in - FStarC_Compiler_Util.format1 "pop %s" uu___ + FStarC_Util.format1 "pop %s" uu___ | CheckSat -> "check-sat" | GetUnsatCore -> "get-unsat-core" | SetOption (s, v) -> diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_UnsatCore.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_UnsatCore.ml similarity index 84% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_UnsatCore.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_UnsatCore.ml index 63eab14503b..5dcf43281fc 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_UnsatCore.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_UnsatCore.ml @@ -8,9 +8,9 @@ let (filter : fun core -> fun decls -> let rec aux theory = - let theory_rev = FStarC_Compiler_List.rev theory in + let theory_rev = FStarC_List.rev theory in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun d -> match uu___1 with @@ -18,14 +18,14 @@ let (filter : (match d with | FStarC_SMTEncoding_Term.Assume a -> if - FStarC_Compiler_List.contains + FStarC_List.contains a.FStarC_SMTEncoding_Term.assumption_name core then ((d :: keep), (n_retained + Prims.int_one), n_pruned) else if - FStarC_Compiler_Util.starts_with + FStarC_Util.starts_with a.FStarC_SMTEncoding_Term.assumption_name "@" then ((d :: keep), n_retained, n_pruned) else @@ -40,8 +40,8 @@ let (filter : | uu___2 -> ((d :: keep), n_retained, n_pruned))) ([FStarC_SMTEncoding_Term.Caption (Prims.strcat "UNSAT CORE USED: " - (FStarC_Compiler_String.concat ", " core))], - Prims.int_zero, Prims.int_zero) theory_rev in + (FStarC_String.concat ", " core))], Prims.int_zero, + Prims.int_zero) theory_rev in match uu___ with | (keep, n_retained, n_pruned) -> (keep, n_retained, n_pruned) in let uu___ = aux decls in diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Util.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Util.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_Util.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Util.ml index 76be85ef0dd..97ed0338f62 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Util.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Util.ml @@ -19,13 +19,12 @@ let (mkAssume : FStarC_SMTEncoding_Term.Assume uu___1 let norng : 'uuuuu 'uuuuu1 . - ('uuuuu -> FStarC_Compiler_Range_Type.range -> 'uuuuu1) -> - 'uuuuu -> 'uuuuu1 - = fun f -> fun x -> f x FStarC_Compiler_Range_Type.dummyRange + ('uuuuu -> FStarC_Range_Type.range -> 'uuuuu1) -> 'uuuuu -> 'uuuuu1 + = fun f -> fun x -> f x FStarC_Range_Type.dummyRange let (mkTrue : FStarC_SMTEncoding_Term.term) = - FStarC_SMTEncoding_Term.mkTrue FStarC_Compiler_Range_Type.dummyRange + FStarC_SMTEncoding_Term.mkTrue FStarC_Range_Type.dummyRange let (mkFalse : FStarC_SMTEncoding_Term.term) = - FStarC_SMTEncoding_Term.mkFalse FStarC_Compiler_Range_Type.dummyRange + FStarC_SMTEncoding_Term.mkFalse FStarC_Range_Type.dummyRange let (mkInteger : Prims.string -> FStarC_SMTEncoding_Term.term) = norng FStarC_SMTEncoding_Term.mkInteger let (mkInteger' : Prims.int -> FStarC_SMTEncoding_Term.term) = @@ -200,28 +199,23 @@ let (mkCases : norng FStarC_SMTEncoding_Term.mkCases let norng2 : 'uuuuu 'uuuuu1 'uuuuu2 . - ('uuuuu -> 'uuuuu1 -> FStarC_Compiler_Range_Type.range -> 'uuuuu2) -> + ('uuuuu -> 'uuuuu1 -> FStarC_Range_Type.range -> 'uuuuu2) -> 'uuuuu -> 'uuuuu1 -> 'uuuuu2 - = fun f -> fun x -> fun y -> f x y FStarC_Compiler_Range_Type.dummyRange + = fun f -> fun x -> fun y -> f x y FStarC_Range_Type.dummyRange let norng3 : 'uuuuu 'uuuuu1 'uuuuu2 'uuuuu3 . - ('uuuuu -> - 'uuuuu1 -> 'uuuuu2 -> FStarC_Compiler_Range_Type.range -> 'uuuuu3) - -> 'uuuuu -> 'uuuuu1 -> 'uuuuu2 -> 'uuuuu3 - = - fun f -> - fun x -> fun y -> fun z -> f x y z FStarC_Compiler_Range_Type.dummyRange + ('uuuuu -> 'uuuuu1 -> 'uuuuu2 -> FStarC_Range_Type.range -> 'uuuuu3) -> + 'uuuuu -> 'uuuuu1 -> 'uuuuu2 -> 'uuuuu3 + = fun f -> fun x -> fun y -> fun z -> f x y z FStarC_Range_Type.dummyRange let norng4 : 'uuuuu 'uuuuu1 'uuuuu2 'uuuuu3 'uuuuu4 . ('uuuuu -> - 'uuuuu1 -> - 'uuuuu2 -> 'uuuuu3 -> FStarC_Compiler_Range_Type.range -> 'uuuuu4) + 'uuuuu1 -> 'uuuuu2 -> 'uuuuu3 -> FStarC_Range_Type.range -> 'uuuuu4) -> 'uuuuu -> 'uuuuu1 -> 'uuuuu2 -> 'uuuuu3 -> 'uuuuu4 = fun f -> fun x -> - fun y -> - fun z -> fun w -> f x y z w FStarC_Compiler_Range_Type.dummyRange + fun y -> fun z -> fun w -> f x y z w FStarC_Range_Type.dummyRange let (mk_Term_app : FStarC_SMTEncoding_Term.term -> FStarC_SMTEncoding_Term.term -> FStarC_SMTEncoding_Term.term) @@ -283,5 +277,6 @@ let (is_smt_reifiable_function : { FStarC_Syntax_Syntax.bs1 = uu___1; FStarC_Syntax_Syntax.comp = c;_} -> - is_smt_reifiable_effect en (FStarC_Syntax_Util.comp_effect_name c) + let uu___2 = FStarC_Syntax_Util.comp_effect_name c in + is_smt_reifiable_effect en uu___2 | uu___1 -> false \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Z3.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Z3.ml similarity index 73% rename from stage0/fstar-lib/generated/FStarC_SMTEncoding_Z3.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Z3.ml index 51de6020b67..527d877cdb0 100644 --- a/stage0/fstar-lib/generated/FStarC_SMTEncoding_Z3.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_SMTEncoding_Z3.ml @@ -38,7 +38,7 @@ let (__proj__TIMEOUT__item___0 : = fun projectee -> match projectee with | TIMEOUT _0 -> _0 let (uu___is_KILLED : z3status -> Prims.bool) = fun projectee -> match projectee with | KILLED -> true | uu___ -> false -type z3statistics = Prims.string FStarC_Compiler_Util.smap +type z3statistics = Prims.string FStarC_Util.smap type z3result = { z3result_status: z3status ; @@ -110,10 +110,10 @@ let (__proj__Mkquery_log__item__close_log : query_log -> unit -> unit) = match projectee with | { get_module_name; set_module_name; write_to_log; append_to_log; close_log;_} -> close_log -let (_already_warned_solver_mismatch : Prims.bool FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref false -let (_already_warned_version_mismatch : - Prims.bool FStarC_Compiler_Effect.ref) = FStarC_Compiler_Util.mk_ref false +let (_already_warned_solver_mismatch : Prims.bool FStarC_Effect.ref) = + FStarC_Util.mk_ref false +let (_already_warned_version_mismatch : Prims.bool FStarC_Effect.ref) = + FStarC_Util.mk_ref false type label = Prims.string let (status_tag : z3status -> Prims.string) = fun uu___ -> @@ -131,7 +131,7 @@ let (status_string_and_errors : | UNSAT uu___ -> ((status_tag s), []) | SAT (errs, msg) -> let uu___ = - FStarC_Compiler_Util.format2 "%s%s" (status_tag s) + FStarC_Util.format2 "%s%s" (status_tag s) (match msg with | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some msg1 -> @@ -139,7 +139,7 @@ let (status_string_and_errors : (uu___, errs) | UNKNOWN (errs, msg) -> let uu___ = - FStarC_Compiler_Util.format2 "%s%s" (status_tag s) + FStarC_Util.format2 "%s%s" (status_tag s) (match msg with | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some msg1 -> @@ -147,25 +147,23 @@ let (status_string_and_errors : (uu___, errs) | TIMEOUT (errs, msg) -> let uu___ = - FStarC_Compiler_Util.format2 "%s%s" (status_tag s) + FStarC_Util.format2 "%s%s" (status_tag s) (match msg with | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some msg1 -> Prims.strcat " because " msg1) in (uu___, errs) let (query_logging : query_log) = - let query_number = FStarC_Compiler_Util.mk_ref Prims.int_zero in - let log_file_opt = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in - let used_file_names = FStarC_Compiler_Util.mk_ref [] in - let current_module_name = - FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in - let current_file_name = - FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let query_number = FStarC_Util.mk_ref Prims.int_zero in + let log_file_opt = FStarC_Util.mk_ref FStar_Pervasives_Native.None in + let used_file_names = FStarC_Util.mk_ref [] in + let current_module_name = FStarC_Util.mk_ref FStar_Pervasives_Native.None in + let current_file_name = FStarC_Util.mk_ref FStar_Pervasives_Native.None in let set_module_name n = - FStarC_Compiler_Effect.op_Colon_Equals current_module_name + FStarC_Effect.op_Colon_Equals current_module_name (FStar_Pervasives_Native.Some n) in let get_module_name uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang current_module_name in + let uu___1 = FStarC_Effect.op_Bang current_module_name in match uu___1 with | FStar_Pervasives_Native.None -> failwith "Module name not set" | FStar_Pervasives_Native.Some n -> n in @@ -173,57 +171,55 @@ let (query_logging : query_log) = let n = get_module_name () in let file_name = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang used_file_names in - FStarC_Compiler_List.tryFind + let uu___2 = FStarC_Effect.op_Bang used_file_names in + FStarC_List.tryFind (fun uu___3 -> match uu___3 with | (m, uu___4) -> n = m) uu___2 in match uu___1 with | FStar_Pervasives_Native.None -> ((let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang used_file_names in + let uu___4 = FStarC_Effect.op_Bang used_file_names in (n, Prims.int_zero) :: uu___4 in - FStarC_Compiler_Effect.op_Colon_Equals used_file_names uu___3); + FStarC_Effect.op_Colon_Equals used_file_names uu___3); n) | FStar_Pervasives_Native.Some (uu___2, k) -> ((let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang used_file_names in + let uu___5 = FStarC_Effect.op_Bang used_file_names in (n, (k + Prims.int_one)) :: uu___5 in - FStarC_Compiler_Effect.op_Colon_Equals used_file_names uu___4); - (let uu___4 = - FStarC_Compiler_Util.string_of_int (k + Prims.int_one) in - FStarC_Compiler_Util.format2 "%s-%s" n uu___4)) in - FStarC_Compiler_Util.format1 "queries-%s.smt2" file_name in + FStarC_Effect.op_Colon_Equals used_file_names uu___4); + (let uu___4 = FStarC_Util.string_of_int (k + Prims.int_one) in + FStarC_Util.format2 "%s-%s" n uu___4)) in + FStarC_Util.format1 "queries-%s.smt2" file_name in let new_log_file uu___ = let file_name = next_file_name () in - FStarC_Compiler_Effect.op_Colon_Equals current_file_name + FStarC_Effect.op_Colon_Equals current_file_name (FStar_Pervasives_Native.Some file_name); - (let c = FStarC_Compiler_Util.open_file_for_writing file_name in - FStarC_Compiler_Effect.op_Colon_Equals log_file_opt + (let c = FStarC_Util.open_file_for_writing file_name in + FStarC_Effect.op_Colon_Equals log_file_opt (FStar_Pervasives_Native.Some (c, file_name)); (c, file_name)) in let get_log_file uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang log_file_opt in + let uu___1 = FStarC_Effect.op_Bang log_file_opt in match uu___1 with | FStar_Pervasives_Native.None -> new_log_file () | FStar_Pervasives_Native.Some c -> c in let append_to_log str = let uu___ = get_log_file () in - match uu___ with - | (f, nm) -> (FStarC_Compiler_Util.append_to_file f str; nm) in + match uu___ with | (f, nm) -> (FStarC_Util.append_to_file f str; nm) in let write_to_new_log str = let file_name = next_file_name () in - FStarC_Compiler_Util.write_file file_name str; file_name in + FStarC_Util.write_file file_name str; file_name in let write_to_log fresh str = if fresh then write_to_new_log str else append_to_log str in let close_log uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang log_file_opt in + let uu___1 = FStarC_Effect.op_Bang log_file_opt in match uu___1 with | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some (c, uu___2) -> - (FStarC_Compiler_Util.close_out_channel c; - FStarC_Compiler_Effect.op_Colon_Equals log_file_opt + (FStarC_Util.close_out_channel c; + FStarC_Effect.op_Colon_Equals log_file_opt FStar_Pervasives_Native.None) in let log_file_name uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang current_file_name in + let uu___1 = FStarC_Effect.op_Bang current_file_name in match uu___1 with | FStar_Pervasives_Native.None -> failwith "no log file" | FStar_Pervasives_Native.Some n -> n in @@ -249,7 +245,7 @@ let (z3_cmd_and_args : unit -> (Prims.string * Prims.string Prims.list)) = [uu___6] in uu___4 :: uu___5 in let uu___4 = FStarC_Find.z3_install_suggestion ver in - FStarC_Compiler_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___3 uu___4 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Error_Z3InvocationError () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) @@ -261,13 +257,13 @@ let (z3_cmd_and_args : unit -> (Prims.string * Prims.string Prims.list)) = let uu___4 = let uu___5 = let uu___6 = FStarC_Options.z3_seed () in - FStarC_Compiler_Util.string_of_int uu___6 in - FStarC_Compiler_Util.format1 "smt.random_seed=%s" uu___5 in + FStarC_Util.string_of_int uu___6 in + FStarC_Util.format1 "smt.random_seed=%s" uu___5 in [uu___4] in "-in" :: uu___3 in "-smt2" :: uu___2 in let uu___2 = FStarC_Options.z3_cliopt () in - FStarC_Compiler_List.append uu___1 uu___2 in + FStarC_List.append uu___1 uu___2 in (cmd, cmd_args) let (warn_handler : FStarC_Errors_Msg.error_message -> Prims.string -> unit) = @@ -289,28 +285,27 @@ let (warn_handler : FStarC_Errors_Msg.error_message -> Prims.string -> unit) FStarC_Pprint.op_Hat_Hat FStarC_Pprint.hardline uu___5 in FStarC_Pprint.op_Hat_Hat uu___3 uu___4 in [uu___2] in - FStarC_Compiler_List.op_At uu___1 suf in + FStarC_List.op_At uu___1 suf in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_UnexpectedZ3Output () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___) -let (check_z3version : FStarC_Compiler_Util.proc -> unit) = +let (check_z3version : FStarC_Util.proc -> unit) = fun p -> let getinfo arg = let s = let uu___ = - FStarC_Compiler_Util.format1 "(get-info :%s)\n(echo \"Done!\")\n" - arg in - FStarC_Compiler_Util.ask_process p uu___ (fun uu___1 -> "Killed") + FStarC_Util.format1 "(get-info :%s)\n(echo \"Done!\")\n" arg in + FStarC_Util.ask_process p uu___ (fun uu___1 -> "Killed") (warn_handler []) in - if FStarC_Compiler_Util.starts_with s (Prims.strcat "(:" arg) + if FStarC_Util.starts_with s (Prims.strcat "(:" arg) then - let ss = FStarC_Compiler_String.split [34] s in - FStarC_Compiler_List.nth ss Prims.int_one + let ss = FStarC_String.split [34] s in + FStarC_List.nth ss Prims.int_one else (warn_handler [] s; (let uu___2 = - let uu___3 = FStarC_Compiler_Util.proc_prog p in - FStarC_Compiler_Util.format1 "Could not run Z3 from `%s'" uu___3 in + let uu___3 = FStarC_Util.proc_prog p in + FStarC_Util.format1 "Could not run Z3 from `%s'" uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Error_Z3InvocationError () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -318,8 +313,7 @@ let (check_z3version : FStarC_Compiler_Util.proc -> unit) = let name = getinfo "name" in (let uu___1 = (name <> "Z3") && - (let uu___2 = - FStarC_Compiler_Effect.op_Bang _already_warned_solver_mismatch in + (let uu___2 = FStarC_Effect.op_Bang _already_warned_solver_mismatch in Prims.op_Negation uu___2) in if uu___1 then @@ -327,7 +321,7 @@ let (check_z3version : FStarC_Compiler_Util.proc -> unit) = let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unexpected SMT solver: expected to be talking to Z3, got %s." name in FStarC_Errors_Msg.text uu___6 in @@ -335,23 +329,24 @@ let (check_z3version : FStarC_Compiler_Util.proc -> unit) = let uu___5 = let uu___6 = FStarC_Options.z3_version () in FStarC_Find.z3_install_suggestion uu___6 in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___4 uu___5 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_SolverMismatch () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___3)); - FStarC_Compiler_Effect.op_Colon_Equals - _already_warned_solver_mismatch true) + FStarC_Effect.op_Colon_Equals _already_warned_solver_mismatch true) else ()); (let ver_found = - let uu___1 = getinfo "version" in - FStarC_Compiler_Util.trim_string uu___1 in + let uu___1 = + let uu___2 = + let uu___3 = getinfo "version" in FStarC_Util.split uu___3 "-" in + FStarC_List.hd uu___2 in + FStarC_Util.trim_string uu___1 in let ver_conf = let uu___1 = FStarC_Options.z3_version () in - FStarC_Compiler_Util.trim_string uu___1 in + FStarC_Util.trim_string uu___1 in let uu___2 = (ver_conf <> ver_found) && - (let uu___3 = - FStarC_Compiler_Effect.op_Bang _already_warned_version_mismatch in + (let uu___3 = FStarC_Effect.op_Bang _already_warned_version_mismatch in Prims.op_Negation uu___3) in if uu___2 then @@ -359,24 +354,23 @@ let (check_z3version : FStarC_Compiler_Util.proc -> unit) = let uu___5 = let uu___6 = let uu___7 = - let uu___8 = FStarC_Compiler_Util.proc_prog p in - FStarC_Compiler_Util.format3 + let uu___8 = FStarC_Util.proc_prog p in + FStarC_Util.format3 "Unexpected Z3 version for '%s': expected '%s', got '%s'." uu___8 ver_conf ver_found in FStarC_Errors_Msg.text uu___7 in [uu___6] in let uu___6 = FStarC_Find.z3_install_suggestion ver_conf in - FStarC_Compiler_List.op_At uu___5 uu___6 in + FStarC_List.op_At uu___5 uu___6 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_SolverMismatch () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___4)); FStarC_Errors.stop_if_err (); - FStarC_Compiler_Effect.op_Colon_Equals - _already_warned_version_mismatch true) + FStarC_Effect.op_Colon_Equals _already_warned_version_mismatch true) else ()) let (new_z3proc : Prims.string -> - (Prims.string * Prims.string Prims.list) -> FStarC_Compiler_Util.proc) + (Prims.string * Prims.string Prims.list) -> FStarC_Util.proc) = fun id -> fun cmd_and_args -> @@ -385,7 +379,7 @@ let (new_z3proc : (fun uu___ -> match () with | () -> - FStarC_Compiler_Util.start_process id + FStarC_Util.start_process id (FStar_Pervasives_Native.fst cmd_and_args) (FStar_Pervasives_Native.snd cmd_and_args) (fun s -> s = "Done!")) () @@ -408,7 +402,7 @@ let (new_z3proc : let uu___6 = let uu___7 = FStarC_Errors_Msg.text "Exception:" in let uu___8 = - let uu___9 = FStarC_Compiler_Util.print_exn uu___ in + let uu___9 = FStarC_Util.print_exn uu___ in FStarC_Pprint.arbitrary_string uu___9 in FStarC_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___7 uu___8 in @@ -421,16 +415,16 @@ let (new_z3proc : (Obj.magic uu___1) in check_z3version proc; proc let (new_z3proc_with_id : - (Prims.string * Prims.string Prims.list) -> FStarC_Compiler_Util.proc) = - let ctr = FStarC_Compiler_Util.mk_ref (Prims.of_int (-1)) in + (Prims.string * Prims.string Prims.list) -> FStarC_Util.proc) = + let ctr = FStarC_Util.mk_ref (Prims.of_int (-1)) in fun cmd_and_args -> let p = let uu___ = let uu___1 = - FStarC_Compiler_Util.incr ctr; - (let uu___3 = FStarC_Compiler_Effect.op_Bang ctr in - FStarC_Compiler_Util.string_of_int uu___3) in - FStarC_Compiler_Util.format1 "z3-bg-%s" uu___1 in + FStarC_Util.incr ctr; + (let uu___3 = FStarC_Effect.op_Bang ctr in + FStarC_Util.string_of_int uu___3) in + FStarC_Util.format1 "z3-bg-%s" uu___1 in new_z3proc uu___ cmd_and_args in p type bgproc = @@ -459,12 +453,12 @@ let (__proj__Mkbgproc__item__ctxt : bgproc -> FStarC_SMTEncoding_SolverState.solver_state) = fun projectee -> match projectee with | { ask; refresh; restart; version; ctxt;_} -> ctxt -let (bg_z3_proc : bgproc FStarC_Compiler_Effect.ref) = - let the_z3proc = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in +let (bg_z3_proc : bgproc FStarC_Effect.ref) = + let the_z3proc = FStarC_Util.mk_ref FStar_Pervasives_Native.None in let the_z3proc_params = - FStarC_Compiler_Util.mk_ref (FStar_Pervasives_Native.Some ("", [""])) in - let the_z3proc_ask_count = FStarC_Compiler_Util.mk_ref Prims.int_zero in - let the_z3proc_version = FStarC_Compiler_Util.mk_ref "" in + FStarC_Util.mk_ref (FStar_Pervasives_Native.Some ("", [""])) in + let the_z3proc_ask_count = FStarC_Util.mk_ref Prims.int_zero in + let the_z3proc_version = FStarC_Util.mk_ref "" in let make_new_z3_proc cmd_and_args = (let uu___1 = FStarC_Options.hint_info () in if uu___1 @@ -477,49 +471,47 @@ let (bg_z3_proc : bgproc FStarC_Compiler_Effect.ref) = let uu___3 = let uu___4 = FStarC_Options.z3_version () in FStarC_Class_Show.show FStarC_Class_Show.showable_string uu___4 in - FStarC_Compiler_Util.print2 - "Creating new z3proc (cmd=[%s], version=[%s])\n" uu___2 uu___3 + FStarC_Util.print2 "Creating new z3proc (cmd=[%s], version=[%s])\n" + uu___2 uu___3 else ()); (let uu___2 = let uu___3 = new_z3proc_with_id cmd_and_args in FStar_Pervasives_Native.Some uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals the_z3proc uu___2); - FStarC_Compiler_Effect.op_Colon_Equals the_z3proc_params + FStarC_Effect.op_Colon_Equals the_z3proc uu___2); + FStarC_Effect.op_Colon_Equals the_z3proc_params (FStar_Pervasives_Native.Some cmd_and_args); - FStarC_Compiler_Effect.op_Colon_Equals the_z3proc_ask_count - Prims.int_zero in + FStarC_Effect.op_Colon_Equals the_z3proc_ask_count Prims.int_zero in (let uu___1 = FStarC_Options.z3_version () in - FStarC_Compiler_Effect.op_Colon_Equals the_z3proc_version uu___1); + FStarC_Effect.op_Colon_Equals the_z3proc_version uu___1); (let z3proc uu___1 = (let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang the_z3proc in + let uu___4 = FStarC_Effect.op_Bang the_z3proc in uu___4 = FStar_Pervasives_Native.None in if uu___3 then let uu___4 = z3_cmd_and_args () in make_new_z3_proc uu___4 else ()); - (let uu___3 = FStarC_Compiler_Effect.op_Bang the_z3proc in - FStarC_Compiler_Util.must uu___3) in + (let uu___3 = FStarC_Effect.op_Bang the_z3proc in + FStarC_Util.must uu___3) in let ask input = - FStarC_Compiler_Util.incr the_z3proc_ask_count; + FStarC_Util.incr the_z3proc_ask_count; (let kill_handler uu___2 = "\nkilled\n" in let uu___2 = z3proc () in - FStarC_Compiler_Util.ask_process uu___2 input kill_handler - (warn_handler [])) in + FStarC_Util.ask_process uu___2 input kill_handler (warn_handler [])) in let maybe_kill_z3proc uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang the_z3proc in + let uu___3 = FStarC_Effect.op_Bang the_z3proc in uu___3 <> FStar_Pervasives_Native.None in if uu___2 then let old_params = - let uu___3 = FStarC_Compiler_Effect.op_Bang the_z3proc_params in - FStarC_Compiler_Util.must uu___3 in - let old_version = FStarC_Compiler_Effect.op_Bang the_z3proc_version in + let uu___3 = FStarC_Effect.op_Bang the_z3proc_params in + FStarC_Util.must uu___3 in + let old_version = FStarC_Effect.op_Bang the_z3proc_version in ((let uu___4 = FStarC_Options.hint_info () in if uu___4 then let uu___5 = - let uu___6 = FStarC_Compiler_Effect.op_Bang the_z3proc_ask_count in + let uu___6 = FStarC_Effect.op_Bang the_z3proc_ask_count in FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___6 in let uu___6 = FStarC_Class_Show.show @@ -527,18 +519,16 @@ let (bg_z3_proc : bgproc FStarC_Compiler_Effect.ref) = FStarC_Class_Show.showable_string (FStarC_Class_Show.show_list FStarC_Class_Show.showable_string)) old_params in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Killing old z3proc (ask_count=%s, old_cmd=[%s])\n" uu___5 uu___6 else ()); (let uu___5 = - let uu___6 = FStarC_Compiler_Effect.op_Bang the_z3proc in - FStarC_Compiler_Util.must uu___6 in - FStarC_Compiler_Util.kill_process uu___5); - FStarC_Compiler_Effect.op_Colon_Equals the_z3proc_ask_count - Prims.int_zero; - FStarC_Compiler_Effect.op_Colon_Equals the_z3proc - FStar_Pervasives_Native.None) + let uu___6 = FStarC_Effect.op_Bang the_z3proc in + FStarC_Util.must uu___6 in + FStarC_Util.kill_process uu___5); + FStarC_Effect.op_Colon_Equals the_z3proc_ask_count Prims.int_zero; + FStarC_Effect.op_Colon_Equals the_z3proc FStar_Pervasives_Native.None) else () in let refresh uu___1 = maybe_kill_z3proc (); query_logging.close_log () in let restart uu___1 = @@ -549,14 +539,13 @@ let (bg_z3_proc : bgproc FStarC_Compiler_Effect.ref) = let uu___1 = let uu___2 = FStarC_SMTEncoding_SolverState.init () in { - ask = (FStarC_Compiler_Util.with_monitor x ask); - refresh = (FStarC_Compiler_Util.with_monitor x refresh); - restart = (FStarC_Compiler_Util.with_monitor x restart); - version = - (fun uu___3 -> FStarC_Compiler_Effect.op_Bang the_z3proc_version); + ask = (FStarC_Util.with_monitor x ask); + refresh = (FStarC_Util.with_monitor x refresh); + restart = (FStarC_Util.with_monitor x restart); + version = (fun uu___3 -> FStarC_Effect.op_Bang the_z3proc_version); ctxt = uu___2 } in - FStarC_Compiler_Util.mk_ref uu___1) + FStarC_Util.mk_ref uu___1) type smt_output_section = Prims.string Prims.list type smt_output = { @@ -597,7 +586,7 @@ let (__proj__Mksmt_output__item__smt_labels : smt_labels;_} -> smt_labels let (smt_output_sections : Prims.string FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> Prims.string Prims.list -> smt_output) + FStarC_Range_Type.range -> Prims.string Prims.list -> smt_output) = fun log_file -> fun r -> @@ -610,7 +599,7 @@ let (smt_output_sections : then FStar_Pervasives_Native.Some ([], lines2) else (let uu___1 = until tag lines2 in - FStarC_Compiler_Util.map_opt uu___1 + FStarC_Util.map_opt uu___1 (fun uu___2 -> match uu___2 with | (until_tag, rest) -> ((l :: until_tag), rest))) in @@ -630,7 +619,7 @@ let (smt_output_sections : (Prims.strcat (end_tag tag) " not found")) | FStar_Pervasives_Native.Some (section, suffix1) -> ((FStar_Pervasives_Native.Some section), - (FStarC_Compiler_List.op_At prefix suffix1))) in + (FStarC_List.op_At prefix suffix1))) in let uu___ = find_section "result" lines in match uu___ with | (result_opt, lines1) -> @@ -638,9 +627,9 @@ let (smt_output_sections : match result_opt with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unexpexted output from Z3: no result section found:\n%s" - (FStarC_Compiler_String.concat "\n" lines1) in + (FStarC_String.concat "\n" lines1) in failwith uu___1 | FStar_Pervasives_Native.Some result1 -> result1 in let uu___1 = find_section "reason-unknown" lines1 in @@ -661,14 +650,12 @@ let (smt_output_sections : | FStar_Pervasives_Native.None -> lines5 | FStar_Pervasives_Native.Some (prefix, suffix) -> - FStarC_Compiler_List.op_At prefix - suffix in + FStarC_List.op_At prefix suffix in ((match remaining with | [] -> () | uu___6 -> let msg = - FStarC_Compiler_String.concat "\n" - remaining in + FStarC_String.concat "\n" remaining in let suf = match log_file with | FStar_Pervasives_Native.Some @@ -685,8 +672,7 @@ let (smt_output_sections : [uu___7] | FStar_Pervasives_Native.None -> [] in warn_handler suf msg); - (let uu___6 = - FStarC_Compiler_Util.must result_opt in + (let uu___6 = FStarC_Util.must result_opt in { smt_result = uu___6; smt_reason_unknown = reason_unknown; @@ -701,11 +687,11 @@ let with_solver_state : -> 'a = fun f -> - let ss = FStarC_Compiler_Effect.op_Bang bg_z3_proc in + let ss = FStarC_Effect.op_Bang bg_z3_proc in let uu___ = f ss.ctxt in match uu___ with | (res, ctxt) -> - (FStarC_Compiler_Effect.op_Colon_Equals bg_z3_proc + (FStarC_Effect.op_Colon_Equals bg_z3_proc { ask = (ss.ask); refresh = (ss.refresh); @@ -721,7 +707,7 @@ let (with_solver_state_unit : = fun f -> with_solver_state (fun x -> let uu___ = f x in ((), uu___)) let reading_solver_state : 'a . (FStarC_SMTEncoding_SolverState.solver_state -> 'a) -> 'a = - fun f -> let ss = FStarC_Compiler_Effect.op_Bang bg_z3_proc in f ss.ctxt + fun f -> let ss = FStarC_Effect.op_Bang bg_z3_proc in f ss.ctxt let (push : Prims.string -> unit) = fun msg -> with_solver_state_unit FStarC_SMTEncoding_SolverState.push; @@ -770,13 +756,15 @@ let (refresh : FStar_Pervasives_Native.option -> unit) = fun using_facts_from -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang bg_z3_proc in - uu___1.refresh ()); + (let uu___1 = FStarC_Effect.op_Bang bg_z3_proc in uu___1.refresh ()); with_solver_state_unit (FStarC_SMTEncoding_SolverState.reset using_facts_from) +let (stop : unit -> unit) = + fun uu___ -> + let uu___1 = FStarC_Effect.op_Bang bg_z3_proc in uu___1.refresh () let (doZ3Exe : Prims.string FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> Prims.string -> FStarC_SMTEncoding_Term.error_labels -> @@ -790,8 +778,8 @@ let (doZ3Exe : fun queryid -> let parse z3out = let lines = - FStarC_Compiler_List.map FStarC_Compiler_Util.trim_string - (FStarC_Compiler_String.split [10] z3out) in + FStarC_List.map FStarC_Util.trim_string + (FStarC_String.split [10] z3out) in let smt_output1 = smt_output_sections log_file r lines in let unsat_core = match smt_output1.smt_unsat_core with @@ -799,19 +787,16 @@ let (doZ3Exe : FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some s -> let s1 = - FStarC_Compiler_Util.trim_string - (FStarC_Compiler_String.concat " " s) in + FStarC_Util.trim_string (FStarC_String.concat " " s) in let s2 = - FStarC_Compiler_Util.substring s1 Prims.int_one - ((FStarC_Compiler_String.length s1) - - (Prims.of_int (2))) in - if FStarC_Compiler_Util.starts_with s2 "error" + FStarC_Util.substring s1 Prims.int_one + ((FStarC_String.length s1) - (Prims.of_int (2))) in + if FStarC_Util.starts_with s2 "error" then FStar_Pervasives_Native.None else (let uu___1 = - FStarC_Compiler_Util.sort_with - FStarC_Compiler_String.compare - (FStarC_Compiler_Util.split s2 " ") in + FStarC_Util.sort_with FStarC_String.compare + (FStarC_Util.split s2 " ") in FStar_Pervasives_Native.Some uu___1) in let labels = match smt_output1.smt_labels with @@ -820,17 +805,17 @@ let (doZ3Exe : let rec lblnegs lines2 = match lines2 with | lname::"false"::rest when - FStarC_Compiler_Util.starts_with lname "label_" - -> let uu___ = lblnegs rest in lname :: uu___ + FStarC_Util.starts_with lname "label_" -> + let uu___ = lblnegs rest in lname :: uu___ | lname::uu___::rest when - FStarC_Compiler_Util.starts_with lname "label_" - -> lblnegs rest + FStarC_Util.starts_with lname "label_" -> + lblnegs rest | uu___ -> [] in let lblnegs1 = lblnegs lines1 in - FStarC_Compiler_List.collect + FStarC_List.collect (fun l -> let uu___ = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | (m, uu___2, uu___3) -> @@ -842,81 +827,68 @@ let (doZ3Exe : | FStar_Pervasives_Native.Some (lbl, msg, r1) -> [(lbl, msg, r1)]) lblnegs1 in let statistics = - let statistics1 = - FStarC_Compiler_Util.smap_create Prims.int_zero in + let statistics1 = FStarC_Util.smap_create Prims.int_zero in match smt_output1.smt_statistics with | FStar_Pervasives_Native.None -> statistics1 | FStar_Pervasives_Native.Some lines1 -> let parse_line line = let pline = - FStarC_Compiler_Util.split - (FStarC_Compiler_Util.trim_string line) ":" in + FStarC_Util.split (FStarC_Util.trim_string line) + ":" in match pline with | "("::entry::[] -> - let tokens = FStarC_Compiler_Util.split entry " " in - let key = FStarC_Compiler_List.hd tokens in + let tokens = FStarC_Util.split entry " " in + let key = FStarC_List.hd tokens in let ltok = - FStarC_Compiler_List.nth tokens - ((FStarC_Compiler_List.length tokens) - - Prims.int_one) in + FStarC_List.nth tokens + ((FStarC_List.length tokens) - Prims.int_one) in let value = - if FStarC_Compiler_Util.ends_with ltok ")" + if FStarC_Util.ends_with ltok ")" then - FStarC_Compiler_Util.substring ltok - Prims.int_zero - ((FStarC_Compiler_String.length ltok) - + FStarC_Util.substring ltok Prims.int_zero + ((FStarC_String.length ltok) - Prims.int_one) else ltok in - FStarC_Compiler_Util.smap_add statistics1 key - value + FStarC_Util.smap_add statistics1 key value | ""::entry::[] -> - let tokens = FStarC_Compiler_Util.split entry " " in - let key = FStarC_Compiler_List.hd tokens in + let tokens = FStarC_Util.split entry " " in + let key = FStarC_List.hd tokens in let ltok = - FStarC_Compiler_List.nth tokens - ((FStarC_Compiler_List.length tokens) - - Prims.int_one) in + FStarC_List.nth tokens + ((FStarC_List.length tokens) - Prims.int_one) in let value = - if FStarC_Compiler_Util.ends_with ltok ")" + if FStarC_Util.ends_with ltok ")" then - FStarC_Compiler_Util.substring ltok - Prims.int_zero - ((FStarC_Compiler_String.length ltok) - + FStarC_Util.substring ltok Prims.int_zero + ((FStarC_String.length ltok) - Prims.int_one) else ltok in - FStarC_Compiler_Util.smap_add statistics1 key - value + FStarC_Util.smap_add statistics1 key value | uu___ -> () in - (FStarC_Compiler_List.iter parse_line lines1; - statistics1) in + (FStarC_List.iter parse_line lines1; statistics1) in let reason_unknown = - FStarC_Compiler_Util.map_opt smt_output1.smt_reason_unknown + FStarC_Util.map_opt smt_output1.smt_reason_unknown (fun x -> - let ru = FStarC_Compiler_String.concat " " x in - if - FStarC_Compiler_Util.starts_with ru - "(:reason-unknown \"" + let ru = FStarC_String.concat " " x in + if FStarC_Util.starts_with ru "(:reason-unknown \"" then let reason = - FStarC_Compiler_Util.substring_from ru - (FStarC_Compiler_String.length - "(:reason-unknown \"") in + FStarC_Util.substring_from ru + (FStarC_String.length "(:reason-unknown \"") in let res = - FStarC_Compiler_String.substring reason - Prims.int_zero - ((FStarC_Compiler_String.length reason) - + FStarC_String.substring reason Prims.int_zero + ((FStarC_String.length reason) - (Prims.of_int (2))) in res else ru) in let status = - (let uu___1 = FStarC_Compiler_Debug.any () in + (let uu___1 = FStarC_Debug.any () in if uu___1 then let uu___2 = - FStarC_Compiler_Util.format1 "Z3 says: %s\n" - (FStarC_Compiler_String.concat "\n" - smt_output1.smt_result) in - FStarC_Compiler_Util.print_string uu___2 + FStarC_Util.format1 "Z3 says: %s\n" + (FStarC_String.concat "\n" smt_output1.smt_result) in + FStarC_Util.print_string uu___2 else ()); (match smt_output1.smt_result with | "unsat"::[] -> UNSAT unsat_core @@ -924,16 +896,14 @@ let (doZ3Exe : | "unknown"::[] -> UNKNOWN (labels, reason_unknown) | "timeout"::[] -> TIMEOUT (labels, reason_unknown) | "killed"::[] -> - ((let uu___2 = - FStarC_Compiler_Effect.op_Bang bg_z3_proc in + ((let uu___2 = FStarC_Effect.op_Bang bg_z3_proc in uu___2.restart ()); KILLED) | uu___1 -> let uu___2 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unexpected output from Z3: got output result: %s\n" - (FStarC_Compiler_String.concat "\n" - smt_output1.smt_result) in + (FStarC_String.concat "\n" smt_output1.smt_result) in failwith uu___2) in (status, statistics) in let log_result fwrite uu___ = @@ -952,7 +922,7 @@ let (doZ3Exe : | UNSAT (FStar_Pervasives_Native.Some core) -> fwrite fname (Prims.strcat "; UNSAT CORE GENERATED: " - (FStarC_Compiler_String.concat ", " core)) + (FStarC_String.concat ", " core)) | uu___4 -> ())) | FStar_Pervasives_Native.None -> ()); (let log_file_name = @@ -975,41 +945,41 @@ let (doZ3Exe : "Tm_unit"; "FString_const"] in let missing = - FStarC_Compiler_List.filter + FStarC_List.filter (fun name -> (((((let uu___4 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun wl -> - FStarC_Compiler_Util.contains - name wl) whitelist in + FStarC_Util.contains name wl) + whitelist in Prims.op_Negation uu___4) && (Prims.op_Negation - (FStarC_Compiler_Util.starts_with - name "binder_"))) + (FStarC_Util.starts_with name + "binder_"))) && (Prims.op_Negation - (FStarC_Compiler_Util.starts_with - name "@query"))) + (FStarC_Util.starts_with name + "@query"))) && (Prims.op_Negation - (FStarC_Compiler_Util.starts_with - name "@MaxFuel"))) + (FStarC_Util.starts_with name + "@MaxFuel"))) && (Prims.op_Negation - (FStarC_Compiler_Util.starts_with name + (FStarC_Util.starts_with name "@MaxIFuel"))) && (let uu___4 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun name' -> name = name') names in Prims.op_Negation uu___4)) core in (match missing with | [] -> () | uu___4 -> - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Query %s (%s): Pruned theory would miss %s\n" queryid log_file_name - (FStarC_Compiler_String.concat ", " missing)) + (FStarC_String.concat ", " missing)) | uu___4 -> ())) in if fresh then @@ -1017,23 +987,22 @@ let (doZ3Exe : let uu___ = z3_cmd_and_args () in new_z3proc_with_id uu___ in let kill_handler uu___ = "\nkilled\n" in let out = - FStarC_Compiler_Util.ask_process proc input kill_handler + FStarC_Util.ask_process proc input kill_handler (warn_handler []) in - let r1 = parse (FStarC_Compiler_Util.trim_string out) in + let r1 = parse (FStarC_Util.trim_string out) in (log_result (fun fname -> fun s -> - let h = - FStarC_Compiler_Util.open_file_for_appending fname in - FStarC_Compiler_Util.append_to_file h s; - FStarC_Compiler_Util.close_out_channel h) r1; - FStarC_Compiler_Util.kill_process proc; + let h = FStarC_Util.open_file_for_appending fname in + FStarC_Util.append_to_file h s; + FStarC_Util.close_out_channel h) r1; + FStarC_Util.kill_process proc; r1) else (let out = - let uu___1 = FStarC_Compiler_Effect.op_Bang bg_z3_proc in + let uu___1 = FStarC_Effect.op_Bang bg_z3_proc in uu___1.ask input in - let r1 = parse (FStarC_Compiler_Util.trim_string out) in + let r1 = parse (FStarC_Util.trim_string out) in log_result (fun _fname -> fun s -> @@ -1051,7 +1020,7 @@ let (z3_options : Prims.string -> Prims.string) = "(set-option :smt.relevancy 2)"] in let opts1 = let uu___ = - let uu___1 = FStarC_Compiler_Misc.version_ge ver "4.12.3" in + let uu___1 = FStarC_Misc.version_ge ver "4.12.3" in if uu___1 then ["(set-option :rewriter.enable_der false)"; @@ -1059,12 +1028,12 @@ let (z3_options : Prims.string -> Prims.string) = "(set-option :pi.decompose_patterns false)"; "(set-option :smt.arith.solver 6)"] else ["(set-option :smt.arith.solver 2)"] in - FStarC_Compiler_List.op_At opts uu___ in - Prims.strcat (FStarC_Compiler_String.concat "\n" opts1) "\n" + FStarC_List.op_At opts uu___ in + Prims.strcat (FStarC_String.concat "\n" opts1) "\n" let (context_profile : FStarC_SMTEncoding_Term.decl Prims.list -> unit) = fun theory -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun d -> match uu___1 with @@ -1072,36 +1041,36 @@ let (context_profile : FStarC_SMTEncoding_Term.decl Prims.list -> unit) = (match d with | FStarC_SMTEncoding_Term.Module (name, decls) -> let decls1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | FStarC_SMTEncoding_Term.Assume uu___3 -> true | uu___3 -> false) decls in - let n = FStarC_Compiler_List.length decls1 in + let n = FStarC_List.length decls1 in (((name, n) :: out), (n + _total)) | uu___2 -> (out, _total))) ([], Prims.int_zero) theory in match uu___ with | (modules, total_decls) -> let modules1 = - FStarC_Compiler_List.sortWith + FStarC_List.sortWith (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with | ((uu___3, n), (uu___4, m)) -> m - n) modules in (if modules1 <> [] then - (let uu___2 = FStarC_Compiler_Util.string_of_int total_decls in - FStarC_Compiler_Util.print1 + (let uu___2 = FStarC_Util.string_of_int total_decls in + FStarC_Util.print1 "Z3 Proof Stats: context_profile with %s assertions\n" uu___2) else (); - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___2 -> match uu___2 with | (m, n) -> if n <> Prims.int_zero then - let uu___3 = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.print2 + let uu___3 = FStarC_Util.string_of_int n in + FStarC_Util.print2 "Z3 Proof Stats: %s produced %s SMT decls\n" m uu___3 else ()) modules1) let (mk_input : @@ -1116,11 +1085,9 @@ let (mk_input : let theory1 = let uu___ = let uu___1 = - let uu___2 = - FStarC_Compiler_Effect.op_Bang FStarC_Options._version in - let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options._commit in - FStarC_Compiler_Util.format3 + let uu___2 = FStarC_Effect.op_Bang FStarC_Options._version in + let uu___3 = FStarC_Effect.op_Bang FStarC_Options._commit in + FStarC_Util.format3 "Z3 invocation started by F*\nF* version: %s -- commit hash: %s\nZ3 version (according to F*): %s" uu___2 uu___3 ver in FStarC_SMTEncoding_Term.Caption uu___1 in @@ -1130,7 +1097,7 @@ let (mk_input : let uu___ = let uu___1 = let uu___2 = FStarC_Options.z3_smtopt () in - FStarC_Compiler_String.concat "\n" uu___2 in + FStarC_String.concat "\n" uu___2 in Prims.strcat uu___1 "\n\n" in Prims.strcat options uu___ in (let uu___1 = FStarC_Options.print_z3_statistics () in @@ -1144,43 +1111,42 @@ let (mk_input : then let uu___3 = let uu___4 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun uu___5 -> match uu___5 with | FStarC_SMTEncoding_Term.CheckSat -> true | uu___6 -> false) theory1 in - FStarC_Compiler_Option.get uu___4 in + FStarC_Option.get uu___4 in match uu___3 with | (prefix, check_sat, suffix) -> let pp = - FStarC_Compiler_List.map - (FStarC_SMTEncoding_Term.declToSmt options1) in + FStarC_List.map (FStarC_SMTEncoding_Term.declToSmt options1) in let suffix1 = check_sat :: suffix in let ps_lines = pp prefix in let ss_lines = pp suffix1 in - let ps = FStarC_Compiler_String.concat "\n" ps_lines in - let ss = FStarC_Compiler_String.concat "\n" ss_lines in + let ps = FStarC_String.concat "\n" ps_lines in + let ss = FStarC_String.concat "\n" ss_lines in let hs = let uu___4 = FStarC_Options.keep_query_captions () in if uu___4 then let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_SMTEncoding_Term.declToSmt_no_caps options1) prefix in - FStarC_Compiler_String.concat "\n" uu___5 + FStarC_String.concat "\n" uu___5 else ps in let hs1 = Prims.strcat hs (Prims.strcat "Z3 version: " ver) in let uu___4 = - let uu___5 = FStarC_Compiler_Util.digest_of_string hs1 in + let uu___5 = FStarC_Util.digest_of_string hs1 in FStar_Pervasives_Native.Some uu___5 in ((Prims.strcat ps (Prims.strcat "\n" ss)), uu___4) else (let uu___4 = let uu___5 = - FStarC_Compiler_List.map - (FStarC_SMTEncoding_Term.declToSmt options1) theory1 in - FStarC_Compiler_String.concat "\n" uu___5 in + FStarC_List.map (FStarC_SMTEncoding_Term.declToSmt options1) + theory1 in + FStarC_String.concat "\n" uu___5 in (uu___4, FStar_Pervasives_Native.None)) in match uu___1 with | (r, hash) -> @@ -1208,8 +1174,8 @@ let (cache_hit : then match qhash with | FStar_Pervasives_Native.Some x when qhash = cache -> - let stats = FStarC_Compiler_Util.smap_create Prims.int_zero in - (FStarC_Compiler_Util.smap_add stats "fstar_cache_hit" "1"; + let stats = FStarC_Util.smap_create Prims.int_zero in + (FStarC_Util.smap_add stats "fstar_cache_hit" "1"; (let result = { z3result_status = (UNSAT FStar_Pervasives_Native.None); @@ -1223,7 +1189,7 @@ let (cache_hit : else FStar_Pervasives_Native.None let (z3_job : Prims.string FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> FStarC_SMTEncoding_Term.error_labels -> Prims.string -> @@ -1247,14 +1213,14 @@ let (z3_job : (fun uu___3 -> match () with | () -> - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___4 -> doZ3Exe log_file r fresh input label_messages queryid)) () with | uu___3 -> (refresh FStar_Pervasives_Native.None; - FStarC_Compiler_Effect.raise uu___3)) uu___1 + FStarC_Effect.raise uu___3)) uu___1 "FStarC.SMTEncoding.Z3 (aggregate query time)" in match uu___ with | ((status, statistics), elapsed_time) -> @@ -1266,7 +1232,7 @@ let (z3_job : z3result_log_file = log_file } let (ask_text : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.string FStar_Pervasives_Native.option -> FStarC_SMTEncoding_Term.error_labels -> FStarC_SMTEncoding_Term.decl Prims.list -> @@ -1289,14 +1255,14 @@ let (ask_text : (FStarC_SMTEncoding_SolverState.filter_with_unsat_core queryid core1) in let query_tail = - FStarC_Compiler_List.op_At + FStarC_List.op_At ((FStarC_SMTEncoding_Term.Push Prims.int_zero) :: qry) [FStarC_SMTEncoding_Term.Pop Prims.int_zero] in - let theory1 = FStarC_Compiler_List.op_At theory query_tail in + let theory1 = FStarC_List.op_At theory query_tail in let uu___ = mk_input true theory1 in match uu___ with | (input, qhash, log_file_name) -> input let (ask : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.string FStar_Pervasives_Native.option -> FStarC_SMTEncoding_Term.error_labels -> FStarC_SMTEncoding_Term.decl Prims.list -> @@ -1326,8 +1292,8 @@ let (ask : (FStarC_SMTEncoding_SolverState.filter_with_unsat_core queryid core1)) in let theory1 = - FStarC_Compiler_List.op_At theory - (FStarC_Compiler_List.op_At + FStarC_List.op_At theory + (FStarC_List.op_At ((FStarC_SMTEncoding_Term.Push Prims.int_zero) :: qry) [FStarC_SMTEncoding_Term.Pop Prims.int_zero]) in let uu___ = mk_input fresh theory1 in diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Sealed.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Sealed.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Compiler_Sealed.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Sealed.ml diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Compress.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Compress.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_Syntax_Compress.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Compress.ml index d85455c9eda..ce8c3ec50d1 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Compress.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Compress.ml @@ -13,7 +13,7 @@ let (compress1_t : let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_ctxu uv in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Internal error: unexpected unresolved uvar in deep_compress: %s" uu___1 in FStarC_Errors.raise_error0 @@ -22,14 +22,13 @@ let (compress1_t : (Obj.magic uu___) | FStarC_Syntax_Syntax.Tm_name bv when Prims.op_Negation allow_names -> - ((let uu___1 = FStarC_Compiler_Debug.any () in + ((let uu___1 = FStarC_Debug.any () in if uu___1 then let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv bv in - FStarC_Compiler_Util.format1 "Tm_name %s in deep compress" - uu___3 in + FStarC_Util.format1 "Tm_name %s in deep compress" uu___3 in FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) t FStarC_Errors_Codes.Warning_NameEscape () @@ -86,14 +85,13 @@ let (compress1_u : match u with | FStarC_Syntax_Syntax.U_name bv when Prims.op_Negation allow_names -> - ((let uu___1 = FStarC_Compiler_Debug.any () in + ((let uu___1 = FStarC_Debug.any () in if uu___1 then let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_ident bv in - FStarC_Compiler_Util.format1 "U_name %s in deep compress" - uu___3 in + FStarC_Util.format1 "U_name %s in deep compress" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NameEscape () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -106,7 +104,7 @@ let (compress1_u : let uu___1 = let uu___2 = FStarC_Syntax_Unionfind.univ_uvar_id uv in FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___2 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Internal error: unexpected unresolved (universe) uvar in deep_compress: %s" uu___1 in FStarC_Errors.raise_error0 @@ -160,7 +158,7 @@ let (deep_compress_se : fun se -> let uu___ = let uu___1 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.format1 "While deep-compressing %s" uu___1 in + FStarC_Util.format1 "While deep-compressing %s" uu___1 in FStarC_Errors.with_ctx uu___ (fun uu___1 -> let uu___2 = compress1_t allow_uvars allow_names in diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_DsEnv.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_DsEnv.ml similarity index 89% rename from stage0/fstar-lib/generated/FStarC_Syntax_DsEnv.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_DsEnv.ml index c2f053f03b7..4ca8c5cb8e4 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_DsEnv.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_DsEnv.ml @@ -1,8 +1,8 @@ open Prims let (ugly_sigelt_to_string_hook : - (FStarC_Syntax_Syntax.sigelt -> Prims.string) FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref (fun uu___ -> "") -type used_marker = Prims.bool FStarC_Compiler_Effect.ref + (FStarC_Syntax_Syntax.sigelt -> Prims.string) FStarC_Effect.ref) = + FStarC_Util.mk_ref (fun uu___ -> "") +type used_marker = Prims.bool FStarC_Effect.ref type record_or_dc = { typename: FStarC_Ident.lident ; @@ -48,24 +48,23 @@ let (__proj__Mkrecord_or_dc__item__is_record : record_or_dc -> Prims.bool) = is_record let (ugly_sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = fun se -> - let uu___ = FStarC_Compiler_Effect.op_Bang ugly_sigelt_to_string_hook in - uu___ se + let uu___ = FStarC_Effect.op_Bang ugly_sigelt_to_string_hook in uu___ se type local_binding = (FStarC_Ident.ident * FStarC_Syntax_Syntax.bv * used_marker) type rec_binding = (FStarC_Ident.ident * FStarC_Ident.lid * used_marker) type scope_mod = - | Local_bindings of local_binding FStarC_Compiler_Util.psmap + | Local_bindings of local_binding FStarC_Util.psmap | Rec_binding of rec_binding | Module_abbrev of FStarC_Syntax_Syntax.module_abbrev | Open_module_or_namespace of FStarC_Syntax_Syntax.open_module_or_namespace - | Top_level_defs of Prims.bool FStarC_Compiler_Util.psmap + | Top_level_defs of Prims.bool FStarC_Util.psmap | Record_or_dc of record_or_dc let (uu___is_Local_bindings : scope_mod -> Prims.bool) = fun projectee -> match projectee with | Local_bindings _0 -> true | uu___ -> false let (__proj__Local_bindings__item___0 : - scope_mod -> local_binding FStarC_Compiler_Util.psmap) = + scope_mod -> local_binding FStarC_Util.psmap) = fun projectee -> match projectee with | Local_bindings _0 -> _0 let (uu___is_Rec_binding : scope_mod -> Prims.bool) = fun projectee -> @@ -90,14 +89,14 @@ let (uu___is_Top_level_defs : scope_mod -> Prims.bool) = fun projectee -> match projectee with | Top_level_defs _0 -> true | uu___ -> false let (__proj__Top_level_defs__item___0 : - scope_mod -> Prims.bool FStarC_Compiler_Util.psmap) = + scope_mod -> Prims.bool FStarC_Util.psmap) = fun projectee -> match projectee with | Top_level_defs _0 -> _0 let (uu___is_Record_or_dc : scope_mod -> Prims.bool) = fun projectee -> match projectee with | Record_or_dc _0 -> true | uu___ -> false let (__proj__Record_or_dc__item___0 : scope_mod -> record_or_dc) = fun projectee -> match projectee with | Record_or_dc _0 -> _0 -type string_set = Prims.string FStarC_Compiler_RBSet.t +type string_set = Prims.string FStarC_RBSet.t type exported_id_kind = | Exported_id_term_type | Exported_id_field @@ -115,23 +114,21 @@ let (uu___0 : exported_id_kind FStarC_Class_Show.showable) = | Exported_id_field -> "Exported_id_field" | Exported_id_term_type -> "Exported_id_term_type") } -type exported_id_set = - exported_id_kind -> string_set FStarC_Compiler_Effect.ref +type exported_id_set = exported_id_kind -> string_set FStarC_Effect.ref type env = { curmodule: FStarC_Ident.lident FStar_Pervasives_Native.option ; curmonad: FStarC_Ident.ident FStar_Pervasives_Native.option ; modules: (FStarC_Ident.lident * FStarC_Syntax_Syntax.modul) Prims.list ; scope_mods: scope_mod Prims.list ; - exported_ids: exported_id_set FStarC_Compiler_Util.smap ; - trans_exported_ids: exported_id_set FStarC_Compiler_Util.smap ; + exported_ids: exported_id_set FStarC_Util.smap ; + trans_exported_ids: exported_id_set FStarC_Util.smap ; includes: (FStarC_Ident.lident * FStarC_Syntax_Syntax.restriction) Prims.list - FStarC_Compiler_Effect.ref FStarC_Compiler_Util.smap + FStarC_Effect.ref FStarC_Util.smap ; sigaccum: FStarC_Syntax_Syntax.sigelts ; - sigmap: - (FStarC_Syntax_Syntax.sigelt * Prims.bool) FStarC_Compiler_Util.smap ; + sigmap: (FStarC_Syntax_Syntax.sigelt * Prims.bool) FStarC_Util.smap ; iface: Prims.bool ; admitted_iface: Prims.bool ; expect_typ: Prims.bool ; @@ -179,7 +176,7 @@ let (__proj__Mkenv__item__scope_mods : env -> scope_mod Prims.list) = admitted_iface; expect_typ; remaining_iface_decls; syntax_only; ds_hooks; dep_graph;_} -> scope_mods let (__proj__Mkenv__item__exported_ids : - env -> exported_id_set FStarC_Compiler_Util.smap) = + env -> exported_id_set FStarC_Util.smap) = fun projectee -> match projectee with | { curmodule; curmonad; modules; scope_mods; exported_ids; @@ -187,7 +184,7 @@ let (__proj__Mkenv__item__exported_ids : admitted_iface; expect_typ; remaining_iface_decls; syntax_only; ds_hooks; dep_graph;_} -> exported_ids let (__proj__Mkenv__item__trans_exported_ids : - env -> exported_id_set FStarC_Compiler_Util.smap) = + env -> exported_id_set FStarC_Util.smap) = fun projectee -> match projectee with | { curmodule; curmonad; modules; scope_mods; exported_ids; @@ -197,7 +194,7 @@ let (__proj__Mkenv__item__trans_exported_ids : let (__proj__Mkenv__item__includes : env -> (FStarC_Ident.lident * FStarC_Syntax_Syntax.restriction) Prims.list - FStarC_Compiler_Effect.ref FStarC_Compiler_Util.smap) + FStarC_Effect.ref FStarC_Util.smap) = fun projectee -> match projectee with @@ -213,8 +210,7 @@ let (__proj__Mkenv__item__sigaccum : env -> FStarC_Syntax_Syntax.sigelts) = admitted_iface; expect_typ; remaining_iface_decls; syntax_only; ds_hooks; dep_graph;_} -> sigaccum let (__proj__Mkenv__item__sigmap : - env -> (FStarC_Syntax_Syntax.sigelt * Prims.bool) FStarC_Compiler_Util.smap) - = + env -> (FStarC_Syntax_Syntax.sigelt * Prims.bool) FStarC_Util.smap) = fun projectee -> match projectee with | { curmodule; curmonad; modules; scope_mods; exported_ids; @@ -404,25 +400,24 @@ let (transitive_exported_ids : fun lid -> let module_name = FStarC_Ident.string_of_lid lid in let uu___ = - FStarC_Compiler_Util.smap_try_find env1.trans_exported_ids - module_name in + FStarC_Util.smap_try_find env1.trans_exported_ids module_name in match uu___ with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some exported_id_set1 -> let uu___1 = let uu___2 = exported_id_set1 Exported_id_term_type in - FStarC_Compiler_Effect.op_Bang uu___2 in + FStarC_Effect.op_Bang uu___2 in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) (Obj.magic uu___1) + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) + (Obj.magic uu___1) let (opens_and_abbrevs : env -> (FStarC_Syntax_Syntax.open_module_or_namespace, FStarC_Syntax_Syntax.module_abbrev) FStar_Pervasives.either Prims.list) = fun env1 -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___ -> match uu___ with | Open_module_or_namespace payload -> [FStar_Pervasives.Inl payload] @@ -433,7 +428,7 @@ let (open_modules : fun e -> e.modules let (open_modules_and_namespaces : env -> FStarC_Ident.lident Prims.list) = fun env1 -> - FStarC_Compiler_List.filter_map + FStarC_List.filter_map (fun uu___ -> match uu___ with | Open_module_or_namespace (lid, _info, _restriction) -> @@ -442,7 +437,7 @@ let (open_modules_and_namespaces : env -> FStarC_Ident.lident Prims.list) = let (module_abbrevs : env -> (FStarC_Ident.ident * FStarC_Ident.lident) Prims.list) = fun env1 -> - FStarC_Compiler_List.filter_map + FStarC_List.filter_map (fun uu___ -> match uu___ with | Module_abbrev (l, m) -> FStar_Pervasives_Native.Some (l, m) @@ -481,7 +476,7 @@ let (iface_decls : fun env1 -> fun l -> let uu___ = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | (m, uu___2) -> FStarC_Ident.lid_equals l m) env1.remaining_iface_decls in @@ -495,7 +490,7 @@ let (set_iface_decls : fun l -> fun ds -> let uu___ = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___1 -> match uu___1 with | (m, uu___2) -> FStarC_Ident.lid_equals l m) env1.remaining_iface_decls in @@ -574,8 +569,8 @@ let (set_ds_hooks : env -> dsenv_hooks -> env) = ds_hooks = hooks; dep_graph = (env1.dep_graph) } -let new_sigmap : 'uuuuu . unit -> 'uuuuu FStarC_Compiler_Util.smap = - fun uu___ -> FStarC_Compiler_Util.smap_create (Prims.of_int (100)) +let new_sigmap : 'uuuuu . unit -> 'uuuuu FStarC_Util.smap = + fun uu___ -> FStarC_Util.smap_create (Prims.of_int (100)) let (empty_env : FStarC_Parser_Dep.deps -> env) = fun deps -> let uu___ = new_sigmap () in @@ -623,11 +618,11 @@ let (set_dep_graph : env -> FStarC_Parser_Dep.deps -> env) = dep_graph = ds } let (sigmap : - env -> (FStarC_Syntax_Syntax.sigelt * Prims.bool) FStarC_Compiler_Util.smap) - = fun env1 -> env1.sigmap + env -> (FStarC_Syntax_Syntax.sigelt * Prims.bool) FStarC_Util.smap) = + fun env1 -> env1.sigmap let (set_bv_range : FStarC_Syntax_Syntax.bv -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.bv) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.bv) = fun bv -> fun r -> @@ -639,7 +634,7 @@ let (set_bv_range : } let (bv_to_name : FStarC_Syntax_Syntax.bv -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.term) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term) = fun bv -> fun r -> @@ -656,7 +651,7 @@ let (unmangleOpName : FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option) = fun id -> - FStarC_Compiler_Util.find_map unmangleMap + FStarC_Util.find_map unmangleMap (fun uu___ -> match uu___ with | (x, y, dq) -> @@ -710,7 +705,7 @@ let find_in_record : let uu___1 = let uu___2 = FStarC_Ident.ident_of_lid record.typename in [uu___2] in - FStarC_Compiler_List.op_At ns uu___1 in + FStarC_List.op_At ns uu___1 in FStarC_Ident.lid_of_ids uu___ in let uu___ = FStarC_Ident.lid_equals typename' record.typename in if uu___ @@ -718,10 +713,10 @@ let find_in_record : let fname = let uu___1 = let uu___2 = FStarC_Ident.ns_of_lid record.typename in - FStarC_Compiler_List.op_At uu___2 [id] in + FStarC_List.op_At uu___2 [id] in FStarC_Ident.lid_of_ids uu___1 in let find = - FStarC_Compiler_Util.find_map record.fields + FStarC_Util.find_map record.fields (fun uu___1 -> match uu___1 with | (f, uu___2) -> @@ -739,20 +734,16 @@ let find_in_record : let (get_exported_id_set : env -> Prims.string -> - (exported_id_kind -> string_set FStarC_Compiler_Effect.ref) + (exported_id_kind -> string_set FStarC_Effect.ref) FStar_Pervasives_Native.option) - = - fun e -> - fun mname -> FStarC_Compiler_Util.smap_try_find e.exported_ids mname + = fun e -> fun mname -> FStarC_Util.smap_try_find e.exported_ids mname let (get_trans_exported_id_set : env -> Prims.string -> - (exported_id_kind -> string_set FStarC_Compiler_Effect.ref) + (exported_id_kind -> string_set FStarC_Effect.ref) FStar_Pervasives_Native.option) = - fun e -> - fun mname -> - FStarC_Compiler_Util.smap_try_find e.trans_exported_ids mname + fun e -> fun mname -> FStarC_Util.smap_try_find e.trans_exported_ids mname let (string_of_exported_id_kind : exported_id_kind -> Prims.string) = fun uu___ -> match uu___ with @@ -788,29 +779,28 @@ let find_in_module_with_includes : | FStar_Pervasives_Native.Some mex -> let mexports = let uu___2 = mex eikind in - FStarC_Compiler_Effect.op_Bang uu___2 in + FStarC_Effect.op_Bang uu___2 in let uu___2 = FStarC_Ident.string_of_id id1 in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) uu___2 (Obj.magic mexports) in let mincludes = let uu___1 = - FStarC_Compiler_Util.smap_try_find env1.includes - mname in + FStarC_Util.smap_try_find env1.includes mname in match uu___1 with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some minc -> - let uu___2 = FStarC_Compiler_Effect.op_Bang minc in - FStarC_Compiler_List.filter_map + let uu___2 = FStarC_Effect.op_Bang minc in + FStarC_List.filter_map (fun uu___3 -> match uu___3 with | (ns1, restriction) -> let opt = FStarC_Syntax_Syntax.is_ident_allowed_by_restriction id1 restriction in - FStarC_Compiler_Util.map_opt opt + FStarC_Util.map_opt opt (fun id2 -> (ns1, id2))) uu___2 in let look_into = if not_shadowed @@ -818,8 +808,7 @@ let find_in_module_with_includes : let uu___1 = qual modul id1 in find_in_module uu___1 else Cont_ignore in (match look_into with - | Cont_ignore -> - aux (FStarC_Compiler_List.op_At mincludes q) + | Cont_ignore -> aux (FStarC_List.op_At mincludes q) | uu___1 -> look_into) in aux [(ns, id)] let try_lookup_id'' : @@ -862,25 +851,24 @@ let try_lookup_id'' : | Local_bindings lbs when let uu___1 = let uu___2 = FStarC_Ident.string_of_id id in - FStarC_Compiler_Util.psmap_try_find lbs uu___2 in + FStarC_Util.psmap_try_find lbs uu___2 in FStar_Pervasives_Native.uu___is_Some uu___1 -> let uu___1 = let uu___2 = FStarC_Ident.string_of_id id in - FStarC_Compiler_Util.psmap_try_find lbs uu___2 in + FStarC_Util.psmap_try_find lbs uu___2 in (match uu___1 with | FStar_Pervasives_Native.Some l -> let uu___2 = l in (match uu___2 with | (uu___3, uu___4, used_marker1) -> - (FStarC_Compiler_Effect.op_Colon_Equals - used_marker1 true; + (FStarC_Effect.op_Colon_Equals used_marker1 + true; k_local_binding l))) | Rec_binding r when check_rec_binding_id r -> let uu___1 = r in (match uu___1 with | (uu___2, uu___3, used_marker1) -> - (FStarC_Compiler_Effect.op_Colon_Equals - used_marker1 true; + (FStarC_Effect.op_Colon_Equals used_marker1 true; k_rec_binding r)) | Open_module_or_namespace (ns, FStarC_Syntax_Syntax.Open_module, restriction) @@ -896,7 +884,7 @@ let try_lookup_id'' : | Top_level_defs ids when let uu___1 = let uu___2 = FStarC_Ident.string_of_id id in - FStarC_Compiler_Util.psmap_try_find ids uu___2 in + FStarC_Util.psmap_try_find ids uu___2 in FStar_Pervasives_Native.uu___is_Some uu___1 -> lookup_default_id Cont_ignore id | Record_or_dc r when is_exported_id_field eikind -> @@ -925,7 +913,7 @@ let try_lookup_id'' : aux env1.scope_mods let found_local_binding : 'uuuuu 'uuuuu1 . - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> ('uuuuu * FStarC_Syntax_Syntax.bv * 'uuuuu1) -> FStarC_Syntax_Syntax.term = @@ -944,7 +932,7 @@ let find_in_module : fun k_not_found -> let uu___ = let uu___1 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_try_find (sigmap env1) uu___1 in + FStarC_Util.smap_try_find (sigmap env1) uu___1 in match uu___ with | FStar_Pervasives_Native.Some sb -> k_global_def lid sb | FStar_Pervasives_Native.None -> k_not_found @@ -987,7 +975,7 @@ let lookup_default_id : let lid = qualify env1 id in let uu___1 = let uu___2 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_try_find (sigmap env1) uu___2 in + FStarC_Util.smap_try_find (sigmap env1) uu___2 in (match uu___1 with | FStar_Pervasives_Native.Some r -> let uu___2 = k_global_def lid r in @@ -1010,7 +998,7 @@ let (module_is_defined : env -> FStarC_Ident.lident -> Prims.bool) = fun env1 -> fun lid -> (lid_is_curmod env1 lid) || - (FStarC_Compiler_List.existsb + (FStarC_List.existsb (fun x -> FStarC_Ident.lid_equals lid (FStar_Pervasives_Native.fst x)) env1.modules) @@ -1023,8 +1011,7 @@ let (resolve_module_name : fun lid -> fun honor_ns -> let nslen = - let uu___ = FStarC_Ident.ns_of_lid lid in - FStarC_Compiler_List.length uu___ in + let uu___ = FStarC_Ident.ns_of_lid lid in FStarC_List.length uu___ in let rec aux uu___ = match uu___ with | [] -> @@ -1039,7 +1026,7 @@ let (resolve_module_name : let uu___1 = let uu___2 = FStarC_Ident.path_of_lid ns in let uu___3 = FStarC_Ident.path_of_lid lid in - FStarC_Compiler_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___2 uu___3 in let uu___2 = FStarC_Ident.range_of_lid lid in FStarC_Ident.lid_of_path uu___1 uu___2 in let uu___1 = module_is_defined env1 new_lid in @@ -1060,7 +1047,7 @@ let (is_open : fun env1 -> fun lid -> fun open_kind -> - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___ -> match uu___ with | Open_module_or_namespace @@ -1084,35 +1071,32 @@ let (shorten_module_path : fun ids -> fun is_full_path -> let rec aux revns id = - let lid = - FStarC_Ident.lid_of_ns_and_id (FStarC_Compiler_List.rev revns) id in + let lid = FStarC_Ident.lid_of_ns_and_id (FStarC_List.rev revns) id in let uu___ = namespace_is_open env1 lid in if uu___ then FStar_Pervasives_Native.Some - ((FStarC_Compiler_List.rev (id :: revns)), []) + ((FStarC_List.rev (id :: revns)), []) else (match revns with | [] -> FStar_Pervasives_Native.None | ns_last_id::rev_ns_prefix -> let uu___2 = aux rev_ns_prefix ns_last_id in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun uu___3 -> match uu___3 with | (stripped_ids, rev_kept_ids) -> (stripped_ids, (id :: rev_kept_ids))) uu___2) in let do_shorten env2 ids1 = - match FStarC_Compiler_List.rev ids1 with + match FStarC_List.rev ids1 with | [] -> ([], []) | ns_last_id::ns_rev_prefix -> let uu___ = aux ns_rev_prefix ns_last_id in (match uu___ with | FStar_Pervasives_Native.None -> ([], ids1) | FStar_Pervasives_Native.Some (stripped_ids, rev_kept_ids) -> - (stripped_ids, (FStarC_Compiler_List.rev rev_kept_ids))) in - if - is_full_path && - ((FStarC_Compiler_List.length ids) > Prims.int_zero) + (stripped_ids, (FStarC_List.rev rev_kept_ids))) in + if is_full_path && ((FStarC_List.length ids) > Prims.int_zero) then let uu___ = let uu___1 = FStarC_Ident.lid_of_ids ids in @@ -1220,7 +1204,7 @@ let (fv_qual_of_se : FStarC_Syntax_Syntax.injective_type_params1 = uu___5;_} -> let qopt = - FStarC_Compiler_Util.find_map se.FStarC_Syntax_Syntax.sigquals + FStarC_Util.find_map se.FStarC_Syntax_Syntax.sigquals (fun uu___6 -> match uu___6 with | FStarC_Syntax_Syntax.RecordConstructor (uu___7, fs) -> @@ -1241,25 +1225,22 @@ let (lb_fv : fun lbs -> fun lid -> let uu___ = - FStarC_Compiler_Util.find_map lbs + FStarC_Util.find_map lbs (fun lb -> - let fv = - FStarC_Compiler_Util.right lb.FStarC_Syntax_Syntax.lbname in + let fv = FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let uu___1 = FStarC_Syntax_Syntax.fv_eq_lid fv lid in if uu___1 then FStar_Pervasives_Native.Some fv else FStar_Pervasives_Native.None) in - FStarC_Compiler_Util.must uu___ + FStarC_Util.must uu___ let (ns_of_lid_equals : FStarC_Ident.lident -> FStarC_Ident.lident -> Prims.bool) = fun lid -> fun ns -> (let uu___ = - let uu___1 = FStarC_Ident.ns_of_lid lid in - FStarC_Compiler_List.length uu___1 in + let uu___1 = FStarC_Ident.ns_of_lid lid in FStarC_List.length uu___1 in let uu___1 = - let uu___2 = FStarC_Ident.ids_of_lid ns in - FStarC_Compiler_List.length uu___2 in + let uu___2 = FStarC_Ident.ids_of_lid ns in FStarC_List.length uu___2 in uu___ = uu___1) && (let uu___ = let uu___1 = FStarC_Ident.ns_of_lid lid in @@ -1321,7 +1302,7 @@ let (try_lookup_name : let quals = se.FStarC_Syntax_Syntax.sigquals in let uu___4 = any_val || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___5 -> match uu___5 with | FStarC_Syntax_Syntax.Assumption -> true @@ -1332,7 +1313,7 @@ let (try_lookup_name : let uu___5 = FStarC_Ident.range_of_lid source_lid in FStarC_Ident.set_lid_range lid1 uu___5 in let uu___5 = - FStarC_Compiler_Util.find_map quals + FStarC_Util.find_map quals (fun uu___6 -> match uu___6 with | FStarC_Syntax_Syntax.Reflectable refl_monad @@ -1394,7 +1375,7 @@ let (try_lookup_name : let k_rec_binding uu___ = match uu___ with | (id, l, used_marker1) -> - (FStarC_Compiler_Effect.op_Colon_Equals used_marker1 true; + (FStarC_Effect.op_Colon_Equals used_marker1 true; (let uu___2 = let uu___3 = let uu___4 = @@ -1552,7 +1533,7 @@ let (try_lookup_root_effect_name : let rec aux new_name = let uu___12 = let uu___13 = FStarC_Ident.string_of_lid new_name in - FStarC_Compiler_Util.smap_try_find (sigmap env1) uu___13 in + FStarC_Util.smap_try_find (sigmap env1) uu___13 in match uu___12 with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (s, uu___13) -> @@ -1613,7 +1594,7 @@ let (try_lookup_module : fun env1 -> fun path -> let uu___ = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | (mlid, modul) -> @@ -1672,7 +1653,7 @@ let (try_lookup_definition : FStarC_Syntax_Syntax.sigopens_and_abbrevs = uu___6; FStarC_Syntax_Syntax.sigopts = uu___7;_}, uu___8) -> - FStarC_Compiler_Util.find_map (FStar_Pervasives_Native.snd lbs) + FStarC_Util.find_map (FStar_Pervasives_Native.snd lbs) (fun lb -> match lb.FStarC_Syntax_Syntax.lbname with | FStar_Pervasives.Inr fv when @@ -1686,9 +1667,9 @@ let (try_lookup_definition : (fun uu___ -> FStar_Pervasives_Native.None) k_global_def let (empty_include_smap : (FStarC_Ident.lident * FStarC_Syntax_Syntax.restriction) Prims.list - FStarC_Compiler_Effect.ref FStarC_Compiler_Util.smap) + FStarC_Effect.ref FStarC_Util.smap) = new_sigmap () -let (empty_exported_id_smap : exported_id_set FStarC_Compiler_Util.smap) = +let (empty_exported_id_smap : exported_id_set FStarC_Util.smap) = new_sigmap () let (try_lookup_lid' : Prims.bool -> @@ -1760,7 +1741,7 @@ let (is_abbrev : = fun env1 -> fun lid -> - FStarC_Compiler_List.tryPick + FStarC_List.tryPick (fun uu___ -> match uu___ with | Module_abbrev (id, ns) when FStarC_Ident.lid_equals lid ns -> @@ -1779,14 +1760,13 @@ let (try_shorten_abbrev : | [] -> FStar_Pervasives_Native.None | hd::tl -> let uu___ = - let uu___1 = - FStarC_Ident.lid_of_ids (FStarC_Compiler_List.rev ns1) in + let uu___1 = FStarC_Ident.lid_of_ids (FStarC_List.rev ns1) in is_abbrev env1 uu___1 in (match uu___ with | FStar_Pervasives_Native.Some short -> FStar_Pervasives_Native.Some (short, rest) | uu___1 -> aux tl (hd :: rest)) in - aux (FStarC_Compiler_List.rev ns) [] + aux (FStarC_List.rev ns) [] let (shorten_lid' : env -> FStarC_Ident.lident -> FStarC_Ident.lident) = fun env1 -> fun lid0 -> @@ -1803,8 +1783,7 @@ let (shorten_lid' : env -> FStarC_Ident.lident -> FStarC_Ident.lident) = match l with | [] -> [[]] | uu___1::tl -> let uu___2 = tails tl in l :: uu___2 in - let suffs = - let uu___1 = tails ns in FStarC_Compiler_List.rev uu___1 in + let suffs = let uu___1 = tails ns in FStarC_List.rev uu___1 in let try1 lid' = let uu___1 = resolve_to_fully_qualified_name env1 lid' in match uu___1 with @@ -1815,8 +1794,8 @@ let (shorten_lid' : env -> FStarC_Ident.lident -> FStarC_Ident.lident) = match nss with | ns1::rest -> let lid' = - FStarC_Ident.lid_of_ns_and_id - (FStarC_Compiler_List.op_At pref ns1) id0 in + FStarC_Ident.lid_of_ns_and_id (FStarC_List.op_At pref ns1) + id0 in let uu___1 = try1 lid' in if uu___1 then lid' else go rest | [] -> lid0 in let r = go suffs in r @@ -1883,7 +1862,7 @@ let (try_lookup_datacon : FStarC_Syntax_Syntax.sigopts = uu___5;_}, uu___6) -> let uu___7 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___8 -> match uu___8 with | FStarC_Syntax_Syntax.Assumption -> true @@ -1962,44 +1941,41 @@ let (record_cache_aux_with_filter : ((unit -> record_or_dc Prims.list) * (record_or_dc -> unit)))) * (unit -> unit))) = - let record_cache = FStarC_Compiler_Util.mk_ref [[]] in + let record_cache = FStarC_Util.mk_ref [[]] in let push uu___ = let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang record_cache in - FStarC_Compiler_List.hd uu___3 in - let uu___3 = FStarC_Compiler_Effect.op_Bang record_cache in uu___2 :: - uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals record_cache uu___1 in + let uu___3 = FStarC_Effect.op_Bang record_cache in + FStarC_List.hd uu___3 in + let uu___3 = FStarC_Effect.op_Bang record_cache in uu___2 :: uu___3 in + FStarC_Effect.op_Colon_Equals record_cache uu___1 in let pop uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang record_cache in - FStarC_Compiler_List.tl uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals record_cache uu___1 in + let uu___2 = FStarC_Effect.op_Bang record_cache in + FStarC_List.tl uu___2 in + FStarC_Effect.op_Colon_Equals record_cache uu___1 in let snapshot uu___ = FStarC_Common.snapshot push record_cache () in let rollback depth = FStarC_Common.rollback pop record_cache depth in let peek uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang record_cache in - FStarC_Compiler_List.hd uu___1 in + let uu___1 = FStarC_Effect.op_Bang record_cache in FStarC_List.hd uu___1 in let insert r = let uu___ = let uu___1 = let uu___2 = peek () in r :: uu___2 in let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang record_cache in - FStarC_Compiler_List.tl uu___3 in + let uu___3 = FStarC_Effect.op_Bang record_cache in + FStarC_List.tl uu___3 in uu___1 :: uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals record_cache uu___ in + FStarC_Effect.op_Colon_Equals record_cache uu___ in let filter uu___ = let rc = peek () in let filtered = - FStarC_Compiler_List.filter (fun r -> Prims.op_Negation r.is_private) - rc in + FStarC_List.filter (fun r -> Prims.op_Negation r.is_private) rc in let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang record_cache in - FStarC_Compiler_List.tl uu___3 in + let uu___3 = FStarC_Effect.op_Bang record_cache in + FStarC_List.tl uu___3 in filtered :: uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals record_cache uu___1 in + FStarC_Effect.op_Colon_Equals record_cache uu___1 in let aux = ((push, pop), ((snapshot, rollback), (peek, insert))) in (aux, filter) let (record_cache_aux : @@ -2032,7 +2008,7 @@ let (insert_record_cache : record_or_dc -> unit) = (FStar_Pervasives_Native.snd record_cache_aux)) let (extract_record : env -> - scope_mod Prims.list FStarC_Compiler_Effect.ref -> + scope_mod Prims.list FStarC_Effect.ref -> FStarC_Syntax_Syntax.sigelt -> unit) = fun e -> @@ -2044,14 +2020,14 @@ let (extract_record : FStarC_Syntax_Syntax.lids = uu___;_} -> let is_record = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.RecordType uu___2 -> true | FStarC_Syntax_Syntax.RecordConstructor uu___2 -> true | uu___2 -> false) in let find_dc dc = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | { @@ -2073,7 +2049,7 @@ let (extract_record : FStarC_Syntax_Syntax.sigopts = uu___13;_} -> FStarC_Ident.lid_equals dc lid | uu___2 -> false) sigs in - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___1 -> match uu___1 with | { @@ -2094,8 +2070,7 @@ let (extract_record : FStarC_Syntax_Syntax.sigopens_and_abbrevs = uu___9; FStarC_Syntax_Syntax.sigopts = uu___10;_} -> let uu___11 = - let uu___12 = find_dc dc in - FStarC_Compiler_Util.must uu___12 in + let uu___12 = find_dc dc in FStarC_Util.must uu___12 in (match uu___11 with | { FStarC_Syntax_Syntax.sigel = @@ -2118,12 +2093,12 @@ let (extract_record : (match uu___22 with | (all_formals, uu___23) -> let uu___24 = - FStarC_Compiler_Util.first_N n all_formals in + FStarC_Util.first_N n all_formals in (match uu___24 with | (_params, formals) -> let is_rec = is_record typename_quals in let formals' = - FStarC_Compiler_List.collect + FStarC_List.collect (fun f -> let uu___25 = (FStarC_Syntax_Syntax.is_null_bv @@ -2135,7 +2110,7 @@ let (extract_record : if uu___25 then [] else [f]) formals in let fields' = - FStarC_Compiler_List.map + FStarC_List.map (fun f -> (((f.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.ppname), ((f.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort))) @@ -2150,18 +2125,17 @@ let (extract_record : parms; fields; is_private = - (FStarC_Compiler_List.contains + (FStarC_List.contains FStarC_Syntax_Syntax.Private typename_quals); is_record = is_rec } in ((let uu___26 = let uu___27 = - FStarC_Compiler_Effect.op_Bang - new_globs in + FStarC_Effect.op_Bang new_globs in (Record_or_dc record) :: uu___27 in - FStarC_Compiler_Effect.op_Colon_Equals - new_globs uu___26); + FStarC_Effect.op_Colon_Equals new_globs + uu___26); (match () with | () -> ((let add_field uu___27 = @@ -2190,18 +2164,18 @@ let (extract_record : FStarC_Ident.string_of_id id in let uu___33 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang my_exported_ids in Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) uu___32 (Obj.magic uu___33)) in - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals my_exported_ids uu___31); (match () with @@ -2219,26 +2193,26 @@ let (extract_record : uu___31 in let uu___32 = let uu___33 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang my_exported_ids in Obj.magic (FStarC_Class_Setlike.add () ( Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) projname ( Obj.magic uu___33)) in - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals my_exported_ids uu___32)) | FStar_Pervasives_Native.None -> ()) in - FStarC_Compiler_List.iter - add_field fields'); + FStarC_List.iter add_field + fields'); (match () with | () -> insert_record_cache record)))))) @@ -2258,7 +2232,7 @@ let (try_lookup_record_or_dc_by_field_name : match uu___ with | (ns, id) -> let uu___1 = peek_record_cache () in - FStarC_Compiler_Util.find_map uu___1 + FStarC_Util.find_map uu___1 (fun record -> let uu___2 = find_in_record ns id record (fun r -> Cont_ok r) in @@ -2292,7 +2266,7 @@ let (try_lookup_record_type : match uu___ with | (ns, id) -> let uu___1 = peek_record_cache () in - FStarC_Compiler_Util.find_map uu___1 + FStarC_Util.find_map uu___1 (fun record -> let uu___2 = let uu___3 = FStarC_Ident.ident_of_lid record.typename in @@ -2338,24 +2312,23 @@ let (try_lookup_dc_by_field_name : let uu___3 = let uu___4 = let uu___5 = FStarC_Ident.ns_of_lid r.typename in - FStarC_Compiler_List.op_At uu___5 [r.constrname] in + FStarC_List.op_At uu___5 [r.constrname] in FStarC_Ident.lid_of_ids uu___4 in let uu___4 = FStarC_Ident.range_of_lid fieldname in FStarC_Ident.set_lid_range uu___3 uu___4 in (uu___2, (r.is_record)) in FStar_Pervasives_Native.Some uu___1 | uu___1 -> FStar_Pervasives_Native.None -let (string_set_ref_new : unit -> string_set FStarC_Compiler_Effect.ref) = +let (string_set_ref_new : unit -> string_set FStarC_Effect.ref) = fun uu___ -> let uu___1 = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_string)) ()) in - FStarC_Compiler_Util.mk_ref uu___1 + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) ()) in + FStarC_Util.mk_ref uu___1 let (exported_id_set_new : - unit -> exported_id_kind -> string_set FStarC_Compiler_Effect.ref) = + unit -> exported_id_kind -> string_set FStarC_Effect.ref) = fun uu___ -> let term_type_set = string_set_ref_new () in let field_set = string_set_ref_new () in @@ -2372,8 +2345,7 @@ let (unique : let filter_scope_mods uu___ = match uu___ with | Rec_binding uu___1 -> true | uu___1 -> false in let this_env = - let uu___ = - FStarC_Compiler_List.filter filter_scope_mods env1.scope_mods in + let uu___ = FStarC_List.filter filter_scope_mods env1.scope_mods in { curmodule = (env1.curmodule); curmonad = (env1.curmonad); @@ -2435,24 +2407,22 @@ let (push_bv' : FStarC_Syntax_Syntax.hash_code = (FStarC_Syntax_Syntax.tun.FStarC_Syntax_Syntax.hash_code) } in - let used_marker1 = FStarC_Compiler_Util.mk_ref false in + let used_marker1 = FStarC_Util.mk_ref false in let scope_mods = match env1.scope_mods with | (Local_bindings lbs)::rest -> let uu___ = let uu___1 = let uu___2 = FStarC_Ident.string_of_id x in - FStarC_Compiler_Util.psmap_add lbs uu___2 - (x, bv, used_marker1) in + FStarC_Util.psmap_add lbs uu___2 (x, bv, used_marker1) in Local_bindings uu___1 in uu___ :: rest | uu___ -> let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Util.psmap_empty () in + let uu___3 = FStarC_Util.psmap_empty () in let uu___4 = FStarC_Ident.string_of_id x in - FStarC_Compiler_Util.psmap_add uu___3 uu___4 - (x, bv, used_marker1) in + FStarC_Util.psmap_add uu___3 uu___4 (x, bv, used_marker1) in Local_bindings uu___2 in uu___1 :: (env1.scope_mods) in ({ @@ -2480,8 +2450,7 @@ let (push_bv : env -> FStarC_Ident.ident -> (env * FStarC_Syntax_Syntax.bv)) let uu___ = push_bv' env1 x in match uu___ with | (env2, bv, uu___1) -> (env2, bv) let (push_top_level_rec_binding : - env -> FStarC_Ident.ident -> (env * Prims.bool FStarC_Compiler_Effect.ref)) - = + env -> FStarC_Ident.ident -> (env * Prims.bool FStarC_Effect.ref)) = fun env0 -> fun x -> let l = qualify env0 x in @@ -2489,7 +2458,7 @@ let (push_top_level_rec_binding : (unique false true env0 l) || (FStarC_Options.interactive ()) in if uu___ then - let used_marker1 = FStarC_Compiler_Util.mk_ref false in + let used_marker1 = FStarC_Util.mk_ref false in ((push_scope_mod env0 (Rec_binding (x, l, used_marker1))), used_marker1) else @@ -2508,30 +2477,29 @@ let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) let err l = let sopt = let uu___ = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_try_find (sigmap env1) uu___ in + FStarC_Util.smap_try_find (sigmap env1) uu___ in let r = match sopt with | FStar_Pervasives_Native.Some (se, uu___) -> let uu___1 = - FStarC_Compiler_Util.find_opt (FStarC_Ident.lid_equals l) - (FStarC_Syntax_Util.lids_of_sigelt se) in + let uu___2 = FStarC_Syntax_Util.lids_of_sigelt se in + FStarC_Util.find_opt (FStarC_Ident.lid_equals l) uu___2 in (match uu___1 with | FStar_Pervasives_Native.Some l1 -> let uu___2 = FStarC_Ident.range_of_lid l1 in - FStarC_Compiler_Range_Ops.string_of_range uu___2 + FStarC_Range_Ops.string_of_range uu___2 | FStar_Pervasives_Native.None -> "") | FStar_Pervasives_Native.None -> "" in let uu___ = let uu___1 = let uu___2 = let uu___3 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 "Duplicate top-level names [%s]" - uu___3 in + FStarC_Util.format1 "Duplicate top-level names [%s]" uu___3 in FStarC_Errors_Msg.text uu___2 in let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_Util.format1 "Previously declared at %s" r in + FStarC_Util.format1 "Previously declared at %s" r in FStarC_Errors_Msg.text uu___4 in [uu___3] in uu___1 :: uu___2 in @@ -2539,7 +2507,7 @@ let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) FStarC_Errors_Codes.Fatal_DuplicateTopLevelNames () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___) in - let globals = FStarC_Compiler_Util.mk_ref env1.scope_mods in + let globals = FStarC_Util.mk_ref env1.scope_mods in let env2 = let uu___ = match s.FStarC_Syntax_Syntax.sigel with @@ -2550,7 +2518,7 @@ let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) | (any_val, exclude_interface) -> let lids = FStarC_Syntax_Util.lids_of_sigelt s in let uu___1 = - FStarC_Compiler_Util.find_map lids + FStarC_Util.find_map lids (fun l -> let uu___2 = let uu___3 = unique any_val exclude_interface env1 l in @@ -2581,7 +2549,7 @@ let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) dep_graph = (env1.dep_graph) })) in let env3 = - let uu___ = FStarC_Compiler_Effect.op_Bang globals in + let uu___ = FStarC_Effect.op_Bang globals in { curmodule = (env2.curmodule); curmonad = (env2.curmonad); @@ -2607,11 +2575,18 @@ let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) FStarC_Syntax_Syntax.lids = uu___1;_} -> let uu___2 = - FStarC_Compiler_List.map - (fun se -> ((FStarC_Syntax_Util.lids_of_sigelt se), se)) - ses in + FStarC_List.map + (fun se -> + let uu___3 = FStarC_Syntax_Util.lids_of_sigelt se in + (uu___3, se)) ses in (env3, uu___2) - | uu___1 -> (env3, [((FStarC_Syntax_Util.lids_of_sigelt s), s)]) in + | uu___1 -> + let uu___2 = + let uu___3 = + let uu___4 = FStarC_Syntax_Util.lids_of_sigelt s in + (uu___4, s) in + [uu___3] in + (env3, uu___2) in match uu___ with | (env4, lss) -> let push_top_level_def id stack = @@ -2620,30 +2595,28 @@ let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) let uu___1 = let uu___2 = let uu___3 = FStarC_Ident.string_of_id id in - FStarC_Compiler_Util.psmap_add ids uu___3 true in + FStarC_Util.psmap_add ids uu___3 true in Top_level_defs uu___2 in uu___1 :: rest | uu___1 -> let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Util.psmap_empty () in + let uu___4 = FStarC_Util.psmap_empty () in let uu___5 = FStarC_Ident.string_of_id id in - FStarC_Compiler_Util.psmap_add uu___4 uu___5 true in + FStarC_Util.psmap_add uu___4 uu___5 true in Top_level_defs uu___3 in uu___2 :: stack in - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun uu___2 -> match uu___2 with | (lids, se) -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun lid -> (let uu___4 = let uu___5 = FStarC_Ident.ident_of_lid lid in - let uu___6 = - FStarC_Compiler_Effect.op_Bang globals in + let uu___6 = FStarC_Effect.op_Bang globals in push_top_level_def uu___5 uu___6 in - FStarC_Compiler_Effect.op_Colon_Equals globals - uu___4); + FStarC_Effect.op_Colon_Equals globals uu___4); (match () with | () -> let modul = @@ -2662,15 +2635,15 @@ let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) FStarC_Ident.ident_of_lid lid in FStarC_Ident.string_of_id uu___8 in let uu___8 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang my_exported_ids in Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) uu___7 (Obj.magic uu___8)) in - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals my_exported_ids uu___6 | FStar_Pervasives_Native.None -> ()); (match () with @@ -2681,15 +2654,15 @@ let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) env4.admitted_iface) in let uu___5 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_add - (sigmap env4) uu___5 + FStarC_Util.smap_add (sigmap env4) + uu___5 (se, (env4.iface && (Prims.op_Negation env4.admitted_iface))))))) lids) lss; (let env5 = - let uu___2 = FStarC_Compiler_Effect.op_Bang globals in + let uu___2 = FStarC_Effect.op_Bang globals in { curmodule = (env4.curmodule); curmonad = (env4.curmonad); @@ -2749,7 +2722,7 @@ let (find_binders_for_datacons : FStarC_Ident.lident -> FStarC_Ident.ident Prims.list FStar_Pervasives_Native.option) = - let debug = FStarC_Compiler_Debug.get_toggle "open_include_restrictions" in + let debug = FStarC_Debug.get_toggle "open_include_restrictions" in fun env1 -> fun lid -> let ns = FStarC_Ident.ns_of_lid lid in @@ -2777,9 +2750,9 @@ let (find_binders_for_datacons : let uu___16 = let uu___17 = FStarC_Syntax_Util.arrow_formals_comp_ln t in FStar_Pervasives_Native.fst uu___17 in - FStarC_Compiler_List.splitAt num_ty_params uu___16 in + FStarC_List.splitAt num_ty_params uu___16 in FStar_Pervasives_Native.snd uu___15 in - FStarC_Compiler_List.map + FStarC_List.map (fun x -> (x.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.ppname) uu___14 in @@ -2789,7 +2762,7 @@ let (find_binders_for_datacons : resolve_in_open_namespaces' env1 lid (fun uu___ -> FStar_Pervasives_Native.None) (fun uu___ -> FStar_Pervasives_Native.None) k_global_def in - (let uu___1 = FStarC_Compiler_Effect.op_Bang debug in + (let uu___1 = FStarC_Effect.op_Bang debug in if uu___1 then let uu___2 = @@ -2805,7 +2778,7 @@ let (find_binders_for_datacons : Prims.strcat ") = " uu___6 in Prims.strcat uu___4 uu___5 in Prims.strcat "find_binders_for_datacons(_, " uu___3 in - FStarC_Compiler_Util.print_endline uu___2 + FStarC_Util.print_endline uu___2 else ()); result let elab_restriction : @@ -2838,25 +2811,25 @@ let elab_restriction : | FStar_Pervasives_Native.None -> let uu___1 = try_lookup_record_or_dc_by_field_name env1 lid in - FStarC_Compiler_Util.is_some uu___1 in + FStarC_Util.is_some uu___1 in let l1 = let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (id, renamed) -> let with_id_range = let uu___3 = FStarC_Ident.range_of_id - (FStarC_Compiler_Util.dflt id renamed) in + (FStarC_Util.dflt id renamed) in FStarC_Ident.set_id_range uu___3 in let uu___3 = let uu___4 = mk_lid id in find_data_constructors_for_typ env1 uu___4 in (match uu___3 with | FStar_Pervasives_Native.Some idents -> - FStarC_Compiler_List.map + FStarC_List.map (fun id1 -> let uu___4 = let uu___5 = @@ -2865,8 +2838,8 @@ let elab_restriction : (uu___4, FStar_Pervasives_Native.None)) idents | FStar_Pervasives_Native.None -> [])) l in - FStarC_Compiler_List.flatten uu___1 in - FStarC_Compiler_List.append l uu___ in + FStarC_List.flatten uu___1 in + FStarC_List.append l uu___ in let l2 = let constructor_lid_to_desugared_record_lids = let uu___ = @@ -2913,26 +2886,28 @@ let elab_restriction : let sigelt1 = Obj.magic sigelt1 in + let uu___6 = + FStarC_Syntax_Util.lids_of_sigelt + sigelt1 in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Class_Monad.monad_list () () (Obj.magic - (FStarC_Syntax_Util.lids_of_sigelt - sigelt1)) - (fun uu___6 + uu___6) + (fun uu___7 -> (fun lid -> let lid = Obj.magic lid in - let uu___6 + let uu___7 = FStarC_Syntax_Util.get_attribute FStarC_Parser_Const.desugar_of_variant_record_lid sigelt1.FStarC_Syntax_Syntax.sigattrs in - match uu___6 + match uu___7 with | FStar_Pervasives_Native.Some @@ -2942,33 +2917,33 @@ let elab_restriction : FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_string (s, - uu___7)); + uu___8)); FStarC_Syntax_Syntax.pos - = uu___8; - FStarC_Syntax_Syntax.vars = uu___9; + FStarC_Syntax_Syntax.vars + = uu___10; FStarC_Syntax_Syntax.hash_code - = uu___10;_}, + = uu___11;_}, FStar_Pervasives_Native.None)::[]) -> - let uu___11 - = let uu___12 = + let uu___13 + = FStarC_Ident.lid_of_str s in - (uu___12, + (uu___13, lid) in Obj.magic - [uu___11] + [uu___12] | - uu___7 -> + uu___8 -> Obj.magic []) - uu___6))) + uu___7))) uu___6))) uu___6))) uu___2)) in - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | (cons, lid) -> @@ -2987,7 +2962,7 @@ let elab_restriction : (FStarC_Class_Ord.ord_list FStarC_Syntax_Syntax.ord_ident)) uu___3 uu___4)) uu___1 in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (cons, lid) -> @@ -2996,12 +2971,12 @@ let elab_restriction : (uu___2, uu___3)) uu___ in let uu___ = let uu___1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | (cons, uu___3) -> let uu___4 = - FStarC_Compiler_List.find + FStarC_List.find (fun uu___5 -> match uu___5 with | (lid, uu___6) -> @@ -3010,28 +2985,28 @@ let elab_restriction : lid cons) l1 in FStar_Pervasives_Native.uu___is_Some uu___4) constructor_lid_to_desugared_record_lids in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (uu___3, lid) -> (lid, FStar_Pervasives_Native.None)) uu___1 in - FStarC_Compiler_List.append l1 uu___ in + FStarC_List.append l1 uu___ in let l3 = let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (id, renamed) -> let with_renamed_range = let uu___3 = FStarC_Ident.range_of_id - (FStarC_Compiler_Util.dflt id renamed) in + (FStarC_Util.dflt id renamed) in FStarC_Ident.set_id_range uu___3 in let with_id_range = let uu___3 = FStarC_Ident.range_of_id - (FStarC_Compiler_Util.dflt id renamed) in + (FStarC_Util.dflt id renamed) in FStarC_Ident.set_id_range uu___3 in let lid = mk_lid id in let uu___3 = @@ -3042,7 +3017,7 @@ let elab_restriction : match uu___6 with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some l4 -> l4 in - FStarC_Compiler_List.map + FStarC_List.map (fun binder -> let uu___6 = let uu___7 = @@ -3050,7 +3025,7 @@ let elab_restriction : lid binder in FStarC_Ident.ident_of_lid uu___7 in let uu___7 = - FStarC_Compiler_Util.map_opt renamed + FStarC_Util.map_opt renamed (fun renamed1 -> let uu___8 = let uu___9 = @@ -3071,8 +3046,7 @@ let elab_restriction : FStarC_Syntax_Util.mk_discriminator uu___11 in let uu___11 = - FStarC_Compiler_Util.map_opt - renamed + FStarC_Util.map_opt renamed (fun renamed1 -> let uu___12 = FStarC_Ident.lid_of_ids @@ -3081,17 +3055,17 @@ let elab_restriction : uu___12) in (uu___10, uu___11) in [uu___9] in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___9 -> match uu___9 with | (x, y) -> let uu___10 = FStarC_Ident.ident_of_lid x in let uu___11 = - FStarC_Compiler_Util.map_opt - y FStarC_Ident.ident_of_lid in + FStarC_Util.map_opt y + FStarC_Ident.ident_of_lid in (uu___10, uu___11)) uu___8 in - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___8 -> match uu___8 with | (x, uu___9) -> name_exists x) @@ -3106,7 +3080,7 @@ let elab_restriction : is_private = uu___11; is_record = uu___12;_} -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> match uu___13 with | (id1, uu___14) -> @@ -3114,28 +3088,28 @@ let elab_restriction : FStar_Pervasives_Native.None)) fields | FStar_Pervasives_Native.None -> [] in - FStarC_Compiler_List.op_At uu___6 uu___7 in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.map + FStarC_List.op_At uu___6 uu___7 in + FStarC_List.op_At uu___4 uu___5 in + FStarC_List.map (fun uu___4 -> match uu___4 with | (id1, renamed1) -> let uu___5 = with_id_range id1 in let uu___6 = - FStarC_Compiler_Util.map_opt renamed1 + FStarC_Util.map_opt renamed1 with_renamed_range in (uu___5, uu___6)) uu___3) l2 in - FStarC_Compiler_List.flatten uu___1 in - FStarC_Compiler_List.append l2 uu___ in + FStarC_List.flatten uu___1 in + FStarC_List.append l2 uu___ in ((let final_idents = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___ -> match uu___ with | (id, renamed) -> - ((FStarC_Compiler_Util.dflt id renamed), i)) l3 in + ((FStarC_Util.dflt id renamed), i)) l3 in let uu___ = - FStarC_Compiler_Util.find_dup + FStarC_Util.find_dup (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -3146,7 +3120,7 @@ let elab_restriction : match uu___ with | FStar_Pervasives_Native.Some (id, i) -> let others = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___1 -> match uu___1 with | (id', i') -> @@ -3159,7 +3133,7 @@ let elab_restriction : FStarC_Class_Ord.ord_int) i i' in Prims.op_Negation uu___2)) final_idents in ((let uu___2 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun nth -> fun uu___3 -> match uu___3 with @@ -3212,19 +3186,18 @@ let elab_restriction : let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_int - ((FStarC_Compiler_List.length others) + - Prims.int_one) in + ((FStarC_List.length others) + Prims.int_one) in Prims.strcat uu___5 " times" in Prims.strcat "The name %s was imported " uu___4 in let uu___4 = FStarC_Ident.string_of_id id in - FStarC_Compiler_Util.format1 uu___3 uu___4 in + FStarC_Util.format1 uu___3 uu___4 in FStarC_Errors.raise_error FStarC_Ident.hasrange_ident id FStarC_Errors_Codes.Fatal_DuplicateTopLevelNames () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2))) | FStar_Pervasives_Native.None -> ()); - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___1 -> match uu___1 with | (id, _renamed) -> @@ -3237,7 +3210,7 @@ let elab_restriction : let uu___4 = let uu___5 = mk_lid id in FStarC_Ident.string_of_lid uu___5 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Definition %s cannot be found" uu___4 in FStarC_Errors.raise_error FStarC_Ident.hasrange_ident id @@ -3257,14 +3230,13 @@ let (push_namespace' : match uu___1 with | FStar_Pervasives_Native.None -> let module_names = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - env1.modules in + FStarC_List.map FStar_Pervasives_Native.fst env1.modules in let module_names1 = match env1.curmodule with | FStar_Pervasives_Native.None -> module_names | FStar_Pervasives_Native.Some l -> l :: module_names in let uu___2 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun m -> let uu___3 = let uu___4 = FStarC_Ident.string_of_lid m in @@ -3272,15 +3244,13 @@ let (push_namespace' : let uu___4 = let uu___5 = FStarC_Ident.string_of_lid ns in Prims.strcat uu___5 "." in - FStarC_Compiler_Util.starts_with uu___3 uu___4) - module_names1 in + FStarC_Util.starts_with uu___3 uu___4) module_names1 in if uu___2 then (ns, FStarC_Syntax_Syntax.Open_namespace) else (let uu___4 = let uu___5 = FStarC_Ident.string_of_lid ns in - FStarC_Compiler_Util.format1 - "Namespace %s cannot be found" uu___5 in + FStarC_Util.format1 "Namespace %s cannot be found" uu___5 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident ns FStarC_Errors_Codes.Fatal_NameSpaceNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -3309,15 +3279,14 @@ let (push_include' : let curmod = let uu___2 = current_module env2 in FStarC_Ident.string_of_lid uu___2 in - (let uu___3 = - FStarC_Compiler_Util.smap_try_find env2.includes curmod in + (let uu___3 = FStarC_Util.smap_try_find env2.includes curmod in match uu___3 with | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some incl -> let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang incl in + let uu___5 = FStarC_Effect.op_Bang incl in (ns1, restriction) :: uu___5 in - FStarC_Compiler_Effect.op_Colon_Equals incl uu___4); + FStarC_Effect.op_Colon_Equals incl uu___4); (match () with | () -> let uu___3 = @@ -3338,11 +3307,11 @@ let (push_include' : let ns_ex = let uu___6 = let uu___7 = ns_trans_exports k in - FStarC_Compiler_Effect.op_Bang uu___7 in + FStarC_Effect.op_Bang uu___7 in Obj.magic (FStarC_Class_Setlike.filter () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) (fun id -> let uu___7 = @@ -3350,44 +3319,41 @@ let (push_include' : FStarC_Ident.id_of_text id in FStarC_Syntax_Syntax.is_ident_allowed_by_restriction uu___8 restriction in - FStarC_Compiler_Util.is_some uu___7) + FStarC_Util.is_some uu___7) (Obj.magic uu___6)) in let ex = cur_exports k in (let uu___7 = - let uu___8 = - FStarC_Compiler_Effect.op_Bang ex in + let uu___8 = FStarC_Effect.op_Bang ex in Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) (Obj.magic uu___8) (Obj.magic ns_ex)) in - FStarC_Compiler_Effect.op_Colon_Equals ex - uu___7); + FStarC_Effect.op_Colon_Equals ex uu___7); (match () with | () -> let trans_ex = cur_trans_exports k in let uu___8 = let uu___9 = - FStarC_Compiler_Effect.op_Bang - trans_ex in + FStarC_Effect.op_Bang trans_ex in Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) (Obj.magic uu___9) (Obj.magic ns_ex)) in - FStarC_Compiler_Effect.op_Colon_Equals - trans_ex uu___8) in - FStarC_Compiler_List.iter update_exports + FStarC_Effect.op_Colon_Equals trans_ex + uu___8) in + FStarC_List.iter update_exports all_exported_id_kinds | uu___6 -> ()); (match () with | () -> env2)) | FStar_Pervasives_Native.None -> let uu___4 = let uu___5 = FStarC_Ident.string_of_lid ns1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "include: Module %s was not prepared" uu___5 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident ns1 @@ -3399,8 +3365,7 @@ let (push_include' : | uu___1 -> let uu___2 = let uu___3 = FStarC_Ident.string_of_lid ns in - FStarC_Compiler_Util.format1 - "include: Module %s cannot be found" uu___3 in + FStarC_Util.format1 "include: Module %s cannot be found" uu___3 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident ns FStarC_Errors_Codes.Fatal_ModuleNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -3424,7 +3389,7 @@ let (push_module_abbrev : else (let uu___2 = let uu___3 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 "Module %s cannot be found" uu___3 in + FStarC_Util.format1 "Module %s cannot be found" uu___3 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident l FStarC_Errors_Codes.Fatal_ModuleNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -3434,7 +3399,7 @@ let (check_admits : fun env1 -> fun m -> let admitted_sig_lids = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun lids -> fun se -> match se.FStarC_Syntax_Syntax.sigel with @@ -3444,13 +3409,12 @@ let (check_admits : FStarC_Syntax_Syntax.t2 = t;_} when Prims.op_Negation - (FStarC_Compiler_List.contains - FStarC_Syntax_Syntax.Assumption + (FStarC_List.contains FStarC_Syntax_Syntax.Assumption se.FStarC_Syntax_Syntax.sigquals) -> let uu___ = let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_try_find (sigmap env1) uu___1 in + FStarC_Util.smap_try_find (sigmap env1) uu___1 in (match uu___ with | FStar_Pervasives_Native.Some ({ @@ -3522,7 +3486,7 @@ let (check_admits : (let quals = FStarC_Syntax_Syntax.Assumption :: (se.FStarC_Syntax_Syntax.sigquals) in (let uu___4 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_add (sigmap env1) uu___4 + FStarC_Util.smap_add (sigmap env1) uu___4 ({ FStarC_Syntax_Syntax.sigel = (se.FStarC_Syntax_Syntax.sigel); @@ -3546,7 +3510,7 @@ let (check_admits : let (finish : env -> FStarC_Syntax_Syntax.modul -> env) = fun env1 -> fun modul -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun se -> let quals = se.FStarC_Syntax_Syntax.sigquals in match se.FStarC_Syntax_Syntax.sigel with @@ -3554,11 +3518,9 @@ let (finish : env -> FStarC_Syntax_Syntax.modul -> env) = { FStarC_Syntax_Syntax.ses = ses; FStarC_Syntax_Syntax.lids = uu___1;_} -> - if - FStarC_Compiler_List.contains FStarC_Syntax_Syntax.Private - quals + if FStarC_List.contains FStarC_Syntax_Syntax.Private quals then - FStarC_Compiler_List.iter + FStarC_List.iter (fun se1 -> match se1.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -3572,8 +3534,7 @@ let (finish : env -> FStarC_Syntax_Syntax.modul -> env) = uu___7;_} -> let uu___8 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_remove (sigmap env1) - uu___8 + FStarC_Util.smap_remove (sigmap env1) uu___8 | FStarC_Syntax_Syntax.Sig_inductive_typ { FStarC_Syntax_Syntax.lid = lid; FStarC_Syntax_Syntax.us = univ_names; @@ -3586,11 +3547,10 @@ let (finish : env -> FStarC_Syntax_Syntax.modul -> env) = uu___5;_} -> ((let uu___7 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_remove (sigmap env1) - uu___7); + FStarC_Util.smap_remove (sigmap env1) uu___7); if Prims.op_Negation - (FStarC_Compiler_List.contains + (FStarC_List.contains FStarC_Syntax_Syntax.Private quals) then (let sigel = @@ -3632,8 +3592,8 @@ let (finish : env -> FStarC_Syntax_Syntax.modul -> env) = (se1.FStarC_Syntax_Syntax.sigopts) } in let uu___7 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_add (sigmap env1) - uu___7 (se2, false)) + FStarC_Util.smap_add (sigmap env1) uu___7 + (se2, false)) else ()) | uu___2 -> ()) ses else () @@ -3642,34 +3602,29 @@ let (finish : env -> FStarC_Syntax_Syntax.modul -> env) = FStarC_Syntax_Syntax.us2 = uu___1; FStarC_Syntax_Syntax.t2 = uu___2;_} -> - if - FStarC_Compiler_List.contains FStarC_Syntax_Syntax.Private - quals + if FStarC_List.contains FStarC_Syntax_Syntax.Private quals then let uu___3 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_remove (sigmap env1) uu___3 + FStarC_Util.smap_remove (sigmap env1) uu___3 else () | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = (uu___1, lbs); FStarC_Syntax_Syntax.lids1 = uu___2;_} -> - if - FStarC_Compiler_List.contains FStarC_Syntax_Syntax.Private - quals + if FStarC_List.contains FStarC_Syntax_Syntax.Private quals then - FStarC_Compiler_List.iter + FStarC_List.iter (fun lb -> let uu___3 = let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in uu___6.FStarC_Syntax_Syntax.fv_name in uu___5.FStarC_Syntax_Syntax.v in FStarC_Ident.string_of_lid uu___4 in - FStarC_Compiler_Util.smap_remove (sigmap env1) uu___3) - lbs + FStarC_Util.smap_remove (sigmap env1) uu___3) lbs else () | uu___1 -> ()) modul.FStarC_Syntax_Syntax.declarations; (let curmod = @@ -3684,21 +3639,18 @@ let (finish : env -> FStarC_Syntax_Syntax.modul -> env) = cur_trans_ex) -> let update_exports eikind = let cur_ex_set = - let uu___3 = cur_ex eikind in - FStarC_Compiler_Effect.op_Bang uu___3 in + let uu___3 = cur_ex eikind in FStarC_Effect.op_Bang uu___3 in let cur_trans_ex_set_ref = cur_trans_ex eikind in let uu___3 = - let uu___4 = - FStarC_Compiler_Effect.op_Bang cur_trans_ex_set_ref in + let uu___4 = FStarC_Effect.op_Bang cur_trans_ex_set_ref in Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Class_Ord.ord_string)) (Obj.magic cur_ex_set) (Obj.magic uu___4)) in - FStarC_Compiler_Effect.op_Colon_Equals cur_trans_ex_set_ref - uu___3 in - FStarC_Compiler_List.iter update_exports all_exported_id_kinds + FStarC_Effect.op_Colon_Equals cur_trans_ex_set_ref uu___3 in + FStarC_List.iter update_exports all_exported_id_kinds | uu___3 -> ()); (match () with | () -> @@ -3724,21 +3676,19 @@ let (finish : env -> FStarC_Syntax_Syntax.modul -> env) = ds_hooks = (env1.ds_hooks); dep_graph = (env1.dep_graph) })))) -let (stack : env Prims.list FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref [] +let (stack : env Prims.list FStarC_Effect.ref) = FStarC_Util.mk_ref [] let (push : env -> env) = fun env1 -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> push_record_cache (); (let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang stack in env1 :: - uu___4 in - FStarC_Compiler_Effect.op_Colon_Equals stack uu___3); - (let uu___3 = FStarC_Compiler_Util.smap_copy env1.exported_ids in - let uu___4 = FStarC_Compiler_Util.smap_copy env1.trans_exported_ids in - let uu___5 = FStarC_Compiler_Util.smap_copy env1.includes in - let uu___6 = FStarC_Compiler_Util.smap_copy env1.sigmap in + let uu___4 = FStarC_Effect.op_Bang stack in env1 :: uu___4 in + FStarC_Effect.op_Colon_Equals stack uu___3); + (let uu___3 = FStarC_Util.smap_copy env1.exported_ids in + let uu___4 = FStarC_Util.smap_copy env1.trans_exported_ids in + let uu___5 = FStarC_Util.smap_copy env1.includes in + let uu___6 = FStarC_Util.smap_copy env1.sigmap in { curmodule = (env1.curmodule); curmonad = (env1.curmonad); @@ -3759,13 +3709,13 @@ let (push : env -> env) = })) let (pop : unit -> env) = fun uu___ -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___1 -> - let uu___2 = FStarC_Compiler_Effect.op_Bang stack in + let uu___2 = FStarC_Effect.op_Bang stack in match uu___2 with | env1::tl -> (pop_record_cache (); - FStarC_Compiler_Effect.op_Colon_Equals stack tl; + FStarC_Effect.op_Colon_Equals stack tl; env1) | uu___3 -> failwith "Impossible: Too many pops") let (snapshot : env -> (Prims.int * env)) = @@ -3776,21 +3726,22 @@ let (export_interface : FStarC_Ident.lident -> env -> env) = fun m -> fun env1 -> let sigelt_in_m se = - match FStarC_Syntax_Util.lids_of_sigelt se with - | l::uu___ -> - let uu___1 = FStarC_Ident.nsstr l in - let uu___2 = FStarC_Ident.string_of_lid m in uu___1 = uu___2 - | uu___ -> false in + let uu___ = FStarC_Syntax_Util.lids_of_sigelt se in + match uu___ with + | l::uu___1 -> + let uu___2 = FStarC_Ident.nsstr l in + let uu___3 = FStarC_Ident.string_of_lid m in uu___2 = uu___3 + | uu___1 -> false in let sm = sigmap env1 in let env2 = pop () in - let keys = FStarC_Compiler_Util.smap_keys sm in + let keys = FStarC_Util.smap_keys sm in let sm' = sigmap env2 in - FStarC_Compiler_List.iter + FStarC_List.iter (fun k -> - let uu___1 = FStarC_Compiler_Util.smap_try_find sm' k in + let uu___1 = FStarC_Util.smap_try_find sm' k in match uu___1 with | FStar_Pervasives_Native.Some (se, true) when sigelt_in_m se -> - (FStarC_Compiler_Util.smap_remove sm' k; + (FStarC_Util.smap_remove sm' k; (let se1 = match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_declare_typ @@ -3816,7 +3767,7 @@ let (export_interface : FStarC_Ident.lident -> env -> env) = (se.FStarC_Syntax_Syntax.sigopts) } | uu___3 -> se in - FStarC_Compiler_Util.smap_add sm' k (se1, false))) + FStarC_Util.smap_add sm' k (se1, false))) | uu___2 -> ()) keys; env2 let (finish_module_or_interface : @@ -3845,21 +3796,20 @@ let (__proj__Mkexported_ids__item__exported_id_fields : let (as_exported_ids : exported_id_set -> exported_ids) = fun e -> let terms = - let uu___ = e Exported_id_term_type in - FStarC_Compiler_Effect.op_Bang uu___ in + let uu___ = e Exported_id_term_type in FStarC_Effect.op_Bang uu___ in let fields = - let uu___ = e Exported_id_field in FStarC_Compiler_Effect.op_Bang uu___ in + let uu___ = e Exported_id_field in FStarC_Effect.op_Bang uu___ in { exported_id_terms = terms; exported_id_fields = fields } let (as_exported_id_set : exported_ids FStar_Pervasives_Native.option -> - exported_id_kind -> string_set FStarC_Compiler_Effect.ref) + exported_id_kind -> string_set FStarC_Effect.ref) = fun e -> match e with | FStar_Pervasives_Native.None -> exported_id_set_new () | FStar_Pervasives_Native.Some e1 -> - let terms = FStarC_Compiler_Util.mk_ref e1.exported_id_terms in - let fields = FStarC_Compiler_Util.mk_ref e1.exported_id_fields in + let terms = FStarC_Util.mk_ref e1.exported_id_terms in + let fields = FStarC_Util.mk_ref e1.exported_id_fields in (fun uu___ -> match uu___ with | Exported_id_term_type -> terms @@ -3902,25 +3852,24 @@ let (default_mii : module_inclusion_info) = let as_includes : 'uuuuu . 'uuuuu Prims.list FStar_Pervasives_Native.option -> - 'uuuuu Prims.list FStarC_Compiler_Effect.ref + 'uuuuu Prims.list FStarC_Effect.ref = fun uu___ -> match uu___ with - | FStar_Pervasives_Native.None -> FStarC_Compiler_Util.mk_ref [] - | FStar_Pervasives_Native.Some l -> FStarC_Compiler_Util.mk_ref l + | FStar_Pervasives_Native.None -> FStarC_Util.mk_ref [] + | FStar_Pervasives_Native.Some l -> FStarC_Util.mk_ref l let (inclusion_info : env -> FStarC_Ident.lident -> module_inclusion_info) = fun env1 -> fun l -> let mname = FStarC_Ident.string_of_lid l in let as_ids_opt m = - let uu___ = FStarC_Compiler_Util.smap_try_find m mname in - FStarC_Compiler_Util.map_opt uu___ as_exported_ids in + let uu___ = FStarC_Util.smap_try_find m mname in + FStarC_Util.map_opt uu___ as_exported_ids in let uu___ = as_ids_opt env1.exported_ids in let uu___1 = as_ids_opt env1.trans_exported_ids in let uu___2 = - let uu___3 = FStarC_Compiler_Util.smap_try_find env1.includes mname in - FStarC_Compiler_Util.map_opt uu___3 - (fun r -> FStarC_Compiler_Effect.op_Bang r) in + let uu___3 = FStarC_Util.smap_try_find env1.includes mname in + FStarC_Util.map_opt uu___3 (fun r -> FStarC_Effect.op_Bang r) in { mii_exported_ids = uu___; mii_trans_exported_ids = uu___1; @@ -3940,7 +3889,7 @@ let (prepare_module_or_interface : let prep env2 = let filename = let uu___ = FStarC_Ident.string_of_lid mname in - FStarC_Compiler_Util.strcat uu___ ".fst" in + FStarC_Util.strcat uu___ ".fst" in let auto_open = FStarC_Parser_Dep.hard_coded_dependencies filename in let auto_open1 = @@ -3950,7 +3899,7 @@ let (prepare_module_or_interface : FStarC_Syntax_Syntax.Open_namespace | FStarC_Parser_Dep.Open_module -> FStarC_Syntax_Syntax.Open_module in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (lid, kind) -> @@ -3960,7 +3909,7 @@ let (prepare_module_or_interface : let uu___ = let uu___1 = let uu___2 = FStarC_Ident.ns_of_lid mname in - FStarC_Compiler_List.length uu___2 in + FStarC_List.length uu___2 in uu___1 > Prims.int_zero in if uu___ then @@ -3973,29 +3922,28 @@ let (prepare_module_or_interface : [uu___1] else [] in let auto_open2 = - FStarC_Compiler_List.op_At namespace_of_module - (FStarC_Compiler_List.rev auto_open1) in + FStarC_List.op_At namespace_of_module + (FStarC_List.rev auto_open1) in (let uu___1 = FStarC_Ident.string_of_lid mname in let uu___2 = as_exported_id_set mii.mii_exported_ids in - FStarC_Compiler_Util.smap_add env2.exported_ids uu___1 uu___2); + FStarC_Util.smap_add env2.exported_ids uu___1 uu___2); (match () with | () -> ((let uu___2 = FStarC_Ident.string_of_lid mname in let uu___3 = as_exported_id_set mii.mii_trans_exported_ids in - FStarC_Compiler_Util.smap_add env2.trans_exported_ids - uu___2 uu___3); + FStarC_Util.smap_add env2.trans_exported_ids uu___2 + uu___3); (match () with | () -> ((let uu___3 = FStarC_Ident.string_of_lid mname in let uu___4 = as_includes mii.mii_includes in - FStarC_Compiler_Util.smap_add env2.includes uu___3 - uu___4); + FStarC_Util.smap_add env2.includes uu___3 uu___4); (match () with | () -> let env' = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> Open_module_or_namespace x) auto_open2 in { @@ -4019,14 +3967,13 @@ let (prepare_module_or_interface : ds_hooks = (env2.ds_hooks); dep_graph = (env2.dep_graph) } in - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun op -> (env2.ds_hooks).ds_push_open_hook env' - op) - (FStarC_Compiler_List.rev auto_open2); + op) (FStarC_List.rev auto_open2); env')))))) in let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | (l, uu___2) -> FStarC_Ident.lid_equals l mname) @@ -4044,7 +3991,7 @@ let (prepare_module_or_interface : then let uu___4 = let uu___5 = FStarC_Ident.string_of_lid mname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Duplicate module or interface name: %s" uu___5 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident mname @@ -4106,7 +4053,7 @@ let fail_or : | FStar_Pervasives_Native.Some r -> r | FStar_Pervasives_Native.None -> let opened_modules = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (lid1, uu___2) -> FStarC_Ident.string_of_lid lid1) @@ -4114,14 +4061,13 @@ let fail_or : let msg = let uu___1 = let uu___2 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format1 "Identifier not found: [%s]" - uu___2 in + FStarC_Util.format1 "Identifier not found: [%s]" uu___2 in FStarC_Errors_Msg.mkmsg uu___1 in let msg1 = let uu___1 = let uu___2 = let uu___3 = FStarC_Ident.ns_of_lid lid in - FStarC_Compiler_List.length uu___3 in + FStarC_List.length uu___3 in uu___2 = Prims.int_zero in if uu___1 then msg @@ -4142,40 +4088,40 @@ let fail_or : | FStar_Pervasives_Native.None -> let opened_modules1 = FStarC_Errors_Msg.text - (FStarC_Compiler_String.concat ", " opened_modules) in + (FStarC_String.concat ", " opened_modules) in let uu___4 = let uu___5 = let uu___6 = let uu___7 = FStarC_Ident.string_of_lid modul in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Could not resolve module name %s" uu___7 in FStarC_Errors_Msg.text uu___6 in [uu___5] in - FStarC_Compiler_List.op_At msg uu___4 + FStarC_List.op_At msg uu___4 | FStar_Pervasives_Native.Some modul' when let uu___4 = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun m -> let uu___5 = FStarC_Ident.string_of_lid modul' in m = uu___5) opened_modules in Prims.op_Negation uu___4 -> let opened_modules1 = FStarC_Errors_Msg.text - (FStarC_Compiler_String.concat ", " opened_modules) in + (FStarC_String.concat ", " opened_modules) in let uu___4 = let uu___5 = let uu___6 = let uu___7 = let uu___8 = FStarC_Ident.string_of_lid modul in let uu___9 = FStarC_Ident.string_of_lid modul' in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Module %s resolved into %s, which does not belong to the list of modules in scope, namely:" uu___8 uu___9 in FStarC_Errors_Msg.text uu___7 in let uu___7 = subdoc opened_modules1 in FStarC_Pprint.op_Hat_Hat uu___6 uu___7 in [uu___5] in - FStarC_Compiler_List.op_At msg uu___4 + FStarC_List.op_At msg uu___4 | FStar_Pervasives_Native.Some modul' -> let uu___4 = let uu___5 = @@ -4185,12 +4131,12 @@ let fail_or : let uu___9 = let uu___10 = FStarC_Ident.ident_of_lid lid in FStarC_Ident.string_of_id uu___10 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Module %s resolved into %s, definition %s not found" uu___7 uu___8 uu___9 in FStarC_Errors_Msg.text uu___6 in [uu___5] in - FStarC_Compiler_List.op_At msg uu___4) in + FStarC_List.op_At msg uu___4) in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident lid FStarC_Errors_Codes.Fatal_IdentifierNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Embeddings.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Embeddings.ml similarity index 95% rename from stage0/fstar-lib/generated/FStarC_Syntax_Embeddings.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Embeddings.ml index 07f279cd99a..bf547b8b65d 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Embeddings.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Embeddings.ml @@ -19,11 +19,11 @@ let (map_shadow : FStarC_Syntax_Embeddings_Base.shadow_term -> (FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) -> FStarC_Syntax_Embeddings_Base.shadow_term) - = fun s -> fun f -> FStarC_Compiler_Util.map_opt s (FStarC_Thunk.map f) + = fun s -> fun f -> FStarC_Util.map_opt s (FStarC_Thunk.map f) let (force_shadow : FStarC_Syntax_Embeddings_Base.shadow_term -> FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option) - = fun s -> FStarC_Compiler_Util.map_opt s FStarC_Thunk.force + = fun s -> FStarC_Util.map_opt s FStarC_Thunk.force type 'a printer = 'a -> Prims.string let unknown_printer : 'uuuuu . FStarC_Syntax_Syntax.typ -> 'uuuuu -> Prims.string = @@ -31,7 +31,7 @@ let unknown_printer : fun uu___ -> let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term typ in - FStarC_Compiler_Util.format1 "unknown %s" uu___1 + FStarC_Util.format1 "unknown %s" uu___1 let (term_as_fv : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.fv) = fun t -> let uu___ = @@ -43,14 +43,13 @@ let (term_as_fv : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.fv) = let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 "Embeddings not defined for type %s" - uu___3 in + FStarC_Util.format1 "Embeddings not defined for type %s" uu___3 in failwith uu___2 let lazy_embed : 'a . 'a printer -> (unit -> FStarC_Syntax_Syntax.emb_typ) -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (unit -> FStarC_Syntax_Syntax.term) -> 'a -> (unit -> FStarC_Syntax_Syntax.term) -> @@ -63,8 +62,7 @@ let lazy_embed : fun x -> fun f -> (let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___1 then let uu___2 = @@ -76,13 +74,12 @@ let lazy_embed : FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ uu___4 in let uu___4 = pa x in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Embedding a %s\n\temb_typ=%s\n\tvalue is %s\n" uu___2 uu___3 uu___4 else ()); (let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.eager_embedding in + FStarC_Effect.op_Bang FStarC_Options.eager_embedding in if uu___1 then f () else @@ -118,14 +115,12 @@ let lazy_unembed : -> let uu___2 = (et1 <> et') || - (FStarC_Compiler_Effect.op_Bang - FStarC_Options.eager_embedding) in + (FStarC_Effect.op_Bang FStarC_Options.eager_embedding) in if uu___2 then let res = let uu___3 = FStarC_Thunk.force t in f uu___3 in ((let uu___4 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___4 then let uu___5 = @@ -139,7 +134,7 @@ let lazy_unembed : | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some x2 -> let uu___8 = pa x2 in Prims.strcat "Some " uu___8 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Unembed cancellation failed\n\t%s <> %s\nvalue is %s\n" uu___5 uu___6 uu___7 else ()); @@ -147,15 +142,14 @@ let lazy_unembed : else (let a1 = FStarC_Dyn.undyn b in (let uu___5 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___5 then let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ et1 in let uu___7 = pa a1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Unembed cancelled for %s\n\tvalue is %s\n" uu___6 uu___7 else ()); @@ -163,8 +157,7 @@ let lazy_unembed : | uu___ -> let aopt = f x1 in ((let uu___2 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___2 then let uu___3 = @@ -178,7 +171,7 @@ let lazy_unembed : | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some a1 -> let uu___6 = pa a1 in Prims.strcat "Some " uu___6 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Unembedding:\n\temb_typ=%s\n\tterm is %s\n\tvalue is %s\n" uu___3 uu___4 uu___5 else ()); @@ -189,21 +182,19 @@ let (mk_any_emb : = fun typ -> let em t _r _shadow _norm = - (let uu___1 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + (let uu___1 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___1 then let uu___2 = unknown_printer typ t in - FStarC_Compiler_Util.print1 "Embedding abstract: %s\n" uu___2 + FStarC_Util.print1 "Embedding abstract: %s\n" uu___2 else ()); t in let un t _n = - (let uu___1 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + (let uu___1 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___1 then let uu___2 = unknown_printer typ t in - FStarC_Compiler_Util.print1 "Unembedding abstract: %s\n" uu___2 + FStarC_Util.print1 "Unembedding abstract: %s\n" uu___2 else ()); FStar_Pervasives_Native.Some t in FStarC_Syntax_Embeddings_Base.mk_emb_full em un (fun uu___ -> typ) @@ -271,8 +262,7 @@ let (e_bool : Prims.bool FStarC_Syntax_Embeddings_Base.embedding) = FStar_Pervasives_Native.Some b | uu___1 -> FStar_Pervasives_Native.None in FStarC_Syntax_Embeddings_Base.mk_emb_full em un - (fun uu___ -> FStarC_Syntax_Syntax.t_bool) - FStarC_Compiler_Util.string_of_bool + (fun uu___ -> FStarC_Syntax_Syntax.t_bool) FStarC_Util.string_of_bool (fun uu___ -> let uu___1 = let uu___2 = FStarC_Ident.string_of_lid FStarC_Parser_Const.bool_lid in @@ -296,8 +286,7 @@ let (e_char : FStar_Char.char FStarC_Syntax_Embeddings_Base.embedding) = FStar_Pervasives_Native.Some c | uu___1 -> FStar_Pervasives_Native.None in FStarC_Syntax_Embeddings_Base.mk_emb_full em un - (fun uu___ -> FStarC_Syntax_Syntax.t_char) - FStarC_Compiler_Util.string_of_char + (fun uu___ -> FStarC_Syntax_Syntax.t_char) FStarC_Util.string_of_char (fun uu___ -> let uu___1 = let uu___2 = FStarC_Ident.string_of_lid FStarC_Parser_Const.char_lid in @@ -353,8 +342,7 @@ let (e_string : Prims.string FStarC_Syntax_Embeddings_Base.embedding) = (fun uu___ -> FStarC_Syntax_Syntax.t_string) (fun x -> Prims.strcat "\"" (Prims.strcat x "\"")) (fun uu___ -> emb_t_string) -let (e_real : - FStarC_Compiler_Real.real FStarC_Syntax_Embeddings_Base.embedding) = +let (e_real : FStarC_Real.real FStarC_Syntax_Embeddings_Base.embedding) = let ty = FStarC_Syntax_Syntax.t_real in let emb_t_real = let uu___ = @@ -364,7 +352,7 @@ let (e_real : let em r rng _shadow _norm = let uu___ = r in match uu___ with - | FStarC_Compiler_Real.Real s -> + | FStarC_Real.Real s -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_real s)) rng in let un t _norm = @@ -373,7 +361,7 @@ let (e_real : uu___1.FStarC_Syntax_Syntax.n in match uu___ with | FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_real s) -> - FStar_Pervasives_Native.Some (FStarC_Compiler_Real.Real s) + FStar_Pervasives_Native.Some (FStarC_Real.Real s) | uu___1 -> FStar_Pervasives_Native.None in FStarC_Syntax_Embeddings_Base.mk_emb_full em un (fun uu___ -> ty) (fun uu___ -> "") (fun uu___ -> emb_t_real) @@ -491,7 +479,7 @@ let e_option : -> let uu___4 = FStarC_Syntax_Embeddings_Base.try_unembed ea a1 norm in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a2 -> FStar_Pervasives_Native.Some (FStar_Pervasives_Native.Some a2)) @@ -531,7 +519,7 @@ let e_tuple2 : let uu___2 = let uu___3 = FStarC_Syntax_Embeddings_Base.printer_of eb in uu___3 y in - FStarC_Compiler_Util.format2 "(%s, %s)" uu___1 uu___2 in + FStarC_Util.format2 "(%s, %s)" uu___1 uu___2 in let em x rng shadow norm = lazy_embed printer1 emb_t_pair rng typ x (fun uu___ -> @@ -690,8 +678,7 @@ let e_tuple3 : let uu___3 = let uu___4 = FStarC_Syntax_Embeddings_Base.printer_of ec in uu___4 z in - FStarC_Compiler_Util.format3 "(%s, %s, %s)" uu___1 uu___2 - uu___3 in + FStarC_Util.format3 "(%s, %s, %s)" uu___1 uu___2 uu___3 in let em uu___ rng shadow norm = match uu___ with | (x1, x2, x3) -> @@ -907,8 +894,8 @@ let e_tuple4 : let uu___4 = let uu___5 = FStarC_Syntax_Embeddings_Base.printer_of ed in uu___5 w in - FStarC_Compiler_Util.format4 "(%s, %s, %s, %s)" uu___1 uu___2 - uu___3 uu___4 in + FStarC_Util.format4 "(%s, %s, %s, %s)" uu___1 uu___2 uu___3 + uu___4 in let em uu___ rng shadow norm = match uu___ with | (x1, x2, x3, x4) -> @@ -1190,8 +1177,8 @@ let e_tuple5 : let uu___5 = let uu___6 = FStarC_Syntax_Embeddings_Base.printer_of ee in uu___6 v in - FStarC_Compiler_Util.format5 "(%s, %s, %s, %s, %s)" uu___1 - uu___2 uu___3 uu___4 uu___5 in + FStarC_Util.format5 "(%s, %s, %s, %s, %s)" uu___1 uu___2 + uu___3 uu___4 uu___5 in let em uu___ rng shadow norm = match uu___ with | (x1, x2, x3, x4, x5) -> @@ -1487,12 +1474,12 @@ let e_either : let uu___ = let uu___1 = FStarC_Syntax_Embeddings_Base.printer_of ea in uu___1 a1 in - FStarC_Compiler_Util.format1 "Inl %s" uu___ + FStarC_Util.format1 "Inl %s" uu___ | FStar_Pervasives.Inr b1 -> let uu___ = let uu___1 = FStarC_Syntax_Embeddings_Base.printer_of eb in uu___1 b1 in - FStarC_Compiler_Util.format1 "Inr %s" uu___ in + FStarC_Util.format1 "Inr %s" uu___ in let em s rng shadow norm = lazy_embed printer1 emb_t_sum_a_b rng typ s (match s with @@ -1633,7 +1620,7 @@ let e_either : -> let uu___5 = FStarC_Syntax_Embeddings_Base.try_unembed ea a1 norm in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a2 -> FStar_Pervasives_Native.Some (FStar_Pervasives.Inl a2)) @@ -1644,7 +1631,7 @@ let e_either : -> let uu___5 = FStarC_Syntax_Embeddings_Base.try_unembed eb b1 norm in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun b2 -> FStar_Pervasives_Native.Some (FStar_Pervasives.Inr b2)) @@ -1673,8 +1660,8 @@ let e_list : let uu___1 = let uu___2 = let uu___3 = FStarC_Syntax_Embeddings_Base.printer_of ea in - FStarC_Compiler_List.map uu___3 l in - FStarC_Compiler_String.concat "; " uu___2 in + FStarC_List.map uu___3 l in + FStarC_String.concat "; " uu___2 in Prims.strcat uu___1 "]" in Prims.strcat "[" uu___ in let rec em l rng shadow_l norm = @@ -1766,10 +1753,10 @@ let e_list : -> let uu___4 = FStarC_Syntax_Embeddings_Base.try_unembed ea hd1 norm in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun hd2 -> let uu___5 = un tl norm in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun tl1 -> FStar_Pervasives_Native.Some (hd2 :: tl1))) | (FStarC_Syntax_Syntax.Tm_fvar fv, @@ -1781,10 +1768,10 @@ let e_list : -> let uu___2 = FStarC_Syntax_Embeddings_Base.try_unembed ea hd1 norm in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun hd2 -> let uu___3 = un tl norm in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun tl1 -> FStar_Pervasives_Native.Some (hd2 :: tl1))) | uu___2 -> FStar_Pervasives_Native.None)) in @@ -1814,6 +1801,8 @@ let (steps_NormDebug : FStarC_Syntax_Syntax.term) = FStarC_Syntax_Syntax.tconst FStarC_Parser_Const.steps_norm_debug let (steps_UnfoldOnly : FStarC_Syntax_Syntax.term) = FStarC_Syntax_Syntax.tconst FStarC_Parser_Const.steps_unfoldonly +let (steps_UnfoldOnce : FStarC_Syntax_Syntax.term) = + FStarC_Syntax_Syntax.tconst FStarC_Parser_Const.steps_unfoldonce let (steps_UnfoldFully : FStarC_Syntax_Syntax.term) = FStarC_Syntax_Syntax.tconst FStarC_Parser_Const.steps_unfoldonly let (steps_UnfoldAttr : FStarC_Syntax_Syntax.term) = @@ -1865,6 +1854,16 @@ let (e_norm_step : FStarC_Syntax_Syntax.as_arg uu___3 in [uu___2] in FStarC_Syntax_Syntax.mk_Tm_app steps_UnfoldOnly uu___1 rng + | FStar_Pervasives.UnfoldOnce l -> + let uu___1 = + let uu___2 = + let uu___3 = + let uu___4 = + FStarC_Syntax_Embeddings_Base.embed e_string_list l in + uu___4 rng FStar_Pervasives_Native.None norm in + FStarC_Syntax_Syntax.as_arg uu___3 in + [uu___2] in + FStarC_Syntax_Syntax.mk_Tm_app steps_UnfoldOnce uu___1 rng | FStar_Pervasives.UnfoldFully l -> let uu___1 = let uu___2 = @@ -1976,10 +1975,21 @@ let (e_norm_step : let uu___3 = FStarC_Syntax_Embeddings_Base.try_unembed e_string_list l norm in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldOnly ss)) + | (FStarC_Syntax_Syntax.Tm_fvar fv, (l, uu___2)::[]) when + FStarC_Syntax_Syntax.fv_eq_lid fv + FStarC_Parser_Const.steps_unfoldonce + -> + let uu___3 = + FStarC_Syntax_Embeddings_Base.try_unembed e_string_list l + norm in + FStarC_Util.bind_opt uu___3 + (fun ss -> + FStar_Pervasives_Native.Some + (FStar_Pervasives.UnfoldOnce ss)) | (FStarC_Syntax_Syntax.Tm_fvar fv, (l, uu___2)::[]) when FStarC_Syntax_Syntax.fv_eq_lid fv FStarC_Parser_Const.steps_unfoldfully @@ -1987,7 +1997,7 @@ let (e_norm_step : let uu___3 = FStarC_Syntax_Embeddings_Base.try_unembed e_string_list l norm in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldFully ss)) @@ -1998,7 +2008,7 @@ let (e_norm_step : let uu___3 = FStarC_Syntax_Embeddings_Base.try_unembed e_string_list l norm in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldAttr ss)) @@ -2009,7 +2019,7 @@ let (e_norm_step : let uu___3 = FStarC_Syntax_Embeddings_Base.try_unembed e_string_list l norm in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldQual ss)) @@ -2020,7 +2030,7 @@ let (e_norm_step : let uu___3 = FStarC_Syntax_Embeddings_Base.try_unembed e_string_list l norm in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldNamespace ss)) @@ -2375,57 +2385,55 @@ let (e_vconfig : let uu___30 = FStarC_Syntax_Embeddings_Base.try_unembed e_fsint initial_fuel norm in - FStarC_Compiler_Util.bind_opt uu___30 + FStarC_Util.bind_opt uu___30 (fun initial_fuel1 -> let uu___31 = FStarC_Syntax_Embeddings_Base.try_unembed e_fsint max_fuel norm in - FStarC_Compiler_Util.bind_opt uu___31 + FStarC_Util.bind_opt uu___31 (fun max_fuel1 -> let uu___32 = FStarC_Syntax_Embeddings_Base.try_unembed e_fsint initial_ifuel norm in - FStarC_Compiler_Util.bind_opt uu___32 + FStarC_Util.bind_opt uu___32 (fun initial_ifuel1 -> let uu___33 = FStarC_Syntax_Embeddings_Base.try_unembed e_fsint max_ifuel norm in - FStarC_Compiler_Util.bind_opt uu___33 + FStarC_Util.bind_opt uu___33 (fun max_ifuel1 -> let uu___34 = FStarC_Syntax_Embeddings_Base.try_unembed e_bool detail_errors norm in - FStarC_Compiler_Util.bind_opt uu___34 + FStarC_Util.bind_opt uu___34 (fun detail_errors1 -> let uu___35 = FStarC_Syntax_Embeddings_Base.try_unembed e_bool detail_hint_replay norm in - FStarC_Compiler_Util.bind_opt uu___35 + FStarC_Util.bind_opt uu___35 (fun detail_hint_replay1 -> let uu___36 = FStarC_Syntax_Embeddings_Base.try_unembed e_bool no_smt norm in - FStarC_Compiler_Util.bind_opt - uu___36 + FStarC_Util.bind_opt uu___36 (fun no_smt1 -> let uu___37 = FStarC_Syntax_Embeddings_Base.try_unembed e_fsint quake_lo norm in - FStarC_Compiler_Util.bind_opt - uu___37 + FStarC_Util.bind_opt uu___37 (fun quake_lo1 -> let uu___38 = FStarC_Syntax_Embeddings_Base.try_unembed e_fsint quake_hi norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___38 (fun quake_hi1 -> let uu___39 = FStarC_Syntax_Embeddings_Base.try_unembed e_bool quake_keep norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___39 (fun quake_keep1 -> @@ -2433,7 +2441,7 @@ let (e_vconfig : FStarC_Syntax_Embeddings_Base.try_unembed e_bool retry norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___40 (fun retry1 -> @@ -2443,7 +2451,7 @@ let (e_vconfig : e_bool smtencoding_elim_box norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___41 (fun smtencoding_elim_box1 @@ -2454,7 +2462,7 @@ let (e_vconfig : e_string smtencoding_nl_arith_repr norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___42 (fun smtencoding_nl_arith_repr1 @@ -2465,7 +2473,7 @@ let (e_vconfig : e_string smtencoding_l_arith_repr norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___43 (fun smtencoding_l_arith_repr1 @@ -2476,7 +2484,7 @@ let (e_vconfig : e_bool smtencoding_valid_intro norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___44 (fun smtencoding_valid_intro1 @@ -2487,7 +2495,7 @@ let (e_vconfig : e_bool smtencoding_valid_elim norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___45 (fun smtencoding_valid_elim1 @@ -2498,7 +2506,7 @@ let (e_vconfig : e_bool tcnorm norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___46 (fun tcnorm1 @@ -2509,7 +2517,7 @@ let (e_vconfig : e_bool no_plugins norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___47 (fun no_plugins1 @@ -2520,7 +2528,7 @@ let (e_vconfig : e_bool no_tactics norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___48 (fun no_tactics1 @@ -2531,7 +2539,7 @@ let (e_vconfig : e_string_list z3cliopt norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___49 (fun z3cliopt1 @@ -2542,7 +2550,7 @@ let (e_vconfig : e_string_list z3smtopt norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___50 (fun z3smtopt1 @@ -2553,7 +2561,7 @@ let (e_vconfig : e_bool z3refresh norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___51 (fun z3refresh1 @@ -2564,7 +2572,7 @@ let (e_vconfig : e_fsint z3rlimit norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___52 (fun z3rlimit1 @@ -2575,7 +2583,7 @@ let (e_vconfig : e_fsint z3rlimit_factor norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___53 (fun z3rlimit_factor1 @@ -2586,7 +2594,7 @@ let (e_vconfig : e_fsint z3seed norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___54 (fun z3seed1 @@ -2597,7 +2605,7 @@ let (e_vconfig : e_string z3version norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___55 (fun z3version1 @@ -2608,7 +2616,7 @@ let (e_vconfig : e_bool trivial_pre_for_unannotated_effectful_fns norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___56 (fun trivial_pre_for_unannotated_effectful_fns1 @@ -2620,7 +2628,7 @@ let (e_vconfig : e_string) reuse_hint_for norm in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___57 (fun reuse_hint_for1 @@ -2717,16 +2725,16 @@ let (e_vconfig : FStarC_Ident.string_of_lid FStarC_Parser_Const.vconfig_lid in (uu___2, []) in FStarC_Syntax_Syntax.ET_app uu___1) -let (e_order : FStar_Order.order FStarC_Syntax_Embeddings_Base.embedding) = +let (e_order : FStarC_Order.order FStarC_Syntax_Embeddings_Base.embedding) = let ord_Lt_lid = FStarC_Ident.lid_of_path ["FStar"; "Order"; "Lt"] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let ord_Eq_lid = FStarC_Ident.lid_of_path ["FStar"; "Order"; "Eq"] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let ord_Gt_lid = FStarC_Ident.lid_of_path ["FStar"; "Order"; "Gt"] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let ord_Lt = FStarC_Syntax_Syntax.tdataconstr ord_Lt_lid in let ord_Eq = FStarC_Syntax_Syntax.tdataconstr ord_Eq_lid in let ord_Gt = FStarC_Syntax_Syntax.tdataconstr ord_Gt_lid in @@ -2742,9 +2750,9 @@ let (e_order : FStar_Order.order FStarC_Syntax_Embeddings_Base.embedding) = let embed_order o rng shadow cb = let r = match o with - | FStar_Order.Lt -> ord_Lt - | FStar_Order.Eq -> ord_Eq - | FStar_Order.Gt -> ord_Gt in + | FStarC_Order.Lt -> ord_Lt + | FStarC_Order.Eq -> ord_Eq + | FStarC_Order.Gt -> ord_Gt in { FStarC_Syntax_Syntax.n = (r.FStarC_Syntax_Syntax.n); FStarC_Syntax_Syntax.pos = rng; @@ -2764,13 +2772,13 @@ let (e_order : FStar_Order.order FStarC_Syntax_Embeddings_Base.embedding) = (match uu___1 with | (FStarC_Syntax_Syntax.Tm_fvar fv, []) when FStarC_Syntax_Syntax.fv_eq_lid fv ord_Lt_lid -> - FStar_Pervasives_Native.Some FStar_Order.Lt + FStar_Pervasives_Native.Some FStarC_Order.Lt | (FStarC_Syntax_Syntax.Tm_fvar fv, []) when FStarC_Syntax_Syntax.fv_eq_lid fv ord_Eq_lid -> - FStar_Pervasives_Native.Some FStar_Order.Eq + FStar_Pervasives_Native.Some FStarC_Order.Eq | (FStarC_Syntax_Syntax.Tm_fvar fv, []) when FStarC_Syntax_Syntax.fv_eq_lid fv ord_Gt_lid -> - FStar_Pervasives_Native.Some FStar_Order.Gt + FStar_Pervasives_Native.Some FStarC_Order.Gt | uu___2 -> FStar_Pervasives_Native.None) in let uu___ = FStarC_Syntax_Syntax.lid_as_fv FStarC_Parser_Const.order_lid @@ -2808,7 +2816,7 @@ let e_arrow : FStarC_Syntax_Syntax.comp = uu___4 } in FStarC_Syntax_Syntax.Tm_arrow uu___2 in - FStarC_Syntax_Syntax.mk uu___1 FStarC_Compiler_Range_Type.dummyRange in + FStarC_Syntax_Syntax.mk uu___1 FStarC_Range_Type.dummyRange in let emb_t_arr_a_b uu___ = let uu___1 = let uu___2 = FStarC_Syntax_Embeddings_Base.emb_typ_of ea () in @@ -2822,25 +2830,23 @@ let e_arrow : let uu___1 = force_shadow shadow_f in match uu___1 with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.raise Embedding_failure + FStarC_Effect.raise Embedding_failure | FStar_Pervasives_Native.Some repr_f -> ((let uu___3 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___3 then let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term repr_f in - let uu___5 = FStarC_Compiler_Util.stack_dump () in - FStarC_Compiler_Util.print2 + let uu___5 = FStarC_Util.stack_dump () in + FStarC_Util.print2 "e_arrow forced back to term using shadow %s; repr=%s\n" uu___4 uu___5 else ()); (let res = norm (FStar_Pervasives.Inr repr_f) in (let uu___4 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___4 then let uu___5 = @@ -2849,8 +2855,8 @@ let e_arrow : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term res in - let uu___7 = FStarC_Compiler_Util.stack_dump () in - FStarC_Compiler_Util.print3 + let uu___7 = FStarC_Util.stack_dump () in + FStarC_Util.print3 "e_arrow forced back to term using shadow %s; repr=%s\n\t%s\n" uu___5 uu___6 uu___7 else ()); @@ -2860,15 +2866,14 @@ let e_arrow : (fun f1 -> let f_wrapped a1 = (let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f1 in - let uu___3 = FStarC_Compiler_Util.stack_dump () in - FStarC_Compiler_Util.print2 + let uu___3 = FStarC_Util.stack_dump () in + FStarC_Util.print2 "Calling back into normalizer for %s\n%s\n" uu___2 uu___3 else ()); (let a_tm = @@ -2889,7 +2894,7 @@ let e_arrow : FStarC_Syntax_Embeddings_Base.unembed eb b_tm norm in match uu___1 with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.raise Unembedding_failure + FStarC_Effect.raise Unembedding_failure | FStar_Pervasives_Native.Some b1 -> b1) in FStar_Pervasives_Native.Some f_wrapped) in FStarC_Syntax_Embeddings_Base.mk_emb_full em un typ printer1 @@ -2897,8 +2902,7 @@ let e_arrow : let e_sealed : 'a . 'a FStarC_Syntax_Embeddings_Base.embedding -> - 'a FStarC_Compiler_Sealed.sealed - FStarC_Syntax_Embeddings_Base.embedding + 'a FStarC_Sealed.sealed FStarC_Syntax_Embeddings_Base.embedding = fun ea -> let typ uu___ = @@ -2917,7 +2921,7 @@ let e_sealed : let uu___ = let uu___1 = let uu___2 = FStarC_Syntax_Embeddings_Base.printer_of ea in - uu___2 (FStarC_Compiler_Sealed.unseal x) in + uu___2 (FStarC_Sealed.unseal x) in Prims.strcat uu___1 ")" in Prims.strcat "(seal " uu___ in let em a1 rng shadow norm = @@ -2950,7 +2954,7 @@ let e_sealed : let uu___5 = let uu___6 = FStarC_Syntax_Embeddings_Base.embed ea - (FStarC_Compiler_Sealed.unseal a1) in + (FStarC_Sealed.unseal a1) in uu___6 rng shadow_a norm in FStarC_Syntax_Syntax.as_arg uu___5 in [uu___4] in @@ -2981,13 +2985,13 @@ let e_sealed : FStarC_Class_Monad.fmap FStarC_Class_Monad.monad_option () () (fun uu___5 -> - (Obj.magic FStarC_Compiler_Sealed.seal) uu___5) + (Obj.magic FStarC_Sealed.seal) uu___5) (Obj.magic uu___4))) | uu___2 -> Obj.magic (Obj.repr FStar_Pervasives_Native.None))) uu___1 uu___ in FStarC_Syntax_Embeddings_Base.mk_emb_full em un typ printer1 emb_ty_a let (e___range : - FStarC_Compiler_Range_Type.range FStarC_Syntax_Embeddings_Base.embedding) = + FStarC_Range_Type.range FStarC_Syntax_Embeddings_Base.embedding) = let em r rng _shadow _norm = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_range r)) rng in @@ -3001,7 +3005,7 @@ let (e___range : | uu___1 -> FStar_Pervasives_Native.None in FStarC_Syntax_Embeddings_Base.mk_emb_full em un (fun uu___ -> FStarC_Syntax_Syntax.t___range) - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range (fun uu___ -> let uu___1 = let uu___2 = @@ -3009,10 +3013,9 @@ let (e___range : (uu___2, []) in FStarC_Syntax_Syntax.ET_app uu___1) let (e_range : - FStarC_Compiler_Range_Type.range FStarC_Syntax_Embeddings_Base.embedding) = + FStarC_Range_Type.range FStarC_Syntax_Embeddings_Base.embedding) = FStarC_Syntax_Embeddings_Base.embed_as (e_sealed e___range) - FStarC_Compiler_Sealed.unseal FStarC_Compiler_Sealed.seal - FStar_Pervasives_Native.None + FStarC_Sealed.unseal FStarC_Sealed.seal FStar_Pervasives_Native.None let (e_issue : FStarC_Errors.issue FStarC_Syntax_Embeddings_Base.embedding) = let uu___ = FStarC_Syntax_Syntax.fvar FStarC_Parser_Const.issue_lid @@ -3060,7 +3063,7 @@ let arrow_as_prim_step_1 : let uu___2 = let uu___3 = FStarC_Syntax_Embeddings_Base.try_unembed ea x norm in - FStarC_Compiler_Util.map_opt uu___3 + FStarC_Util.map_opt uu___3 (fun x1 -> let uu___4 = let uu___5 = f x1 in @@ -3104,12 +3107,12 @@ let arrow_as_prim_step_2 : let uu___3 = let uu___4 = FStarC_Syntax_Embeddings_Base.try_unembed ea x norm in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun x1 -> let uu___5 = FStarC_Syntax_Embeddings_Base.try_unembed eb y norm in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun y1 -> let uu___6 = let uu___7 = @@ -3161,17 +3164,17 @@ let arrow_as_prim_step_3 : let uu___4 = let uu___5 = FStarC_Syntax_Embeddings_Base.try_unembed ea x norm in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun x1 -> let uu___6 = FStarC_Syntax_Embeddings_Base.try_unembed eb y norm in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun y1 -> let uu___7 = FStarC_Syntax_Embeddings_Base.try_unembed ec z norm in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun z1 -> let uu___8 = let uu___9 = @@ -3189,17 +3192,11 @@ let arrow_as_prim_step_3 : let debug_wrap : 'a . Prims.string -> (unit -> 'a) -> 'a = fun s -> fun f -> - (let uu___1 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in - if uu___1 - then FStarC_Compiler_Util.print1 "++++starting %s\n" s - else ()); + (let uu___1 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in + if uu___1 then FStarC_Util.print1 "++++starting %s\n" s else ()); (let res = f () in - (let uu___2 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in - if uu___2 - then FStarC_Compiler_Util.print1 "------ending %s\n" s - else ()); + (let uu___2 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in + if uu___2 then FStarC_Util.print1 "------ending %s\n" s else ()); res) let (e_abstract_term : abstract_term FStarC_Syntax_Embeddings_Base.embedding) = diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Embeddings_AppEmb.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Embeddings_AppEmb.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Syntax_Embeddings_AppEmb.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Embeddings_AppEmb.ml diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Embeddings_Base.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Embeddings_Base.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_Syntax_Embeddings_Base.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Embeddings_Base.ml index 3bb4ec8cd30..72fd26b4f54 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Embeddings_Base.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Embeddings_Base.ml @@ -5,7 +5,7 @@ type norm_cb = type shadow_term = FStarC_Syntax_Syntax.term FStarC_Thunk.t FStar_Pervasives_Native.option type embed_t = - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> shadow_term -> norm_cb -> FStarC_Syntax_Syntax.term type 'a unembed_t = norm_cb -> 'a FStar_Pervasives_Native.option type 'a raw_embedder = 'a -> embed_t @@ -30,10 +30,10 @@ let (uu___is_Unembedding_failure : Prims.exn -> Prims.bool) = let (map_shadow : shadow_term -> (FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) -> shadow_term) - = fun s -> fun f -> FStarC_Compiler_Util.map_opt s (FStarC_Thunk.map f) + = fun s -> fun f -> FStarC_Util.map_opt s (FStarC_Thunk.map f) let (force_shadow : shadow_term -> FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option) = - fun s -> FStarC_Compiler_Util.map_opt s FStarC_Thunk.force + fun s -> FStarC_Util.map_opt s FStarC_Thunk.force type 'a embedding = { em: 'a -> embed_t ; @@ -85,7 +85,7 @@ let unknown_printer : 'a . FStarC_Syntax_Syntax.term -> 'a -> Prims.string = fun uu___ -> let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term typ1 in - FStarC_Compiler_Util.format1 "unknown %s" uu___1 + FStarC_Util.format1 "unknown %s" uu___1 let (term_as_fv : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.fv) = fun t -> let uu___ = @@ -97,8 +97,7 @@ let (term_as_fv : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.fv) = let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 "Embeddings not defined for type %s" - uu___3 in + FStarC_Util.format1 "Embeddings not defined for type %s" uu___3 in failwith uu___2 let mk_emb : 'a . @@ -263,15 +262,14 @@ let embed_as : (fun t -> fun cb -> let uu___ = try_unembed ea t cb in - FStarC_Compiler_Util.map_opt uu___ ab) + FStarC_Util.map_opt uu___ ab) (fun uu___ -> match o with | FStar_Pervasives_Native.Some t -> t | uu___1 -> type_of ea) (fun x -> let uu___ = let uu___1 = ba x in ea.print uu___1 in - FStarC_Compiler_Util.format1 "(embed_as>> %s)\n" uu___) - ea.e_typ + FStarC_Util.format1 "(embed_as>> %s)\n" uu___) ea.e_typ let e_lazy : 'a . FStarC_Syntax_Syntax.lazy_kind -> @@ -313,7 +311,7 @@ let e_lazy : FStarC_Syntax_Syntax.showable_lazy_kind lkind in let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t0 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Warning, lazy unembedding failed, tag mismatch.\n\tExpected %s, got %s\n\tt = %s." uu___5 uu___6 uu___7 in FStarC_Errors.log_issue @@ -328,7 +326,7 @@ let lazy_embed : 'a . 'a printer -> FStarC_Syntax_Syntax.emb_typ -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> 'a -> (unit -> FStarC_Syntax_Syntax.term) -> @@ -341,8 +339,7 @@ let lazy_embed : fun x -> fun f -> (let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___1 then let uu___2 = @@ -352,13 +349,12 @@ let lazy_embed : FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ et in let uu___4 = pa x in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Embedding a %s\n\temb_typ=%s\n\tvalue is %s\n" uu___2 uu___3 uu___4 else ()); (let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.eager_embedding in + FStarC_Effect.op_Bang FStarC_Options.eager_embedding in if uu___1 then f () else @@ -391,14 +387,12 @@ let lazy_unembed : -> let uu___2 = (et <> et') || - (FStarC_Compiler_Effect.op_Bang - FStarC_Options.eager_embedding) in + (FStarC_Effect.op_Bang FStarC_Options.eager_embedding) in if uu___2 then let res = let uu___3 = FStarC_Thunk.force t in f uu___3 in ((let uu___4 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___4 then let uu___5 = @@ -412,7 +406,7 @@ let lazy_unembed : | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some x2 -> let uu___8 = pa x2 in Prims.strcat "Some " uu___8 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Unembed cancellation failed\n\t%s <> %s\nvalue is %s\n" uu___5 uu___6 uu___7 else ()); @@ -420,15 +414,14 @@ let lazy_unembed : else (let a1 = FStarC_Dyn.undyn b in (let uu___5 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___5 then let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ et in let uu___7 = pa a1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Unembed cancelled for %s\n\tvalue is %s\n" uu___6 uu___7 else ()); @@ -436,8 +429,7 @@ let lazy_unembed : | uu___ -> let aopt = f x1 in ((let uu___2 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___2 then let uu___3 = @@ -451,7 +443,7 @@ let lazy_unembed : | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some a1 -> let uu___6 = pa a1 in Prims.strcat "Some " uu___6 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Unembedding:\n\temb_typ=%s\n\tterm is %s\n\tvalue is %s\n" uu___3 uu___4 uu___5 else ()); @@ -461,7 +453,7 @@ let op_let_Question : 'uuuuu FStar_Pervasives_Native.option -> ('uuuuu -> 'uuuuu1 FStar_Pervasives_Native.option) -> 'uuuuu1 FStar_Pervasives_Native.option - = fun o -> fun f -> FStarC_Compiler_Util.bind_opt o f + = fun o -> fun f -> FStarC_Util.bind_opt o f let mk_extracted_embedding : 'a . Prims.string -> @@ -492,8 +484,7 @@ let mk_extracted_embedding : let uu___2 = let uu___3 = FStarC_Ident.string_of_lid hd_lid in let uu___4 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - args in + FStarC_List.map FStar_Pervasives_Native.fst args in (uu___3, uu___4) in u uu___2) in let ee x rng _topt _norm = e x in @@ -505,8 +496,8 @@ let extracted_embed : 'a . 'a embedding -> 'a -> FStarC_Syntax_Syntax.term = fun e -> fun x -> let uu___ = embed e x in - uu___ FStarC_Compiler_Range_Type.dummyRange - FStar_Pervasives_Native.None id_norm_cb + uu___ FStarC_Range_Type.dummyRange FStar_Pervasives_Native.None + id_norm_cb let extracted_unembed : 'a . 'a embedding -> diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Formula.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Formula.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_Syntax_Formula.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Formula.ml index 0e4e6a4fc9e..3e6f6587786 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Formula.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Formula.ml @@ -117,13 +117,13 @@ let (lookup_arity_lid : fun table -> fun target_lid -> fun args -> - let arg_len = FStarC_Compiler_List.length args in + let arg_len = FStarC_List.length args in let aux uu___ = match uu___ with | (arity, lids) -> if arg_len = arity then - FStarC_Compiler_Util.find_map lids + FStarC_Util.find_map lids (fun uu___1 -> match uu___1 with | (lid, out_lid) -> @@ -134,7 +134,7 @@ let (lookup_arity_lid : (BaseConn (out_lid, args)) else FStar_Pervasives_Native.None) else FStar_Pervasives_Native.None in - FStarC_Compiler_Util.find_map table aux + FStarC_Util.find_map table aux let (destruct_base_conn : FStarC_Syntax_Syntax.term -> connective FStar_Pervasives_Native.option) = fun t -> @@ -207,7 +207,7 @@ let (destruct_q_conn : | (t2, args) -> let uu___1 = FStarC_Syntax_Util.un_uinst t2 in let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (t3, imp) -> @@ -296,7 +296,7 @@ let (destruct_q_conn : FStar_Pervasives_Native.Some uu___11 in aux uu___10 (b :: out) t2 | (FStar_Pervasives_Native.Some b, uu___1) -> - let bs = FStarC_Compiler_List.rev out in + let bs = FStarC_List.rev out in let uu___2 = FStarC_Syntax_Subst.open_term bs t1 in (match uu___2 with | (bs1, t2) -> @@ -426,8 +426,8 @@ and (maybe_collect : | FStar_Pervasives_Native.Some (QAll (bs', pats', psi)) -> FStar_Pervasives_Native.Some (QAll - ((FStarC_Compiler_List.op_At bs bs'), - (FStarC_Compiler_List.op_At pats pats'), psi)) + ((FStarC_List.op_At bs bs'), + (FStarC_List.op_At pats pats'), psi)) | uu___1 -> f) | FStar_Pervasives_Native.Some (QEx (bs, pats, phi)) -> let uu___ = destruct_sq_exists phi in @@ -435,8 +435,8 @@ and (maybe_collect : | FStar_Pervasives_Native.Some (QEx (bs', pats', psi)) -> FStar_Pervasives_Native.Some (QEx - ((FStarC_Compiler_List.op_At bs bs'), - (FStarC_Compiler_List.op_At pats pats'), psi)) + ((FStarC_List.op_At bs bs'), + (FStarC_List.op_At pats pats'), psi)) | uu___1 -> f) | uu___ -> f let (destruct_typ_as_formula : @@ -445,18 +445,18 @@ let (destruct_typ_as_formula : let phi = unmeta_monadic f in let r = let uu___ = destruct_base_conn phi in - FStarC_Compiler_Util.catch_opt uu___ + FStarC_Util.catch_opt uu___ (fun uu___1 -> let uu___2 = destruct_q_conn phi in - FStarC_Compiler_Util.catch_opt uu___2 + FStarC_Util.catch_opt uu___2 (fun uu___3 -> let uu___4 = destruct_sq_base_conn phi in - FStarC_Compiler_Util.catch_opt uu___4 + FStarC_Util.catch_opt uu___4 (fun uu___5 -> let uu___6 = destruct_sq_forall phi in - FStarC_Compiler_Util.catch_opt uu___6 + FStarC_Util.catch_opt uu___6 (fun uu___7 -> let uu___8 = destruct_sq_exists phi in - FStarC_Compiler_Util.catch_opt uu___8 + FStarC_Util.catch_opt uu___8 (fun uu___9 -> FStar_Pervasives_Native.None))))) in r \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Free.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Free.ml similarity index 85% rename from stage0/fstar-lib/generated/FStarC_Syntax_Free.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Free.ml index 8ca857b0c0e..05c4b521c9f 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Free.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Free.ml @@ -89,8 +89,7 @@ let (uu___is_NoCache : use_cache_t -> Prims.bool) = let (uu___is_Full : use_cache_t -> Prims.bool) = fun projectee -> match projectee with | Full -> true | uu___ -> false type free_vars_and_fvars = - (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident - FStarC_Compiler_RBSet.t) + (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident FStarC_RBSet.t) let rec snoc : 'a . 'a FStarC_Class_Deq.deq -> 'a Prims.list -> 'a -> 'a Prims.list = fun uu___ -> @@ -111,32 +110,29 @@ let op_At_At : fun uu___ -> fun xs -> fun ys -> - FStarC_Compiler_List.fold_left (fun xs1 -> fun y -> snoc uu___ xs1 y) - xs ys + FStarC_List.fold_left (fun xs1 -> fun y -> snoc uu___ xs1 y) xs ys let (no_free_vars : free_vars_and_fvars) = let uu___ = let uu___1 = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_bv)) ()) in + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) + ()) in let uu___2 = Obj.magic (FStarC_Class_Setlike.empty () - (Obj.magic (FStarC_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) - ()) in + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_ctx_uvar)) ()) in let uu___3 = Obj.magic (FStarC_Class_Setlike.empty () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) ()) in + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_univ_uvar)) ()) in let uu___4 = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_ident)) ()) in + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) + ()) in { FStarC_Syntax_Syntax.free_names = uu___1; FStarC_Syntax_Syntax.free_uvars = uu___2; @@ -146,8 +142,7 @@ let (no_free_vars : free_vars_and_fvars) = let uu___1 = Obj.magic (FStarC_Class_Setlike.empty () - (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) + (Obj.magic (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) ()) in (uu___, uu___1) let (singleton_fvar : FStarC_Syntax_Syntax.fv -> free_vars_and_fvars) = @@ -157,20 +152,17 @@ let (singleton_fvar : FStarC_Syntax_Syntax.fv -> free_vars_and_fvars) = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_fv)) ()) in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) ()) in Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_fv)) + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v (Obj.magic uu___1)) in ((FStar_Pervasives_Native.fst no_free_vars), uu___) let (singleton_bv : FStarC_Syntax_Syntax.bv -> - (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident - FStarC_Compiler_RBSet.t)) + (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident FStarC_RBSet.t)) = fun x -> let uu___ = @@ -179,8 +171,8 @@ let (singleton_bv : Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_bv)) x) in + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) + x) in { FStarC_Syntax_Syntax.free_names = uu___2; FStarC_Syntax_Syntax.free_uvars = @@ -193,8 +185,7 @@ let (singleton_bv : (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_uv : FStarC_Syntax_Syntax.ctx_uvar -> - (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident - FStarC_Compiler_RBSet.t)) + (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident FStarC_RBSet.t)) = fun x -> let uu___ = @@ -202,8 +193,7 @@ let (singleton_uv : let uu___2 = Obj.magic (FStarC_Class_Setlike.singleton () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) x) in + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_ctx_uvar)) x) in { FStarC_Syntax_Syntax.free_names = (uu___1.FStarC_Syntax_Syntax.free_names); @@ -216,8 +206,7 @@ let (singleton_uv : (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_univ : FStarC_Syntax_Syntax.universe_uvar -> - (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident - FStarC_Compiler_RBSet.t)) + (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident FStarC_RBSet.t)) = fun x -> let uu___ = @@ -225,8 +214,7 @@ let (singleton_univ : let uu___2 = Obj.magic (FStarC_Class_Setlike.singleton () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) x) in + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_univ_uvar)) x) in { FStarC_Syntax_Syntax.free_names = (uu___1.FStarC_Syntax_Syntax.free_names); @@ -239,8 +227,7 @@ let (singleton_univ : (uu___, (FStar_Pervasives_Native.snd no_free_vars)) let (singleton_univ_name : FStarC_Syntax_Syntax.univ_name -> - (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident - FStarC_Compiler_RBSet.t)) + (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident FStarC_RBSet.t)) = fun x -> let uu___ = @@ -249,7 +236,7 @@ let (singleton_univ_name : Obj.magic (FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) x) in { FStarC_Syntax_Syntax.free_names = @@ -264,8 +251,7 @@ let (singleton_univ_name : let (op_Plus_Plus : free_vars_and_fvars -> free_vars_and_fvars -> - (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident - FStarC_Compiler_RBSet.t)) + (FStarC_Syntax_Syntax.free_vars * FStarC_Ident.lident FStarC_RBSet.t)) = fun f1 -> fun f2 -> @@ -274,7 +260,7 @@ let (op_Plus_Plus : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic (FStar_Pervasives_Native.fst f1).FStarC_Syntax_Syntax.free_names) @@ -283,8 +269,7 @@ let (op_Plus_Plus : let uu___2 = Obj.magic (FStarC_Class_Setlike.union () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_ctx_uvar)) (Obj.magic (FStar_Pervasives_Native.fst f1).FStarC_Syntax_Syntax.free_uvars) (Obj.magic @@ -292,8 +277,7 @@ let (op_Plus_Plus : let uu___3 = Obj.magic (FStarC_Class_Setlike.union () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_univ_uvar)) (Obj.magic (FStar_Pervasives_Native.fst f1).FStarC_Syntax_Syntax.free_univs) (Obj.magic @@ -302,7 +286,7 @@ let (op_Plus_Plus : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic (FStar_Pervasives_Native.fst f1).FStarC_Syntax_Syntax.free_univ_names) @@ -318,8 +302,7 @@ let (op_Plus_Plus : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_fv)) + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) (Obj.magic (FStar_Pervasives_Native.snd f1)) (Obj.magic (FStar_Pervasives_Native.snd f2))) in (uu___, uu___1) @@ -333,7 +316,7 @@ let rec (free_univs : FStarC_Syntax_Syntax.universe -> free_vars_and_fvars) = | FStarC_Syntax_Syntax.U_name uname -> singleton_univ_name uname | FStarC_Syntax_Syntax.U_succ u1 -> free_univs u1 | FStarC_Syntax_Syntax.U_max us -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun out -> fun x -> let uu___1 = free_univs x in op_Plus_Plus out uu___1) no_free_vars us @@ -366,7 +349,7 @@ let rec (free_names_and_uvs' : | FStarC_Syntax_Syntax.Tm_unknown -> no_free_vars | FStarC_Syntax_Syntax.Tm_uinst (t1, us) -> let f = free_names_and_uvars t1 use_cache in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun out -> fun u -> let uu___ = free_univs u in op_Plus_Plus out uu___) f us @@ -430,7 +413,7 @@ let rec (free_names_and_uvs' : free_names_and_uvars_ascription asc use_cache in op_Plus_Plus uu___5 uu___6 in op_Plus_Plus uu___3 uu___4 in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun n -> fun uu___3 -> match uu___3 with @@ -443,7 +426,7 @@ let rec (free_names_and_uvs' : let n2 = free_names_and_uvars t2 use_cache in let n3 = let uu___4 = FStarC_Syntax_Syntax.pat_bvs p in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun n4 -> fun x -> let uu___5 = @@ -465,7 +448,7 @@ let rec (free_names_and_uvs' : FStarC_Syntax_Syntax.body1 = t1;_} -> let uu___ = free_names_and_uvars t1 use_cache in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun n -> fun lb -> let uu___1 = @@ -481,7 +464,7 @@ let rec (free_names_and_uvs' : | FStarC_Syntax_Syntax.Tm_quoted (tm1, qi) -> (match qi.FStarC_Syntax_Syntax.qkind with | FStarC_Syntax_Syntax.Quote_static -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun n -> fun t1 -> let uu___ = free_names_and_uvars t1 use_cache in @@ -496,7 +479,7 @@ let rec (free_names_and_uvs' : let u1 = free_names_and_uvars t1 use_cache in (match m with | FStarC_Syntax_Syntax.Meta_pattern (uu___, args) -> - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun a -> fun acc -> free_names_and_uvars_args a acc use_cache) args u1 @@ -513,7 +496,7 @@ and (free_names_and_uvars_binders : FStarC_Syntax_Syntax.binders -> use_cache_t -> free_vars_and_fvars) = fun bs -> fun use_cache -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun n -> fun b -> let uu___ = @@ -550,7 +533,7 @@ and (free_names_and_uvars : fun t -> fun use_cache -> let t1 = FStarC_Syntax_Subst.compress t in - let uu___ = FStarC_Compiler_Effect.op_Bang t1.FStarC_Syntax_Syntax.vars in + let uu___ = FStarC_Effect.op_Bang t1.FStarC_Syntax_Syntax.vars in match uu___ with | FStar_Pervasives_Native.Some n when let uu___1 = should_invalidate_cache n use_cache in @@ -559,17 +542,16 @@ and (free_names_and_uvars : Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_fv)) ()) in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) + ()) in (n, uu___1) | uu___1 -> - (FStarC_Compiler_Effect.op_Colon_Equals - t1.FStarC_Syntax_Syntax.vars FStar_Pervasives_Native.None; + (FStarC_Effect.op_Colon_Equals t1.FStarC_Syntax_Syntax.vars + FStar_Pervasives_Native.None; (let n = free_names_and_uvs' t1 use_cache in if use_cache <> Full then - FStarC_Compiler_Effect.op_Colon_Equals - t1.FStarC_Syntax_Syntax.vars + FStarC_Effect.op_Colon_Equals t1.FStarC_Syntax_Syntax.vars (FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst n)) else (); n)) @@ -581,7 +563,7 @@ and (free_names_and_uvars_args : fun args -> fun acc -> fun use_cache -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun n -> fun uu___ -> match uu___ with @@ -594,21 +576,21 @@ and (free_names_and_uvars_comp : = fun c -> fun use_cache -> - let uu___ = FStarC_Compiler_Effect.op_Bang c.FStarC_Syntax_Syntax.vars in + let uu___ = FStarC_Effect.op_Bang c.FStarC_Syntax_Syntax.vars in match uu___ with | FStar_Pervasives_Native.Some n -> let uu___1 = should_invalidate_cache n use_cache in if uu___1 then - (FStarC_Compiler_Effect.op_Colon_Equals - c.FStarC_Syntax_Syntax.vars FStar_Pervasives_Native.None; + (FStarC_Effect.op_Colon_Equals c.FStarC_Syntax_Syntax.vars + FStar_Pervasives_Native.None; free_names_and_uvars_comp c use_cache) else (let uu___3 = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) ()) in (n, uu___3)) | uu___1 -> @@ -621,7 +603,7 @@ and (free_names_and_uvars_comp : | FStarC_Syntax_Syntax.Comp ct -> let decreases_vars = let uu___2 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.DECREASES uu___4 -> true @@ -639,12 +621,12 @@ and (free_names_and_uvars_comp : let us1 = free_names_and_uvars_args ct.FStarC_Syntax_Syntax.effect_args us use_cache in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun us2 -> fun u -> let uu___2 = free_univs u in op_Plus_Plus us2 uu___2) us1 ct.FStarC_Syntax_Syntax.comp_univs in - (FStarC_Compiler_Effect.op_Colon_Equals c.FStarC_Syntax_Syntax.vars + (FStarC_Effect.op_Colon_Equals c.FStarC_Syntax_Syntax.vars (FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst n)); n) and (free_names_and_uvars_dec_order : @@ -654,7 +636,7 @@ and (free_names_and_uvars_dec_order : fun use_cache -> match dec_order with | FStarC_Syntax_Syntax.Decreases_lex l -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun t -> let uu___ = free_names_and_uvars t use_cache in @@ -669,8 +651,7 @@ and (should_invalidate_cache : fun use_cache -> ((use_cache <> Def) || (FStarC_Class_Setlike.for_any () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set ord_ctx_uvar)) + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_ctx_uvar)) (fun u -> let uu___ = FStarC_Syntax_Unionfind.find @@ -681,8 +662,7 @@ and (should_invalidate_cache : (Obj.magic n.FStarC_Syntax_Syntax.free_uvars))) || (FStarC_Class_Setlike.for_any () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set ord_univ_uvar)) + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_univ_uvar)) (fun u -> let uu___ = FStarC_Syntax_Unionfind.univ_find u in match uu___ with @@ -690,17 +670,14 @@ and (should_invalidate_cache : | FStar_Pervasives_Native.None -> false) (Obj.magic n.FStarC_Syntax_Syntax.free_univs)) let (names : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t) - = + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.t) = fun t -> let uu___ = let uu___1 = free_names_and_uvars t Def in FStar_Pervasives_Native.fst uu___1 in uu___.FStarC_Syntax_Syntax.free_names let (uvars : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.ctx_uvar FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.ctx_uvar FStarC_FlatSet.t) = fun t -> let uu___ = @@ -709,7 +686,7 @@ let (uvars : uu___.FStarC_Syntax_Syntax.free_uvars let (univs : FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.universe_uvar FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.universe_uvar FStarC_FlatSet.t) = fun t -> let uu___ = @@ -718,7 +695,7 @@ let (univs : uu___.FStarC_Syntax_Syntax.free_univs let (univnames : FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.univ_name FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.univ_name FStarC_FlatSet.t) = fun t -> let uu___ = @@ -727,30 +704,27 @@ let (univnames : uu___.FStarC_Syntax_Syntax.free_univ_names let (univnames_comp : FStarC_Syntax_Syntax.comp -> - FStarC_Syntax_Syntax.univ_name FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.univ_name FStarC_FlatSet.t) = fun c -> let uu___ = let uu___1 = free_names_and_uvars_comp c Def in FStar_Pervasives_Native.fst uu___1 in uu___.FStarC_Syntax_Syntax.free_univ_names -let (fvars : - FStarC_Syntax_Syntax.term -> FStarC_Ident.lident FStarC_Compiler_RBSet.t) = +let (fvars : FStarC_Syntax_Syntax.term -> FStarC_Ident.lident FStarC_RBSet.t) + = fun t -> let uu___ = free_names_and_uvars t NoCache in FStar_Pervasives_Native.snd uu___ let (names_of_binders : - FStarC_Syntax_Syntax.binders -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t) - = + FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.t) = fun bs -> let uu___ = let uu___1 = free_names_and_uvars_binders bs Def in FStar_Pervasives_Native.fst uu___1 in uu___.FStarC_Syntax_Syntax.free_names let (uvars_uncached : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.ctx_uvar FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.ctx_uvar FStarC_FlatSet.t) = fun t -> let uu___ = @@ -758,8 +732,7 @@ let (uvars_uncached : FStar_Pervasives_Native.fst uu___1 in uu___.FStarC_Syntax_Syntax.free_uvars let (uvars_full : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.ctx_uvar FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.ctx_uvar FStarC_FlatSet.t) = fun t -> let uu___ = diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Hash.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Hash.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_Syntax_Hash.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Hash.ml index b8ec74e32bb..30a8e22388c 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Hash.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Hash.ml @@ -20,8 +20,7 @@ let maybe_memoize : fun should_memo1 -> if should_memo1 then - let uu___ = - FStarC_Compiler_Effect.op_Bang h.FStarC_Syntax_Syntax.hash_code in + let uu___ = FStarC_Effect.op_Bang h.FStarC_Syntax_Syntax.hash_code in match uu___ with | FStar_Pervasives_Native.Some c -> (c, should_memo1) | FStar_Pervasives_Native.None -> @@ -30,7 +29,7 @@ let maybe_memoize : | (c, should_memo2) -> (if should_memo2 then - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals h.FStarC_Syntax_Syntax.hash_code (FStar_Pervasives_Native.Some c) else (); @@ -58,16 +57,14 @@ let (nil_hc : FStarC_Hash.hash_code mm) = of_int (Prims.of_int (1229)) let (cons_hc : FStarC_Hash.hash_code mm) = of_int (Prims.of_int (1231)) let (mix_list : FStarC_Hash.hash_code mm Prims.list -> FStarC_Hash.hash_code mm) = - fun l -> FStarC_Compiler_List.fold_right mix l nil_hc + fun l -> FStarC_List.fold_right mix l nil_hc let (mix_list_lit : FStarC_Hash.hash_code mm Prims.list -> FStarC_Hash.hash_code mm) = mix_list let hash_list : 'a . ('a -> FStarC_Hash.hash_code mm) -> 'a Prims.list -> FStarC_Hash.hash_code mm - = - fun h -> - fun ts -> let uu___ = FStarC_Compiler_List.map h ts in mix_list uu___ + = fun h -> fun ts -> let uu___ = FStarC_List.map h ts in mix_list uu___ let hash_option : 'a . ('a -> FStarC_Hash.hash_code mm) -> @@ -86,8 +83,8 @@ let hash_option : let (hash_doc : FStarC_Pprint.document -> FStarC_Hash.hash_code mm) = fun d -> let uu___ = - FStarC_Pprint.pretty_string - (FStarC_Compiler_Util.float_of_string "1.0") (Prims.of_int (80)) d in + FStarC_Pprint.pretty_string (FStarC_Util.float_of_string "1.0") + (Prims.of_int (80)) d in of_string uu___ let (hash_doc_list : FStarC_Pprint.document Prims.list -> FStarC_Hash.hash_code mm) = @@ -453,7 +450,7 @@ and (hash_uvar : and (hash_universe_uvar : (FStarC_Syntax_Syntax.universe FStar_Pervasives_Native.option FStarC_Unionfind.p_uvar * FStarC_Syntax_Syntax.version * - FStarC_Compiler_Range_Type.range) -> FStarC_Hash.hash_code mm) + FStarC_Range_Type.range) -> FStarC_Hash.hash_code mm) = fun u -> let uu___ = FStarC_Syntax_Unionfind.univ_uvar_id u in of_int uu___ and (hash_ascription : @@ -501,8 +498,7 @@ and (hash_constant : FStarC_Syntax_Syntax.sconst -> FStarC_Hash.hash_code mm) | FStarC_Const.Const_range r -> let uu___1 = of_int (Prims.of_int (367)) in let uu___2 = - let uu___3 = FStarC_Compiler_Range_Ops.string_of_range r in - of_string uu___3 in + let uu___3 = FStarC_Range_Ops.string_of_range r in of_string uu___3 in mix uu___1 uu___2 | FStarC_Const.Const_reify uu___1 -> of_int (Prims.of_int (367)) | FStarC_Const.Const_reflect l -> @@ -600,7 +596,7 @@ and (hash_meta : FStarC_Syntax_Syntax.metadata -> FStarC_Hash.hash_code mm) = let uu___4 = hash_doc_list s in let uu___5 = let uu___6 = - let uu___7 = FStarC_Compiler_Range_Ops.string_of_range r in + let uu___7 = FStarC_Range_Ops.string_of_range r in of_string uu___7 in [uu___6] in uu___4 :: uu___5 in @@ -711,12 +707,12 @@ let rec (equal_term : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> Prims.bool) = fun t1 -> fun t2 -> - let uu___ = FStarC_Compiler_Util.physical_equality t1 t2 in + let uu___ = FStarC_Util.physical_equality t1 t2 in if uu___ then true else (let uu___2 = - FStarC_Compiler_Util.physical_equality t1.FStarC_Syntax_Syntax.n + FStarC_Util.physical_equality t1.FStarC_Syntax_Syntax.n t2.FStarC_Syntax_Syntax.n in if uu___2 then true @@ -844,7 +840,7 @@ and (equal_comp : = fun c1 -> fun c2 -> - let uu___ = FStarC_Compiler_Util.physical_equality c1 c2 in + let uu___ = FStarC_Util.physical_equality c1 c2 in if uu___ then true else @@ -874,7 +870,7 @@ and (equal_binder : FStarC_Syntax_Syntax.binder -> FStarC_Syntax_Syntax.binder -> Prims.bool) = fun b1 -> fun b2 -> - let uu___ = FStarC_Compiler_Util.physical_equality b1 b2 in + let uu___ = FStarC_Util.physical_equality b1 b2 in if uu___ then true else @@ -919,7 +915,7 @@ and (equal_ascription : = fun x1 -> fun x2 -> - let uu___ = FStarC_Compiler_Util.physical_equality x1 x2 in + let uu___ = FStarC_Util.physical_equality x1 x2 in if uu___ then true else @@ -942,7 +938,7 @@ and (equal_letbinding : = fun l1 -> fun l2 -> - let uu___ = FStarC_Compiler_Util.physical_equality l1 l2 in + let uu___ = FStarC_Util.physical_equality l1 l2 in if uu___ then true else @@ -983,7 +979,7 @@ and (equal_bv : FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.bv -> Prims.bool) = fun b1 -> fun b2 -> - let uu___ = FStarC_Compiler_Util.physical_equality b1 b2 in + let uu___ = FStarC_Util.physical_equality b1 b2 in if uu___ then true else @@ -996,7 +992,7 @@ and (equal_fv : FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.fv -> Prims.bool) = fun f1 -> fun f2 -> - let uu___ = FStarC_Compiler_Util.physical_equality f1 f2 in + let uu___ = FStarC_Util.physical_equality f1 f2 in if uu___ then true else @@ -1009,7 +1005,7 @@ and (equal_universe : = fun u1 -> fun u2 -> - let uu___ = FStarC_Compiler_Util.physical_equality u1 u2 in + let uu___ = FStarC_Util.physical_equality u1 u2 in if uu___ then true else @@ -1036,7 +1032,7 @@ and (equal_constant : FStarC_Syntax_Syntax.sconst -> FStarC_Syntax_Syntax.sconst -> Prims.bool) = fun c1 -> fun c2 -> - let uu___ = FStarC_Compiler_Util.physical_equality c1 c2 in + let uu___ = FStarC_Util.physical_equality c1 c2 in if uu___ then true else @@ -1057,7 +1053,7 @@ and (equal_constant : | (FStarC_Const.Const_set_range_of, FStarC_Const.Const_set_range_of) -> true | (FStarC_Const.Const_range r1, FStarC_Const.Const_range r2) -> - let uu___2 = FStarC_Compiler_Range_Ops.compare r1 r2 in + let uu___2 = FStarC_Range_Ops.compare r1 r2 in uu___2 = Prims.int_zero | (FStarC_Const.Const_reify uu___2, FStarC_Const.Const_reify uu___3) -> true @@ -1073,7 +1069,7 @@ and (equal_arg : = fun arg1 -> fun arg2 -> - let uu___ = FStarC_Compiler_Util.physical_equality arg1 arg2 in + let uu___ = FStarC_Util.physical_equality arg1 arg2 in if uu___ then true else @@ -1125,7 +1121,7 @@ and (equal_pat : = fun p1 -> fun p2 -> - let uu___ = FStarC_Compiler_Util.physical_equality p1 p2 in + let uu___ = FStarC_Util.physical_equality p1 p2 in if uu___ then true else @@ -1160,7 +1156,7 @@ and (equal_meta : | (FStarC_Syntax_Syntax.Meta_labeled (s1, r1, uu___), FStarC_Syntax_Syntax.Meta_labeled (s2, r2, uu___1)) -> (s1 = s2) && - (let uu___2 = FStarC_Compiler_Range_Ops.compare r1 r2 in + (let uu___2 = FStarC_Range_Ops.compare r1 r2 in uu___2 = Prims.int_zero) | (FStarC_Syntax_Syntax.Meta_desugared msi1, FStarC_Syntax_Syntax.Meta_desugared msi2) -> msi1 = msi2 @@ -1178,7 +1174,7 @@ and (equal_lazyinfo : = fun l1 -> fun l2 -> - FStarC_Compiler_Util.physical_equality l1.FStarC_Syntax_Syntax.blob + FStarC_Util.physical_equality l1.FStarC_Syntax_Syntax.blob l2.FStarC_Syntax_Syntax.blob and (equal_quoteinfo : FStarC_Syntax_Syntax.quoteinfo -> diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_InstFV.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_InstFV.ml similarity index 95% rename from stage0/fstar-lib/generated/FStarC_Syntax_InstFV.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_InstFV.ml index e72c4fdc410..009445ad1f7 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_InstFV.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_InstFV.ml @@ -89,7 +89,7 @@ let rec (inst : FStarC_Syntax_Syntax.rc_opt1 = lopt;_} -> let pats1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (p, wopt, t3) -> @@ -142,7 +142,7 @@ let rec (inst : -> let lbs1 = let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___1 = inst s lb.FStarC_Syntax_Syntax.lbtyp in let uu___2 = inst s lb.FStarC_Syntax_Syntax.lbdef in @@ -180,7 +180,7 @@ let rec (inst : let uu___2 = inst s t2 in let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_List.map (inst_args s) args in + let uu___5 = FStarC_List.map (inst_args s) args in (bvs, uu___5) in FStarC_Syntax_Syntax.Meta_pattern uu___4 in { @@ -235,7 +235,7 @@ and (inst_binder : FStarC_Syntax_Syntax.sort = uu___2 } in let uu___1 = - FStarC_Compiler_List.map (inst s) b.FStarC_Syntax_Syntax.binder_attrs in + FStarC_List.map (inst s) b.FStarC_Syntax_Syntax.binder_attrs in { FStarC_Syntax_Syntax.binder_bv = uu___; FStarC_Syntax_Syntax.binder_qual = @@ -248,7 +248,7 @@ and (inst_binders : (FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.term) -> FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.binders) - = fun s -> fun bs -> FStarC_Compiler_List.map (inst_binder s) bs + = fun s -> fun bs -> FStarC_List.map (inst_binder s) bs and (inst_args : (FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.term) @@ -262,7 +262,7 @@ and (inst_args : = fun s -> fun args -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (a, imp) -> let uu___1 = inst s a in (uu___1, imp)) args @@ -285,7 +285,7 @@ and (inst_comp : let uu___ = inst s ct.FStarC_Syntax_Syntax.result_typ in let uu___1 = inst_args s ct.FStarC_Syntax_Syntax.effect_args in let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.DECREASES dec_order -> @@ -313,7 +313,7 @@ and (inst_decreases_order : fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Decreases_lex l -> - let uu___1 = FStarC_Compiler_List.map (inst s) l in + let uu___1 = FStarC_List.map (inst s) l in FStarC_Syntax_Syntax.Decreases_lex uu___1 | FStarC_Syntax_Syntax.Decreases_wf (rel, e) -> let uu___1 = @@ -334,8 +334,8 @@ and (inst_lcomp_opt : | FStar_Pervasives_Native.Some rc -> let uu___ = let uu___1 = - FStarC_Compiler_Util.map_opt - rc.FStarC_Syntax_Syntax.residual_typ (inst s) in + FStarC_Util.map_opt rc.FStarC_Syntax_Syntax.residual_typ + (inst s) in { FStarC_Syntax_Syntax.residual_effect = (rc.FStarC_Syntax_Syntax.residual_effect); @@ -366,7 +366,7 @@ and (inst_ascription : let uu___1 = inst s t in FStar_Pervasives.Inl uu___1 | FStar_Pervasives.Inr c -> let uu___1 = inst_comp s c in FStar_Pervasives.Inr uu___1 in - let topt1 = FStarC_Compiler_Util.map_opt topt (inst s) in + let topt1 = FStarC_Util.map_opt topt (inst s) in (annot1, topt1, use_eq) let (instantiate : inst_t -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = @@ -377,7 +377,7 @@ let (instantiate : | uu___ -> let inst_fv t1 fv = let uu___1 = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___2 -> match uu___2 with | (x, uu___3) -> diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_MutRecTy.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_MutRecTy.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_Syntax_MutRecTy.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_MutRecTy.ml index 84ab48511b8..89ab7d0f675 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_MutRecTy.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_MutRecTy.ml @@ -3,7 +3,7 @@ let (disentangle_abbrevs_from_bundle : FStarC_Syntax_Syntax.sigelt Prims.list -> FStarC_Syntax_Syntax.qualifier Prims.list -> FStarC_Ident.lident Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.sigelt * FStarC_Syntax_Syntax.sigelt Prims.list)) = @@ -12,7 +12,7 @@ let (disentangle_abbrevs_from_bundle : fun members -> fun rng -> let sigattrs = - FStarC_Compiler_List.collect + FStarC_List.collect (fun s -> match s.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ uu___ -> @@ -22,7 +22,7 @@ let (disentangle_abbrevs_from_bundle : | uu___ -> []) sigelts in let sigattrs1 = FStarC_Syntax_Util.deduplicate_terms sigattrs in let type_abbrev_sigelts = - FStarC_Compiler_List.collect + FStarC_List.collect (fun x -> match x.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_let @@ -63,7 +63,7 @@ let (disentangle_abbrevs_from_bundle : }, []) | uu___ -> let type_abbrevs = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> match x.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_let @@ -87,16 +87,13 @@ let (disentangle_abbrevs_from_bundle : "mutrecty: disentangle_abbrevs_from_bundle: type_abbrevs: impossible") type_abbrev_sigelts in let unfolded_type_abbrevs = - let rev_unfolded_type_abbrevs = - FStarC_Compiler_Util.mk_ref [] in - let in_progress = FStarC_Compiler_Util.mk_ref [] in - let not_unfolded_yet = - FStarC_Compiler_Util.mk_ref type_abbrev_sigelts in + let rev_unfolded_type_abbrevs = FStarC_Util.mk_ref [] in + let in_progress = FStarC_Util.mk_ref [] in + let not_unfolded_yet = FStarC_Util.mk_ref type_abbrev_sigelts in let remove_not_unfolded lid = let uu___1 = - let uu___2 = - FStarC_Compiler_Effect.op_Bang not_unfolded_yet in - FStarC_Compiler_List.filter + let uu___2 = FStarC_Effect.op_Bang not_unfolded_yet in + FStarC_List.filter (fun x -> match x.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_let @@ -119,8 +116,7 @@ let (disentangle_abbrevs_from_bundle : (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in Prims.op_Negation uu___11 | uu___3 -> true) uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals not_unfolded_yet - uu___1 in + FStarC_Effect.op_Colon_Equals not_unfolded_yet uu___1 in let rec unfold_abbrev_fv t fv = let replacee x = match x.FStarC_Syntax_Syntax.sigel with @@ -171,21 +167,18 @@ let (disentangle_abbrevs_from_bundle : | uu___1 -> FStar_Pervasives_Native.None in let uu___1 = let uu___2 = - FStarC_Compiler_Effect.op_Bang - rev_unfolded_type_abbrevs in - FStarC_Compiler_Util.find_map uu___2 replacee_term in + FStarC_Effect.op_Bang rev_unfolded_type_abbrevs in + FStarC_Util.find_map uu___2 replacee_term in match uu___1 with | FStar_Pervasives_Native.Some x -> x | FStar_Pervasives_Native.None -> let uu___2 = - FStarC_Compiler_Util.find_map type_abbrev_sigelts - replacee in + FStarC_Util.find_map type_abbrev_sigelts replacee in (match uu___2 with | FStar_Pervasives_Native.Some se -> let uu___3 = - let uu___4 = - FStarC_Compiler_Effect.op_Bang in_progress in - FStarC_Compiler_List.existsb + let uu___4 = FStarC_Effect.op_Bang in_progress in + FStarC_List.existsb (fun x -> FStarC_Ident.lid_equals x (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v) @@ -196,7 +189,7 @@ let (disentangle_abbrevs_from_bundle : let uu___4 = FStarC_Ident.string_of_lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Cycle on %s in mutually recursive type abbreviations" uu___4 in FStarC_Errors.raise_error @@ -216,7 +209,7 @@ let (disentangle_abbrevs_from_bundle : FStarC_Syntax_Syntax.lids1 = uu___1;_} -> let quals1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Noeq -> false @@ -230,11 +223,9 @@ let (disentangle_abbrevs_from_bundle : failwith "mutrecty: disentangle_abbrevs_from_bundle: rename_abbrev: lid: impossible" in ((let uu___3 = - let uu___4 = - FStarC_Compiler_Effect.op_Bang in_progress in + let uu___4 = FStarC_Effect.op_Bang in_progress in lid :: uu___4 in - FStarC_Compiler_Effect.op_Colon_Equals in_progress - uu___3); + FStarC_Effect.op_Colon_Equals in_progress uu___3); (match () with | () -> (remove_not_unfolded lid; @@ -272,7 +263,7 @@ let (disentangle_abbrevs_from_bundle : } in ((let uu___5 = let uu___6 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang rev_unfolded_type_abbrevs in { FStarC_Syntax_Syntax.sigel = sigelt'; @@ -290,42 +281,40 @@ let (disentangle_abbrevs_from_bundle : FStarC_Syntax_Syntax.sigopts = (x.FStarC_Syntax_Syntax.sigopts) } :: uu___6 in - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals rev_unfolded_type_abbrevs uu___5); (match () with | () -> ((let uu___6 = let uu___7 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang in_progress in - FStarC_Compiler_List.tl uu___7 in - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_List.tl uu___7 in + FStarC_Effect.op_Colon_Equals in_progress uu___6); (match () with | () -> tm')))))))) | uu___1 -> failwith "mutrecty: disentangle_abbrevs_from_bundle: rename_abbrev: impossible" in let rec aux uu___1 = - let uu___2 = - FStarC_Compiler_Effect.op_Bang not_unfolded_yet in + let uu___2 = FStarC_Effect.op_Bang not_unfolded_yet in match uu___2 with | x::uu___3 -> let _unused = unfold_abbrev x in aux () | uu___3 -> let uu___4 = - FStarC_Compiler_Effect.op_Bang - rev_unfolded_type_abbrevs in - FStarC_Compiler_List.rev uu___4 in + FStarC_Effect.op_Bang rev_unfolded_type_abbrevs in + FStarC_List.rev uu___4 in aux () in let filter_out_type_abbrevs l = - FStarC_Compiler_List.filter + FStarC_List.filter (fun lid -> - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun lid' -> let uu___1 = FStarC_Ident.lid_equals lid lid' in Prims.op_Negation uu___1) type_abbrevs) l in let inductives_with_abbrevs_unfolded = let find_in_unfolded fv = - FStarC_Compiler_Util.find_map unfolded_type_abbrevs + FStarC_Util.find_map unfolded_type_abbrevs (fun x -> match x.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_let @@ -440,7 +429,7 @@ let (disentangle_abbrevs_from_bundle : | uu___1 -> failwith "mutrecty: inductives_with_abbrevs_unfolded: unfold_in_sig: impossible" in - FStarC_Compiler_List.collect unfold_in_sig sigelts in + FStarC_List.collect unfold_in_sig sigelts in let new_members = filter_out_type_abbrevs members in let new_bundle = { diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Print.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print.ml similarity index 85% rename from stage0/fstar-lib/generated/FStarC_Syntax_Print.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print.ml index c2cdcf8c141..e177743b0f6 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Print.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print.ml @@ -38,8 +38,7 @@ let (db_to_string : FStarC_Syntax_Syntax.bv -> Prims.string) = fun bv -> let uu___ = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in let uu___1 = - let uu___2 = - FStarC_Compiler_Util.string_of_int bv.FStarC_Syntax_Syntax.index in + let uu___2 = FStarC_Util.string_of_int bv.FStarC_Syntax_Syntax.index in Prims.strcat "@" uu___2 in Prims.strcat uu___ uu___1 let (filter_imp : @@ -63,7 +62,7 @@ let filter_imp_args : FStar_Pervasives_Native.option) Prims.list = fun args -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___ -> match uu___ with | (uu___1, FStar_Pervasives_Native.None) -> true @@ -74,7 +73,7 @@ let (filter_imp_binders : FStarC_Syntax_Syntax.binder Prims.list) = fun bs -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun b -> filter_imp b.FStarC_Syntax_Syntax.binder_qual) bs let (const_to_string : FStarC_Const.sconst -> Prims.string) = FStarC_Parser_Const.const_to_string @@ -95,19 +94,17 @@ let (uvar_to_string : FStarC_Syntax_Syntax.uvar -> Prims.string) = else (let uu___2 = let uu___3 = FStarC_Syntax_Unionfind.uvar_id u in - FStarC_Compiler_Util.string_of_int uu___3 in + FStarC_Util.string_of_int uu___3 in Prims.strcat "?" uu___2) let (version_to_string : FStarC_Syntax_Syntax.version -> Prims.string) = fun v -> - let uu___ = - FStarC_Compiler_Util.string_of_int v.FStarC_Syntax_Syntax.major in - let uu___1 = - FStarC_Compiler_Util.string_of_int v.FStarC_Syntax_Syntax.minor in - FStarC_Compiler_Util.format2 "%s.%s" uu___ uu___1 + let uu___ = FStarC_Util.string_of_int v.FStarC_Syntax_Syntax.major in + let uu___1 = FStarC_Util.string_of_int v.FStarC_Syntax_Syntax.minor in + FStarC_Util.format2 "%s.%s" uu___ uu___1 let (univ_uvar_to_string : (FStarC_Syntax_Syntax.universe FStar_Pervasives_Native.option FStarC_Unionfind.p_uvar * FStarC_Syntax_Syntax.version * - FStarC_Compiler_Range_Type.range) -> Prims.string) + FStarC_Range_Type.range) -> Prims.string) = fun u -> let uu___ = FStarC_Options.hide_uvar_nums () in @@ -117,7 +114,7 @@ let (univ_uvar_to_string : (let uu___2 = let uu___3 = let uu___4 = FStarC_Syntax_Unionfind.univ_uvar_id u in - FStarC_Compiler_Util.string_of_int uu___4 in + FStarC_Util.string_of_int uu___4 in let uu___4 = let uu___5 = match u with | (uu___6, u1, uu___7) -> version_to_string u1 in @@ -150,29 +147,29 @@ let rec (univ_to_string : FStarC_Syntax_Syntax.universe -> Prims.string) = let uu___2 = FStarC_Ident.string_of_id x in Prims.strcat "U_name " uu___2 | FStarC_Syntax_Syntax.U_bvar x -> - let uu___2 = FStarC_Compiler_Util.string_of_int x in + let uu___2 = FStarC_Util.string_of_int x in Prims.strcat "@" uu___2 | FStarC_Syntax_Syntax.U_zero -> "0" | FStarC_Syntax_Syntax.U_succ u1 -> let uu___2 = int_of_univ Prims.int_one u1 in (match uu___2 with | (n, FStar_Pervasives_Native.None) -> - FStarC_Compiler_Util.string_of_int n + FStarC_Util.string_of_int n | (n, FStar_Pervasives_Native.Some u2) -> let uu___3 = univ_to_string u2 in - let uu___4 = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format2 "(%s + %s)" uu___3 uu___4) + let uu___4 = FStarC_Util.string_of_int n in + FStarC_Util.format2 "(%s + %s)" uu___3 uu___4) | FStarC_Syntax_Syntax.U_max us -> let uu___2 = - let uu___3 = FStarC_Compiler_List.map univ_to_string us in - FStarC_Compiler_String.concat ", " uu___3 in - FStarC_Compiler_Util.format1 "(max %s)" uu___2 + let uu___3 = FStarC_List.map univ_to_string us in + FStarC_String.concat ", " uu___3 in + FStarC_Util.format1 "(max %s)" uu___2 | FStarC_Syntax_Syntax.U_unknown -> "unknown") let (univs_to_string : FStarC_Syntax_Syntax.universe Prims.list -> Prims.string) = fun us -> - let uu___ = FStarC_Compiler_List.map univ_to_string us in - FStarC_Compiler_String.concat ", " uu___ + let uu___ = FStarC_List.map univ_to_string us in + FStarC_String.concat ", " uu___ let (qual_to_string : FStarC_Syntax_Syntax.qualifier -> Prims.string) = fun uu___ -> match uu___ with @@ -191,38 +188,37 @@ let (qual_to_string : FStarC_Syntax_Syntax.qualifier -> Prims.string) = | FStarC_Syntax_Syntax.TotalEffect -> "total" | FStarC_Syntax_Syntax.Discriminator l -> let uu___1 = lid_to_string l in - FStarC_Compiler_Util.format1 "(Discriminator %s)" uu___1 + FStarC_Util.format1 "(Discriminator %s)" uu___1 | FStarC_Syntax_Syntax.Projector (l, x) -> let uu___1 = lid_to_string l in let uu___2 = FStarC_Ident.string_of_id x in - FStarC_Compiler_Util.format2 "(Projector %s %s)" uu___1 uu___2 + FStarC_Util.format2 "(Projector %s %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.RecordType (ns, fns) -> let uu___1 = let uu___2 = FStarC_Ident.path_of_ns ns in FStarC_Ident.text_of_path uu___2 in let uu___2 = - let uu___3 = FStarC_Compiler_List.map FStarC_Ident.string_of_id fns in - FStarC_Compiler_String.concat ", " uu___3 in - FStarC_Compiler_Util.format2 "(RecordType %s %s)" uu___1 uu___2 + let uu___3 = FStarC_List.map FStarC_Ident.string_of_id fns in + FStarC_String.concat ", " uu___3 in + FStarC_Util.format2 "(RecordType %s %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.RecordConstructor (ns, fns) -> let uu___1 = let uu___2 = FStarC_Ident.path_of_ns ns in FStarC_Ident.text_of_path uu___2 in let uu___2 = - let uu___3 = FStarC_Compiler_List.map FStarC_Ident.string_of_id fns in - FStarC_Compiler_String.concat ", " uu___3 in - FStarC_Compiler_Util.format2 "(RecordConstructor %s %s)" uu___1 - uu___2 + let uu___3 = FStarC_List.map FStarC_Ident.string_of_id fns in + FStarC_String.concat ", " uu___3 in + FStarC_Util.format2 "(RecordConstructor %s %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.Action eff_lid -> let uu___1 = lid_to_string eff_lid in - FStarC_Compiler_Util.format1 "(Action %s)" uu___1 + FStarC_Util.format1 "(Action %s)" uu___1 | FStarC_Syntax_Syntax.ExceptionConstructor -> "ExceptionConstructor" | FStarC_Syntax_Syntax.HasMaskedEffect -> "HasMaskedEffect" | FStarC_Syntax_Syntax.Effect -> "Effect" | FStarC_Syntax_Syntax.Reifiable -> "reify" | FStarC_Syntax_Syntax.Reflectable l -> let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 "(reflect %s)" uu___1 + FStarC_Util.format1 "(reflect %s)" uu___1 | FStarC_Syntax_Syntax.OnlyName -> "OnlyName" let (quals_to_string : FStarC_Syntax_Syntax.qualifier Prims.list -> Prims.string) = @@ -230,8 +226,8 @@ let (quals_to_string : match quals with | [] -> "" | uu___ -> - let uu___1 = FStarC_Compiler_List.map qual_to_string quals in - FStarC_Compiler_String.concat " " uu___1 + let uu___1 = FStarC_List.map qual_to_string quals in + FStarC_String.concat " " uu___1 let (quals_to_string' : FStarC_Syntax_Syntax.qualifier Prims.list -> Prims.string) = fun quals -> @@ -437,29 +433,29 @@ let (subst_elt_to_string : FStarC_Syntax_Syntax.subst_elt -> Prims.string) = fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.DB (i, x) -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in let uu___2 = bv_to_string x in - FStarC_Compiler_Util.format2 "DB (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "DB (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.DT (i, t) -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in let uu___2 = term_to_string t in - FStarC_Compiler_Util.format2 "DT (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "DT (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.NM (x, i) -> let uu___1 = bv_to_string x in - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format2 "NM (%s, %s)" uu___1 uu___2 + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format2 "NM (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.NT (x, t) -> let uu___1 = bv_to_string x in let uu___2 = term_to_string t in - FStarC_Compiler_Util.format2 "NT (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "NT (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.UN (i, u) -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in let uu___2 = univ_to_string u in - FStarC_Compiler_Util.format2 "UN (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "UN (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.UD (u, i) -> let uu___1 = FStarC_Ident.string_of_id u in - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format2 "UD (%s, %s)" uu___1 uu___2 + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format2 "UD (%s, %s)" uu___1 uu___2 let (modul_to_string : FStarC_Syntax_Syntax.modul -> Prims.string) = fun m -> let uu___ = @@ -467,45 +463,42 @@ let (modul_to_string : FStarC_Syntax_Syntax.modul -> Prims.string) = m.FStarC_Syntax_Syntax.name in let uu___1 = let uu___2 = - FStarC_Compiler_List.map sigelt_to_string - m.FStarC_Syntax_Syntax.declarations in - FStarC_Compiler_String.concat "\n" uu___2 in - FStarC_Compiler_Util.format2 "module %s\nDeclarations: [\n%s\n]\n" uu___ - uu___1 + FStarC_List.map sigelt_to_string m.FStarC_Syntax_Syntax.declarations in + FStarC_String.concat "\n" uu___2 in + FStarC_Util.format2 "module %s\nDeclarations: [\n%s\n]\n" uu___ uu___1 let (metadata_to_string : FStarC_Syntax_Syntax.metadata -> Prims.string) = fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Meta_pattern (uu___1, ps) -> let pats = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun args -> let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (t, uu___5) -> term_to_string t) args in - FStarC_Compiler_String.concat "; " uu___3) ps in - FStarC_Compiler_String.concat "\\/" uu___2 in - FStarC_Compiler_Util.format1 "{Meta_pattern %s}" pats + FStarC_String.concat "; " uu___3) ps in + FStarC_String.concat "\\/" uu___2 in + FStarC_Util.format1 "{Meta_pattern %s}" pats | FStarC_Syntax_Syntax.Meta_named lid -> - let uu___1 = sli lid in - FStarC_Compiler_Util.format1 "{Meta_named %s}" uu___1 + let uu___1 = sli lid in FStarC_Util.format1 "{Meta_named %s}" uu___1 | FStarC_Syntax_Syntax.Meta_labeled (l, r, uu___1) -> let uu___2 = FStarC_Errors_Msg.rendermsg l in - let uu___3 = FStarC_Compiler_Range_Ops.string_of_range r in - FStarC_Compiler_Util.format2 "{Meta_labeled (%s, %s)}" uu___2 uu___3 + let uu___3 = FStarC_Range_Ops.string_of_range r in + FStarC_Util.format2 "{Meta_labeled (%s, %s)}" uu___2 uu___3 | FStarC_Syntax_Syntax.Meta_desugared msi -> "{Meta_desugared}" | FStarC_Syntax_Syntax.Meta_monadic (m, t) -> let uu___1 = sli m in let uu___2 = term_to_string t in - FStarC_Compiler_Util.format2 "{Meta_monadic(%s @ %s)}" uu___1 uu___2 + FStarC_Util.format2 "{Meta_monadic(%s @ %s)}" uu___1 uu___2 | FStarC_Syntax_Syntax.Meta_monadic_lift (m, m', t) -> let uu___1 = sli m in let uu___2 = sli m' in let uu___3 = term_to_string t in - FStarC_Compiler_Util.format3 "{Meta_monadic_lift(%s -> %s @ %s)}" - uu___1 uu___2 uu___3 + FStarC_Util.format3 "{Meta_monadic_lift(%s -> %s @ %s)}" uu___1 + uu___2 uu___3 let (showable_term : FStarC_Syntax_Syntax.term FStarC_Class_Show.showable) = { FStarC_Class_Show.show = term_to_string } let (showable_univ : @@ -528,13 +521,13 @@ let (showable_uvar : FStarC_Syntax_Syntax.uvar FStarC_Class_Show.showable) = let (ctx_uvar_to_string : FStarC_Syntax_Syntax.ctx_uvar -> Prims.string) = fun ctx_uvar -> let reason_string = - FStarC_Compiler_Util.format1 "(* %s *)\n" + FStarC_Util.format1 "(* %s *)\n" ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_reason in let uu___ = let uu___1 = - FStarC_Compiler_List.map (FStarC_Class_Show.show showable_binder) + FStarC_List.map (FStarC_Class_Show.show showable_binder) ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_binders in - FStarC_Compiler_String.concat ", " uu___1 in + FStarC_String.concat ", " uu___1 in let uu___1 = uvar_to_string ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_head in let uu___2 = let uu___3 = FStarC_Syntax_Util.ctx_uvar_typ ctx_uvar in @@ -549,8 +542,8 @@ let (ctx_uvar_to_string : FStarC_Syntax_Syntax.ctx_uvar -> Prims.string) = | FStarC_Syntax_Syntax.Allow_ghost s -> Prims.strcat "Allow_ghost " s | FStarC_Syntax_Syntax.Strict -> "Strict" | FStarC_Syntax_Syntax.Already_checked -> "Already_checked" in - FStarC_Compiler_Util.format5 "%s(%s |- %s : %s) %s" reason_string uu___ - uu___1 uu___2 uu___3 + FStarC_Util.format5 "%s(%s |- %s : %s) %s" reason_string uu___ uu___1 + uu___2 uu___3 let (showable_ctxu : FStarC_Syntax_Syntax.ctx_uvar FStarC_Class_Show.showable) = { FStarC_Class_Show.show = ctx_uvar_to_string } @@ -610,6 +603,12 @@ let (showable_ctx_uvar_meta : let uu___1 = FStarC_Class_Show.show showable_term r in Prims.strcat "Ctx_uvar_meta_tac " uu___1) } +let (showable_bqual : + FStarC_Syntax_Syntax.binder_qualifier FStarC_Class_Show.showable) = + { + FStarC_Class_Show.show = + (fun b -> bqual_to_string (FStar_Pervasives_Native.Some b)) + } let (showable_aqual : FStarC_Syntax_Syntax.aqual FStarC_Class_Show.showable) = { FStarC_Class_Show.show = aqual_to_string } let (tscheme_to_string : FStarC_Syntax_Syntax.tscheme -> Prims.string) = @@ -618,21 +617,27 @@ let (tscheme_to_string : FStarC_Syntax_Syntax.tscheme -> Prims.string) = if uu___ then FStarC_Syntax_Print_Ugly.tscheme_to_string ts else FStarC_Syntax_Print_Pretty.tscheme_to_string ts +let (tscheme_to_doc : FStarC_Syntax_Syntax.tscheme -> FStarC_Pprint.document) + = + fun ts -> + let uu___ = FStarC_Options.ugly () in + if uu___ + then + let uu___1 = FStarC_Syntax_Print_Ugly.tscheme_to_string ts in + FStarC_Pprint.arbitrary_string uu___1 + else FStarC_Syntax_Print_Pretty.tscheme_to_doc ts let (sub_eff_to_string : FStarC_Syntax_Syntax.sub_eff -> Prims.string) = fun se -> let tsopt_to_string ts_opt = - if FStarC_Compiler_Util.is_some ts_opt - then - let uu___ = FStarC_Compiler_Util.must ts_opt in - tscheme_to_string uu___ + if FStarC_Util.is_some ts_opt + then let uu___ = FStarC_Util.must ts_opt in tscheme_to_string uu___ else "" in let uu___ = lid_to_string se.FStarC_Syntax_Syntax.source in let uu___1 = lid_to_string se.FStarC_Syntax_Syntax.target in let uu___2 = tsopt_to_string se.FStarC_Syntax_Syntax.lift in let uu___3 = tsopt_to_string se.FStarC_Syntax_Syntax.lift_wp in - FStarC_Compiler_Util.format4 - "sub_effect %s ~> %s : lift = %s ;; lift_wp = %s" uu___ uu___1 uu___2 - uu___3 + FStarC_Util.format4 "sub_effect %s ~> %s : lift = %s ;; lift_wp = %s" + uu___ uu___1 uu___2 uu___3 let (showable_sub_eff : FStarC_Syntax_Syntax.sub_eff FStarC_Class_Show.showable) = { FStarC_Class_Show.show = sub_eff_to_string } @@ -672,6 +677,14 @@ let (pretty_bv : FStarC_Syntax_Syntax.bv FStarC_Class_PP.pretty) = let uu___ = FStarC_Class_Show.show showable_bv x in FStarC_Pprint.doc_of_string uu___) } +let (pretty_qualifier : + FStarC_Syntax_Syntax.qualifier FStarC_Class_PP.pretty) = + { + FStarC_Class_PP.pp = + (fun x -> + let uu___ = FStarC_Class_Show.show showable_qualifier x in + FStarC_Pprint.doc_of_string uu___) + } let (pretty_binding : FStarC_Syntax_Syntax.binding FStarC_Class_PP.pretty) = { FStarC_Class_PP.pp = @@ -708,7 +721,7 @@ let rec (sigelt_to_string_short : FStarC_Syntax_Syntax.lids1 = uu___6;_} -> let uu___7 = lbname_to_string lb in - FStarC_Compiler_Util.format1 "let %s" uu___7 + FStarC_Util.format1 "let %s" uu___7 | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = @@ -723,17 +736,17 @@ let rec (sigelt_to_string_short : FStarC_Syntax_Syntax.lids1 = uu___6;_} -> let uu___7 = lbname_to_string lb in - FStarC_Compiler_Util.format1 "let rec %s" uu___7 + FStarC_Util.format1 "let rec %s" uu___7 | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = (true, lbs); FStarC_Syntax_Syntax.lids1 = uu___;_} -> let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> lbname_to_string lb.FStarC_Syntax_Syntax.lbname) lbs in - FStarC_Compiler_String.concat " and " uu___2 in - FStarC_Compiler_Util.format1 "let rec %s" uu___1 + FStarC_String.concat " and " uu___2 in + FStarC_Util.format1 "let rec %s" uu___1 | FStarC_Syntax_Syntax.Sig_let uu___ -> failwith "Impossible: sigelt_to_string_short, ill-formed let" | FStarC_Syntax_Syntax.Sig_declare_typ @@ -741,7 +754,7 @@ let rec (sigelt_to_string_short : FStarC_Syntax_Syntax.t2 = uu___1;_} -> let uu___2 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format1 "val %s" uu___2 + FStarC_Util.format1 "val %s" uu___2 | FStarC_Syntax_Syntax.Sig_inductive_typ { FStarC_Syntax_Syntax.lid = lid; FStarC_Syntax_Syntax.us = uu___; FStarC_Syntax_Syntax.params = uu___1; @@ -752,7 +765,7 @@ let rec (sigelt_to_string_short : FStarC_Syntax_Syntax.injective_type_params = uu___6;_} -> let uu___7 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format1 "type %s" uu___7 + FStarC_Util.format1 "type %s" uu___7 | FStarC_Syntax_Syntax.Sig_datacon { FStarC_Syntax_Syntax.lid1 = lid; FStarC_Syntax_Syntax.us1 = uu___; FStarC_Syntax_Syntax.t1 = uu___1; @@ -763,19 +776,17 @@ let rec (sigelt_to_string_short : -> let uu___5 = FStarC_Ident.string_of_lid lid in let uu___6 = FStarC_Ident.string_of_lid t_lid in - FStarC_Compiler_Util.format2 "datacon %s for type %s" uu___5 uu___6 + FStarC_Util.format2 "datacon %s for type %s" uu___5 uu___6 | FStarC_Syntax_Syntax.Sig_assume { FStarC_Syntax_Syntax.lid3 = lid; FStarC_Syntax_Syntax.us3 = uu___; FStarC_Syntax_Syntax.phi1 = uu___1;_} -> let uu___2 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format1 "assume %s" uu___2 + FStarC_Util.format1 "assume %s" uu___2 | FStarC_Syntax_Syntax.Sig_bundle { FStarC_Syntax_Syntax.ses = ses; FStarC_Syntax_Syntax.lids = uu___;_} - -> - let uu___1 = FStarC_Compiler_List.hd ses in - sigelt_to_string_short uu___1 + -> let uu___1 = FStarC_List.hd ses in sigelt_to_string_short uu___1 | FStarC_Syntax_Syntax.Sig_fail { FStarC_Syntax_Syntax.errs = uu___; FStarC_Syntax_Syntax.rng1 = uu___1; @@ -783,9 +794,8 @@ let rec (sigelt_to_string_short : FStarC_Syntax_Syntax.ses1 = ses;_} -> let uu___3 = - let uu___4 = FStarC_Compiler_List.hd ses in - sigelt_to_string_short uu___4 in - FStarC_Compiler_Util.format1 "[@@expect_failure] %s" uu___3 + let uu___4 = FStarC_List.hd ses in sigelt_to_string_short uu___4 in + FStarC_Util.format1 "[@@expect_failure] %s" uu___3 | FStarC_Syntax_Syntax.Sig_new_effect ed -> let kw = let uu___ = FStarC_Syntax_Util.is_layered ed in @@ -795,11 +805,11 @@ let rec (sigelt_to_string_short : (let uu___2 = FStarC_Syntax_Util.is_dm4f ed in if uu___2 then "new_effect_for_free" else "new_effect") in let uu___ = lid_to_string ed.FStarC_Syntax_Syntax.mname in - FStarC_Compiler_Util.format2 "%s { %s ... }" kw uu___ + FStarC_Util.format2 "%s { %s ... }" kw uu___ | FStarC_Syntax_Syntax.Sig_sub_effect se -> let uu___ = lid_to_string se.FStarC_Syntax_Syntax.source in let uu___1 = lid_to_string se.FStarC_Syntax_Syntax.target in - FStarC_Compiler_Util.format2 "sub_effect %s ~> %s" uu___ uu___1 + FStarC_Util.format2 "sub_effect %s ~> %s" uu___ uu___1 | FStarC_Syntax_Syntax.Sig_effect_abbrev { FStarC_Syntax_Syntax.lid4 = l; FStarC_Syntax_Syntax.us4 = uu___; FStarC_Syntax_Syntax.bs2 = tps; FStarC_Syntax_Syntax.comp1 = c; @@ -808,21 +818,19 @@ let rec (sigelt_to_string_short : let uu___2 = sli l in let uu___3 = let uu___4 = - FStarC_Compiler_List.map (FStarC_Class_Show.show showable_binder) - tps in - FStarC_Compiler_String.concat " " uu___4 in + FStarC_List.map (FStarC_Class_Show.show showable_binder) tps in + FStarC_String.concat " " uu___4 in let uu___4 = FStarC_Class_Show.show showable_comp c in - FStarC_Compiler_Util.format3 "effect %s %s = %s" uu___2 uu___3 uu___4 + FStarC_Util.format3 "effect %s %s = %s" uu___2 uu___3 uu___4 | FStarC_Syntax_Syntax.Sig_splice { FStarC_Syntax_Syntax.is_typed = is_typed; FStarC_Syntax_Syntax.lids2 = lids; FStarC_Syntax_Syntax.tac = uu___;_} -> let uu___1 = - let uu___2 = - FStarC_Compiler_List.map FStarC_Ident.string_of_lid lids in - FStarC_Compiler_String.concat "; " uu___2 in - FStarC_Compiler_Util.format3 "%splice%s[%s] (...)" "%s" + let uu___2 = FStarC_List.map FStarC_Ident.string_of_lid lids in + FStarC_String.concat "; " uu___2 in + FStarC_Util.format3 "%splice%s[%s] (...)" "%s" (if is_typed then "_t" else "") uu___1 | FStarC_Syntax_Syntax.Sig_polymonadic_bind { FStarC_Syntax_Syntax.m_lid = m; FStarC_Syntax_Syntax.n_lid = n; @@ -833,8 +841,8 @@ let rec (sigelt_to_string_short : let uu___3 = FStarC_Ident.string_of_lid m in let uu___4 = FStarC_Ident.string_of_lid n in let uu___5 = FStarC_Ident.string_of_lid p in - FStarC_Compiler_Util.format3 "polymonadic_bind (%s, %s) |> %s" uu___3 - uu___4 uu___5 + FStarC_Util.format3 "polymonadic_bind (%s, %s) |> %s" uu___3 uu___4 + uu___5 | FStarC_Syntax_Syntax.Sig_polymonadic_subcomp { FStarC_Syntax_Syntax.m_lid1 = m; FStarC_Syntax_Syntax.n_lid1 = n; FStarC_Syntax_Syntax.tm4 = uu___; @@ -843,8 +851,7 @@ let rec (sigelt_to_string_short : -> let uu___3 = FStarC_Ident.string_of_lid m in let uu___4 = FStarC_Ident.string_of_lid n in - FStarC_Compiler_Util.format2 "polymonadic_subcomp %s <: %s" uu___3 - uu___4 + FStarC_Util.format2 "polymonadic_subcomp %s <: %s" uu___3 uu___4 let (binder_to_json : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.binder -> FStarC_Json.json) = @@ -866,7 +873,7 @@ let (binders_to_json : = fun env -> fun bs -> - let uu___ = FStarC_Compiler_List.map (binder_to_json env) bs in + let uu___ = FStarC_List.map (binder_to_json env) bs in FStarC_Json.JsonList uu___ let (eff_decl_to_string : FStarC_Syntax_Syntax.eff_decl -> Prims.string) = fun ed -> @@ -880,14 +887,14 @@ let (showable_eff_decl : let (args_to_string : FStarC_Syntax_Syntax.args -> Prims.string) = fun args -> let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (a, q) -> let uu___2 = aqual_to_string q in let uu___3 = term_to_string a in Prims.strcat uu___2 uu___3) args in - FStarC_Compiler_String.concat " " uu___ + FStarC_String.concat " " uu___ let (showable_decreases_order : FStarC_Syntax_Syntax.decreases_order FStarC_Class_Show.showable) = { @@ -936,9 +943,8 @@ let (binder_to_string_with_type : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map - (FStarC_Class_Show.show showable_term) ts in - FStarC_Compiler_String.concat ", " uu___3 in + FStarC_List.map (FStarC_Class_Show.show showable_term) ts in + FStarC_String.concat ", " uu___3 in Prims.strcat uu___2 "] " in Prims.strcat "[@@@" uu___1 in let uu___1 = FStarC_Syntax_Syntax.is_null_binder b in diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Print_Pretty.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print_Pretty.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_Syntax_Print_Pretty.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print_Pretty.ml index 37e4a742359..e0bc858c60f 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Print_Pretty.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print_Pretty.ml @@ -1,6 +1,5 @@ open Prims -let (rfrac : FStarC_BaseTypes.float) = - FStarC_Compiler_Util.float_of_string "1.0" +let (rfrac : FStarC_BaseTypes.float) = FStarC_Util.float_of_string "1.0" let (width : Prims.int) = (Prims.of_int (100)) let (pp : FStarC_Pprint.document -> Prims.string) = fun d -> FStarC_Pprint.pretty_string rfrac width d @@ -24,7 +23,7 @@ let (univ_to_doc' : (fun uu___ -> let e = FStarC_Syntax_Resugar.resugar_universe' env u - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Parser_ToDocument.term_to_document e) let (term_to_string' : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.term -> Prims.string) = @@ -85,7 +84,7 @@ let (univ_to_doc : FStarC_Syntax_Syntax.universe -> FStarC_Pprint.document) = (fun uu___ -> let e = FStarC_Syntax_Resugar.resugar_universe u - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Parser_ToDocument.term_to_document e) let (comp_to_doc : FStarC_Syntax_Syntax.comp -> FStarC_Pprint.document) = fun c -> @@ -127,14 +126,17 @@ let (univ_to_string : FStarC_Syntax_Syntax.universe -> Prims.string) = (fun uu___ -> let e = FStarC_Syntax_Resugar.resugar_universe u - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let d = FStarC_Parser_ToDocument.term_to_document e in pp d) -let (tscheme_to_string : FStarC_Syntax_Syntax.tscheme -> Prims.string) = +let (tscheme_to_doc : FStarC_Syntax_Syntax.tscheme -> FStarC_Pprint.document) + = fun ts -> FStarC_GenSym.with_frozen_gensym (fun uu___ -> let d = FStarC_Syntax_Resugar.resugar_tscheme ts in - let d1 = FStarC_Parser_ToDocument.decl_to_document d in pp d1) + FStarC_Parser_ToDocument.decl_to_document d) +let (tscheme_to_string : FStarC_Syntax_Syntax.tscheme -> Prims.string) = + fun ts -> let uu___ = tscheme_to_doc ts in pp uu___ let (pat_to_string : FStarC_Syntax_Syntax.pat -> Prims.string) = fun p -> FStarC_GenSym.with_frozen_gensym @@ -144,7 +146,7 @@ let (pat_to_string : FStarC_Syntax_Syntax.pat -> Prims.string) = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) ()) in FStarC_Syntax_Resugar.resugar_pat p uu___1 in let d = FStarC_Parser_ToDocument.pat_to_document e in pp d) @@ -156,7 +158,7 @@ let (binder_to_string' : (fun uu___ -> let e = FStarC_Syntax_Resugar.resugar_binder b - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let d = FStarC_Parser_ToDocument.binder_to_document e in pp d) let (eff_decl_to_string : FStarC_Syntax_Syntax.eff_decl -> Prims.string) = fun ed -> diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Print_Ugly.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print_Ugly.ml similarity index 80% rename from stage0/fstar-lib/generated/FStarC_Syntax_Print_Ugly.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print_Ugly.ml index 67b67c9382d..201506c6531 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Print_Ugly.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Print_Ugly.ml @@ -15,8 +15,7 @@ let (bv_to_string : FStarC_Syntax_Syntax.bv -> Prims.string) = fun bv -> let uu___ = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in let uu___1 = - let uu___2 = - FStarC_Compiler_Util.string_of_int bv.FStarC_Syntax_Syntax.index in + let uu___2 = FStarC_Util.string_of_int bv.FStarC_Syntax_Syntax.index in Prims.strcat "#" uu___2 in Prims.strcat uu___ uu___1 let (nm_to_string : FStarC_Syntax_Syntax.bv -> Prims.string) = @@ -29,8 +28,7 @@ let (db_to_string : FStarC_Syntax_Syntax.bv -> Prims.string) = fun bv -> let uu___ = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in let uu___1 = - let uu___2 = - FStarC_Compiler_Util.string_of_int bv.FStarC_Syntax_Syntax.index in + let uu___2 = FStarC_Util.string_of_int bv.FStarC_Syntax_Syntax.index in Prims.strcat "@" uu___2 in Prims.strcat uu___ uu___1 let (filter_imp : @@ -54,7 +52,7 @@ let filter_imp_args : FStar_Pervasives_Native.option) Prims.list = fun args -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___ -> match uu___ with | (uu___1, FStar_Pervasives_Native.None) -> true @@ -65,7 +63,7 @@ let (filter_imp_binders : FStarC_Syntax_Syntax.binder Prims.list) = fun bs -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun b -> filter_imp b.FStarC_Syntax_Syntax.binder_qual) bs let (const_to_string : FStarC_Const.sconst -> Prims.string) = FStarC_Parser_Const.const_to_string @@ -86,19 +84,17 @@ let (uvar_to_string : FStarC_Syntax_Syntax.uvar -> Prims.string) = else (let uu___2 = let uu___3 = FStarC_Syntax_Unionfind.uvar_id u in - FStarC_Compiler_Util.string_of_int uu___3 in + FStarC_Util.string_of_int uu___3 in Prims.strcat "?" uu___2) let (version_to_string : FStarC_Syntax_Syntax.version -> Prims.string) = fun v -> - let uu___ = - FStarC_Compiler_Util.string_of_int v.FStarC_Syntax_Syntax.major in - let uu___1 = - FStarC_Compiler_Util.string_of_int v.FStarC_Syntax_Syntax.minor in - FStarC_Compiler_Util.format2 "%s.%s" uu___ uu___1 + let uu___ = FStarC_Util.string_of_int v.FStarC_Syntax_Syntax.major in + let uu___1 = FStarC_Util.string_of_int v.FStarC_Syntax_Syntax.minor in + FStarC_Util.format2 "%s.%s" uu___ uu___1 let (univ_uvar_to_string : (FStarC_Syntax_Syntax.universe FStar_Pervasives_Native.option FStarC_Unionfind.p_uvar * FStarC_Syntax_Syntax.version * - FStarC_Compiler_Range_Type.range) -> Prims.string) + FStarC_Range_Type.range) -> Prims.string) = fun u -> let uu___ = FStarC_Options.hide_uvar_nums () in @@ -108,7 +104,7 @@ let (univ_uvar_to_string : (let uu___2 = let uu___3 = let uu___4 = FStarC_Syntax_Unionfind.univ_uvar_id u in - FStarC_Compiler_Util.string_of_int uu___4 in + FStarC_Util.string_of_int uu___4 in let uu___4 = let uu___5 = match u with | (uu___6, u1, uu___7) -> version_to_string u1 in @@ -141,34 +137,33 @@ let rec (univ_to_string : FStarC_Syntax_Syntax.universe -> Prims.string) = let uu___2 = FStarC_Ident.string_of_id x in Prims.strcat "U_name " uu___2 | FStarC_Syntax_Syntax.U_bvar x -> - let uu___2 = FStarC_Compiler_Util.string_of_int x in + let uu___2 = FStarC_Util.string_of_int x in Prims.strcat "@" uu___2 | FStarC_Syntax_Syntax.U_zero -> "0" | FStarC_Syntax_Syntax.U_succ u1 -> let uu___2 = int_of_univ Prims.int_one u1 in (match uu___2 with | (n, FStar_Pervasives_Native.None) -> - FStarC_Compiler_Util.string_of_int n + FStarC_Util.string_of_int n | (n, FStar_Pervasives_Native.Some u2) -> let uu___3 = univ_to_string u2 in - let uu___4 = FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format2 "(%s + %s)" uu___3 uu___4) + let uu___4 = FStarC_Util.string_of_int n in + FStarC_Util.format2 "(%s + %s)" uu___3 uu___4) | FStarC_Syntax_Syntax.U_max us -> let uu___2 = - let uu___3 = FStarC_Compiler_List.map univ_to_string us in - FStarC_Compiler_String.concat ", " uu___3 in - FStarC_Compiler_Util.format1 "(max %s)" uu___2 + let uu___3 = FStarC_List.map univ_to_string us in + FStarC_String.concat ", " uu___3 in + FStarC_Util.format1 "(max %s)" uu___2 | FStarC_Syntax_Syntax.U_unknown -> "unknown") let (univs_to_string : FStarC_Syntax_Syntax.universe Prims.list -> Prims.string) = fun us -> - let uu___ = FStarC_Compiler_List.map univ_to_string us in - FStarC_Compiler_String.concat ", " uu___ + let uu___ = FStarC_List.map univ_to_string us in + FStarC_String.concat ", " uu___ let (univ_names_to_string : FStarC_Ident.ident Prims.list -> Prims.string) = fun us -> - let uu___ = - FStarC_Compiler_List.map (fun x -> FStarC_Ident.string_of_id x) us in - FStarC_Compiler_String.concat ", " uu___ + let uu___ = FStarC_List.map (fun x -> FStarC_Ident.string_of_id x) us in + FStarC_String.concat ", " uu___ let (qual_to_string : FStarC_Syntax_Syntax.qualifier -> Prims.string) = fun uu___ -> match uu___ with @@ -187,38 +182,37 @@ let (qual_to_string : FStarC_Syntax_Syntax.qualifier -> Prims.string) = | FStarC_Syntax_Syntax.TotalEffect -> "total" | FStarC_Syntax_Syntax.Discriminator l -> let uu___1 = lid_to_string l in - FStarC_Compiler_Util.format1 "(Discriminator %s)" uu___1 + FStarC_Util.format1 "(Discriminator %s)" uu___1 | FStarC_Syntax_Syntax.Projector (l, x) -> let uu___1 = lid_to_string l in let uu___2 = FStarC_Ident.string_of_id x in - FStarC_Compiler_Util.format2 "(Projector %s %s)" uu___1 uu___2 + FStarC_Util.format2 "(Projector %s %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.RecordType (ns, fns) -> let uu___1 = let uu___2 = FStarC_Ident.path_of_ns ns in FStarC_Ident.text_of_path uu___2 in let uu___2 = - let uu___3 = FStarC_Compiler_List.map FStarC_Ident.string_of_id fns in - FStarC_Compiler_String.concat ", " uu___3 in - FStarC_Compiler_Util.format2 "(RecordType %s %s)" uu___1 uu___2 + let uu___3 = FStarC_List.map FStarC_Ident.string_of_id fns in + FStarC_String.concat ", " uu___3 in + FStarC_Util.format2 "(RecordType %s %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.RecordConstructor (ns, fns) -> let uu___1 = let uu___2 = FStarC_Ident.path_of_ns ns in FStarC_Ident.text_of_path uu___2 in let uu___2 = - let uu___3 = FStarC_Compiler_List.map FStarC_Ident.string_of_id fns in - FStarC_Compiler_String.concat ", " uu___3 in - FStarC_Compiler_Util.format2 "(RecordConstructor %s %s)" uu___1 - uu___2 + let uu___3 = FStarC_List.map FStarC_Ident.string_of_id fns in + FStarC_String.concat ", " uu___3 in + FStarC_Util.format2 "(RecordConstructor %s %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.Action eff_lid -> let uu___1 = lid_to_string eff_lid in - FStarC_Compiler_Util.format1 "(Action %s)" uu___1 + FStarC_Util.format1 "(Action %s)" uu___1 | FStarC_Syntax_Syntax.ExceptionConstructor -> "ExceptionConstructor" | FStarC_Syntax_Syntax.HasMaskedEffect -> "HasMaskedEffect" | FStarC_Syntax_Syntax.Effect -> "Effect" | FStarC_Syntax_Syntax.Reifiable -> "reify" | FStarC_Syntax_Syntax.Reflectable l -> let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 "(reflect %s)" uu___1 + FStarC_Util.format1 "(reflect %s)" uu___1 | FStarC_Syntax_Syntax.OnlyName -> "OnlyName" let (quals_to_string : FStarC_Syntax_Syntax.qualifier Prims.list -> Prims.string) = @@ -226,8 +220,8 @@ let (quals_to_string : match quals with | [] -> "" | uu___ -> - let uu___1 = FStarC_Compiler_List.map qual_to_string quals in - FStarC_Compiler_String.concat " " uu___1 + let uu___1 = FStarC_List.map qual_to_string quals in + FStarC_String.concat " " uu___1 let (quals_to_string' : FStarC_Syntax_Syntax.qualifier Prims.list -> Prims.string) = fun quals -> @@ -269,9 +263,9 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang FStarC_Syntax_Syntax.lazy_chooser in - FStarC_Compiler_Util.must uu___5 in + FStarC_Util.must uu___5 in uu___4 i.FStarC_Syntax_Syntax.lkind i in term_to_string uu___3 in Prims.strcat uu___2 "]" in @@ -284,10 +278,10 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = FStarC_Common.string_of_list term_to_string (FStar_Pervasives_Native.snd qi.FStarC_Syntax_Syntax.antiquotations) in - FStarC_Compiler_Util.format2 "`(%s)%s" uu___1 uu___2 + FStarC_Util.format2 "`(%s)%s" uu___1 uu___2 | FStarC_Syntax_Syntax.Quote_dynamic -> let uu___1 = term_to_string tm in - FStarC_Compiler_Util.format1 "quote (%s)" uu___1) + FStarC_Util.format1 "quote (%s)" uu___1) | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = t; FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_pattern @@ -295,17 +289,17 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = -> let pats = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun args -> let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (t1, uu___5) -> term_to_string t1) args in - FStarC_Compiler_String.concat "; " uu___3) ps in - FStarC_Compiler_String.concat "\\/" uu___2 in + FStarC_String.concat "; " uu___3) ps in + FStarC_String.concat "\\/" uu___2 in let uu___2 = term_to_string t in - FStarC_Compiler_Util.format2 "{:pattern %s} %s" pats uu___2 + FStarC_Util.format2 "{:pattern %s} %s" pats uu___2 | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = t; FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_monadic @@ -316,8 +310,8 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in let uu___4 = term_to_string t in - FStarC_Compiler_Util.format4 "(MetaMonadic-{%s %s} (%s) %s)" - uu___1 uu___2 uu___3 uu___4 + FStarC_Util.format4 "(MetaMonadic-{%s %s} (%s) %s)" uu___1 + uu___2 uu___3 uu___4 | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = t; FStarC_Syntax_Syntax.meta = @@ -327,37 +321,35 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = let uu___2 = sli m0 in let uu___3 = sli m1 in let uu___4 = term_to_string t in - FStarC_Compiler_Util.format4 - "(MetaMonadicLift-{%s : %s -> %s} %s)" uu___1 uu___2 uu___3 - uu___4 + FStarC_Util.format4 "(MetaMonadicLift-{%s : %s -> %s} %s)" + uu___1 uu___2 uu___3 uu___4 | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = t; FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_labeled (l, r, b);_} -> let uu___1 = FStarC_Errors_Msg.rendermsg l in - let uu___2 = FStarC_Compiler_Range_Ops.string_of_range r in + let uu___2 = FStarC_Range_Ops.string_of_range r in let uu___3 = term_to_string t in - FStarC_Compiler_Util.format3 "Meta_labeled(%s, %s){%s}" uu___1 - uu___2 uu___3 + FStarC_Util.format3 "Meta_labeled(%s, %s){%s}" uu___1 uu___2 + uu___3 | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = t; FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_named l;_} -> let uu___1 = lid_to_string l in let uu___2 = - FStarC_Compiler_Range_Ops.string_of_range - t.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.string_of_range t.FStarC_Syntax_Syntax.pos in let uu___3 = term_to_string t in - FStarC_Compiler_Util.format3 "Meta_named(%s, %s){%s}" uu___1 - uu___2 uu___3 + FStarC_Util.format3 "Meta_named(%s, %s){%s}" uu___1 uu___2 + uu___3 | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = t; FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_desugared uu___1;_} -> let uu___2 = term_to_string t in - FStarC_Compiler_Util.format1 "Meta_desugared{%s}" uu___2 + FStarC_Util.format1 "Meta_desugared{%s}" uu___2 | FStarC_Syntax_Syntax.Tm_bvar x3 -> let uu___1 = db_to_string x3 in let uu___2 = @@ -392,7 +384,7 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = let uu___5 = FStarC_Syntax_Unionfind.uvar_id u.FStarC_Syntax_Syntax.ctx_uvar_head in - FStarC_Compiler_Util.string_of_int uu___5 in + FStarC_Util.string_of_int uu___5 in Prims.strcat "?" uu___4) | FStarC_Syntax_Syntax.Tm_uvar (u, s) -> let uu___1 = @@ -403,16 +395,16 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = let uu___2 = ctx_uvar_to_string_aux true u in let uu___3 = let uu___4 = - FStarC_Compiler_List.map subst_to_string + FStarC_List.map subst_to_string (FStar_Pervasives_Native.fst s) in - FStarC_Compiler_String.concat "; " uu___4 in - FStarC_Compiler_Util.format2 "(%s @ %s)" uu___2 uu___3 + FStarC_String.concat "; " uu___4 in + FStarC_Util.format2 "(%s @ %s)" uu___2 uu___3 else (let uu___3 = let uu___4 = FStarC_Syntax_Unionfind.uvar_id u.FStarC_Syntax_Syntax.ctx_uvar_head in - FStarC_Compiler_Util.string_of_int uu___4 in + FStarC_Util.string_of_int uu___4 in Prims.strcat "?" uu___3) | FStarC_Syntax_Syntax.Tm_constant c -> const_to_string c | FStarC_Syntax_Syntax.Tm_type u -> @@ -420,7 +412,7 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = if uu___1 then let uu___2 = univ_to_string u in - FStarC_Compiler_Util.format1 "Type u#(%s)" uu___2 + FStarC_Util.format1 "Type u#(%s)" uu___2 else "Type" | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = bs; @@ -428,7 +420,7 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = -> let uu___1 = binders_to_string " -> " bs in let uu___2 = comp_to_string c in - FStarC_Compiler_Util.format2 "(%s -> %s)" uu___1 uu___2 + FStarC_Util.format2 "(%s -> %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.Tm_abs { FStarC_Syntax_Syntax.bs = bs; FStarC_Syntax_Syntax.body = t2; FStarC_Syntax_Syntax.rc_opt = lc;_} @@ -443,42 +435,41 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = rc.FStarC_Syntax_Syntax.residual_effect in let uu___4 = if - FStarC_Compiler_Option.isNone + FStarC_Option.isNone rc.FStarC_Syntax_Syntax.residual_typ then "None" else (let uu___6 = - FStarC_Compiler_Option.get + FStarC_Option.get rc.FStarC_Syntax_Syntax.residual_typ in term_to_string uu___6) in - FStarC_Compiler_Util.format4 - "(fun %s -> (%s $$ (residual) %s %s))" uu___1 uu___2 - uu___3 uu___4 + FStarC_Util.format4 "(fun %s -> (%s $$ (residual) %s %s))" + uu___1 uu___2 uu___3 uu___4 | uu___1 -> let uu___2 = binders_to_string " " bs in let uu___3 = term_to_string t2 in - FStarC_Compiler_Util.format2 "(fun %s -> %s)" uu___2 uu___3) + FStarC_Util.format2 "(fun %s -> %s)" uu___2 uu___3) | FStarC_Syntax_Syntax.Tm_refine { FStarC_Syntax_Syntax.b = xt; FStarC_Syntax_Syntax.phi = f;_} -> let uu___1 = bv_to_string xt in let uu___2 = term_to_string xt.FStarC_Syntax_Syntax.sort in let uu___3 = formula_to_string f in - FStarC_Compiler_Util.format3 "(%s:%s{%s})" uu___1 uu___2 uu___3 + FStarC_Util.format3 "(%s:%s{%s})" uu___1 uu___2 uu___3 | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = t; FStarC_Syntax_Syntax.args = args;_} -> let uu___1 = term_to_string t in let uu___2 = args_to_string args in - FStarC_Compiler_Util.format2 "(%s %s)" uu___1 uu___2 + FStarC_Util.format2 "(%s %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.Tm_let { FStarC_Syntax_Syntax.lbs = lbs; FStarC_Syntax_Syntax.body1 = e;_} -> let uu___1 = lbs_to_string [] lbs in let uu___2 = term_to_string e in - FStarC_Compiler_Util.format2 "%s\nin\n%s" uu___1 uu___2 + FStarC_Util.format2 "%s\nin\n%s" uu___1 uu___2 | FStarC_Syntax_Syntax.Tm_ascribed { FStarC_Syntax_Syntax.tm = e; FStarC_Syntax_Syntax.asc = (annot, topt, b); @@ -489,22 +480,21 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = | FStar_Pervasives.Inl t -> let uu___1 = let uu___2 = - FStarC_Compiler_Util.map_opt eff_name + FStarC_Util.map_opt eff_name FStarC_Ident.string_of_lid in - FStarC_Compiler_Util.dflt "default" uu___2 in + FStarC_Util.dflt "default" uu___2 in let uu___2 = term_to_string t in - FStarC_Compiler_Util.format2 "[%s] %s" uu___1 uu___2 + FStarC_Util.format2 "[%s] %s" uu___1 uu___2 | FStar_Pervasives.Inr c -> comp_to_string c in let topt1 = match topt with | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some t -> let uu___1 = term_to_string t in - FStarC_Compiler_Util.format1 "by %s" uu___1 in + FStarC_Util.format1 "by %s" uu___1 in let s = if b then "ascribed_eq" else "ascribed" in let uu___1 = term_to_string e in - FStarC_Compiler_Util.format4 "(%s <%s: %s %s)" uu___1 s annot1 - topt1 + FStarC_Util.format4 "(%s <%s: %s %s)" uu___1 s annot1 topt1 | FStarC_Syntax_Syntax.Tm_match { FStarC_Syntax_Syntax.scrutinee = head; FStarC_Syntax_Syntax.ret_opt = asc_opt; @@ -517,15 +507,15 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = FStarC_Options.print_implicits () -> let uu___1 = if - FStarC_Compiler_Option.isNone + FStarC_Option.isNone lc1.FStarC_Syntax_Syntax.residual_typ then "None" else (let uu___3 = - FStarC_Compiler_Option.get + FStarC_Option.get lc1.FStarC_Syntax_Syntax.residual_typ in term_to_string uu___3) in - FStarC_Compiler_Util.format1 " (residual_comp:%s)" uu___1 + FStarC_Util.format1 " (residual_comp:%s)" uu___1 | uu___1 -> "" in let uu___1 = term_to_string head in let uu___2 = @@ -543,22 +533,21 @@ let rec (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some tac -> let uu___6 = term_to_string tac in - FStarC_Compiler_Util.format1 " by %s" uu___6 in - FStarC_Compiler_Util.format4 "as %s %s %s%s " uu___3 s - uu___4 uu___5 in + FStarC_Util.format1 " by %s" uu___6 in + FStarC_Util.format4 "as %s %s %s%s " uu___3 s uu___4 + uu___5 in let uu___3 = - let uu___4 = - FStarC_Compiler_List.map branch_to_string branches in - FStarC_Compiler_Util.concat_l "\n\t|" uu___4 in - FStarC_Compiler_Util.format4 "(match %s %swith\n\t| %s%s)" - uu___1 uu___2 uu___3 lc_str + let uu___4 = FStarC_List.map branch_to_string branches in + FStarC_Util.concat_l "\n\t|" uu___4 in + FStarC_Util.format4 "(match %s %swith\n\t| %s%s)" uu___1 uu___2 + uu___3 lc_str | FStarC_Syntax_Syntax.Tm_uinst (t, us) -> let uu___1 = FStarC_Options.print_universes () in if uu___1 then let uu___2 = term_to_string t in let uu___3 = univs_to_string us in - FStarC_Compiler_Util.format2 "%s<%s>" uu___2 uu___3 + FStarC_Util.format2 "%s<%s>" uu___2 uu___3 else term_to_string t | FStarC_Syntax_Syntax.Tm_unknown -> "_") and (branch_to_string : FStarC_Syntax_Syntax.branch -> Prims.string) = @@ -571,9 +560,9 @@ and (branch_to_string : FStarC_Syntax_Syntax.branch -> Prims.string) = | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some w -> let uu___3 = term_to_string w in - FStarC_Compiler_Util.format1 "when %s" uu___3 in + FStarC_Util.format1 "when %s" uu___3 in let uu___3 = term_to_string e in - FStarC_Compiler_Util.format3 "%s %s -> %s" uu___1 uu___2 uu___3 + FStarC_Util.format3 "%s %s -> %s" uu___1 uu___2 uu___3 and (ctx_uvar_to_string_aux : Prims.bool -> FStarC_Syntax_Syntax.ctx_uvar -> Prims.string) = fun print_reason -> @@ -581,20 +570,20 @@ and (ctx_uvar_to_string_aux : let reason_string = if print_reason then - FStarC_Compiler_Util.format1 "(* %s *)\n" + FStarC_Util.format1 "(* %s *)\n" ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_reason else (let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.start_of_range + FStarC_Range_Ops.start_of_range ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_range in - FStarC_Compiler_Range_Ops.string_of_pos uu___2 in + FStarC_Range_Ops.string_of_pos uu___2 in let uu___2 = let uu___3 = - FStarC_Compiler_Range_Ops.end_of_range + FStarC_Range_Ops.end_of_range ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_range in - FStarC_Compiler_Range_Ops.string_of_pos uu___3 in - FStarC_Compiler_Util.format2 "(%s-%s) " uu___1 uu___2) in + FStarC_Range_Ops.string_of_pos uu___3 in + FStarC_Util.format2 "(%s-%s) " uu___1 uu___2) in let uu___ = binders_to_string ", " ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_binders in let uu___1 = uvar_to_string ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_head in @@ -611,40 +600,40 @@ and (ctx_uvar_to_string_aux : | FStarC_Syntax_Syntax.Allow_ghost s -> Prims.strcat "Allow_ghost " s | FStarC_Syntax_Syntax.Strict -> "Strict" | FStarC_Syntax_Syntax.Already_checked -> "Already_checked" in - FStarC_Compiler_Util.format5 "%s(%s |- %s : %s) %s" reason_string uu___ - uu___1 uu___2 uu___3 + FStarC_Util.format5 "%s(%s |- %s : %s) %s" reason_string uu___ uu___1 + uu___2 uu___3 and (subst_elt_to_string : FStarC_Syntax_Syntax.subst_elt -> Prims.string) = fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.DB (i, x) -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in let uu___2 = bv_to_string x in - FStarC_Compiler_Util.format2 "DB (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "DB (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.DT (i, t) -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in let uu___2 = term_to_string t in - FStarC_Compiler_Util.format2 "DT (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "DT (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.NM (x, i) -> let uu___1 = bv_to_string x in - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format2 "NM (%s, %s)" uu___1 uu___2 + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format2 "NM (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.NT (x, t) -> let uu___1 = bv_to_string x in let uu___2 = term_to_string t in - FStarC_Compiler_Util.format2 "NT (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "NT (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.UN (i, u) -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in let uu___2 = univ_to_string u in - FStarC_Compiler_Util.format2 "UN (%s, %s)" uu___1 uu___2 + FStarC_Util.format2 "UN (%s, %s)" uu___1 uu___2 | FStarC_Syntax_Syntax.UD (u, i) -> let uu___1 = FStarC_Ident.string_of_id u in - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.format2 "UD (%s, %s)" uu___1 uu___2 + let uu___2 = FStarC_Util.string_of_int i in + FStarC_Util.format2 "UD (%s, %s)" uu___1 uu___2 and (subst_to_string : FStarC_Syntax_Syntax.subst_elt Prims.list -> Prims.string) = fun s -> - let uu___ = FStarC_Compiler_List.map subst_elt_to_string s in - FStarC_Compiler_String.concat "; " uu___ + let uu___ = FStarC_List.map subst_elt_to_string s in + FStarC_String.concat "; " uu___ and (pat_to_string : FStarC_Syntax_Syntax.pat -> Prims.string) = fun x -> match x.FStarC_Syntax_Syntax.v with @@ -661,19 +650,19 @@ and (pat_to_string : FStarC_Syntax_Syntax.pat -> Prims.string) = | FStar_Pervasives_Native.None -> " " | FStar_Pervasives_Native.Some us -> let uu___4 = - let uu___5 = FStarC_Compiler_List.map univ_to_string us in - FStarC_Compiler_String.concat " " uu___5 in - FStarC_Compiler_Util.format1 " %s " uu___4) in + let uu___5 = FStarC_List.map univ_to_string us in + FStarC_String.concat " " uu___5 in + FStarC_Util.format1 " %s " uu___4) in let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (x1, b) -> let p = pat_to_string x1 in if b then Prims.strcat "#" p else p) pats in - FStarC_Compiler_String.concat " " uu___3 in - FStarC_Compiler_Util.format3 "(%s%s%s)" uu___ uu___1 uu___2 + FStarC_String.concat " " uu___3 in + FStarC_Util.format3 "(%s%s%s)" uu___ uu___1 uu___2 | FStarC_Syntax_Syntax.Pat_dot_term topt -> let uu___ = FStarC_Options.print_bound_var_types () in if uu___ @@ -682,9 +671,8 @@ and (pat_to_string : FStarC_Syntax_Syntax.pat -> Prims.string) = if topt = FStar_Pervasives_Native.None then "_" else - (let uu___3 = FStarC_Compiler_Util.must topt in - term_to_string uu___3) in - FStarC_Compiler_Util.format1 ".%s" uu___1 + (let uu___3 = FStarC_Util.must topt in term_to_string uu___3) in + FStarC_Util.format1 ".%s" uu___1 else "._" | FStarC_Syntax_Syntax.Pat_var x1 -> let uu___ = FStarC_Options.print_bound_var_types () in @@ -692,7 +680,7 @@ and (pat_to_string : FStarC_Syntax_Syntax.pat -> Prims.string) = then let uu___1 = bv_to_string x1 in let uu___2 = term_to_string x1.FStarC_Syntax_Syntax.sort in - FStarC_Compiler_Util.format2 "%s:%s" uu___1 uu___2 + FStarC_Util.format2 "%s:%s" uu___1 uu___2 else bv_to_string x1 | FStarC_Syntax_Syntax.Pat_constant c -> const_to_string c and (lbs_to_string : @@ -704,7 +692,7 @@ and (lbs_to_string : let uu___ = quals_to_string' quals in let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___3 = attrs_to_string lb.FStarC_Syntax_Syntax.lbattrs in let uu___4 = lbname_to_string lb.FStarC_Syntax_Syntax.lbname in @@ -720,10 +708,10 @@ and (lbs_to_string : else "" in let uu___6 = term_to_string lb.FStarC_Syntax_Syntax.lbtyp in let uu___7 = term_to_string lb.FStarC_Syntax_Syntax.lbdef in - FStarC_Compiler_Util.format5 "%s%s %s : %s = %s" uu___3 uu___4 - uu___5 uu___6 uu___7) (FStar_Pervasives_Native.snd lbs) in - FStarC_Compiler_Util.concat_l "\n and " uu___2 in - FStarC_Compiler_Util.format3 "%slet %s %s" uu___ + FStarC_Util.format5 "%s%s %s : %s = %s" uu___3 uu___4 uu___5 + uu___6 uu___7) (FStar_Pervasives_Native.snd lbs) in + FStarC_Util.concat_l "\n and " uu___2 in + FStarC_Util.format3 "%slet %s %s" uu___ (if FStar_Pervasives_Native.fst lbs then "rec" else "") uu___1 and (attrs_to_string : FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax Prims.list -> @@ -735,10 +723,10 @@ and (attrs_to_string : | tms -> let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun t -> let uu___3 = term_to_string t in paren uu___3) tms in - FStarC_Compiler_String.concat "; " uu___2 in - FStarC_Compiler_Util.format1 "[@ %s]" uu___1 + FStarC_String.concat "; " uu___2 in + FStarC_Util.format1 "[@ %s]" uu___1 and (binder_attrs_to_string : FStarC_Syntax_Syntax.term Prims.list -> Prims.string) = fun uu___ -> @@ -750,10 +738,10 @@ and (binder_attrs_to_string : | tms -> let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun t -> let uu___3 = term_to_string t in paren uu___3) tms in - FStarC_Compiler_String.concat "; " uu___2 in - FStarC_Compiler_Util.format1 "[@@@ %s]" uu___1) + FStarC_String.concat "; " uu___2 in + FStarC_Util.format1 "[@@@ %s]" uu___1) and (bqual_to_string' : Prims.string -> FStarC_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> @@ -840,11 +828,11 @@ and (binders_to_string : if uu___ then bs else filter_imp_binders bs in if sep = " -> " then - let uu___ = FStarC_Compiler_List.map arrow_binder_to_string bs1 in - FStarC_Compiler_String.concat sep uu___ + let uu___ = FStarC_List.map arrow_binder_to_string bs1 in + FStarC_String.concat sep uu___ else - (let uu___1 = FStarC_Compiler_List.map binder_to_string bs1 in - FStarC_Compiler_String.concat sep uu___1) + (let uu___1 = FStarC_List.map binder_to_string bs1 in + FStarC_String.concat sep uu___1) and (arg_to_string : (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option) -> Prims.string) @@ -862,8 +850,8 @@ and (args_to_string : let args1 = let uu___ = FStarC_Options.print_implicits () in if uu___ then args else filter_imp_args args in - let uu___ = FStarC_Compiler_List.map arg_to_string args1 in - FStarC_Compiler_String.concat " " uu___ + let uu___ = FStarC_List.map arg_to_string args1 in + FStarC_String.concat " " uu___ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = fun c -> FStarC_Errors.with_ctx "While ugly-printing a computation" @@ -881,7 +869,7 @@ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = Prims.op_Negation uu___3 -> term_to_string t | uu___2 -> let uu___3 = term_to_string t in - FStarC_Compiler_Util.format1 "Tot %s" uu___3) + FStarC_Util.format1 "Tot %s" uu___3) | FStarC_Syntax_Syntax.GTotal t -> let uu___1 = let uu___2 = FStarC_Syntax_Subst.compress t in @@ -894,7 +882,7 @@ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = Prims.op_Negation uu___3 -> term_to_string t | uu___2 -> let uu___3 = term_to_string t in - FStarC_Compiler_Util.format1 "GTot %s" uu___3) + FStarC_Util.format1 "GTot %s" uu___3) | FStarC_Syntax_Syntax.Comp c1 -> let basic = let uu___1 = FStarC_Options.print_effect_args () in @@ -903,23 +891,22 @@ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = let uu___2 = sli c1.FStarC_Syntax_Syntax.effect_name in let uu___3 = let uu___4 = - FStarC_Compiler_List.map univ_to_string + FStarC_List.map univ_to_string c1.FStarC_Syntax_Syntax.comp_univs in - FStarC_Compiler_String.concat ", " uu___4 in + FStarC_String.concat ", " uu___4 in let uu___4 = term_to_string c1.FStarC_Syntax_Syntax.result_typ in let uu___5 = let uu___6 = - FStarC_Compiler_List.map arg_to_string + FStarC_List.map arg_to_string c1.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_String.concat ", " uu___6 in + FStarC_String.concat ", " uu___6 in let uu___6 = cflags_to_string c1.FStarC_Syntax_Syntax.flags in - FStarC_Compiler_Util.format5 - "%s<%s> (%s) %s (attributes %s)" uu___2 uu___3 uu___4 - uu___5 uu___6 + FStarC_Util.format5 "%s<%s> (%s) %s (attributes %s)" uu___2 + uu___3 uu___4 uu___5 uu___6 else (let uu___3 = - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___4 -> match uu___4 with | FStarC_Syntax_Syntax.TOTAL -> true @@ -931,7 +918,7 @@ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = then let uu___4 = term_to_string c1.FStarC_Syntax_Syntax.result_typ in - FStarC_Compiler_Util.format1 "Tot %s" uu___4 + FStarC_Util.format1 "Tot %s" uu___4 else (let uu___5 = ((let uu___6 = FStarC_Options.print_effect_args () in @@ -948,7 +935,7 @@ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = (let uu___7 = (let uu___8 = FStarC_Options.print_effect_args () in Prims.op_Negation uu___8) && - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___8 -> match uu___8 with | FStarC_Syntax_Syntax.MLEFFECT -> true @@ -958,18 +945,17 @@ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = then let uu___8 = term_to_string c1.FStarC_Syntax_Syntax.result_typ in - FStarC_Compiler_Util.format1 "ALL %s" uu___8 + FStarC_Util.format1 "ALL %s" uu___8 else (let uu___9 = sli c1.FStarC_Syntax_Syntax.effect_name in let uu___10 = term_to_string c1.FStarC_Syntax_Syntax.result_typ in - FStarC_Compiler_Util.format2 "%s (%s)" uu___9 - uu___10)))) in + FStarC_Util.format2 "%s (%s)" uu___9 uu___10)))) in let dec = let uu___1 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.DECREASES dec_order -> @@ -981,7 +967,7 @@ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = | [] -> "" | hd::tl -> let uu___5 = term_to_string hd in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun s -> fun t -> let uu___6 = @@ -989,20 +975,20 @@ and (comp_to_string : FStarC_Syntax_Syntax.comp -> Prims.string) = Prims.strcat ";" uu___7 in Prims.strcat s uu___6) uu___5 tl in - FStarC_Compiler_Util.format1 - " (decreases [%s])" uu___4 in + FStarC_Util.format1 " (decreases [%s])" + uu___4 in [uu___3] | FStarC_Syntax_Syntax.Decreases_wf (rel, e) -> let uu___3 = let uu___4 = term_to_string rel in let uu___5 = term_to_string e in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "(decreases {:well-founded %s %s})" uu___4 uu___5 in [uu___3]) | uu___3 -> []) c1.FStarC_Syntax_Syntax.flags in - FStarC_Compiler_String.concat " " uu___1 in - FStarC_Compiler_Util.format2 "%s%s" basic dec) + FStarC_String.concat " " uu___1 in + FStarC_Util.format2 "%s%s" basic dec) and (cflag_to_string : FStarC_Syntax_Syntax.cflag -> Prims.string) = fun c -> match c with @@ -1050,7 +1036,7 @@ let (tscheme_to_string : FStarC_Syntax_Syntax.tscheme -> Prims.string) = let uu___1 = let uu___2 = univ_names_to_string us in enclose_universes uu___2 in let uu___2 = term_to_string t in - FStarC_Compiler_Util.format2 "%s%s" uu___1 uu___2 + FStarC_Util.format2 "%s%s" uu___1 uu___2 let (action_to_string : FStarC_Syntax_Syntax.action -> Prims.string) = fun a -> let uu___ = sli a.FStarC_Syntax_Syntax.action_name in @@ -1060,8 +1046,7 @@ let (action_to_string : FStarC_Syntax_Syntax.action -> Prims.string) = enclose_universes uu___3 in let uu___3 = term_to_string a.FStarC_Syntax_Syntax.action_typ in let uu___4 = term_to_string a.FStarC_Syntax_Syntax.action_defn in - FStarC_Compiler_Util.format5 "%s%s %s : %s = %s" uu___ uu___1 uu___2 - uu___3 uu___4 + FStarC_Util.format5 "%s%s %s : %s = %s" uu___ uu___1 uu___2 uu___3 uu___4 let (wp_eff_combinators_to_string : FStarC_Syntax_Syntax.wp_eff_combinators -> Prims.string) = fun combs -> @@ -1108,24 +1093,21 @@ let (wp_eff_combinators_to_string : uu___5 :: uu___6 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStarC_Compiler_Util.format + FStarC_Util.format "{\nret_wp = %s\n; bind_wp = %s\n; stronger = %s\n; if_then_else = %s\n; ite_wp = %s\n; close_wp = %s\n; trivial = %s\n; repr = %s\n; return_repr = %s\n; bind_repr = %s\n}\n" uu___ let (sub_eff_to_string : FStarC_Syntax_Syntax.sub_eff -> Prims.string) = fun se -> let tsopt_to_string ts_opt = - if FStarC_Compiler_Util.is_some ts_opt - then - let uu___ = FStarC_Compiler_Util.must ts_opt in - tscheme_to_string uu___ + if FStarC_Util.is_some ts_opt + then let uu___ = FStarC_Util.must ts_opt in tscheme_to_string uu___ else "" in let uu___ = lid_to_string se.FStarC_Syntax_Syntax.source in let uu___1 = lid_to_string se.FStarC_Syntax_Syntax.target in let uu___2 = tsopt_to_string se.FStarC_Syntax_Syntax.lift in let uu___3 = tsopt_to_string se.FStarC_Syntax_Syntax.lift_wp in - FStarC_Compiler_Util.format4 - "sub_effect %s ~> %s : lift = %s ;; lift_wp = %s" uu___ uu___1 uu___2 - uu___3 + FStarC_Util.format4 "sub_effect %s ~> %s : lift = %s ;; lift_wp = %s" + uu___ uu___1 uu___2 uu___3 let (layered_eff_combinators_to_string : FStarC_Syntax_Syntax.layered_eff_combinators -> Prims.string) = fun combs -> @@ -1139,13 +1121,13 @@ let (layered_eff_combinators_to_string : (FStarC_Class_Show.show_option FStarC_Syntax_Syntax.showable_indexed_effect_combinator_kind) kopt in - FStarC_Compiler_Util.format3 "(%s) : (%s)<%s>" uu___1 uu___2 uu___3 in + FStarC_Util.format3 "(%s) : (%s)<%s>" uu___1 uu___2 uu___3 in let to_str2 uu___ = match uu___ with | (ts_t, ts_ty) -> let uu___1 = tscheme_to_string ts_t in let uu___2 = tscheme_to_string ts_ty in - FStarC_Compiler_Util.format2 "(%s) : (%s)" uu___1 uu___2 in + FStarC_Util.format2 "(%s) : (%s)" uu___1 uu___2 in let uu___ = let uu___1 = to_str2 combs.FStarC_Syntax_Syntax.l_repr in let uu___2 = @@ -1165,17 +1147,16 @@ let (layered_eff_combinators_to_string : else (let uu___13 = let uu___14 = - FStarC_Compiler_Util.must - combs.FStarC_Syntax_Syntax.l_close in + FStarC_Util.must combs.FStarC_Syntax_Syntax.l_close in to_str2 uu___14 in - FStarC_Compiler_Util.format1 "; l_close = %s\n" uu___13) in + FStarC_Util.format1 "; l_close = %s\n" uu___13) in [uu___11] in uu___9 :: uu___10 in uu___7 :: uu___8 in uu___5 :: uu___6 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStarC_Compiler_Util.format + FStarC_Util.format "{\n; l_repr = %s\n; l_return = %s\n; l_bind = %s\n; l_subcomp = %s\n; l_if_then_else = %s\n\n %s\n }\n" uu___ let (eff_combinators_to_string : @@ -1193,14 +1174,14 @@ let (eff_extraction_mode_to_string : fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Extract_none s -> - FStarC_Compiler_Util.format1 "none (%s)" s + FStarC_Util.format1 "none (%s)" s | FStarC_Syntax_Syntax.Extract_reify -> "reify" | FStarC_Syntax_Syntax.Extract_primitive -> "primitive" let (eff_decl_to_string : FStarC_Syntax_Syntax.eff_decl -> Prims.string) = fun ed -> let actions_to_string actions = - let uu___ = FStarC_Compiler_List.map action_to_string actions in - FStarC_Compiler_String.concat ",\n\t" uu___ in + let uu___ = FStarC_List.map action_to_string actions in + FStarC_String.concat ",\n\t" uu___ in let eff_name = let uu___ = FStarC_Syntax_Util.is_layered ed in if uu___ then "layered_effect" else "new_effect" in @@ -1236,7 +1217,7 @@ let (eff_decl_to_string : FStarC_Syntax_Syntax.eff_decl -> Prims.string) = uu___3 :: uu___4 in "" :: uu___2 in eff_name :: uu___1 in - FStarC_Compiler_Util.format + FStarC_Util.format "%s%s { %s%s %s : %s \n %s\nand effect_actions\n\t%s\n}\n" uu___ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = fun x -> @@ -1261,12 +1242,12 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = then let uu___5 = FStarC_Ident.string_of_lid lid in let uu___6 = univ_names_to_string univs in - FStarC_Compiler_Util.format5 "%stype %s<%s> %s : %s" quals_str - uu___5 uu___6 binders_str term_str + FStarC_Util.format5 "%stype %s<%s> %s : %s" quals_str uu___5 + uu___6 binders_str term_str else (let uu___6 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format4 "%stype %s %s : %s" quals_str - uu___6 binders_str term_str) + FStarC_Util.format4 "%stype %s %s : %s" quals_str uu___6 + binders_str term_str) | FStarC_Syntax_Syntax.Sig_datacon { FStarC_Syntax_Syntax.lid1 = lid; FStarC_Syntax_Syntax.us1 = univs; FStarC_Syntax_Syntax.t1 = t; @@ -1281,12 +1262,11 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = let uu___5 = univ_names_to_string univs in let uu___6 = FStarC_Ident.string_of_lid lid in let uu___7 = term_to_string t in - FStarC_Compiler_Util.format3 "datacon<%s> %s : %s" uu___5 uu___6 - uu___7 + FStarC_Util.format3 "datacon<%s> %s : %s" uu___5 uu___6 uu___7 else (let uu___6 = FStarC_Ident.string_of_lid lid in let uu___7 = term_to_string t in - FStarC_Compiler_Util.format2 "datacon %s : %s" uu___6 uu___7) + FStarC_Util.format2 "datacon %s : %s" uu___6 uu___7) | FStarC_Syntax_Syntax.Sig_declare_typ { FStarC_Syntax_Syntax.lid2 = lid; FStarC_Syntax_Syntax.us2 = univs; FStarC_Syntax_Syntax.t2 = t;_} @@ -1298,11 +1278,10 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = if uu___3 then let uu___4 = univ_names_to_string univs in - FStarC_Compiler_Util.format1 "<%s>" uu___4 + FStarC_Util.format1 "<%s>" uu___4 else "" in let uu___3 = term_to_string t in - FStarC_Compiler_Util.format4 "%sval %s %s : %s" uu___ uu___1 uu___2 - uu___3 + FStarC_Util.format4 "%sval %s %s : %s" uu___ uu___1 uu___2 uu___3 | FStarC_Syntax_Syntax.Sig_assume { FStarC_Syntax_Syntax.lid3 = lid; FStarC_Syntax_Syntax.us3 = us; FStarC_Syntax_Syntax.phi1 = f;_} @@ -1313,19 +1292,18 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = let uu___1 = FStarC_Ident.string_of_lid lid in let uu___2 = univ_names_to_string us in let uu___3 = term_to_string f in - FStarC_Compiler_Util.format3 "assume %s<%s> : %s" uu___1 uu___2 - uu___3 + FStarC_Util.format3 "assume %s<%s> : %s" uu___1 uu___2 uu___3 else (let uu___2 = FStarC_Ident.string_of_lid lid in let uu___3 = term_to_string f in - FStarC_Compiler_Util.format2 "assume %s : %s" uu___2 uu___3) + FStarC_Util.format2 "assume %s : %s" uu___2 uu___3) | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = lbs; FStarC_Syntax_Syntax.lids1 = uu___;_} -> let lbs1 = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> { FStarC_Syntax_Syntax.lbname = @@ -1349,8 +1327,8 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = FStarC_Syntax_Syntax.lids = uu___;_} -> let uu___1 = - let uu___2 = FStarC_Compiler_List.map sigelt_to_string ses in - FStarC_Compiler_String.concat "\n" uu___2 in + let uu___2 = FStarC_List.map sigelt_to_string ses in + FStarC_String.concat "\n" uu___2 in Prims.strcat "(* Sig_bundle *)" uu___1 | FStarC_Syntax_Syntax.Sig_fail { FStarC_Syntax_Syntax.errs = errs; @@ -1358,16 +1336,14 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = FStarC_Syntax_Syntax.fail_in_lax = lax; FStarC_Syntax_Syntax.ses1 = ses;_} -> - let uu___1 = FStarC_Compiler_Util.string_of_bool lax in + let uu___1 = FStarC_Util.string_of_bool lax in let uu___2 = - FStarC_Common.string_of_list FStarC_Compiler_Util.string_of_int - errs in + FStarC_Common.string_of_list FStarC_Util.string_of_int errs in let uu___3 = - let uu___4 = FStarC_Compiler_List.map sigelt_to_string ses in - FStarC_Compiler_String.concat "\n" uu___4 in - FStarC_Compiler_Util.format3 - "(* Sig_fail %s %s *)\n%s\n(* / Sig_fail*)\n" uu___1 uu___2 - uu___3 + let uu___4 = FStarC_List.map sigelt_to_string ses in + FStarC_String.concat "\n" uu___4 in + FStarC_Util.format3 "(* Sig_fail %s %s *)\n%s\n(* / Sig_fail*)\n" + uu___1 uu___2 uu___3 | FStarC_Syntax_Syntax.Sig_new_effect ed -> let uu___ = let uu___1 = FStarC_Syntax_Util.is_dm4f ed in @@ -1392,7 +1368,7 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = { FStarC_Syntax_Syntax.bs1 = tps; FStarC_Syntax_Syntax.comp = c - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in FStarC_Syntax_Subst.open_univ_vars univs uu___2 in (match uu___1 with | (univs1, t) -> @@ -1412,14 +1388,13 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = let uu___4 = univ_names_to_string univs1 in let uu___5 = binders_to_string " " tps1 in let uu___6 = comp_to_string c1 in - FStarC_Compiler_Util.format4 "effect %s<%s> %s = %s" - uu___3 uu___4 uu___5 uu___6)) + FStarC_Util.format4 "effect %s<%s> %s = %s" uu___3 + uu___4 uu___5 uu___6)) else (let uu___2 = sli l in let uu___3 = binders_to_string " " tps in let uu___4 = comp_to_string c in - FStarC_Compiler_Util.format3 "effect %s %s = %s" uu___2 uu___3 - uu___4) + FStarC_Util.format3 "effect %s %s = %s" uu___2 uu___3 uu___4) | FStarC_Syntax_Syntax.Sig_splice { FStarC_Syntax_Syntax.is_typed = is_typed; FStarC_Syntax_Syntax.lids2 = lids; @@ -1427,11 +1402,11 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = -> let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Ident.showable_lident) lids in - FStarC_Compiler_String.concat "; " uu___1 in + FStarC_String.concat "; " uu___1 in let uu___1 = term_to_string t in - FStarC_Compiler_Util.format3 "splice%s[%s] (%s)" + FStarC_Util.format3 "splice%s[%s] (%s)" (if is_typed then "_t" else "") uu___ uu___1 | FStarC_Syntax_Syntax.Sig_polymonadic_bind { FStarC_Syntax_Syntax.m_lid = m; FStarC_Syntax_Syntax.n_lid = n; @@ -1448,7 +1423,7 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = (FStarC_Class_Show.show_option FStarC_Syntax_Syntax.showable_indexed_effect_combinator_kind) k in - FStarC_Compiler_Util.format6 + FStarC_Util.format6 "polymonadic_bind (%s, %s) |> %s = (%s, %s)<%s>" uu___ uu___1 uu___2 uu___3 uu___4 uu___5 | FStarC_Syntax_Syntax.Sig_polymonadic_subcomp @@ -1465,9 +1440,8 @@ let rec (sigelt_to_string : FStarC_Syntax_Syntax.sigelt -> Prims.string) = (FStarC_Class_Show.show_option FStarC_Syntax_Syntax.showable_indexed_effect_combinator_kind) k in - FStarC_Compiler_Util.format5 - "polymonadic_subcomp %s <: %s = (%s, %s)<%s>" uu___ uu___1 uu___2 - uu___3 uu___4 in + FStarC_Util.format5 "polymonadic_subcomp %s <: %s = (%s, %s)<%s>" + uu___ uu___1 uu___2 uu___3 uu___4 in match x.FStarC_Syntax_Syntax.sigattrs with | [] -> Prims.strcat "[@ ]" (Prims.strcat "\n" basic) | uu___ -> diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Resugar.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Resugar.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_Syntax_Resugar.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Resugar.ml index 9836a4bd039..e32d8cdf71e 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Resugar.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Resugar.ml @@ -1,7 +1,7 @@ open Prims let (doc_to_string : FStarC_Pprint.document -> Prims.string) = fun doc -> - FStarC_Pprint.pretty_string (FStarC_Compiler_Util.float_of_string "1.0") + FStarC_Pprint.pretty_string (FStarC_Util.float_of_string "1.0") (Prims.of_int (100)) doc let (parser_term_to_string : FStarC_Parser_AST.term -> Prims.string) = fun t -> @@ -18,19 +18,18 @@ let map_opt : unit -> ('uuuuu -> 'uuuuu1 FStar_Pervasives_Native.option) -> 'uuuuu Prims.list -> 'uuuuu1 Prims.list - = fun uu___ -> FStarC_Compiler_List.filter_map + = fun uu___ -> FStarC_List.filter_map let (bv_as_unique_ident : FStarC_Syntax_Syntax.bv -> FStarC_Ident.ident) = fun x -> let unique_name = let uu___ = (let uu___1 = FStarC_Ident.string_of_id x.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Util.starts_with FStarC_Ident.reserved_prefix uu___1) - || (FStarC_Options.print_real_names ()) in + FStarC_Util.starts_with FStarC_Ident.reserved_prefix uu___1) || + (FStarC_Options.print_real_names ()) in if uu___ then let uu___1 = FStarC_Ident.string_of_id x.FStarC_Syntax_Syntax.ppname in - let uu___2 = - FStarC_Compiler_Util.string_of_int x.FStarC_Syntax_Syntax.index in + let uu___2 = FStarC_Util.string_of_int x.FStarC_Syntax_Syntax.index in Prims.strcat uu___1 uu___2 else FStarC_Ident.string_of_id x.FStarC_Syntax_Syntax.ppname in let uu___ = @@ -52,7 +51,7 @@ let (is_imp_bqual : | uu___ -> false let (no_imp_args : FStarC_Syntax_Syntax.args -> FStarC_Syntax_Syntax.args) = fun args -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___ -> match uu___ with | (uu___1, FStar_Pervasives_Native.None) -> true @@ -63,7 +62,7 @@ let (no_imp_bs : FStarC_Syntax_Syntax.binder Prims.list) = fun bs -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun b -> Prims.op_Negation (is_imp_bqual b.FStarC_Syntax_Syntax.binder_qual)) bs @@ -88,7 +87,7 @@ let filter_pattern_imp : if uu___ then xs else - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | (uu___3, is_implicit) -> Prims.op_Negation is_implicit) xs @@ -119,12 +118,12 @@ let (universe_to_string : FStarC_Ident.ident Prims.list -> Prims.string) = if uu___ then let uu___1 = - FStarC_Compiler_List.map (fun x -> FStarC_Ident.string_of_id x) univs in - FStarC_Compiler_String.concat ", " uu___1 + FStarC_List.map (fun x -> FStarC_Ident.string_of_id x) univs in + FStarC_String.concat ", " uu___1 else "" let rec (resugar_universe : FStarC_Syntax_Syntax.universe -> - FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.term) + FStarC_Range_Type.range -> FStarC_Parser_AST.term) = fun u -> fun r -> @@ -145,7 +144,7 @@ let rec (resugar_universe : let uu___2 = let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_Util.string_of_int n in + let uu___5 = FStarC_Util.string_of_int n in (uu___5, FStar_Pervasives_Native.None) in FStarC_Const.Const_int uu___4 in FStarC_Parser_AST.Const uu___3 in @@ -155,7 +154,7 @@ let rec (resugar_universe : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_Util.string_of_int n in + let uu___6 = FStarC_Util.string_of_int n in (uu___6, FStar_Pervasives_Native.None) in FStarC_Const.Const_int uu___5 in FStarC_Parser_AST.Const uu___4 in @@ -176,7 +175,7 @@ let rec (resugar_universe : let uu___2 = FStarC_Ident.lid_of_path ["max"] r in FStarC_Parser_AST.Var uu___2 in mk uu___1 r in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun x -> let uu___1 = @@ -191,8 +190,8 @@ let rec (resugar_universe : let id = let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int x in - FStarC_Compiler_Util.strcat "uu__univ_bvar_" uu___2 in + let uu___2 = FStarC_Util.string_of_int x in + FStarC_Util.strcat "uu__univ_bvar_" uu___2 in (uu___1, r) in FStarC_Ident.mk_ident uu___ in mk (FStarC_Parser_AST.Uvar id) r @@ -200,7 +199,7 @@ let rec (resugar_universe : let (resugar_universe' : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.universe -> - FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.term) + FStarC_Range_Type.range -> FStarC_Parser_AST.term) = fun env -> fun u -> fun r -> resugar_universe u r type expected_arity = Prims.int FStar_Pervasives_Native.option let rec (resugar_term_as_op : @@ -241,7 +240,7 @@ let rec (resugar_term_as_op : (FStarC_Parser_Const.calc_finish_lid, "calc_finish")] in let fallback fv = let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun d -> FStarC_Syntax_Syntax.fv_eq_lid fv (FStar_Pervasives_Native.fst d)) infix_prim_ops in @@ -254,7 +253,7 @@ let rec (resugar_term_as_op : let uu___2 = FStarC_Ident.nsstr (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_String.length uu___2 in + FStarC_String.length uu___2 in let str = if length = Prims.int_zero then @@ -264,45 +263,42 @@ let rec (resugar_term_as_op : (let uu___3 = FStarC_Ident.string_of_lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.substring_from uu___3 - (length + Prims.int_one)) in + FStarC_Util.substring_from uu___3 (length + Prims.int_one)) in let uu___2 = - (FStarC_Compiler_Util.starts_with str "dtuple") && + (FStarC_Util.starts_with str "dtuple") && (let uu___3 = let uu___4 = - FStarC_Compiler_Util.substring_from str (Prims.of_int (6)) in - FStarC_Compiler_Util.safe_int_of_string uu___4 in - FStarC_Compiler_Option.isSome uu___3) in + FStarC_Util.substring_from str (Prims.of_int (6)) in + FStarC_Util.safe_int_of_string uu___4 in + FStarC_Option.isSome uu___3) in if uu___2 then let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_Util.substring_from str (Prims.of_int (6)) in - FStarC_Compiler_Util.safe_int_of_string uu___5 in + FStarC_Util.substring_from str (Prims.of_int (6)) in + FStarC_Util.safe_int_of_string uu___5 in ("dtuple", uu___4) in FStar_Pervasives_Native.Some uu___3 else (let uu___4 = - (FStarC_Compiler_Util.starts_with str "tuple") && + (FStarC_Util.starts_with str "tuple") && (let uu___5 = let uu___6 = - FStarC_Compiler_Util.substring_from str - (Prims.of_int (5)) in - FStarC_Compiler_Util.safe_int_of_string uu___6 in - FStarC_Compiler_Option.isSome uu___5) in + FStarC_Util.substring_from str (Prims.of_int (5)) in + FStarC_Util.safe_int_of_string uu___6 in + FStarC_Option.isSome uu___5) in if uu___4 then let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_Util.substring_from str - (Prims.of_int (5)) in - FStarC_Compiler_Util.safe_int_of_string uu___7 in + FStarC_Util.substring_from str (Prims.of_int (5)) in + FStarC_Util.safe_int_of_string uu___7 in ("tuple", uu___6) in FStar_Pervasives_Native.Some uu___5 else - if FStarC_Compiler_Util.starts_with str "try_with" + if FStarC_Util.starts_with str "try_with" then FStar_Pervasives_Native.Some ("try_with", FStar_Pervasives_Native.None) @@ -328,7 +324,7 @@ let rec (resugar_term_as_op : let uu___1 = FStarC_Ident.nsstr (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_String.length uu___1 in + FStarC_String.length uu___1 in let s = if length = Prims.int_zero then @@ -338,8 +334,7 @@ let rec (resugar_term_as_op : (let uu___2 = FStarC_Ident.string_of_lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.substring_from uu___2 - (length + Prims.int_one)) in + FStarC_Util.substring_from uu___2 (length + Prims.int_one)) in let uu___1 = FStarC_Parser_AST.string_to_op s in (match uu___1 with | FStar_Pervasives_Native.Some t1 -> FStar_Pervasives_Native.Some t1 @@ -403,10 +398,10 @@ let (serialize_machine_integer_desc : | FStarC_Const.Unsigned -> "u" | FStarC_Const.Signed -> "" in let uu___1 = - FStarC_Compiler_Util.format3 "FStar.%sInt%s.__%sint_to_t" sU sW su in + FStarC_Util.format3 "FStar.%sInt%s.__%sint_to_t" sU sW su in let uu___2 = let uu___3 = - FStarC_Compiler_Util.format3 "FStar.%sInt%s.%sint_to_t" sU sW su in + FStarC_Util.format3 "FStar.%sInt%s.%sint_to_t" sU sW su in [uu___3] in uu___1 :: uu___2 let (parse_machine_integer_desc : @@ -448,7 +443,7 @@ let (parse_machine_integer_desc : ((FStarC_Const.Unsigned, FStarC_Const.Sizet), "FStar.SizeT.__uint_to_t") :: uu___ in fun fv -> - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___ -> match uu___ with | (uu___1, d) -> @@ -459,12 +454,10 @@ let (parse_machine_integer_desc : let (can_resugar_machine_integer_fv : FStarC_Syntax_Syntax.fv -> Prims.bool) = fun fv -> - let uu___ = parse_machine_integer_desc fv in - FStarC_Compiler_Option.isSome uu___ + let uu___ = parse_machine_integer_desc fv in FStarC_Option.isSome uu___ let (resugar_machine_integer : FStarC_Syntax_Syntax.fv -> - Prims.string -> - FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.term) + Prims.string -> FStarC_Range_Type.range -> FStarC_Parser_AST.term) = fun fv -> fun i -> @@ -601,20 +594,18 @@ let rec (resugar_term' : let uu___1 = FStarC_Ident.nsstr (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_String.length uu___1 in + FStarC_String.length uu___1 in let s = if length = Prims.int_zero then FStarC_Ident.string_of_lid a else (let uu___2 = FStarC_Ident.string_of_lid a in - FStarC_Compiler_Util.substring_from uu___2 - (length + Prims.int_one)) in + FStarC_Util.substring_from uu___2 (length + Prims.int_one)) in let is_prefix = Prims.strcat FStarC_Ident.reserved_prefix "is_" in - if FStarC_Compiler_Util.starts_with s is_prefix + if FStarC_Util.starts_with s is_prefix then let rest = - FStarC_Compiler_Util.substring_from s - (FStarC_Compiler_String.length is_prefix) in + FStarC_Util.substring_from s (FStarC_String.length is_prefix) in let uu___1 = let uu___2 = FStarC_Ident.lid_of_path [rest] t.FStarC_Syntax_Syntax.pos in @@ -622,15 +613,15 @@ let rec (resugar_term' : mk uu___1 else if - FStarC_Compiler_Util.starts_with s + FStarC_Util.starts_with s FStarC_Syntax_Util.field_projector_prefix then (let rest = - FStarC_Compiler_Util.substring_from s - (FStarC_Compiler_String.length + FStarC_Util.substring_from s + (FStarC_String.length FStarC_Syntax_Util.field_projector_prefix) in let r = - FStarC_Compiler_Util.split rest + FStarC_Util.split rest FStarC_Syntax_Util.field_projector_sep in match r with | fst::snd::[] -> @@ -678,11 +669,9 @@ let rec (resugar_term' : FStarC_Parser_Const.assume_lid)) || (let uu___8 = - let uu___9 = - FStarC_Compiler_String.get s Prims.int_zero in + let uu___9 = FStarC_String.get s Prims.int_zero in FStar_Char.uppercase uu___9 in - let uu___9 = - FStarC_Compiler_String.get s Prims.int_zero in + let uu___9 = FStarC_String.get s Prims.int_zero in uu___8 <> uu___9) in if uu___7 then @@ -703,7 +692,7 @@ let rec (resugar_term' : if uu___1 then let univs = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> resugar_universe x t.FStarC_Syntax_Syntax.pos) universes in (match e1 with @@ -714,13 +703,13 @@ let rec (resugar_term' : -> let args1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun u -> (u, FStarC_Parser_AST.UnivApp)) univs in - FStarC_Compiler_List.op_At args uu___2 in + FStarC_List.op_At args uu___2 in FStarC_Parser_AST.mk_term (FStarC_Parser_AST.Construct (hd, args1)) r l | uu___2 -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun u -> mk @@ -765,12 +754,12 @@ let rec (resugar_term' : let xs2 = filter_imp_bs xs1 in let body_bv = FStarC_Syntax_Free.names body1 in let patterns = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> resugar_bv_as_pat env x.FStarC_Syntax_Syntax.binder_bv x.FStarC_Syntax_Syntax.binder_qual body_bv) xs2 in let body2 = resugar_term' env body1 in - if FStarC_Compiler_List.isEmpty patterns + if FStarC_List.isEmpty patterns then body2 else mk (FStarC_Parser_AST.Abs (patterns, body2))) | FStarC_Syntax_Syntax.Tm_arrow uu___1 -> @@ -795,11 +784,11 @@ let rec (resugar_term' : let body2 = resugar_comp' env body1 in let xs3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> resugar_binder' env b t.FStarC_Syntax_Syntax.pos) xs2 in - FStarC_Compiler_List.rev uu___4 in + FStarC_List.rev uu___4 in let rec aux body3 uu___4 = match uu___4 with | [] -> body3 @@ -817,7 +806,7 @@ let rec (resugar_term' : (match uu___1 with | (x1, phi1) -> let b = - let uu___2 = FStarC_Compiler_List.hd x1 in + let uu___2 = FStarC_List.hd x1 in resugar_binder' env uu___2 t.FStarC_Syntax_Syntax.pos in let uu___2 = let uu___3 = @@ -888,7 +877,7 @@ let rec (resugar_term' : | a1::a2::uu___4 -> [a1; a2] in let resugar_as_app e1 args1 = let args2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (e2, qual) -> @@ -904,11 +893,9 @@ let rec (resugar_term' : FStarC_Parser_AST.level = l;_} -> FStarC_Parser_AST.mk_term (FStarC_Parser_AST.Construct - (hd, - (FStarC_Compiler_List.op_At previous_args args2))) - r l + (hd, (FStarC_List.op_At previous_args args2))) r l | e2 -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun uu___4 -> match uu___4 with @@ -930,24 +917,24 @@ let rec (resugar_term' : let uu___4 = FStarC_Ident.nsstr (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_String.length uu___4 in + FStarC_String.length uu___4 in let s = if length = Prims.int_zero then FStarC_Ident.string_of_lid a else (let uu___5 = FStarC_Ident.string_of_lid a in - FStarC_Compiler_Util.substring_from uu___5 + FStarC_Util.substring_from uu___5 (length + Prims.int_one)) in if - FStarC_Compiler_Util.starts_with s + FStarC_Util.starts_with s FStarC_Syntax_Util.field_projector_prefix then let rest = - FStarC_Compiler_Util.substring_from s - (FStarC_Compiler_String.length + FStarC_Util.substring_from s + (FStarC_String.length FStarC_Syntax_Util.field_projector_prefix) in let r = - FStarC_Compiler_Util.split rest + FStarC_Util.split rest FStarC_Syntax_Util.field_projector_sep in (match r with | fst::snd::[] -> @@ -964,10 +951,10 @@ let rec (resugar_term' : let uu___3 = ((let uu___4 = is_projector e in FStar_Pervasives_Native.uu___is_Some uu___4) && - ((FStarC_Compiler_List.length args1) >= Prims.int_one)) + ((FStarC_List.length args1) >= Prims.int_one)) && (let uu___4 = - let uu___5 = FStarC_Compiler_List.hd args1 in + let uu___5 = FStarC_List.hd args1 in FStar_Pervasives_Native.snd uu___5 in FStar_Pervasives_Native.uu___is_None uu___4) in if uu___3 @@ -990,7 +977,7 @@ let rec (resugar_term' : (arg, uu___9) in FStarC_Parser_AST.Project uu___8 in mk uu___7 in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun uu___7 -> match uu___7 with @@ -1005,11 +992,10 @@ let rec (resugar_term' : (((let uu___6 = FStarC_Options.print_implicits () in Prims.op_Negation uu___6) && (let uu___6 = - FStarC_Options_Ext.get "show_hide_reveal" in - uu___6 = "")) + FStarC_Options_Ext.enabled "show_hide_reveal" in + Prims.op_Negation uu___6)) && (is_hide_or_reveal e)) - && - ((FStarC_Compiler_List.length args1) = Prims.int_one) in + && ((FStarC_List.length args1) = Prims.int_one) in if uu___5 then let uu___6 = args1 in @@ -1020,12 +1006,12 @@ let rec (resugar_term' : let rec unsnoc' acc uu___7 = match uu___7 with | [] -> failwith "unsnoc: empty list" - | x::[] -> ((FStarC_Compiler_List.rev acc), x) + | x::[] -> ((FStarC_List.rev acc), x) | x::xs -> unsnoc' (x :: acc) xs in unsnoc' [] l in let resugar_tuple_type env1 args2 = let typs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (x, uu___8) -> resugar_term' env1 x) args2 in @@ -1035,7 +1021,7 @@ let rec (resugar_term' : let uu___8 = let uu___9 = let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___11 -> FStar_Pervasives.Inr uu___11) pre in (uu___10, last1) in @@ -1044,13 +1030,13 @@ let rec (resugar_term' : let resugar_dtuple_type env1 hd args2 = let fancy_resugar uu___7 = (fun uu___7 -> - let n = FStarC_Compiler_List.length args2 in + let n = FStarC_List.length args2 in let take n1 l = - let uu___8 = FStarC_Compiler_List.splitAt n1 l in + let uu___8 = FStarC_List.splitAt n1 l in FStar_Pervasives_Native.fst uu___8 in let uu___8 = let uu___9 = - let uu___10 = FStarC_Compiler_List.last args2 in + let uu___10 = FStarC_List.last args2 in FStar_Pervasives_Native.fst uu___10 in FStarC_Syntax_Util.abs_formals uu___9 in match uu___8 with @@ -1059,7 +1045,7 @@ let rec (resugar_term' : (FStarC_Class_Monad.op_let_Bang FStarC_Class_Monad.monad_option () () (if - (FStarC_Compiler_List.length bs) < + (FStarC_List.length bs) < (n - Prims.int_one) then FStar_Pervasives_Native.None else FStar_Pervasives_Native.Some ()) @@ -1190,7 +1176,7 @@ let rec (resugar_term' : | (pre_bs_types, last_type) -> let bs2 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun t2 -> let b1 = @@ -1205,7 +1191,7 @@ let rec (resugar_term' : let uu___15 = let uu___16 = let uu___17 = - FStarC_Compiler_List.map + FStarC_List.map ( fun uu___18 @@ -1237,7 +1223,7 @@ let rec (resugar_term' : | FStar_Pervasives_Native.Some ts -> let uu___8 = let uu___9 = - FStarC_Compiler_List.map (resugar_term' env) ts in + FStarC_List.map (resugar_term' env) ts in FStarC_Parser_AST.ListLiteral uu___9 in mk uu___8 | FStar_Pervasives_Native.None -> @@ -1246,8 +1232,7 @@ let rec (resugar_term' : | FStar_Pervasives_Native.Some ts -> let uu___9 = let uu___10 = - FStarC_Compiler_List.map - (resugar_term' env) ts in + FStarC_List.map (resugar_term' env) ts in FStarC_Parser_AST.SeqLiteral uu___10 in mk uu___9 | FStar_Pervasives_Native.None -> @@ -1264,13 +1249,13 @@ let rec (resugar_term' : | FStar_Pervasives_Native.Some ("tuple", n) when (FStar_Pervasives_Native.Some - (FStarC_Compiler_List.length args1)) + (FStarC_List.length args1)) = n -> resugar_tuple_type env args1 | FStar_Pervasives_Native.Some ("dtuple", n) when (FStar_Pervasives_Native.Some - (FStarC_Compiler_List.length args1)) + (FStarC_List.length args1)) = n -> resugar_dtuple_type env e args1 | FStar_Pervasives_Native.Some @@ -1279,8 +1264,7 @@ let rec (resugar_term' : FStarC_Ident.string_of_lid FStarC_Parser_Const.sread_lid in ref_read = uu___11 -> - let uu___11 = - FStarC_Compiler_List.hd args1 in + let uu___11 = FStarC_List.hd args1 in (match uu___11 with | (t2, uu___12) -> let uu___13 = @@ -1316,8 +1300,7 @@ let rec (resugar_term' : | uu___14 -> resugar_term' env t2)) | FStar_Pervasives_Native.Some ("try_with", uu___10) when - (FStarC_Compiler_List.length args1) > - Prims.int_one + (FStarC_List.length args1) > Prims.int_one -> (try (fun uu___11 -> @@ -1442,11 +1425,8 @@ let rec (resugar_term' : -> resugar_as_app e args1 | FStar_Pervasives_Native.Some (op, uu___10) when - (FStarC_Compiler_Util.starts_with op - "forall") - || - (FStarC_Compiler_Util.starts_with op - "exists") + (FStarC_Util.starts_with op "forall") || + (FStarC_Util.starts_with op "exists") -> let rec uncurry xs pats t2 flavor_matches = @@ -1454,25 +1434,22 @@ let rec (resugar_term' : | FStarC_Parser_AST.QExists (xs', (uu___11, pats'), body) when flavor_matches t2 -> - uncurry - (FStarC_Compiler_List.op_At xs xs') - (FStarC_Compiler_List.op_At pats - pats') body flavor_matches + uncurry (FStarC_List.op_At xs xs') + (FStarC_List.op_At pats pats') + body flavor_matches | FStarC_Parser_AST.QForall (xs', (uu___11, pats'), body) when flavor_matches t2 -> - uncurry - (FStarC_Compiler_List.op_At xs xs') - (FStarC_Compiler_List.op_At pats - pats') body flavor_matches + uncurry (FStarC_List.op_At xs xs') + (FStarC_List.op_At pats pats') + body flavor_matches | FStarC_Parser_AST.QuantOp (uu___11, xs', (uu___12, pats'), body) when flavor_matches t2 -> - uncurry - (FStarC_Compiler_List.op_At xs xs') - (FStarC_Compiler_List.op_At pats - pats') body flavor_matches + uncurry (FStarC_List.op_At xs xs') + (FStarC_List.op_At pats pats') + body flavor_matches | uu___11 -> (xs, pats, t2) in let resugar_forall_body body = let uu___11 = @@ -1493,7 +1470,7 @@ let rec (resugar_term' : | (xs1, body2) -> let xs2 = filter_imp_bs xs1 in let xs3 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> resugar_binder' env b t1.FStarC_Syntax_Syntax.pos) @@ -1519,9 +1496,9 @@ let rec (resugar_term' : | FStarC_Syntax_Syntax.Meta_pattern (uu___17, pats) -> let uu___18 = - FStarC_Compiler_List.map + FStarC_List.map (fun es -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___19 -> @@ -1652,7 +1629,7 @@ let rec (resugar_term' : uu___15 in mk uu___14) in if - (FStarC_Compiler_List.length args1) > + (FStarC_List.length args1) > Prims.int_zero then let args2 = last args1 in @@ -1665,15 +1642,14 @@ let rec (resugar_term' : else resugar_as_app e args1 | FStar_Pervasives_Native.Some ("alloc", uu___10) -> - let uu___11 = - FStarC_Compiler_List.hd args1 in + let uu___11 = FStarC_List.hd args1 in (match uu___11 with | (e1, uu___12) -> resugar_term' env e1) | FStar_Pervasives_Native.Some (op, expected_arity1) -> let op1 = FStarC_Ident.id_of_text op in let resugar args2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___10 -> match uu___10 with | (e1, qual) -> @@ -1689,27 +1665,26 @@ let rec (resugar_term' : FStarC_Parser_ToDocument.handleable_args_length op1 in if - (FStarC_Compiler_List.length - resugared_args) + (FStarC_List.length resugared_args) >= expect_n then let uu___10 = - FStarC_Compiler_Util.first_N - expect_n resugared_args in + FStarC_Util.first_N expect_n + resugared_args in (match uu___10 with | (op_args, rest) -> let head = let uu___11 = let uu___12 = let uu___13 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst op_args in (op1, uu___13) in FStarC_Parser_AST.Op uu___12 in mk uu___11 in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun head1 -> fun uu___11 -> match uu___11 with @@ -1721,14 +1696,12 @@ let rec (resugar_term' : rest) else resugar_as_app e args1 | FStar_Pervasives_Native.Some n when - (FStarC_Compiler_List.length args1) = - n - -> + (FStarC_List.length args1) = n -> let uu___10 = let uu___11 = let uu___12 = let uu___13 = resugar args1 in - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst uu___13 in (op1, uu___12) in @@ -1783,7 +1756,7 @@ let rec (resugar_term' : let uu___2 = let uu___3 = let uu___4 = resugar_term' env e in - let uu___5 = FStarC_Compiler_List.map resugar_branch branches in + let uu___5 = FStarC_List.map resugar_branch branches in (uu___4, FStar_Pervasives_Native.None, asc_opt1, uu___5) in FStarC_Parser_AST.Match uu___3 in mk uu___2 @@ -1814,8 +1787,7 @@ let rec (resugar_term' : match bnd.FStarC_Syntax_Syntax.lbattrs with | [] -> FStar_Pervasives_Native.None | tms -> - let uu___2 = - FStarC_Compiler_List.map (resugar_term' env) tms in + let uu___2 = FStarC_List.map (resugar_term' env) tms in FStar_Pervasives_Native.Some uu___2 in let uu___2 = let uu___3 = @@ -1883,7 +1855,7 @@ let rec (resugar_term' : if is_pat_app then let args = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let q = resugar_bqual env @@ -1894,7 +1866,7 @@ let rec (resugar_term' : bv_as_unique_ident b.FStarC_Syntax_Syntax.binder_bv in let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map (resugar_term' env) b.FStarC_Syntax_Syntax.binder_attrs in (uu___9, q, uu___10) in @@ -1920,8 +1892,7 @@ let rec (resugar_term' : universe_to_string univs in (uu___8, uu___9)) in (attrs_opt, uu___6)))) in - let r = - FStarC_Compiler_List.map resugar_one_binding source_lbs1 in + let r = FStarC_List.map resugar_one_binding source_lbs1 in let bnds = let f uu___2 = match uu___2 with @@ -1937,7 +1908,7 @@ let rec (resugar_term' : label univs (FStar_Pervasives_Native.snd pb) in ((FStar_Pervasives_Native.fst pb), uu___6) in (attrs, uu___5)) in - FStarC_Compiler_List.map f r in + FStarC_List.map f r in let body2 = resugar_term' env body1 in mk (FStarC_Parser_AST.Let @@ -1950,7 +1921,7 @@ let rec (resugar_term' : let uu___3 = FStarC_Syntax_Unionfind.uvar_id u.FStarC_Syntax_Syntax.ctx_uvar_head in - FStarC_Compiler_Util.string_of_int uu___3 in + FStarC_Util.string_of_int uu___3 in Prims.strcat "?u" uu___2 in let uu___2 = mk FStarC_Parser_AST.Wild in label s uu___2 | FStarC_Syntax_Syntax.Tm_quoted (tm, qi) -> @@ -2016,8 +1987,7 @@ and (resugar_ascription : match asc with | FStar_Pervasives.Inl n -> resugar_term' env n | FStar_Pervasives.Inr n -> resugar_comp' env n in - let uu___2 = - FStarC_Compiler_Util.map_opt tac_opt (resugar_term' env) in + let uu___2 = FStarC_Util.map_opt tac_opt (resugar_term' env) in (uu___1, uu___2, b) and (resugar_calc : FStarC_Syntax_DsEnv.env -> @@ -2102,10 +2072,8 @@ and (resugar_calc : { FStarC_Syntax_Syntax.hd = e; FStarC_Syntax_Syntax.args = args;_} when - (FStarC_Compiler_List.length args) >= - (Prims.of_int (2)) - -> - (match FStarC_Compiler_List.rev args with + (FStarC_List.length args) >= (Prims.of_int (2)) -> + (match FStarC_List.rev args with | (a1, FStar_Pervasives_Native.None)::(a2, FStar_Pervasives_Native.None)::rest -> @@ -2119,7 +2087,7 @@ and (resugar_calc : then let uu___5 = FStarC_Syntax_Util.mk_app e - (FStarC_Compiler_List.rev rest) in + (FStarC_List.rev rest) in FStar_Pervasives_Native.Some uu___5 else FStar_Pervasives_Native.Some rel | uu___4 -> FStar_Pervasives_Native.Some rel) @@ -2188,7 +2156,7 @@ and (resugar_calc : match uu___ with | FStar_Pervasives_Native.Some (t, r, j, k) -> let uu___1 = resugar_all_steps k in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun uu___2 -> match uu___2 with | (steps, k1) -> @@ -2232,7 +2200,7 @@ and (resugar_calc : let uu___2 = resugar_rel rel in let uu___3 = r x0 in let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (z, rel1, j) -> @@ -2273,7 +2241,7 @@ and (resugar_calc : let x0 = Obj.magic x0 in let uu___5 = build_calc rel x0 - (FStarC_Compiler_List.rev + (FStarC_List.rev steps) in Obj.magic (FStar_Pervasives_Native.Some @@ -2282,7 +2250,7 @@ and (resugar_calc : and (resugar_match_returns : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.binder * ((FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax, FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax) @@ -2304,7 +2272,7 @@ and (resugar_match_returns : let uu___1 = FStarC_Syntax_Subst.open_ascription [b] asc in match uu___1 with | (bs, asc1) -> - let b1 = FStarC_Compiler_List.hd bs in + let b1 = FStarC_List.hd bs in let uu___2 = let uu___3 = FStarC_Ident.string_of_id @@ -2336,7 +2304,7 @@ and (resugar_match_returns : (match uu___ with | (bopt, asc1) -> let bopt1 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun b1 -> let uu___1 = resugar_binder' env b1 r in FStarC_Parser_AST.ident_of_binder r uu___1) bopt in @@ -2395,8 +2363,7 @@ and (resugar_comp' : | FStarC_Syntax_Syntax.Decreases_lex ts -> let uu___1 = let uu___2 = - FStarC_Compiler_List.map (resugar_term' env) - ts in + FStarC_List.map (resugar_term' env) ts in FStarC_Parser_AST.LexList uu___2 in mk uu___1 | FStarC_Syntax_Syntax.Decreases_wf (rel, e) -> @@ -2418,13 +2385,12 @@ and (resugar_comp' : (FStarC_Ident.lid_equals c1.FStarC_Syntax_Syntax.effect_name FStarC_Parser_Const.effect_Lemma_lid) && - ((FStarC_Compiler_List.length - c1.FStarC_Syntax_Syntax.effect_args) - = (Prims.of_int (3))) in + ((FStarC_List.length c1.FStarC_Syntax_Syntax.effect_args) = + (Prims.of_int (3))) in if uu___ then let args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (e, uu___2) -> @@ -2451,7 +2417,7 @@ and (resugar_comp' : uu___3 in if uu___2 then [] else [pats] in let pre2 = - FStarC_Compiler_List.map + FStarC_List.map (fun t -> let uu___2 = let uu___3 = @@ -2466,8 +2432,7 @@ and (resugar_comp' : (uu___4, FStar_Pervasives_Native.None) in FStarC_Parser_AST.Ensures uu___3 in mk uu___2 in - let pats2 = - FStarC_Compiler_List.map (resugar_term' env) pats1 in + let pats2 = FStarC_List.map (resugar_term' env) pats1 in let decrease = mk_decreases c1.FStarC_Syntax_Syntax.flags in let uu___2 = let uu___3 = @@ -2475,11 +2440,10 @@ and (resugar_comp' : maybe_shorten_lid env c1.FStarC_Syntax_Syntax.effect_name in let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun t -> (t, FStarC_Parser_AST.Nothing)) - (FStarC_Compiler_List.op_At pre2 - (FStarC_Compiler_List.op_At (post2 :: decrease) - pats2)) in + (FStarC_List.op_At pre2 + (FStarC_List.op_At (post2 :: decrease) pats2)) in (uu___4, uu___5) in FStarC_Parser_AST.Construct uu___3 in mk uu___2) @@ -2488,7 +2452,7 @@ and (resugar_comp' : if uu___2 then let args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (e, uu___4) -> @@ -2497,15 +2461,14 @@ and (resugar_comp' : c1.FStarC_Syntax_Syntax.effect_args in let decrease = let uu___3 = mk_decreases c1.FStarC_Syntax_Syntax.flags in - FStarC_Compiler_List.map - (fun t -> (t, FStarC_Parser_AST.Nothing)) uu___3 in + FStarC_List.map (fun t -> (t, FStarC_Parser_AST.Nothing)) + uu___3 in let uu___3 = let uu___4 = let uu___5 = maybe_shorten_lid env c1.FStarC_Syntax_Syntax.effect_name in - (uu___5, - (FStarC_Compiler_List.op_At (result :: decrease) args)) in + (uu___5, (FStarC_List.op_At (result :: decrease) args)) in FStarC_Parser_AST.Construct uu___4 in mk uu___3 else @@ -2520,7 +2483,7 @@ and (resugar_comp' : and (resugar_binder' : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.binder -> - FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.binder) + FStarC_Range_Type.range -> FStarC_Parser_AST.binder) = fun env -> fun b -> @@ -2530,7 +2493,7 @@ and (resugar_binder' : resugar_term' env (b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort in let attrs = - FStarC_Compiler_List.map (resugar_term' env) + FStarC_List.map (resugar_term' env) b.FStarC_Syntax_Syntax.binder_attrs in let b' = match e.FStarC_Parser_AST.tm with @@ -2555,7 +2518,7 @@ and (resugar_bv_as_pat' : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.bv -> FStarC_Parser_AST.arg_qualifier FStar_Pervasives_Native.option -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t -> + FStarC_Syntax_Syntax.bv FStarC_FlatSet.t -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax FStar_Pervasives_Native.option -> FStarC_Parser_AST.pattern) = @@ -2570,7 +2533,7 @@ and (resugar_bv_as_pat' : let used = FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) v (Obj.magic body_bv) in let pat = let uu___ = @@ -2606,8 +2569,7 @@ and (resugar_bv_as_pat : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t -> - FStarC_Parser_AST.pattern) + FStarC_Syntax_Syntax.bv FStarC_FlatSet.t -> FStarC_Parser_AST.pattern) = fun env -> fun x -> @@ -2622,21 +2584,20 @@ and (resugar_bv_as_pat : and (resugar_pat' : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.pat -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t -> - FStarC_Parser_AST.pattern) + FStarC_Syntax_Syntax.bv FStarC_FlatSet.t -> FStarC_Parser_AST.pattern) = fun env -> fun p -> fun branch_bv -> let mk a = FStarC_Parser_AST.mk_pattern a p.FStarC_Syntax_Syntax.p in let to_arg_qual bopt = - FStarC_Compiler_Util.bind_opt bopt + FStarC_Util.bind_opt bopt (fun b -> if b then FStar_Pervasives_Native.Some FStarC_Parser_AST.Implicit else FStar_Pervasives_Native.None) in let must_print args = - FStarC_Compiler_List.existsML + FStarC_List.existsML (fun uu___ -> match uu___ with | (pattern, is_implicit) -> @@ -2645,7 +2606,7 @@ and (resugar_pat' : is_implicit && (FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) bv (Obj.magic branch_bv)) | uu___1 -> false)) args in @@ -2665,7 +2626,7 @@ and (resugar_pat' : let uu___1 = must_print args in Prims.op_Negation uu___1 in if uu___ then filter_pattern_imp args else args in let args2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (p1, b) -> aux p1 (FStar_Pervasives_Native.Some b)) args1 in @@ -2711,7 +2672,7 @@ and (resugar_pat' : && (let uu___1 = must_print args in Prims.op_Negation uu___1) -> let args1 = - FStarC_Compiler_List.filter_map + FStarC_List.filter_map (fun uu___1 -> match uu___1 with | (p2, is_implicit) -> @@ -2733,17 +2694,17 @@ and (resugar_pat' : -> let fields1 = let uu___2 = - FStarC_Compiler_List.map - (fun f -> FStarC_Ident.lid_of_ids [f]) fields in - FStarC_Compiler_List.rev uu___2 in + FStarC_List.map (fun f -> FStarC_Ident.lid_of_ids [f]) + fields in + FStarC_List.rev uu___2 in let args1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (p2, b) -> aux p2 (FStar_Pervasives_Native.Some b)) args in - FStarC_Compiler_List.rev uu___2 in + FStarC_List.rev uu___2 in let rec map2 l1 l2 = match (l1, l2) with | ([], []) -> [] @@ -2759,8 +2720,7 @@ and (resugar_pat' : | (hd1::tl1, hd2::tl2) -> let uu___2 = map2 tl1 tl2 in (hd1, hd2) :: uu___2 in let args2 = - let uu___2 = map2 fields1 args1 in - FStarC_Compiler_List.rev uu___2 in + let uu___2 = map2 fields1 args1 in FStarC_List.rev uu___2 in mk (FStarC_Parser_AST.PatRecord args2) | FStarC_Syntax_Syntax.Pat_cons (fv, uu___, args) -> resugar_plain_pat_cons fv args @@ -2890,7 +2850,7 @@ let (drop_n_bs : match uu___ with | (bs, c) -> let bs1 = - let uu___1 = FStarC_Compiler_List.splitAt n bs in + let uu___1 = FStarC_List.splitAt n bs in FStar_Pervasives_Native.snd uu___1 in FStarC_Syntax_Util.arrow bs1 c let (resugar_typ : @@ -2914,7 +2874,7 @@ let (resugar_typ : FStarC_Syntax_Syntax.injective_type_params = uu___2;_} -> let uu___3 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun se1 -> match se1.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -2931,17 +2891,16 @@ let (resugar_typ : | (current_datacons, other_datacons) -> let bs1 = filter_imp_bs bs in let bs2 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> resugar_binder' env b t.FStarC_Syntax_Syntax.pos) bs1 in let tyc = let uu___4 = - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some FStarC_Syntax_Syntax.uu___is_RecordType se.FStarC_Syntax_Syntax.sigquals) && - ((FStarC_Compiler_List.length current_datacons) = - Prims.int_one) in + ((FStarC_List.length current_datacons) = Prims.int_one) in if uu___4 then let uu___5 = current_datacons in @@ -2966,7 +2925,7 @@ let (resugar_typ : match uu___9 with | (bs3, uu___10) -> let bs4 = filter_imp_bs bs3 in - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let q = resugar_bqual env @@ -2975,7 +2934,7 @@ let (resugar_typ : bv_as_unique_ident b.FStarC_Syntax_Syntax.binder_bv in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (resugar_term' env) b.FStarC_Syntax_Syntax.binder_attrs in let uu___13 = @@ -2985,8 +2944,7 @@ let (resugar_typ : let uu___9 = let uu___10 = FStarC_Ident.ident_of_lid tylid in let uu___11 = - FStarC_Compiler_List.map - (resugar_term' env) + FStarC_List.map (resugar_term' env) se.FStarC_Syntax_Syntax.sigattrs in (uu___10, bs2, FStar_Pervasives_Native.None, uu___11, fields) in @@ -3014,13 +2972,13 @@ let (resugar_typ : FStarC_Parser_AST.VpArbitrary uu___12 in FStar_Pervasives_Native.Some uu___11 in let uu___11 = - FStarC_Compiler_List.map (resugar_term' env) + FStarC_List.map (resugar_term' env) se1.FStarC_Syntax_Syntax.sigattrs in (uu___9, uu___10, uu___11) in c :: constructors | uu___6 -> failwith "unexpected" in let constructors = - FStarC_Compiler_List.fold_left resugar_datacon [] + FStarC_List.fold_left resugar_datacon [] current_datacons in let uu___6 = let uu___7 = FStarC_Ident.ident_of_lid tylid in @@ -3032,14 +2990,14 @@ let (resugar_typ : failwith "Impossible : only Sig_inductive_typ can be resugared as types" let (mk_decl : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.qualifier Prims.list -> FStarC_Parser_AST.decl' -> FStarC_Parser_AST.decl) = fun r -> fun q -> fun d' -> - let uu___ = FStarC_Compiler_List.choose resugar_qualifier q in + let uu___ = FStarC_List.choose resugar_qualifier q in { FStarC_Parser_AST.d = d'; FStarC_Parser_AST.drange = r; @@ -3103,9 +3061,7 @@ let (resugar_wp_eff_combinators : let bind_repr = resugar_opt "bind_repr" combs.FStarC_Syntax_Syntax.bind_repr in if for_free - then - FStarC_Compiler_List.op_At repr - (FStarC_Compiler_List.op_At return_repr bind_repr) + then FStarC_List.op_At repr (FStarC_List.op_At return_repr bind_repr) else (let uu___1 = resugar_tscheme'' env "ret_wp" combs.FStarC_Syntax_Syntax.ret_wp in @@ -3134,8 +3090,8 @@ let (resugar_wp_eff_combinators : resugar_tscheme'' env "trivial" combs.FStarC_Syntax_Syntax.trivial in uu___13 :: - (FStarC_Compiler_List.op_At repr - (FStarC_Compiler_List.op_At return_repr bind_repr)) in + (FStarC_List.op_At repr + (FStarC_List.op_At return_repr bind_repr)) in uu___11 :: uu___12 in uu___9 :: uu___10 in uu___7 :: uu___8 in @@ -3190,7 +3146,7 @@ let (resugar_eff_decl' : = fun env -> fun ed -> - let r = FStarC_Compiler_Range_Type.dummyRange in + let r = FStarC_Range_Type.dummyRange in let q = [] in let resugar_action d for_free = let action_params = @@ -3209,9 +3165,9 @@ let (resugar_eff_decl' : let action_params1 = filter_imp_bs action_params in let action_params2 = let uu___2 = - FStarC_Compiler_List.map - (fun b -> resugar_binder' env b r) action_params1 in - FStarC_Compiler_List.rev uu___2 in + FStarC_List.map (fun b -> resugar_binder' env b r) + action_params1 in + FStarC_List.rev uu___2 in let action_defn1 = resugar_term' env action_defn in let action_typ1 = resugar_term' env action_typ in if for_free @@ -3266,17 +3222,15 @@ let (resugar_eff_decl' : let eff_binders1 = filter_imp_bs eff_binders in let eff_binders2 = let uu___1 = - FStarC_Compiler_List.map (fun b -> resugar_binder' env b r) - eff_binders1 in - FStarC_Compiler_List.rev uu___1 in + FStarC_List.map (fun b -> resugar_binder' env b r) eff_binders1 in + FStarC_List.rev uu___1 in let eff_typ1 = resugar_term' env eff_typ in let mandatory_members_decls = resugar_combinators env ed.FStarC_Syntax_Syntax.combinators in let actions = - FStarC_Compiler_List.map (fun a -> resugar_action a false) + FStarC_List.map (fun a -> resugar_action a false) ed.FStarC_Syntax_Syntax.actions in - let decls = - FStarC_Compiler_List.op_At mandatory_members_decls actions in + let decls = FStarC_List.op_At mandatory_members_decls actions in mk_decl r q (FStarC_Parser_AST.NewEffect (FStarC_Parser_AST.DefineEffect @@ -3295,7 +3249,7 @@ let (resugar_sigelt' : FStarC_Syntax_Syntax.lids = uu___;_} -> let uu___1 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun se1 -> match se1.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ uu___2 -> true @@ -3315,9 +3269,8 @@ let (resugar_sigelt' : | (datacon_ses2, tyc) -> (datacon_ses2, (tyc :: tycons))) in let uu___2 = - FStarC_Compiler_List.fold_left - retrieve_datacons_and_resugar (datacon_ses, []) - decl_typ_ses in + FStarC_List.fold_left retrieve_datacons_and_resugar + (datacon_ses, []) decl_typ_ses in (match uu___2 with | (leftover_datacons, tycons) -> (match leftover_datacons with @@ -3358,7 +3311,7 @@ let (resugar_sigelt' : FStarC_Syntax_Syntax.lids1 = uu___;_} -> let uu___1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Projector (uu___3, uu___4) -> true @@ -3384,12 +3337,12 @@ let (resugar_sigelt' : FStarC_Syntax_Syntax.lid_as_fv uu___4 FStar_Pervasives_Native.None in let lbs2 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in nopath uu___6 in FStar_Pervasives.Inr uu___5 in @@ -3424,8 +3377,7 @@ let (resugar_sigelt' : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.snd lets in + FStarC_List.map FStar_Pervasives_Native.snd lets in (isrec, uu___7) in FStarC_Parser_AST.TopLevelLet uu___6 in decl'_to_decl se uu___5 in @@ -3447,7 +3399,7 @@ let (resugar_sigelt' : | FStarC_Syntax_Syntax.Sig_new_effect ed -> let a_decl = resugar_eff_decl' env ed in let q = - FStarC_Compiler_List.choose resugar_qualifier + FStarC_List.choose resugar_qualifier se.FStarC_Syntax_Syntax.sigquals in FStar_Pervasives_Native.Some { @@ -3504,7 +3456,7 @@ let (resugar_sigelt' : | (bs1, c1) -> let bs2 = filter_imp_bs bs1 in let bs3 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> resugar_binder' env b se.FStarC_Syntax_Syntax.sigrng) bs2 in @@ -3533,7 +3485,7 @@ let (resugar_sigelt' : FStarC_Syntax_Syntax.us2 = uvs; FStarC_Syntax_Syntax.t2 = t;_} -> let uu___ = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.Projector (uu___2, uu___3) -> true @@ -3545,8 +3497,7 @@ let (resugar_sigelt' : (let t' = let uu___2 = (let uu___3 = FStarC_Options.print_universes () in - Prims.op_Negation uu___3) || - (FStarC_Compiler_List.isEmpty uvs) in + Prims.op_Negation uu___3) || (FStarC_List.isEmpty uvs) in if uu___2 then resugar_term' env t else @@ -3573,8 +3524,8 @@ let (resugar_sigelt' : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map - (fun l -> FStarC_Ident.ident_of_lid l) ids in + FStarC_List.map (fun l -> FStarC_Ident.ident_of_lid l) + ids in let uu___4 = resugar_term' env t in (is_typed, uu___3, uu___4) in FStarC_Parser_AST.Splice uu___2 in @@ -3616,7 +3567,7 @@ let (resugar_sigelt' : | FStar_Pervasives_Native.Some d1 -> let uu___ = let uu___1 = - FStarC_Compiler_List.map (resugar_term' env) + FStarC_List.map (resugar_term' env) se.FStarC_Syntax_Syntax.sigattrs in { FStarC_Parser_AST.d = (d1.FStarC_Parser_AST.d); @@ -3641,14 +3592,13 @@ let (resugar_comp : FStarC_Syntax_Syntax.comp -> FStarC_Parser_AST.term) = fun c -> let uu___ = noenv resugar_comp' in uu___ c let (resugar_pat : FStarC_Syntax_Syntax.pat -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t -> - FStarC_Parser_AST.pattern) + FStarC_Syntax_Syntax.bv FStarC_FlatSet.t -> FStarC_Parser_AST.pattern) = fun p -> fun branch_bv -> let uu___ = noenv resugar_pat' in uu___ p branch_bv let (resugar_binder : FStarC_Syntax_Syntax.binder -> - FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.binder) + FStarC_Range_Type.range -> FStarC_Parser_AST.binder) = fun b -> fun r -> let uu___ = noenv resugar_binder' in uu___ b r let (resugar_tscheme : FStarC_Syntax_Syntax.tscheme -> FStarC_Parser_AST.decl) = diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Subst.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Subst.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_Syntax_Subst.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Subst.ml index 5ad3c9f4010..ab8201d0c69 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Subst.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Subst.ml @@ -3,12 +3,12 @@ let subst_to_string : 'uuuuu . (FStarC_Syntax_Syntax.bv * 'uuuuu) Prims.list -> Prims.string = fun s -> let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (b, uu___2) -> FStarC_Ident.string_of_id b.FStarC_Syntax_Syntax.ppname) s in - FStarC_Compiler_String.concat ", " uu___ + FStarC_String.concat ", " uu___ let rec apply_until_some : 'uuuuu 'uuuuu1 . ('uuuuu -> 'uuuuu1 FStar_Pervasives_Native.option) -> @@ -55,7 +55,7 @@ let compose_subst : fun s1 -> fun s2 -> let s = - FStarC_Compiler_List.op_At (FStar_Pervasives_Native.fst s1) + FStarC_List.op_At (FStar_Pervasives_Native.fst s1) (FStar_Pervasives_Native.fst s2) in let ropt = match FStar_Pervasives_Native.snd s2 with @@ -136,7 +136,7 @@ let (subst_bv : = fun a -> fun s -> - FStarC_Compiler_Util.find_map s + FStarC_Util.find_map s (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.DB (i, x) when @@ -159,7 +159,7 @@ let (subst_nm : = fun a -> fun s -> - FStarC_Compiler_Util.find_map s + FStarC_Util.find_map s (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.NM (x, i) when @@ -185,7 +185,7 @@ let (subst_univ_bv : = fun x -> fun s -> - FStarC_Compiler_Util.find_map s + FStarC_Util.find_map s (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.UN (y, t) when x = y -> @@ -198,7 +198,7 @@ let (subst_univ_nm : = fun x -> fun s -> - FStarC_Compiler_Util.find_map s + FStarC_Util.find_map s (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.UD (y, i) when @@ -223,7 +223,7 @@ let rec (subst_univ : | FStarC_Syntax_Syntax.U_succ u2 -> let uu___ = subst_univ s u2 in FStarC_Syntax_Syntax.U_succ uu___ | FStarC_Syntax_Syntax.U_max us -> - let uu___ = FStarC_Compiler_List.map (subst_univ s) us in + let uu___ = FStarC_List.map (subst_univ s) us in FStarC_Syntax_Syntax.U_max uu___ let tag_with_range : 'uuuuu . @@ -238,16 +238,16 @@ let tag_with_range : | FStarC_Syntax_Syntax.SomeUseRange r -> let uu___ = let uu___1 = - FStarC_Compiler_Range_Type.use_range t.FStarC_Syntax_Syntax.pos in - let uu___2 = FStarC_Compiler_Range_Type.use_range r in - FStarC_Compiler_Range_Ops.rng_included uu___1 uu___2 in + FStarC_Range_Type.use_range t.FStarC_Syntax_Syntax.pos in + let uu___2 = FStarC_Range_Type.use_range r in + FStarC_Range_Ops.rng_included uu___1 uu___2 in if uu___ then t else (let r1 = - let uu___2 = FStarC_Compiler_Range_Type.use_range r in - FStarC_Compiler_Range_Type.set_use_range - t.FStarC_Syntax_Syntax.pos uu___2 in + let uu___2 = FStarC_Range_Type.use_range r in + FStarC_Range_Type.set_use_range t.FStarC_Syntax_Syntax.pos + uu___2 in let t' = match t.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_bvar bv -> @@ -295,20 +295,20 @@ let tag_lid_with_range : let uu___ = let uu___1 = let uu___2 = FStarC_Ident.range_of_lid l in - FStarC_Compiler_Range_Type.use_range uu___2 in - let uu___2 = FStarC_Compiler_Range_Type.use_range r in - FStarC_Compiler_Range_Ops.rng_included uu___1 uu___2 in + FStarC_Range_Type.use_range uu___2 in + let uu___2 = FStarC_Range_Type.use_range r in + FStarC_Range_Ops.rng_included uu___1 uu___2 in if uu___ then l else (let uu___2 = let uu___3 = FStarC_Ident.range_of_lid l in - let uu___4 = FStarC_Compiler_Range_Type.use_range r in - FStarC_Compiler_Range_Type.set_use_range uu___3 uu___4 in + let uu___4 = FStarC_Range_Type.use_range r in + FStarC_Range_Type.set_use_range uu___3 uu___4 in FStarC_Ident.set_lid_range l uu___2) let (mk_range : - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.subst_ts -> FStarC_Compiler_Range_Type.range) + FStarC_Range_Type.range -> + FStarC_Syntax_Syntax.subst_ts -> FStarC_Range_Type.range) = fun r -> fun s -> @@ -316,14 +316,14 @@ let (mk_range : | FStarC_Syntax_Syntax.NoUseRange -> r | FStarC_Syntax_Syntax.SomeUseRange r' -> let uu___ = - let uu___1 = FStarC_Compiler_Range_Type.use_range r in - let uu___2 = FStarC_Compiler_Range_Type.use_range r' in - FStarC_Compiler_Range_Ops.rng_included uu___1 uu___2 in + let uu___1 = FStarC_Range_Type.use_range r in + let uu___2 = FStarC_Range_Type.use_range r' in + FStarC_Range_Ops.rng_included uu___1 uu___2 in if uu___ then r else - (let uu___2 = FStarC_Compiler_Range_Type.use_range r' in - FStarC_Compiler_Range_Type.set_use_range r uu___2) + (let uu___2 = FStarC_Range_Type.use_range r' in + FStarC_Range_Type.set_use_range r uu___2) let rec (subst' : FStarC_Syntax_Syntax.subst_ts -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) @@ -370,7 +370,7 @@ let (subst_dec_order' : fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Decreases_lex l -> - let uu___1 = FStarC_Compiler_List.map (subst' s) l in + let uu___1 = FStarC_List.map (subst' s) l in FStarC_Syntax_Syntax.Decreases_lex uu___1 | FStarC_Syntax_Syntax.Decreases_wf (rel, e) -> let uu___1 = @@ -384,7 +384,7 @@ let (subst_flags' : = fun s -> fun flags -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.DECREASES dec_order -> @@ -415,7 +415,7 @@ let (subst_aqual' : | FStar_Pervasives_Native.Some a -> let uu___ = let uu___1 = - FStarC_Compiler_List.map (subst' s) + FStarC_List.map (subst' s) a.FStarC_Syntax_Syntax.aqual_attributes in { FStarC_Syntax_Syntax.aqual_implicit = @@ -435,14 +435,13 @@ let (subst_comp_typ' : | ([]::[], FStarC_Syntax_Syntax.NoUseRange) -> t | uu___ -> let uu___1 = - FStarC_Compiler_List.map - (subst_univ (FStar_Pervasives_Native.fst s)) + FStarC_List.map (subst_univ (FStar_Pervasives_Native.fst s)) t.FStarC_Syntax_Syntax.comp_univs in let uu___2 = tag_lid_with_range t.FStarC_Syntax_Syntax.effect_name s in let uu___3 = subst' s t.FStarC_Syntax_Syntax.result_typ in let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (t1, imp) -> @@ -498,7 +497,7 @@ let (subst_ascription' : let uu___1 = subst' s t in FStar_Pervasives.Inl uu___1 | FStar_Pervasives.Inr c -> let uu___1 = subst_comp' s c in FStar_Pervasives.Inr uu___1 in - let uu___1 = FStarC_Compiler_Util.map_opt topt (subst' s) in + let uu___1 = FStarC_Util.map_opt topt (subst' s) in (annot1, uu___1, use_eq) let (shift : Prims.int -> @@ -520,7 +519,7 @@ let (shift : | FStarC_Syntax_Syntax.NT uu___ -> s let (shift_subst : Prims.int -> FStarC_Syntax_Syntax.subst_t -> FStarC_Syntax_Syntax.subst_t) - = fun n -> fun s -> FStarC_Compiler_List.map (shift n) s + = fun n -> fun s -> FStarC_List.map (shift n) s let shift_subst' : 'uuuuu . Prims.int -> @@ -530,8 +529,7 @@ let shift_subst' : fun n -> fun s -> let uu___ = - FStarC_Compiler_List.map (shift_subst n) - (FStar_Pervasives_Native.fst s) in + FStarC_List.map (shift_subst n) (FStar_Pervasives_Native.fst s) in (uu___, (FStar_Pervasives_Native.snd s)) let (subst_binder' : FStarC_Syntax_Syntax.subst_ts -> @@ -551,8 +549,7 @@ let (subst_binder' : } in let uu___1 = subst_bqual' s b.FStarC_Syntax_Syntax.binder_qual in let uu___2 = - FStarC_Compiler_List.map (subst' s) - b.FStarC_Syntax_Syntax.binder_attrs in + FStarC_List.map (subst' s) b.FStarC_Syntax_Syntax.binder_attrs in FStarC_Syntax_Syntax.mk_binder_with_attrs uu___ uu___1 b.FStarC_Syntax_Syntax.binder_positivity uu___2 let (subst_binder : @@ -567,7 +564,7 @@ let (subst_binders' : = fun s -> fun bs -> - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun b -> if i = Prims.int_zero @@ -593,7 +590,7 @@ let subst_args' : FStarC_Syntax_Syntax.subst_ts -> (FStarC_Syntax_Syntax.term * 'uuuuu) Prims.list -> (FStarC_Syntax_Syntax.term * 'uuuuu) Prims.list - = fun s -> FStarC_Compiler_List.map (subst_arg' s) + = fun s -> FStarC_List.map (subst_arg' s) let (subst_univs_opt : FStarC_Syntax_Syntax.subst_elt Prims.list Prims.list -> FStarC_Syntax_Syntax.universe Prims.list FStar_Pervasives_Native.option @@ -605,7 +602,7 @@ let (subst_univs_opt : match us_opt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some us -> - let uu___ = FStarC_Compiler_List.map (subst_univ sub) us in + let uu___ = FStarC_List.map (subst_univ sub) us in FStar_Pervasives_Native.Some uu___ let (subst_pat' : (FStarC_Syntax_Syntax.subst_t Prims.list * @@ -625,7 +622,7 @@ let (subst_pat' : FStar_Pervasives_Native.fst uu___1 in subst_univs_opt uu___ us_opt in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -639,7 +636,7 @@ let (subst_pat' : ({ FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_cons - (fv, us_opt1, (FStarC_Compiler_List.rev pats1))); + (fv, us_opt1, (FStarC_List.rev pats1))); FStarC_Syntax_Syntax.p = (p1.FStarC_Syntax_Syntax.p) }, n1)) | FStarC_Syntax_Syntax.Pat_var x -> @@ -657,7 +654,7 @@ let (subst_pat' : }, (n + Prims.int_one)) | FStarC_Syntax_Syntax.Pat_dot_term eopt -> let s1 = shift_subst' n s in - let eopt1 = FStarC_Compiler_Util.map_option (subst' s1) eopt in + let eopt1 = FStarC_Util.map_option (subst' s1) eopt in ({ FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_dot_term eopt1); @@ -675,7 +672,7 @@ let (push_subst_lcomp : | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some rc -> let residual_typ = - FStarC_Compiler_Util.map_opt rc.FStarC_Syntax_Syntax.residual_typ + FStarC_Util.map_opt rc.FStarC_Syntax_Syntax.residual_typ (subst' s) in let rc1 = { @@ -695,7 +692,7 @@ let (compose_uvar_subst : fun s0 -> fun s -> let should_retain x = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun b -> FStarC_Syntax_Syntax.bv_eq x b.FStarC_Syntax_Syntax.binder_bv) u.FStarC_Syntax_Syntax.ctx_uvar_binders in @@ -704,7 +701,7 @@ let (compose_uvar_subst : | [] -> [] | hd_subst::rest -> let hd = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.NT (x, t) -> @@ -743,10 +740,10 @@ let (compose_uvar_subst : | uu___3 -> [FStarC_Syntax_Syntax.NT (x, t)]) else [] | uu___2 -> []) hd_subst in - let uu___1 = aux rest in FStarC_Compiler_List.op_At hd uu___1 in + let uu___1 = aux rest in FStarC_List.op_At hd uu___1 in let uu___ = aux - (FStarC_Compiler_List.op_At (FStar_Pervasives_Native.fst s0) + (FStarC_List.op_At (FStar_Pervasives_Native.fst s0) (FStar_Pervasives_Native.fst s)) in match uu___ with | [] -> ([], (FStar_Pervasives_Native.snd s)) @@ -772,9 +769,9 @@ let rec (push_subst_aux : let t1 = let uu___1 = let uu___2 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang FStarC_Syntax_Syntax.lazy_chooser in - FStarC_Compiler_Util.must uu___2 in + FStarC_Util.must uu___2 in uu___1 i.FStarC_Syntax_Syntax.lkind i in push_subst_aux resolve_uvars s t1 | uu___ -> tag_with_range t s) @@ -811,8 +808,7 @@ let rec (push_subst_aux : | FStarC_Syntax_Syntax.Tm_name uu___ -> subst' s t | FStarC_Syntax_Syntax.Tm_uinst (t', us) -> let us1 = - FStarC_Compiler_List.map - (subst_univ (FStar_Pervasives_Native.fst s)) us in + FStarC_List.map (subst_univ (FStar_Pervasives_Native.fst s)) us in let uu___ = mk (FStarC_Syntax_Syntax.Tm_uinst (t', us1)) in tag_with_range uu___ s | FStarC_Syntax_Syntax.Tm_app @@ -848,7 +844,7 @@ let rec (push_subst_aux : { FStarC_Syntax_Syntax.bs = bs; FStarC_Syntax_Syntax.body = body; FStarC_Syntax_Syntax.rc_opt = lopt;_} -> - let n = FStarC_Compiler_List.length bs in + let n = FStarC_List.length bs in let s' = shift_subst' n s in let uu___ = let uu___1 = @@ -866,7 +862,7 @@ let rec (push_subst_aux : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = comp;_} -> - let n = FStarC_Compiler_List.length bs in + let n = FStarC_List.length bs in let uu___ = let uu___1 = let uu___2 = subst_binders' s bs in @@ -904,7 +900,7 @@ let rec (push_subst_aux : -> let t01 = subst' s t0 in let pats1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (pat, wopt, branch) -> @@ -945,18 +941,17 @@ let rec (push_subst_aux : { FStarC_Syntax_Syntax.lbs = (is_rec, lbs); FStarC_Syntax_Syntax.body1 = body;_} -> - let n = FStarC_Compiler_List.length lbs in + let n = FStarC_List.length lbs in let sn = shift_subst' n s in let body1 = subst' sn body in let lbs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let lbt = subst' s lb.FStarC_Syntax_Syntax.lbtyp in let lbd = let uu___ = is_rec && - (FStarC_Compiler_Util.is_left - lb.FStarC_Syntax_Syntax.lbname) in + (FStarC_Util.is_left lb.FStarC_Syntax_Syntax.lbname) in if uu___ then subst' sn lb.FStarC_Syntax_Syntax.lbdef else subst' s lb.FStarC_Syntax_Syntax.lbdef in @@ -973,7 +968,7 @@ let rec (push_subst_aux : } | FStar_Pervasives.Inr fv -> FStar_Pervasives.Inr fv in let lbattrs = - FStarC_Compiler_List.map (subst' s) + FStarC_List.map (subst' s) lb.FStarC_Syntax_Syntax.lbattrs in { FStarC_Syntax_Syntax.lbname = lbname; @@ -1003,8 +998,8 @@ let rec (push_subst_aux : let uu___2 = subst' s t0 in let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_List.map (subst' s) bs in - let uu___6 = FStarC_Compiler_List.map (subst_args' s) ps in + let uu___5 = FStarC_List.map (subst' s) bs in + let uu___6 = FStarC_List.map (subst_args' s) ps in (uu___5, uu___6) in FStarC_Syntax_Syntax.Meta_pattern uu___4 in { @@ -1104,7 +1099,7 @@ let (subst : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun s -> fun t -> subst' ([s], FStarC_Syntax_Syntax.NoUseRange) t let (set_use_range : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun r -> @@ -1112,8 +1107,8 @@ let (set_use_range : let uu___ = let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Range_Type.use_range r in - FStarC_Compiler_Range_Type.set_def_range r uu___3 in + let uu___3 = FStarC_Range_Type.use_range r in + FStarC_Range_Type.set_def_range r uu___3 in FStarC_Syntax_Syntax.SomeUseRange uu___2 in ([], uu___1) in subst' uu___ t @@ -1167,7 +1162,7 @@ let (closing_subst : = fun bs -> let uu___ = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun uu___1 -> match uu___1 with @@ -1200,8 +1195,7 @@ let (open_binders' : } in let imp = subst_bqual o b.FStarC_Syntax_Syntax.binder_qual in let attrs = - FStarC_Compiler_List.map (subst o) - b.FStarC_Syntax_Syntax.binder_attrs in + FStarC_List.map (subst o) b.FStarC_Syntax_Syntax.binder_attrs in let o1 = let uu___ = shift_subst Prims.int_one o in (FStarC_Syntax_Syntax.DB (Prims.int_zero, x')) :: uu___ in @@ -1271,7 +1265,7 @@ let (open_pat : | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let us_opt1 = subst_univs_opt [sub] us_opt in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -1285,7 +1279,7 @@ let (open_pat : ({ FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_cons - (fv, us_opt1, (FStarC_Compiler_List.rev pats1))); + (fv, us_opt1, (FStarC_List.rev pats1))); FStarC_Syntax_Syntax.p = (p1.FStarC_Syntax_Syntax.p) }, sub1)) | FStarC_Syntax_Syntax.Pat_var x -> @@ -1306,7 +1300,7 @@ let (open_pat : FStarC_Syntax_Syntax.p = (p1.FStarC_Syntax_Syntax.p) }, sub1) | FStarC_Syntax_Syntax.Pat_dot_term eopt -> - let eopt1 = FStarC_Compiler_Util.map_option (subst sub) eopt in + let eopt1 = FStarC_Util.map_option (subst sub) eopt in ({ FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_dot_term eopt1); @@ -1362,8 +1356,7 @@ let (close_binders : } in let imp = subst_bqual s b.FStarC_Syntax_Syntax.binder_qual in let attrs = - FStarC_Compiler_List.map (subst s) - b.FStarC_Syntax_Syntax.binder_attrs in + FStarC_List.map (subst s) b.FStarC_Syntax_Syntax.binder_attrs in let s' = let uu___ = shift_subst Prims.int_one s in (FStarC_Syntax_Syntax.NM (x, Prims.int_zero)) :: uu___ in @@ -1390,7 +1383,7 @@ let (close_pat : | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let us_opt1 = subst_univs_opt [sub] us_opt in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -1404,7 +1397,7 @@ let (close_pat : ({ FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_cons - (fv, us_opt1, (FStarC_Compiler_List.rev pats1))); + (fv, us_opt1, (FStarC_List.rev pats1))); FStarC_Syntax_Syntax.p = (p1.FStarC_Syntax_Syntax.p) }, sub1)) | FStarC_Syntax_Syntax.Pat_var x -> @@ -1423,7 +1416,7 @@ let (close_pat : FStarC_Syntax_Syntax.p = (p1.FStarC_Syntax_Syntax.p) }, sub1) | FStarC_Syntax_Syntax.Pat_dot_term eopt -> - let eopt1 = FStarC_Compiler_Util.map_option (subst sub) eopt in + let eopt1 = FStarC_Util.map_option (subst sub) eopt in ({ FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_dot_term eopt1); @@ -1451,9 +1444,9 @@ let (univ_var_opening : FStarC_Syntax_Syntax.univ_name Prims.list)) = fun us -> - let n = (FStarC_Compiler_List.length us) - Prims.int_one in + let n = (FStarC_List.length us) - Prims.int_one in let s = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun u -> FStarC_Syntax_Syntax.UN @@ -1464,9 +1457,9 @@ let (univ_var_closing : FStarC_Syntax_Syntax.subst_elt Prims.list) = fun us -> - let n = (FStarC_Compiler_List.length us) - Prims.int_one in - FStarC_Compiler_List.mapi - (fun i -> fun u -> FStarC_Syntax_Syntax.UD (u, (n - i))) us + let n = (FStarC_List.length us) - Prims.int_one in + FStarC_List.mapi (fun i -> fun u -> FStarC_Syntax_Syntax.UD (u, (n - i))) + us let (open_univ_vars : FStarC_Syntax_Syntax.univ_names -> FStarC_Syntax_Syntax.term -> @@ -1496,9 +1489,9 @@ let (close_univ_vars_comp : = fun us -> fun c -> - let n = (FStarC_Compiler_List.length us) - Prims.int_one in + let n = (FStarC_List.length us) - Prims.int_one in let s = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun u -> FStarC_Syntax_Syntax.UD (u, (n - i))) us in subst_comp s c let (open_let_rec : @@ -1514,15 +1507,14 @@ let (open_let_rec : if uu___1 then (Prims.int_zero, lbs, []) else - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun lb -> fun uu___3 -> match uu___3 with | (i, lbs1, out) -> let x = let uu___4 = - FStarC_Compiler_Util.left - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.freshen_bv uu___4 in ((i + Prims.int_one), ({ @@ -1546,9 +1538,9 @@ let (open_let_rec : | (n_let_recs, lbs1, let_rec_opening) -> let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_List.hd lbs1 in + let uu___3 = FStarC_List.hd lbs1 in uu___3.FStarC_Syntax_Syntax.lbunivs in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun u -> fun uu___3 -> match uu___3 with @@ -1563,7 +1555,7 @@ let (open_let_rec : (match uu___1 with | (uu___2, us, u_let_rec_opening) -> let lbs2 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___3 = subst u_let_rec_opening lb.FStarC_Syntax_Syntax.lbtyp in @@ -1596,7 +1588,7 @@ let (close_let_rec : if uu___1 then (Prims.int_zero, []) else - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun lb -> fun uu___3 -> match uu___3 with @@ -1605,8 +1597,7 @@ let (close_let_rec : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_Util.left - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in (uu___7, i) in FStarC_Syntax_Syntax.NM uu___6 in uu___5 :: out in @@ -1615,9 +1606,9 @@ let (close_let_rec : | (n_let_recs, let_rec_closing) -> let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_List.hd lbs in + let uu___3 = FStarC_List.hd lbs in uu___3.FStarC_Syntax_Syntax.lbunivs in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun u -> fun uu___3 -> match uu___3 with @@ -1628,7 +1619,7 @@ let (close_let_rec : (match uu___1 with | (uu___2, u_let_rec_closing) -> let lbs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___3 = subst u_let_rec_closing lb.FStarC_Syntax_Syntax.lbtyp in @@ -1657,10 +1648,10 @@ let (close_tscheme : fun uu___ -> match uu___ with | (us, t) -> - let n = (FStarC_Compiler_List.length binders) - Prims.int_one in - let k = FStarC_Compiler_List.length us in + let n = (FStarC_List.length binders) - Prims.int_one in + let k = FStarC_List.length us in let s = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun b -> FStarC_Syntax_Syntax.NM @@ -1675,10 +1666,10 @@ let (close_univ_vars_tscheme : fun uu___ -> match uu___ with | (us', t) -> - let n = (FStarC_Compiler_List.length us) - Prims.int_one in - let k = FStarC_Compiler_List.length us' in + let n = (FStarC_List.length us) - Prims.int_one in + let k = FStarC_List.length us' in let s = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun x -> FStarC_Syntax_Syntax.UD (x, (k + (n - i)))) us in let uu___1 = subst s t in (us', uu___1) @@ -1690,13 +1681,13 @@ let (subst_tscheme : fun uu___ -> match uu___ with | (us, t) -> - let s1 = shift_subst (FStarC_Compiler_List.length us) s in + let s1 = shift_subst (FStarC_List.length us) s in let uu___1 = subst s1 t in (us, uu___1) let (opening_of_binders : FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.subst_t) = fun bs -> - let n = (FStarC_Compiler_List.length bs) - Prims.int_one in - FStarC_Compiler_List.mapi + let n = (FStarC_List.length bs) - Prims.int_one in + FStarC_List.mapi (fun i -> fun b -> FStarC_Syntax_Syntax.DB @@ -1723,14 +1714,12 @@ let (open_term_bvs : fun bvs -> fun t -> let uu___ = - let uu___1 = - FStarC_Compiler_List.map FStarC_Syntax_Syntax.mk_binder bvs in + let uu___1 = FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs in open_term uu___1 t in match uu___ with | (bs, t1) -> let uu___1 = - FStarC_Compiler_List.map - (fun b -> b.FStarC_Syntax_Syntax.binder_bv) bs in + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) bs in (uu___1, t1) let (open_term_bv : FStarC_Syntax_Syntax.bv -> diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Syntax.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Syntax.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_Syntax_Syntax.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Syntax.ml index 9c8fa55e710..9a049dd0c4c 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Syntax.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Syntax.ml @@ -1,11 +1,11 @@ open Prims type 'a withinfo_t = { v: 'a ; - p: FStarC_Compiler_Range_Type.range }[@@deriving yojson,show] + p: FStarC_Range_Type.range }[@@deriving yojson,show] let __proj__Mkwithinfo_t__item__v : 'a . 'a withinfo_t -> 'a = fun projectee -> match projectee with | { v; p;_} -> v let __proj__Mkwithinfo_t__item__p : - 'a . 'a withinfo_t -> FStarC_Compiler_Range_Type.range = + 'a . 'a withinfo_t -> FStarC_Range_Type.range = fun projectee -> match projectee with | { v; p;_} -> p type var = FStarC_Ident.lident withinfo_t[@@deriving yojson,show] type sconst = FStarC_Const.sconst[@@deriving yojson,show] @@ -51,23 +51,22 @@ let (pragma_to_string : pragma -> Prims.string) = | ShowOptions -> "#show-options" | ResetOptions (FStar_Pervasives_Native.None) -> "#reset-options" | ResetOptions (FStar_Pervasives_Native.Some s) -> - FStarC_Compiler_Util.format1 "#reset-options \"%s\"" s - | SetOptions s -> FStarC_Compiler_Util.format1 "#set-options \"%s\"" s + FStarC_Util.format1 "#reset-options \"%s\"" s + | SetOptions s -> FStarC_Util.format1 "#set-options \"%s\"" s | PushOptions (FStar_Pervasives_Native.None) -> "#push-options" | PushOptions (FStar_Pervasives_Native.Some s) -> - FStarC_Compiler_Util.format1 "#push-options \"%s\"" s + FStarC_Util.format1 "#push-options \"%s\"" s | RestartSolver -> "#restart-solver" | PrintEffectsGraph -> "#print-effects-graph" | PopOptions -> "#pop-options" let (showable_pragma : pragma FStarC_Class_Show.showable) = { FStarC_Class_Show.show = pragma_to_string } type 'a memo = - (('a FStar_Pervasives_Native.option FStarC_Compiler_Effect.ref)[@printer - fun fmt -> - fun _ -> - Format.pp_print_string - fmt - "None"]) + (('a FStar_Pervasives_Native.option FStarC_Effect.ref)[@printer + fun fmt -> + fun _ -> + Format.pp_print_string + fmt "None"]) [@@deriving yojson,show] type emb_typ = | ET_abstract @@ -99,7 +98,7 @@ type universe = | U_bvar of Prims.int | U_name of FStarC_Ident.ident | U_unif of (universe FStar_Pervasives_Native.option - FStarC_Unionfind.p_uvar * version * FStarC_Compiler_Range_Type.range) + FStarC_Unionfind.p_uvar * version * FStarC_Range_Type.range) | U_unknown [@@deriving yojson,show] let (uu___is_U_zero : universe -> Prims.bool) = fun projectee -> match projectee with | U_zero -> true | uu___ -> false @@ -124,14 +123,14 @@ let (uu___is_U_unif : universe -> Prims.bool) = let (__proj__U_unif__item___0 : universe -> (universe FStar_Pervasives_Native.option FStarC_Unionfind.p_uvar * - version * FStarC_Compiler_Range_Type.range)) + version * FStarC_Range_Type.range)) = fun projectee -> match projectee with | U_unif _0 -> _0 let (uu___is_U_unknown : universe -> Prims.bool) = fun projectee -> match projectee with | U_unknown -> true | uu___ -> false type univ_name = FStarC_Ident.ident[@@deriving yojson,show] type universe_uvar = (universe FStar_Pervasives_Native.option FStarC_Unionfind.p_uvar * version - * FStarC_Compiler_Range_Type.range)[@@deriving yojson,show] + * FStarC_Range_Type.range)[@@deriving yojson,show] type univ_names = univ_name Prims.list[@@deriving yojson,show] type universes = universe Prims.list[@@deriving yojson,show] type monad_name = FStarC_Ident.lident[@@deriving yojson,show] @@ -146,14 +145,14 @@ let (uu___is_Quote_dynamic : quote_kind -> Prims.bool) = match projectee with | Quote_dynamic -> true | uu___ -> false type maybe_set_use_range = | NoUseRange - | SomeUseRange of FStarC_Compiler_Range_Type.range [@@deriving yojson,show] + | SomeUseRange of FStarC_Range_Type.range [@@deriving yojson,show] let (uu___is_NoUseRange : maybe_set_use_range -> Prims.bool) = fun projectee -> match projectee with | NoUseRange -> true | uu___ -> false let (uu___is_SomeUseRange : maybe_set_use_range -> Prims.bool) = fun projectee -> match projectee with | SomeUseRange _0 -> true | uu___ -> false let (__proj__SomeUseRange__item___0 : - maybe_set_use_range -> FStarC_Compiler_Range_Type.range) = + maybe_set_use_range -> FStarC_Range_Type.range) = fun projectee -> match projectee with | SomeUseRange _0 -> _0 type delta_depth = | Delta_constant_at_level of Prims.int @@ -287,12 +286,12 @@ and ctx_uvar = { ctx_uvar_head: ((term' syntax FStar_Pervasives_Native.option * uvar_decoration) - FStarC_Unionfind.p_uvar * version * FStarC_Compiler_Range_Type.range) + FStarC_Unionfind.p_uvar * version * FStarC_Range_Type.range) ; ctx_uvar_gamma: binding Prims.list ; ctx_uvar_binders: binder Prims.list ; ctx_uvar_reason: Prims.string ; - ctx_uvar_range: FStarC_Compiler_Range_Type.range ; + ctx_uvar_range: FStarC_Range_Type.range ; ctx_uvar_meta: ctx_uvar_meta_t FStar_Pervasives_Native.option } and ctx_uvar_meta_t = | Ctx_uvar_meta_tac of term' syntax @@ -317,7 +316,7 @@ and letbinding = lbeff: FStarC_Ident.lident ; lbdef: term' syntax ; lbattrs: term' syntax Prims.list ; - lbpos: FStarC_Compiler_Range_Type.range } + lbpos: FStarC_Range_Type.range } and quoteinfo = { qkind: quote_kind ; @@ -359,7 +358,7 @@ and metadata = FStar_Pervasives_Native.option) Prims.list Prims.list) | Meta_named of FStarC_Ident.lident | Meta_labeled of (FStarC_Pprint.document Prims.list * - FStarC_Compiler_Range_Type.range * Prims.bool) + FStarC_Range_Type.range * Prims.bool) | Meta_desugared of meta_source_info | Meta_monadic of (monad_name * term' syntax) | Meta_monadic_lift of (monad_name * monad_name * term' syntax) @@ -390,7 +389,7 @@ and subst_elt = and 'a syntax = { n: 'a ; - pos: FStarC_Compiler_Range_Type.range ; + pos: FStarC_Range_Type.range ; vars: free_vars memo ; hash_code: FStarC_Hash.hash_code memo } and bv = { @@ -402,10 +401,10 @@ and fv = { fv_qual: fv_qual FStar_Pervasives_Native.option } and free_vars = { - free_names: bv FStarC_Compiler_FlatSet.t ; - free_uvars: ctx_uvar FStarC_Compiler_FlatSet.t ; - free_univs: universe_uvar FStarC_Compiler_FlatSet.t ; - free_univ_names: univ_name FStarC_Compiler_FlatSet.t } + free_names: bv FStarC_FlatSet.t ; + free_uvars: ctx_uvar FStarC_FlatSet.t ; + free_univs: universe_uvar FStarC_FlatSet.t ; + free_univ_names: univ_name FStarC_FlatSet.t } and residual_comp = { residual_effect: FStarC_Ident.lident ; @@ -416,7 +415,7 @@ and lazyinfo = blob: FStarC_Dyn.dyn ; lkind: lazy_kind ; ltyp: term' syntax ; - rng: FStarC_Compiler_Range_Type.range } + rng: FStarC_Range_Type.range } and lazy_kind = | BadLazy | Lazy_bv @@ -624,7 +623,7 @@ let (uu___is_Tm_unknown : term' -> Prims.bool) = let (__proj__Mkctx_uvar__item__ctx_uvar_head : ctx_uvar -> ((term' syntax FStar_Pervasives_Native.option * uvar_decoration) - FStarC_Unionfind.p_uvar * version * FStarC_Compiler_Range_Type.range)) + FStarC_Unionfind.p_uvar * version * FStarC_Range_Type.range)) = fun projectee -> match projectee with @@ -648,7 +647,7 @@ let (__proj__Mkctx_uvar__item__ctx_uvar_reason : ctx_uvar -> Prims.string) = | { ctx_uvar_head; ctx_uvar_gamma; ctx_uvar_binders; ctx_uvar_reason; ctx_uvar_range; ctx_uvar_meta;_} -> ctx_uvar_reason let (__proj__Mkctx_uvar__item__ctx_uvar_range : - ctx_uvar -> FStarC_Compiler_Range_Type.range) = + ctx_uvar -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { ctx_uvar_head; ctx_uvar_gamma; ctx_uvar_binders; ctx_uvar_reason; @@ -748,7 +747,7 @@ let (__proj__Mkletbinding__item__lbattrs : match projectee with | { lbname; lbunivs; lbtyp; lbeff; lbdef; lbattrs; lbpos;_} -> lbattrs let (__proj__Mkletbinding__item__lbpos : - letbinding -> FStarC_Compiler_Range_Type.range) = + letbinding -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { lbname; lbunivs; lbtyp; lbeff; lbdef; lbattrs; lbpos;_} -> lbpos @@ -878,7 +877,7 @@ let (uu___is_Meta_labeled : metadata -> Prims.bool) = match projectee with | Meta_labeled _0 -> true | uu___ -> false let (__proj__Meta_labeled__item___0 : metadata -> - (FStarC_Pprint.document Prims.list * FStarC_Compiler_Range_Type.range * + (FStarC_Pprint.document Prims.list * FStarC_Range_Type.range * Prims.bool)) = fun projectee -> match projectee with | Meta_labeled _0 -> _0 let (uu___is_Meta_desugared : metadata -> Prims.bool) = @@ -983,8 +982,7 @@ let (__proj__UD__item___0 : subst_elt -> (univ_name * Prims.int)) = fun projectee -> match projectee with | UD _0 -> _0 let __proj__Mksyntax__item__n : 'a . 'a syntax -> 'a = fun projectee -> match projectee with | { n; pos; vars; hash_code;_} -> n -let __proj__Mksyntax__item__pos : - 'a . 'a syntax -> FStarC_Compiler_Range_Type.range = +let __proj__Mksyntax__item__pos : 'a . 'a syntax -> FStarC_Range_Type.range = fun projectee -> match projectee with | { n; pos; vars; hash_code;_} -> pos let __proj__Mksyntax__item__vars : 'a . 'a syntax -> free_vars memo = fun projectee -> @@ -1007,22 +1005,22 @@ let (__proj__Mkfv__item__fv_qual : fun projectee -> match projectee with | { fv_name; fv_qual = fv_qual1;_} -> fv_qual1 let (__proj__Mkfree_vars__item__free_names : - free_vars -> bv FStarC_Compiler_FlatSet.t) = + free_vars -> bv FStarC_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_names let (__proj__Mkfree_vars__item__free_uvars : - free_vars -> ctx_uvar FStarC_Compiler_FlatSet.t) = + free_vars -> ctx_uvar FStarC_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_uvars let (__proj__Mkfree_vars__item__free_univs : - free_vars -> universe_uvar FStarC_Compiler_FlatSet.t) = + free_vars -> universe_uvar FStarC_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> free_univs let (__proj__Mkfree_vars__item__free_univ_names : - free_vars -> univ_name FStarC_Compiler_FlatSet.t) = + free_vars -> univ_name FStarC_FlatSet.t) = fun projectee -> match projectee with | { free_names; free_uvars; free_univs; free_univ_names;_} -> @@ -1049,8 +1047,7 @@ let (__proj__Mklazyinfo__item__lkind : lazyinfo -> lazy_kind) = match projectee with | { blob; lkind; ltyp; rng;_} -> lkind let (__proj__Mklazyinfo__item__ltyp : lazyinfo -> term' syntax) = fun projectee -> match projectee with | { blob; lkind; ltyp; rng;_} -> ltyp -let (__proj__Mklazyinfo__item__rng : - lazyinfo -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mklazyinfo__item__rng : lazyinfo -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { blob; lkind; ltyp; rng;_} -> rng let (uu___is_BadLazy : lazy_kind -> Prims.bool) = fun projectee -> match projectee with | BadLazy -> true | uu___ -> false @@ -1152,8 +1149,8 @@ type ctx_uvar_and_subst = type term = term' syntax type uvar = ((term' syntax FStar_Pervasives_Native.option * uvar_decoration) - FStarC_Unionfind.p_uvar * version * FStarC_Compiler_Range_Type.range) -type uvars = ctx_uvar FStarC_Compiler_FlatSet.t + FStarC_Unionfind.p_uvar * version * FStarC_Range_Type.range) +type uvars = ctx_uvar FStarC_FlatSet.t type comp = comp' syntax type ascription = ((term' syntax, comp' syntax) FStar_Pervasives.either * term' syntax @@ -1174,7 +1171,7 @@ type args = type binders = binder Prims.list type lbname = (bv, fv) FStar_Pervasives.either type letbindings = (Prims.bool * letbinding Prims.list) -type freenames = bv FStarC_Compiler_FlatSet.t +type freenames = bv FStarC_FlatSet.t type attribute = term' syntax type tscheme = (univ_name Prims.list * term' syntax) type gamma = binding Prims.list @@ -1299,8 +1296,8 @@ let rec (emb_typ_to_string : emb_typ -> Prims.string) = let uu___2 = let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_List.map emb_typ_to_string args1 in - FStarC_Compiler_String.concat " " uu___5 in + let uu___5 = FStarC_List.map emb_typ_to_string args1 in + FStarC_String.concat " " uu___5 in Prims.strcat uu___4 ")" in Prims.strcat " " uu___3 in Prims.strcat h uu___2 in @@ -1318,10 +1315,10 @@ let rec (delta_depth_to_string : delta_depth -> Prims.string) = fun uu___ -> match uu___ with | Delta_constant_at_level i -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in Prims.strcat "Delta_constant_at_level " uu___1 | Delta_equational_at_level i -> - let uu___1 = FStarC_Compiler_Util.string_of_int i in + let uu___1 = FStarC_Util.string_of_int i in Prims.strcat "Delta_equational_at_level " uu___1 | Delta_abstract d -> let uu___1 = @@ -1343,29 +1340,28 @@ let (showable_should_check_uvar : } let (lazy_chooser : (lazy_kind -> lazyinfo -> term) FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None -let (cmp_qualifier : qualifier -> qualifier -> FStarC_Compiler_Order.order) = + FStarC_Effect.ref) + = FStarC_Util.mk_ref FStar_Pervasives_Native.None +let (cmp_qualifier : qualifier -> qualifier -> FStarC_Order.order) = fun q1 -> fun q2 -> match (q1, q2) with - | (Assumption, Assumption) -> FStarC_Compiler_Order.Eq - | (New, New) -> FStarC_Compiler_Order.Eq - | (Private, Private) -> FStarC_Compiler_Order.Eq + | (Assumption, Assumption) -> FStarC_Order.Eq + | (New, New) -> FStarC_Order.Eq + | (Private, Private) -> FStarC_Order.Eq | (Unfold_for_unification_and_vcgen, Unfold_for_unification_and_vcgen) - -> FStarC_Compiler_Order.Eq - | (Irreducible, Irreducible) -> FStarC_Compiler_Order.Eq - | (Inline_for_extraction, Inline_for_extraction) -> - FStarC_Compiler_Order.Eq - | (NoExtract, NoExtract) -> FStarC_Compiler_Order.Eq - | (Noeq, Noeq) -> FStarC_Compiler_Order.Eq - | (Unopteq, Unopteq) -> FStarC_Compiler_Order.Eq - | (TotalEffect, TotalEffect) -> FStarC_Compiler_Order.Eq - | (Logic, Logic) -> FStarC_Compiler_Order.Eq - | (Reifiable, Reifiable) -> FStarC_Compiler_Order.Eq + -> FStarC_Order.Eq + | (Irreducible, Irreducible) -> FStarC_Order.Eq + | (Inline_for_extraction, Inline_for_extraction) -> FStarC_Order.Eq + | (NoExtract, NoExtract) -> FStarC_Order.Eq + | (Noeq, Noeq) -> FStarC_Order.Eq + | (Unopteq, Unopteq) -> FStarC_Order.Eq + | (TotalEffect, TotalEffect) -> FStarC_Order.Eq + | (Logic, Logic) -> FStarC_Order.Eq + | (Reifiable, Reifiable) -> FStarC_Order.Eq | (Reflectable l1, Reflectable l2) -> FStarC_Class_Ord.cmp FStarC_Ident.ord_lident l1 l2 - | (Visible_default, Visible_default) -> FStarC_Compiler_Order.Eq + | (Visible_default, Visible_default) -> FStarC_Order.Eq | (Discriminator l1, Discriminator l2) -> FStarC_Class_Ord.cmp FStarC_Ident.ord_lident l1 l2 | (Projector (l1, i1), Projector (l2, i2)) -> @@ -1386,67 +1382,64 @@ let (cmp_qualifier : qualifier -> qualifier -> FStarC_Compiler_Order.order) = (l2, i2) | (Action l1, Action l2) -> FStarC_Class_Ord.cmp FStarC_Ident.ord_lident l1 l2 - | (ExceptionConstructor, ExceptionConstructor) -> - FStarC_Compiler_Order.Eq - | (HasMaskedEffect, HasMaskedEffect) -> FStarC_Compiler_Order.Eq - | (Effect, Effect) -> FStarC_Compiler_Order.Eq - | (OnlyName, OnlyName) -> FStarC_Compiler_Order.Eq - | (InternalAssumption, InternalAssumption) -> FStarC_Compiler_Order.Eq - | (Assumption, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Assumption) -> FStarC_Compiler_Order.Gt - | (New, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, New) -> FStarC_Compiler_Order.Gt - | (Private, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Private) -> FStarC_Compiler_Order.Gt - | (Unfold_for_unification_and_vcgen, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Unfold_for_unification_and_vcgen) -> FStarC_Compiler_Order.Gt - | (Irreducible, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Irreducible) -> FStarC_Compiler_Order.Gt - | (Inline_for_extraction, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Inline_for_extraction) -> FStarC_Compiler_Order.Gt - | (NoExtract, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, NoExtract) -> FStarC_Compiler_Order.Gt - | (Noeq, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Noeq) -> FStarC_Compiler_Order.Gt - | (Unopteq, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Unopteq) -> FStarC_Compiler_Order.Gt - | (TotalEffect, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, TotalEffect) -> FStarC_Compiler_Order.Gt - | (Logic, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Logic) -> FStarC_Compiler_Order.Gt - | (Reifiable, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Reifiable) -> FStarC_Compiler_Order.Gt - | (Reflectable uu___, uu___1) -> FStarC_Compiler_Order.Lt - | (uu___, Reflectable uu___1) -> FStarC_Compiler_Order.Gt - | (Visible_default, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Visible_default) -> FStarC_Compiler_Order.Gt - | (Discriminator uu___, uu___1) -> FStarC_Compiler_Order.Lt - | (uu___, Discriminator uu___1) -> FStarC_Compiler_Order.Gt - | (Projector uu___, uu___1) -> FStarC_Compiler_Order.Lt - | (uu___, Projector uu___1) -> FStarC_Compiler_Order.Gt - | (RecordType uu___, uu___1) -> FStarC_Compiler_Order.Lt - | (uu___, RecordType uu___1) -> FStarC_Compiler_Order.Gt - | (RecordConstructor uu___, uu___1) -> FStarC_Compiler_Order.Lt - | (uu___, RecordConstructor uu___1) -> FStarC_Compiler_Order.Gt - | (Action uu___, uu___1) -> FStarC_Compiler_Order.Lt - | (uu___, Action uu___1) -> FStarC_Compiler_Order.Gt - | (ExceptionConstructor, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, ExceptionConstructor) -> FStarC_Compiler_Order.Gt - | (HasMaskedEffect, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, HasMaskedEffect) -> FStarC_Compiler_Order.Gt - | (Effect, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, Effect) -> FStarC_Compiler_Order.Gt - | (OnlyName, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, OnlyName) -> FStarC_Compiler_Order.Gt - | (InternalAssumption, uu___) -> FStarC_Compiler_Order.Lt - | (uu___, InternalAssumption) -> FStarC_Compiler_Order.Gt + | (ExceptionConstructor, ExceptionConstructor) -> FStarC_Order.Eq + | (HasMaskedEffect, HasMaskedEffect) -> FStarC_Order.Eq + | (Effect, Effect) -> FStarC_Order.Eq + | (OnlyName, OnlyName) -> FStarC_Order.Eq + | (InternalAssumption, InternalAssumption) -> FStarC_Order.Eq + | (Assumption, uu___) -> FStarC_Order.Lt + | (uu___, Assumption) -> FStarC_Order.Gt + | (New, uu___) -> FStarC_Order.Lt + | (uu___, New) -> FStarC_Order.Gt + | (Private, uu___) -> FStarC_Order.Lt + | (uu___, Private) -> FStarC_Order.Gt + | (Unfold_for_unification_and_vcgen, uu___) -> FStarC_Order.Lt + | (uu___, Unfold_for_unification_and_vcgen) -> FStarC_Order.Gt + | (Irreducible, uu___) -> FStarC_Order.Lt + | (uu___, Irreducible) -> FStarC_Order.Gt + | (Inline_for_extraction, uu___) -> FStarC_Order.Lt + | (uu___, Inline_for_extraction) -> FStarC_Order.Gt + | (NoExtract, uu___) -> FStarC_Order.Lt + | (uu___, NoExtract) -> FStarC_Order.Gt + | (Noeq, uu___) -> FStarC_Order.Lt + | (uu___, Noeq) -> FStarC_Order.Gt + | (Unopteq, uu___) -> FStarC_Order.Lt + | (uu___, Unopteq) -> FStarC_Order.Gt + | (TotalEffect, uu___) -> FStarC_Order.Lt + | (uu___, TotalEffect) -> FStarC_Order.Gt + | (Logic, uu___) -> FStarC_Order.Lt + | (uu___, Logic) -> FStarC_Order.Gt + | (Reifiable, uu___) -> FStarC_Order.Lt + | (uu___, Reifiable) -> FStarC_Order.Gt + | (Reflectable uu___, uu___1) -> FStarC_Order.Lt + | (uu___, Reflectable uu___1) -> FStarC_Order.Gt + | (Visible_default, uu___) -> FStarC_Order.Lt + | (uu___, Visible_default) -> FStarC_Order.Gt + | (Discriminator uu___, uu___1) -> FStarC_Order.Lt + | (uu___, Discriminator uu___1) -> FStarC_Order.Gt + | (Projector uu___, uu___1) -> FStarC_Order.Lt + | (uu___, Projector uu___1) -> FStarC_Order.Gt + | (RecordType uu___, uu___1) -> FStarC_Order.Lt + | (uu___, RecordType uu___1) -> FStarC_Order.Gt + | (RecordConstructor uu___, uu___1) -> FStarC_Order.Lt + | (uu___, RecordConstructor uu___1) -> FStarC_Order.Gt + | (Action uu___, uu___1) -> FStarC_Order.Lt + | (uu___, Action uu___1) -> FStarC_Order.Gt + | (ExceptionConstructor, uu___) -> FStarC_Order.Lt + | (uu___, ExceptionConstructor) -> FStarC_Order.Gt + | (HasMaskedEffect, uu___) -> FStarC_Order.Lt + | (uu___, HasMaskedEffect) -> FStarC_Order.Gt + | (Effect, uu___) -> FStarC_Order.Lt + | (uu___, Effect) -> FStarC_Order.Gt + | (OnlyName, uu___) -> FStarC_Order.Lt + | (uu___, OnlyName) -> FStarC_Order.Gt + | (InternalAssumption, uu___) -> FStarC_Order.Lt + | (uu___, InternalAssumption) -> FStarC_Order.Gt let (deq_qualifier : qualifier FStarC_Class_Deq.deq) = { FStarC_Class_Deq.op_Equals_Question = (fun q1 -> - fun q2 -> - let uu___ = cmp_qualifier q1 q2 in - uu___ = FStarC_Compiler_Order.Eq) + fun q2 -> let uu___ = cmp_qualifier q1 q2 in uu___ = FStarC_Order.Eq) } let (ord_qualifier : qualifier FStarC_Class_Ord.ord) = { @@ -2053,7 +2046,7 @@ and sigelt'__Sig_polymonadic_subcomp__payload = and sigelt'__Sig_fail__payload = { errs: Prims.int Prims.list ; - rng1: FStarC_Compiler_Range_Type.range ; + rng1: FStarC_Range_Type.range ; fail_in_lax: Prims.bool ; ses1: sigelt Prims.list } and sigelt' = @@ -2074,7 +2067,7 @@ and sigelt' = and sigelt = { sigel: sigelt' ; - sigrng: FStarC_Compiler_Range_Type.range ; + sigrng: FStarC_Range_Type.range ; sigquals: qualifier Prims.list ; sigmeta: sig_metadata ; sigattrs: attribute Prims.list ; @@ -2327,7 +2320,7 @@ let (__proj__Mksigelt'__Sig_fail__payload__item__errs : match projectee with | { errs; rng1 = rng; fail_in_lax; ses1 = ses;_} -> errs let (__proj__Mksigelt'__Sig_fail__payload__item__rng : - sigelt'__Sig_fail__payload -> FStarC_Compiler_Range_Type.range) = + sigelt'__Sig_fail__payload -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { errs; rng1 = rng; fail_in_lax; ses1 = ses;_} -> rng @@ -2423,8 +2416,7 @@ let (__proj__Mksigelt__item__sigel : sigelt -> sigelt') = match projectee with | { sigel; sigrng; sigquals; sigmeta; sigattrs; sigopens_and_abbrevs; sigopts;_} -> sigel -let (__proj__Mksigelt__item__sigrng : - sigelt -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mksigelt__item__sigrng : sigelt -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { sigel; sigrng; sigquals; sigmeta; sigattrs; sigopens_and_abbrevs; @@ -2479,13 +2471,13 @@ let (__proj__Mkmodul__item__is_interface : modul -> Prims.bool) = let (mod_name : modul -> FStarC_Ident.lident) = fun m -> m.name let (contains_reflectable : qualifier Prims.list -> Prims.bool) = fun l -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___ -> match uu___ with | Reflectable uu___1 -> true | uu___1 -> false) l -let withinfo : 'a . 'a -> FStarC_Compiler_Range_Type.range -> 'a withinfo_t = +let withinfo : 'a . 'a -> FStarC_Range_Type.range -> 'a withinfo_t = fun v -> fun r -> { v; p = r } let withsort : 'a . 'a -> 'a withinfo_t = - fun v -> withinfo v FStarC_Compiler_Range_Type.dummyRange + fun v -> withinfo v FStarC_Range_Type.dummyRange let (order_bv : bv -> bv -> Prims.int) = fun x -> fun y -> x.index - y.index let (bv_eq : bv -> bv -> Prims.bool) = fun x -> fun y -> let uu___ = order_bv x y in uu___ = Prims.int_zero @@ -2494,21 +2486,21 @@ let (order_ident : FStarC_Ident.ident -> FStarC_Ident.ident -> Prims.int) = fun y -> let uu___ = FStarC_Ident.string_of_id x in let uu___1 = FStarC_Ident.string_of_id y in - FStarC_Compiler_String.compare uu___ uu___1 + FStarC_String.compare uu___ uu___1 let (order_fv : FStarC_Ident.lident -> FStarC_Ident.lident -> Prims.int) = fun x -> fun y -> let uu___ = FStarC_Ident.string_of_lid x in let uu___1 = FStarC_Ident.string_of_lid y in - FStarC_Compiler_String.compare uu___ uu___1 -let (range_of_lbname : lbname -> FStarC_Compiler_Range_Type.range) = + FStarC_String.compare uu___ uu___1 +let (range_of_lbname : lbname -> FStarC_Range_Type.range) = fun l -> match l with | FStar_Pervasives.Inl x -> FStarC_Ident.range_of_id x.ppname | FStar_Pervasives.Inr fv1 -> FStarC_Ident.range_of_lid (fv1.fv_name).v -let (range_of_bv : bv -> FStarC_Compiler_Range_Type.range) = +let (range_of_bv : bv -> FStarC_Range_Type.range) = fun x -> FStarC_Ident.range_of_id x.ppname -let (set_range_of_bv : bv -> FStarC_Compiler_Range_Type.range -> bv) = +let (set_range_of_bv : bv -> FStarC_Range_Type.range -> bv) = fun x -> fun r -> let uu___ = FStarC_Ident.set_id_range r x.ppname in @@ -2519,7 +2511,7 @@ let (on_antiquoted : (term -> term) -> quoteinfo -> quoteinfo) = let uu___ = qi.antiquotations in match uu___ with | (s, aqs) -> - let aqs' = FStarC_Compiler_List.map f aqs in + let aqs' = FStarC_List.map f aqs in { qkind = (qi.qkind); antiquotations = (s, aqs') } let (lookup_aq : bv -> antiquotations -> term) = fun bv1 -> @@ -2528,10 +2520,9 @@ let (lookup_aq : bv -> antiquotations -> term) = (fun uu___ -> match () with | () -> - FStarC_Compiler_List.nth (FStar_Pervasives_Native.snd aq) - ((((FStarC_Compiler_List.length - (FStar_Pervasives_Native.snd aq)) - - Prims.int_one) + FStarC_List.nth (FStar_Pervasives_Native.snd aq) + ((((FStarC_List.length (FStar_Pervasives_Native.snd aq)) - + Prims.int_one) - bv1.index) + (FStar_Pervasives_Native.fst aq))) () with | uu___ -> failwith "antiquotation out of bounds" @@ -2539,19 +2530,16 @@ type path = Prims.string Prims.list type subst_t = subst_elt Prims.list let deq_instance_from_cmp : 'uuuuu . - ('uuuuu -> 'uuuuu -> FStarC_Compiler_Order.order) -> - 'uuuuu FStarC_Class_Deq.deq + ('uuuuu -> 'uuuuu -> FStarC_Order.order) -> 'uuuuu FStarC_Class_Deq.deq = fun f -> { FStarC_Class_Deq.op_Equals_Question = - (fun x -> - fun y -> let uu___ = f x y in FStarC_Compiler_Order.eq uu___) + (fun x -> fun y -> let uu___ = f x y in FStarC_Order.eq uu___) } let ord_instance_from_cmp : 'uuuuu . - ('uuuuu -> 'uuuuu -> FStarC_Compiler_Order.order) -> - 'uuuuu FStarC_Class_Ord.ord + ('uuuuu -> 'uuuuu -> FStarC_Order.order) -> 'uuuuu FStarC_Class_Ord.ord = fun f -> { @@ -2563,81 +2551,67 @@ let (order_univ_name : univ_name -> univ_name -> Prims.int) = fun y -> let uu___ = FStarC_Ident.string_of_id x in let uu___1 = FStarC_Ident.string_of_id y in - FStarC_Compiler_String.compare uu___ uu___1 + FStarC_String.compare uu___ uu___1 let (deq_bv : bv FStarC_Class_Deq.deq) = deq_instance_from_cmp (fun x -> - fun y -> - let uu___ = order_bv x y in - FStarC_Compiler_Order.order_from_int uu___) + fun y -> let uu___ = order_bv x y in FStarC_Order.order_from_int uu___) let (deq_ident : FStarC_Ident.ident FStarC_Class_Deq.deq) = deq_instance_from_cmp (fun x -> fun y -> - let uu___ = order_ident x y in - FStarC_Compiler_Order.order_from_int uu___) + let uu___ = order_ident x y in FStarC_Order.order_from_int uu___) let (deq_fv : FStarC_Ident.lident FStarC_Class_Deq.deq) = deq_instance_from_cmp (fun x -> - fun y -> - let uu___ = order_fv x y in - FStarC_Compiler_Order.order_from_int uu___) + fun y -> let uu___ = order_fv x y in FStarC_Order.order_from_int uu___) let (deq_univ_name : univ_name FStarC_Class_Deq.deq) = deq_instance_from_cmp (fun x -> fun y -> - let uu___ = order_univ_name x y in - FStarC_Compiler_Order.order_from_int uu___) + let uu___ = order_univ_name x y in FStarC_Order.order_from_int uu___) let (deq_delta_depth : delta_depth FStarC_Class_Deq.deq) = { FStarC_Class_Deq.op_Equals_Question = (fun x -> fun y -> x = y) } let (ord_bv : bv FStarC_Class_Ord.ord) = ord_instance_from_cmp (fun x -> - fun y -> - let uu___ = order_bv x y in - FStarC_Compiler_Order.order_from_int uu___) + fun y -> let uu___ = order_bv x y in FStarC_Order.order_from_int uu___) let (ord_ident : FStarC_Ident.ident FStarC_Class_Ord.ord) = ord_instance_from_cmp (fun x -> fun y -> - let uu___ = order_ident x y in - FStarC_Compiler_Order.order_from_int uu___) + let uu___ = order_ident x y in FStarC_Order.order_from_int uu___) let (ord_fv : FStarC_Ident.lident FStarC_Class_Ord.ord) = ord_instance_from_cmp (fun x -> - fun y -> - let uu___ = order_fv x y in - FStarC_Compiler_Order.order_from_int uu___) + fun y -> let uu___ = order_fv x y in FStarC_Order.order_from_int uu___) let syn : 'uuuuu 'uuuuu1 'uuuuu2 . 'uuuuu -> 'uuuuu1 -> ('uuuuu1 -> 'uuuuu -> 'uuuuu2) -> 'uuuuu2 = fun p -> fun k -> fun f -> f k p let mk_fvs : - 'uuuuu . - unit -> 'uuuuu FStar_Pervasives_Native.option FStarC_Compiler_Effect.ref - = fun uu___ -> FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + 'uuuuu . unit -> 'uuuuu FStar_Pervasives_Native.option FStarC_Effect.ref = + fun uu___ -> FStarC_Util.mk_ref FStar_Pervasives_Native.None let mk_uvs : - 'uuuuu . - unit -> 'uuuuu FStar_Pervasives_Native.option FStarC_Compiler_Effect.ref - = fun uu___ -> FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + 'uuuuu . unit -> 'uuuuu FStar_Pervasives_Native.option FStarC_Effect.ref = + fun uu___ -> FStarC_Util.mk_ref FStar_Pervasives_Native.None let (list_of_freenames : freenames -> bv Prims.list) = fun fvs -> FStarC_Class_Setlike.elems () - (Obj.magic (FStarC_Compiler_FlatSet.setlike_flat_set ord_bv)) - (Obj.magic fvs) -let mk : 'a . 'a -> FStarC_Compiler_Range_Type.range -> 'a syntax = + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_bv)) (Obj.magic fvs) +let mk : 'a . 'a -> FStarC_Range_Type.range -> 'a syntax = fun t -> fun r -> - let uu___ = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in - let uu___1 = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None in + let uu___ = FStarC_Util.mk_ref FStar_Pervasives_Native.None in + let uu___1 = FStarC_Util.mk_ref FStar_Pervasives_Native.None in { n = t; pos = r; vars = uu___; hash_code = uu___1 } let (bv_to_tm : bv -> term) = fun bv1 -> let uu___ = range_of_bv bv1 in mk (Tm_bvar bv1) uu___ let (bv_to_name : bv -> term) = fun bv1 -> let uu___ = range_of_bv bv1 in mk (Tm_name bv1) uu___ let (binders_to_names : binders -> term Prims.list) = - fun bs -> FStarC_Compiler_List.map (fun b -> bv_to_name b.binder_bv) bs -let (mk_Tm_app : term -> args -> FStarC_Compiler_Range_Type.range -> term) = + fun bs -> FStarC_List.map (fun b -> bv_to_name b.binder_bv) bs +let (mk_Tm_app : term -> args -> FStarC_Range_Type.range -> term) = fun t1 -> fun args1 -> fun p -> @@ -2651,19 +2625,17 @@ let (mk_Tm_uinst : term -> universes -> term) = | Tm_fvar uu___ -> (match us with | [] -> t | us1 -> mk (Tm_uinst (t, us1)) t.pos) | uu___ -> failwith "Unexpected universe instantiation" -let (extend_app_n : term -> args -> FStarC_Compiler_Range_Type.range -> term) - = +let (extend_app_n : term -> args -> FStarC_Range_Type.range -> term) = fun t -> fun args' -> fun r -> match t.n with | Tm_app { hd; args = args1;_} -> - mk_Tm_app hd (FStarC_Compiler_List.op_At args1 args') r + mk_Tm_app hd (FStarC_List.op_At args1 args') r | uu___ -> mk_Tm_app t args' r -let (extend_app : term -> arg -> FStarC_Compiler_Range_Type.range -> term) = +let (extend_app : term -> arg -> FStarC_Range_Type.range -> term) = fun t -> fun arg1 -> fun r -> extend_app_n t [arg1] r -let (mk_Tm_delayed : - (term * subst_ts) -> FStarC_Compiler_Range_Type.range -> term) = +let (mk_Tm_delayed : (term * subst_ts) -> FStarC_Range_Type.range -> term) = fun lr -> fun pos -> mk @@ -2677,7 +2649,7 @@ let (mk_GTotal : typ -> comp) = fun t -> mk (GTotal t) t.pos let (mk_Comp : comp_typ -> comp) = fun ct -> mk (Comp ct) (ct.result_typ).pos let (mk_lb : (lbname * univ_name Prims.list * FStarC_Ident.lident * typ * term * - attribute Prims.list * FStarC_Compiler_Range_Type.range) -> letbinding) + attribute Prims.list * FStarC_Range_Type.range) -> letbinding) = fun uu___ -> match uu___ with @@ -2714,7 +2686,7 @@ let (mk_sigelt : sigelt' -> sigelt) = fun e -> { sigel = e; - sigrng = FStarC_Compiler_Range_Type.dummyRange; + sigrng = FStarC_Range_Type.dummyRange; sigquals = []; sigmeta = default_sigmeta; sigattrs = []; @@ -2724,12 +2696,11 @@ let (mk_sigelt : sigelt' -> sigelt) = let (mk_subst : subst_t -> subst_t) = fun s -> s let (extend_subst : subst_elt -> subst_elt Prims.list -> subst_t) = fun x -> fun s -> x :: s -let (argpos : arg -> FStarC_Compiler_Range_Type.range) = +let (argpos : arg -> FStarC_Range_Type.range) = fun x -> (FStar_Pervasives_Native.fst x).pos -let (tun : term) = mk Tm_unknown FStarC_Compiler_Range_Type.dummyRange +let (tun : term) = mk Tm_unknown FStarC_Range_Type.dummyRange let (teff : term) = - mk (Tm_constant FStarC_Const.Const_effect) - FStarC_Compiler_Range_Type.dummyRange + mk (Tm_constant FStarC_Const.Const_effect) FStarC_Range_Type.dummyRange let (is_teff : term -> Prims.bool) = fun t -> match t.n with @@ -2738,7 +2709,7 @@ let (is_teff : term -> Prims.bool) = let (is_type : term -> Prims.bool) = fun t -> match t.n with | Tm_type uu___ -> true | uu___ -> false let (null_id : FStarC_Ident.ident) = - FStarC_Ident.mk_ident ("_", FStarC_Compiler_Range_Type.dummyRange) + FStarC_Ident.mk_ident ("_", FStarC_Range_Type.dummyRange) let (null_bv : term -> bv) = fun k -> let uu___ = FStarC_GenSym.next_id () in @@ -2749,17 +2720,16 @@ let (is_null_bv : bv -> Prims.bool) = let uu___1 = FStarC_Ident.string_of_id null_id in uu___ = uu___1 let (is_null_binder : binder -> Prims.bool) = fun b -> is_null_bv b.binder_bv let (range_of_ropt : - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range) + FStarC_Range_Type.range FStar_Pervasives_Native.option -> + FStarC_Range_Type.range) = fun uu___ -> match uu___ with - | FStar_Pervasives_Native.None -> FStarC_Compiler_Range_Type.dummyRange + | FStar_Pervasives_Native.None -> FStarC_Range_Type.dummyRange | FStar_Pervasives_Native.Some r -> r let (gen_bv' : FStarC_Ident.ident -> - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> - typ -> bv) + FStarC_Range_Type.range FStar_Pervasives_Native.option -> typ -> bv) = fun id -> fun r -> @@ -2768,8 +2738,7 @@ let (gen_bv' : { ppname = id; index = uu___; sort = t } let (gen_bv : Prims.string -> - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> - typ -> bv) + FStarC_Range_Type.range FStar_Pervasives_Native.option -> typ -> bv) = fun s -> fun r -> @@ -2777,9 +2746,8 @@ let (gen_bv : let id = FStarC_Ident.mk_ident (s, (range_of_ropt r)) in gen_bv' id r t let (new_bv : - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> - typ -> bv) - = fun ropt -> fun t -> gen_bv FStarC_Ident.reserved_prefix ropt t + FStarC_Range_Type.range FStar_Pervasives_Native.option -> typ -> bv) = + fun ropt -> fun t -> gen_bv FStarC_Ident.reserved_prefix ropt t let (freshen_bv : bv -> bv) = fun bv1 -> let uu___ = is_null_bv bv1 in @@ -2832,25 +2800,23 @@ let (freenames_of_binders : binders -> freenames) = let uu___ = Obj.magic (FStarC_Class_Setlike.empty () - (Obj.magic (FStarC_Compiler_FlatSet.setlike_flat_set ord_bv)) ()) in - FStarC_Compiler_List.fold_right + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_bv)) ()) in + FStarC_List.fold_right (fun uu___2 -> fun uu___1 -> (fun b -> fun out -> Obj.magic (FStarC_Class_Setlike.add () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set ord_bv)) + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_bv)) b.binder_bv (Obj.magic out))) uu___2 uu___1) bs uu___ let (binders_of_list : bv Prims.list -> binders) = - fun fvs -> FStarC_Compiler_List.map (fun t -> mk_binder t) fvs + fun fvs -> FStarC_List.map (fun t -> mk_binder t) fvs let (binders_of_freenames : freenames -> binders) = fun fvs -> let uu___ = FStarC_Class_Setlike.elems () - (Obj.magic (FStarC_Compiler_FlatSet.setlike_flat_set ord_bv)) - (Obj.magic fvs) in + (Obj.magic (FStarC_FlatSet.setlike_flat_set ord_bv)) (Obj.magic fvs) in binders_of_list uu___ let (is_bqual_implicit : bqual -> Prims.bool) = fun uu___ -> @@ -2889,11 +2855,11 @@ let (pat_bvs : pat -> bv Prims.list) = | Pat_constant uu___ -> b | Pat_var x -> x :: b | Pat_cons (uu___, uu___1, pats) -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun b1 -> fun uu___2 -> match uu___2 with | (p2, uu___3) -> aux b1 p2) b pats in - let uu___ = aux [] p in FStarC_Compiler_List.rev uu___ + let uu___ = aux [] p in FStarC_List.rev uu___ let (freshen_binder : binder -> binder) = fun b -> let uu___ = freshen_bv b.binder_bv in @@ -2904,14 +2870,12 @@ let (freshen_binder : binder -> binder) = binder_attrs = (b.binder_attrs) } let (new_univ_name : - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> - univ_name) - = + FStarC_Range_Type.range FStar_Pervasives_Native.option -> univ_name) = fun ropt -> let id = FStarC_GenSym.next_id () in let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int id in + let uu___2 = FStarC_Util.string_of_int id in Prims.strcat FStarC_Ident.reserved_prefix uu___2 in (uu___1, (range_of_ropt ropt)) in FStarC_Ident.mk_ident uu___ @@ -2931,7 +2895,7 @@ let (fv_eq : fv -> fv -> Prims.bool) = fun fv2 -> FStarC_Ident.lid_equals (fv1.fv_name).v (fv2.fv_name).v let (fv_eq_lid : fv -> FStarC_Ident.lident -> Prims.bool) = fun fv1 -> fun lid -> FStarC_Ident.lid_equals (fv1.fv_name).v lid -let (set_bv_range : bv -> FStarC_Compiler_Range_Type.range -> bv) = +let (set_bv_range : bv -> FStarC_Range_Type.range -> bv) = fun bv1 -> fun r -> let uu___ = FStarC_Ident.set_id_range r bv1.ppname in @@ -2961,9 +2925,9 @@ let (fvar : FStarC_Ident.lident -> fv_qual FStar_Pervasives_Native.option -> term) = fun l -> fun dq -> let uu___ = lid_as_fv l dq in fv_to_tm uu___ let (lid_of_fv : fv -> FStarC_Ident.lid) = fun fv1 -> (fv1.fv_name).v -let (range_of_fv : fv -> FStarC_Compiler_Range_Type.range) = +let (range_of_fv : fv -> FStarC_Range_Type.range) = fun fv1 -> let uu___ = lid_of_fv fv1 in FStarC_Ident.range_of_lid uu___ -let (set_range_of_fv : fv -> FStarC_Compiler_Range_Type.range -> fv) = +let (set_range_of_fv : fv -> FStarC_Range_Type.range -> fv) = fun fv1 -> fun r -> let uu___ = @@ -2975,7 +2939,7 @@ let (set_range_of_fv : fv -> FStarC_Compiler_Range_Type.range -> fv) = let (has_simple_attribute : term Prims.list -> Prims.string -> Prims.bool) = fun l -> fun s -> - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___ -> match uu___ with | { n = Tm_constant (FStarC_Const.Const_string (data, uu___1)); @@ -2990,11 +2954,10 @@ let rec (eq_pat : pat -> pat -> Prims.bool) = | (Pat_cons (fv1, us1, as1), Pat_cons (fv2, us2, as2)) -> let uu___ = (fv_eq fv1 fv2) && - ((FStarC_Compiler_List.length as1) = - (FStarC_Compiler_List.length as2)) in + ((FStarC_List.length as1) = (FStarC_List.length as2)) in if uu___ then - (FStarC_Compiler_List.forall2 + (FStarC_List.forall2 (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -3006,8 +2969,7 @@ let rec (eq_pat : pat -> pat -> Prims.bool) = FStar_Pervasives_Native.None) -> true | (FStar_Pervasives_Native.Some us11, FStar_Pervasives_Native.Some us21) -> - (FStarC_Compiler_List.length us11) = - (FStarC_Compiler_List.length us21) + (FStarC_List.length us11) = (FStarC_List.length us21) | uu___1 -> false)) else false | (Pat_var uu___, Pat_var uu___1) -> true @@ -3021,13 +2983,13 @@ let (fvconst : FStarC_Ident.lident -> fv) = let (tconst : FStarC_Ident.lident -> term) = fun l -> let uu___ = let uu___1 = fvconst l in Tm_fvar uu___1 in - mk uu___ FStarC_Compiler_Range_Type.dummyRange + mk uu___ FStarC_Range_Type.dummyRange let (tabbrev : FStarC_Ident.lident -> term) = fun l -> let uu___ = let uu___1 = lid_and_dd_as_fv l FStar_Pervasives_Native.None in Tm_fvar uu___1 in - mk uu___ FStarC_Compiler_Range_Type.dummyRange + mk uu___ FStarC_Range_Type.dummyRange let (tdataconstr : FStarC_Ident.lident -> term) = fun l -> let uu___ = lid_and_dd_as_fv l (FStar_Pervasives_Native.Some Data_ctor) in @@ -3061,14 +3023,14 @@ let (t_tac_of : term -> term -> term) = let uu___1 = let uu___2 = as_arg a in let uu___3 = let uu___4 = as_arg b in [uu___4] in uu___2 :: uu___3 in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_tactic_of : term -> term) = fun t -> let uu___ = let uu___1 = tabbrev FStarC_Parser_Const.tactic_lid in mk_Tm_uinst uu___1 [U_zero] in let uu___1 = let uu___2 = as_arg t in [uu___2] in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_tactic_unit : term) = t_tactic_of t_unit let (t_list_of : term -> term) = fun t -> @@ -3076,14 +3038,14 @@ let (t_list_of : term -> term) = let uu___1 = tabbrev FStarC_Parser_Const.list_lid in mk_Tm_uinst uu___1 [U_zero] in let uu___1 = let uu___2 = as_arg t in [uu___2] in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_option_of : term -> term) = fun t -> let uu___ = let uu___1 = tabbrev FStarC_Parser_Const.option_lid in mk_Tm_uinst uu___1 [U_zero] in let uu___1 = let uu___2 = as_arg t in [uu___2] in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_tuple2_of : term -> term -> term) = fun t1 -> fun t2 -> @@ -3093,7 +3055,7 @@ let (t_tuple2_of : term -> term -> term) = let uu___1 = let uu___2 = as_arg t1 in let uu___3 = let uu___4 = as_arg t2 in [uu___4] in uu___2 :: uu___3 in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_tuple3_of : term -> term -> term -> term) = fun t1 -> fun t2 -> @@ -3108,7 +3070,7 @@ let (t_tuple3_of : term -> term -> term -> term) = let uu___5 = let uu___6 = as_arg t3 in [uu___6] in uu___4 :: uu___5 in uu___2 :: uu___3 in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_tuple4_of : term -> term -> term -> term -> term) = fun t1 -> fun t2 -> @@ -3127,7 +3089,7 @@ let (t_tuple4_of : term -> term -> term -> term -> term) = uu___7 in uu___4 :: uu___5 in uu___2 :: uu___3 in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_tuple5_of : term -> term -> term -> term -> term -> term) = fun t1 -> fun t2 -> @@ -3150,7 +3112,7 @@ let (t_tuple5_of : term -> term -> term -> term -> term -> term) = uu___6 :: uu___7 in uu___4 :: uu___5 in uu___2 :: uu___3 in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_either_of : term -> term -> term) = fun t1 -> fun t2 -> @@ -3160,25 +3122,24 @@ let (t_either_of : term -> term -> term) = let uu___1 = let uu___2 = as_arg t1 in let uu___3 = let uu___4 = as_arg t2 in [uu___4] in uu___2 :: uu___3 in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_sealed_of : term -> term) = fun t -> let uu___ = let uu___1 = tabbrev FStarC_Parser_Const.sealed_lid in mk_Tm_uinst uu___1 [U_zero] in let uu___1 = let uu___2 = as_arg t in [uu___2] in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let (t_erased_of : term -> term) = fun t -> let uu___ = let uu___1 = tabbrev FStarC_Parser_Const.erased_lid in mk_Tm_uinst uu___1 [U_zero] in let uu___1 = let uu___2 = as_arg t in [uu___2] in - mk_Tm_app uu___ uu___1 FStarC_Compiler_Range_Type.dummyRange -let (unit_const_with_range : FStarC_Compiler_Range_Type.range -> term) = + mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange +let (unit_const_with_range : FStarC_Range_Type.range -> term) = fun r -> mk (Tm_constant FStarC_Const.Const_unit) r -let (unit_const : term) = - unit_const_with_range FStarC_Compiler_Range_Type.dummyRange +let (unit_const : term) = unit_const_with_range FStarC_Range_Type.dummyRange let (show_restriction : restriction FStarC_Class_Show.showable) = { FStarC_Class_Show.show = @@ -3207,23 +3168,22 @@ let (is_ident_allowed_by_restriction' : | Unrestricted -> FStar_Pervasives_Native.Some id | AllowList allow_list -> let uu___1 = - FStarC_Compiler_List.find + FStarC_List.find (fun uu___2 -> match uu___2 with | (dest_id, renamed_id) -> FStarC_Class_Deq.op_Equals_Question deq_univ_name - (FStarC_Compiler_Util.dflt dest_id renamed_id) id) - allow_list in - FStarC_Compiler_Util.map_opt uu___1 FStar_Pervasives_Native.fst + (FStarC_Util.dflt dest_id renamed_id) id) allow_list in + FStarC_Util.map_opt uu___1 FStar_Pervasives_Native.fst let (is_ident_allowed_by_restriction : FStarC_Ident.ident -> restriction -> FStarC_Ident.ident FStar_Pervasives_Native.option) = - let debug = FStarC_Compiler_Debug.get_toggle "open_include_restrictions" in + let debug = FStarC_Debug.get_toggle "open_include_restrictions" in fun id -> fun restriction1 -> let result = is_ident_allowed_by_restriction' id restriction1 in - (let uu___1 = FStarC_Compiler_Effect.op_Bang debug in + (let uu___1 = FStarC_Effect.op_Bang debug in if uu___1 then let uu___2 = @@ -3244,7 +3204,7 @@ let (is_ident_allowed_by_restriction : Prims.strcat ", " uu___6 in Prims.strcat uu___4 uu___5 in Prims.strcat "is_ident_allowed_by_restriction(" uu___3 in - FStarC_Compiler_Util.print_endline uu___2 + FStarC_Util.print_endline uu___2 else ()); result let has_range_syntax : 'a . unit -> 'a syntax FStarC_Class_HasRange.hasRange diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Unionfind.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Unionfind.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_Syntax_Unionfind.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Unionfind.ml index 21623995bef..ed47538818b 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Unionfind.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Unionfind.ml @@ -12,20 +12,18 @@ let (__proj__Mkvops_t__item__next_minor : fun projectee -> match projectee with | { next_major; next_minor;_} -> next_minor let (vops : vops_t) = - let major = FStarC_Compiler_Util.mk_ref Prims.int_zero in - let minor = FStarC_Compiler_Util.mk_ref Prims.int_zero in + let major = FStarC_Util.mk_ref Prims.int_zero in + let minor = FStarC_Util.mk_ref Prims.int_zero in let next_major uu___ = - FStarC_Compiler_Effect.op_Colon_Equals minor Prims.int_zero; - (let uu___2 = - FStarC_Compiler_Util.incr major; FStarC_Compiler_Effect.op_Bang major in + FStarC_Effect.op_Colon_Equals minor Prims.int_zero; + (let uu___2 = FStarC_Util.incr major; FStarC_Effect.op_Bang major in { FStarC_Syntax_Syntax.major = uu___2; FStarC_Syntax_Syntax.minor = Prims.int_zero }) in let next_minor uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang major in - let uu___2 = - FStarC_Compiler_Util.incr minor; FStarC_Compiler_Effect.op_Bang minor in + let uu___1 = FStarC_Effect.op_Bang major in + let uu___2 = FStarC_Util.incr minor; FStarC_Effect.op_Bang minor in { FStarC_Syntax_Syntax.major = uu___1; FStarC_Syntax_Syntax.minor = uu___2 @@ -65,24 +63,22 @@ let (empty : FStarC_Syntax_Syntax.version -> uf) = { term_graph = uu___; univ_graph = uu___1; version = v; ro = false } let (version_to_string : FStarC_Syntax_Syntax.version -> Prims.string) = fun v -> - let uu___ = - FStarC_Compiler_Util.string_of_int v.FStarC_Syntax_Syntax.major in - let uu___1 = - FStarC_Compiler_Util.string_of_int v.FStarC_Syntax_Syntax.minor in - FStarC_Compiler_Util.format2 "%s.%s" uu___ uu___1 -let (state : uf FStarC_Compiler_Effect.ref) = + let uu___ = FStarC_Util.string_of_int v.FStarC_Syntax_Syntax.major in + let uu___1 = FStarC_Util.string_of_int v.FStarC_Syntax_Syntax.minor in + FStarC_Util.format2 "%s.%s" uu___ uu___1 +let (state : uf FStarC_Effect.ref) = let uu___ = let uu___1 = vops.next_major () in empty uu___1 in - FStarC_Compiler_Util.mk_ref uu___ + FStarC_Util.mk_ref uu___ type tx = | TX of uf let (uu___is_TX : tx -> Prims.bool) = fun projectee -> true let (__proj__TX__item___0 : tx -> uf) = fun projectee -> match projectee with | TX _0 -> _0 -let (get : unit -> uf) = fun uu___ -> FStarC_Compiler_Effect.op_Bang state +let (get : unit -> uf) = fun uu___ -> FStarC_Effect.op_Bang state let (set_ro : unit -> unit) = fun uu___ -> let s = get () in - FStarC_Compiler_Effect.op_Colon_Equals state + FStarC_Effect.op_Colon_Equals state { term_graph = (s.term_graph); univ_graph = (s.univ_graph); @@ -92,7 +88,7 @@ let (set_ro : unit -> unit) = let (set_rw : unit -> unit) = fun uu___ -> let s = get () in - FStarC_Compiler_Effect.op_Colon_Equals state + FStarC_Effect.op_Colon_Equals state { term_graph = (s.term_graph); univ_graph = (s.univ_graph); @@ -110,7 +106,7 @@ let with_uf_enabled : 'a . (unit -> 'a) -> 'a = then f () else (try (fun uu___3 -> match () with | () -> f ()) () - with | uu___3 -> (restore (); FStarC_Compiler_Effect.raise uu___3)) in + with | uu___3 -> (restore (); FStarC_Effect.raise uu___3)) in restore (); r) let (fail_if_ro : unit -> unit) = fun uu___ -> @@ -122,7 +118,7 @@ let (fail_if_ro : unit -> unit) = (Obj.magic "Internal error: UF graph was in read-only mode") else () let (set : uf -> unit) = - fun u -> fail_if_ro (); FStarC_Compiler_Effect.op_Colon_Equals state u + fun u -> fail_if_ro (); FStarC_Effect.op_Colon_Equals state u let (reset : unit -> unit) = fun uu___ -> fail_if_ro (); @@ -153,7 +149,7 @@ let (new_transaction : unit -> tx) = let (commit : tx -> unit) = fun tx1 -> () let (rollback : tx -> unit) = fun uu___ -> match uu___ with | TX uf1 -> set uf1 -let update_in_tx : 'a . 'a FStarC_Compiler_Effect.ref -> 'a -> unit = +let update_in_tx : 'a . 'a FStarC_Effect.ref -> 'a -> unit = fun r -> fun x -> () let (get_term_graph : unit -> tgraph) = fun uu___ -> let uu___1 = get () in uu___1.term_graph @@ -183,7 +179,7 @@ let (chk_v_t : let uvar_to_string u1 = let uu___1 = let uu___2 = FStarC_Unionfind.puf_unique_id u1 in - FStarC_Compiler_Util.string_of_int uu___2 in + FStarC_Util.string_of_int uu___2 in Prims.strcat "?" uu___1 in let expected = get_version () in if @@ -231,7 +227,7 @@ let (uvar_unique_id : FStarC_Syntax_Syntax.uvar -> Prims.int) = fun u -> let uu___ = chk_v_t u in FStarC_Unionfind.puf_unique_id uu___ let (fresh : FStarC_Syntax_Syntax.uvar_decoration -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.uvar) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.uvar) = fun decoration -> fun rng -> @@ -305,7 +301,7 @@ let (get_univ_graph : unit -> ugraph) = let chk_v_u : 'uuuuu . ('uuuuu FStarC_Unionfind.p_uvar * FStarC_Syntax_Syntax.version * - FStarC_Compiler_Range_Type.range) -> 'uuuuu FStarC_Unionfind.p_uvar + FStarC_Range_Type.range) -> 'uuuuu FStarC_Unionfind.p_uvar = fun uu___ -> match uu___ with @@ -313,7 +309,7 @@ let chk_v_u : let uvar_to_string u1 = let uu___1 = let uu___2 = FStarC_Unionfind.puf_unique_id u1 in - FStarC_Compiler_Util.string_of_int uu___2 in + FStarC_Util.string_of_int uu___2 in Prims.strcat "?" uu___1 in let expected = get_version () in if @@ -369,7 +365,7 @@ let (univ_uvar_id : FStarC_Syntax_Syntax.universe_uvar -> Prims.int) = let uu___ = get_univ_graph () in let uu___1 = chk_v_u u in FStarC_Unionfind.puf_id uu___ uu___1 let (univ_fresh : - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.universe_uvar) = + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.universe_uvar) = fun rng -> fail_if_ro (); (let uu___1 = diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Util.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Util.ml similarity index 86% rename from stage0/fstar-lib/generated/FStarC_Syntax_Util.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Util.ml index c4b809bc2e4..a37c2671ae6 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_Util.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Util.ml @@ -1,21 +1,21 @@ open Prims let (tts_f : (FStarC_Syntax_Syntax.term -> Prims.string) FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + FStarC_Effect.ref) + = FStarC_Util.mk_ref FStar_Pervasives_Native.None let (tts : FStarC_Syntax_Syntax.term -> Prims.string) = fun t -> - let uu___ = FStarC_Compiler_Effect.op_Bang tts_f in + let uu___ = FStarC_Effect.op_Bang tts_f in match uu___ with | FStar_Pervasives_Native.None -> "<>" | FStar_Pervasives_Native.Some f -> f t let (ttd_f : (FStarC_Syntax_Syntax.term -> FStarC_Pprint.document) - FStar_Pervasives_Native.option FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + FStar_Pervasives_Native.option FStarC_Effect.ref) + = FStarC_Util.mk_ref FStar_Pervasives_Native.None let (ttd : FStarC_Syntax_Syntax.term -> FStarC_Pprint.document) = fun t -> - let uu___ = FStarC_Compiler_Effect.op_Bang ttd_f in + let uu___ = FStarC_Effect.op_Bang ttd_f in match uu___ with | FStar_Pervasives_Native.None -> FStarC_Pprint.doc_of_string "<>" @@ -37,7 +37,7 @@ let (mk_discriminator : FStarC_Ident.lident -> FStarC_Ident.lident) = let uu___6 = FStarC_Ident.range_of_lid lid in (uu___5, uu___6) in FStarC_Ident.mk_ident uu___4 in [uu___3] in - FStarC_Compiler_List.op_At uu___1 uu___2 in + FStarC_List.op_At uu___1 uu___2 in FStarC_Ident.lid_of_ids uu___ let (is_name : FStarC_Ident.lident -> Prims.bool) = fun lid -> @@ -45,8 +45,8 @@ let (is_name : FStarC_Ident.lident -> Prims.bool) = let uu___ = let uu___1 = FStarC_Ident.ident_of_lid lid in FStarC_Ident.string_of_id uu___1 in - FStarC_Compiler_Util.char_at uu___ Prims.int_zero in - FStarC_Compiler_Util.is_upper c + FStarC_Util.char_at uu___ Prims.int_zero in + FStarC_Util.is_upper c let (aqual_of_binder : FStarC_Syntax_Syntax.binder -> FStarC_Syntax_Syntax.aqual) = fun b -> @@ -90,19 +90,15 @@ let (bqual_and_attrs_of_aqual : else FStar_Pervasives_Native.None), (a1.FStarC_Syntax_Syntax.aqual_attributes)) let (arg_of_non_null_binder : - FStarC_Syntax_Syntax.binder -> - (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.aqual)) - = + FStarC_Syntax_Syntax.binder -> FStarC_Syntax_Syntax.arg) = fun b -> let uu___ = FStarC_Syntax_Syntax.bv_to_name b.FStarC_Syntax_Syntax.binder_bv in let uu___1 = aqual_of_binder b in (uu___, uu___1) let (args_of_non_null_binders : - FStarC_Syntax_Syntax.binders -> - (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.aqual) Prims.list) - = + FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.args) = fun binders -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun b -> let uu___ = FStarC_Syntax_Syntax.is_null_binder b in if uu___ @@ -114,7 +110,7 @@ let (args_of_binders : = fun binders -> let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___1 = FStarC_Syntax_Syntax.is_null_binder b in if uu___1 @@ -135,13 +131,11 @@ let (args_of_binders : let uu___2 = arg_of_non_null_binder b1 in (b1, uu___2) else (let uu___3 = arg_of_non_null_binder b in (b, uu___3))) binders in - FStarC_Compiler_List.unzip uu___ + FStarC_List.unzip uu___ let (name_binders : - FStarC_Syntax_Syntax.binder Prims.list -> - FStarC_Syntax_Syntax.binder Prims.list) - = + FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.binders) = fun binders -> - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun b -> let uu___ = FStarC_Syntax_Syntax.is_null_binder b in @@ -149,7 +143,7 @@ let (name_binders : then let bname = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in + let uu___2 = FStarC_Util.string_of_int i in Prims.strcat "_" uu___2 in FStarC_Ident.id_of_text uu___1 in let bv = @@ -170,9 +164,7 @@ let (name_binders : } else b) binders let (name_function_binders : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> match t.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_arrow @@ -194,7 +186,7 @@ let (null_binders_of_tks : FStarC_Syntax_Syntax.binders) = fun tks -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (t, imp) -> @@ -213,7 +205,7 @@ let (binders_of_tks : FStarC_Syntax_Syntax.binders) = fun tks -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (t, imp) -> @@ -230,11 +222,9 @@ let (subst_of_list : = fun formals -> fun actuals -> - if - (FStarC_Compiler_List.length formals) = - (FStarC_Compiler_List.length actuals) + if (FStarC_List.length formals) = (FStarC_List.length actuals) then - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun f -> fun a -> fun out -> @@ -249,11 +239,9 @@ let (rename_binders : = fun replace_xs -> fun with_ys -> - if - (FStarC_Compiler_List.length replace_xs) = - (FStarC_Compiler_List.length with_ys) + if (FStarC_List.length replace_xs) = (FStarC_List.length with_ys) then - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun x -> fun y -> let uu___ = @@ -359,7 +347,7 @@ let rec (compare_univs : -> let uu___1 = FStarC_Ident.string_of_id u11 in let uu___2 = FStarC_Ident.string_of_id u21 in - FStarC_Compiler_String.compare uu___1 uu___2 + FStarC_String.compare uu___1 uu___2 | (FStarC_Syntax_Syntax.U_name uu___1, uu___2) -> (Prims.of_int (-1)) | (uu___1, FStarC_Syntax_Syntax.U_name uu___2) -> Prims.int_one | (FStarC_Syntax_Syntax.U_unif u11, FStarC_Syntax_Syntax.U_unif u21) @@ -370,14 +358,14 @@ let rec (compare_univs : | (FStarC_Syntax_Syntax.U_unif uu___1, uu___2) -> (Prims.of_int (-1)) | (uu___1, FStarC_Syntax_Syntax.U_unif uu___2) -> Prims.int_one | (FStarC_Syntax_Syntax.U_max us1, FStarC_Syntax_Syntax.U_max us2) -> - let n1 = FStarC_Compiler_List.length us1 in - let n2 = FStarC_Compiler_List.length us2 in + let n1 = FStarC_List.length us1 in + let n2 = FStarC_List.length us2 in if n1 <> n2 then n1 - n2 else (let copt = - let uu___2 = FStarC_Compiler_List.zip us1 us2 in - FStarC_Compiler_Util.find_map uu___2 + let uu___2 = FStarC_List.zip us1 us2 in + FStarC_Util.find_map uu___2 (fun uu___3 -> match uu___3 with | (u11, u21) -> @@ -410,11 +398,11 @@ let (eq_univs_list : = fun us -> fun vs -> - ((FStarC_Compiler_List.length us) = (FStarC_Compiler_List.length vs)) - && (FStarC_Compiler_List.forall2 eq_univs us vs) + ((FStarC_List.length us) = (FStarC_List.length vs)) && + (FStarC_List.forall2 eq_univs us vs) let (ml_comp : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.comp) + FStarC_Syntax_Syntax.term -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.comp) = fun t -> fun r -> @@ -430,10 +418,7 @@ let (ml_comp : FStarC_Syntax_Syntax.flags = [FStarC_Syntax_Syntax.MLEFFECT] } in FStarC_Syntax_Syntax.mk_Comp uu___ -let (comp_effect_name : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> - FStarC_Ident.lident) - = +let (comp_effect_name : FStarC_Syntax_Syntax.comp -> FStarC_Ident.lident) = fun c -> match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Comp c1 -> c1.FStarC_Syntax_Syntax.effect_name @@ -441,9 +426,7 @@ let (comp_effect_name : | FStarC_Syntax_Syntax.GTotal uu___ -> FStarC_Parser_Const.effect_GTot_lid let (comp_flags : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.cflag Prims.list) - = + FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.cflag Prims.list) = fun c -> match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Total uu___ -> [FStarC_Syntax_Syntax.TOTAL] @@ -467,7 +450,7 @@ let (comp_eff_name_res_and_args : let (effect_indices_from_repr : FStarC_Syntax_Syntax.term -> Prims.bool -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.string -> FStarC_Syntax_Syntax.term Prims.list) = fun repr -> @@ -486,7 +469,7 @@ let (effect_indices_from_repr : | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = uu___; FStarC_Syntax_Syntax.args = uu___1::is;_} - -> FStarC_Compiler_List.map FStar_Pervasives_Native.fst is + -> FStarC_List.map FStar_Pervasives_Native.fst is | uu___ -> err1 () else (match repr1.FStarC_Syntax_Syntax.n with @@ -497,8 +480,7 @@ let (effect_indices_from_repr : let uu___2 = comp_eff_name_res_and_args c in (match uu___2 with | (uu___3, uu___4, args) -> - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - args) + FStarC_List.map FStar_Pervasives_Native.fst args) | uu___1 -> err1 ()) let (destruct_comp : FStarC_Syntax_Syntax.comp_typ -> @@ -514,17 +496,15 @@ let (destruct_comp : let uu___2 = FStarC_Ident.string_of_lid c.FStarC_Syntax_Syntax.effect_name in let uu___3 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length - c.FStarC_Syntax_Syntax.effect_args) in - FStarC_Compiler_Util.format2 + FStarC_Util.string_of_int + (FStarC_List.length c.FStarC_Syntax_Syntax.effect_args) in + FStarC_Util.format2 "Impossible: Got a computation %s with %s effect args" uu___2 uu___3 in failwith uu___1 in - let uu___ = FStarC_Compiler_List.hd c.FStarC_Syntax_Syntax.comp_univs in + let uu___ = FStarC_List.hd c.FStarC_Syntax_Syntax.comp_univs in (uu___, (c.FStarC_Syntax_Syntax.result_typ), wp) -let (is_named_tot : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = +let (is_named_tot : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Comp c1 -> @@ -532,40 +512,37 @@ let (is_named_tot : FStarC_Parser_Const.effect_Tot_lid | FStarC_Syntax_Syntax.Total uu___ -> true | FStarC_Syntax_Syntax.GTotal uu___ -> false -let (is_total_comp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = +let (is_total_comp : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> - (FStarC_Ident.lid_equals (comp_effect_name c) - FStarC_Parser_Const.effect_Tot_lid) - || - (FStarC_Compiler_Util.for_some - (fun uu___ -> - match uu___ with + (let uu___ = comp_effect_name c in + FStarC_Ident.lid_equals uu___ FStarC_Parser_Const.effect_Tot_lid) || + (let uu___ = comp_flags c in + FStarC_Util.for_some + (fun uu___1 -> + match uu___1 with | FStarC_Syntax_Syntax.TOTAL -> true | FStarC_Syntax_Syntax.RETURN -> true - | uu___1 -> false) (comp_flags c)) -let (is_partial_return : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = + | uu___2 -> false) uu___) +let (is_partial_return : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> - FStarC_Compiler_Util.for_some - (fun uu___ -> - match uu___ with + let uu___ = comp_flags c in + FStarC_Util.for_some + (fun uu___1 -> + match uu___1 with | FStarC_Syntax_Syntax.RETURN -> true | FStarC_Syntax_Syntax.PARTIAL_RETURN -> true - | uu___1 -> false) (comp_flags c) -let (is_tot_or_gtot_comp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = + | uu___2 -> false) uu___ +let (is_tot_or_gtot_comp : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> (is_total_comp c) || - (FStarC_Ident.lid_equals FStarC_Parser_Const.effect_GTot_lid - (comp_effect_name c)) + (let uu___ = comp_effect_name c in + FStarC_Ident.lid_equals FStarC_Parser_Const.effect_GTot_lid uu___) let (is_pure_effect : FStarC_Ident.lident -> Prims.bool) = fun l -> ((FStarC_Ident.lid_equals l FStarC_Parser_Const.effect_Tot_lid) || (FStarC_Ident.lid_equals l FStarC_Parser_Const.effect_PURE_lid)) || (FStarC_Ident.lid_equals l FStarC_Parser_Const.effect_Pure_lid) -let (is_pure_comp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = +let (is_pure_comp : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Total uu___ -> true @@ -574,7 +551,7 @@ let (is_pure_comp : ((is_total_comp c) || (is_pure_effect ct.FStarC_Syntax_Syntax.effect_name)) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.LEMMA -> true @@ -589,12 +566,13 @@ let (is_div_effect : FStarC_Ident.lident -> Prims.bool) = ((FStarC_Ident.lid_equals l FStarC_Parser_Const.effect_DIV_lid) || (FStarC_Ident.lid_equals l FStarC_Parser_Const.effect_Div_lid)) || (FStarC_Ident.lid_equals l FStarC_Parser_Const.effect_Dv_lid) -let (is_pure_or_ghost_comp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = - fun c -> (is_pure_comp c) || (is_ghost_effect (comp_effect_name c)) +let (is_pure_or_ghost_comp : FStarC_Syntax_Syntax.comp -> Prims.bool) = + fun c -> + (is_pure_comp c) || + (let uu___ = comp_effect_name c in is_ghost_effect uu___) let (is_pure_or_ghost_effect : FStarC_Ident.lident -> Prims.bool) = fun l -> (is_pure_effect l) || (is_ghost_effect l) -let (is_pure_or_ghost_function : FStarC_Syntax_Syntax.term -> Prims.bool) = +let (is_pure_or_ghost_function : FStarC_Syntax_Syntax.typ -> Prims.bool) = fun t -> let uu___ = let uu___1 = FStarC_Syntax_Subst.compress t in @@ -604,15 +582,14 @@ let (is_pure_or_ghost_function : FStarC_Syntax_Syntax.term -> Prims.bool) = { FStarC_Syntax_Syntax.bs1 = uu___1; FStarC_Syntax_Syntax.comp = c;_} -> is_pure_or_ghost_comp c | uu___1 -> true -let (is_lemma_comp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = +let (is_lemma_comp : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Comp ct -> FStarC_Ident.lid_equals ct.FStarC_Syntax_Syntax.effect_name FStarC_Parser_Const.effect_Lemma_lid | uu___ -> false -let (is_lemma : FStarC_Syntax_Syntax.term -> Prims.bool) = +let (is_lemma : FStarC_Syntax_Syntax.typ -> Prims.bool) = fun t -> let uu___ = let uu___1 = FStarC_Syntax_Subst.compress t in @@ -652,10 +629,7 @@ let rec (head_of : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = | uu___1 -> t let (head_and_args : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax * - (FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax * - FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option) - Prims.list)) + (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.args)) = fun t -> let t1 = FStarC_Syntax_Subst.compress t in @@ -682,9 +656,7 @@ let rec (__head_and_args_full : | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = head; FStarC_Syntax_Syntax.args = args;_} - -> - __head_and_args_full (FStarC_Compiler_List.op_At args acc) - unmeta1 head + -> __head_and_args_full (FStarC_List.op_At args acc) unmeta1 head | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = tm; FStarC_Syntax_Syntax.meta = uu___;_} @@ -692,15 +664,11 @@ let rec (__head_and_args_full : | uu___ -> (t1, acc) let (head_and_args_full : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.term * (FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax * FStarC_Syntax_Syntax.arg_qualifier - FStar_Pervasives_Native.option) Prims.list)) + (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.args)) = fun t -> __head_and_args_full [] false t let (head_and_args_full_unmeta : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.term * (FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax * FStarC_Syntax_Syntax.arg_qualifier - FStar_Pervasives_Native.option) Prims.list)) + (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.args)) = fun t -> __head_and_args_full [] true t let rec (leftmost_head : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = @@ -734,9 +702,7 @@ let rec (leftmost_head : | uu___ -> t1 let (leftmost_head_and_args : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.term * (FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax * FStarC_Syntax_Syntax.arg_qualifier - FStar_Pervasives_Native.option) Prims.list)) + (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.args)) = fun t -> let rec aux t1 args = @@ -745,7 +711,7 @@ let (leftmost_head_and_args : | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = t0; FStarC_Syntax_Syntax.args = args';_} - -> aux t0 (FStarC_Compiler_List.op_At args' args) + -> aux t0 (FStarC_List.op_At args' args) | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = t0; FStarC_Syntax_Syntax.meta = FStarC_Syntax_Syntax.Meta_pattern @@ -778,33 +744,28 @@ let (un_uinst : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = | FStarC_Syntax_Syntax.Tm_uinst (t2, uu___) -> FStarC_Syntax_Subst.compress t2 | uu___ -> t1 -let (is_ml_comp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = +let (is_ml_comp : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Comp c1 -> (let uu___ = FStarC_Parser_Const.effect_ML_lid () in FStarC_Ident.lid_equals c1.FStarC_Syntax_Syntax.effect_name uu___) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.MLEFFECT -> true | uu___1 -> false) c1.FStarC_Syntax_Syntax.flags) | uu___ -> false -let (comp_result : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = +let (comp_result : FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.typ) = fun c -> match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Total t -> t | FStarC_Syntax_Syntax.GTotal t -> t | FStarC_Syntax_Syntax.Comp ct -> ct.FStarC_Syntax_Syntax.result_typ let (set_result_typ : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.comp) + FStarC_Syntax_Syntax.comp -> + FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.comp) = fun c -> fun t -> @@ -823,15 +784,15 @@ let (set_result_typ : (ct.FStarC_Syntax_Syntax.effect_args); FStarC_Syntax_Syntax.flags = (ct.FStarC_Syntax_Syntax.flags) } -let (is_trivial_wp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = +let (is_trivial_wp : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> - FStarC_Compiler_Util.for_some - (fun uu___ -> - match uu___ with + let uu___ = comp_flags c in + FStarC_Util.for_some + (fun uu___1 -> + match uu___1 with | FStarC_Syntax_Syntax.TOTAL -> true | FStarC_Syntax_Syntax.RETURN -> true - | uu___1 -> false) (comp_flags c) + | uu___2 -> false) uu___ let (comp_effect_args : FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.args) = fun c -> @@ -856,9 +817,8 @@ let (primops : FStarC_Ident.lident Prims.list) = FStarC_Parser_Const.op_Or; FStarC_Parser_Const.op_Negation] let (is_primop_lid : FStarC_Ident.lident -> Prims.bool) = - fun l -> FStarC_Compiler_Util.for_some (FStarC_Ident.lid_equals l) primops -let (is_primop : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> Prims.bool) = + fun l -> FStarC_Util.for_some (FStarC_Ident.lid_equals l) primops +let (is_primop : FStarC_Syntax_Syntax.term -> Prims.bool) = fun f -> match f.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_fvar fv -> @@ -876,12 +836,8 @@ let rec (unascribe : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) -> unascribe e2 | uu___ -> e1 let rec (ascribe : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - ((FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax, - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax) - FStar_Pervasives.either * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax FStar_Pervasives_Native.option * - Prims.bool) -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.ascription -> FStarC_Syntax_Syntax.term) = fun t -> fun k -> @@ -902,9 +858,8 @@ let (unfold_lazy : FStarC_Syntax_Syntax.lazyinfo -> FStarC_Syntax_Syntax.term) = fun i -> let uu___ = - let uu___1 = - FStarC_Compiler_Effect.op_Bang FStarC_Syntax_Syntax.lazy_chooser in - FStarC_Compiler_Util.must uu___1 in + let uu___1 = FStarC_Effect.op_Bang FStarC_Syntax_Syntax.lazy_chooser in + FStarC_Util.must uu___1 in uu___ i.FStarC_Syntax_Syntax.lkind i let rec (unlazy : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> @@ -928,9 +883,7 @@ let (unlazy_emb : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = | uu___1 -> t) | uu___1 -> t let unlazy_as_t : - 'uuuuu . - FStarC_Syntax_Syntax.lazy_kind -> FStarC_Syntax_Syntax.term -> 'uuuuu - = + 'a . FStarC_Syntax_Syntax.lazy_kind -> FStarC_Syntax_Syntax.term -> 'a = fun k -> fun t -> let uu___ = @@ -955,8 +908,8 @@ let unlazy_as_t : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_lazy_kind k' in - FStarC_Compiler_Util.format2 - "Expected Tm_lazy of kind %s, got %s" uu___6 uu___7 in + FStarC_Util.format2 "Expected Tm_lazy of kind %s, got %s" + uu___6 uu___7 in failwith uu___5) | uu___1 -> failwith "Not a Tm_lazy of the expected kind" let mk_lazy : @@ -964,7 +917,7 @@ let mk_lazy : 'a -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.lazy_kind -> - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option -> + FStarC_Range_Type.range FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.term = fun t -> @@ -974,8 +927,7 @@ let mk_lazy : let rng = match r with | FStar_Pervasives_Native.Some r1 -> r1 - | FStar_Pervasives_Native.None -> - FStarC_Compiler_Range_Type.dummyRange in + | FStar_Pervasives_Native.None -> FStarC_Range_Type.dummyRange in let i = let uu___ = FStarC_Dyn.mkdyn t in { @@ -985,10 +937,7 @@ let mk_lazy : FStarC_Syntax_Syntax.rng = rng } in FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_lazy i) rng -let (canon_app : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term) - = +let (canon_app : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> let uu___ = let uu___1 = unascribe t in head_and_args_full uu___1 in match uu___ with @@ -1056,7 +1005,7 @@ let (is_fun : FStarC_Syntax_Syntax.term -> Prims.bool) = match uu___ with | FStarC_Syntax_Syntax.Tm_abs uu___1 -> true | uu___1 -> false -let (is_function_typ : FStarC_Syntax_Syntax.term -> Prims.bool) = +let (is_function_typ : FStarC_Syntax_Syntax.typ -> Prims.bool) = fun t -> let uu___ = let uu___1 = FStarC_Syntax_Subst.compress t in @@ -1064,7 +1013,7 @@ let (is_function_typ : FStarC_Syntax_Syntax.term -> Prims.bool) = match uu___ with | FStarC_Syntax_Syntax.Tm_arrow uu___1 -> true | uu___1 -> false -let rec (pre_typ : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = +let rec (pre_typ : FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ) = fun t -> let t1 = FStarC_Syntax_Subst.compress t in match t1.FStarC_Syntax_Syntax.n with @@ -1077,11 +1026,9 @@ let rec (pre_typ : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = -> pre_typ t2 | uu___ -> t1 let (destruct : - FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.typ -> FStarC_Ident.lident -> - (FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax * - FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option) - Prims.list FStar_Pervasives_Native.option) + FStarC_Syntax_Syntax.args FStar_Pervasives_Native.option) = fun typ -> fun lid -> @@ -1161,38 +1108,32 @@ let (lid_of_sigelt : FStarC_Ident.lident FStar_Pervasives_Native.option) = fun se -> - match lids_of_sigelt se with + let uu___ = lids_of_sigelt se in + match uu___ with | l::[] -> FStar_Pervasives_Native.Some l - | uu___ -> FStar_Pervasives_Native.None + | uu___1 -> FStar_Pervasives_Native.None let (quals_of_sigelt : FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.qualifier Prims.list) = fun x -> x.FStarC_Syntax_Syntax.sigquals let (range_of_sigelt : - FStarC_Syntax_Syntax.sigelt -> FStarC_Compiler_Range_Type.range) = + FStarC_Syntax_Syntax.sigelt -> FStarC_Range_Type.range) = fun x -> x.FStarC_Syntax_Syntax.sigrng -let range_of_arg : - 'uuuuu 'uuuuu1 . - ('uuuuu FStarC_Syntax_Syntax.syntax * 'uuuuu1) -> - FStarC_Compiler_Range_Type.range - = +let (range_of_arg : FStarC_Syntax_Syntax.arg -> FStarC_Range_Type.range) = fun uu___ -> match uu___ with | (hd, uu___1) -> hd.FStarC_Syntax_Syntax.pos -let range_of_args : - 'uuuuu 'uuuuu1 . - ('uuuuu FStarC_Syntax_Syntax.syntax * 'uuuuu1) Prims.list -> - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.range +let (range_of_args : + FStarC_Syntax_Syntax.args -> + FStarC_Range_Type.range -> FStarC_Range_Type.range) = fun args -> fun r -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun r1 -> fun a -> - FStarC_Compiler_Range_Ops.union_ranges r1 (range_of_arg a)) r - args + let uu___ = range_of_arg a in + FStarC_Range_Ops.union_ranges r1 uu___) r args let (mk_app : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - (FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax * - FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option) - Prims.list -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.args -> FStarC_Syntax_Syntax.term) = fun f -> fun args -> @@ -1207,14 +1148,13 @@ let (mk_app : FStarC_Syntax_Syntax.args = args }) r let (mk_app_binders : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.binder Prims.list -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.term) = fun f -> fun bs -> let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___1 = FStarC_Syntax_Syntax.bv_to_name @@ -1224,7 +1164,7 @@ let (mk_app_binders : let (field_projector_prefix : Prims.string) = "__proj__" let (field_projector_sep : Prims.string) = "__item__" let (field_projector_contains_constructor : Prims.string -> Prims.bool) = - fun s -> FStarC_Compiler_Util.starts_with s field_projector_prefix + fun s -> FStarC_Util.starts_with s field_projector_prefix let (mk_field_projector_name_from_string : Prims.string -> Prims.string -> Prims.string) = fun constr -> @@ -1237,20 +1177,21 @@ let (mk_field_projector_name_from_ident : fun i -> let itext = FStarC_Ident.string_of_id i in let newi = - if field_projector_contains_constructor itext + let uu___ = field_projector_contains_constructor itext in + if uu___ then i else - (let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStarC_Ident.ident_of_lid lid in - FStarC_Ident.string_of_id uu___4 in - mk_field_projector_name_from_string uu___3 itext in - let uu___3 = FStarC_Ident.range_of_id i in (uu___2, uu___3) in - FStarC_Ident.mk_ident uu___1) in + (let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = FStarC_Ident.ident_of_lid lid in + FStarC_Ident.string_of_id uu___5 in + mk_field_projector_name_from_string uu___4 itext in + let uu___4 = FStarC_Ident.range_of_id i in (uu___3, uu___4) in + FStarC_Ident.mk_ident uu___2) in let uu___ = let uu___1 = FStarC_Ident.ns_of_lid lid in - FStarC_Compiler_List.op_At uu___1 [newi] in + FStarC_List.op_At uu___1 [newi] in FStarC_Ident.lid_of_ids uu___ let (mk_field_projector_name : FStarC_Ident.lident -> @@ -1265,7 +1206,7 @@ let (mk_field_projector_name : then let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Util.string_of_int i in + let uu___3 = FStarC_Util.string_of_int i in Prims.strcat "_" uu___3 in let uu___3 = FStarC_Syntax_Syntax.range_of_bv x in (uu___2, uu___3) in @@ -1291,10 +1232,10 @@ let (set_uvar : let uu___1 = let uu___2 = let uu___3 = FStarC_Syntax_Unionfind.uvar_id uv in - FStarC_Compiler_Util.string_of_int uu___3 in + FStarC_Util.string_of_int uu___3 in let uu___3 = tts t in let uu___4 = tts t' in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Changing a fixed uvar! ?%s to %s but it is already set to %s\n" uu___2 uu___3 uu___4 in failwith uu___1 @@ -1316,20 +1257,16 @@ let (qualifier_equal : let uu___1 = FStarC_Ident.string_of_id l2b in uu___ = uu___1) | (FStarC_Syntax_Syntax.RecordType (ns1, f1), FStarC_Syntax_Syntax.RecordType (ns2, f2)) -> - ((((FStarC_Compiler_List.length ns1) = - (FStarC_Compiler_List.length ns2)) - && - (FStarC_Compiler_List.forall2 + ((((FStarC_List.length ns1) = (FStarC_List.length ns2)) && + (FStarC_List.forall2 (fun x1 -> fun x2 -> let uu___ = FStarC_Ident.string_of_id x1 in let uu___1 = FStarC_Ident.string_of_id x2 in uu___ = uu___1) f1 f2)) - && - ((FStarC_Compiler_List.length f1) = - (FStarC_Compiler_List.length f2))) + && ((FStarC_List.length f1) = (FStarC_List.length f2))) && - (FStarC_Compiler_List.forall2 + (FStarC_List.forall2 (fun x1 -> fun x2 -> let uu___ = FStarC_Ident.string_of_id x1 in @@ -1337,20 +1274,16 @@ let (qualifier_equal : uu___ = uu___1) f1 f2) | (FStarC_Syntax_Syntax.RecordConstructor (ns1, f1), FStarC_Syntax_Syntax.RecordConstructor (ns2, f2)) -> - ((((FStarC_Compiler_List.length ns1) = - (FStarC_Compiler_List.length ns2)) - && - (FStarC_Compiler_List.forall2 + ((((FStarC_List.length ns1) = (FStarC_List.length ns2)) && + (FStarC_List.forall2 (fun x1 -> fun x2 -> let uu___ = FStarC_Ident.string_of_id x1 in let uu___1 = FStarC_Ident.string_of_id x2 in uu___ = uu___1) f1 f2)) - && - ((FStarC_Compiler_List.length f1) = - (FStarC_Compiler_List.length f2))) + && ((FStarC_List.length f1) = (FStarC_List.length f2))) && - (FStarC_Compiler_List.forall2 + (FStarC_List.forall2 (fun x1 -> fun x2 -> let uu___ = FStarC_Ident.string_of_id x1 in @@ -1359,9 +1292,9 @@ let (qualifier_equal : | uu___ -> q1 = q2 let (abs : FStarC_Syntax_Syntax.binders -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.residual_comp FStar_Pervasives_Native.option -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term) = fun bs -> fun t -> @@ -1372,8 +1305,7 @@ let (abs : | FStar_Pervasives_Native.Some rc -> let uu___ = let uu___1 = - FStarC_Compiler_Util.map_opt - rc.FStarC_Syntax_Syntax.residual_typ + FStarC_Util.map_opt rc.FStarC_Syntax_Syntax.residual_typ (FStarC_Syntax_Subst.close bs) in { FStarC_Syntax_Syntax.residual_effect = @@ -1399,7 +1331,7 @@ let (abs : let uu___2 = let uu___3 = let uu___4 = FStarC_Syntax_Subst.close_binders bs in - FStarC_Compiler_List.op_At uu___4 bs' in + FStarC_List.op_At uu___4 bs' in let uu___4 = close_lopt lopt' in { FStarC_Syntax_Syntax.bs = uu___3; @@ -1421,9 +1353,8 @@ let (abs : FStarC_Syntax_Syntax.Tm_abs uu___3 in FStarC_Syntax_Syntax.mk uu___2 t.FStarC_Syntax_Syntax.pos) let (arrow_ln : - FStarC_Syntax_Syntax.binder Prims.list -> - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.binders -> + FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.term) = fun bs -> fun c -> @@ -1431,10 +1362,10 @@ let (arrow_ln : | [] -> comp_result c | uu___ -> let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun a -> fun b -> - FStarC_Compiler_Range_Ops.union_ranges a + FStarC_Range_Ops.union_ranges a ((b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort).FStarC_Syntax_Syntax.pos) c.FStarC_Syntax_Syntax.pos bs in FStarC_Syntax_Syntax.mk @@ -1443,8 +1374,7 @@ let (arrow_ln : }) uu___1 let (arrow : FStarC_Syntax_Syntax.binders -> - FStarC_Syntax_Syntax.comp -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.term) = fun bs -> fun c -> @@ -1452,8 +1382,7 @@ let (arrow : let bs1 = FStarC_Syntax_Subst.close_binders bs in arrow_ln bs1 c1 let (flat_arrow : FStarC_Syntax_Syntax.binders -> - FStarC_Syntax_Syntax.comp -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.term) = fun bs -> fun c -> @@ -1479,16 +1408,14 @@ let (flat_arrow : (FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = - (FStarC_Compiler_List.op_At bs1 bs'); + (FStarC_List.op_At bs1 bs'); FStarC_Syntax_Syntax.comp = c' }) t.FStarC_Syntax_Syntax.pos | uu___2 -> t) | uu___1 -> t) | uu___1 -> t let rec (canon_arrow : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> let uu___ = let uu___1 = FStarC_Syntax_Subst.compress t in @@ -1514,8 +1441,7 @@ let rec (canon_arrow : | uu___1 -> t let (refine : FStarC_Syntax_Syntax.bv -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun b -> fun t -> @@ -1529,8 +1455,7 @@ let (refine : FStarC_Syntax_Syntax.Tm_refine uu___1 in let uu___1 = let uu___2 = FStarC_Syntax_Syntax.range_of_bv b in - FStarC_Compiler_Range_Ops.union_ranges uu___2 - t.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.union_ranges uu___2 t.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk uu___ uu___1 let (branch : FStarC_Syntax_Syntax.branch -> FStarC_Syntax_Syntax.branch) = fun b -> FStarC_Syntax_Subst.close_branch b @@ -1539,7 +1464,7 @@ let (has_decreases : FStarC_Syntax_Syntax.comp -> Prims.bool) = match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Comp ct -> let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.DECREASES uu___2 -> true @@ -1551,7 +1476,7 @@ let (has_decreases : FStarC_Syntax_Syntax.comp -> Prims.bool) = | uu___ -> false let rec (arrow_formals_comp_ln : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.binder Prims.list * FStarC_Syntax_Syntax.comp)) + (FStarC_Syntax_Syntax.binders * FStarC_Syntax_Syntax.comp)) = fun k -> let k1 = FStarC_Syntax_Subst.compress k in @@ -1563,9 +1488,9 @@ let rec (arrow_formals_comp_ln : (let uu___1 = has_decreases c in Prims.op_Negation uu___1) in if uu___ then - let uu___1 = arrow_formals_comp_ln (comp_result c) in - (match uu___1 with - | (bs', k2) -> ((FStarC_Compiler_List.op_At bs bs'), k2)) + let uu___1 = + let uu___2 = comp_result c in arrow_formals_comp_ln uu___2 in + (match uu___1 with | (bs', k2) -> ((FStarC_List.op_At bs bs'), k2)) else (bs, c) | FStarC_Syntax_Syntax.Tm_refine { @@ -1602,20 +1527,18 @@ let (arrow_formals_comp : match uu___ with | (bs, c) -> FStarC_Syntax_Subst.open_comp bs c let (arrow_formals_ln : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.binder Prims.list * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax)) + (FStarC_Syntax_Syntax.binders * FStarC_Syntax_Syntax.typ)) = fun k -> let uu___ = arrow_formals_comp_ln k in - match uu___ with | (bs, c) -> (bs, (comp_result c)) + match uu___ with | (bs, c) -> let uu___1 = comp_result c in (bs, uu___1) let (arrow_formals : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.binders * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax)) + (FStarC_Syntax_Syntax.binders * FStarC_Syntax_Syntax.typ)) = fun k -> let uu___ = arrow_formals_comp k in - match uu___ with | (bs, c) -> (bs, (comp_result c)) + match uu___ with | (bs, c) -> let uu___1 = comp_result c in (bs, uu___1) let (let_rec_arity : FStarC_Syntax_Syntax.letbinding -> (Prims.int * Prims.bool Prims.list FStar_Pervasives_Native.option)) @@ -1631,11 +1554,12 @@ let (let_rec_arity : (match uu___ with | (bs1, c1) -> let uu___1 = - FStarC_Compiler_Util.find_opt - (fun uu___2 -> - match uu___2 with - | FStarC_Syntax_Syntax.DECREASES uu___3 -> true - | uu___3 -> false) (comp_flags c1) in + let uu___2 = comp_flags c1 in + FStarC_Util.find_opt + (fun uu___3 -> + match uu___3 with + | FStarC_Syntax_Syntax.DECREASES uu___4 -> true + | uu___4 -> false) uu___2 in (match uu___1 with | FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.DECREASES d) -> @@ -1644,10 +1568,11 @@ let (let_rec_arity : let uu___3 = is_total_comp c1 in if uu___3 then - let uu___4 = arrow_until_decreases (comp_result c1) in + let uu___4 = + let uu___5 = comp_result c1 in + arrow_until_decreases uu___5 in (match uu___4 with - | (bs', d) -> - ((FStarC_Compiler_List.op_At bs1 bs'), d)) + | (bs', d) -> ((FStarC_List.op_At bs1 bs'), d)) else (bs1, FStar_Pervasives_Native.None))) | FStarC_Syntax_Syntax.Tm_refine { @@ -1661,10 +1586,9 @@ let (let_rec_arity : let uu___ = arrow_until_decreases lb.FStarC_Syntax_Syntax.lbtyp in match uu___ with | (bs, dopt) -> - let n_univs = - FStarC_Compiler_List.length lb.FStarC_Syntax_Syntax.lbunivs in + let n_univs = FStarC_List.length lb.FStarC_Syntax_Syntax.lbunivs in let uu___1 = - FStarC_Compiler_Util.map_opt dopt + FStarC_Util.map_opt dopt (fun d -> let d_bvs = match d with @@ -1675,9 +1599,9 @@ let (let_rec_arity : Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) ()) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun uu___3 -> (fun s -> @@ -1687,7 +1611,7 @@ let (let_rec_arity : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic s) (Obj.magic uu___3))) uu___4 uu___3) uu___2 l)) @@ -1698,22 +1622,22 @@ let (let_rec_arity : let uu___3 = FStarC_Syntax_Free.names e in FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___2) (Obj.magic uu___3))) in let uu___2 = FStarC_Common.tabulate n_univs (fun uu___3 -> false) in let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) b.FStarC_Syntax_Syntax.binder_bv (Obj.magic d_bvs)) bs in - FStarC_Compiler_List.op_At uu___2 uu___3) in - ((n_univs + (FStarC_Compiler_List.length bs)), uu___1) + FStarC_List.op_At uu___2 uu___3) in + ((n_univs + (FStarC_List.length bs)), uu___1) let (abs_formals_maybe_unascribe_body : Prims.bool -> FStarC_Syntax_Syntax.term -> @@ -1727,8 +1651,7 @@ let (abs_formals_maybe_unascribe_body : | FStar_Pervasives_Native.Some rc -> let uu___ = let uu___1 = - FStarC_Compiler_Util.map_opt - rc.FStarC_Syntax_Syntax.residual_typ + FStarC_Util.map_opt rc.FStarC_Syntax_Syntax.residual_typ (FStarC_Syntax_Subst.subst s) in { FStarC_Syntax_Syntax.residual_effect = @@ -1751,8 +1674,7 @@ let (abs_formals_maybe_unascribe_body : then let uu___1 = aux t2 what in (match uu___1 with - | (bs', t3, what1) -> - ((FStarC_Compiler_List.op_At bs bs'), t3, what1)) + | (bs', t3, what1) -> ((FStarC_List.op_At bs bs'), t3, what1)) else (bs, t2, what) | uu___1 -> ([], t1, abs_body_lcomp) in let uu___ = aux t FStar_Pervasives_Native.None in @@ -1794,7 +1716,7 @@ let (remove_inacc : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = | uu___1 -> let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_List.map no_acc bs in + let uu___4 = FStarC_List.map no_acc bs in { FStarC_Syntax_Syntax.bs1 = uu___4; FStarC_Syntax_Syntax.comp = c @@ -1805,13 +1727,11 @@ let (mk_letbinding : (FStarC_Syntax_Syntax.bv, FStarC_Syntax_Syntax.fv) FStar_Pervasives.either -> FStarC_Syntax_Syntax.univ_name Prims.list -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.term -> FStarC_Ident.lident -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax Prims.list - -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.letbinding) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term Prims.list -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.letbinding) = fun lbname -> fun univ_vars -> @@ -1837,10 +1757,8 @@ let (close_univs_and_mk_letbinding : FStarC_Syntax_Syntax.term -> FStarC_Ident.lident -> FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax - Prims.list -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.letbinding) + FStarC_Syntax_Syntax.term Prims.list -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.letbinding) = fun recs -> fun lbname -> @@ -1856,11 +1774,11 @@ let (close_univs_and_mk_letbinding : | (uu___, []) -> def | (FStar_Pervasives_Native.Some fvs, uu___) -> let universes = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> FStarC_Syntax_Syntax.U_name uu___1) univ_vars in let inst = - FStarC_Compiler_List.map + FStarC_List.map (fun fv -> (((fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v), universes)) fvs in @@ -1872,10 +1790,10 @@ let (close_univs_and_mk_letbinding : mk_letbinding lbname univ_vars typ1 eff def2 attrs pos let (open_univ_vars_binders_and_comp : FStarC_Syntax_Syntax.univ_names -> - FStarC_Syntax_Syntax.binder Prims.list -> + FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.comp -> - (FStarC_Syntax_Syntax.univ_names * FStarC_Syntax_Syntax.binder - Prims.list * FStarC_Syntax_Syntax.comp)) + (FStarC_Syntax_Syntax.univ_names * FStarC_Syntax_Syntax.binders * + FStarC_Syntax_Syntax.comp)) = fun uvs -> fun binders -> @@ -1922,9 +1840,6 @@ let (is_exists : FStarC_Ident.lident -> Prims.bool) = fun lid -> FStarC_Ident.lid_equals lid FStarC_Parser_Const.exists_lid let (is_qlid : FStarC_Ident.lident -> Prims.bool) = fun lid -> (is_forall lid) || (is_exists lid) -let (is_equality : - FStarC_Ident.lident FStarC_Syntax_Syntax.withinfo_t -> Prims.bool) = - fun x -> is_lid_equality x.FStarC_Syntax_Syntax.v let (lid_is_connective : FStarC_Ident.lident -> Prims.bool) = let lst = [FStarC_Parser_Const.and_lid; @@ -1932,7 +1847,7 @@ let (lid_is_connective : FStarC_Ident.lident -> Prims.bool) = FStarC_Parser_Const.not_lid; FStarC_Parser_Const.iff_lid; FStarC_Parser_Const.imp_lid] in - fun lid -> FStarC_Compiler_Util.for_some (FStarC_Ident.lid_equals lid) lst + fun lid -> FStarC_Util.for_some (FStarC_Ident.lid_equals lid) lst let (is_constructor : FStarC_Syntax_Syntax.term -> FStarC_Ident.lident -> Prims.bool) = fun t -> @@ -1981,66 +1896,63 @@ let (is_fstar_tactics_by_tactic : FStarC_Syntax_Syntax.term -> Prims.bool) = let (ktype : FStarC_Syntax_Syntax.term) = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type FStarC_Syntax_Syntax.U_unknown) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (ktype0 : FStarC_Syntax_Syntax.term) = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type FStarC_Syntax_Syntax.U_zero) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (type_u : unit -> (FStarC_Syntax_Syntax.typ * FStarC_Syntax_Syntax.universe)) = fun uu___ -> let u = let uu___1 = - FStarC_Syntax_Unionfind.univ_fresh - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Syntax_Unionfind.univ_fresh FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.U_unif uu___1 in let uu___1 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in (uu___1, u) let (type_with_u : FStarC_Syntax_Syntax.universe -> FStarC_Syntax_Syntax.typ) = fun u -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u) - FStarC_Compiler_Range_Type.dummyRange -let (attr_substitute : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) = + FStarC_Range_Type.dummyRange +let (attr_substitute : FStarC_Syntax_Syntax.term) = let uu___ = let uu___1 = FStarC_Syntax_Syntax.lid_as_fv FStarC_Parser_Const.attr_substitute_lid FStar_Pervasives_Native.None in FStarC_Syntax_Syntax.Tm_fvar uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange let (exp_bool : Prims.bool -> FStarC_Syntax_Syntax.term) = fun b -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_bool b)) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (exp_true_bool : FStarC_Syntax_Syntax.term) = exp_bool true let (exp_false_bool : FStarC_Syntax_Syntax.term) = exp_bool false let (exp_unit : FStarC_Syntax_Syntax.term) = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_constant FStarC_Const.Const_unit) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (exp_int : Prims.string -> FStarC_Syntax_Syntax.term) = fun s -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_int (s, FStar_Pervasives_Native.None))) - FStarC_Compiler_Range_Type.dummyRange -let (exp_char : FStarC_BaseTypes.char -> FStarC_Syntax_Syntax.term) = + FStarC_Range_Type.dummyRange +let (exp_char : FStar_Char.char -> FStarC_Syntax_Syntax.term) = fun c -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_char c)) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (exp_string : Prims.string -> FStarC_Syntax_Syntax.term) = fun s -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_constant - (FStarC_Const.Const_string - (s, FStarC_Compiler_Range_Type.dummyRange))) - FStarC_Compiler_Range_Type.dummyRange -let (fvar_const : FStarC_Ident.lident -> FStarC_Syntax_Syntax.term) = + (FStarC_Const.Const_string (s, FStarC_Range_Type.dummyRange))) + FStarC_Range_Type.dummyRange +let (fvar_const : FStarC_Ident.lid -> FStarC_Syntax_Syntax.term) = fun l -> FStarC_Syntax_Syntax.fvar_with_dd l FStar_Pervasives_Native.None let (tand : FStarC_Syntax_Syntax.term) = fvar_const FStarC_Parser_Const.and_lid @@ -2078,11 +1990,9 @@ let (t_dsl_tac_typ : FStarC_Syntax_Syntax.term) = FStarC_Syntax_Syntax.fvar FStarC_Parser_Const.dsl_tac_typ_lid FStar_Pervasives_Native.None let (mk_conj_opt : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax - FStar_Pervasives_Native.option -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax - FStar_Pervasives_Native.option) + FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option -> + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option) = fun phi1 -> fun phi2 -> @@ -2103,15 +2013,14 @@ let (mk_conj_opt : } in FStarC_Syntax_Syntax.Tm_app uu___2 in let uu___2 = - FStarC_Compiler_Range_Ops.union_ranges - phi11.FStarC_Syntax_Syntax.pos phi2.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.union_ranges phi11.FStarC_Syntax_Syntax.pos + phi2.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk uu___1 uu___2 in FStar_Pervasives_Native.Some uu___ let (mk_binop : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun op_t -> fun phi1 -> @@ -2129,13 +2038,10 @@ let (mk_binop : } in FStarC_Syntax_Syntax.Tm_app uu___1 in let uu___1 = - FStarC_Compiler_Range_Ops.union_ranges - phi1.FStarC_Syntax_Syntax.pos phi2.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.union_ranges phi1.FStarC_Syntax_Syntax.pos + phi2.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk uu___ uu___1 -let (mk_neg : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = +let (mk_neg : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun phi -> let uu___ = let uu___1 = @@ -2145,47 +2051,36 @@ let (mk_neg : FStarC_Syntax_Syntax.Tm_app uu___1 in FStarC_Syntax_Syntax.mk uu___ phi.FStarC_Syntax_Syntax.pos let (mk_conj : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun phi1 -> fun phi2 -> mk_binop tand phi1 phi2 let (mk_conj_l : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax Prims.list -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = + FStarC_Syntax_Syntax.term Prims.list -> FStarC_Syntax_Syntax.term) = fun phi -> match phi with | [] -> FStarC_Syntax_Syntax.fvar_with_dd FStarC_Parser_Const.true_lid FStar_Pervasives_Native.None - | hd::tl -> FStarC_Compiler_List.fold_right mk_conj tl hd + | hd::tl -> FStarC_List.fold_right mk_conj tl hd let (mk_disj : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun phi1 -> fun phi2 -> mk_binop tor phi1 phi2 let (mk_disj_l : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax Prims.list -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = + FStarC_Syntax_Syntax.term Prims.list -> FStarC_Syntax_Syntax.term) = fun phi -> match phi with | [] -> t_false - | hd::tl -> FStarC_Compiler_List.fold_right mk_disj tl hd + | hd::tl -> FStarC_List.fold_right mk_disj tl hd let (mk_imp : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun phi1 -> fun phi2 -> mk_binop timp phi1 phi2 let (mk_iff : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun phi1 -> fun phi2 -> mk_binop tiff phi1 phi2 -let (b2t : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = +let (b2t : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun e -> let uu___ = let uu___1 = @@ -2220,9 +2115,8 @@ let (is_t_true : FStarC_Syntax_Syntax.term -> Prims.bool) = FStarC_Syntax_Syntax.fv_eq_lid fv FStarC_Parser_Const.true_lid | uu___1 -> false let (mk_conj_simp : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t1 -> fun t2 -> @@ -2232,9 +2126,8 @@ let (mk_conj_simp : else (let uu___2 = is_t_true t2 in if uu___2 then t1 else mk_conj t1 t2) let (mk_disj_simp : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t1 -> fun t2 -> @@ -2247,9 +2140,8 @@ let (mk_disj_simp : let (teq : FStarC_Syntax_Syntax.term) = fvar_const FStarC_Parser_Const.eq2_lid let (mk_untyped_eq2 : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun e1 -> fun e2 -> @@ -2264,7 +2156,7 @@ let (mk_untyped_eq2 : } in FStarC_Syntax_Syntax.Tm_app uu___1 in let uu___1 = - FStarC_Compiler_Range_Ops.union_ranges e1.FStarC_Syntax_Syntax.pos + FStarC_Range_Ops.union_ranges e1.FStarC_Syntax_Syntax.pos e2.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk uu___ uu___1 let (mk_eq2 : @@ -2294,15 +2186,14 @@ let (mk_eq2 : } in FStarC_Syntax_Syntax.Tm_app uu___1 in let uu___1 = - FStarC_Compiler_Range_Ops.union_ranges - e1.FStarC_Syntax_Syntax.pos e2.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.union_ranges e1.FStarC_Syntax_Syntax.pos + e2.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk uu___ uu___1 let (mk_eq3_no_univ : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = let teq3 = fvar_const FStarC_Parser_Const.eq3_lid in fun t1 -> @@ -2328,14 +2219,13 @@ let (mk_eq3_no_univ : } in FStarC_Syntax_Syntax.Tm_app uu___1 in let uu___1 = - FStarC_Compiler_Range_Ops.union_ranges - e1.FStarC_Syntax_Syntax.pos e2.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.union_ranges e1.FStarC_Syntax_Syntax.pos + e2.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk uu___ uu___1 let (mk_has_type : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> fun x -> @@ -2346,7 +2236,7 @@ let (mk_has_type : (FStarC_Syntax_Syntax.Tm_uinst (t_has_type, [FStarC_Syntax_Syntax.U_zero; FStarC_Syntax_Syntax.U_zero])) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___ = let uu___1 = let uu___2 = @@ -2362,7 +2252,7 @@ let (mk_has_type : FStarC_Syntax_Syntax.args = uu___2 } in FStarC_Syntax_Syntax.Tm_app uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange let (tforall : FStarC_Syntax_Syntax.term) = FStarC_Syntax_Syntax.fvar_with_dd FStarC_Parser_Const.forall_lid FStar_Pervasives_Native.None @@ -2376,9 +2266,8 @@ let (decidable_eq : FStarC_Syntax_Syntax.term) = fvar_const FStarC_Parser_Const.op_Eq let (mk_decidable_eq : FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> fun e1 -> @@ -2399,15 +2288,14 @@ let (mk_decidable_eq : } in FStarC_Syntax_Syntax.Tm_app uu___1 in let uu___1 = - FStarC_Compiler_Range_Ops.union_ranges e1.FStarC_Syntax_Syntax.pos + FStarC_Range_Ops.union_ranges e1.FStarC_Syntax_Syntax.pos e2.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk uu___ uu___1 let (b_and : FStarC_Syntax_Syntax.term) = fvar_const FStarC_Parser_Const.op_And let (mk_and : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun e1 -> fun e2 -> @@ -2424,21 +2312,17 @@ let (mk_and : } in FStarC_Syntax_Syntax.Tm_app uu___1 in let uu___1 = - FStarC_Compiler_Range_Ops.union_ranges e1.FStarC_Syntax_Syntax.pos + FStarC_Range_Ops.union_ranges e1.FStarC_Syntax_Syntax.pos e2.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk uu___ uu___1 let (mk_and_l : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax Prims.list -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = + FStarC_Syntax_Syntax.term Prims.list -> FStarC_Syntax_Syntax.term) = fun l -> match l with | [] -> exp_true_bool - | hd::tl -> FStarC_Compiler_List.fold_left mk_and hd tl + | hd::tl -> FStarC_List.fold_left mk_and hd tl let (mk_boolean_negation : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun b -> let uu___ = let uu___1 = @@ -2452,8 +2336,7 @@ let (mk_boolean_negation : FStarC_Syntax_Syntax.mk uu___ b.FStarC_Syntax_Syntax.pos let (mk_residual_comp : FStarC_Ident.lident -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax - FStar_Pervasives_Native.option -> + FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.cflag Prims.list -> FStarC_Syntax_Syntax.residual_comp) = @@ -2466,9 +2349,7 @@ let (mk_residual_comp : FStarC_Syntax_Syntax.residual_flags = f } let (residual_tot : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.residual_comp) - = + FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.residual_comp) = fun t -> { FStarC_Syntax_Syntax.residual_effect = @@ -2477,9 +2358,7 @@ let (residual_tot : FStarC_Syntax_Syntax.residual_flags = [FStarC_Syntax_Syntax.TOTAL] } let (residual_gtot : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.residual_comp) - = + FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.residual_comp) = fun t -> { FStarC_Syntax_Syntax.residual_effect = @@ -2490,22 +2369,25 @@ let (residual_gtot : let (residual_comp_of_comp : FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.residual_comp) = fun c -> - let uu___ = - FStarC_Compiler_List.filter - (fun uu___1 -> - match uu___1 with - | FStarC_Syntax_Syntax.DECREASES uu___2 -> false - | uu___2 -> true) (comp_flags c) in + let uu___ = comp_effect_name c in + let uu___1 = + let uu___2 = comp_result c in FStar_Pervasives_Native.Some uu___2 in + let uu___2 = + let uu___3 = comp_flags c in + FStarC_List.filter + (fun uu___4 -> + match uu___4 with + | FStarC_Syntax_Syntax.DECREASES uu___5 -> false + | uu___5 -> true) uu___3 in { - FStarC_Syntax_Syntax.residual_effect = (comp_effect_name c); - FStarC_Syntax_Syntax.residual_typ = - (FStar_Pervasives_Native.Some (comp_result c)); - FStarC_Syntax_Syntax.residual_flags = uu___ + FStarC_Syntax_Syntax.residual_effect = uu___; + FStarC_Syntax_Syntax.residual_typ = uu___1; + FStarC_Syntax_Syntax.residual_flags = uu___2 } let (mk_forall_aux : FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> FStarC_Syntax_Syntax.bv -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) = fun fa -> @@ -2522,8 +2404,10 @@ let (mk_forall_aux : let uu___7 = let uu___8 = FStarC_Syntax_Syntax.mk_binder x in [uu___8] in - abs uu___7 body - (FStar_Pervasives_Native.Some (residual_tot ktype0)) in + let uu___8 = + let uu___9 = residual_tot ktype0 in + FStar_Pervasives_Native.Some uu___9 in + abs uu___7 body uu___8 in FStarC_Syntax_Syntax.as_arg uu___6 in [uu___5] in uu___3 :: uu___4 in @@ -2532,7 +2416,7 @@ let (mk_forall_aux : FStarC_Syntax_Syntax.args = uu___2 } in FStarC_Syntax_Syntax.Tm_app uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange let (mk_forall_no_univ : FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ) @@ -2553,7 +2437,7 @@ let (close_forall_no_univs : = fun bs -> fun f -> - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun f1 -> let uu___ = FStarC_Syntax_Syntax.is_null_binder b in @@ -2563,7 +2447,7 @@ let (close_forall_no_univs : let (mk_exists_aux : FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> FStarC_Syntax_Syntax.bv -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) = fun fa -> @@ -2580,8 +2464,10 @@ let (mk_exists_aux : let uu___7 = let uu___8 = FStarC_Syntax_Syntax.mk_binder x in [uu___8] in - abs uu___7 body - (FStar_Pervasives_Native.Some (residual_tot ktype0)) in + let uu___8 = + let uu___9 = residual_tot ktype0 in + FStar_Pervasives_Native.Some uu___9 in + abs uu___7 body uu___8 in FStarC_Syntax_Syntax.as_arg uu___6 in [uu___5] in uu___3 :: uu___4 in @@ -2590,7 +2476,7 @@ let (mk_exists_aux : FStarC_Syntax_Syntax.args = uu___2 } in FStarC_Syntax_Syntax.Tm_app uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange let (mk_exists_no_univ : FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ) @@ -2611,7 +2497,7 @@ let (close_exists_no_univs : = fun bs -> fun f -> - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun f1 -> let uu___ = FStarC_Syntax_Syntax.is_null_binder b in @@ -2619,10 +2505,9 @@ let (close_exists_no_univs : then f1 else mk_exists_no_univ b.FStarC_Syntax_Syntax.binder_bv f1) bs f let (if_then_else : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun b -> fun t1 -> @@ -2641,10 +2526,9 @@ let (if_then_else : (uu___, FStar_Pervasives_Native.None, t2) in let uu___ = let uu___1 = - FStarC_Compiler_Range_Ops.union_ranges - t1.FStarC_Syntax_Syntax.pos t2.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_Range_Ops.union_ranges b.FStarC_Syntax_Syntax.pos - uu___1 in + FStarC_Range_Ops.union_ranges t1.FStarC_Syntax_Syntax.pos + t2.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.union_ranges b.FStarC_Syntax_Syntax.pos uu___1 in FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_match { @@ -2655,8 +2539,7 @@ let (if_then_else : }) uu___ let (mk_squash : FStarC_Syntax_Syntax.universe -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun u -> fun p -> @@ -2668,8 +2551,7 @@ let (mk_squash : mk_app uu___ uu___1 let (mk_auto_squash : FStarC_Syntax_Syntax.universe -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun u -> fun p -> @@ -2681,8 +2563,7 @@ let (mk_auto_squash : mk_app uu___ uu___1 let (un_squash : FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax - FStar_Pervasives_Native.option) + FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option) = fun t -> let uu___ = head_and_args t in @@ -2722,7 +2603,7 @@ let (un_squash : let uu___4 = FStarC_Syntax_Free.names p1 in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) b1.FStarC_Syntax_Syntax.binder_bv (Obj.magic uu___4) in @@ -2733,8 +2614,8 @@ let (un_squash : | uu___2 -> FStar_Pervasives_Native.None) let (is_squash : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.universe * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax) FStar_Pervasives_Native.option) + (FStarC_Syntax_Syntax.universe * FStarC_Syntax_Syntax.term) + FStar_Pervasives_Native.option) = fun t -> let uu___ = head_and_args t in @@ -2758,8 +2639,8 @@ let (is_squash : | uu___2 -> FStar_Pervasives_Native.None) let (is_auto_squash : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.universe * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax) FStar_Pervasives_Native.option) + (FStarC_Syntax_Syntax.universe * FStarC_Syntax_Syntax.term) + FStar_Pervasives_Native.option) = fun t -> let uu___ = head_and_args t in @@ -2866,10 +2747,10 @@ let (arrow_one_ln : { FStarC_Syntax_Syntax.bs1 = b::bs; FStarC_Syntax_Syntax.comp = c;_} -> let rng' = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun a -> fun b1 -> - FStarC_Compiler_Range_Ops.union_ranges a + FStarC_Range_Ops.union_ranges a ((b1.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort).FStarC_Syntax_Syntax.pos) c.FStarC_Syntax_Syntax.pos bs in let c' = @@ -2890,7 +2771,7 @@ let (arrow_one : = fun t -> let uu___ = arrow_one_ln t in - FStarC_Compiler_Util.bind_opt uu___ + FStarC_Util.bind_opt uu___ (fun uu___1 -> match uu___1 with | (b, c) -> @@ -2936,12 +2817,12 @@ let (is_free_in : let uu___ = FStarC_Syntax_Free.names t in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) bv + (Obj.magic uu___) let (action_as_lb : FStarC_Ident.lident -> FStarC_Syntax_Syntax.action -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.sigelt) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt) = fun eff_lid -> fun a -> @@ -2982,9 +2863,9 @@ let (action_as_lb : FStarC_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } let (mk_reify : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.term -> FStarC_Ident.lident FStar_Pervasives_Native.option -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term) = fun t -> fun lopt -> @@ -3001,10 +2882,7 @@ let (mk_reify : } in FStarC_Syntax_Syntax.Tm_app uu___1 in FStarC_Syntax_Syntax.mk uu___ t.FStarC_Syntax_Syntax.pos -let (mk_reflect : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = +let (mk_reflect : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> let reflect_ = let uu___ = @@ -3057,10 +2935,10 @@ let (dm4f_lid : (fun s -> Prims.strcat "_dm4f_" (Prims.strcat s (Prims.strcat "_" name))) p in - FStarC_Ident.lid_of_path p' FStarC_Compiler_Range_Type.dummyRange + FStarC_Ident.lid_of_path p' FStarC_Range_Type.dummyRange let (mk_list : FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term Prims.list -> FStarC_Syntax_Syntax.term) = fun typ -> @@ -3088,7 +2966,7 @@ let (mk_list : let uu___ = let uu___1 = let uu___2 = FStarC_Syntax_Syntax.iarg typ in [uu___2] in nil uu___1 rng in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun t -> fun a -> let uu___1 = @@ -3152,8 +3030,7 @@ let eqopt : | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) -> true | uu___ -> false -let (debug_term_eq : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref false +let (debug_term_eq : Prims.bool FStarC_Effect.ref) = FStarC_Util.mk_ref false let (check : Prims.bool -> Prims.string -> Prims.bool -> Prims.bool) = fun dbg -> fun msg -> @@ -3162,7 +3039,7 @@ let (check : Prims.bool -> Prims.string -> Prims.bool -> Prims.bool) = then true else (if dbg - then FStarC_Compiler_Util.print1 ">>> term_eq failing: %s\n" msg + then FStarC_Util.print1 ">>> term_eq failing: %s\n" msg else (); false) let (fail : Prims.bool -> Prims.string -> Prims.bool) = @@ -3538,13 +3415,13 @@ and (aqual_eq_dbg : (a11.FStarC_Syntax_Syntax.aqual_implicit = a21.FStarC_Syntax_Syntax.aqual_implicit) && - ((FStarC_Compiler_List.length + ((FStarC_List.length a11.FStarC_Syntax_Syntax.aqual_attributes) = - (FStarC_Compiler_List.length + (FStarC_List.length a21.FStarC_Syntax_Syntax.aqual_attributes)) then - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun out -> fun t1 -> fun t2 -> @@ -3558,23 +3435,19 @@ and (aqual_eq_dbg : true | uu___ -> false let (eq_aqual : - FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> - FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option -> - Prims.bool) - = fun a1 -> fun a2 -> aqual_eq_dbg false a1 a2 + FStarC_Syntax_Syntax.aqual -> FStarC_Syntax_Syntax.aqual -> Prims.bool) = + fun a1 -> fun a2 -> aqual_eq_dbg false a1 a2 let (eq_bqual : - FStarC_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - FStarC_Syntax_Syntax.binder_qualifier FStar_Pervasives_Native.option -> - Prims.bool) - = fun b1 -> fun b2 -> bqual_eq_dbg false b1 b2 + FStarC_Syntax_Syntax.bqual -> FStarC_Syntax_Syntax.bqual -> Prims.bool) = + fun b1 -> fun b2 -> bqual_eq_dbg false b1 b2 let (term_eq : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> Prims.bool) = fun t1 -> fun t2 -> let r = - let uu___ = FStarC_Compiler_Effect.op_Bang debug_term_eq in + let uu___ = FStarC_Effect.op_Bang debug_term_eq in term_eq_dbg uu___ t1 t2 in - FStarC_Compiler_Effect.op_Colon_Equals debug_term_eq false; r + FStarC_Effect.op_Colon_Equals debug_term_eq false; r let rec (sizeof : FStarC_Syntax_Syntax.term -> Prims.int) = fun t -> match t.FStarC_Syntax_Syntax.n with @@ -3589,14 +3462,14 @@ let rec (sizeof : FStarC_Syntax_Syntax.term -> Prims.int) = let uu___ = sizeof bv.FStarC_Syntax_Syntax.sort in Prims.int_one + uu___ | FStarC_Syntax_Syntax.Tm_uinst (t1, us) -> - let uu___ = sizeof t1 in (FStarC_Compiler_List.length us) + uu___ + let uu___ = sizeof t1 in (FStarC_List.length us) + uu___ | FStarC_Syntax_Syntax.Tm_abs { FStarC_Syntax_Syntax.bs = bs; FStarC_Syntax_Syntax.body = t1; FStarC_Syntax_Syntax.rc_opt = uu___;_} -> let uu___1 = sizeof t1 in let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun b -> let uu___3 = @@ -3609,7 +3482,7 @@ let rec (sizeof : FStarC_Syntax_Syntax.term -> Prims.int) = -> let uu___ = sizeof hd in let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun uu___2 -> match uu___2 with @@ -3631,8 +3504,7 @@ let (is_synth_by_tactic : FStarC_Syntax_Syntax.term -> Prims.bool) = let (has_attribute : FStarC_Syntax_Syntax.attribute Prims.list -> FStarC_Ident.lident -> Prims.bool) - = - fun attrs -> fun attr -> FStarC_Compiler_Util.for_some (is_fvar attr) attrs + = fun attrs -> fun attr -> FStarC_Util.for_some (is_fvar attr) attrs let (get_attribute : FStarC_Ident.lident -> FStarC_Syntax_Syntax.attribute Prims.list -> @@ -3640,7 +3512,7 @@ let (get_attribute : = fun attr -> fun attrs -> - FStarC_Compiler_List.tryPick + FStarC_List.tryPick (fun t -> let uu___ = head_and_args t in match uu___ with @@ -3660,30 +3532,50 @@ let (remove_attr : = fun attr -> fun attrs -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun a -> let uu___ = is_fvar attr a in Prims.op_Negation uu___) attrs let (process_pragma : - FStarC_Syntax_Syntax.pragma -> FStarC_Compiler_Range_Type.range -> unit) = + FStarC_Syntax_Syntax.pragma -> FStarC_Range_Type.range -> unit) = fun p -> fun r -> FStarC_Errors.set_option_warning_callback_range (FStar_Pervasives_Native.Some r); (let set_options s = - let uu___1 = FStarC_Options.set_options s in - match uu___1 with - | FStarC_Getopt.Success -> () - | FStarC_Getopt.Help -> - FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r - FStarC_Errors_Codes.Fatal_FailToProcessPragma () - (Obj.magic FStarC_Errors_Msg.is_error_message_string) - (Obj.magic - "Failed to process pragma: use 'fstar --help' to see which options are available") - | FStarC_Getopt.Error (s1, opt) -> + try + (fun uu___1 -> + match () with + | () -> + let uu___2 = FStarC_Options.set_options s in + (match uu___2 with + | FStarC_Getopt.Success -> () + | FStarC_Getopt.Help -> + FStarC_Errors.raise_error + FStarC_Class_HasRange.hasRange_range r + FStarC_Errors_Codes.Fatal_FailToProcessPragma () + (Obj.magic FStarC_Errors_Msg.is_error_message_string) + (Obj.magic + "Failed to process pragma: use 'fstar --help' to see which options are available") + | FStarC_Getopt.Error (s1, opt) -> + let uu___3 = + let uu___4 = + FStarC_Errors_Msg.text + (Prims.strcat "Failed to process pragma: " s1) in + [uu___4] in + FStarC_Errors.raise_error + FStarC_Class_HasRange.hasRange_range r + FStarC_Errors_Codes.Fatal_FailToProcessPragma () + (Obj.magic + FStarC_Errors_Msg.is_error_message_list_doc) + (Obj.magic uu___3))) () + with + | FStarC_Options.NotSettable x -> let uu___2 = let uu___3 = - FStarC_Errors_Msg.text - (Prims.strcat "Failed to process pragma: " s1) in + let uu___4 = + FStarC_Util.format1 + "Option '%s' is not settable via a pragma." x in + FStarC_Errors_Msg.text uu___4 in [uu___3] in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_FailToProcessPragma () @@ -3716,9 +3608,7 @@ let (process_pragma : else () | FStarC_Syntax_Syntax.PrintEffectsGraph -> ()) let rec (unbound_variables : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.bv Prims.list) - = + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.bv Prims.list) = fun tm -> let t = FStarC_Syntax_Subst.compress tm in match t.FStarC_Syntax_Syntax.n with @@ -3740,26 +3630,26 @@ let rec (unbound_variables : (match uu___1 with | (bs1, t2) -> let uu___2 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun b -> unbound_variables (b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort) bs1 in let uu___3 = unbound_variables t2 in - FStarC_Compiler_List.op_At uu___2 uu___3) + FStarC_List.op_At uu___2 uu___3) | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} -> let uu___ = FStarC_Syntax_Subst.open_comp bs c in (match uu___ with | (bs1, c1) -> let uu___1 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun b -> unbound_variables (b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort) bs1 in let uu___2 = unbound_variables_comp c1 in - FStarC_Compiler_List.op_At uu___1 uu___2) + FStarC_List.op_At uu___1 uu___2) | FStarC_Syntax_Syntax.Tm_refine { FStarC_Syntax_Syntax.b = b; FStarC_Syntax_Syntax.phi = t1;_} -> let uu___ = @@ -3769,22 +3659,21 @@ let rec (unbound_variables : (match uu___ with | (bs, t2) -> let uu___1 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun b1 -> unbound_variables (b1.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort) bs in let uu___2 = unbound_variables t2 in - FStarC_Compiler_List.op_At uu___1 uu___2) + FStarC_List.op_At uu___1 uu___2) | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = t1; FStarC_Syntax_Syntax.args = args;_} -> let uu___ = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___1 -> match uu___1 with | (x, uu___2) -> unbound_variables x) args in - let uu___1 = unbound_variables t1 in - FStarC_Compiler_List.op_At uu___ uu___1 + let uu___1 = unbound_variables t1 in FStarC_List.op_At uu___ uu___1 | FStarC_Syntax_Syntax.Tm_match { FStarC_Syntax_Syntax.scrutinee = t1; FStarC_Syntax_Syntax.ret_opt = asc_opt; @@ -3801,15 +3690,15 @@ let rec (unbound_variables : (match uu___4 with | (bs, asc1) -> let uu___5 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun b1 -> unbound_variables (b1.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort) bs in let uu___6 = unbound_variables_ascription asc1 in - FStarC_Compiler_List.op_At uu___5 uu___6) in + FStarC_List.op_At uu___5 uu___6) in let uu___4 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun br -> let uu___5 = FStarC_Syntax_Subst.open_branch br in match uu___5 with @@ -3820,16 +3709,16 @@ let rec (unbound_variables : | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some t3 -> unbound_variables t3 in - FStarC_Compiler_List.op_At uu___6 uu___7) pats in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___6 uu___7) pats in + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 | FStarC_Syntax_Syntax.Tm_ascribed { FStarC_Syntax_Syntax.tm = t1; FStarC_Syntax_Syntax.asc = asc; FStarC_Syntax_Syntax.eff_opt = uu___;_} -> let uu___1 = unbound_variables t1 in let uu___2 = unbound_variables_ascription asc in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___1 uu___2 | FStarC_Syntax_Syntax.Tm_let { FStarC_Syntax_Syntax.lbs = (false, lb::[]); FStarC_Syntax_Syntax.body1 = t1;_} @@ -3847,8 +3736,8 @@ let rec (unbound_variables : [uu___6] in FStarC_Syntax_Subst.open_term uu___5 t1 in (match uu___4 with | (uu___5, t2) -> unbound_variables t2) in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___ uu___1 | FStarC_Syntax_Syntax.Tm_let { FStarC_Syntax_Syntax.lbs = (uu___, lbs); FStarC_Syntax_Syntax.body1 = t1;_} @@ -3858,14 +3747,14 @@ let rec (unbound_variables : | (lbs1, t2) -> let uu___2 = unbound_variables t2 in let uu___3 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun lb -> let uu___4 = unbound_variables lb.FStarC_Syntax_Syntax.lbtyp in let uu___5 = unbound_variables lb.FStarC_Syntax_Syntax.lbdef in - FStarC_Compiler_List.op_At uu___4 uu___5) lbs1 in - FStarC_Compiler_List.op_At uu___2 uu___3) + FStarC_List.op_At uu___4 uu___5) lbs1 in + FStarC_List.op_At uu___2 uu___3) | FStarC_Syntax_Syntax.Tm_quoted (tm1, qi) -> (match qi.FStarC_Syntax_Syntax.qkind with | FStarC_Syntax_Syntax.Quote_static -> [] @@ -3876,8 +3765,8 @@ let rec (unbound_variables : let uu___1 = match m with | FStarC_Syntax_Syntax.Meta_pattern (uu___2, args) -> - FStarC_Compiler_List.collect - (FStarC_Compiler_List.collect + FStarC_List.collect + (FStarC_List.collect (fun uu___3 -> match uu___3 with | (a, uu___4) -> unbound_variables a)) args @@ -3888,7 +3777,7 @@ let rec (unbound_variables : | FStarC_Syntax_Syntax.Meta_labeled uu___2 -> [] | FStarC_Syntax_Syntax.Meta_desugared uu___2 -> [] | FStarC_Syntax_Syntax.Meta_named uu___2 -> [] in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___ uu___1 and (unbound_variables_ascription : ((FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax, FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax) @@ -3908,7 +3797,7 @@ and (unbound_variables_ascription : match topt with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some tac -> unbound_variables tac in - FStarC_Compiler_List.op_At uu___2 uu___3 + FStarC_List.op_At uu___2 uu___3 and (unbound_variables_comp : FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.bv Prims.list) = fun c -> @@ -3918,11 +3807,11 @@ and (unbound_variables_comp : | FStarC_Syntax_Syntax.Comp ct -> let uu___ = unbound_variables ct.FStarC_Syntax_Syntax.result_typ in let uu___1 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___2 -> match uu___2 with | (a, uu___3) -> unbound_variables a) ct.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_List.op_At uu___ uu___1 + FStarC_List.op_At uu___ uu___1 let (extract_attr' : FStarC_Ident.lid -> FStarC_Syntax_Syntax.term Prims.list -> @@ -3944,7 +3833,7 @@ let (extract_attr' : (match uu___1 with | FStarC_Syntax_Syntax.Tm_fvar fv when FStarC_Syntax_Syntax.fv_eq_lid fv attr_lid -> - let attrs' = FStarC_Compiler_List.rev_acc acc t in + let attrs' = FStarC_List.rev_acc acc t in FStar_Pervasives_Native.Some (attrs', args) | uu___2 -> aux (h :: acc) t)) in aux [] attrs @@ -4027,8 +3916,7 @@ let rec (list_elements : -> let uu___5 = let uu___6 = - let uu___7 = list_elements tl in - FStarC_Compiler_Util.must uu___7 in + let uu___7 = list_elements tl in FStarC_Util.must uu___7 in hd :: uu___6 in FStar_Pervasives_Native.Some uu___5 | uu___2 -> FStar_Pervasives_Native.None) @@ -4106,14 +3994,12 @@ let (destruct_lemma_with_smt_patterns : (match uu___ with | FStar_Pervasives_Native.Some e -> let uu___1 = list_literal_elements e in - FStarC_Compiler_List.map + FStarC_List.map (fun branch1 -> let uu___2 = list_literal_elements branch1 in - FStarC_Compiler_List.map one_pat uu___2) uu___1 - | uu___1 -> - let uu___2 = FStarC_Compiler_List.map one_pat elts in [uu___2]) - | uu___ -> - let uu___1 = FStarC_Compiler_List.map one_pat elts in [uu___1] in + FStarC_List.map one_pat uu___2) uu___1 + | uu___1 -> let uu___2 = FStarC_List.map one_pat elts in [uu___2]) + | uu___ -> let uu___1 = FStarC_List.map one_pat elts in [uu___1] in let uu___ = let uu___1 = FStarC_Syntax_Subst.compress t in uu___1.FStarC_Syntax_Syntax.n in @@ -4147,15 +4033,15 @@ let (triggers_of_smt_lemma : match uu___ with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some (uu___1, uu___2, uu___3, pats) -> - FStarC_Compiler_List.map - (FStarC_Compiler_List.collect + FStarC_List.map + (FStarC_List.collect (fun uu___4 -> match uu___4 with | (t1, uu___5) -> let uu___6 = FStarC_Syntax_Free.fvars t1 in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) (Obj.magic uu___6))) pats let (unthunk : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = @@ -4171,7 +4057,7 @@ let (unthunk : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = let uu___2 = FStarC_Syntax_Subst.open_term [b] e in (match uu___2 with | (bs, e1) -> - let b1 = FStarC_Compiler_List.hd bs in + let b1 = FStarC_List.hd bs in let uu___3 = is_free_in b1.FStarC_Syntax_Syntax.binder_bv e1 in if uu___3 then @@ -4220,7 +4106,7 @@ let (smt_lemma_as_forall : FStarC_Syntax_Syntax.mk uu___1 t.FStarC_Syntax_Syntax.pos in let quant = let uu___1 = universe_of_binders binders in - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun b -> fun u -> fun out -> @@ -4276,14 +4162,11 @@ let (apply_wp_eff_combinators : let uu___4 = f combs.FStarC_Syntax_Syntax.ite_wp in let uu___5 = f combs.FStarC_Syntax_Syntax.close_wp in let uu___6 = f combs.FStarC_Syntax_Syntax.trivial in - let uu___7 = - FStarC_Compiler_Util.map_option f combs.FStarC_Syntax_Syntax.repr in + let uu___7 = FStarC_Util.map_option f combs.FStarC_Syntax_Syntax.repr in let uu___8 = - FStarC_Compiler_Util.map_option f - combs.FStarC_Syntax_Syntax.return_repr in + FStarC_Util.map_option f combs.FStarC_Syntax_Syntax.return_repr in let uu___9 = - FStarC_Compiler_Util.map_option f - combs.FStarC_Syntax_Syntax.bind_repr in + FStarC_Util.map_option f combs.FStarC_Syntax_Syntax.bind_repr in { FStarC_Syntax_Syntax.ret_wp = uu___; FStarC_Syntax_Syntax.bind_wp = uu___1; @@ -4317,8 +4200,7 @@ let (apply_layered_eff_combinators : let uu___3 = map3 combs.FStarC_Syntax_Syntax.l_subcomp in let uu___4 = map3 combs.FStarC_Syntax_Syntax.l_if_then_else in let uu___5 = - FStarC_Compiler_Util.map_option map2 - combs.FStarC_Syntax_Syntax.l_close in + FStarC_Util.map_option map2 combs.FStarC_Syntax_Syntax.l_close in { FStarC_Syntax_Syntax.l_repr = uu___; FStarC_Syntax_Syntax.l_return = uu___1; @@ -4530,8 +4412,7 @@ let (aqual_is_erasable : FStarC_Syntax_Syntax.aqual -> Prims.bool) = match aq with | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some aq1 -> - FStarC_Compiler_Util.for_some - (is_fvar FStarC_Parser_Const.erasable_attr) + FStarC_Util.for_some (is_fvar FStarC_Parser_Const.erasable_attr) aq1.FStarC_Syntax_Syntax.aqual_attributes let (is_erased_head : FStarC_Syntax_Syntax.term -> @@ -4580,15 +4461,15 @@ let (check_mutual_universes : match uu___ with | lb::lbs1 -> let expected = lb.FStarC_Syntax_Syntax.lbunivs in - let expected_len = FStarC_Compiler_List.length expected in - FStarC_Compiler_List.iter + let expected_len = FStarC_List.length expected in + FStarC_List.iter (fun lb1 -> let uu___1 = - ((FStarC_Compiler_List.length lb1.FStarC_Syntax_Syntax.lbunivs) - <> expected_len) + ((FStarC_List.length lb1.FStarC_Syntax_Syntax.lbunivs) <> + expected_len) || (let uu___2 = - FStarC_Compiler_List.forall2 FStarC_Ident.ident_equals + FStarC_List.forall2 FStarC_Ident.ident_equals lb1.FStarC_Syntax_Syntax.lbunivs expected in Prims.op_Negation uu___2) in if uu___1 @@ -4608,9 +4489,7 @@ let (ctx_uvar_should_check : u.FStarC_Syntax_Syntax.ctx_uvar_head in uu___.FStarC_Syntax_Syntax.uvar_decoration_should_check let (ctx_uvar_typ : - FStarC_Syntax_Syntax.ctx_uvar -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = + FStarC_Syntax_Syntax.ctx_uvar -> FStarC_Syntax_Syntax.term) = fun u -> let uu___ = FStarC_Syntax_Unionfind.find_decoration @@ -4625,9 +4504,7 @@ let (ctx_uvar_typedness_deps : u.FStarC_Syntax_Syntax.ctx_uvar_head in uu___.FStarC_Syntax_Syntax.uvar_decoration_typedness_depends_on let (flatten_refinement : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> let rec aux t1 unascribe1 = let t2 = FStarC_Syntax_Subst.compress t1 in @@ -4728,8 +4605,7 @@ let (is_binder_unused : FStarC_Syntax_Syntax.binder -> Prims.bool) = let (deduplicate_terms : FStarC_Syntax_Syntax.term Prims.list -> FStarC_Syntax_Syntax.term Prims.list) - = - fun l -> FStarC_Compiler_List.deduplicate (fun x -> fun y -> term_eq x y) l + = fun l -> FStarC_List.deduplicate (fun x -> fun y -> term_eq x y) l let (eq_binding : FStarC_Syntax_Syntax.binding -> FStarC_Syntax_Syntax.binding -> Prims.bool) = diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_Visit.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Visit.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Syntax_Visit.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_Visit.ml diff --git a/stage0/fstar-lib/generated/FStarC_Syntax_VisitM.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_VisitM.ml similarity index 99% rename from stage0/fstar-lib/generated/FStarC_Syntax_VisitM.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_VisitM.ml index 549d80b24f9..03868b4f63b 100644 --- a/stage0/fstar-lib/generated/FStarC_Syntax_VisitM.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Syntax_VisitM.ml @@ -395,9 +395,8 @@ let rec (compress : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = let tm' = let uu___ = let uu___1 = - FStarC_Compiler_Effect.op_Bang - FStarC_Syntax_Syntax.lazy_chooser in - FStarC_Compiler_Util.must uu___1 in + FStarC_Effect.op_Bang FStarC_Syntax_Syntax.lazy_chooser in + FStarC_Util.must uu___1 in uu___ li.FStarC_Syntax_Syntax.lkind li in compress tm' | uu___ -> tm1 @@ -2181,51 +2180,50 @@ let op_Less_Less_Bar : let tie_bu : 'm . 'm FStarC_Class_Monad.monad -> 'm lvm -> 'm lvm = fun md -> fun d -> - let r = let uu___ = novfs md in FStarC_Compiler_Util.mk_ref uu___ in + let r = let uu___ = novfs md in FStarC_Util.mk_ref uu___ in (let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang r in uu___3.lvm_monad in + let uu___3 = FStarC_Effect.op_Bang r in uu___3.lvm_monad in { lvm_monad = uu___2; f_term = (fun x -> let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang r in + let uu___4 = FStarC_Effect.op_Bang r in on_sub_term uu___4 x in op_Less_Less_Bar md () () (fun uu___4 -> (Obj.magic (f_term d)) uu___4) uu___3); f_binder = (fun x -> let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang r in + let uu___4 = FStarC_Effect.op_Bang r in on_sub_binder uu___4 x in op_Less_Less_Bar md () () (fun uu___4 -> (Obj.magic (f_binder d)) uu___4) uu___3); f_binding_bv = (fun x -> let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang r in + let uu___4 = FStarC_Effect.op_Bang r in on_sub_binding_bv uu___4 x in op_Less_Less_Bar md () () (fun uu___4 -> (Obj.magic (f_binding_bv d)) uu___4) uu___3); f_br = (fun x -> let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang r in - on_sub_br uu___4 x in + let uu___4 = FStarC_Effect.op_Bang r in on_sub_br uu___4 x in op_Less_Less_Bar md () () (fun uu___4 -> (Obj.magic (f_br d)) uu___4) uu___3); f_comp = (fun x -> let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang r in + let uu___4 = FStarC_Effect.op_Bang r in on_sub_comp uu___4 x in op_Less_Less_Bar md () () (fun uu___4 -> (Obj.magic (f_comp d)) uu___4) uu___3); f_residual_comp = (fun x -> let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang r in + let uu___4 = FStarC_Effect.op_Bang r in on_sub_residual_comp uu___4 x in op_Less_Less_Bar md () () (fun uu___4 -> (Obj.magic (f_residual_comp d)) uu___4) @@ -2233,14 +2231,14 @@ let tie_bu : 'm . 'm FStarC_Class_Monad.monad -> 'm lvm -> 'm lvm = f_univ = (fun x -> let uu___3 = - let uu___4 = FStarC_Compiler_Effect.op_Bang r in + let uu___4 = FStarC_Effect.op_Bang r in on_sub_univ uu___4 x in op_Less_Less_Bar md () () (fun uu___4 -> (Obj.magic (f_univ d)) uu___4) uu___3); proc_quotes = (d.proc_quotes) } in - FStarC_Compiler_Effect.op_Colon_Equals r uu___1); - FStarC_Compiler_Effect.op_Bang r + FStarC_Effect.op_Colon_Equals r uu___1); + FStarC_Effect.op_Bang r let visitM_term_univs : 'm . 'm FStarC_Class_Monad.monad -> diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_Common.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Common.ml similarity index 87% rename from stage0/fstar-lib/generated/FStarC_Tactics_Common.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Common.ml index c786f742153..67e77f322c4 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_Common.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Common.ml @@ -4,13 +4,13 @@ let (uu___is_NotAListLiteral : Prims.exn -> Prims.bool) = fun projectee -> match projectee with | NotAListLiteral -> true | uu___ -> false exception TacticFailure of (FStarC_Errors_Msg.error_message * - FStarC_Compiler_Range_Type.range FStar_Pervasives_Native.option) + FStarC_Range_Type.range FStar_Pervasives_Native.option) let (uu___is_TacticFailure : Prims.exn -> Prims.bool) = fun projectee -> match projectee with | TacticFailure uu___ -> true | uu___ -> false let (__proj__TacticFailure__item__uu___ : Prims.exn -> - (FStarC_Errors_Msg.error_message * FStarC_Compiler_Range_Type.range + (FStarC_Errors_Msg.error_message * FStarC_Range_Type.range FStar_Pervasives_Native.option)) = fun projectee -> match projectee with | TacticFailure uu___ -> uu___ exception EExn of FStarC_Syntax_Syntax.term diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_CtrlRewrite.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_CtrlRewrite.ml similarity index 99% rename from stage0/fstar-lib/generated/FStarC_Tactics_CtrlRewrite.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_CtrlRewrite.ml index 75d5911cd5d..7a4afb270aa 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_CtrlRewrite.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_CtrlRewrite.ml @@ -3,8 +3,7 @@ type controller_ty = FStarC_Syntax_Syntax.term -> (Prims.bool * FStarC_Tactics_Types.ctrl_flag) FStarC_Tactics_Monad.tac type rewriter_ty = unit FStarC_Tactics_Monad.tac -let (rangeof : FStarC_Tactics_Types.goal -> FStarC_Compiler_Range_Type.range) - = +let (rangeof : FStarC_Tactics_Types.goal -> FStarC_Range_Type.range) = fun g -> (g.FStarC_Tactics_Types.goal_ctx_uvar).FStarC_Syntax_Syntax.ctx_uvar_range let (__do_rewrite : @@ -198,7 +197,7 @@ let (__do_rewrite : (FStarC_Errors_Codes.Error_LayeredMissingAnnot, uu___2, uu___3, uu___4) -> FStar_Pervasives_Native.None - | e -> FStarC_Compiler_Effect.raise e in + | e -> FStarC_Effect.raise e in match res with | FStar_Pervasives_Native.None -> Obj.magic @@ -225,9 +224,7 @@ let (__do_rewrite : lcomp.FStarC_TypeChecker_Common.res_typ in let typ1 = let uu___4 = - let uu___5 = - FStarC_Options_Ext.get "__unrefine" in - uu___5 <> "" in + FStarC_Options_Ext.enabled "__unrefine" in if uu___4 then let typ_norm = @@ -288,7 +285,7 @@ let (__do_rewrite : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ut in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "do_rewrite: making equality\n\t%s ==\n\t%s\n" uu___8 uu___9) in Obj.magic @@ -360,7 +357,7 @@ let (__do_rewrite : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ut1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "rewrite_rec: succeeded rewriting\n\t%s to\n\t%s\n" uu___14 uu___15) in @@ -824,7 +821,7 @@ and (on_subterms : k_flag) -> let bs1 = - FStarC_Compiler_List.rev + FStarC_List.rev accum_binders in let subst = @@ -837,7 +834,7 @@ and (on_subterms : FStarC_Syntax_Subst.subst subst t2 in let k2 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (FStarC_Syntax_Subst.subst_residual_comp subst) k1 in let uu___5 @@ -1011,7 +1008,7 @@ and (on_subterms : match uu___1 with | (bs_orig, t1, subst) -> let k1 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (FStarC_Syntax_Subst.subst_residual_comp subst) k in descend_binders tm1 [] [] @@ -1604,7 +1601,7 @@ let (ctrl_rewrite : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term gt in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "ctrl_rewrite starting with %s\n" uu___5) in Obj.magic @@ -1635,7 +1632,7 @@ let (ctrl_rewrite : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term gt' in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "ctrl_rewrite seems to have succeded with %s\n" uu___8) in Obj.magic diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_Embedding.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Embedding.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_Tactics_Embedding.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Embedding.ml index 44fcd04b21e..7f9efec6f37 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_Embedding.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Embedding.ml @@ -44,8 +44,8 @@ let (fstar_tactics_const : Prims.string Prims.list -> tac_constant) = let (fstar_tc_core_lid : Prims.string -> FStarC_Ident.lid) = fun s -> FStarC_Ident.lid_of_path - (FStarC_Compiler_List.op_At ["FStar"; "Stubs"; "TypeChecker"; "Core"] - [s]) FStarC_Compiler_Range_Type.dummyRange + (FStarC_List.op_At ["FStar"; "Stubs"; "TypeChecker"; "Core"] [s]) + FStarC_Range_Type.dummyRange let (fstar_tc_core_data : Prims.string -> tac_constant) = fun s -> let lid = fstar_tc_core_lid s in @@ -65,6 +65,8 @@ let (fstar_tactics_TacticFailure : tac_constant) = fstar_tactics_data ["Common"; "TacticFailure"] let (fstar_tactics_SKIP : tac_constant) = fstar_tactics_data ["Common"; "SKIP"] +let (fstar_tactics_Stop : tac_constant) = + fstar_tactics_data ["Common"; "Stop"] let (fstar_tactics_result : tac_constant) = fstar_tactics_const ["Result"; "__result"] let (fstar_tactics_Success : tac_constant) = @@ -114,7 +116,7 @@ let (fstar_tactics_Force : tac_constant) = fstar_tactics_data ["Types"; "Force"] let mk_emb : 'a . - (FStarC_Compiler_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term) -> + (FStarC_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term) -> (FStarC_Syntax_Syntax.term -> 'a FStar_Pervasives_Native.option) -> FStarC_Syntax_Syntax.term -> 'a FStarC_Syntax_Embeddings_Base.embedding @@ -129,7 +131,7 @@ let mk_emb : let embed : 'a . 'a FStarC_Syntax_Embeddings_Base.embedding -> - FStarC_Compiler_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term + FStarC_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term = fun uu___ -> fun r -> @@ -146,18 +148,13 @@ let unembed' : fun x -> FStarC_Syntax_Embeddings_Base.unembed uu___ x FStarC_Syntax_Embeddings_Base.id_norm_cb -let (t_result_of : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = +let (t_result_of : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> let uu___ = let uu___1 = FStarC_Syntax_Syntax.as_arg t in [uu___1] in FStarC_Syntax_Util.mk_app fstar_tactics_result.t uu___ let (hd'_and_args : FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.term' * (FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax * FStarC_Syntax_Syntax.arg_qualifier - FStar_Pervasives_Native.option) Prims.list)) + (FStarC_Syntax_Syntax.term' * FStarC_Syntax_Syntax.args)) = fun tm -> let tm1 = FStarC_Syntax_Util.unascribe tm in @@ -191,8 +188,8 @@ let (mkFV : fun fv -> fun us -> fun ts -> - FStarC_TypeChecker_NBETerm.mkFV fv (FStarC_Compiler_List.rev us) - (FStarC_Compiler_List.rev ts) + FStarC_TypeChecker_NBETerm.mkFV fv (FStarC_List.rev us) + (FStarC_List.rev ts) let (mkConstruct : FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.universe Prims.list -> @@ -202,8 +199,8 @@ let (mkConstruct : fun fv -> fun us -> fun ts -> - FStarC_TypeChecker_NBETerm.mkConstruct fv - (FStarC_Compiler_List.rev us) (FStarC_Compiler_List.rev ts) + FStarC_TypeChecker_NBETerm.mkConstruct fv (FStarC_List.rev us) + (FStarC_List.rev ts) let (fv_as_emb_typ : FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.emb_typ) = fun fv -> @@ -222,7 +219,7 @@ let (e_proofstate_nbe : FStarC_Syntax_Syntax.blob = uu___; FStarC_Syntax_Syntax.lkind = FStarC_Syntax_Syntax.Lazy_proofstate; FStarC_Syntax_Syntax.ltyp = (fstar_tactics_proofstate.t); - FStarC_Syntax_Syntax.rng = FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.rng = FStarC_Range_Type.dummyRange } in let thunk = FStarC_Thunk.mk @@ -230,8 +227,7 @@ let (e_proofstate_nbe : FStarC_TypeChecker_NBETerm.mk_t (FStarC_TypeChecker_NBETerm.Constant (FStarC_TypeChecker_NBETerm.String - ("(((proofstate.nbe)))", - FStarC_Compiler_Range_Type.dummyRange)))) in + ("(((proofstate.nbe)))", FStarC_Range_Type.dummyRange)))) in FStarC_TypeChecker_NBETerm.mk_t (FStarC_TypeChecker_NBETerm.Lazy ((FStar_Pervasives.Inl li), thunk)) in let unembed_proofstate _cb t = @@ -248,14 +244,13 @@ let (e_proofstate_nbe : let uu___4 = FStarC_Dyn.undyn b in FStar_Pervasives_Native.Some uu___4 | uu___1 -> - ((let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + ((let uu___3 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___3 then let uu___4 = let uu___5 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 - "Not an embedded NBE proofstate: %s\n" uu___5 in + FStarC_Util.format1 "Not an embedded NBE proofstate: %s\n" + uu___5 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4) @@ -278,7 +273,7 @@ let (e_goal_nbe : FStarC_Syntax_Syntax.blob = uu___; FStarC_Syntax_Syntax.lkind = FStarC_Syntax_Syntax.Lazy_goal; FStarC_Syntax_Syntax.ltyp = (fstar_tactics_goal.t); - FStarC_Syntax_Syntax.rng = FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.rng = FStarC_Range_Type.dummyRange } in let thunk = FStarC_Thunk.mk @@ -286,7 +281,7 @@ let (e_goal_nbe : FStarC_TypeChecker_NBETerm.mk_t (FStarC_TypeChecker_NBETerm.Constant (FStarC_TypeChecker_NBETerm.String - ("(((goal.nbe)))", FStarC_Compiler_Range_Type.dummyRange)))) in + ("(((goal.nbe)))", FStarC_Range_Type.dummyRange)))) in FStarC_TypeChecker_NBETerm.mk_t (FStarC_TypeChecker_NBETerm.Lazy ((FStar_Pervasives.Inl li), thunk)) in let unembed_goal _cb t = @@ -303,14 +298,12 @@ let (e_goal_nbe : let uu___4 = FStarC_Dyn.undyn b in FStar_Pervasives_Native.Some uu___4 | uu___1 -> - ((let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + ((let uu___3 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___3 then let uu___4 = let uu___5 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded NBE goal: %s" - uu___5 in + FStarC_Util.format1 "Not an embedded NBE goal: %s" uu___5 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4) @@ -350,6 +343,15 @@ let (e_exn : Prims.exn FStarC_Syntax_Embeddings_Base.embedding) = FStarC_Syntax_Syntax.hash_code = (uu___2.FStarC_Syntax_Syntax.hash_code) } + | FStarC_Errors.Stop -> + let uu___2 = fstar_tactics_Stop.t in + { + FStarC_Syntax_Syntax.n = (uu___2.FStarC_Syntax_Syntax.n); + FStarC_Syntax_Syntax.pos = rng; + FStarC_Syntax_Syntax.vars = (uu___2.FStarC_Syntax_Syntax.vars); + FStarC_Syntax_Syntax.hash_code = + (uu___2.FStarC_Syntax_Syntax.hash_code) + } | FStarC_Tactics_Common.EExn t -> { FStarC_Syntax_Syntax.n = (t.FStarC_Syntax_Syntax.n); @@ -362,7 +364,7 @@ let (e_exn : Prims.exn FStarC_Syntax_Embeddings_Base.embedding) = let uu___2 = FStarC_Errors_Msg.text "Uncaught exception" in let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_Util.message_of_exn e1 in + let uu___5 = FStarC_Util.message_of_exn e1 in FStarC_Pprint.arbitrary_string uu___5 in [uu___4] in uu___2 :: uu___3 in @@ -392,13 +394,16 @@ let (e_exn : Prims.exn FStarC_Syntax_Embeddings_Base.embedding) = FStarC_Syntax_Embeddings.e_document) (FStarC_Syntax_Embeddings.e_option FStarC_Syntax_Embeddings.e_range)) s in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun s1 -> FStar_Pervasives_Native.Some (FStarC_Tactics_Common.TacticFailure s1)) | (FStarC_Syntax_Syntax.Tm_fvar fv, []) when FStarC_Syntax_Syntax.fv_eq_lid fv fstar_tactics_SKIP.lid -> FStar_Pervasives_Native.Some FStarC_Tactics_Common.SKIP + | (FStarC_Syntax_Syntax.Tm_fvar fv, []) when + FStarC_Syntax_Syntax.fv_eq_lid fv fstar_tactics_Stop.lid -> + FStar_Pervasives_Native.Some FStarC_Errors.Stop | uu___2 -> FStar_Pervasives_Native.Some (FStarC_Tactics_Common.EExn t) in FStarC_Syntax_Embeddings_Base.mk_emb_full embed_exn unembed_exn (fun uu___ -> FStarC_Syntax_Syntax.t_exn) (fun uu___ -> "(exn)") @@ -428,8 +433,8 @@ let (e_exn_nbe : Prims.exn FStarC_TypeChecker_NBETerm.embedding) = | FStarC_Tactics_Common.SKIP -> mkConstruct fstar_tactics_SKIP.fv [] [] | uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_Util.message_of_exn e in - FStarC_Compiler_Util.format1 "cannot embed exn (NBE) : %s" uu___2 in + let uu___2 = FStarC_Util.message_of_exn e in + FStarC_Util.format1 "cannot embed exn (NBE) : %s" uu___2 in failwith uu___1 in let unembed_exn cb t = let uu___ = FStarC_TypeChecker_NBETerm.nbe_t_of_t t in @@ -443,7 +448,7 @@ let (e_exn_nbe : Prims.exn FStarC_TypeChecker_NBETerm.embedding) = FStarC_TypeChecker_NBETerm.e_document) (FStarC_TypeChecker_NBETerm.e_option FStarC_TypeChecker_NBETerm.e_range)) cb s in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun s1 -> FStar_Pervasives_Native.Some (FStarC_Tactics_Common.TacticFailure s1)) @@ -513,20 +518,20 @@ let e_result : | (FStarC_Syntax_Syntax.Tm_fvar fv, _t::(a1, uu___2)::(ps, uu___3)::[]) when FStarC_Syntax_Syntax.fv_eq_lid fv fstar_tactics_Success.lid -> let uu___4 = unembed' ea a1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a2 -> let uu___5 = unembed' e_proofstate ps in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ps1 -> FStar_Pervasives_Native.Some (FStarC_Tactics_Result.Success (a2, ps1)))) | (FStarC_Syntax_Syntax.Tm_fvar fv, _t::(e, uu___2)::(ps, uu___3)::[]) when FStarC_Syntax_Syntax.fv_eq_lid fv fstar_tactics_Failed.lid -> let uu___4 = unembed' e_exn e in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun e1 -> let uu___5 = unembed' e_proofstate ps in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ps1 -> FStar_Pervasives_Native.Some (FStarC_Tactics_Result.Failed (e1, ps1)))) @@ -598,11 +603,11 @@ let e_result_nbe : (fv, uu___1, (ps, uu___2)::(a1, uu___3)::_t::[]) when FStarC_Syntax_Syntax.fv_eq_lid fv fstar_tactics_Success.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed ea cb a1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a2 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_proofstate_nbe cb ps in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ps1 -> FStar_Pervasives_Native.Some (FStarC_Tactics_Result.Success (a2, ps1)))) @@ -610,11 +615,11 @@ let e_result_nbe : (fv, uu___1, (ps, uu___2)::(e, uu___3)::_t::[]) when FStarC_Syntax_Syntax.fv_eq_lid fv fstar_tactics_Failed.lid -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e_exn_nbe cb e in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun e1 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e_proofstate_nbe cb ps in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ps1 -> FStar_Pervasives_Native.Some (FStarC_Tactics_Result.Failed (e1, ps1)))) @@ -664,14 +669,12 @@ let (e_direction_nbe : FStarC_Syntax_Syntax.fv_eq_lid fv fstar_tactics_bottomup.lid -> FStar_Pervasives_Native.Some FStarC_Tactics_Types.BottomUp | uu___1 -> - ((let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + ((let uu___3 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___3 then let uu___4 = let uu___5 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded direction: %s" - uu___5 in + FStarC_Util.format1 "Not an embedded direction: %s" uu___5 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4) @@ -729,14 +732,12 @@ let (e_ctrl_flag_nbe : FStarC_Syntax_Syntax.fv_eq_lid fv fstar_tactics_Abort.lid -> FStar_Pervasives_Native.Some FStarC_Tactics_Types.Abort | uu___1 -> - ((let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + ((let uu___3 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___3 then let uu___4 = let uu___5 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded ctrl_flag: %s" - uu___5 in + FStarC_Util.format1 "Not an embedded ctrl_flag: %s" uu___5 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4) @@ -807,14 +808,12 @@ let (e_unfold_side_nbe : fstar_tc_core_unfold_side_Neither.lid -> FStar_Pervasives_Native.Some FStarC_TypeChecker_Core.Neither | uu___1 -> - ((let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + ((let uu___3 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___3 then let uu___4 = let uu___5 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded unfold_side: %s" - uu___5 in + FStarC_Util.format1 "Not an embedded unfold_side: %s" uu___5 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4) @@ -872,14 +871,12 @@ let (e_tot_or_ghost_nbe : fstar_tc_core_tot_or_ghost_EGhost.lid -> FStar_Pervasives_Native.Some FStarC_TypeChecker_Core.E_Ghost | uu___1 -> - ((let uu___3 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + ((let uu___3 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___3 then let uu___4 = let uu___5 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded tot_or_ghost: %s" - uu___5 in + FStarC_Util.format1 "Not an embedded tot_or_ghost: %s" uu___5 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4) @@ -904,8 +901,7 @@ let (t_tref : FStarC_Syntax_Syntax.term) = let uu___1 = let uu___2 = FStarC_Syntax_Syntax.iarg FStarC_Syntax_Syntax.t_term in [uu___2] in - FStarC_Syntax_Syntax.mk_Tm_app uu___ uu___1 - FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk_Tm_app uu___ uu___1 FStarC_Range_Type.dummyRange let e_tref : 'a . unit -> @@ -949,7 +945,7 @@ let e_tref_nbe : FStarC_Syntax_Syntax.blob = uu___1; FStarC_Syntax_Syntax.lkind = FStarC_Syntax_Syntax.Lazy_tref; FStarC_Syntax_Syntax.ltyp = t_tref; - FStarC_Syntax_Syntax.rng = FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.rng = FStarC_Range_Type.dummyRange } in let thunk = FStarC_Thunk.mk @@ -957,8 +953,7 @@ let e_tref_nbe : FStarC_TypeChecker_NBETerm.mk_t (FStarC_TypeChecker_NBETerm.Constant (FStarC_TypeChecker_NBETerm.String - ("(((tref.nbe)))", - FStarC_Compiler_Range_Type.dummyRange)))) in + ("(((tref.nbe)))", FStarC_Range_Type.dummyRange)))) in FStarC_TypeChecker_NBETerm.mk_t (FStarC_TypeChecker_NBETerm.Lazy ((FStar_Pervasives.Inl li), thunk)) in let unembed_tref _cb t = @@ -975,14 +970,12 @@ let e_tref_nbe : let uu___5 = FStarC_Dyn.undyn b in FStar_Pervasives_Native.Some uu___5 | uu___2 -> - ((let uu___4 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + ((let uu___4 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___4 then let uu___5 = let uu___6 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.format1 "Not an embedded NBE tref: %s\n" - uu___6 in + FStarC_Util.format1 "Not an embedded NBE tref: %s\n" uu___6 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_Hooks.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Hooks.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Tactics_Hooks.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Hooks.ml index 266149b4852..1511d2e7bc6 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_Hooks.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Hooks.ml @@ -1,11 +1,10 @@ open Prims -let (dbg_Tac : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Tac" -let (dbg_SpinoffAll : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SpinoffAll" +let (dbg_Tac : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Tac" +let (dbg_SpinoffAll : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SpinoffAll" let (run_tactic_on_typ : - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> @@ -18,9 +17,9 @@ let (run_tactic_on_typ : fun env -> fun typ -> let rng = - let uu___ = FStarC_Compiler_Range_Type.use_range rng_tac in - let uu___1 = FStarC_Compiler_Range_Type.use_range rng_goal in - FStarC_Compiler_Range_Type.range_of_rng uu___ uu___1 in + let uu___ = FStarC_Range_Type.use_range rng_tac in + let uu___1 = FStarC_Range_Type.use_range rng_goal in + FStarC_Range_Type.range_of_rng uu___ uu___1 in let uu___ = FStarC_Tactics_V2_Basic.proofstate_of_goal_ty rng env typ in match uu___ with @@ -33,8 +32,8 @@ let (run_tactic_on_typ : tactic_already_typed ps in (match uu___1 with | (gs, _res) -> (gs, w)) let (run_tactic_on_all_implicits : - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> FStarC_TypeChecker_Env.env -> FStarC_TypeChecker_Env.implicits -> @@ -263,8 +262,7 @@ let comb2 : Simplified uu___ | (Simplified (t1, gs1), Simplified (t2, gs2)) -> let uu___ = - let uu___1 = f t1 t2 in - (uu___1, (FStarC_Compiler_List.op_At gs1 gs2)) in + let uu___1 = f t1 t2 in (uu___1, (FStarC_List.op_At gs1 gs2)) in Simplified uu___ | uu___ -> let uu___1 = explode x in @@ -276,8 +274,7 @@ let comb2 : let uu___3 = let uu___4 = f n1 n2 in let uu___5 = f p1 p2 in - (uu___4, uu___5, - (FStarC_Compiler_List.op_At gs1 gs2)) in + (uu___4, uu___5, (FStarC_List.op_At gs1 gs2)) in Dual uu___3)) let comb_list : 'a . 'a tres_m Prims.list -> 'a Prims.list tres_m = fun rs -> @@ -286,7 +283,7 @@ let comb_list : 'a . 'a tres_m Prims.list -> 'a Prims.list tres_m = | [] -> acc | hd::tl -> let uu___ = comb2 (fun l -> fun r -> l :: r) hd acc in aux tl uu___ in - aux (FStarC_Compiler_List.rev rs) (tpure []) + aux (FStarC_List.rev rs) (tpure []) let emit : 'a . FStarC_Tactics_Types.goal Prims.list -> 'a tres_m -> 'a tres_m = fun gs -> fun m -> comb2 (fun uu___ -> fun x -> x) (Simplified ((), gs)) m @@ -390,14 +387,14 @@ let rec (traverse : FStarC_Syntax_Util.mk_conj uu___9 uu___10 in Simplified ((t1.FStarC_Syntax_Syntax.n), - (FStarC_Compiler_List.op_At gs1 gs2))))) + (FStarC_List.op_At gs1 gs2))))) | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = hd; FStarC_Syntax_Syntax.args = args;_} -> let r0 = traverse f pol1 e hd in let r1 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___1 -> fun r2 -> match uu___1 with @@ -423,7 +420,7 @@ let rec (traverse : | (bs1, topen) -> let e' = FStarC_TypeChecker_Env.push_binders e bs1 in let r0 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let r1 = traverse f (flip pol1) e @@ -482,7 +479,7 @@ let rec (traverse : let uu___1 = traverse f pol1 e sc in let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun br -> let uu___4 = FStarC_Syntax_Subst.open_branch br in match uu___4 with @@ -551,7 +548,7 @@ let rec (traverse : (t.FStarC_Syntax_Syntax.vars); FStarC_Syntax_Syntax.hash_code = (t.FStarC_Syntax_Syntax.hash_code) - }, p', (FStarC_Compiler_List.op_At gs gs'))) + }, p', (FStarC_List.op_At gs gs'))) let (preprocess : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> @@ -562,7 +559,7 @@ let (preprocess : fun goal -> FStarC_Errors.with_ctx "While preprocessing VC with a tactic" (fun uu___ -> - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Tac in + (let uu___2 = FStarC_Effect.op_Bang dbg_Tac in if uu___2 then let uu___3 = @@ -572,8 +569,8 @@ let (preprocess : FStarC_Syntax_Print.showable_binder) uu___4 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term goal in - FStarC_Compiler_Util.print2 "About to preprocess %s |= %s\n" - uu___3 uu___4 + FStarC_Util.print2 "About to preprocess %s |= %s\n" uu___3 + uu___4 else ()); (let initial = (Prims.int_one, []) in let uu___2 = @@ -585,7 +582,7 @@ let (preprocess : failwith "preprocess: impossible, traverse returned a Dual" in match uu___2 with | (did_anything, (t', gs)) -> - ((let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Tac in + ((let uu___4 = FStarC_Effect.op_Bang dbg_Tac in if uu___4 then let uu___5 = @@ -596,12 +593,12 @@ let (preprocess : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t' in - FStarC_Compiler_Util.print2 - "Main goal simplified to: %s |- %s\n" uu___5 uu___6 + FStarC_Util.print2 "Main goal simplified to: %s |- %s\n" + uu___5 uu___6 else ()); (let s = initial in let s1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun g -> match uu___4 with @@ -622,7 +619,7 @@ let (preprocess : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___8 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Tactic returned proof-relevant goal: %s" uu___7 in FStarC_Errors.raise_error @@ -634,8 +631,7 @@ let (preprocess : FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___6) | FStar_Pervasives_Native.Some phi1 -> phi1 in - ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Tac in if uu___6 then let uu___7 = @@ -647,8 +643,8 @@ let (preprocess : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___9 in - FStarC_Compiler_Util.print2 - "Got goal #%s: %s\n" uu___7 uu___8 + FStarC_Util.print2 "Got goal #%s: %s\n" + uu___7 uu___8 else ()); (let label = let uu___6 = @@ -695,7 +691,7 @@ let (preprocess : let uu___4 = s1 in match uu___4 with | (uu___5, gs1) -> - let gs2 = FStarC_Compiler_List.rev gs1 in + let gs2 = FStarC_List.rev gs1 in let uu___6 = let uu___7 = let uu___8 = FStarC_Options.peek () in @@ -704,7 +700,7 @@ let (preprocess : (did_anything, uu___6))))) let rec (traverse_for_spinoff : pol -> - (FStarC_Pprint.document Prims.list * FStarC_Compiler_Range_Type.range) + (FStarC_Pprint.document Prims.list * FStarC_Range_Type.range) FStar_Pervasives_Native.option -> FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> tres) = @@ -712,21 +708,18 @@ let rec (traverse_for_spinoff : fun label_ctx -> fun e -> fun t -> - let debug_any = FStarC_Compiler_Debug.any () in + let debug_any = FStarC_Debug.any () in let traverse1 pol2 e1 t1 = traverse_for_spinoff pol2 label_ctx e1 t1 in let traverse_ctx pol2 ctx e1 t1 = let print_lc uu___ = match uu___ with | (msg, rng) -> - let uu___1 = - FStarC_Compiler_Range_Ops.string_of_def_range rng in - let uu___2 = - FStarC_Compiler_Range_Ops.string_of_use_range rng in + let uu___1 = FStarC_Range_Ops.string_of_def_range rng in + let uu___2 = FStarC_Range_Ops.string_of_use_range rng in let uu___3 = FStarC_Errors_Msg.rendermsg msg in - FStarC_Compiler_Util.format3 "(%s,%s) : %s" uu___1 uu___2 - uu___3 in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_SpinoffAll in + FStarC_Util.format3 "(%s,%s) : %s" uu___1 uu___2 uu___3 in + (let uu___1 = FStarC_Effect.op_Bang dbg_SpinoffAll in if uu___1 then let uu___2 = @@ -734,8 +727,8 @@ let rec (traverse_for_spinoff : | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some lc -> print_lc lc in let uu___3 = print_lc ctx in - FStarC_Compiler_Util.print2 - "Changing label context from %s to %s" uu___2 uu___3 + FStarC_Util.print2 "Changing label context from %s to %s" + uu___2 uu___3 else ()); traverse_for_spinoff pol2 (FStar_Pervasives_Native.Some ctx) e1 t1 in @@ -799,14 +792,13 @@ let rec (traverse_for_spinoff : let spinoff t2 = match pol2 with | StrictlyPositive -> - ((let uu___1 = - FStarC_Compiler_Effect.op_Bang dbg_SpinoffAll in + ((let uu___1 = FStarC_Effect.op_Bang dbg_SpinoffAll in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print1 "Spinning off %s\n" uu___2 + FStarC_Util.print1 "Spinning off %s\n" uu___2 else ()); (let uu___1 = let uu___2 = @@ -980,21 +972,21 @@ let rec (traverse_for_spinoff : FStar_Pervasives_Native.Some (e2, (lc.FStarC_TypeChecker_Common.res_typ), u))) in let bv_universes env1 bvs = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___ = FStarC_TypeChecker_TcTerm.universe_of env1 x.FStarC_Syntax_Syntax.sort in (x, uu___)) bvs in let mk_forall_l bv_univs term = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___ -> fun out -> match uu___ with | (x, u) -> FStarC_Syntax_Util.mk_forall u x out) bv_univs term in let mk_exists_l bv_univs term = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___ -> fun out -> match uu___ with @@ -1078,7 +1070,7 @@ let rec (traverse_for_spinoff : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Failed to split match term because %s (%s)" msg uu___5 in FStarC_Errors.diag @@ -1099,7 +1091,7 @@ let rec (traverse_for_spinoff : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term res1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Rewrote match term\n%s\ninto %s\n" uu___5 uu___6 in FStarC_Errors.diag @@ -1253,7 +1245,7 @@ let rec (traverse_for_spinoff : | uu___5 -> let r0 = traverse1 pol1 e hd in let r1 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___6 -> fun r2 -> match uu___6 with @@ -1289,11 +1281,11 @@ let rec (traverse_for_spinoff : FStarC_TypeChecker_TermEqAndSimplify.Equal) -> ((let uu___9 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_SpinoffAll in if uu___9 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "Simplified squash True to True" else ()); FStarC_Syntax_Util.t_true.FStarC_Syntax_Syntax.n) @@ -1317,7 +1309,7 @@ let rec (traverse_for_spinoff : let e' = FStarC_TypeChecker_Env.push_binders e bs1 in let r0 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let r1 = traverse1 (flip pol1) e @@ -1407,7 +1399,7 @@ let rec (traverse_for_spinoff : (t.FStarC_Syntax_Syntax.vars); FStarC_Syntax_Syntax.hash_code = (t.FStarC_Syntax_Syntax.hash_code) - }, p', (FStarC_Compiler_List.op_At gs gs')))) + }, p', (FStarC_List.op_At gs gs')))) let (pol_to_string : pol -> Prims.string) = fun uu___ -> match uu___ with @@ -1422,12 +1414,12 @@ let (spinoff_strictly_positive_goals : = fun env -> fun goal -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_SpinoffAll in + (let uu___1 = FStarC_Effect.op_Bang dbg_SpinoffAll in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term goal in - FStarC_Compiler_Util.print1 "spinoff_all called with %s\n" uu___2 + FStarC_Util.print1 "spinoff_all called with %s\n" uu___2 else ()); FStarC_Errors.with_ctx "While spinning off all goals" (fun uu___1 -> @@ -1453,8 +1445,7 @@ let (spinoff_strictly_positive_goals : match t with | FStarC_TypeChecker_Common.Trivial -> [] | FStarC_TypeChecker_Common.NonTrivial t1 -> - ((let uu___4 = - FStarC_Compiler_Effect.op_Bang dbg_SpinoffAll in + ((let uu___4 = FStarC_Effect.op_Bang dbg_SpinoffAll in if uu___4 then let msg = @@ -1467,12 +1458,12 @@ let (spinoff_strictly_positive_goals : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Main goal simplified to: %s |- %s\n" uu___5 uu___6 in let uu___5 = FStarC_TypeChecker_Env.get_range env in let uu___6 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Verification condition was to be split into several atomic sub-goals, but this query had some sub-goals that couldn't be split---the error report, if any, may be inaccurate.\n%s\n" msg in FStarC_Errors.diag @@ -1484,7 +1475,7 @@ let (spinoff_strictly_positive_goals : [(env, t1)]) in let s = initial in let s1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun g -> match uu___3 with @@ -1499,9 +1490,9 @@ let (spinoff_strictly_positive_goals : let uu___3 = s1 in (match uu___3 with | (uu___4, gs1) -> - let gs2 = FStarC_Compiler_List.rev gs1 in + let gs2 = FStarC_List.rev gs1 in let gs3 = - FStarC_Compiler_List.filter_map + FStarC_List.filter_map (fun uu___5 -> match uu___5 with | (env1, t) -> @@ -1517,16 +1508,15 @@ let (spinoff_strictly_positive_goals : FStar_Pervasives_Native.None | FStarC_TypeChecker_Common.NonTrivial t2 -> ((let uu___8 = - FStarC_Compiler_Effect.op_Bang - dbg_SpinoffAll in + FStarC_Effect.op_Bang dbg_SpinoffAll in if uu___8 then let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print1 - "Got goal: %s\n" uu___9 + FStarC_Util.print1 "Got goal: %s\n" + uu___9 else ()); FStar_Pervasives_Native.Some (env1, t2)))) gs2 in @@ -1535,14 +1525,14 @@ let (spinoff_strictly_positive_goals : let uu___8 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length gs3) in - FStarC_Compiler_Util.format1 - "Split query into %s sub-goals" uu___8 in + (FStarC_List.length gs3) in + FStarC_Util.format1 "Split query into %s sub-goals" + uu___8 in FStarC_Errors.diag FStarC_Class_HasRange.hasRange_range uu___6 () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___7)); - FStarC_Compiler_List.op_At main_goal gs3))) + FStarC_List.op_At main_goal gs3))) let (synthesize : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.typ -> @@ -1570,7 +1560,7 @@ let (synthesize : typ.FStarC_Syntax_Syntax.pos tau env typ in match uu___2 with | (gs, w) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun g -> let uu___4 = let uu___5 = FStarC_Tactics_Types.goal_env g in @@ -1578,14 +1568,13 @@ let (synthesize : getprop uu___5 uu___6 in match uu___4 with | FStar_Pervasives_Native.Some vc -> - ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Tac in if uu___6 then let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term vc in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Synthesis left a goal: %s\n" uu___7 else ()); (let guard = @@ -1627,14 +1616,14 @@ let (solve_implicits : then let uu___4 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length gs) in - FStarC_Compiler_Util.print1 - "solve_implicits produced %s goals\n" uu___4 + (FStarC_List.length gs) in + FStarC_Util.print1 "solve_implicits produced %s goals\n" + uu___4 else ()); FStarC_Options.with_saved_options (fun uu___3 -> let uu___4 = FStarC_Options.set_options "--no_tactics" in - FStarC_Compiler_List.iter + FStarC_List.iter (fun g -> (let uu___6 = FStarC_Tactics_Types.goal_opts g in FStarC_Options.set uu___6); @@ -1644,14 +1633,13 @@ let (solve_implicits : getprop uu___7 uu___8 in match uu___6 with | FStar_Pervasives_Native.Some vc -> - ((let uu___8 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + ((let uu___8 = FStarC_Effect.op_Bang dbg_Tac in if uu___8 then let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term vc in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Synthesis left a goal: %s\n" uu___9 else ()); if @@ -1689,7 +1677,7 @@ let (find_user_tac_for_attr : let hooks = FStarC_TypeChecker_Env.lookup_attr env FStarC_Parser_Const.handle_smt_goals_attr_string in - FStarC_Compiler_Util.try_find (fun uu___ -> true) hooks + FStarC_Util.try_find (fun uu___ -> true) hooks let (handle_smt_goal : FStarC_TypeChecker_Env.env -> FStarC_TypeChecker_Env.goal -> @@ -1736,7 +1724,7 @@ let (handle_smt_goal : tau env uu___5 in match uu___3 with | (gs1, uu___4) -> - FStarC_Compiler_List.map + FStarC_List.map (fun g -> let uu___5 = let uu___6 = FStarC_Tactics_Types.goal_env g in @@ -1746,14 +1734,14 @@ let (handle_smt_goal : match uu___5 with | FStar_Pervasives_Native.Some vc -> ((let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + FStarC_Effect.op_Bang dbg_Tac in if uu___7 then let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term vc in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "handle_smt_goals left a goal: %s\n" uu___8 else ()); @@ -1786,8 +1774,7 @@ let (splice : Prims.bool -> FStarC_Ident.lident Prims.list -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.sigelt Prims.list) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt Prims.list) = fun env -> fun is_typed -> @@ -1819,16 +1806,14 @@ let (splice : let uu___5 = if is_typed then - (if - (FStarC_Compiler_List.length lids) > - Prims.int_one + (if (FStarC_List.length lids) > Prims.int_one then let uu___6 = let uu___7 = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Ident.showable_lident) lids in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Typed splice: unexpected lids length (> 1) (%s)" uu___7 in FStarC_Errors.raise_error @@ -1840,13 +1825,12 @@ let (splice : else (let val_t = if - (FStarC_Compiler_List.length lids) = + (FStarC_List.length lids) = Prims.int_zero then FStar_Pervasives_Native.None else (let uu___8 = - let uu___9 = - FStarC_Compiler_List.hd lids in + let uu___9 = FStarC_List.hd lids in FStarC_TypeChecker_Env.try_lookup_val_decl env uu___9 in match uu___8 with @@ -1855,16 +1839,15 @@ let (splice : | FStar_Pervasives_Native.Some ((uvs, tval), uu___9) -> if - (FStarC_Compiler_List.length uvs) - <> Prims.int_zero + (FStarC_List.length uvs) <> + Prims.int_zero then let uu___10 = let uu___11 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length - uvs) in - FStarC_Compiler_Util.format1 + (FStarC_List.length uvs) in + FStarC_Util.format1 "Typed splice: val declaration for %s is universe polymorphic in %s universes, expected 0" uu___11 in FStarC_Errors.raise_error @@ -2041,11 +2024,10 @@ let (splice : sig_blobs_after)) -> let uu___8 = uu___7 in let sig_blobs = - FStarC_Compiler_List.op_At - sig_blobs_before (sig_blob :: - sig_blobs_after) in + FStarC_List.op_At sig_blobs_before + (sig_blob :: sig_blobs_after) in let sigelts = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___9 -> match uu___9 with | (checked, se, blob_opt) -> @@ -2145,7 +2127,7 @@ let (splice : FStarC_Syntax_Syntax.lbpos = (lb.FStarC_Syntax_Syntax.lbpos) } in - FStarC_Compiler_List.map + FStarC_List.map (fun se -> match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_let @@ -2158,8 +2140,8 @@ let (splice : let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_List.map - set_lb_dd lbs in + FStarC_List.map set_lb_dd + lbs in (is_rec, uu___9) in { FStarC_Syntax_Syntax.lbs1 = @@ -2189,7 +2171,7 @@ let (splice : | uu___6 -> se) sigelts in (FStarC_Options.with_saved_options (fun uu___7 -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun g1 -> (let uu___9 = FStarC_Tactics_Types.goal_opts g1 in @@ -2206,7 +2188,7 @@ let (splice : | FStar_Pervasives_Native.Some vc -> ((let uu___11 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Tac in if uu___11 then @@ -2214,7 +2196,7 @@ let (splice : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term vc in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Splice left a goal: %s\n" uu___12 else ()); @@ -2239,13 +2221,13 @@ let (splice : "splice left open goals"))) gs); (let lids' = - FStarC_Compiler_List.collect + FStarC_List.collect FStarC_Syntax_Util.lids_of_sigelt sigelts1 in - FStarC_Compiler_List.iter + FStarC_List.iter (fun lid -> let uu___8 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (FStarC_Ident.lid_equals lid) lids' in match uu___8 with | FStar_Pervasives_Native.None when @@ -2262,7 +2244,7 @@ let (splice : (FStarC_Class_Show.show_list FStarC_Ident.showable_lident) lids' in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Splice declared the name %s but it was not defined.\nThose defined were: %s" uu___10 uu___11 in FStarC_Errors.raise_error @@ -2274,8 +2256,7 @@ let (splice : FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___9) | uu___9 -> ()) lids; - (let uu___9 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + (let uu___9 = FStarC_Effect.op_Bang dbg_Tac in if uu___9 then let uu___10 = @@ -2283,12 +2264,12 @@ let (splice : (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_sigelt) sigelts1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "splice: got decls = {\n\n%s\n\n}\n" uu___10 else ()); (let sigelts2 = - FStarC_Compiler_List.map + FStarC_List.map (fun se -> (match se.FStarC_Syntax_Syntax.sigel with @@ -2370,9 +2351,9 @@ let (splice : if is_typed then () else - FStarC_Compiler_List.iter + FStarC_List.iter (fun se -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun q -> let uu___11 = FStarC_Syntax_Syntax.is_internal_qualifier @@ -2386,7 +2367,7 @@ let (splice : FStarC_Class_Show.show FStarC_Syntax_Print.showable_qualifier q in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "The qualifier %s is internal." uu___15 in FStarC_Errors_Msg.text @@ -2478,7 +2459,7 @@ let (postprocess : tm.FStarC_Syntax_Syntax.pos tau env goal in (match uu___4 with | (gs, w) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun g -> let uu___6 = let uu___7 = @@ -2489,15 +2470,14 @@ let (postprocess : match uu___6 with | FStar_Pervasives_Native.Some vc -> ((let uu___8 = - FStarC_Compiler_Effect.op_Bang - dbg_Tac in + FStarC_Effect.op_Bang dbg_Tac in if uu___8 then let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term vc in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Postprocessing left a goal: %s\n" uu___9 else ()); diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_InterpFuns.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_InterpFuns.ml similarity index 95% rename from stage0/fstar-lib/generated/FStarC_Tactics_InterpFuns.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_InterpFuns.ml index 2790c874a96..d23e541a1f9 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_InterpFuns.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_InterpFuns.ml @@ -3,7 +3,7 @@ let solve : 'a . 'a -> 'a = fun ev -> ev let embed : 'a . 'a FStarC_Syntax_Embeddings_Base.embedding -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> 'a -> FStarC_Syntax_Embeddings_Base.norm_cb -> FStarC_Syntax_Syntax.term = @@ -479,12 +479,12 @@ let mk_tactic_interpretation_1 : match args with | (a1, uu___)::(a2, uu___1)::[] -> let uu___2 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun a11 -> let uu___3 = unembed FStarC_Tactics_Embedding.e_proofstate a2 ncb in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ps -> let ps1 = FStarC_Tactics_Types.set_ps_psc psc ps in @@ -529,16 +529,16 @@ let mk_tactic_interpretation_2 : match args with | (a1, uu___)::(a2, uu___1)::(a3, uu___2)::[] -> let uu___3 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun a11 -> let uu___4 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a21 -> let uu___5 = unembed FStarC_Tactics_Embedding.e_proofstate a3 ncb in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ps -> let ps1 = FStarC_Tactics_Types.set_ps_psc psc @@ -587,19 +587,19 @@ let mk_tactic_interpretation_3 : | (a1, uu___)::(a2, uu___1)::(a3, uu___2)::(a4, uu___3)::[] -> let uu___4 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a11 -> let uu___5 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a21 -> let uu___6 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a31 -> let uu___7 = unembed FStarC_Tactics_Embedding.e_proofstate a4 ncb in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun ps -> let ps1 = FStarC_Tactics_Types.set_ps_psc @@ -653,24 +653,22 @@ let mk_tactic_interpretation_4 : uu___3):: (a5, uu___4)::[] -> let uu___5 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a11 -> let uu___6 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a21 -> let uu___7 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a31 -> let uu___8 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt - uu___8 + FStarC_Util.bind_opt uu___8 (fun a41 -> let uu___9 = unembed FStarC_Tactics_Embedding.e_proofstate a5 ncb in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun ps -> let ps1 = FStarC_Tactics_Types.set_ps_psc @@ -727,28 +725,27 @@ let mk_tactic_interpretation_5 : | (a1, uu___)::(a2, uu___1)::(a3, uu___2):: (a4, uu___3)::(a5, uu___4)::(a6, uu___5)::[] -> let uu___6 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a11 -> let uu___7 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a21 -> let uu___8 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a31 -> let uu___9 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a41 -> let uu___10 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___10 (fun a51 -> let uu___11 = unembed FStarC_Tactics_Embedding.e_proofstate a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun ps -> let ps1 = @@ -815,35 +812,33 @@ let mk_tactic_interpretation_6 : (a4, uu___3)::(a5, uu___4)::(a6, uu___5):: (a7, uu___6)::[] -> let uu___7 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a11 -> let uu___8 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a21 -> let uu___9 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a31 -> let uu___10 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a41 -> let uu___11 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun a51 -> let uu___12 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a61 -> let uu___13 = unembed FStarC_Tactics_Embedding.e_proofstate a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun ps -> let ps1 = @@ -918,35 +913,33 @@ let mk_tactic_interpretation_7 : (a4, uu___3)::(a5, uu___4)::(a6, uu___5):: (a7, uu___6)::(a8, uu___7)::[] -> let uu___8 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a11 -> let uu___9 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a21 -> let uu___10 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a31 -> let uu___11 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a41 -> let uu___12 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a51 -> let uu___13 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a61 -> let uu___14 = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a71 -> let uu___15 @@ -954,7 +947,7 @@ let mk_tactic_interpretation_7 : unembed FStarC_Tactics_Embedding.e_proofstate a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun ps -> @@ -1035,37 +1028,35 @@ let mk_tactic_interpretation_8 : (a7, uu___6)::(a8, uu___7)::(a9, uu___8)::[] -> let uu___9 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a11 -> let uu___10 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a21 -> let uu___11 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a31 -> let uu___12 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a41 -> let uu___13 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a51 -> let uu___14 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a61 -> let uu___15 = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 ( fun a71 @@ -1074,7 +1065,7 @@ let mk_tactic_interpretation_8 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a81 -> @@ -1083,7 +1074,7 @@ let mk_tactic_interpretation_8 : unembed FStarC_Tactics_Embedding.e_proofstate a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun ps -> @@ -1169,38 +1160,36 @@ let mk_tactic_interpretation_9 : uu___8):: (a10, uu___9)::[] -> let uu___10 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun a11 -> let uu___11 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a21 -> let uu___12 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a31 -> let uu___13 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a41 -> let uu___14 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a51 -> let uu___15 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a61 -> let uu___16 = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a71 -> @@ -1208,7 +1197,7 @@ let mk_tactic_interpretation_9 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a81 -> @@ -1216,7 +1205,7 @@ let mk_tactic_interpretation_9 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a91 -> @@ -1225,7 +1214,7 @@ let mk_tactic_interpretation_9 : unembed FStarC_Tactics_Embedding.e_proofstate a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun ps -> @@ -1316,33 +1305,32 @@ let mk_tactic_interpretation_10 : uu___8):: (a10, uu___9)::(a11, uu___10)::[] -> let uu___11 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___11 + FStarC_Util.bind_opt uu___11 (fun a12 -> let uu___12 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a21 -> let uu___13 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a31 -> let uu___14 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a41 -> let uu___15 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a51 -> let uu___16 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a61 -> @@ -1350,7 +1338,7 @@ let mk_tactic_interpretation_10 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a71 -> @@ -1358,7 +1346,7 @@ let mk_tactic_interpretation_10 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a81 -> @@ -1366,7 +1354,7 @@ let mk_tactic_interpretation_10 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a91 -> @@ -1375,7 +1363,7 @@ let mk_tactic_interpretation_10 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a101 -> @@ -1384,7 +1372,7 @@ let mk_tactic_interpretation_10 : unembed FStarC_Tactics_Embedding.e_proofstate a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun ps -> @@ -1480,35 +1468,33 @@ let mk_tactic_interpretation_11 : (a10, uu___9)::(a11, uu___10):: (a12, uu___11)::[] -> let uu___12 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a13 -> let uu___13 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a21 -> let uu___14 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a31 -> let uu___15 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a41 -> let uu___16 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a51 -> let uu___17 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a61 -> @@ -1516,7 +1502,7 @@ let mk_tactic_interpretation_11 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a71 -> @@ -1524,7 +1510,7 @@ let mk_tactic_interpretation_11 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a81 -> @@ -1532,7 +1518,7 @@ let mk_tactic_interpretation_11 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a91 -> @@ -1541,7 +1527,7 @@ let mk_tactic_interpretation_11 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a101 -> @@ -1550,7 +1536,7 @@ let mk_tactic_interpretation_11 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a111 -> @@ -1559,7 +1545,7 @@ let mk_tactic_interpretation_11 : unembed FStarC_Tactics_Embedding.e_proofstate a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun ps -> @@ -1659,36 +1645,34 @@ let mk_tactic_interpretation_12 : (a11, uu___10)::(a12, uu___11):: (a13, uu___12)::[] -> let uu___13 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a14 -> let uu___14 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___14 + FStarC_Util.bind_opt uu___14 (fun a21 -> let uu___15 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a31 -> let uu___16 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a41 -> let uu___17 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a51 -> let uu___18 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a61 -> @@ -1696,7 +1680,7 @@ let mk_tactic_interpretation_12 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a71 -> @@ -1704,7 +1688,7 @@ let mk_tactic_interpretation_12 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a81 -> @@ -1712,7 +1696,7 @@ let mk_tactic_interpretation_12 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a91 -> @@ -1721,7 +1705,7 @@ let mk_tactic_interpretation_12 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a101 -> @@ -1730,7 +1714,7 @@ let mk_tactic_interpretation_12 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a111 -> @@ -1739,7 +1723,7 @@ let mk_tactic_interpretation_12 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a121 -> @@ -1748,7 +1732,7 @@ let mk_tactic_interpretation_12 : unembed FStarC_Tactics_Embedding.e_proofstate a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun ps -> @@ -1857,30 +1841,29 @@ let mk_tactic_interpretation_13 : (a13, uu___12)::(a14, uu___13)::[] -> let uu___14 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt - uu___14 + FStarC_Util.bind_opt uu___14 (fun a15 -> let uu___15 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a21 -> let uu___16 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a31 -> let uu___17 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a41 -> let uu___18 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 ( fun a51 @@ -1889,7 +1872,7 @@ let mk_tactic_interpretation_13 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a61 -> @@ -1897,7 +1880,7 @@ let mk_tactic_interpretation_13 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a71 -> @@ -1905,7 +1888,7 @@ let mk_tactic_interpretation_13 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a81 -> @@ -1913,7 +1896,7 @@ let mk_tactic_interpretation_13 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a91 -> @@ -1922,7 +1905,7 @@ let mk_tactic_interpretation_13 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a101 -> @@ -1931,7 +1914,7 @@ let mk_tactic_interpretation_13 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a111 -> @@ -1940,7 +1923,7 @@ let mk_tactic_interpretation_13 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a121 -> @@ -1949,7 +1932,7 @@ let mk_tactic_interpretation_13 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a131 -> @@ -1958,7 +1941,7 @@ let mk_tactic_interpretation_13 : unembed FStarC_Tactics_Embedding.e_proofstate a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun ps -> @@ -2077,30 +2060,29 @@ let mk_tactic_interpretation_14 : (a15, uu___14)::[] -> let uu___15 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt - uu___15 + FStarC_Util.bind_opt uu___15 (fun a16 -> let uu___16 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a21 -> let uu___17 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a31 -> let uu___18 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a41 -> let uu___19 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a51 -> @@ -2108,7 +2090,7 @@ let mk_tactic_interpretation_14 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a61 -> @@ -2116,7 +2098,7 @@ let mk_tactic_interpretation_14 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a71 -> @@ -2124,7 +2106,7 @@ let mk_tactic_interpretation_14 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a81 -> @@ -2132,7 +2114,7 @@ let mk_tactic_interpretation_14 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a91 -> @@ -2141,7 +2123,7 @@ let mk_tactic_interpretation_14 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a101 -> @@ -2150,7 +2132,7 @@ let mk_tactic_interpretation_14 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a111 -> @@ -2159,7 +2141,7 @@ let mk_tactic_interpretation_14 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a121 -> @@ -2168,7 +2150,7 @@ let mk_tactic_interpretation_14 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a131 -> @@ -2177,7 +2159,7 @@ let mk_tactic_interpretation_14 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a141 -> @@ -2186,7 +2168,7 @@ let mk_tactic_interpretation_14 : unembed FStarC_Tactics_Embedding.e_proofstate a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun ps -> @@ -2313,25 +2295,25 @@ let mk_tactic_interpretation_15 : -> let uu___16 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a17 -> let uu___17 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a21 -> let uu___18 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a31 -> let uu___19 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a41 -> @@ -2339,7 +2321,7 @@ let mk_tactic_interpretation_15 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a51 -> @@ -2347,7 +2329,7 @@ let mk_tactic_interpretation_15 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a61 -> @@ -2355,7 +2337,7 @@ let mk_tactic_interpretation_15 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a71 -> @@ -2363,7 +2345,7 @@ let mk_tactic_interpretation_15 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a81 -> @@ -2371,7 +2353,7 @@ let mk_tactic_interpretation_15 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a91 -> @@ -2380,7 +2362,7 @@ let mk_tactic_interpretation_15 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a101 -> @@ -2389,7 +2371,7 @@ let mk_tactic_interpretation_15 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a111 -> @@ -2398,7 +2380,7 @@ let mk_tactic_interpretation_15 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a121 -> @@ -2407,7 +2389,7 @@ let mk_tactic_interpretation_15 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a131 -> @@ -2416,7 +2398,7 @@ let mk_tactic_interpretation_15 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a141 -> @@ -2425,7 +2407,7 @@ let mk_tactic_interpretation_15 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a151 -> @@ -2434,7 +2416,7 @@ let mk_tactic_interpretation_15 : unembed FStarC_Tactics_Embedding.e_proofstate a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun ps -> @@ -2573,25 +2555,25 @@ let mk_tactic_interpretation_16 : (a17, uu___16)::[] -> let uu___17 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a18 -> let uu___18 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a21 -> let uu___19 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a31 -> let uu___20 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a41 -> @@ -2599,7 +2581,7 @@ let mk_tactic_interpretation_16 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a51 -> @@ -2607,7 +2589,7 @@ let mk_tactic_interpretation_16 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a61 -> @@ -2615,7 +2597,7 @@ let mk_tactic_interpretation_16 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a71 -> @@ -2623,7 +2605,7 @@ let mk_tactic_interpretation_16 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a81 -> @@ -2631,7 +2613,7 @@ let mk_tactic_interpretation_16 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a91 -> @@ -2640,7 +2622,7 @@ let mk_tactic_interpretation_16 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a101 -> @@ -2649,7 +2631,7 @@ let mk_tactic_interpretation_16 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a111 -> @@ -2658,7 +2640,7 @@ let mk_tactic_interpretation_16 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a121 -> @@ -2667,7 +2649,7 @@ let mk_tactic_interpretation_16 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a131 -> @@ -2676,7 +2658,7 @@ let mk_tactic_interpretation_16 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a141 -> @@ -2685,7 +2667,7 @@ let mk_tactic_interpretation_16 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a151 -> @@ -2694,7 +2676,7 @@ let mk_tactic_interpretation_16 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a161 -> @@ -2703,7 +2685,7 @@ let mk_tactic_interpretation_16 : unembed FStarC_Tactics_Embedding.e_proofstate a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun ps -> @@ -2850,26 +2832,26 @@ let mk_tactic_interpretation_17 : (a18, uu___17)::[] -> let uu___18 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a19 -> let uu___19 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a21 -> let uu___20 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a31 -> let uu___21 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a41 -> @@ -2877,7 +2859,7 @@ let mk_tactic_interpretation_17 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a51 -> @@ -2885,7 +2867,7 @@ let mk_tactic_interpretation_17 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a61 -> @@ -2893,7 +2875,7 @@ let mk_tactic_interpretation_17 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a71 -> @@ -2901,7 +2883,7 @@ let mk_tactic_interpretation_17 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a81 -> @@ -2909,7 +2891,7 @@ let mk_tactic_interpretation_17 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a91 -> @@ -2918,7 +2900,7 @@ let mk_tactic_interpretation_17 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a101 -> @@ -2927,7 +2909,7 @@ let mk_tactic_interpretation_17 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a111 -> @@ -2936,7 +2918,7 @@ let mk_tactic_interpretation_17 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a121 -> @@ -2945,7 +2927,7 @@ let mk_tactic_interpretation_17 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a131 -> @@ -2954,7 +2936,7 @@ let mk_tactic_interpretation_17 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a141 -> @@ -2963,7 +2945,7 @@ let mk_tactic_interpretation_17 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a151 -> @@ -2972,7 +2954,7 @@ let mk_tactic_interpretation_17 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a161 -> @@ -2981,7 +2963,7 @@ let mk_tactic_interpretation_17 : unembed e17 a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a171 -> @@ -2990,7 +2972,7 @@ let mk_tactic_interpretation_17 : unembed FStarC_Tactics_Embedding.e_proofstate a18 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun ps -> @@ -3145,20 +3127,20 @@ let mk_tactic_interpretation_18 : (a19, uu___18)::[] -> let uu___19 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a110 -> let uu___20 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a21 -> let uu___21 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 ( fun a31 @@ -3167,7 +3149,7 @@ let mk_tactic_interpretation_18 : = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a41 -> @@ -3175,7 +3157,7 @@ let mk_tactic_interpretation_18 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a51 -> @@ -3183,7 +3165,7 @@ let mk_tactic_interpretation_18 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a61 -> @@ -3191,7 +3173,7 @@ let mk_tactic_interpretation_18 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a71 -> @@ -3199,7 +3181,7 @@ let mk_tactic_interpretation_18 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a81 -> @@ -3207,7 +3189,7 @@ let mk_tactic_interpretation_18 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a91 -> @@ -3216,7 +3198,7 @@ let mk_tactic_interpretation_18 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a101 -> @@ -3225,7 +3207,7 @@ let mk_tactic_interpretation_18 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a111 -> @@ -3234,7 +3216,7 @@ let mk_tactic_interpretation_18 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a121 -> @@ -3243,7 +3225,7 @@ let mk_tactic_interpretation_18 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a131 -> @@ -3252,7 +3234,7 @@ let mk_tactic_interpretation_18 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a141 -> @@ -3261,7 +3243,7 @@ let mk_tactic_interpretation_18 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a151 -> @@ -3270,7 +3252,7 @@ let mk_tactic_interpretation_18 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a161 -> @@ -3279,7 +3261,7 @@ let mk_tactic_interpretation_18 : unembed e17 a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a171 -> @@ -3288,7 +3270,7 @@ let mk_tactic_interpretation_18 : unembed e18 a18 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a181 -> @@ -3297,7 +3279,7 @@ let mk_tactic_interpretation_18 : unembed FStarC_Tactics_Embedding.e_proofstate a19 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun ps -> @@ -3461,20 +3443,20 @@ let mk_tactic_interpretation_19 : -> let uu___20 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a110 -> let uu___21 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a21 -> let uu___22 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a31 -> @@ -3482,7 +3464,7 @@ let mk_tactic_interpretation_19 : = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a41 -> @@ -3490,7 +3472,7 @@ let mk_tactic_interpretation_19 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a51 -> @@ -3498,7 +3480,7 @@ let mk_tactic_interpretation_19 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a61 -> @@ -3506,7 +3488,7 @@ let mk_tactic_interpretation_19 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a71 -> @@ -3514,7 +3496,7 @@ let mk_tactic_interpretation_19 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a81 -> @@ -3522,7 +3504,7 @@ let mk_tactic_interpretation_19 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a91 -> @@ -3531,7 +3513,7 @@ let mk_tactic_interpretation_19 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a101 -> @@ -3540,7 +3522,7 @@ let mk_tactic_interpretation_19 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a111 -> @@ -3549,7 +3531,7 @@ let mk_tactic_interpretation_19 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a121 -> @@ -3558,7 +3540,7 @@ let mk_tactic_interpretation_19 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a131 -> @@ -3567,7 +3549,7 @@ let mk_tactic_interpretation_19 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a141 -> @@ -3576,7 +3558,7 @@ let mk_tactic_interpretation_19 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a151 -> @@ -3585,7 +3567,7 @@ let mk_tactic_interpretation_19 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a161 -> @@ -3594,7 +3576,7 @@ let mk_tactic_interpretation_19 : unembed e17 a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a171 -> @@ -3603,7 +3585,7 @@ let mk_tactic_interpretation_19 : unembed e18 a18 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun a181 -> @@ -3612,7 +3594,7 @@ let mk_tactic_interpretation_19 : unembed e19 a19 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___38 (fun a191 -> @@ -3621,7 +3603,7 @@ let mk_tactic_interpretation_19 : unembed FStarC_Tactics_Embedding.e_proofstate a20 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___39 (fun ps -> @@ -3792,14 +3774,14 @@ let mk_tactic_interpretation_20 : let uu___21 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a110 -> let uu___22 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a22 -> @@ -3807,7 +3789,7 @@ let mk_tactic_interpretation_20 : = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a31 -> @@ -3815,7 +3797,7 @@ let mk_tactic_interpretation_20 : = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a41 -> @@ -3823,7 +3805,7 @@ let mk_tactic_interpretation_20 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a51 -> @@ -3831,7 +3813,7 @@ let mk_tactic_interpretation_20 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a61 -> @@ -3839,7 +3821,7 @@ let mk_tactic_interpretation_20 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a71 -> @@ -3847,7 +3829,7 @@ let mk_tactic_interpretation_20 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a81 -> @@ -3855,7 +3837,7 @@ let mk_tactic_interpretation_20 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a91 -> @@ -3864,7 +3846,7 @@ let mk_tactic_interpretation_20 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a101 -> @@ -3873,7 +3855,7 @@ let mk_tactic_interpretation_20 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a111 -> @@ -3882,7 +3864,7 @@ let mk_tactic_interpretation_20 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a121 -> @@ -3891,7 +3873,7 @@ let mk_tactic_interpretation_20 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a131 -> @@ -3900,7 +3882,7 @@ let mk_tactic_interpretation_20 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a141 -> @@ -3909,7 +3891,7 @@ let mk_tactic_interpretation_20 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a151 -> @@ -3918,7 +3900,7 @@ let mk_tactic_interpretation_20 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a161 -> @@ -3927,7 +3909,7 @@ let mk_tactic_interpretation_20 : unembed e17 a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun a171 -> @@ -3936,7 +3918,7 @@ let mk_tactic_interpretation_20 : unembed e18 a18 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___38 (fun a181 -> @@ -3945,7 +3927,7 @@ let mk_tactic_interpretation_20 : unembed e19 a19 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___39 (fun a191 -> @@ -3954,7 +3936,7 @@ let mk_tactic_interpretation_20 : unembed e20 a20 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___40 (fun a201 -> @@ -3963,7 +3945,7 @@ let mk_tactic_interpretation_20 : unembed FStarC_Tactics_Embedding.e_proofstate a21 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___41 (fun ps -> @@ -4028,12 +4010,12 @@ let mk_tactic_nbe_interpretation_1 : match args with | (a1, uu___)::(a2, uu___1)::[] -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun a11 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a2 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun ps -> let r1 = interp_ctx name @@ -4071,17 +4053,17 @@ let mk_tactic_nbe_interpretation_2 : | (a1, uu___)::(a2, uu___1)::(a3, uu___2)::[] -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun a11 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a21 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a3 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun ps -> let r1 = interp_ctx name @@ -4123,22 +4105,22 @@ let mk_tactic_nbe_interpretation_3 : -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a11 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a21 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a31 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a4 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun ps -> let r1 = interp_ctx name @@ -4183,28 +4165,27 @@ let mk_tactic_nbe_interpretation_4 : (a5, uu___4)::[] -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a11 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a21 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a31 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a41 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a5 in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun ps -> let r1 = interp_ctx name @@ -4253,35 +4234,33 @@ let mk_tactic_nbe_interpretation_5 : (a5, uu___4)::(a6, uu___5)::[] -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a11 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a21 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a31 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a41 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a51 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun ps -> let r1 = @@ -4338,41 +4317,40 @@ let mk_tactic_nbe_interpretation_6 : (a7, uu___6)::[] -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a11 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a21 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a31 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a41 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun a51 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a61 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun ps -> let r1 = @@ -4437,41 +4415,39 @@ let mk_tactic_nbe_interpretation_7 : (a7, uu___6)::(a8, uu___7)::[] -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a11 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a21 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a31 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a41 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a51 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a61 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a71 -> let uu___15 @@ -4479,7 +4455,7 @@ let mk_tactic_nbe_interpretation_7 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun ps -> @@ -4551,48 +4527,46 @@ let mk_tactic_nbe_interpretation_8 : let uu___9 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a11 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun a21 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a31 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a41 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a51 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a61 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a71 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a81 -> @@ -4601,7 +4575,7 @@ let mk_tactic_nbe_interpretation_8 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun ps -> @@ -4677,43 +4651,41 @@ let mk_tactic_nbe_interpretation_9 : let uu___10 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun a11 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a21 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a31 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a41 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a51 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a61 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 ( fun a71 @@ -4722,7 +4694,7 @@ let mk_tactic_nbe_interpretation_9 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a81 -> @@ -4730,7 +4702,7 @@ let mk_tactic_nbe_interpretation_9 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a91 -> @@ -4739,7 +4711,7 @@ let mk_tactic_nbe_interpretation_9 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun ps -> @@ -4821,43 +4793,41 @@ let mk_tactic_nbe_interpretation_10 : let uu___11 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___11 + FStarC_Util.bind_opt uu___11 (fun a12 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a21 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a31 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a41 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a51 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a61 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a71 -> @@ -4865,7 +4835,7 @@ let mk_tactic_nbe_interpretation_10 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a81 -> @@ -4873,7 +4843,7 @@ let mk_tactic_nbe_interpretation_10 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a91 -> @@ -4882,7 +4852,7 @@ let mk_tactic_nbe_interpretation_10 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a101 -> @@ -4891,7 +4861,7 @@ let mk_tactic_nbe_interpretation_10 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun ps -> @@ -4978,37 +4948,36 @@ let mk_tactic_nbe_interpretation_11 : let uu___12 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___12 + FStarC_Util.bind_opt uu___12 (fun a13 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a21 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a31 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a41 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a51 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a61 -> @@ -5016,7 +4985,7 @@ let mk_tactic_nbe_interpretation_11 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a71 -> @@ -5024,7 +4993,7 @@ let mk_tactic_nbe_interpretation_11 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a81 -> @@ -5032,7 +5001,7 @@ let mk_tactic_nbe_interpretation_11 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a91 -> @@ -5041,7 +5010,7 @@ let mk_tactic_nbe_interpretation_11 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a101 -> @@ -5050,7 +5019,7 @@ let mk_tactic_nbe_interpretation_11 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a111 -> @@ -5059,7 +5028,7 @@ let mk_tactic_nbe_interpretation_11 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun ps -> @@ -5152,38 +5121,36 @@ let mk_tactic_nbe_interpretation_12 : let uu___13 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a14 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___14 + FStarC_Util.bind_opt uu___14 (fun a21 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a31 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a41 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a51 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a61 -> @@ -5191,7 +5158,7 @@ let mk_tactic_nbe_interpretation_12 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a71 -> @@ -5199,7 +5166,7 @@ let mk_tactic_nbe_interpretation_12 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a81 -> @@ -5207,7 +5174,7 @@ let mk_tactic_nbe_interpretation_12 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a91 -> @@ -5216,7 +5183,7 @@ let mk_tactic_nbe_interpretation_12 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a101 -> @@ -5225,7 +5192,7 @@ let mk_tactic_nbe_interpretation_12 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a111 -> @@ -5234,7 +5201,7 @@ let mk_tactic_nbe_interpretation_12 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a121 -> @@ -5243,7 +5210,7 @@ let mk_tactic_nbe_interpretation_12 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun ps -> @@ -5341,38 +5308,36 @@ let mk_tactic_nbe_interpretation_13 : let uu___14 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt - uu___14 + FStarC_Util.bind_opt uu___14 (fun a15 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___15 + FStarC_Util.bind_opt uu___15 (fun a21 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a31 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a41 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a51 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a61 -> @@ -5380,7 +5345,7 @@ let mk_tactic_nbe_interpretation_13 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a71 -> @@ -5388,7 +5353,7 @@ let mk_tactic_nbe_interpretation_13 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a81 -> @@ -5396,7 +5361,7 @@ let mk_tactic_nbe_interpretation_13 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a91 -> @@ -5405,7 +5370,7 @@ let mk_tactic_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a101 -> @@ -5414,7 +5379,7 @@ let mk_tactic_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a111 -> @@ -5423,7 +5388,7 @@ let mk_tactic_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a121 -> @@ -5432,7 +5397,7 @@ let mk_tactic_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a131 -> @@ -5441,7 +5406,7 @@ let mk_tactic_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun ps -> @@ -5545,32 +5510,31 @@ let mk_tactic_nbe_interpretation_14 : let uu___15 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt - uu___15 + FStarC_Util.bind_opt uu___15 (fun a16 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a21 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a31 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a41 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 ( fun a51 @@ -5579,7 +5543,7 @@ let mk_tactic_nbe_interpretation_14 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a61 -> @@ -5587,7 +5551,7 @@ let mk_tactic_nbe_interpretation_14 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a71 -> @@ -5595,7 +5559,7 @@ let mk_tactic_nbe_interpretation_14 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a81 -> @@ -5603,7 +5567,7 @@ let mk_tactic_nbe_interpretation_14 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a91 -> @@ -5612,7 +5576,7 @@ let mk_tactic_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a101 -> @@ -5621,7 +5585,7 @@ let mk_tactic_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a111 -> @@ -5630,7 +5594,7 @@ let mk_tactic_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a121 -> @@ -5639,7 +5603,7 @@ let mk_tactic_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a131 -> @@ -5648,7 +5612,7 @@ let mk_tactic_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a141 -> @@ -5657,7 +5621,7 @@ let mk_tactic_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun ps -> @@ -5773,32 +5737,31 @@ let mk_tactic_nbe_interpretation_15 : let uu___16 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt - uu___16 + FStarC_Util.bind_opt uu___16 (fun a17 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a21 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a31 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a41 -> let uu___20 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a51 -> @@ -5806,7 +5769,7 @@ let mk_tactic_nbe_interpretation_15 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a61 -> @@ -5814,7 +5777,7 @@ let mk_tactic_nbe_interpretation_15 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a71 -> @@ -5822,7 +5785,7 @@ let mk_tactic_nbe_interpretation_15 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a81 -> @@ -5830,7 +5793,7 @@ let mk_tactic_nbe_interpretation_15 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a91 -> @@ -5839,7 +5802,7 @@ let mk_tactic_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a101 -> @@ -5848,7 +5811,7 @@ let mk_tactic_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a111 -> @@ -5857,7 +5820,7 @@ let mk_tactic_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a121 -> @@ -5866,7 +5829,7 @@ let mk_tactic_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a131 -> @@ -5875,7 +5838,7 @@ let mk_tactic_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a141 -> @@ -5884,7 +5847,7 @@ let mk_tactic_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a151 -> @@ -5893,7 +5856,7 @@ let mk_tactic_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun ps -> @@ -6015,26 +5978,26 @@ let mk_tactic_nbe_interpretation_16 : let uu___17 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a18 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a21 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a31 -> let uu___20 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a41 -> @@ -6042,7 +6005,7 @@ let mk_tactic_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a51 -> @@ -6050,7 +6013,7 @@ let mk_tactic_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a61 -> @@ -6058,7 +6021,7 @@ let mk_tactic_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a71 -> @@ -6066,7 +6029,7 @@ let mk_tactic_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a81 -> @@ -6074,7 +6037,7 @@ let mk_tactic_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a91 -> @@ -6083,7 +6046,7 @@ let mk_tactic_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a101 -> @@ -6092,7 +6055,7 @@ let mk_tactic_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a111 -> @@ -6101,7 +6064,7 @@ let mk_tactic_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a121 -> @@ -6110,7 +6073,7 @@ let mk_tactic_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a131 -> @@ -6119,7 +6082,7 @@ let mk_tactic_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a141 -> @@ -6128,7 +6091,7 @@ let mk_tactic_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a151 -> @@ -6137,7 +6100,7 @@ let mk_tactic_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a161 -> @@ -6146,7 +6109,7 @@ let mk_tactic_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun ps -> @@ -6281,26 +6244,26 @@ let mk_tactic_nbe_interpretation_17 : let uu___18 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a19 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a21 -> let uu___20 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a31 -> let uu___21 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a41 -> @@ -6308,7 +6271,7 @@ let mk_tactic_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a51 -> @@ -6316,7 +6279,7 @@ let mk_tactic_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a61 -> @@ -6324,7 +6287,7 @@ let mk_tactic_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a71 -> @@ -6332,7 +6295,7 @@ let mk_tactic_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a81 -> @@ -6340,7 +6303,7 @@ let mk_tactic_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a91 -> @@ -6349,7 +6312,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a101 -> @@ -6358,7 +6321,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a111 -> @@ -6367,7 +6330,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a121 -> @@ -6376,7 +6339,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a131 -> @@ -6385,7 +6348,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a141 -> @@ -6394,7 +6357,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a151 -> @@ -6403,7 +6366,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a161 -> @@ -6412,7 +6375,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e17 cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a171 -> @@ -6421,7 +6384,7 @@ let mk_tactic_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a18 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun ps -> @@ -6563,26 +6526,26 @@ let mk_tactic_nbe_interpretation_18 : let uu___19 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a110 -> let uu___20 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a21 -> let uu___21 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a31 -> let uu___22 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a41 -> @@ -6590,7 +6553,7 @@ let mk_tactic_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a51 -> @@ -6598,7 +6561,7 @@ let mk_tactic_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a61 -> @@ -6606,7 +6569,7 @@ let mk_tactic_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a71 -> @@ -6614,7 +6577,7 @@ let mk_tactic_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a81 -> @@ -6622,7 +6585,7 @@ let mk_tactic_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a91 -> @@ -6631,7 +6594,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a101 -> @@ -6640,7 +6603,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a111 -> @@ -6649,7 +6612,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a121 -> @@ -6658,7 +6621,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a131 -> @@ -6667,7 +6630,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a141 -> @@ -6676,7 +6639,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a151 -> @@ -6685,7 +6648,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a161 -> @@ -6694,7 +6657,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e17 cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a171 -> @@ -6703,7 +6666,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e18 cb a18 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a181 -> @@ -6712,7 +6675,7 @@ let mk_tactic_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a19 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun ps -> @@ -6862,20 +6825,20 @@ let mk_tactic_nbe_interpretation_19 : let uu___20 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a110 -> let uu___21 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a21 -> let uu___22 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 ( fun a31 @@ -6884,7 +6847,7 @@ let mk_tactic_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a41 -> @@ -6892,7 +6855,7 @@ let mk_tactic_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a51 -> @@ -6900,7 +6863,7 @@ let mk_tactic_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a61 -> @@ -6908,7 +6871,7 @@ let mk_tactic_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a71 -> @@ -6916,7 +6879,7 @@ let mk_tactic_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a81 -> @@ -6924,7 +6887,7 @@ let mk_tactic_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a91 -> @@ -6933,7 +6896,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a101 -> @@ -6942,7 +6905,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a111 -> @@ -6951,7 +6914,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a121 -> @@ -6960,7 +6923,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a131 -> @@ -6969,7 +6932,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a141 -> @@ -6978,7 +6941,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a151 -> @@ -6987,7 +6950,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a161 -> @@ -6996,7 +6959,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e17 cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a171 -> @@ -7005,7 +6968,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e18 cb a18 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun a181 -> @@ -7014,7 +6977,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e19 cb a19 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___38 (fun a191 -> @@ -7023,7 +6986,7 @@ let mk_tactic_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a20 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___39 (fun ps -> @@ -7180,20 +7143,20 @@ let mk_tactic_nbe_interpretation_20 : let uu___21 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a110 -> let uu___22 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a22 -> let uu___23 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a31 -> @@ -7201,7 +7164,7 @@ let mk_tactic_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a41 -> @@ -7209,7 +7172,7 @@ let mk_tactic_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a51 -> @@ -7217,7 +7180,7 @@ let mk_tactic_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a61 -> @@ -7225,7 +7188,7 @@ let mk_tactic_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a71 -> @@ -7233,7 +7196,7 @@ let mk_tactic_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a81 -> @@ -7241,7 +7204,7 @@ let mk_tactic_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a91 -> @@ -7250,7 +7213,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a101 -> @@ -7259,7 +7222,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a111 -> @@ -7268,7 +7231,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a121 -> @@ -7277,7 +7240,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a131 -> @@ -7286,7 +7249,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a141 -> @@ -7295,7 +7258,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a151 -> @@ -7304,7 +7267,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a161 -> @@ -7313,7 +7276,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e17 cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun a171 -> @@ -7322,7 +7285,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e18 cb a18 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___38 (fun a181 -> @@ -7331,7 +7294,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e19 cb a19 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___39 (fun a191 -> @@ -7340,7 +7303,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e20 cb a20 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___40 (fun a201 -> @@ -7349,7 +7312,7 @@ let mk_tactic_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed FStarC_Tactics_Embedding.e_proofstate_nbe cb a21 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___41 (fun ps -> @@ -7407,7 +7370,7 @@ let mk_total_interpretation_1 : match args with | (a1, uu___)::[] -> let uu___1 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun a11 -> let r1 = interp_ctx name (fun uu___2 -> f a11) in let uu___2 = @@ -7442,10 +7405,10 @@ let mk_total_interpretation_2 : match args with | (a1, uu___)::(a2, uu___1)::[] -> let uu___2 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun a11 -> let uu___3 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun a21 -> let r1 = interp_ctx name (fun uu___4 -> f a11 a21) in @@ -7484,13 +7447,13 @@ let mk_total_interpretation_3 : match args with | (a1, uu___)::(a2, uu___1)::(a3, uu___2)::[] -> let uu___3 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun a11 -> let uu___4 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a21 -> let uu___5 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a31 -> let r1 = interp_ctx name @@ -7534,17 +7497,16 @@ let mk_total_interpretation_4 : uu___3)::[] -> let uu___4 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a11 -> let uu___5 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a21 -> let uu___6 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a31 -> let uu___7 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt - uu___7 + FStarC_Util.bind_opt uu___7 (fun a41 -> let r1 = interp_ctx name @@ -7591,22 +7553,20 @@ let mk_total_interpretation_5 : | (a1, uu___)::(a2, uu___1)::(a3, uu___2):: (a4, uu___3)::(a5, uu___4)::[] -> let uu___5 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a11 -> let uu___6 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a21 -> let uu___7 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a31 -> let uu___8 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt - uu___8 + FStarC_Util.bind_opt uu___8 (fun a41 -> let uu___9 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a51 -> let r1 = interp_ctx name @@ -7658,27 +7618,25 @@ let mk_total_interpretation_6 : (a4, uu___3)::(a5, uu___4)::(a6, uu___5)::[] -> let uu___6 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a11 -> let uu___7 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a21 -> let uu___8 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt - uu___8 + FStarC_Util.bind_opt uu___8 (fun a31 -> let uu___9 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a41 -> let uu___10 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___10 (fun a51 -> let uu___11 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun a61 -> let r1 = @@ -7738,35 +7696,33 @@ let mk_total_interpretation_7 : (a4, uu___3)::(a5, uu___4)::(a6, uu___5):: (a7, uu___6)::[] -> let uu___7 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a11 -> let uu___8 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a21 -> let uu___9 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a31 -> let uu___10 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a41 -> let uu___11 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun a51 -> let uu___12 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a61 -> let uu___13 = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a71 -> let r1 = @@ -7831,36 +7787,35 @@ let mk_total_interpretation_8 : (a4, uu___3)::(a5, uu___4)::(a6, uu___5):: (a7, uu___6)::(a8, uu___7)::[] -> let uu___8 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a11 -> let uu___9 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a21 -> let uu___10 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a31 -> let uu___11 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun a41 -> let uu___12 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a51 -> let uu___13 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a61 -> let uu___14 = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 ( fun a71 @@ -7869,7 +7824,7 @@ let mk_total_interpretation_8 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a81 -> @@ -7940,38 +7895,36 @@ let mk_total_interpretation_9 : uu___8)::[] -> let uu___9 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a11 -> let uu___10 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a21 -> let uu___11 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a31 -> let uu___12 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a41 -> let uu___13 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a51 -> let uu___14 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a61 -> let uu___15 = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a71 -> @@ -7979,7 +7932,7 @@ let mk_total_interpretation_9 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a81 -> @@ -7987,7 +7940,7 @@ let mk_total_interpretation_9 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a91 -> @@ -8063,33 +8016,32 @@ let mk_total_interpretation_10 : uu___8):: (a10, uu___9)::[] -> let uu___10 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun a11 -> let uu___11 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a21 -> let uu___12 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a31 -> let uu___13 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a41 -> let uu___14 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a51 -> let uu___15 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a61 -> @@ -8097,7 +8049,7 @@ let mk_total_interpretation_10 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a71 -> @@ -8105,7 +8057,7 @@ let mk_total_interpretation_10 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a81 -> @@ -8113,7 +8065,7 @@ let mk_total_interpretation_10 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a91 -> @@ -8122,7 +8074,7 @@ let mk_total_interpretation_10 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a101 -> @@ -8203,35 +8155,33 @@ let mk_total_interpretation_11 : (a10, uu___9)::(a11, uu___10)::[] -> let uu___11 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a12 -> let uu___12 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a21 -> let uu___13 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a31 -> let uu___14 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a41 -> let uu___15 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a51 -> let uu___16 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a61 -> @@ -8239,7 +8189,7 @@ let mk_total_interpretation_11 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a71 -> @@ -8247,7 +8197,7 @@ let mk_total_interpretation_11 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a81 -> @@ -8255,7 +8205,7 @@ let mk_total_interpretation_11 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a91 -> @@ -8264,7 +8214,7 @@ let mk_total_interpretation_11 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a101 -> @@ -8273,7 +8223,7 @@ let mk_total_interpretation_11 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a111 -> @@ -8358,36 +8308,34 @@ let mk_total_interpretation_12 : (a11, uu___10)::(a12, uu___11)::[] -> let uu___12 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a13 -> let uu___13 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a21 -> let uu___14 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a31 -> let uu___15 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a41 -> let uu___16 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a51 -> let uu___17 = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a61 -> @@ -8395,7 +8343,7 @@ let mk_total_interpretation_12 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a71 -> @@ -8403,7 +8351,7 @@ let mk_total_interpretation_12 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a81 -> @@ -8411,7 +8359,7 @@ let mk_total_interpretation_12 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a91 -> @@ -8420,7 +8368,7 @@ let mk_total_interpretation_12 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a101 -> @@ -8429,7 +8377,7 @@ let mk_total_interpretation_12 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a111 -> @@ -8438,7 +8386,7 @@ let mk_total_interpretation_12 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a121 -> @@ -8531,30 +8479,29 @@ let mk_total_interpretation_13 : (a11, uu___10)::(a12, uu___11):: (a13, uu___12)::[] -> let uu___13 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a14 -> let uu___14 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a21 -> let uu___15 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a31 -> let uu___16 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a41 -> let uu___17 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 ( fun a51 @@ -8563,7 +8510,7 @@ let mk_total_interpretation_13 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a61 -> @@ -8571,7 +8518,7 @@ let mk_total_interpretation_13 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a71 -> @@ -8579,7 +8526,7 @@ let mk_total_interpretation_13 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a81 -> @@ -8587,7 +8534,7 @@ let mk_total_interpretation_13 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a91 -> @@ -8596,7 +8543,7 @@ let mk_total_interpretation_13 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a101 -> @@ -8605,7 +8552,7 @@ let mk_total_interpretation_13 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a111 -> @@ -8614,7 +8561,7 @@ let mk_total_interpretation_13 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a121 -> @@ -8623,7 +8570,7 @@ let mk_total_interpretation_13 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a131 -> @@ -8727,30 +8674,29 @@ let mk_total_interpretation_14 : -> let uu___14 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt - uu___14 + FStarC_Util.bind_opt uu___14 (fun a15 -> let uu___15 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a21 -> let uu___16 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a31 -> let uu___17 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a41 -> let uu___18 = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a51 -> @@ -8758,7 +8704,7 @@ let mk_total_interpretation_14 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a61 -> @@ -8766,7 +8712,7 @@ let mk_total_interpretation_14 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a71 -> @@ -8774,7 +8720,7 @@ let mk_total_interpretation_14 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a81 -> @@ -8782,7 +8728,7 @@ let mk_total_interpretation_14 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a91 -> @@ -8791,7 +8737,7 @@ let mk_total_interpretation_14 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a101 -> @@ -8800,7 +8746,7 @@ let mk_total_interpretation_14 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a111 -> @@ -8809,7 +8755,7 @@ let mk_total_interpretation_14 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a121 -> @@ -8818,7 +8764,7 @@ let mk_total_interpretation_14 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a131 -> @@ -8827,7 +8773,7 @@ let mk_total_interpretation_14 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a141 -> @@ -8938,25 +8884,25 @@ let mk_total_interpretation_15 : (a15, uu___14)::[] -> let uu___15 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a16 -> let uu___16 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a21 -> let uu___17 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a31 -> let uu___18 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a41 -> @@ -8964,7 +8910,7 @@ let mk_total_interpretation_15 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a51 -> @@ -8972,7 +8918,7 @@ let mk_total_interpretation_15 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a61 -> @@ -8980,7 +8926,7 @@ let mk_total_interpretation_15 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a71 -> @@ -8988,7 +8934,7 @@ let mk_total_interpretation_15 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a81 -> @@ -8996,7 +8942,7 @@ let mk_total_interpretation_15 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a91 -> @@ -9005,7 +8951,7 @@ let mk_total_interpretation_15 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a101 -> @@ -9014,7 +8960,7 @@ let mk_total_interpretation_15 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a111 -> @@ -9023,7 +8969,7 @@ let mk_total_interpretation_15 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a121 -> @@ -9032,7 +8978,7 @@ let mk_total_interpretation_15 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a131 -> @@ -9041,7 +8987,7 @@ let mk_total_interpretation_15 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a141 -> @@ -9050,7 +8996,7 @@ let mk_total_interpretation_15 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a151 -> @@ -9174,25 +9120,25 @@ let mk_total_interpretation_16 : -> let uu___16 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a17 -> let uu___17 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a21 -> let uu___18 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a31 -> let uu___19 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a41 -> @@ -9200,7 +9146,7 @@ let mk_total_interpretation_16 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a51 -> @@ -9208,7 +9154,7 @@ let mk_total_interpretation_16 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a61 -> @@ -9216,7 +9162,7 @@ let mk_total_interpretation_16 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a71 -> @@ -9224,7 +9170,7 @@ let mk_total_interpretation_16 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a81 -> @@ -9232,7 +9178,7 @@ let mk_total_interpretation_16 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a91 -> @@ -9241,7 +9187,7 @@ let mk_total_interpretation_16 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a101 -> @@ -9250,7 +9196,7 @@ let mk_total_interpretation_16 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a111 -> @@ -9259,7 +9205,7 @@ let mk_total_interpretation_16 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a121 -> @@ -9268,7 +9214,7 @@ let mk_total_interpretation_16 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a131 -> @@ -9277,7 +9223,7 @@ let mk_total_interpretation_16 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a141 -> @@ -9286,7 +9232,7 @@ let mk_total_interpretation_16 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a151 -> @@ -9295,7 +9241,7 @@ let mk_total_interpretation_16 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a161 -> @@ -9427,26 +9373,26 @@ let mk_total_interpretation_17 : (a17, uu___16)::[] -> let uu___17 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a18 -> let uu___18 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a21 -> let uu___19 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a31 -> let uu___20 = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a41 -> @@ -9454,7 +9400,7 @@ let mk_total_interpretation_17 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a51 -> @@ -9462,7 +9408,7 @@ let mk_total_interpretation_17 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a61 -> @@ -9470,7 +9416,7 @@ let mk_total_interpretation_17 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a71 -> @@ -9478,7 +9424,7 @@ let mk_total_interpretation_17 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a81 -> @@ -9486,7 +9432,7 @@ let mk_total_interpretation_17 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a91 -> @@ -9495,7 +9441,7 @@ let mk_total_interpretation_17 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a101 -> @@ -9504,7 +9450,7 @@ let mk_total_interpretation_17 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a111 -> @@ -9513,7 +9459,7 @@ let mk_total_interpretation_17 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a121 -> @@ -9522,7 +9468,7 @@ let mk_total_interpretation_17 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a131 -> @@ -9531,7 +9477,7 @@ let mk_total_interpretation_17 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a141 -> @@ -9540,7 +9486,7 @@ let mk_total_interpretation_17 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a151 -> @@ -9549,7 +9495,7 @@ let mk_total_interpretation_17 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a161 -> @@ -9558,7 +9504,7 @@ let mk_total_interpretation_17 : unembed e17 a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a171 -> @@ -9698,20 +9644,20 @@ let mk_total_interpretation_18 : (a18, uu___17)::[] -> let uu___18 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a19 -> let uu___19 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a21 -> let uu___20 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 ( fun a31 @@ -9720,7 +9666,7 @@ let mk_total_interpretation_18 : = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a41 -> @@ -9728,7 +9674,7 @@ let mk_total_interpretation_18 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a51 -> @@ -9736,7 +9682,7 @@ let mk_total_interpretation_18 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a61 -> @@ -9744,7 +9690,7 @@ let mk_total_interpretation_18 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a71 -> @@ -9752,7 +9698,7 @@ let mk_total_interpretation_18 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a81 -> @@ -9760,7 +9706,7 @@ let mk_total_interpretation_18 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a91 -> @@ -9769,7 +9715,7 @@ let mk_total_interpretation_18 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a101 -> @@ -9778,7 +9724,7 @@ let mk_total_interpretation_18 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a111 -> @@ -9787,7 +9733,7 @@ let mk_total_interpretation_18 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a121 -> @@ -9796,7 +9742,7 @@ let mk_total_interpretation_18 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a131 -> @@ -9805,7 +9751,7 @@ let mk_total_interpretation_18 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a141 -> @@ -9814,7 +9760,7 @@ let mk_total_interpretation_18 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a151 -> @@ -9823,7 +9769,7 @@ let mk_total_interpretation_18 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a161 -> @@ -9832,7 +9778,7 @@ let mk_total_interpretation_18 : unembed e17 a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a171 -> @@ -9841,7 +9787,7 @@ let mk_total_interpretation_18 : unembed e18 a18 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a181 -> @@ -9988,20 +9934,20 @@ let mk_total_interpretation_19 : -> let uu___19 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a110 -> let uu___20 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a21 -> let uu___21 = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a31 -> @@ -10009,7 +9955,7 @@ let mk_total_interpretation_19 : = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a41 -> @@ -10017,7 +9963,7 @@ let mk_total_interpretation_19 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a51 -> @@ -10025,7 +9971,7 @@ let mk_total_interpretation_19 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a61 -> @@ -10033,7 +9979,7 @@ let mk_total_interpretation_19 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a71 -> @@ -10041,7 +9987,7 @@ let mk_total_interpretation_19 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a81 -> @@ -10049,7 +9995,7 @@ let mk_total_interpretation_19 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a91 -> @@ -10058,7 +10004,7 @@ let mk_total_interpretation_19 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a101 -> @@ -10067,7 +10013,7 @@ let mk_total_interpretation_19 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a111 -> @@ -10076,7 +10022,7 @@ let mk_total_interpretation_19 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a121 -> @@ -10085,7 +10031,7 @@ let mk_total_interpretation_19 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a131 -> @@ -10094,7 +10040,7 @@ let mk_total_interpretation_19 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a141 -> @@ -10103,7 +10049,7 @@ let mk_total_interpretation_19 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a151 -> @@ -10112,7 +10058,7 @@ let mk_total_interpretation_19 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a161 -> @@ -10121,7 +10067,7 @@ let mk_total_interpretation_19 : unembed e17 a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a171 -> @@ -10130,7 +10076,7 @@ let mk_total_interpretation_19 : unembed e18 a18 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a181 -> @@ -10139,7 +10085,7 @@ let mk_total_interpretation_19 : unembed e19 a19 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun a191 -> @@ -10295,14 +10241,14 @@ let mk_total_interpretation_20 : let uu___20 = unembed e1 a1 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a110 -> let uu___21 = unembed e2 a2 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a21 -> @@ -10310,7 +10256,7 @@ let mk_total_interpretation_20 : = unembed e3 a3 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a31 -> @@ -10318,7 +10264,7 @@ let mk_total_interpretation_20 : = unembed e4 a4 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a41 -> @@ -10326,7 +10272,7 @@ let mk_total_interpretation_20 : = unembed e5 a5 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a51 -> @@ -10334,7 +10280,7 @@ let mk_total_interpretation_20 : = unembed e6 a6 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a61 -> @@ -10342,7 +10288,7 @@ let mk_total_interpretation_20 : = unembed e7 a7 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a71 -> @@ -10350,7 +10296,7 @@ let mk_total_interpretation_20 : = unembed e8 a8 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a81 -> @@ -10358,7 +10304,7 @@ let mk_total_interpretation_20 : = unembed e9 a9 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a91 -> @@ -10367,7 +10313,7 @@ let mk_total_interpretation_20 : unembed e10 a10 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a101 -> @@ -10376,7 +10322,7 @@ let mk_total_interpretation_20 : unembed e11 a11 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a111 -> @@ -10385,7 +10331,7 @@ let mk_total_interpretation_20 : unembed e12 a12 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a121 -> @@ -10394,7 +10340,7 @@ let mk_total_interpretation_20 : unembed e13 a13 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a131 -> @@ -10403,7 +10349,7 @@ let mk_total_interpretation_20 : unembed e14 a14 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a141 -> @@ -10412,7 +10358,7 @@ let mk_total_interpretation_20 : unembed e15 a15 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a151 -> @@ -10421,7 +10367,7 @@ let mk_total_interpretation_20 : unembed e16 a16 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a161 -> @@ -10430,7 +10376,7 @@ let mk_total_interpretation_20 : unembed e17 a17 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a171 -> @@ -10439,7 +10385,7 @@ let mk_total_interpretation_20 : unembed e18 a18 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun a181 -> @@ -10448,7 +10394,7 @@ let mk_total_interpretation_20 : unembed e19 a19 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___38 (fun a191 -> @@ -10457,7 +10403,7 @@ let mk_total_interpretation_20 : unembed e20 a20 ncb in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___39 (fun a201 -> @@ -10512,7 +10458,7 @@ let mk_total_nbe_interpretation_1 : match args with | (a1, uu___)::[] -> let uu___1 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun a11 -> let r1 = interp_ctx name (fun uu___2 -> f a11) in let uu___2 = @@ -10544,11 +10490,11 @@ let mk_total_nbe_interpretation_2 : | (a1, uu___)::(a2, uu___1)::[] -> let uu___2 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun a11 -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun a21 -> let r1 = interp_ctx name (fun uu___4 -> f a11 a21) in @@ -10583,16 +10529,16 @@ let mk_total_nbe_interpretation_3 : | (a1, uu___)::(a2, uu___1)::(a3, uu___2)::[] -> let uu___3 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun a11 -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a21 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a31 -> let r1 = interp_ctx name @@ -10632,21 +10578,21 @@ let mk_total_nbe_interpretation_4 : -> let uu___4 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun a11 -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a21 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a31 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a41 -> let r1 = interp_ctx name @@ -10691,29 +10637,27 @@ let mk_total_nbe_interpretation_5 : (a5, uu___4)::[] -> let uu___5 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun a11 -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a21 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a31 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt - uu___8 + FStarC_Util.bind_opt uu___8 (fun a41 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a51 -> let r1 = interp_ctx name @@ -10760,34 +10704,33 @@ let mk_total_nbe_interpretation_6 : (a4, uu___3)::(a5, uu___4)::(a6, uu___5)::[] -> let uu___6 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun a11 -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a21 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a31 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a41 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___10 (fun a51 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun a61 -> let r1 = @@ -10840,41 +10783,39 @@ let mk_total_nbe_interpretation_7 : (a7, uu___6)::[] -> let uu___7 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun a11 -> let uu___8 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a21 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt - uu___9 + FStarC_Util.bind_opt uu___9 (fun a31 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a41 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___11 (fun a51 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a61 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a71 -> let r1 = @@ -10934,48 +10875,46 @@ let mk_total_nbe_interpretation_8 : let uu___8 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___8 + FStarC_Util.bind_opt uu___8 (fun a11 -> let uu___9 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a21 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a31 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a41 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a51 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a61 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a71 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a81 -> @@ -11040,43 +10979,41 @@ let mk_total_nbe_interpretation_9 : let uu___9 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___9 + FStarC_Util.bind_opt uu___9 (fun a11 -> let uu___10 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___10 + FStarC_Util.bind_opt uu___10 (fun a21 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a31 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___12 (fun a41 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a51 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a61 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 ( fun a71 @@ -11085,7 +11022,7 @@ let mk_total_nbe_interpretation_9 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a81 -> @@ -11093,7 +11030,7 @@ let mk_total_nbe_interpretation_9 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a91 -> @@ -11164,43 +11101,41 @@ let mk_total_nbe_interpretation_10 : let uu___10 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___10 + FStarC_Util.bind_opt uu___10 (fun a11 -> let uu___11 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___11 + FStarC_Util.bind_opt uu___11 (fun a21 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a31 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a41 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a51 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a61 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a71 -> @@ -11208,7 +11143,7 @@ let mk_total_nbe_interpretation_10 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a81 -> @@ -11216,7 +11151,7 @@ let mk_total_nbe_interpretation_10 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a91 -> @@ -11225,7 +11160,7 @@ let mk_total_nbe_interpretation_10 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a101 -> @@ -11300,37 +11235,36 @@ let mk_total_nbe_interpretation_11 : let uu___11 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt uu___11 + FStarC_Util.bind_opt uu___11 (fun a12 -> let uu___12 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a21 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___13 (fun a31 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a41 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a51 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a61 -> @@ -11338,7 +11272,7 @@ let mk_total_nbe_interpretation_11 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a71 -> @@ -11346,7 +11280,7 @@ let mk_total_nbe_interpretation_11 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a81 -> @@ -11354,7 +11288,7 @@ let mk_total_nbe_interpretation_11 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a91 -> @@ -11363,7 +11297,7 @@ let mk_total_nbe_interpretation_11 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a101 -> @@ -11372,7 +11306,7 @@ let mk_total_nbe_interpretation_11 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a111 -> @@ -11453,38 +11387,36 @@ let mk_total_nbe_interpretation_12 : let uu___12 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt - uu___12 + FStarC_Util.bind_opt uu___12 (fun a13 -> let uu___13 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a21 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___14 (fun a31 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a41 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a51 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a61 -> @@ -11492,7 +11424,7 @@ let mk_total_nbe_interpretation_12 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a71 -> @@ -11500,7 +11432,7 @@ let mk_total_nbe_interpretation_12 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a81 -> @@ -11508,7 +11440,7 @@ let mk_total_nbe_interpretation_12 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a91 -> @@ -11517,7 +11449,7 @@ let mk_total_nbe_interpretation_12 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a101 -> @@ -11526,7 +11458,7 @@ let mk_total_nbe_interpretation_12 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a111 -> @@ -11535,7 +11467,7 @@ let mk_total_nbe_interpretation_12 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a121 -> @@ -11621,38 +11553,36 @@ let mk_total_nbe_interpretation_13 : let uu___13 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt - uu___13 + FStarC_Util.bind_opt uu___13 (fun a14 -> let uu___14 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt - uu___14 + FStarC_Util.bind_opt uu___14 (fun a21 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a31 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a41 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a51 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a61 -> @@ -11660,7 +11590,7 @@ let mk_total_nbe_interpretation_13 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a71 -> @@ -11668,7 +11598,7 @@ let mk_total_nbe_interpretation_13 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a81 -> @@ -11676,7 +11606,7 @@ let mk_total_nbe_interpretation_13 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a91 -> @@ -11685,7 +11615,7 @@ let mk_total_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a101 -> @@ -11694,7 +11624,7 @@ let mk_total_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a111 -> @@ -11703,7 +11633,7 @@ let mk_total_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a121 -> @@ -11712,7 +11642,7 @@ let mk_total_nbe_interpretation_13 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a131 -> @@ -11806,32 +11736,31 @@ let mk_total_nbe_interpretation_14 : let uu___14 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt - uu___14 + FStarC_Util.bind_opt uu___14 (fun a15 -> let uu___15 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___15 (fun a21 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a31 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a41 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 ( fun a51 @@ -11840,7 +11769,7 @@ let mk_total_nbe_interpretation_14 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a61 -> @@ -11848,7 +11777,7 @@ let mk_total_nbe_interpretation_14 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a71 -> @@ -11856,7 +11785,7 @@ let mk_total_nbe_interpretation_14 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a81 -> @@ -11864,7 +11793,7 @@ let mk_total_nbe_interpretation_14 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a91 -> @@ -11873,7 +11802,7 @@ let mk_total_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a101 -> @@ -11882,7 +11811,7 @@ let mk_total_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a111 -> @@ -11891,7 +11820,7 @@ let mk_total_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a121 -> @@ -11900,7 +11829,7 @@ let mk_total_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a131 -> @@ -11909,7 +11838,7 @@ let mk_total_nbe_interpretation_14 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a141 -> @@ -12012,32 +11941,31 @@ let mk_total_nbe_interpretation_15 : let uu___15 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt - uu___15 + FStarC_Util.bind_opt uu___15 (fun a16 -> let uu___16 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a21 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a31 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a41 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a51 -> @@ -12045,7 +11973,7 @@ let mk_total_nbe_interpretation_15 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a61 -> @@ -12053,7 +11981,7 @@ let mk_total_nbe_interpretation_15 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a71 -> @@ -12061,7 +11989,7 @@ let mk_total_nbe_interpretation_15 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a81 -> @@ -12069,7 +11997,7 @@ let mk_total_nbe_interpretation_15 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a91 -> @@ -12078,7 +12006,7 @@ let mk_total_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a101 -> @@ -12087,7 +12015,7 @@ let mk_total_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a111 -> @@ -12096,7 +12024,7 @@ let mk_total_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a121 -> @@ -12105,7 +12033,7 @@ let mk_total_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a131 -> @@ -12114,7 +12042,7 @@ let mk_total_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a141 -> @@ -12123,7 +12051,7 @@ let mk_total_nbe_interpretation_15 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a151 -> @@ -12235,26 +12163,26 @@ let mk_total_nbe_interpretation_16 : let uu___16 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___16 (fun a17 -> let uu___17 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a21 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a31 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a41 -> @@ -12262,7 +12190,7 @@ let mk_total_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a51 -> @@ -12270,7 +12198,7 @@ let mk_total_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a61 -> @@ -12278,7 +12206,7 @@ let mk_total_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a71 -> @@ -12286,7 +12214,7 @@ let mk_total_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a81 -> @@ -12294,7 +12222,7 @@ let mk_total_nbe_interpretation_16 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a91 -> @@ -12303,7 +12231,7 @@ let mk_total_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a101 -> @@ -12312,7 +12240,7 @@ let mk_total_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a111 -> @@ -12321,7 +12249,7 @@ let mk_total_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a121 -> @@ -12330,7 +12258,7 @@ let mk_total_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a131 -> @@ -12339,7 +12267,7 @@ let mk_total_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a141 -> @@ -12348,7 +12276,7 @@ let mk_total_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a151 -> @@ -12357,7 +12285,7 @@ let mk_total_nbe_interpretation_16 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a161 -> @@ -12480,26 +12408,26 @@ let mk_total_nbe_interpretation_17 : let uu___17 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___17 (fun a18 -> let uu___18 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a21 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a31 -> let uu___20 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a41 -> @@ -12507,7 +12435,7 @@ let mk_total_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a51 -> @@ -12515,7 +12443,7 @@ let mk_total_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a61 -> @@ -12523,7 +12451,7 @@ let mk_total_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a71 -> @@ -12531,7 +12459,7 @@ let mk_total_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a81 -> @@ -12539,7 +12467,7 @@ let mk_total_nbe_interpretation_17 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a91 -> @@ -12548,7 +12476,7 @@ let mk_total_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a101 -> @@ -12557,7 +12485,7 @@ let mk_total_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a111 -> @@ -12566,7 +12494,7 @@ let mk_total_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a121 -> @@ -12575,7 +12503,7 @@ let mk_total_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a131 -> @@ -12584,7 +12512,7 @@ let mk_total_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a141 -> @@ -12593,7 +12521,7 @@ let mk_total_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a151 -> @@ -12602,7 +12530,7 @@ let mk_total_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a161 -> @@ -12611,7 +12539,7 @@ let mk_total_nbe_interpretation_17 : FStarC_TypeChecker_NBETerm.unembed e17 cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a171 -> @@ -12741,26 +12669,26 @@ let mk_total_nbe_interpretation_18 : let uu___18 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___18 (fun a19 -> let uu___19 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a21 -> let uu___20 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a31 -> let uu___21 = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a41 -> @@ -12768,7 +12696,7 @@ let mk_total_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a51 -> @@ -12776,7 +12704,7 @@ let mk_total_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a61 -> @@ -12784,7 +12712,7 @@ let mk_total_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a71 -> @@ -12792,7 +12720,7 @@ let mk_total_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a81 -> @@ -12800,7 +12728,7 @@ let mk_total_nbe_interpretation_18 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a91 -> @@ -12809,7 +12737,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a101 -> @@ -12818,7 +12746,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a111 -> @@ -12827,7 +12755,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a121 -> @@ -12836,7 +12764,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a131 -> @@ -12845,7 +12773,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a141 -> @@ -12854,7 +12782,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a151 -> @@ -12863,7 +12791,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a161 -> @@ -12872,7 +12800,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e17 cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a171 -> @@ -12881,7 +12809,7 @@ let mk_total_nbe_interpretation_18 : FStarC_TypeChecker_NBETerm.unembed e18 cb a18 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a181 -> @@ -13019,20 +12947,20 @@ let mk_total_nbe_interpretation_19 : let uu___19 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___19 (fun a110 -> let uu___20 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a21 -> let uu___21 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 ( fun a31 @@ -13041,7 +12969,7 @@ let mk_total_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a41 -> @@ -13049,7 +12977,7 @@ let mk_total_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a51 -> @@ -13057,7 +12985,7 @@ let mk_total_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a61 -> @@ -13065,7 +12993,7 @@ let mk_total_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a71 -> @@ -13073,7 +13001,7 @@ let mk_total_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a81 -> @@ -13081,7 +13009,7 @@ let mk_total_nbe_interpretation_19 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a91 -> @@ -13090,7 +13018,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a101 -> @@ -13099,7 +13027,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a111 -> @@ -13108,7 +13036,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a121 -> @@ -13117,7 +13045,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a131 -> @@ -13126,7 +13054,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a141 -> @@ -13135,7 +13063,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a151 -> @@ -13144,7 +13072,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a161 -> @@ -13153,7 +13081,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e17 cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a171 -> @@ -13162,7 +13090,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e18 cb a18 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a181 -> @@ -13171,7 +13099,7 @@ let mk_total_nbe_interpretation_19 : FStarC_TypeChecker_NBETerm.unembed e19 cb a19 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun a191 -> @@ -13317,20 +13245,20 @@ let mk_total_nbe_interpretation_20 : let uu___20 = FStarC_TypeChecker_NBETerm.unembed e1 cb a1 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___20 (fun a110 -> let uu___21 = FStarC_TypeChecker_NBETerm.unembed e2 cb a2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___21 (fun a21 -> let uu___22 = FStarC_TypeChecker_NBETerm.unembed e3 cb a3 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___22 (fun a31 -> @@ -13338,7 +13266,7 @@ let mk_total_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e4 cb a4 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun a41 -> @@ -13346,7 +13274,7 @@ let mk_total_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e5 cb a5 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___24 (fun a51 -> @@ -13354,7 +13282,7 @@ let mk_total_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e6 cb a6 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___25 (fun a61 -> @@ -13362,7 +13290,7 @@ let mk_total_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e7 cb a7 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___26 (fun a71 -> @@ -13370,7 +13298,7 @@ let mk_total_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e8 cb a8 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___27 (fun a81 -> @@ -13378,7 +13306,7 @@ let mk_total_nbe_interpretation_20 : = FStarC_TypeChecker_NBETerm.unembed e9 cb a9 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___28 (fun a91 -> @@ -13387,7 +13315,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e10 cb a10 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___29 (fun a101 -> @@ -13396,7 +13324,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e11 cb a11 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___30 (fun a111 -> @@ -13405,7 +13333,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e12 cb a12 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___31 (fun a121 -> @@ -13414,7 +13342,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e13 cb a13 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___32 (fun a131 -> @@ -13423,7 +13351,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e14 cb a14 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___33 (fun a141 -> @@ -13432,7 +13360,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e15 cb a15 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___34 (fun a151 -> @@ -13441,7 +13369,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e16 cb a16 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___35 (fun a161 -> @@ -13450,7 +13378,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e17 cb a17 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___36 (fun a171 -> @@ -13459,7 +13387,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e18 cb a18 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___37 (fun a181 -> @@ -13468,7 +13396,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e19 cb a19 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___38 (fun a191 -> @@ -13477,7 +13405,7 @@ let mk_total_nbe_interpretation_20 : FStarC_TypeChecker_NBETerm.unembed e20 cb a20 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___39 (fun a201 -> diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_Interpreter.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Interpreter.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Tactics_Interpreter.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Interpreter.ml index e2841a689a4..faf58a34a48 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_Interpreter.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Interpreter.ml @@ -1,11 +1,10 @@ open Prims -let (dbg_Tac : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Tac" +let (dbg_Tac : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Tac" let solve : 'a . 'a -> 'a = fun ev -> ev let embed : 'a . 'a FStarC_Syntax_Embeddings_Base.embedding -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> 'a -> FStarC_Syntax_Embeddings_Base.norm_cb -> FStarC_Syntax_Syntax.term = @@ -50,24 +49,22 @@ let (native_tactics_steps : s.FStarC_Tactics_Native.name) } in let uu___1 = FStarC_Tactics_Native.list_all () in - FStarC_Compiler_List.map step_from_native_step uu___1 + FStarC_List.map step_from_native_step uu___1 let (__primitive_steps_ref : - FStarC_TypeChecker_Primops_Base.primitive_step Prims.list - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref [] + FStarC_TypeChecker_Primops_Base.primitive_step Prims.list FStarC_Effect.ref) + = FStarC_Util.mk_ref [] let (primitive_steps : unit -> FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = fun uu___ -> let uu___1 = native_tactics_steps () in - let uu___2 = FStarC_Compiler_Effect.op_Bang __primitive_steps_ref in - FStarC_Compiler_List.op_At uu___1 uu___2 + let uu___2 = FStarC_Effect.op_Bang __primitive_steps_ref in + FStarC_List.op_At uu___1 uu___2 let (register_tactic_primitive_step : FStarC_TypeChecker_Primops_Base.primitive_step -> unit) = fun s -> let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang __primitive_steps_ref in s - :: uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals __primitive_steps_ref uu___ + let uu___1 = FStarC_Effect.op_Bang __primitive_steps_ref in s :: uu___1 in + FStarC_Effect.op_Colon_Equals __primitive_steps_ref uu___ let rec (t_head_of : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun t -> @@ -367,7 +364,7 @@ let unembed_tactic_1 : fun f -> fun ncb -> fun x -> - let rng = FStarC_Compiler_Range_Type.dummyRange in + let rng = FStarC_Range_Type.dummyRange in let x_tm = embed ea rng x ncb in let app = let uu___ = @@ -492,7 +489,7 @@ let unembed_tactic_1_alt : fun ncb -> FStar_Pervasives_Native.Some (fun x -> - let rng = FStarC_Compiler_Range_Type.dummyRange in + let rng = FStarC_Range_Type.dummyRange in let x_tm = embed ea rng x ncb in let app = let uu___ = @@ -523,12 +520,11 @@ let e_tactic_1_alt : FStarC_Syntax_Embeddings_Base.term_as_fv FStarC_Syntax_Syntax.t_unit in FStarC_Syntax_Embeddings_Base.mk_emb em un uu___ let (report_implicits : - FStarC_Compiler_Range_Type.range -> - FStarC_TypeChecker_Rel.tagged_implicits -> unit) + FStarC_Range_Type.range -> FStarC_TypeChecker_Rel.tagged_implicits -> unit) = fun rng -> fun is -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___1 -> match uu___1 with | (imp, tag) -> @@ -655,8 +651,8 @@ let (report_implicits : FStarC_Errors.stop_if_err () let run_unembedded_tactic_on_ps : 'a 'b . - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> 'a -> ('a -> 'b FStarC_Tactics_Monad.tac) -> @@ -955,29 +951,27 @@ let run_unembedded_tactic_on_ps : let uu___2 = tau arg in FStarC_Tactics_Monad.run_safe uu___2 ps2) uu___ "FStarC.Tactics.Interpreter.run_safe" in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Tac in - if uu___1 then FStarC_Compiler_Util.print_string "}\n" else ()); + (let uu___1 = FStarC_Effect.op_Bang dbg_Tac in + if uu___1 then FStarC_Util.print_string "}\n" else ()); (match res with | FStarC_Tactics_Result.Success (ret, ps3) -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Tac in + ((let uu___2 = FStarC_Effect.op_Bang dbg_Tac in if uu___2 then FStarC_Tactics_Printing.do_dump_proofstate ps3 "at the finish line" else ()); (let remaining_smt_goals = - FStarC_Compiler_List.op_At - ps3.FStarC_Tactics_Types.goals + FStarC_List.op_At ps3.FStarC_Tactics_Types.goals ps3.FStarC_Tactics_Types.smt_goals in - FStarC_Compiler_List.iter + FStarC_List.iter (fun g -> FStarC_Tactics_Monad.mark_goal_implicit_already_checked g; (let uu___4 = FStarC_Tactics_Monad.is_irrelevant g in if uu___4 then - ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Tac in if uu___6 then let uu___7 = @@ -985,7 +979,7 @@ let run_unembedded_tactic_on_ps : FStarC_Tactics_Types.goal_witness g in FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___8 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Assigning irrelevant goal %s\n" uu___7 else ()); (let uu___6 = @@ -1004,7 +998,7 @@ let run_unembedded_tactic_on_ps : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___10 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Irrelevant tactic witness does not unify with (): %s" uu___9 in failwith uu___8))) @@ -1012,8 +1006,7 @@ let run_unembedded_tactic_on_ps : FStarC_Errors.with_ctx "While checking implicits left by a tactic" (fun uu___4 -> - (let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + (let uu___6 = FStarC_Effect.op_Bang dbg_Tac in if uu___6 then let uu___7 = @@ -1023,13 +1016,13 @@ let run_unembedded_tactic_on_ps : FStarC_Syntax_Print.showable_ctxu imp.FStarC_TypeChecker_Common.imp_uvar) ps3.FStarC_Tactics_Types.all_implicits in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "About to check tactic implicits: %s\n" uu___7 else ()); (let g = let uu___6 = FStarC_Class_Listlike.from_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) ps3.FStarC_Tactics_Types.all_implicits in { FStarC_TypeChecker_Common.guard_f = @@ -1045,42 +1038,40 @@ let run_unembedded_tactic_on_ps : let g1 = FStarC_TypeChecker_Rel.solve_deferred_constraints env g in - (let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + (let uu___7 = FStarC_Effect.op_Bang dbg_Tac in if uu___7 then let uu___8 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length + (FStarC_List.length ps3.FStarC_Tactics_Types.all_implicits) in let uu___9 = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_TypeChecker_Common.showable_implicit) ps3.FStarC_Tactics_Types.all_implicits in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Checked %s implicits (1): %s\n" uu___8 uu___9 else ()); (let tagged_implicits = FStarC_TypeChecker_Rel.resolve_implicits_tac env g1 in - (let uu___8 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + (let uu___8 = FStarC_Effect.op_Bang dbg_Tac in if uu___8 then let uu___9 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length + (FStarC_List.length ps3.FStarC_Tactics_Types.all_implicits) in let uu___10 = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_TypeChecker_Common.showable_implicit) ps3.FStarC_Tactics_Types.all_implicits in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Checked %s implicits (2): %s\n" uu___9 uu___10 else ()); @@ -1091,8 +1082,29 @@ let run_unembedded_tactic_on_ps : let msg1 = let uu___1 = FStarC_Pprint.doc_of_string "Tactic failed" in uu___1 :: msg in - FStarC_Compiler_Effect.raise + FStarC_Effect.raise (FStarC_Errors.Error (code, msg1, rng, ctx)) + | FStarC_Tactics_Result.Failed (FStarC_Errors.Stop, ps3) -> + let uu___1 = + let uu___2 = FStarC_Errors.get_err_count () in + uu___2 > Prims.int_zero in + if uu___1 + then FStarC_Effect.raise FStarC_Errors.Stop + else + (let uu___3 = + let uu___4 = + FStarC_Errors_Msg.text + "A tactic raised the Stop exception but did not log errors." in + let uu___5 = + let uu___6 = + FStarC_Errors_Msg.text "Failing anyway." in + [uu___6] in + uu___4 :: uu___5 in + FStarC_Errors.raise_error0 + FStarC_Errors_Codes.Fatal_UserTacticFailure () + (Obj.magic + FStarC_Errors_Msg.is_error_message_list_doc) + (Obj.magic uu___3)) | FStarC_Tactics_Result.Failed (e, ps3) -> (if ps3.FStarC_Tactics_Types.dump_on_failure then @@ -1113,7 +1125,7 @@ let run_unembedded_tactic_on_ps : FStarC_Pprint.doc_of_string uu___4 in [uu___3] in (uu___2, FStar_Pervasives_Native.None) - | e2 -> FStarC_Compiler_Effect.raise e2 in + | e2 -> FStarC_Effect.raise e2 in let uu___2 = texn_to_doc e in match uu___2 with | (doc, rng) -> @@ -1137,7 +1149,7 @@ let run_unembedded_tactic_on_ps : FStarC_Pprint.doc_of_string "Tactic failed" in [uu___5] else [] in - FStarC_Compiler_List.op_At uu___4 doc in + FStarC_List.op_At uu___4 doc in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range rng1 FStarC_Errors_Codes.Fatal_UserTacticFailure () @@ -1146,8 +1158,8 @@ let run_unembedded_tactic_on_ps : (Obj.magic uu___3)))) let run_tactic_on_ps' : 'a 'b . - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> 'a FStarC_Syntax_Embeddings_Base.embedding -> 'a -> @@ -1167,7 +1179,7 @@ let run_tactic_on_ps' : fun tactic_already_typed -> fun ps -> let env = ps.FStarC_Tactics_Types.main_context in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Tac in + (let uu___1 = FStarC_Effect.op_Bang dbg_Tac in if uu___1 then let uu___2 = @@ -1177,7 +1189,7 @@ let run_tactic_on_ps' : FStarC_Class_Show.show FStarC_Class_Show.showable_bool tactic_already_typed in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Typechecking tactic: (%s) (already_typed: %s) {\n" uu___2 uu___3 else ()); @@ -1193,10 +1205,8 @@ let run_tactic_on_ps' : FStarC_TypeChecker_TcTerm.tc_tactic uu___3 uu___4 env tactic in match uu___2 with | (uu___3, uu___4, g1) -> g1) in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Tac in - if uu___2 - then FStarC_Compiler_Util.print_string "}\n" - else ()); + (let uu___2 = FStarC_Effect.op_Bang dbg_Tac in + if uu___2 then FStarC_Util.print_string "}\n" else ()); FStarC_TypeChecker_Rel.force_trivial_guard env g; FStarC_Errors.stop_if_err (); (let tau = @@ -1206,8 +1216,8 @@ let run_tactic_on_ps' : background arg tau ps)) let run_tactic_on_ps : 'a 'b . - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> 'a FStarC_Syntax_Embeddings_Base.embedding -> 'a -> diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_Monad.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Monad.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Tactics_Monad.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Monad.ml index a9f18c8829c..efc101bf756 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_Monad.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Monad.ml @@ -1,26 +1,26 @@ open Prims -let (dbg_Core : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Core" -let (dbg_CoreEq : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "CoreEq" -let (dbg_RegisterGoal : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "RegisterGoal" -let (dbg_TacFail : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "TacFail" -let (goal_ctr : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero +let (dbg_Core : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Core" +let (dbg_CoreEq : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "CoreEq" +let (dbg_RegisterGoal : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "RegisterGoal" +let (dbg_TacFail : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "TacFail" +let (goal_ctr : Prims.int FStarC_Effect.ref) = + FStarC_Util.mk_ref Prims.int_zero let (get_goal_ctr : unit -> Prims.int) = - fun uu___ -> FStarC_Compiler_Effect.op_Bang goal_ctr + fun uu___ -> FStarC_Effect.op_Bang goal_ctr let (incr_goal_ctr : unit -> Prims.int) = fun uu___ -> - let v = FStarC_Compiler_Effect.op_Bang goal_ctr in - FStarC_Compiler_Effect.op_Colon_Equals goal_ctr (v + Prims.int_one); v + let v = FStarC_Effect.op_Bang goal_ctr in + FStarC_Effect.op_Colon_Equals goal_ctr (v + Prims.int_one); v let (is_goal_safe_as_well_typed : FStarC_Tactics_Types.goal -> Prims.bool) = fun g -> let uv = g.FStarC_Tactics_Types.goal_ctx_uvar in let all_deps_resolved = let uu___ = FStarC_Syntax_Util.ctx_uvar_typedness_deps uv in - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uv1 -> let uu___1 = FStarC_Syntax_Unionfind.find @@ -30,7 +30,7 @@ let (is_goal_safe_as_well_typed : FStarC_Tactics_Types.goal -> Prims.bool) = let uu___2 = FStarC_Syntax_Free.uvars t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) | uu___2 -> false) uu___ in all_deps_resolved @@ -165,31 +165,31 @@ let (register_goal : FStarC_Tactics_Types.goal -> unit) = FStarC_TypeChecker_Env.missing_decl = (env.FStarC_TypeChecker_Env.missing_decl) } in - (let uu___7 = FStarC_Compiler_Effect.op_Bang dbg_CoreEq in + (let uu___7 = FStarC_Effect.op_Bang dbg_CoreEq in if uu___7 then let uu___8 = FStarC_Class_Show.show FStarC_Class_Show.showable_int i in - FStarC_Compiler_Util.print1 "(%s) Registering goal\n" uu___8 + FStarC_Util.print1 "(%s) Registering goal\n" uu___8 else ()); (let should_register = is_goal_safe_as_well_typed g in if Prims.op_Negation should_register then let uu___8 = - (FStarC_Compiler_Effect.op_Bang dbg_Core) || - (FStarC_Compiler_Effect.op_Bang dbg_RegisterGoal) in + (FStarC_Effect.op_Bang dbg_Core) || + (FStarC_Effect.op_Bang dbg_RegisterGoal) in (if uu___8 then let uu___9 = FStarC_Class_Show.show FStarC_Class_Show.showable_int i in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(%s) Not registering goal since it has unresolved uvar deps\n" uu___9 else ()) else ((let uu___9 = - (FStarC_Compiler_Effect.op_Bang dbg_Core) || - (FStarC_Compiler_Effect.op_Bang dbg_RegisterGoal) in + (FStarC_Effect.op_Bang dbg_Core) || + (FStarC_Effect.op_Bang dbg_RegisterGoal) in if uu___9 then let uu___10 = @@ -197,8 +197,8 @@ let (register_goal : FStarC_Tactics_Types.goal -> unit) = let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_ctxu uv in - FStarC_Compiler_Util.print2 - "(%s) Registering goal for %s\n" uu___10 uu___11 + FStarC_Util.print2 "(%s) Registering goal for %s\n" + uu___10 uu___11 else ()); (let goal_ty = FStarC_Syntax_Util.ctx_uvar_typ uv in let uu___9 = @@ -214,7 +214,7 @@ let (register_goal : FStarC_Tactics_Types.goal -> unit) = FStarC_Syntax_Print.showable_term uu___11 in let uu___11 = FStarC_TypeChecker_Core.print_error_short err in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Failed to check initial tactic goal %s because %s" uu___10 uu___11 in FStarC_Errors.log_issue @@ -296,12 +296,12 @@ let fail_doc : 'a . FStarC_Errors_Msg.error_message -> 'a tac = fun msg -> mk_tac (fun ps -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_TacFail in + (let uu___1 = FStarC_Effect.op_Bang dbg_TacFail in if uu___1 then let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_List.hd msg in + let uu___4 = FStarC_List.hd msg in FStarC_Errors_Msg.renderdoc uu___4 in Prims.strcat "TACTIC FAILING: " uu___3 in FStarC_Tactics_Printing.do_dump_proofstate ps uu___2 @@ -318,7 +318,7 @@ let catch : 'a . 'a tac -> (Prims.exn, 'a) FStar_Pervasives.either tac = mk_tac (fun ps -> let idtable = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang (ps.FStarC_Tactics_Types.main_context).FStarC_TypeChecker_Env.identifier_info in let tx = FStarC_Syntax_Unionfind.new_transaction () in let uu___ = run t ps in @@ -328,7 +328,7 @@ let catch : 'a . 'a tac -> (Prims.exn, 'a) FStar_Pervasives.either tac = FStarC_Tactics_Result.Success ((FStar_Pervasives.Inr a1), q)) | FStarC_Tactics_Result.Failed (m, q) -> (FStarC_Syntax_Unionfind.rollback tx; - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals (ps.FStarC_Tactics_Types.main_context).FStarC_TypeChecker_Env.identifier_info idtable; (let ps1 = @@ -393,8 +393,7 @@ let trytac_exn : 'a . 'a tac -> 'a FStar_Pervasives_Native.option tac = (do_log ps (fun uu___5 -> let uu___6 = FStarC_Errors_Msg.rendermsg msg in - FStarC_Compiler_Util.print1 "trytac_exn error: (%s)" - uu___6); + FStarC_Util.print1 "trytac_exn error: (%s)" uu___6); FStarC_Tactics_Result.Success (FStar_Pervasives_Native.None, ps))) let rec iter_tac : 'a . ('a -> unit tac) -> 'a Prims.list -> unit tac = @@ -414,8 +413,7 @@ let (uu___is_Bad : Prims.exn -> Prims.bool) = fun projectee -> match projectee with | Bad uu___ -> true | uu___ -> false let (__proj__Bad__item__uu___ : Prims.exn -> Prims.string) = fun projectee -> match projectee with | Bad uu___ -> uu___ -let (nwarn : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero +let (nwarn : Prims.int FStarC_Effect.ref) = FStarC_Util.mk_ref Prims.int_zero let (check_valid_goal : FStarC_Tactics_Types.goal -> unit) = fun g -> let uu___ = FStarC_Options.defensive () in @@ -431,17 +429,13 @@ let (check_valid_goal : FStarC_Tactics_Types.goal -> unit) = let uu___5 = FStarC_Tactics_Types.goal_witness g in FStarC_TypeChecker_Env.closed env uu___5 in Prims.op_Negation uu___4 in - if uu___3 - then FStarC_Compiler_Effect.raise (Bad "witness") - else ()); + if uu___3 then FStarC_Effect.raise (Bad "witness") else ()); (let uu___4 = let uu___5 = let uu___6 = FStarC_Tactics_Types.goal_type g in FStarC_TypeChecker_Env.closed env uu___6 in Prims.op_Negation uu___5 in - if uu___4 - then FStarC_Compiler_Effect.raise (Bad "goal type") - else ()); + if uu___4 then FStarC_Effect.raise (Bad "goal type") else ()); (let rec aux e = let uu___4 = FStarC_TypeChecker_Env.pop_bv e in match uu___4 with @@ -461,14 +455,14 @@ let (check_valid_goal : FStarC_Tactics_Types.goal -> unit) = FStarC_Syntax_Print.showable_bv bv in Prims.strcat "bv: " uu___9 in Bad uu___8 in - FStarC_Compiler_Effect.raise uu___7 + FStarC_Effect.raise uu___7 else ()); aux e1) in aux env))) () with | Bad culprit -> let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang nwarn in + let uu___3 = FStarC_Effect.op_Bang nwarn in uu___3 < (Prims.of_int (5)) in (if uu___2 then @@ -476,7 +470,7 @@ let (check_valid_goal : FStarC_Tactics_Types.goal -> unit) = let uu___5 = let uu___6 = FStarC_Tactics_Printing.goal_to_string_verbose g in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "The following goal is ill-formed (%s). Keeping calm and carrying on...\n<%s>\n\n" culprit uu___6 in FStarC_Errors.log_issue @@ -485,15 +479,15 @@ let (check_valid_goal : FStarC_Tactics_Types.goal -> unit) = (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___5)); (let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang nwarn in + let uu___5 = FStarC_Effect.op_Bang nwarn in uu___5 + Prims.int_one in - FStarC_Compiler_Effect.op_Colon_Equals nwarn uu___4)) + FStarC_Effect.op_Colon_Equals nwarn uu___4)) else ()) else () let (check_valid_goals : FStarC_Tactics_Types.goal Prims.list -> unit) = fun gs -> let uu___ = FStarC_Options.defensive () in - if uu___ then FStarC_Compiler_List.iter check_valid_goal gs else () + if uu___ then FStarC_List.iter check_valid_goal gs else () let (set_goals : FStarC_Tactics_Types.goal Prims.list -> unit tac) = fun gs -> bind get @@ -574,7 +568,7 @@ let (cur_goal : FStarC_Tactics_Types.goal tac) = let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "!!!!!!!!!!!! GOAL IS ALREADY SOLVED! %s\nsol is %s\n" uu___3 uu___4); ret hd))) @@ -582,7 +576,7 @@ let (remove_solved_goals : unit tac) = bind cur_goals (fun gs -> let gs1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun g -> let uu___ = FStarC_Tactics_Types.check_goal_solved g in Prims.op_Negation uu___) gs in @@ -592,7 +586,7 @@ let (dismiss : unit tac) = bind get (fun ps -> let uu___ = - let uu___1 = FStarC_Compiler_List.tl ps.FStarC_Tactics_Types.goals in + let uu___1 = FStarC_List.tl ps.FStarC_Tactics_Types.goals in { FStarC_Tactics_Types.main_context = (ps.FStarC_Tactics_Types.main_context); @@ -626,9 +620,8 @@ let (replace_cur : FStarC_Tactics_Types.goal -> unit tac) = check_valid_goal g; (let uu___1 = let uu___2 = - let uu___3 = - FStarC_Compiler_List.tl ps.FStarC_Tactics_Types.goals in - g :: uu___3 in + let uu___3 = FStarC_List.tl ps.FStarC_Tactics_Types.goals in g + :: uu___3 in { FStarC_Tactics_Types.main_context = (ps.FStarC_Tactics_Types.main_context); @@ -676,7 +669,7 @@ let (add_goals : FStarC_Tactics_Types.goal Prims.list -> unit tac) = FStarC_Tactics_Types.all_implicits = (ps.FStarC_Tactics_Types.all_implicits); FStarC_Tactics_Types.goals = - (FStarC_Compiler_List.op_At gs ps.FStarC_Tactics_Types.goals); + (FStarC_List.op_At gs ps.FStarC_Tactics_Types.goals); FStarC_Tactics_Types.smt_goals = (ps.FStarC_Tactics_Types.smt_goals); FStarC_Tactics_Types.depth = (ps.FStarC_Tactics_Types.depth); @@ -709,8 +702,7 @@ let (add_smt_goals : FStarC_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStarC_Tactics_Types.all_implicits); FStarC_Tactics_Types.goals = (ps.FStarC_Tactics_Types.goals); FStarC_Tactics_Types.smt_goals = - (FStarC_Compiler_List.op_At gs - ps.FStarC_Tactics_Types.smt_goals); + (FStarC_List.op_At gs ps.FStarC_Tactics_Types.smt_goals); FStarC_Tactics_Types.depth = (ps.FStarC_Tactics_Types.depth); FStarC_Tactics_Types.__dump = (ps.FStarC_Tactics_Types.__dump); FStarC_Tactics_Types.psc = (ps.FStarC_Tactics_Types.psc); @@ -740,7 +732,7 @@ let (push_goals : FStarC_Tactics_Types.goal Prims.list -> unit tac) = FStarC_Tactics_Types.all_implicits = (ps.FStarC_Tactics_Types.all_implicits); FStarC_Tactics_Types.goals = - (FStarC_Compiler_List.op_At ps.FStarC_Tactics_Types.goals gs); + (FStarC_List.op_At ps.FStarC_Tactics_Types.goals gs); FStarC_Tactics_Types.smt_goals = (ps.FStarC_Tactics_Types.smt_goals); FStarC_Tactics_Types.depth = (ps.FStarC_Tactics_Types.depth); @@ -773,8 +765,7 @@ let (push_smt_goals : FStarC_Tactics_Types.goal Prims.list -> unit tac) = (ps.FStarC_Tactics_Types.all_implicits); FStarC_Tactics_Types.goals = (ps.FStarC_Tactics_Types.goals); FStarC_Tactics_Types.smt_goals = - (FStarC_Compiler_List.op_At ps.FStarC_Tactics_Types.smt_goals - gs); + (FStarC_List.op_At ps.FStarC_Tactics_Types.smt_goals gs); FStarC_Tactics_Types.depth = (ps.FStarC_Tactics_Types.depth); FStarC_Tactics_Types.__dump = (ps.FStarC_Tactics_Types.__dump); FStarC_Tactics_Types.psc = (ps.FStarC_Tactics_Types.psc); @@ -801,8 +792,7 @@ let (add_implicits : FStarC_TypeChecker_Env.implicits -> unit tac) = FStarC_Tactics_Types.main_context = (ps.FStarC_Tactics_Types.main_context); FStarC_Tactics_Types.all_implicits = - (FStarC_Compiler_List.op_At i - ps.FStarC_Tactics_Types.all_implicits); + (FStarC_List.op_At i ps.FStarC_Tactics_Types.all_implicits); FStarC_Tactics_Types.goals = (ps.FStarC_Tactics_Types.goals); FStarC_Tactics_Types.smt_goals = (ps.FStarC_Tactics_Types.smt_goals); @@ -830,7 +820,7 @@ let (new_uvar : FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.ctx_uvar Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.ctx_uvar) tac) = fun reason -> @@ -852,7 +842,7 @@ let (new_uvar : let uu___1 = let uu___2 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) g_u.FStarC_TypeChecker_Common.implicits in add_implicits uu___2 in bind uu___1 @@ -864,7 +854,7 @@ let (mk_irrelevant_goal : FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Options.optionstate -> Prims.string -> FStarC_Tactics_Types.goal tac) = @@ -893,7 +883,7 @@ let (add_irrelevant_goal' : FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Options.optionstate -> Prims.string -> unit tac) = fun reason -> @@ -928,8 +918,7 @@ let (goal_of_guard : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option - -> - FStarC_Compiler_Range_Type.range -> FStarC_Tactics_Types.goal tac) + -> FStarC_Range_Type.range -> FStarC_Tactics_Types.goal tac) = fun reason -> fun e -> @@ -967,7 +956,7 @@ let wrap_err_doc : 'a . FStarC_Errors_Msg.error_message -> 'a tac -> 'a tac = (FStarC_Tactics_Common.TacticFailure (msg, r), q) -> FStarC_Tactics_Result.Failed ((FStarC_Tactics_Common.TacticFailure - ((FStarC_Compiler_List.op_At pref msg), r)), q) + ((FStarC_List.op_At pref msg), r)), q) | FStarC_Tactics_Result.Failed (e, q) -> FStarC_Tactics_Result.Failed (e, q)) let wrap_err : 'a . Prims.string -> 'a tac -> 'a tac = @@ -1008,8 +997,8 @@ let (compress_implicits : unit tac) = let imps = ps.FStarC_Tactics_Types.all_implicits in let g = let uu___ = - FStarC_Class_Listlike.from_list - (FStarC_Compiler_CList.listlike_clist ()) imps in + FStarC_Class_Listlike.from_list (FStarC_CList.listlike_clist ()) + imps in { FStarC_TypeChecker_Common.guard_f = (FStarC_TypeChecker_Env.trivial_guard.FStarC_TypeChecker_Common.guard_f); @@ -1025,8 +1014,7 @@ let (compress_implicits : unit tac) = FStarC_TypeChecker_Rel.resolve_implicits_tac ps.FStarC_Tactics_Types.main_context g in let ps' = - let uu___ = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst imps1 in + let uu___ = FStarC_List.map FStar_Pervasives_Native.fst imps1 in { FStarC_Tactics_Types.main_context = (ps.FStarC_Tactics_Types.main_context); @@ -1063,7 +1051,7 @@ let (get_phi : FStarC_TypeChecker_Normalize.unfold_whnf uu___1 uu___2 in FStarC_Syntax_Util.un_squash uu___ let (is_irrelevant : FStarC_Tactics_Types.goal -> Prims.bool) = - fun g -> let uu___ = get_phi g in FStarC_Compiler_Option.isSome uu___ + fun g -> let uu___ = get_phi g in FStarC_Option.isSome uu___ let (goal_typedness_deps : FStarC_Tactics_Types.goal -> FStarC_Syntax_Syntax.ctx_uvar Prims.list) = fun g -> @@ -1143,7 +1131,7 @@ let divide : 'a 'b . FStarC_BigInt.t -> 'a tac -> 'b tac -> ('a * 'b) tac = let uu___2 = let uu___3 = FStarC_BigInt.to_int_fs n in - FStarC_Compiler_List.splitAt uu___3 + FStarC_List.splitAt uu___3 p.FStarC_Tactics_Types.goals in Obj.magic (FStarC_Class_Monad.return @@ -1320,14 +1308,14 @@ let divide : 'a 'b . FStarC_BigInt.t -> 'a tac -> 'b tac -> ('a * 'b) tac = (rp'.FStarC_Tactics_Types.all_implicits); FStarC_Tactics_Types.goals = - (FStarC_Compiler_List.op_At + (FStarC_List.op_At lp'.FStarC_Tactics_Types.goals rp'.FStarC_Tactics_Types.goals); FStarC_Tactics_Types.smt_goals = - (FStarC_Compiler_List.op_At + (FStarC_List.op_At lp'.FStarC_Tactics_Types.smt_goals - (FStarC_Compiler_List.op_At + (FStarC_List.op_At rp'.FStarC_Tactics_Types.smt_goals p.FStarC_Tactics_Types.smt_goals)); FStarC_Tactics_Types.depth diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_Printing.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Printing.ml similarity index 85% rename from stage0/fstar-lib/generated/FStarC_Tactics_Printing.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Printing.ml index 1dff162209f..b3463422fab 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_Printing.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Printing.ml @@ -1,6 +1,5 @@ open Prims -let (dbg_Imp : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Imp" +let (dbg_Imp : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Imp" let (term_to_string : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> Prims.string) = fun e -> @@ -19,8 +18,8 @@ let (goal_to_string_verbose : FStarC_Tactics_Types.goal -> Prims.string) = let uu___3 = let uu___4 = FStarC_Tactics_Types.goal_env g in term_to_string uu___4 t in - FStarC_Compiler_Util.format1 "\tGOAL ALREADY SOLVED!: %s" uu___3 in - FStarC_Compiler_Util.format2 "%s%s\n" uu___ uu___1 + FStarC_Util.format1 "\tGOAL ALREADY SOLVED!: %s" uu___3 in + FStarC_Util.format2 "%s%s\n" uu___ uu___1 let (unshadow : FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.term -> @@ -48,7 +47,7 @@ let (unshadow : match bs1 with | [] -> let uu___ = FStarC_Syntax_Subst.subst subst t1 in - ((FStarC_Compiler_List.rev bs'), uu___) + ((FStarC_List.rev bs'), uu___) | b::bs2 -> let b1 = let uu___ = FStarC_Syntax_Subst.subst_binders subst [b] in @@ -65,8 +64,7 @@ let (unshadow : FStarC_Class_Show.show FStarC_Ident.showable_ident bv0.FStarC_Syntax_Syntax.ppname in fresh_until uu___1 - (fun s -> - Prims.op_Negation (FStarC_Compiler_List.mem s seen)) in + (fun s -> Prims.op_Negation (FStarC_List.mem s seen)) in let bv = sset bv0 nbs in let b2 = FStarC_Syntax_Syntax.mk_binder_with_attrs bv q @@ -80,7 +78,7 @@ let (unshadow : (bv0, uu___5) in FStarC_Syntax_Syntax.NT uu___4 in [uu___3] in - FStarC_Compiler_List.op_At subst uu___2 in + FStarC_List.op_At subst uu___2 in go (nbs :: seen) uu___1 bs2 (b2 :: bs') t1) in go [] [] bs [] t let (goal_to_string : @@ -116,14 +114,14 @@ let (goal_to_string : FStarC_Class_Show.show FStarC_Class_Show.showable_int i in let uu___1 = FStarC_Class_Show.show FStarC_Class_Show.showable_int n in - FStarC_Compiler_Util.format2 " %s/%s" uu___ uu___1 in + FStarC_Util.format2 " %s/%s" uu___ uu___1 in let maybe_label = match g.FStarC_Tactics_Types.label with | "" -> "" | l -> Prims.strcat " (" (Prims.strcat l ")") in let uu___ = let rename_binders subst bs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> let x = uu___1.FStarC_Syntax_Syntax.binder_bv in let y = @@ -180,17 +178,16 @@ let (goal_to_string : else (let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Print.binder_to_string_with_type goal_binders1 in - FStarC_Compiler_String.concat ", " uu___4 in + FStarC_String.concat ", " uu___4 in let uu___4 = let uu___5 = FStarC_Tactics_Types.goal_env g in term_to_string uu___5 goal_ty1 in - FStarC_Compiler_Util.format3 "%s |- %s : %s\n" uu___3 - w uu___4) in - FStarC_Compiler_Util.format4 "%s%s%s:\n%s\n" kind num - maybe_label actual_goal) + FStarC_Util.format3 "%s |- %s : %s\n" uu___3 w uu___4) in + FStarC_Util.format4 "%s%s%s:\n%s\n" kind num maybe_label + actual_goal) let (ps_to_string : (Prims.string * FStarC_Tactics_Types.proofstate) -> Prims.string) = fun uu___ -> @@ -199,10 +196,8 @@ let (ps_to_string : let p_imp imp = FStarC_Class_Show.show FStarC_Syntax_Print.showable_uvar (imp.FStarC_TypeChecker_Common.imp_uvar).FStarC_Syntax_Syntax.ctx_uvar_head in - let n_active = - FStarC_Compiler_List.length ps.FStarC_Tactics_Types.goals in - let n_smt = - FStarC_Compiler_List.length ps.FStarC_Tactics_Types.smt_goals in + let n_active = FStarC_List.length ps.FStarC_Tactics_Types.goals in + let n_smt = FStarC_List.length ps.FStarC_Tactics_Types.smt_goals in let n = n_active + n_smt in let uu___1 = let uu___2 = @@ -210,51 +205,50 @@ let (ps_to_string : let uu___4 = FStarC_Class_Show.show FStarC_Class_Show.showable_int ps.FStarC_Tactics_Types.depth in - FStarC_Compiler_Util.format2 "State dump @ depth %s (%s):\n" - uu___4 msg in + FStarC_Util.format2 "State dump @ depth %s (%s):\n" uu___4 msg in let uu___4 = let uu___5 = if ps.FStarC_Tactics_Types.entry_range <> - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange then let uu___6 = - FStarC_Compiler_Range_Ops.string_of_def_range + FStarC_Range_Ops.string_of_def_range ps.FStarC_Tactics_Types.entry_range in - FStarC_Compiler_Util.format1 "Location: %s\n" uu___6 + FStarC_Util.format1 "Location: %s\n" uu___6 else "" in let uu___6 = let uu___7 = - let uu___8 = FStarC_Compiler_Effect.op_Bang dbg_Imp in + let uu___8 = FStarC_Effect.op_Bang dbg_Imp in if uu___8 then let uu___9 = FStarC_Common.string_of_list p_imp ps.FStarC_Tactics_Types.all_implicits in - FStarC_Compiler_Util.format1 "Imps: %s\n" uu___9 + FStarC_Util.format1 "Imps: %s\n" uu___9 else "" in [uu___7] in uu___5 :: uu___6 in uu___3 :: uu___4 in let uu___3 = let uu___4 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun g -> goal_to_string "Goal" (FStar_Pervasives_Native.Some ((Prims.int_one + i), n)) ps g) ps.FStarC_Tactics_Types.goals in let uu___5 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun g -> goal_to_string "SMT Goal" (FStar_Pervasives_Native.Some (((Prims.int_one + n_active) + i), n)) ps g) ps.FStarC_Tactics_Types.smt_goals in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.op_At uu___2 uu___3 in - FStarC_Compiler_String.concat "" uu___1 + FStarC_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___2 uu___3 in + FStarC_String.concat "" uu___1 let (goal_to_json : FStarC_Tactics_Types.goal -> FStarC_Json.json) = fun g -> let g_binders = @@ -311,7 +305,7 @@ let (ps_to_json : let uu___6 = let uu___7 = let uu___8 = - FStarC_Compiler_List.map goal_to_json + FStarC_List.map goal_to_json ps.FStarC_Tactics_Types.goals in FStarC_Json.JsonList uu___8 in ("goals", uu___7) in @@ -319,7 +313,7 @@ let (ps_to_json : let uu___8 = let uu___9 = let uu___10 = - FStarC_Compiler_List.map goal_to_json + FStarC_List.map goal_to_json ps.FStarC_Tactics_Types.smt_goals in FStarC_Json.JsonList uu___10 in ("smt-goals", uu___9) in @@ -335,16 +329,16 @@ let (ps_to_json : let uu___3 = if ps.FStarC_Tactics_Types.entry_range <> - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange then let uu___4 = let uu___5 = - FStarC_Compiler_Range_Ops.json_of_def_range + FStarC_Range_Ops.json_of_def_range ps.FStarC_Tactics_Types.entry_range in ("location", uu___5) in [uu___4] else [] in - FStarC_Compiler_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___2 uu___3 in FStarC_Json.JsonAssoc uu___1 let (do_dump_proofstate : FStarC_Tactics_Types.proofstate -> Prims.string -> unit) = @@ -359,7 +353,7 @@ let (do_dump_proofstate : (fun uu___1 -> FStarC_Options.set_option "print_effect_args" (FStarC_Options.Bool true); - FStarC_Compiler_Util.print_generic "proof-state" ps_to_string - ps_to_json (msg, ps); - FStarC_Compiler_Util.flush_stdout ()) + FStarC_Util.print_generic "proof-state" ps_to_string ps_to_json + (msg, ps); + FStarC_Util.flush_stdout ()) else () \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_Result.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Result.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Tactics_Result.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Result.ml diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_Types.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Types.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_Tactics_Types.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Types.ml index 83b39d3b744..96529944812 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_Types.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_Types.ml @@ -58,11 +58,11 @@ type proofstate = depth: Prims.int ; __dump: proofstate -> Prims.string -> unit ; psc: FStarC_TypeChecker_Primops_Base.psc ; - entry_range: FStarC_Compiler_Range_Type.range ; + entry_range: FStarC_Range_Type.range ; guard_policy: guard_policy ; freshness: Prims.int ; tac_verb_dbg: Prims.bool ; - local_state: FStarC_Syntax_Syntax.term FStarC_Compiler_Util.psmap ; + local_state: FStarC_Syntax_Syntax.term FStarC_Util.psmap ; urgency: Prims.int ; dump_on_failure: Prims.bool } let (__proj__Mkproofstate__item__main_context : @@ -114,7 +114,7 @@ let (__proj__Mkproofstate__item__psc : psc; entry_range; guard_policy = guard_policy1; freshness; tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> psc let (__proj__Mkproofstate__item__entry_range : - proofstate -> FStarC_Compiler_Range_Type.range) = + proofstate -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; @@ -141,7 +141,7 @@ let (__proj__Mkproofstate__item__tac_verb_dbg : proofstate -> Prims.bool) = tac_verb_dbg; local_state; urgency; dump_on_failure;_} -> tac_verb_dbg let (__proj__Mkproofstate__item__local_state : - proofstate -> FStarC_Syntax_Syntax.term FStarC_Compiler_Util.psmap) = + proofstate -> FStarC_Syntax_Syntax.term FStarC_Util.psmap) = fun projectee -> match projectee with | { main_context; all_implicits; goals; smt_goals; depth; __dump; @@ -163,14 +163,14 @@ let (__proj__Mkproofstate__item__dump_on_failure : proofstate -> Prims.bool) dump_on_failure let (goal_env : goal -> FStarC_TypeChecker_Env.env) = fun g -> g.goal_main_env -let (goal_range : goal -> FStarC_Compiler_Range_Type.range) = +let (goal_range : goal -> FStarC_Range_Type.range) = fun g -> (g.goal_main_env).FStarC_TypeChecker_Env.range let (goal_witness : goal -> FStarC_Syntax_Syntax.term) = fun g -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_uvar ((g.goal_ctx_uvar), ([], FStarC_Syntax_Syntax.NoUseRange))) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (goal_type : goal -> FStarC_Syntax_Syntax.term) = fun g -> FStarC_Syntax_Util.ctx_uvar_typ g.goal_ctx_uvar let (goal_opts : goal -> FStarC_Options.optionstate) = fun g -> g.opts @@ -424,12 +424,12 @@ let (tracepoint : proofstate -> Prims.bool) = if uu___1 then ps.__dump ps "TRACE" else ()); true let (set_proofstate_range : - proofstate -> FStarC_Compiler_Range_Type.range -> proofstate) = + proofstate -> FStarC_Range_Type.range -> proofstate) = fun ps -> fun r -> let uu___ = - let uu___1 = FStarC_Compiler_Range_Type.def_range r in - FStarC_Compiler_Range_Type.set_def_range ps.entry_range uu___1 in + let uu___1 = FStarC_Range_Type.def_range r in + FStarC_Range_Type.set_def_range ps.entry_range uu___1 in { main_context = (ps.main_context); all_implicits = (ps.all_implicits); @@ -488,9 +488,8 @@ let (check_goal_solved' : | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None let (check_goal_solved : goal -> Prims.bool) = fun goal1 -> - let uu___ = check_goal_solved' goal1 in - FStarC_Compiler_Option.isSome uu___ -type 'a tref = 'a FStarC_Compiler_Effect.ref + let uu___ = check_goal_solved' goal1 in FStarC_Option.isSome uu___ +type 'a tref = 'a FStarC_Effect.ref type ('g, 't) non_informative_token = unit type ('g, 't0, 't1) subtyping_token = unit type ('g, 't0, 't1) equiv_token = unit diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_V1_Basic.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V1_Basic.ml similarity index 97% rename from stage0/fstar-lib/generated/FStarC_Tactics_V1_Basic.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V1_Basic.ml index 73c8256a9b3..4051dbba862 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_V1_Basic.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V1_Basic.ml @@ -1,12 +1,11 @@ open Prims -let (dbg_2635 : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "2635" -let (dbg_ReflTc : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ReflTc" -let (dbg_Tac : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Tac" -let (dbg_TacUnify : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "TacUnify" +let (dbg_2635 : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "2635" +let (dbg_ReflTc : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ReflTc" +let (dbg_Tac : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Tac" +let (dbg_TacUnify : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "TacUnify" let ret : 'a . 'a -> 'a FStarC_Tactics_Monad.tac = fun uu___ -> (fun x -> @@ -39,7 +38,7 @@ let (get_phi : FStarC_TypeChecker_Normalize.unfold_whnf uu___1 uu___2 in FStarC_Syntax_Util.un_squash uu___ let (is_irrelevant : FStarC_Tactics_Types.goal -> Prims.bool) = - fun g -> let uu___ = get_phi g in FStarC_Compiler_Option.isSome uu___ + fun g -> let uu___ = get_phi g in FStarC_Option.isSome uu___ let (core_check : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> @@ -59,7 +58,7 @@ let (core_check : then FStar_Pervasives.Inl FStar_Pervasives_Native.None else (let debug f = - let uu___2 = FStarC_Compiler_Debug.any () in + let uu___2 = FStarC_Debug.any () in if uu___2 then f () else () in let uu___2 = FStarC_TypeChecker_Core.check_term env sol t must_tot in @@ -77,7 +76,7 @@ let (core_check : let uu___5 = let uu___6 = FStarC_TypeChecker_Env.get_range env in FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range uu___6 in + FStarC_Range_Ops.showable_range uu___6 in let uu___6 = FStarC_TypeChecker_Core.print_error_short err in let uu___7 = @@ -87,15 +86,14 @@ let (core_check : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___9 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "(%s) Core checking failed (%s) on term %s and type %s\n%s\n" uu___5 uu___6 uu___7 uu___8 uu___9); FStar_Pervasives.Inr err)) type name = FStarC_Syntax_Syntax.bv type env = FStarC_TypeChecker_Env.env type implicits = FStarC_TypeChecker_Env.implicits -let (rangeof : FStarC_Tactics_Types.goal -> FStarC_Compiler_Range_Type.range) - = +let (rangeof : FStarC_Tactics_Types.goal -> FStarC_Range_Type.range) = fun g -> (g.FStarC_Tactics_Types.goal_ctx_uvar).FStarC_Syntax_Syntax.ctx_uvar_range let (normalize : @@ -173,26 +171,26 @@ let (bnorm_goal : FStarC_Tactics_Types.goal -> FStarC_Tactics_Types.goal) = let uu___2 = FStarC_Tactics_Types.goal_type g in bnorm uu___1 uu___2 in goal_with_type g uu___ let (tacprint : Prims.string -> unit) = - fun s -> FStarC_Compiler_Util.print1 "TAC>> %s\n" s + fun s -> FStarC_Util.print1 "TAC>> %s\n" s let (tacprint1 : Prims.string -> Prims.string -> unit) = fun s -> fun x -> - let uu___ = FStarC_Compiler_Util.format1 s x in - FStarC_Compiler_Util.print1 "TAC>> %s\n" uu___ + let uu___ = FStarC_Util.format1 s x in + FStarC_Util.print1 "TAC>> %s\n" uu___ let (tacprint2 : Prims.string -> Prims.string -> Prims.string -> unit) = fun s -> fun x -> fun y -> - let uu___ = FStarC_Compiler_Util.format2 s x y in - FStarC_Compiler_Util.print1 "TAC>> %s\n" uu___ + let uu___ = FStarC_Util.format2 s x y in + FStarC_Util.print1 "TAC>> %s\n" uu___ let (tacprint3 : Prims.string -> Prims.string -> Prims.string -> Prims.string -> unit) = fun s -> fun x -> fun y -> fun z -> - let uu___ = FStarC_Compiler_Util.format3 s x y z in - FStarC_Compiler_Util.print1 "TAC>> %s\n" uu___ + let uu___ = FStarC_Util.format3 s x y z in + FStarC_Util.print1 "TAC>> %s\n" uu___ let (print : Prims.string -> unit FStarC_Tactics_Monad.tac) = fun msg -> (let uu___1 = @@ -204,8 +202,7 @@ let (debugging : unit -> Prims.bool FStarC_Tactics_Monad.tac) = fun uu___ -> let uu___1 = bind () in uu___1 FStarC_Tactics_Monad.get - (fun ps -> - let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Tac in ret uu___2) + (fun ps -> let uu___2 = FStarC_Effect.op_Bang dbg_Tac in ret uu___2) let (do_dump_ps : Prims.string -> FStarC_Tactics_Types.proofstate -> unit) = fun msg -> fun ps -> @@ -223,7 +220,7 @@ let (dump_all : Prims.bool -> Prims.string -> unit FStarC_Tactics_Monad.tac) FStarC_Tactics_Monad.mk_tac (fun ps -> let gs = - FStarC_Compiler_List.map + FStarC_List.map (fun i -> FStarC_Tactics_Types.goal_of_implicit ps.FStarC_Tactics_Types.main_context i) @@ -232,7 +229,7 @@ let (dump_all : Prims.bool -> Prims.string -> unit FStarC_Tactics_Monad.tac) if print_resolved then gs else - FStarC_Compiler_List.filter + FStarC_List.filter (fun g -> let uu___1 = FStarC_Tactics_Types.check_goal_solved g in Prims.op_Negation uu___1) gs in @@ -276,13 +273,12 @@ let (dump_uvars_of : FStarC_Syntax_Free.uvars uu___1 in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let gs = - FStarC_Compiler_List.map - (FStarC_Tactics_Types.goal_of_ctx_uvar g) uvs in + FStarC_List.map (FStarC_Tactics_Types.goal_of_ctx_uvar g) uvs in let gs1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun g1 -> let uu___ = FStarC_Tactics_Types.check_goal_solved g1 in Prims.op_Negation uu___) gs in @@ -317,7 +313,7 @@ let fail1 : 'uuuuu . Prims.string -> Prims.string -> 'uuuuu FStarC_Tactics_Monad.tac = fun msg -> fun x -> - let uu___ = FStarC_Compiler_Util.format1 msg x in + let uu___ = FStarC_Util.format1 msg x in FStarC_Tactics_Monad.fail uu___ let fail2 : 'uuuuu . @@ -327,7 +323,7 @@ let fail2 : fun msg -> fun x -> fun y -> - let uu___ = FStarC_Compiler_Util.format2 msg x y in + let uu___ = FStarC_Util.format2 msg x y in FStarC_Tactics_Monad.fail uu___ let fail3 : 'uuuuu . @@ -339,7 +335,7 @@ let fail3 : fun x -> fun y -> fun z -> - let uu___ = FStarC_Compiler_Util.format3 msg x y z in + let uu___ = FStarC_Util.format3 msg x y z in FStarC_Tactics_Monad.fail uu___ let fail4 : 'uuuuu . @@ -353,7 +349,7 @@ let fail4 : fun y -> fun z -> fun w -> - let uu___ = FStarC_Compiler_Util.format4 msg x y z w in + let uu___ = FStarC_Util.format4 msg x y z w in FStarC_Tactics_Monad.fail uu___ let (destruct_eq' : FStarC_Syntax_Syntax.typ -> @@ -479,7 +475,7 @@ let (proc_guard' : FStarC_TypeChecker_Common.guard_t -> FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> unit FStarC_Tactics_Monad.tac) + FStarC_Range_Type.range -> unit FStarC_Tactics_Monad.tac) = fun simplify -> fun reason -> @@ -490,17 +486,17 @@ let (proc_guard' : FStarC_Tactics_Monad.mlog (fun uu___ -> let uu___1 = FStarC_TypeChecker_Rel.guard_to_string e g in - FStarC_Compiler_Util.print2 "Processing guard (%s:%s)\n" - reason uu___1) + FStarC_Util.print2 "Processing guard (%s:%s)\n" reason + uu___1) (fun uu___ -> let imps = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in (match sc_opt with | FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Allow_untyped r) -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun imp -> mark_uvar_with_should_check_tag imp.FStarC_TypeChecker_Common.imp_uvar @@ -537,7 +533,7 @@ let (proc_guard' : let uu___6 = FStarC_TypeChecker_Rel.guard_to_string e g in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Tactics admitted guard <%s>\n\n" uu___6 in FStarC_Errors.log_issue @@ -556,7 +552,7 @@ let (proc_guard' : let uu___5 = FStarC_TypeChecker_Rel.guard_to_string e g in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Making guard (%s:%s) into a goal\n" reason uu___5) (fun uu___4 -> @@ -584,7 +580,7 @@ let (proc_guard' : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Pushing guard (%s:%s) as SMT goal\n" reason uu___5) (fun uu___4 -> @@ -612,7 +608,7 @@ let (proc_guard' : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Sending guard (%s:%s) to SMT Synchronously\n" reason uu___5) (fun uu___4 -> @@ -626,7 +622,7 @@ let (proc_guard' : let uu___5 = FStarC_TypeChecker_Rel.guard_to_string e g in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Forcing guard (%s:%s)\n" reason uu___5) (fun uu___4 -> @@ -655,7 +651,7 @@ let (proc_guard' : = FStarC_TypeChecker_Rel.guard_to_string e g in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "guard = %s\n" uu___8) ( @@ -673,7 +669,7 @@ let (proc_guard' : let uu___7 = FStarC_TypeChecker_Rel.guard_to_string e g in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "guard = %s\n" uu___7) (fun uu___6 -> @@ -686,8 +682,7 @@ let (proc_guard : env -> FStarC_TypeChecker_Common.guard_t -> FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option - -> - FStarC_Compiler_Range_Type.range -> unit FStarC_Tactics_Monad.tac) + -> FStarC_Range_Type.range -> unit FStarC_Tactics_Monad.tac) = proc_guard' true let (tc_unifier_solved_implicits : FStarC_TypeChecker_Env.env -> @@ -952,7 +947,7 @@ let (__do_unify_wflags : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "%%%%%%%%do_unify %s =? %s\n" uu___1 uu___2) else (); @@ -964,7 +959,7 @@ let (__do_unify_wflags : (Obj.repr (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) ())) | Check_left_only -> @@ -984,13 +979,13 @@ let (__do_unify_wflags : FStarC_Syntax_Free.uvars t2 in FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) (Obj.magic uu___3))) in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___1) in let uu___1 = @@ -1028,7 +1023,7 @@ let (__do_unify_wflags : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "%%%%%%%%do_unify (RESULT %s) %s =? %s\n" uu___7 uu___8 uu___9) @@ -1067,7 +1062,7 @@ let (__do_unify_wflags : let uu___10 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in FStarC_Tactics_Monad.add_implicits @@ -1104,9 +1099,9 @@ let (__do_unify_wflags : msg in let uu___10 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range r in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 ">> do_unify error, (%s) at (%s)\n" uu___9 uu___10) (fun uu___8 -> @@ -1147,7 +1142,7 @@ let (__do_unify : let uu___ = bind () in uu___ idtac (fun uu___1 -> - (let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_TacUnify in + (let uu___3 = FStarC_Effect.op_Bang dbg_TacUnify in if uu___3 then (FStarC_Options.push (); @@ -1156,15 +1151,13 @@ let (__do_unify : ())) else ()); (let uu___3 = - let uu___4 = - FStarC_Compiler_Effect.op_Bang dbg_TacUnify in + let uu___4 = FStarC_Effect.op_Bang dbg_TacUnify in __do_unify_wflags uu___4 allow_guards must_tot check_side env1 t1 t2 in let uu___4 = bind () in uu___4 uu___3 (fun r -> - (let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_TacUnify in + (let uu___6 = FStarC_Effect.op_Bang dbg_TacUnify in if uu___6 then FStarC_Options.pop () else ()); ret r))) let (do_unify_aux : @@ -1249,7 +1242,7 @@ let (do_match : let uu___5 = FStarC_Class_Setlike.equal () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs1) (Obj.magic uvs2) in Prims.op_Negation uu___5 in @@ -1293,7 +1286,7 @@ let (do_match_on_lhs : let uu___7 = FStarC_Class_Setlike.equal () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs1) (Obj.magic uvs2) in Prims.op_Negation uu___7 in @@ -1315,7 +1308,7 @@ let (set_solution : | FStar_Pervasives_Native.Some uu___1 -> let uu___2 = let uu___3 = FStarC_Tactics_Printing.goal_to_string_verbose goal in - FStarC_Compiler_Util.format1 "Goal %s is already solved" uu___3 in + FStarC_Util.format1 "Goal %s is already solved" uu___3 in FStarC_Tactics_Monad.fail uu___2 | FStar_Pervasives_Native.None -> (FStarC_Syntax_Unionfind.change @@ -1348,7 +1341,7 @@ let (solve : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term solution in - FStarC_Compiler_Util.print2 "solve %s := %s\n" uu___1 uu___2) + FStarC_Util.print2 "solve %s := %s\n" uu___1 uu___2) (fun uu___ -> let uu___1 = trysolve goal solution in let uu___2 = bind () in @@ -1372,8 +1365,8 @@ let (solve : let uu___8 = FStarC_Tactics_Types.goal_env goal in let uu___9 = FStarC_Tactics_Types.goal_type goal in tts uu___8 uu___9 in - FStarC_Compiler_Util.format3 "%s does not solve %s : %s" - uu___5 uu___6 uu___7 in + FStarC_Util.format3 "%s does not solve %s : %s" uu___5 + uu___6 uu___7 in FStarC_Tactics_Monad.fail uu___4))) let (solve' : FStarC_Tactics_Types.goal -> @@ -1430,8 +1423,8 @@ let (tadmit_t : FStarC_Syntax_Syntax.term -> unit FStarC_Tactics_Monad.tac) = let uu___6 = FStarC_Tactics_Printing.goal_to_string "" FStar_Pervasives_Native.None ps g in - FStarC_Compiler_Util.format1 - "Tactics admitted goal <%s>\n\n" uu___6 in + FStarC_Util.format1 "Tactics admitted goal <%s>\n\n" + uu___6 in FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) uu___4 FStarC_Errors_Codes.Warning_TacAdmit () @@ -1478,7 +1471,7 @@ let (fresh : unit -> FStarC_BigInt.t FStarC_Tactics_Monad.tac) = let (curms : unit -> FStarC_BigInt.t FStarC_Tactics_Monad.tac) = fun uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_Util.get_time_of_day_ms () in + let uu___2 = FStarC_Util.get_time_of_day_ms () in FStarC_BigInt.of_int_fs uu___2 in ret uu___1 let (__tc : @@ -1496,7 +1489,7 @@ let (__tc : (fun uu___1 -> let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 "Tac> __tc(%s)\n" uu___2) + FStarC_Util.print1 "Tac> __tc(%s)\n" uu___2) (fun uu___1 -> let e1 = { @@ -1639,7 +1632,7 @@ let (__tc_ghost : (fun uu___1 -> let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 "Tac> __tc_ghost(%s)\n" uu___2) + FStarC_Util.print1 "Tac> __tc_ghost(%s)\n" uu___2) (fun uu___1 -> let e1 = { @@ -1897,8 +1890,8 @@ let (__tc_lax : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) uu___4 in - FStarC_Compiler_Util.print2 "Tac> __tc_lax(%s)(Context:%s)\n" - uu___2 uu___3) + FStarC_Util.print2 "Tac> __tc_lax(%s)(Context:%s)\n" uu___2 + uu___3) (fun uu___1 -> let e1 = { @@ -2267,7 +2260,9 @@ let (tc : let uu___ = let uu___1 = tcc e t in let uu___2 = bind () in - uu___2 uu___1 (fun c -> ret (FStarC_Syntax_Util.comp_result c)) in + uu___2 uu___1 + (fun c -> + let uu___3 = FStarC_Syntax_Util.comp_result c in ret uu___3) in FStarC_Tactics_Monad.wrap_err "tc" uu___ let divide : 'a 'b . @@ -2288,7 +2283,7 @@ let divide : | () -> let uu___3 = let uu___4 = FStarC_BigInt.to_int_fs n in - FStarC_Compiler_List.splitAt uu___4 + FStarC_List.splitAt uu___4 p.FStarC_Tactics_Types.goals in ret uu___3) () with @@ -2389,14 +2384,14 @@ let divide : (rp'.FStarC_Tactics_Types.all_implicits); FStarC_Tactics_Types.goals = - (FStarC_Compiler_List.op_At + (FStarC_List.op_At lp'.FStarC_Tactics_Types.goals rp'.FStarC_Tactics_Types.goals); FStarC_Tactics_Types.smt_goals = - (FStarC_Compiler_List.op_At + (FStarC_List.op_At lp'.FStarC_Tactics_Types.smt_goals - (FStarC_Compiler_List.op_At + (FStarC_List.op_At rp'.FStarC_Tactics_Types.smt_goals p.FStarC_Tactics_Types.smt_goals)); FStarC_Tactics_Types.depth @@ -2616,9 +2611,9 @@ let (intro_rec : (fun uu___1 -> (fun goal -> let goal = Obj.magic goal in - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "WARNING (intro_rec): calling this is known to cause normalizer loops\n"; - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "WARNING (intro_rec): proceed at your own risk...\n"; (let uu___3 = let uu___4 = FStarC_Tactics_Types.goal_env goal in @@ -2649,13 +2644,15 @@ let (intro_rec : FStar_Pervasives_Native.None uu___6 in let uu___6 = let uu___7 = - let uu___8 = + FStarC_Syntax_Util.comp_result c in + let uu___8 = + let uu___9 = should_check_goal_uvar goal in - FStar_Pervasives_Native.Some uu___8 in - let uu___8 = goal_typedness_deps goal in + FStar_Pervasives_Native.Some uu___9 in + let uu___9 = goal_typedness_deps goal in FStarC_Tactics_Monad.new_uvar "intro_rec" - env' (FStarC_Syntax_Util.comp_result c) - uu___7 uu___8 (rangeof goal) in + env' uu___7 uu___8 uu___9 + (rangeof goal) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () (Obj.magic uu___6) @@ -2677,7 +2674,7 @@ let (intro_rec : [] uu___8 FStarC_Parser_Const.effect_Tot_lid uu___9 [] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let body = FStarC_Syntax_Syntax.bv_to_name bv in @@ -2785,7 +2782,7 @@ let (norm : let uu___3 = FStarC_Tactics_Types.goal_witness goal in FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___3 in - FStarC_Compiler_Util.print1 "norm: witness = %s\n" uu___2) in + FStarC_Util.print1 "norm: witness = %s\n" uu___2) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ @@ -2795,7 +2792,7 @@ let (norm : let steps = let uu___2 = FStarC_TypeChecker_Cfg.translate_norm_steps s in - FStarC_Compiler_List.op_At + FStarC_List.op_At [FStarC_TypeChecker_Env.Reify; FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]] uu___2 in @@ -2828,8 +2825,8 @@ let (norm_term_env : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 - "norm_term_env: t = %s\n" uu___3) in + FStarC_Util.print1 "norm_term_env: t = %s\n" + uu___3) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 @@ -2850,7 +2847,7 @@ let (norm_term_env : let uu___7 = FStarC_TypeChecker_Cfg.translate_norm_steps s in - FStarC_Compiler_List.op_At + FStarC_List.op_At [FStarC_TypeChecker_Env.Reify; FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]] @@ -2866,7 +2863,7 @@ let (norm_term_env : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "norm_term_env: t' = %s\n" uu___9) in Obj.magic @@ -2908,7 +2905,7 @@ let (refine_intro : unit -> unit FStarC_Tactics_Monad.tac) = match uu___5 with | (bvs, phi1) -> let uu___6 = - let uu___7 = FStarC_Compiler_List.hd bvs in + let uu___7 = FStarC_List.hd bvs in uu___7.FStarC_Syntax_Syntax.binder_bv in (uu___6, phi1) in match uu___4 with @@ -2987,7 +2984,7 @@ let (__exact_now : FStarC_Tactics_Types.goal_env goal in FStarC_TypeChecker_Rel.guard_to_string uu___6 guard in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "__exact_now: got type %s\n__exact_now: and guard %s\n" uu___4 uu___5) in Obj.magic @@ -3029,7 +3026,7 @@ let (__exact_now : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___10 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "__exact_now: unifying %s and %s\n" uu___8 uu___9) in Obj.magic @@ -3140,7 +3137,7 @@ let (t_exact : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 "t_exact: tm = %s\n" uu___3) in + FStarC_Util.print1 "t_exact: tm = %s\n" uu___3) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 (fun uu___2 -> @@ -3165,7 +3162,7 @@ let (t_exact : let uu___5 = FStarC_Tactics_Monad.if_verbose (fun uu___6 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "__exact_now failed, trying refine...\n") in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -3222,7 +3219,7 @@ let (t_exact : FStarC_Tactics_Monad.if_verbose (fun uu___10 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "__exact_now: failed after refining too\n") in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -3246,7 +3243,7 @@ let (t_exact : FStarC_Tactics_Monad.if_verbose (fun uu___11 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "__exact_now: was not a refinement\n") in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -3274,7 +3271,7 @@ let (try_unify_by_application : env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.aqual * FStarC_Syntax_Syntax.ctx_uvar) Prims.list FStarC_Tactics_Monad.tac) @@ -3357,7 +3354,7 @@ let (try_unify_by_application : FStarC_Class_Show.show FStarC_Syntax_Print.showable_ctxu uv in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "t_apply: generated uvar %s\n" uu___9) in Obj.magic @@ -3486,7 +3483,7 @@ let (t_apply : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "t_apply: uopt %s, only_match %s, tc_resolved_uvars %s, tm = %s\n" uu___3 uu___4 uu___5 uu___6) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () @@ -3551,7 +3548,7 @@ let (t_apply : = FStarC_TypeChecker_Rel.guard_to_string e guard in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "t_apply: tm = %s\nt_apply: goal = %s\nenv.gamma=%s\ntyp=%s\nguard=%s\n" uu___8 uu___9 @@ -3622,7 +3619,7 @@ let (t_apply : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t) uvs in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "t_apply: found args = %s\n" uu___11) in Obj.magic @@ -3641,7 +3638,7 @@ let (t_apply : Obj.magic uu___10 in let w = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___11 -> @@ -3665,10 +3662,10 @@ let (t_apply : (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) ()) in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___13 -> @@ -3697,7 +3694,7 @@ let (t_apply : (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic s) @@ -3712,7 +3709,7 @@ let (t_apply : FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) uv (Obj.magic @@ -3738,7 +3735,7 @@ let (t_apply : uu___12 in let uvt_uv_l = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> @@ -3778,7 +3775,7 @@ let (t_apply : = let uu___15 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun g -> let uu___16 = @@ -3787,12 +3784,12 @@ let (t_apply : g.FStarC_Tactics_Types.goal_ctx_uvar) in Prims.op_Negation uu___16) - (FStarC_Compiler_List.flatten + (FStarC_List.flatten sub_goals) in - FStarC_Compiler_List.map + FStarC_List.map bnorm_goal uu___15 in - FStarC_Compiler_List.rev + FStarC_List.rev uu___14 in let uu___14 = @@ -3866,7 +3863,7 @@ let (lemma_or_sq : if uu___3 then let uu___4 = FStarC_Syntax_Util.un_squash res in - FStarC_Compiler_Util.map_opt uu___4 + FStarC_Util.map_opt uu___4 (fun post -> (FStarC_Syntax_Util.t_true, post)) else FStar_Pervasives_Native.None) let rec fold_left : @@ -3903,8 +3900,7 @@ let (t_apply_lemma : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 - "apply_lemma: tm = %s\n" uu___4) in + FStarC_Util.print1 "apply_lemma: tm = %s\n" uu___4) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___2 @@ -4075,9 +4071,9 @@ let (t_apply_lemma : (( let uu___19 = - (FStarC_Compiler_Debug.medium + (FStarC_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Effect.op_Bang dbg_2635) in if uu___19 @@ -4092,7 +4088,7 @@ let (t_apply_lemma : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Apply lemma created a new uvar %s while applying %s\n" uu___20 uu___21 @@ -4140,11 +4136,11 @@ let (t_apply_lemma : subst) -> let implicits2 = - FStarC_Compiler_List.rev + FStarC_List.rev implicits1 in let uvs1 = - FStarC_Compiler_List.rev + FStarC_List.rev uvs in let pre1 = @@ -4275,15 +4271,15 @@ let (t_apply_lemma : FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___17) in - FStarC_Compiler_List.map + FStarC_List.map (fun x -> x.FStarC_Syntax_Syntax.ctx_uvar_head) uu___16 in - FStarC_Compiler_List.existsML + FStarC_List.existsML (fun u -> FStarC_Syntax_Unionfind.equiv u uv) @@ -4291,7 +4287,7 @@ let (t_apply_lemma : let appears uv goals = - FStarC_Compiler_List.existsML + FStarC_List.existsML (fun g' -> let uu___16 @@ -4356,7 +4352,7 @@ let (t_apply_lemma : sub_goals in let sub_goals1 = - FStarC_Compiler_List.flatten + FStarC_List.flatten sub_goals in let rec filter' f xs = @@ -4504,15 +4500,15 @@ let (split_env : then FStar_Pervasives_Native.Some (e', bv', []) else (let uu___3 = aux e' in - FStarC_Compiler_Util.map_opt uu___3 + FStarC_Util.map_opt uu___3 (fun uu___4 -> match uu___4 with | (e'', bv, bvs) -> (e'', bv, (bv' :: bvs)))) in let uu___ = aux e in - FStarC_Compiler_Util.map_opt uu___ + FStarC_Util.map_opt uu___ (fun uu___1 -> match uu___1 with - | (e', bv, bvs) -> (e', bv, (FStarC_Compiler_List.rev bvs))) + | (e', bv, bvs) -> (e', bv, (FStarC_List.rev bvs))) let (subst_goal : FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.bv -> @@ -4534,8 +4530,8 @@ let (subst_goal : Obj.magic (Obj.repr (let bs = - FStarC_Compiler_List.map - FStarC_Syntax_Syntax.mk_binder (b11 :: bvs) in + FStarC_List.map FStarC_Syntax_Syntax.mk_binder + (b11 :: bvs) in let t = FStarC_Tactics_Types.goal_type g in let uu___1 = let uu___2 = FStarC_Syntax_Subst.close_binders bs in @@ -4545,15 +4541,15 @@ let (subst_goal : | (bs', t') -> let bs'1 = let uu___2 = FStarC_Syntax_Syntax.mk_binder b2 in - let uu___3 = FStarC_Compiler_List.tail bs' in - uu___2 :: uu___3 in + let uu___3 = FStarC_List.tail bs' in uu___2 :: + uu___3 in let uu___2 = FStarC_TypeChecker_Core.open_binders_in_term e0 bs'1 t' in (match uu___2 with | (new_env, bs'', t'') -> let b21 = - let uu___3 = FStarC_Compiler_List.hd bs'' in + let uu___3 = FStarC_List.hd bs'' in uu___3.FStarC_Syntax_Syntax.binder_bv in let uu___3 = let uu___4 = @@ -4583,7 +4579,7 @@ let (subst_goal : uvt FStar_Pervasives_Native.None in let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | { @@ -4640,8 +4636,7 @@ let (rewrite : FStarC_Syntax_Syntax.binder -> unit FStarC_Tactics_Monad.tac) FStarC_Class_Show.show FStarC_Syntax_Print.showable_term bv.FStarC_Syntax_Syntax.sort in - FStarC_Compiler_Util.print2 "+++Rewrite %s : %s\n" - uu___3 uu___4) in + FStarC_Util.print2 "+++Rewrite %s : %s\n" uu___3 uu___4) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 @@ -4672,7 +4667,7 @@ let (rewrite : FStarC_Syntax_Syntax.binder -> unit FStarC_Tactics_Monad.tac) let t = FStarC_Tactics_Types.goal_type goal in let bs = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs in let uu___6 = let uu___7 = @@ -4746,7 +4741,7 @@ let (rewrite : FStarC_Syntax_Syntax.binder -> unit FStarC_Tactics_Monad.tac) FStar_Pervasives_Native.None in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> @@ -4936,7 +4931,7 @@ let (binder_retype : FStarC_Syntax_Syntax.NT uu___6 in [uu___5] in let bvs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b1 -> let uu___5 = FStarC_Syntax_Subst.subst s @@ -5025,7 +5020,7 @@ let (norm_binder_type : let steps = let uu___2 = FStarC_TypeChecker_Cfg.translate_norm_steps s in - FStarC_Compiler_List.op_At + FStarC_List.op_At [FStarC_TypeChecker_Env.Reify; FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]] uu___2 in @@ -5120,8 +5115,8 @@ let (free_in : let uu___ = FStarC_Syntax_Free.names t in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) bv + (Obj.magic uu___) let (clear : FStarC_Syntax_Syntax.binder -> unit FStarC_Tactics_Monad.tac) = fun b -> let bv = b.FStarC_Syntax_Syntax.binder_bv in @@ -5141,11 +5136,11 @@ let (clear : FStarC_Syntax_Syntax.binder -> unit FStarC_Tactics_Monad.tac) = let uu___5 = let uu___6 = FStarC_Tactics_Types.goal_env goal in FStarC_TypeChecker_Env.all_binders uu___6 in - FStarC_Compiler_List.length uu___5 in + FStarC_List.length uu___5 in FStarC_Class_Show.show FStarC_Class_Show.showable_nat uu___4 in - FStarC_Compiler_Util.print2 - "Clear of (%s), env has %s binders\n" uu___2 uu___3) in + FStarC_Util.print2 "Clear of (%s), env has %s binders\n" + uu___2 uu___3) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ @@ -5173,7 +5168,7 @@ let (clear : FStarC_Syntax_Syntax.binder -> unit FStarC_Tactics_Monad.tac) = let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv bv' in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Cannot clear; binder present in the type of %s" uu___5 in FStarC_Tactics_Monad.fail uu___4 @@ -5347,11 +5342,10 @@ let (_t_trefl : let uu___2 = FStarC_Syntax_Free.uvars t in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) in let uu___2 = - FStarC_Compiler_Util.for_all - is_uvar_untyped_or_already_checked uvars in + FStarC_Util.for_all is_uvar_untyped_or_already_checked uvars in if uu___2 then skip_register else @@ -5824,8 +5818,7 @@ let longest_prefix : else (acc, (x :: xs), (y :: ys)) | uu___ -> (acc, l11, l21) in let uu___ = aux [] l1 l2 in - match uu___ with - | (pr, t1, t2) -> ((FStarC_Compiler_List.rev pr), t1, t2) + match uu___ with | (pr, t1, t2) -> ((FStarC_List.rev pr), t1, t2) let (eq_binding : FStarC_Syntax_Syntax.binding -> FStarC_Syntax_Syntax.binding -> Prims.bool) = @@ -5854,7 +5847,7 @@ let (join_goals : (fun g1 -> fun g2 -> let close_forall_no_univs bs f = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun f1 -> FStarC_Syntax_Util.mk_forall_no_univ @@ -5882,19 +5875,19 @@ let (join_goals : (g2.FStarC_Tactics_Types.goal_ctx_uvar).FStarC_Syntax_Syntax.ctx_uvar_gamma in let uu___2 = longest_prefix eq_binding - (FStarC_Compiler_List.rev gamma1) - (FStarC_Compiler_List.rev gamma2) in + (FStarC_List.rev gamma1) + (FStarC_List.rev gamma2) in match uu___2 with | (gamma, r1, r2) -> let t1 = let uu___3 = FStarC_TypeChecker_Env.binders_of_bindings - (FStarC_Compiler_List.rev r1) in + (FStarC_List.rev r1) in close_forall_no_univs uu___3 phi1 in let t2 = let uu___3 = FStarC_TypeChecker_Env.binders_of_bindings - (FStarC_Compiler_List.rev r2) in + (FStarC_List.rev r2) in close_forall_no_univs uu___3 phi2 in let goal_sc = let uu___3 = @@ -5947,7 +5940,7 @@ let (join_goals : (uu___7.FStarC_TypeChecker_Env.curmodule); FStarC_TypeChecker_Env.gamma = - (FStarC_Compiler_List.rev + (FStarC_List.rev gamma); FStarC_TypeChecker_Env.gamma_sig = @@ -6126,7 +6119,7 @@ let (join_goals : = FStarC_Tactics_Printing.goal_to_string_verbose goal in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "join_goals of\n(%s)\nand\n(%s)\n= (%s)\n" uu___10 uu___11 @@ -6277,7 +6270,7 @@ let (unquote : (fun uu___2 -> let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 "unquote: tm = %s\n" uu___3) in + FStarC_Util.print1 "unquote: tm = %s\n" uu___3) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 @@ -6313,7 +6306,7 @@ let (unquote : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "unquote: tm' = %s\n" uu___7) in Obj.magic @@ -6331,7 +6324,7 @@ let (unquote : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term typ in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "unquote: typ = %s\n" uu___9) in Obj.magic @@ -6444,7 +6437,7 @@ let (uvar_env : (ret (typ, FStarC_TypeChecker_Env.trivial_guard, - FStarC_Compiler_Range_Type.dummyRange))) + FStarC_Range_Type.dummyRange))) uu___2)) in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -7146,9 +7139,8 @@ let (launch_process : if uu___1 then let s = - FStarC_Compiler_Util.run_process - "tactic_launch" prog args - (FStar_Pervasives_Native.Some input) in + FStarC_Util.run_process "tactic_launch" prog + args (FStar_Pervasives_Native.Some input) in Obj.magic (ret s) else Obj.magic @@ -7177,7 +7169,7 @@ let (change : FStarC_Syntax_Syntax.typ -> unit FStarC_Tactics_Monad.tac) = (fun uu___2 -> let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ty in - FStarC_Compiler_Util.print1 "change: ty = %s\n" uu___3) in + FStarC_Util.print1 "change: ty = %s\n" uu___3) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 (fun uu___2 -> @@ -7494,9 +7486,9 @@ let (t_destruct : let uu___14 = failwhen - ((FStarC_Compiler_List.length + ((FStarC_List.length a_us) <> - (FStarC_Compiler_List.length + (FStarC_List.length t_us)) "t_us don't match?" in Obj.magic @@ -7592,9 +7584,9 @@ let (t_destruct : let uu___22 = failwhen - ((FStarC_Compiler_List.length + ((FStarC_List.length a_us) <> - (FStarC_Compiler_List.length + (FStarC_List.length c_us)) "t_us don't match?" in FStarC_Class_Monad.op_let_Bang @@ -7678,7 +7670,7 @@ let (t_destruct : (bv.FStarC_Syntax_Syntax.sort) } in let bs' = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___27 = @@ -7699,7 +7691,7 @@ let (t_destruct : }) bs in let subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___27 -> @@ -7759,7 +7751,7 @@ let (t_destruct : comp1) -> let uu___27 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt nparam bs1 in (match uu___27 @@ -7818,7 +7810,7 @@ let (t_destruct : -> false in let uu___30 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt nparam args in match uu___30 @@ -7829,9 +7821,9 @@ let (t_destruct : let uu___31 = failwhen - ((FStarC_Compiler_List.length + ((FStarC_List.length a_ps) <> - (FStarC_Compiler_List.length + (FStarC_List.length d_ps)) "params not match?" in Obj.magic @@ -7851,11 +7843,11 @@ let (t_destruct : uu___32 in let d_ps_a_ps = - FStarC_Compiler_List.zip + FStarC_List.zip d_ps a_ps in let subst = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___33 -> @@ -7882,7 +7874,7 @@ let (t_destruct : subst bs2 in let subpats_1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___33 -> @@ -7909,7 +7901,7 @@ let (t_destruct : d_ps_a_ps in let subpats_2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___33 -> @@ -7933,7 +7925,7 @@ let (t_destruct : bq))) bs3 in let subpats = - FStarC_Compiler_List.op_At + FStarC_List.op_At subpats_1 subpats_2 in let pat = @@ -8235,7 +8227,7 @@ let (t_destruct : let uu___43 = FStarC_BigInt.of_int_fs - (FStarC_Compiler_List.length + (FStarC_List.length bs3) in (fv1, uu___43) in @@ -8275,7 +8267,7 @@ let (t_destruct : goal_brs in let uu___18 = - FStarC_Compiler_List.unzip3 + FStarC_List.unzip3 goal_brs in match uu___18 with @@ -8610,7 +8602,7 @@ let rec (inspect : | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, ps) -> let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (p1, b) -> @@ -8621,15 +8613,14 @@ let rec (inspect : | FStarC_Syntax_Syntax.Pat_var bv -> FStarC_Reflection_V1_Data.Pat_Var (bv, - (FStarC_Compiler_Sealed.seal + (FStarC_Sealed.seal bv.FStarC_Syntax_Syntax.sort)) | FStarC_Syntax_Syntax.Pat_dot_term eopt -> FStarC_Reflection_V1_Data.Pat_Dot_Term eopt in let brs1 = - FStarC_Compiler_List.map - FStarC_Syntax_Subst.open_branch brs in + FStarC_List.map FStarC_Syntax_Subst.open_branch brs in let brs2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (pat, uu___4, t4) -> @@ -8649,7 +8640,7 @@ let rec (inspect : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "inspect: outside of expected syntax (%s, %s)\n" uu___5 uu___6 in FStarC_Errors.log_issue @@ -8696,7 +8687,7 @@ let (pack' : | FStarC_Reflection_V1_Data.Tv_Type u -> let uu___ = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in ret uu___ | FStarC_Reflection_V1_Data.Tv_Refine (bv, sort, t) -> let bv1 = @@ -8711,13 +8702,12 @@ let (pack' : let uu___1 = let uu___2 = FStarC_Reflection_V1_Builtins.pack_const c in FStarC_Syntax_Syntax.Tm_constant uu___2 in - FStarC_Syntax_Syntax.mk uu___1 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Syntax_Syntax.mk uu___1 FStarC_Range_Type.dummyRange in ret uu___ | FStarC_Reflection_V1_Data.Tv_Uvar (_u, ctx_u_s) -> let uu___ = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_uvar ctx_u_s) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in ret uu___ | FStarC_Reflection_V1_Data.Tv_Let (false, attrs, bv, ty, t1, t2) -> let bv1 = @@ -8730,7 +8720,7 @@ let (pack' : FStarC_Syntax_Util.mk_letbinding (FStar_Pervasives.Inl bv1) [] bv1.FStarC_Syntax_Syntax.sort FStarC_Parser_Const.effect_Tot_lid t1 attrs - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___ = let uu___1 = let uu___2 = @@ -8744,8 +8734,7 @@ let (pack' : FStarC_Syntax_Syntax.body1 = uu___3 } in FStarC_Syntax_Syntax.Tm_let uu___2 in - FStarC_Syntax_Syntax.mk uu___1 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Syntax_Syntax.mk uu___1 FStarC_Range_Type.dummyRange in ret uu___ | FStarC_Reflection_V1_Data.Tv_Let (true, attrs, bv, ty, t1, t2) -> let bv1 = @@ -8758,7 +8747,7 @@ let (pack' : FStarC_Syntax_Util.mk_letbinding (FStar_Pervasives.Inl bv1) [] bv1.FStarC_Syntax_Syntax.sort FStarC_Parser_Const.effect_Tot_lid t1 attrs - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___ = FStarC_Syntax_Subst.close_let_rec [lb] t2 in (match uu___ with | (lbs, body) -> @@ -8768,13 +8757,13 @@ let (pack' : { FStarC_Syntax_Syntax.lbs = (true, lbs); FStarC_Syntax_Syntax.body1 = body - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in ret uu___1) | FStarC_Reflection_V1_Data.Tv_Match (t, ret_opt, brs) -> let wrap v = { FStarC_Syntax_Syntax.v = v; - FStarC_Syntax_Syntax.p = FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.p = FStarC_Range_Type.dummyRange } in let rec pack_pat p = match p with @@ -8787,7 +8776,7 @@ let (pack' : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (p1, b) -> @@ -8800,14 +8789,13 @@ let (pack' : | FStarC_Reflection_V1_Data.Pat_Dot_Term eopt -> wrap (FStarC_Syntax_Syntax.Pat_dot_term eopt) in let brs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (pat, t1) -> let uu___1 = pack_pat pat in (uu___1, FStar_Pervasives_Native.None, t1)) brs in - let brs2 = - FStarC_Compiler_List.map FStarC_Syntax_Subst.close_branch brs1 in + let brs2 = FStarC_List.map FStarC_Syntax_Subst.close_branch brs1 in let uu___ = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_match @@ -8817,7 +8805,7 @@ let (pack' : FStarC_Syntax_Syntax.brs = brs2; FStarC_Syntax_Syntax.rc_opt1 = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in ret uu___ | FStarC_Reflection_V1_Data.Tv_AscribedT (e, t, tacopt, use_eq) -> let uu___ = @@ -8829,7 +8817,7 @@ let (pack' : ((FStar_Pervasives.Inl t), tacopt, use_eq); FStarC_Syntax_Syntax.eff_opt = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in ret uu___ | FStarC_Reflection_V1_Data.Tv_AscribedC (e, c, tacopt, use_eq) -> let uu___ = @@ -8841,12 +8829,12 @@ let (pack' : ((FStar_Pervasives.Inr c), tacopt, use_eq); FStarC_Syntax_Syntax.eff_opt = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in ret uu___ | FStarC_Reflection_V1_Data.Tv_Unknown -> let uu___ = FStarC_Syntax_Syntax.mk FStarC_Syntax_Syntax.Tm_unknown - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in ret uu___ | FStarC_Reflection_V1_Data.Tv_Unsupp -> FStarC_Tactics_Monad.fail "cannot pack Tv_Unsupp" @@ -8872,7 +8860,7 @@ let (lget : (fun ps -> let ps = Obj.magic ps in let uu___1 = - FStarC_Compiler_Util.psmap_try_find + FStarC_Util.psmap_try_find ps.FStarC_Tactics_Types.local_state k in match uu___1 with | FStar_Pervasives_Native.None -> @@ -8896,7 +8884,7 @@ let (lset : let ps = Obj.magic ps in let ps1 = let uu___1 = - FStarC_Compiler_Util.psmap_add + FStarC_Util.psmap_add ps.FStarC_Tactics_Types.local_state k t in { FStarC_Tactics_Types.main_context = @@ -8995,7 +8983,7 @@ let (t_commute_applied_match : unit -> unit FStarC_Tactics_Monad.tac) = FStarC_Syntax_Syntax.rc_opt1 = lopt;_} -> let brs' = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (p, w, e1) -> @@ -9003,18 +8991,17 @@ let (t_commute_applied_match : unit -> unit FStarC_Tactics_Monad.tac) = FStarC_Syntax_Util.mk_app e1 las in (p, w, uu___6)) brs in let lopt' = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun rc -> let uu___5 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun t -> let uu___6 = let uu___7 = FStarC_Tactics_Types.goal_env g in FStarC_TypeChecker_Normalize.get_n_binders - uu___7 - (FStarC_Compiler_List.length - las) t in + uu___7 (FStarC_List.length las) + t in match uu___6 with | (bs, c) -> let uu___7 = @@ -9023,7 +9010,7 @@ let (t_commute_applied_match : unit -> unit FStarC_Tactics_Monad.tac) = (match uu___7 with | (bs1, c1) -> let ss = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun a -> FStarC_Syntax_Syntax.NT @@ -9145,8 +9132,7 @@ let (push_bv_dsenv : = fun e -> fun i -> - let ident = - FStarC_Ident.mk_ident (i, FStarC_Compiler_Range_Type.dummyRange) in + let ident = FStarC_Ident.mk_ident (i, FStarC_Range_Type.dummyRange) in let uu___ = FStarC_Syntax_DsEnv.push_bv e.FStarC_TypeChecker_Env.dsenv ident in match uu___ with @@ -9267,11 +9253,9 @@ let (comp_to_string : let s = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in ret s let (range_to_string : - FStarC_Compiler_Range_Type.range -> Prims.string FStarC_Tactics_Monad.tac) - = + FStarC_Range_Type.range -> Prims.string FStarC_Tactics_Monad.tac) = fun r -> - let uu___ = - FStarC_Class_Show.show FStarC_Compiler_Range_Ops.showable_range r in + let uu___ = FStarC_Class_Show.show FStarC_Range_Ops.showable_range r in ret uu___ let (term_eq_old : FStarC_Syntax_Syntax.term -> @@ -9390,10 +9374,10 @@ let (free_uvars : let uu___2 = FStarC_Syntax_Free.uvars_uncached tm in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) in - FStarC_Compiler_List.map + FStarC_List.map (fun u -> let uu___2 = FStarC_Syntax_Unionfind.uvar_id @@ -9403,9 +9387,9 @@ let (free_uvars : let (dbg_refl : env -> (unit -> Prims.string) -> unit) = fun g -> fun msg -> - let uu___ = FStarC_Compiler_Effect.op_Bang dbg_ReflTc in + let uu___ = FStarC_Effect.op_Bang dbg_ReflTc in if uu___ - then let uu___1 = msg () in FStarC_Compiler_Util.print_string uu___1 + then let uu___1 = msg () in FStarC_Util.print_string uu___1 else () type issues = FStarC_Errors.issue Prims.list let refl_typing_builtin_wrapper : @@ -9424,7 +9408,7 @@ let refl_typing_builtin_wrapper : | uu___1 -> let issue = let uu___2 = - let uu___3 = FStarC_Compiler_Util.print_exn uu___1 in + let uu___3 = FStarC_Util.print_exn uu___1 in FStarC_Errors_Msg.mkmsg uu___3 in let uu___3 = FStarC_Errors.get_ctx () in { @@ -9439,7 +9423,7 @@ let refl_typing_builtin_wrapper : match uu___ with | (errs, r) -> (FStarC_Syntax_Unionfind.rollback tx; - if (FStarC_Compiler_List.length errs) > Prims.int_zero + if (FStarC_List.length errs) > Prims.int_zero then ret (FStar_Pervasives_Native.None, errs) else ret (r, errs)) let (no_uvars_in_term : FStarC_Syntax_Syntax.term -> Prims.bool) = @@ -9447,17 +9431,17 @@ let (no_uvars_in_term : FStarC_Syntax_Syntax.term -> Prims.bool) = (let uu___ = FStarC_Syntax_Free.uvars t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___)) && (let uu___ = FStarC_Syntax_Free.univs t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) + (Obj.magic uu___)) let (no_uvars_in_g : env -> Prims.bool) = fun g -> - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Binding_var bv -> @@ -9470,8 +9454,8 @@ let (uu___is_Subtyping : relation -> Prims.bool) = fun projectee -> match projectee with | Subtyping -> true | uu___ -> false let (uu___is_Equality : relation -> Prims.bool) = fun projectee -> match projectee with | Equality -> true | uu___ -> false -let (unexpected_uvars_issue : - FStarC_Compiler_Range_Type.range -> FStarC_Errors.issue) = +let (unexpected_uvars_issue : FStarC_Range_Type.range -> FStarC_Errors.issue) + = fun r -> let i = let uu___ = FStarC_Errors_Msg.mkmsg "Cannot check relation with uvars" in diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_V1_Primops.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V1_Primops.ml similarity index 99% rename from stage0/fstar-lib/generated/FStarC_Tactics_V1_Primops.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V1_Primops.ml index e31cae822c5..5cf827285b4 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_V1_Primops.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V1_Primops.ml @@ -10,7 +10,7 @@ let (fix_module : fun ps -> let p = FStarC_Ident.path_of_lid ps.FStarC_TypeChecker_Primops_Base.name in let uu___ = - FStarC_Compiler_Path.is_under + FStarC_Path.is_under (FStarC_Class_Ord.ord_eq FStarC_Class_Ord.ord_string) p ["FStar"; "Stubs"; "Tactics"; "V2"; "Builtins"] in if uu___ @@ -20,13 +20,12 @@ let (fix_module : let uu___2 = let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_List.tl p in - FStarC_Compiler_List.tl uu___5 in - FStarC_Compiler_List.tl uu___4 in - FStarC_Compiler_List.tl uu___3 in - FStarC_Compiler_List.tl uu___2 in - FStarC_Compiler_List.op_At - ["FStar"; "Stubs"; "Tactics"; "V1"; "Builtins"] uu___1 in + let uu___5 = FStarC_List.tl p in FStarC_List.tl uu___5 in + FStarC_List.tl uu___4 in + FStarC_List.tl uu___3 in + FStarC_List.tl uu___2 in + FStarC_List.op_At ["FStar"; "Stubs"; "Tactics"; "V1"; "Builtins"] + uu___1 in let uu___1 = let uu___2 = FStarC_Class_HasRange.pos FStarC_Ident.hasrange_lident @@ -1201,4 +1200,4 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = uu___5 :: uu___6 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStarC_Compiler_List.map fix_module uu___ \ No newline at end of file + FStarC_List.map fix_module uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_V2_Basic.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V2_Basic.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_Tactics_V2_Basic.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V2_Basic.ml index 5a9e9d9dbab..5772e1d9663 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_V2_Basic.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V2_Basic.ml @@ -1,14 +1,22 @@ open Prims -let (dbg_Tac : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Tac" -let (dbg_TacUnify : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "TacUnify" -let (dbg_2635 : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "2635" -let (dbg_ReflTc : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ReflTc" -let (dbg_TacVerbose : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "TacVerbose" +let (dbg_Tac : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Tac" +let (dbg_TacUnify : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "TacUnify" +let (dbg_2635 : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "2635" +let (dbg_ReflTc : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ReflTc" +let (dbg_TacVerbose : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "TacVerbose" +let (fixup_range : + FStarC_Range_Type.range -> FStarC_Range_Type.range FStarC_Tactics_Monad.tac) + = + fun uu___ -> + (fun r -> + let uu___ = FStarC_Errors.maybe_bound_range r in + Obj.magic + (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () + (Obj.magic uu___))) uu___ let (compress : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term FStarC_Tactics_Monad.tac) @@ -47,7 +55,7 @@ let (core_check : then FStar_Pervasives.Inl FStar_Pervasives_Native.None else (let debug f = - let uu___2 = FStarC_Compiler_Debug.any () in + let uu___2 = FStarC_Debug.any () in if uu___2 then f () else () in let uu___2 = FStarC_TypeChecker_Core.check_term env sol t must_tot in @@ -65,7 +73,7 @@ let (core_check : let uu___5 = let uu___6 = FStarC_TypeChecker_Env.get_range env in FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range uu___6 in + FStarC_Range_Ops.showable_range uu___6 in let uu___6 = FStarC_TypeChecker_Core.print_error_short err in let uu___7 = @@ -75,15 +83,14 @@ let (core_check : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___9 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "(%s) Core checking failed (%s) on term %s and type %s\n%s\n" uu___5 uu___6 uu___7 uu___8 uu___9); FStar_Pervasives.Inr err)) type name = FStarC_Syntax_Syntax.bv type env = FStarC_TypeChecker_Env.env type implicits = FStarC_TypeChecker_Env.implicits -let (rangeof : FStarC_Tactics_Types.goal -> FStarC_Compiler_Range_Type.range) - = +let (rangeof : FStarC_Tactics_Types.goal -> FStarC_Range_Type.range) = fun g -> (g.FStarC_Tactics_Types.goal_ctx_uvar).FStarC_Syntax_Syntax.ctx_uvar_range let (normalize : @@ -113,26 +120,26 @@ let (bnorm_goal : FStarC_Tactics_Types.goal -> FStarC_Tactics_Types.goal) = let uu___2 = FStarC_Tactics_Types.goal_type g in bnorm uu___1 uu___2 in FStarC_Tactics_Monad.goal_with_type g uu___ let (tacprint : Prims.string -> unit) = - fun s -> FStarC_Compiler_Util.print1 "TAC>> %s\n" s + fun s -> FStarC_Util.print1 "TAC>> %s\n" s let (tacprint1 : Prims.string -> Prims.string -> unit) = fun s -> fun x -> - let uu___ = FStarC_Compiler_Util.format1 s x in - FStarC_Compiler_Util.print1 "TAC>> %s\n" uu___ + let uu___ = FStarC_Util.format1 s x in + FStarC_Util.print1 "TAC>> %s\n" uu___ let (tacprint2 : Prims.string -> Prims.string -> Prims.string -> unit) = fun s -> fun x -> fun y -> - let uu___ = FStarC_Compiler_Util.format2 s x y in - FStarC_Compiler_Util.print1 "TAC>> %s\n" uu___ + let uu___ = FStarC_Util.format2 s x y in + FStarC_Util.print1 "TAC>> %s\n" uu___ let (tacprint3 : Prims.string -> Prims.string -> Prims.string -> Prims.string -> unit) = fun s -> fun x -> fun y -> fun z -> - let uu___ = FStarC_Compiler_Util.format3 s x y z in - FStarC_Compiler_Util.print1 "TAC>> %s\n" uu___ + let uu___ = FStarC_Util.format3 s x y z in + FStarC_Util.print1 "TAC>> %s\n" uu___ let (print : Prims.string -> unit FStarC_Tactics_Monad.tac) = fun msg -> (let uu___1 = @@ -152,7 +159,7 @@ let (debugging : unit -> Prims.bool FStarC_Tactics_Monad.tac) = (fun uu___2 -> (fun uu___2 -> let uu___2 = Obj.magic uu___2 in - let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Tac in + let uu___3 = FStarC_Effect.op_Bang dbg_Tac in Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () (Obj.magic uu___3))) uu___2))) uu___ @@ -189,7 +196,7 @@ let (dump_all : Prims.bool -> Prims.string -> unit FStarC_Tactics_Monad.tac) FStarC_Tactics_Monad.mk_tac (fun ps -> let gs = - FStarC_Compiler_List.map + FStarC_List.map (fun i -> FStarC_Tactics_Types.goal_of_implicit ps.FStarC_Tactics_Types.main_context i) @@ -198,7 +205,7 @@ let (dump_all : Prims.bool -> Prims.string -> unit FStarC_Tactics_Monad.tac) if print_resolved then gs else - FStarC_Compiler_List.filter + FStarC_List.filter (fun g -> let uu___1 = FStarC_Tactics_Types.check_goal_solved g in Prims.op_Negation uu___1) gs in @@ -242,13 +249,12 @@ let (dump_uvars_of : FStarC_Syntax_Free.uvars uu___1 in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in let gs = - FStarC_Compiler_List.map - (FStarC_Tactics_Types.goal_of_ctx_uvar g) uvs in + FStarC_List.map (FStarC_Tactics_Types.goal_of_ctx_uvar g) uvs in let gs1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun g1 -> let uu___ = FStarC_Tactics_Types.check_goal_solved g1 in Prims.op_Negation uu___) gs in @@ -283,7 +289,7 @@ let fail1 : 'uuuuu . Prims.string -> Prims.string -> 'uuuuu FStarC_Tactics_Monad.tac = fun msg -> fun x -> - let uu___ = FStarC_Compiler_Util.format1 msg x in + let uu___ = FStarC_Util.format1 msg x in FStarC_Tactics_Monad.fail uu___ let fail2 : 'uuuuu . @@ -293,7 +299,7 @@ let fail2 : fun msg -> fun x -> fun y -> - let uu___ = FStarC_Compiler_Util.format2 msg x y in + let uu___ = FStarC_Util.format2 msg x y in FStarC_Tactics_Monad.fail uu___ let fail3 : 'uuuuu . @@ -305,7 +311,7 @@ let fail3 : fun x -> fun y -> fun z -> - let uu___ = FStarC_Compiler_Util.format3 msg x y z in + let uu___ = FStarC_Util.format3 msg x y z in FStarC_Tactics_Monad.fail uu___ let fail4 : 'uuuuu . @@ -319,7 +325,7 @@ let fail4 : fun y -> fun z -> fun w -> - let uu___ = FStarC_Compiler_Util.format4 msg x y z w in + let uu___ = FStarC_Util.format4 msg x y z w in FStarC_Tactics_Monad.fail uu___ let (destruct_eq' : FStarC_Syntax_Syntax.typ -> @@ -481,8 +487,7 @@ let (proc_guard_formula : env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option - -> - FStarC_Compiler_Range_Type.range -> unit FStarC_Tactics_Monad.tac) + -> FStarC_Range_Type.range -> unit FStarC_Tactics_Monad.tac) = fun reason -> fun e -> @@ -500,7 +505,7 @@ let (proc_guard_formula : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Tactics admitted guard <%s>\n\n" uu___2 in FStarC_Errors.log_issue FStarC_TypeChecker_Env.hasRange_env e @@ -518,7 +523,7 @@ let (proc_guard_formula : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Making guard (%s:%s) into a goal\n" reason uu___2) in Obj.magic @@ -547,7 +552,7 @@ let (proc_guard_formula : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Pushing guard (%s:%s) as SMT goal\n" reason uu___2) in Obj.magic @@ -576,7 +581,7 @@ let (proc_guard_formula : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Sending guard (%s:%s) to SMT Synchronously\n" reason uu___2) in Obj.magic @@ -613,8 +618,8 @@ let (proc_guard_formula : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print2 - "Forcing guard (%s:%s)\n" reason uu___2) in + FStarC_Util.print2 "Forcing guard (%s:%s)\n" + reason uu___2) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ @@ -667,7 +672,7 @@ let (proc_guard_formula : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "guard = %s\n" uu___5) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () @@ -688,7 +693,7 @@ let (proc_guard_formula : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Forcing guard WITH SMT (%s:%s)\n" reason uu___2) in Obj.magic @@ -743,7 +748,7 @@ let (proc_guard_formula : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "guard = %s\n" uu___5) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () @@ -764,7 +769,7 @@ let (proc_guard' : FStarC_TypeChecker_Common.guard_t -> FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> unit FStarC_Tactics_Monad.tac) + FStarC_Range_Type.range -> unit FStarC_Tactics_Monad.tac) = fun simplify -> fun reason -> @@ -776,8 +781,8 @@ let (proc_guard' : FStarC_Tactics_Monad.log (fun uu___1 -> let uu___2 = FStarC_TypeChecker_Rel.guard_to_string e g in - FStarC_Compiler_Util.print2 "Processing guard (%s:%s)\n" - reason uu___2) in + FStarC_Util.print2 "Processing guard (%s:%s)\n" reason + uu___2) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ (fun uu___1 -> @@ -785,12 +790,12 @@ let (proc_guard' : let uu___1 = Obj.magic uu___1 in let imps = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in (match sc_opt with | FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Allow_untyped r) -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun imp -> FStarC_Tactics_Monad.mark_uvar_with_should_check_tag imp.FStarC_TypeChecker_Common.imp_uvar @@ -827,8 +832,7 @@ let (proc_guard : env -> FStarC_TypeChecker_Common.guard_t -> FStarC_Syntax_Syntax.should_check_uvar FStar_Pervasives_Native.option - -> - FStarC_Compiler_Range_Type.range -> unit FStarC_Tactics_Monad.tac) + -> FStarC_Range_Type.range -> unit FStarC_Tactics_Monad.tac) = proc_guard' true let (tc_unifier_solved_implicits : FStarC_TypeChecker_Env.env -> @@ -1156,7 +1160,7 @@ let (__do_unify_wflags : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "%%%%%%%%do_unify %s =? %s\n" uu___1 uu___2) else (); @@ -1168,7 +1172,7 @@ let (__do_unify_wflags : (Obj.repr (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) ())) | Check_left_only -> @@ -1188,13 +1192,13 @@ let (__do_unify_wflags : FStarC_Syntax_Free.uvars t2 in FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) (Obj.magic uu___3))) in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___1) in let uu___1 = @@ -1243,7 +1247,7 @@ let (__do_unify_wflags : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "%%%%%%%%do_unify (RESULT %s) %s =? %s\n" uu___6 uu___7 @@ -1286,7 +1290,7 @@ let (__do_unify_wflags : let uu___9 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in FStarC_Tactics_Monad.add_implicits @@ -1333,9 +1337,9 @@ let (__do_unify_wflags : let uu___10 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range r in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 ">> do_unify error, (%s) at (%s)\n" uu___9 uu___10) in @@ -1415,8 +1419,7 @@ let (__do_unify : (fun uu___1 -> let uu___1 = Obj.magic uu___1 in (let uu___3 = - FStarC_Compiler_Effect.op_Bang - dbg_TacUnify in + FStarC_Effect.op_Bang dbg_TacUnify in if uu___3 then (FStarC_Options.push (); @@ -1427,8 +1430,7 @@ let (__do_unify : else ()); (let uu___3 = let uu___4 = - FStarC_Compiler_Effect.op_Bang - dbg_TacUnify in + FStarC_Effect.op_Bang dbg_TacUnify in __do_unify_wflags uu___4 allow_guards must_tot check_side env1 t1 t2 in @@ -1440,7 +1442,7 @@ let (__do_unify : (fun r -> let r = Obj.magic r in (let uu___5 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_TacUnify in if uu___5 then FStarC_Options.pop () @@ -1581,7 +1583,7 @@ let (do_match : let uu___3 = FStarC_Class_Setlike.equal () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs1) (Obj.magic uvs2) in @@ -1663,7 +1665,7 @@ let (do_match_on_lhs : FStarC_Class_Setlike.equal () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs1) (Obj.magic uvs2) in @@ -1702,7 +1704,7 @@ let (set_solution : | FStar_Pervasives_Native.Some uu___1 -> let uu___2 = let uu___3 = FStarC_Tactics_Printing.goal_to_string_verbose goal in - FStarC_Compiler_Util.format1 "Goal %s is already solved" uu___3 in + FStarC_Util.format1 "Goal %s is already solved" uu___3 in FStarC_Tactics_Monad.fail uu___2 | FStar_Pervasives_Native.None -> (FStarC_Syntax_Unionfind.change @@ -1738,7 +1740,7 @@ let (solve : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term solution in - FStarC_Compiler_Util.print2 "solve %s := %s\n" uu___2 uu___3) in + FStarC_Util.print2 "solve %s := %s\n" uu___2 uu___3) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ (fun uu___1 -> @@ -1859,14 +1861,13 @@ let meas : FStarC_Tactics_Monad.mk_tac (fun ps -> let uu___ = - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___1 -> FStarC_Tactics_Monad.run f ps) in match uu___ with | (r, ms) -> ((let uu___2 = FStarC_Class_Show.show FStarC_Class_Show.showable_int ms in - FStarC_Compiler_Util.print2 "++ Tactic %s ran in \t\t%sms\n" - s uu___2); + FStarC_Util.print2 "++ Tactic %s ran in \t\t%sms\n" s uu___2); r)) let (tadmit_t : FStarC_Syntax_Syntax.term -> unit FStarC_Tactics_Monad.tac) = fun t -> @@ -1968,7 +1969,7 @@ let (curms : unit -> FStarC_BigInt.t FStarC_Tactics_Monad.tac) = fun uu___ -> (fun uu___ -> let uu___1 = - let uu___2 = FStarC_Compiler_Util.get_time_of_day_ms () in + let uu___2 = FStarC_Util.get_time_of_day_ms () in FStarC_BigInt.of_int_fs uu___2 in Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () @@ -1995,8 +1996,7 @@ let (__tc : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 "Tac> __tc(%s)\n" - uu___2) in + FStarC_Util.print1 "Tac> __tc(%s)\n" uu___2) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ @@ -2051,8 +2051,7 @@ let (__tc : FStarC_Pprint.op_Hat_Slash_Hat uu___9 uu___10 in [uu___8] in - FStarC_Compiler_List.op_At uu___7 - msg in + FStarC_List.op_At uu___7 msg in FStarC_Tactics_Monad.fail_doc uu___6)) uu___1))) uu___))) uu___1 uu___ let (__tc_ghost : @@ -2077,8 +2076,8 @@ let (__tc_ghost : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 - "Tac> __tc_ghost(%s)\n" uu___2) in + FStarC_Util.print1 "Tac> __tc_ghost(%s)\n" + uu___2) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ @@ -2255,8 +2254,7 @@ let (__tc_ghost : FStarC_Pprint.op_Hat_Slash_Hat uu___9 uu___10 in [uu___8] in - FStarC_Compiler_List.op_At uu___7 - msg in + FStarC_List.op_At uu___7 msg in FStarC_Tactics_Monad.fail_doc uu___6)) uu___1))) uu___))) uu___1 uu___ let (__tc_lax : @@ -2288,7 +2286,7 @@ let (__tc_lax : (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) uu___4 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Tac> __tc_lax(%s)(Context:%s)\n" uu___2 uu___3) in Obj.magic @@ -2577,8 +2575,7 @@ let (__tc_lax : FStarC_Pprint.op_Hat_Slash_Hat uu___9 uu___10 in [uu___8] in - FStarC_Compiler_List.op_At uu___7 - msg in + FStarC_List.op_At uu___7 msg in FStarC_Tactics_Monad.fail_doc uu___6)) uu___1))) uu___))) uu___1 uu___ let (tcc : @@ -2621,10 +2618,10 @@ let (tc : (fun uu___2 -> (fun c -> let c = Obj.magic c in + let uu___2 = FStarC_Syntax_Util.comp_result c in Obj.magic (FStarC_Class_Monad.return - FStarC_Tactics_Monad.monad_tac () - (Obj.magic (FStarC_Syntax_Util.comp_result c)))) + FStarC_Tactics_Monad.monad_tac () (Obj.magic uu___2))) uu___2)) in FStarC_Tactics_Monad.wrap_err "tc" uu___ let rec map : @@ -2702,7 +2699,7 @@ let (bv_to_binding : let uu___2 = FStarC_Class_Show.show FStarC_Ident.showable_ident bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Sealed.seal uu___2 in + FStarC_Sealed.seal uu___2 in { FStarC_Reflection_V2_Data.uniq1 = uu___; FStarC_Reflection_V2_Data.sort3 = (bv.FStarC_Syntax_Syntax.sort); @@ -2719,16 +2716,15 @@ let (binding_to_string : FStarC_Reflection_V2_Data.binding -> Prims.string) = FStarC_BigInt.to_int_fs b.FStarC_Reflection_V2_Data.uniq1 in FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___2 in Prims.strcat "#" uu___1 in - Prims.strcat - (FStarC_Compiler_Sealed.unseal b.FStarC_Reflection_V2_Data.ppname3) + Prims.strcat (FStarC_Sealed.unseal b.FStarC_Reflection_V2_Data.ppname3) uu___ let (binding_to_bv : FStarC_Reflection_V2_Data.binding -> FStarC_Syntax_Syntax.bv) = fun b -> let uu___ = FStarC_Ident.mk_ident - ((FStarC_Compiler_Sealed.unseal b.FStarC_Reflection_V2_Data.ppname3), - FStarC_Compiler_Range_Type.dummyRange) in + ((FStarC_Sealed.unseal b.FStarC_Reflection_V2_Data.ppname3), + FStarC_Range_Type.dummyRange) in let uu___1 = FStarC_BigInt.to_int_fs b.FStarC_Reflection_V2_Data.uniq1 in { FStarC_Syntax_Syntax.ppname = uu___; @@ -2886,7 +2882,7 @@ let (intros : let uu___2 = if max1 >= Prims.int_zero then - let uu___3 = FStarC_Compiler_List.splitAt max1 bs in + let uu___3 = FStarC_List.splitAt max1 bs in match uu___3 with | (bs0, bs1) -> let c1 = @@ -3002,7 +2998,7 @@ let (intros : uu___11 in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map binder_to_binding bs2 in Obj.magic @@ -3029,9 +3025,9 @@ let (intro_rec : (fun uu___1 -> (fun goal -> let goal = Obj.magic goal in - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "WARNING (intro_rec): calling this is known to cause normalizer loops\n"; - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "WARNING (intro_rec): proceed at your own risk...\n"; (let uu___3 = let uu___4 = FStarC_Tactics_Types.goal_env goal in @@ -3062,15 +3058,17 @@ let (intro_rec : FStar_Pervasives_Native.None uu___6 in let uu___6 = let uu___7 = - let uu___8 = - should_check_goal_uvar goal in - FStar_Pervasives_Native.Some uu___8 in + FStarC_Syntax_Util.comp_result c in let uu___8 = + let uu___9 = + should_check_goal_uvar goal in + FStar_Pervasives_Native.Some uu___9 in + let uu___9 = FStarC_Tactics_Monad.goal_typedness_deps goal in FStarC_Tactics_Monad.new_uvar "intro_rec" - env' (FStarC_Syntax_Util.comp_result c) - uu___7 uu___8 (rangeof goal) in + env' uu___7 uu___8 uu___9 + (rangeof goal) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () (Obj.magic uu___6) @@ -3092,7 +3090,7 @@ let (intro_rec : [] uu___8 FStarC_Parser_Const.effect_Tot_lid uu___9 [] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let body = FStarC_Syntax_Syntax.bv_to_name bv in @@ -3211,7 +3209,7 @@ let (norm : let uu___3 = FStarC_Tactics_Types.goal_witness goal in FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___3 in - FStarC_Compiler_Util.print1 "norm: witness = %s\n" uu___2) in + FStarC_Util.print1 "norm: witness = %s\n" uu___2) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ @@ -3221,7 +3219,7 @@ let (norm : let steps = let uu___2 = FStarC_TypeChecker_Cfg.translate_norm_steps s in - FStarC_Compiler_List.op_At + FStarC_List.op_At [FStarC_TypeChecker_Env.Reify; FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]] uu___2 in @@ -3257,8 +3255,8 @@ let (__norm_term_env : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 - "norm_term_env: t = %s\n" uu___3) in + FStarC_Util.print1 "norm_term_env: t = %s\n" + uu___3) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 @@ -3300,7 +3298,7 @@ let (__norm_term_env : let uu___4 = FStarC_TypeChecker_Cfg.translate_norm_steps s in - FStarC_Compiler_List.op_At + FStarC_List.op_At [FStarC_TypeChecker_Env.Reify; FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]] @@ -3316,7 +3314,7 @@ let (__norm_term_env : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "norm_term_env: t' = %s\n" uu___6) in Obj.magic @@ -3374,7 +3372,7 @@ let (refine_intro : unit -> unit FStarC_Tactics_Monad.tac) = match uu___5 with | (bvs, phi1) -> let uu___6 = - let uu___7 = FStarC_Compiler_List.hd bvs in + let uu___7 = FStarC_List.hd bvs in uu___7.FStarC_Syntax_Syntax.binder_bv in (uu___6, phi1) in match uu___4 with @@ -3559,7 +3557,7 @@ let (__exact_now : FStarC_Tactics_Types.goal_env goal in FStarC_TypeChecker_Rel.guard_to_string uu___6 guard in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "__exact_now: got type %s\n__exact_now: and guard %s\n" uu___4 uu___5) in Obj.magic @@ -3601,7 +3599,7 @@ let (__exact_now : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___10 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "__exact_now: unifying %s and %s\n" uu___8 uu___9) in Obj.magic @@ -3741,7 +3739,7 @@ let (t_exact : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 "t_exact: tm = %s\n" uu___3) in + FStarC_Util.print1 "t_exact: tm = %s\n" uu___3) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 (fun uu___2 -> @@ -3770,7 +3768,7 @@ let (t_exact : let uu___5 = FStarC_Tactics_Monad.if_verbose (fun uu___6 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "__exact_now failed, trying refine...\n") in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -3827,7 +3825,7 @@ let (t_exact : FStarC_Tactics_Monad.if_verbose (fun uu___10 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "__exact_now: failed after refining too\n") in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -3855,7 +3853,7 @@ let (t_exact : FStarC_Tactics_Monad.if_verbose (fun uu___11 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "__exact_now: was not a refinement\n") in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -3883,7 +3881,7 @@ let (try_unify_by_application : env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.aqual * FStarC_Syntax_Syntax.ctx_uvar) Prims.list FStarC_Tactics_Monad.tac) @@ -3992,7 +3990,7 @@ let (try_unify_by_application : FStarC_Class_Show.show FStarC_Syntax_Print.showable_ctxu uv in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "t_apply: generated uvar %s\n" uu___9) in Obj.magic @@ -4131,7 +4129,7 @@ let (t_apply : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "t_apply: uopt %s, only_match %s, tc_resolved_uvars %s, tm = %s\n" uu___3 uu___4 uu___5 uu___6) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () @@ -4196,7 +4194,7 @@ let (t_apply : = FStarC_TypeChecker_Rel.guard_to_string e guard in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "t_apply: tm = %s\nt_apply: goal = %s\nenv.gamma=%s\ntyp=%s\nguard=%s\n" uu___8 uu___9 @@ -4233,7 +4231,7 @@ let (t_apply : FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___11) in @@ -4312,7 +4310,7 @@ let (t_apply : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t) uvs in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "t_apply: found args = %s\n" uu___13) in Obj.magic @@ -4331,7 +4329,7 @@ let (t_apply : Obj.magic uu___12 in let w = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___13 -> @@ -4355,10 +4353,10 @@ let (t_apply : (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) ()) in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___15 -> @@ -4387,7 +4385,7 @@ let (t_apply : (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic s) @@ -4402,7 +4400,7 @@ let (t_apply : FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) uv (Obj.magic @@ -4428,7 +4426,7 @@ let (t_apply : uu___14 in let uvt_uv_l = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___15 -> @@ -4468,7 +4466,7 @@ let (t_apply : = let uu___17 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun g -> let uu___18 = @@ -4477,12 +4475,12 @@ let (t_apply : g.FStarC_Tactics_Types.goal_ctx_uvar) in Prims.op_Negation uu___18) - (FStarC_Compiler_List.flatten + (FStarC_List.flatten sub_goals) in - FStarC_Compiler_List.map + FStarC_List.map bnorm_goal uu___17 in - FStarC_Compiler_List.rev + FStarC_List.rev uu___16 in let uu___16 = @@ -4557,7 +4555,7 @@ let (lemma_or_sq : if uu___3 then let uu___4 = FStarC_Syntax_Util.un_squash res in - FStarC_Compiler_Util.map_opt uu___4 + FStarC_Util.map_opt uu___4 (fun post -> (FStarC_Syntax_Util.t_true, post)) else FStar_Pervasives_Native.None) let (t_apply_lemma : @@ -4580,8 +4578,7 @@ let (t_apply_lemma : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 - "apply_lemma: tm = %s\n" uu___4) in + FStarC_Util.print1 "apply_lemma: tm = %s\n" uu___4) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___2 @@ -4922,7 +4919,7 @@ let (t_apply_lemma : (( let uu___19 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_2635 in if uu___19 @@ -4937,7 +4934,7 @@ let (t_apply_lemma : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Apply lemma created a new uvar %s while applying %s\n" uu___20 uu___21 @@ -4990,11 +4987,11 @@ let (t_apply_lemma : subst) -> let implicits2 = - FStarC_Compiler_List.rev + FStarC_List.rev implicits1 in let uvs1 = - FStarC_Compiler_List.rev + FStarC_List.rev uvs in let pre1 = @@ -5159,7 +5156,7 @@ let (t_apply_lemma : FStarC_Class_Setlike.for_any () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (fun u -> FStarC_Syntax_Unionfind.equiv @@ -5170,7 +5167,7 @@ let (t_apply_lemma : let appears uv goals = - FStarC_Compiler_List.existsML + FStarC_List.existsML (fun g' -> let uu___16 @@ -5235,7 +5232,7 @@ let (t_apply_lemma : sub_goals in let sub_goals1 = - FStarC_Compiler_List.flatten + FStarC_List.flatten sub_goals in let rec filter' f xs = @@ -5387,15 +5384,15 @@ let (split_env : then FStar_Pervasives_Native.Some (e', bv', []) else (let uu___3 = aux e' in - FStarC_Compiler_Util.map_opt uu___3 + FStarC_Util.map_opt uu___3 (fun uu___4 -> match uu___4 with | (e'', bv, bvs) -> (e'', bv, (bv' :: bvs)))) in let uu___ = aux e in - FStarC_Compiler_Util.map_opt uu___ + FStarC_Util.map_opt uu___ (fun uu___1 -> match uu___1 with - | (e', bv, bvs) -> (e', bv, (FStarC_Compiler_List.rev bvs))) + | (e', bv, bvs) -> (e', bv, (FStarC_List.rev bvs))) let (subst_goal : FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.bv -> @@ -5415,8 +5412,8 @@ let (subst_goal : match uu___ with | FStar_Pervasives_Native.Some (e0, b11, bvs) -> let bs = - FStarC_Compiler_List.map FStarC_Syntax_Syntax.mk_binder - (b11 :: bvs) in + FStarC_List.map FStarC_Syntax_Syntax.mk_binder (b11 :: + bvs) in let t = FStarC_Tactics_Types.goal_type g in let uu___1 = let uu___2 = FStarC_Syntax_Subst.close_binders bs in @@ -5426,15 +5423,15 @@ let (subst_goal : | (bs', t') -> let bs'1 = let uu___2 = FStarC_Syntax_Syntax.mk_binder b2 in - let uu___3 = FStarC_Compiler_List.tail bs' in - uu___2 :: uu___3 in + let uu___3 = FStarC_List.tail bs' in uu___2 :: + uu___3 in let uu___2 = FStarC_TypeChecker_Core.open_binders_in_term e0 bs'1 t' in (match uu___2 with | (new_env, bs'', t'') -> let b21 = - let uu___3 = FStarC_Compiler_List.hd bs'' in + let uu___3 = FStarC_List.hd bs'' in uu___3.FStarC_Syntax_Syntax.binder_bv in let uu___3 = let uu___4 = @@ -5465,7 +5462,7 @@ let (subst_goal : uvt FStar_Pervasives_Native.None in let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | { @@ -5530,8 +5527,7 @@ let (rewrite : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term bv.FStarC_Syntax_Syntax.sort in - FStarC_Compiler_Util.print2 "+++Rewrite %s : %s\n" - uu___3 uu___4) in + FStarC_Util.print2 "+++Rewrite %s : %s\n" uu___3 uu___4) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 @@ -5562,7 +5558,7 @@ let (rewrite : let t = FStarC_Tactics_Types.goal_type goal in let bs = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs in let uu___6 = let uu___7 = @@ -5636,7 +5632,7 @@ let (rewrite : FStar_Pervasives_Native.None in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> @@ -6023,7 +6019,7 @@ let (rename_to : (b.FStarC_Reflection_V2_Data.sort3); FStarC_Reflection_V2_Data.ppname3 = - (FStarC_Compiler_Sealed.seal + (FStarC_Sealed.seal s) }))) uu___4)))) uu___2))) uu___1)) in @@ -6084,7 +6080,7 @@ let (var_retype : FStarC_Syntax_Syntax.NT uu___6 in [uu___5] in let bvs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b1 -> let uu___5 = FStarC_Syntax_Subst.subst s @@ -6173,7 +6169,7 @@ let (norm_binding_type : let steps = let uu___2 = FStarC_TypeChecker_Cfg.translate_norm_steps s in - FStarC_Compiler_List.op_At + FStarC_List.op_At [FStarC_TypeChecker_Env.Reify; FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]] uu___2 in @@ -6268,8 +6264,8 @@ let (free_in : let uu___ = FStarC_Syntax_Free.names t in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_bv)) bv (Obj.magic uu___) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) bv + (Obj.magic uu___) let (clear : FStarC_Reflection_V2_Data.binding -> unit FStarC_Tactics_Monad.tac) = fun b -> @@ -6288,11 +6284,11 @@ let (clear : let uu___5 = let uu___6 = FStarC_Tactics_Types.goal_env goal in FStarC_TypeChecker_Env.all_binders uu___6 in - FStarC_Compiler_List.length uu___5 in + FStarC_List.length uu___5 in FStarC_Class_Show.show FStarC_Class_Show.showable_nat uu___4 in - FStarC_Compiler_Util.print2 - "Clear of (%s), env has %s binders\n" uu___2 uu___3) in + FStarC_Util.print2 "Clear of (%s), env has %s binders\n" + uu___2 uu___3) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___ @@ -6323,7 +6319,7 @@ let (clear : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv bv' in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Cannot clear; binder present in the type of %s" uu___5 in FStarC_Tactics_Monad.fail uu___4 @@ -6498,7 +6494,7 @@ let (_t_trefl : let uu___2 = FStarC_Class_Setlike.for_all () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) is_uvar_untyped_or_already_checked (Obj.magic uvars) in if uu___2 @@ -6994,8 +6990,7 @@ let longest_prefix : else (acc, (x :: xs), (y :: ys)) | uu___ -> (acc, l11, l21) in let uu___ = aux [] l1 l2 in - match uu___ with - | (pr, t1, t2) -> ((FStarC_Compiler_List.rev pr), t1, t2) + match uu___ with | (pr, t1, t2) -> ((FStarC_List.rev pr), t1, t2) let (eq_binding : FStarC_Syntax_Syntax.binding -> FStarC_Syntax_Syntax.binding -> Prims.bool) = fun b1 -> fun b2 -> false @@ -7009,7 +7004,7 @@ let (join_goals : (fun g1 -> fun g2 -> let close_forall_no_univs bs f = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun f1 -> FStarC_Syntax_Util.mk_forall_no_univ @@ -7037,19 +7032,19 @@ let (join_goals : (g2.FStarC_Tactics_Types.goal_ctx_uvar).FStarC_Syntax_Syntax.ctx_uvar_gamma in let uu___2 = longest_prefix eq_binding - (FStarC_Compiler_List.rev gamma1) - (FStarC_Compiler_List.rev gamma2) in + (FStarC_List.rev gamma1) + (FStarC_List.rev gamma2) in match uu___2 with | (gamma, r1, r2) -> let t1 = let uu___3 = FStarC_TypeChecker_Env.binders_of_bindings - (FStarC_Compiler_List.rev r1) in + (FStarC_List.rev r1) in close_forall_no_univs uu___3 phi1 in let t2 = let uu___3 = FStarC_TypeChecker_Env.binders_of_bindings - (FStarC_Compiler_List.rev r2) in + (FStarC_List.rev r2) in close_forall_no_univs uu___3 phi2 in let goal_sc = let uu___3 = @@ -7077,7 +7072,7 @@ let (join_goals : FStarC_TypeChecker_Env.curmodule = (uu___3.FStarC_TypeChecker_Env.curmodule); FStarC_TypeChecker_Env.gamma = - (FStarC_Compiler_List.rev gamma); + (FStarC_List.rev gamma); FStarC_TypeChecker_Env.gamma_sig = (uu___3.FStarC_TypeChecker_Env.gamma_sig); FStarC_TypeChecker_Env.gamma_cache = @@ -7208,7 +7203,7 @@ let (join_goals : let uu___8 = FStarC_Tactics_Printing.goal_to_string_verbose goal in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "join_goals of\n(%s)\nand\n(%s)\n= (%s)\n" uu___6 uu___7 uu___8) in Obj.magic @@ -7394,7 +7389,7 @@ let (unquote : (fun uu___2 -> let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 "unquote: tm = %s\n" uu___3) in + FStarC_Util.print1 "unquote: tm = %s\n" uu___3) in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 @@ -7430,7 +7425,7 @@ let (unquote : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "unquote: tm' = %s\n" uu___7) in Obj.magic @@ -7448,7 +7443,7 @@ let (unquote : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term typ in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "unquote: typ = %s\n" uu___9) in Obj.magic @@ -7571,7 +7566,7 @@ let (uvar_env : (Obj.magic (typ, FStarC_TypeChecker_Env.trivial_guard, - FStarC_Compiler_Range_Type.dummyRange)))) + FStarC_Range_Type.dummyRange)))) uu___2)) in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -8297,8 +8292,8 @@ let (launch_process : Obj.magic (Obj.repr (let s = - FStarC_Compiler_Util.run_process - "tactic_launch" prog args + FStarC_Util.run_process "tactic_launch" + prog args (FStar_Pervasives_Native.Some input) in FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () @@ -8336,7 +8331,7 @@ let (change : FStarC_Syntax_Syntax.typ -> unit FStarC_Tactics_Monad.tac) = (fun uu___2 -> let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ty in - FStarC_Compiler_Util.print1 "change: ty = %s\n" uu___3) in + FStarC_Util.print1 "change: ty = %s\n" uu___3) in FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () uu___1 (fun uu___2 -> @@ -8679,9 +8674,9 @@ let (t_destruct : let uu___14 = failwhen - ((FStarC_Compiler_List.length + ((FStarC_List.length a_us) <> - (FStarC_Compiler_List.length + (FStarC_List.length t_us)) "t_us don't match?" in Obj.magic @@ -8805,9 +8800,9 @@ let (t_destruct : let uu___22 = failwhen - ((FStarC_Compiler_List.length + ((FStarC_List.length a_us) <> - (FStarC_Compiler_List.length + (FStarC_List.length c_us)) "t_us don't match?" in FStarC_Class_Monad.op_let_Bang @@ -8891,7 +8886,7 @@ let (t_destruct : (bv.FStarC_Syntax_Syntax.sort) } in let bs' = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___27 = @@ -8912,7 +8907,7 @@ let (t_destruct : }) bs in let subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___27 -> @@ -8972,7 +8967,7 @@ let (t_destruct : comp1) -> let uu___27 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt nparam bs1 in (match uu___27 @@ -9031,7 +9026,7 @@ let (t_destruct : -> false in let uu___30 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt nparam args in match uu___30 @@ -9042,9 +9037,9 @@ let (t_destruct : let uu___31 = failwhen - ((FStarC_Compiler_List.length + ((FStarC_List.length a_ps) <> - (FStarC_Compiler_List.length + (FStarC_List.length d_ps)) "params not match?" in Obj.magic @@ -9064,11 +9059,11 @@ let (t_destruct : uu___32 in let d_ps_a_ps = - FStarC_Compiler_List.zip + FStarC_List.zip d_ps a_ps in let subst = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___33 -> @@ -9095,7 +9090,7 @@ let (t_destruct : subst bs2 in let subpats_1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___33 -> @@ -9122,7 +9117,7 @@ let (t_destruct : d_ps_a_ps in let subpats_2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___33 -> @@ -9146,7 +9141,7 @@ let (t_destruct : bq))) bs3 in let subpats = - FStarC_Compiler_List.op_At + FStarC_List.op_At subpats_1 subpats_2 in let pat = @@ -9448,7 +9443,7 @@ let (t_destruct : let uu___43 = FStarC_BigInt.of_int_fs - (FStarC_Compiler_List.length + (FStarC_List.length bs3) in (fv1, uu___43) in @@ -9491,7 +9486,7 @@ let (t_destruct : goal_brs in let uu___18 = - FStarC_Compiler_List.unzip3 + FStarC_List.unzip3 goal_brs in match uu___18 with @@ -9605,7 +9600,7 @@ let (lget : (fun ps -> let ps = Obj.magic ps in let uu___1 = - FStarC_Compiler_Util.psmap_try_find + FStarC_Util.psmap_try_find ps.FStarC_Tactics_Types.local_state k in match uu___1 with | FStar_Pervasives_Native.None -> @@ -9629,7 +9624,7 @@ let (lset : let ps = Obj.magic ps in let ps1 = let uu___1 = - FStarC_Compiler_Util.psmap_add + FStarC_Util.psmap_add ps.FStarC_Tactics_Types.local_state k t in { FStarC_Tactics_Types.main_context = @@ -9763,7 +9758,7 @@ let (t_commute_applied_match : unit -> unit FStarC_Tactics_Monad.tac) = FStarC_Syntax_Syntax.rc_opt1 = lopt;_} -> let brs' = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (p, w, e1) -> @@ -9771,18 +9766,17 @@ let (t_commute_applied_match : unit -> unit FStarC_Tactics_Monad.tac) = FStarC_Syntax_Util.mk_app e1 las in (p, w, uu___6)) brs in let lopt' = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun rc -> let uu___5 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun t -> let uu___6 = let uu___7 = FStarC_Tactics_Types.goal_env g in FStarC_TypeChecker_Normalize.get_n_binders - uu___7 - (FStarC_Compiler_List.length - las) t in + uu___7 (FStarC_List.length las) + t in match uu___6 with | (bs, c) -> let uu___7 = @@ -9791,7 +9785,7 @@ let (t_commute_applied_match : unit -> unit FStarC_Tactics_Monad.tac) = (match uu___7 with | (bs1, c1) -> let ss = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun a -> FStarC_Syntax_Syntax.NT @@ -9921,7 +9915,7 @@ let (push_bv_dsenv : (fun e -> fun i -> let ident = - FStarC_Ident.mk_ident (i, FStarC_Compiler_Range_Type.dummyRange) in + FStarC_Ident.mk_ident (i, FStarC_Range_Type.dummyRange) in let uu___ = FStarC_Syntax_DsEnv.push_bv e.FStarC_TypeChecker_Env.dsenv ident in match uu___ with @@ -10110,12 +10104,10 @@ let (comp_to_doc : (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () (Obj.magic s))) uu___1))) uu___ let (range_to_string : - FStarC_Compiler_Range_Type.range -> Prims.string FStarC_Tactics_Monad.tac) - = + FStarC_Range_Type.range -> Prims.string FStarC_Tactics_Monad.tac) = fun uu___ -> (fun r -> - let uu___ = - FStarC_Class_Show.show FStarC_Compiler_Range_Ops.showable_range r in + let uu___ = FStarC_Class_Show.show FStarC_Range_Ops.showable_range r in Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () (Obj.magic uu___))) uu___ @@ -10247,10 +10239,10 @@ let (free_uvars : let uu___3 = FStarC_Syntax_Free.uvars_uncached tm in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___3) in - FStarC_Compiler_List.map + FStarC_List.map (fun u -> let uu___3 = FStarC_Syntax_Unionfind.uvar_id @@ -10293,6 +10285,22 @@ let (ext_getv : Prims.string -> Prims.string FStarC_Tactics_Monad.tac) = Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () (Obj.magic uu___2))) uu___1))) uu___ +let (ext_enabled : Prims.string -> Prims.bool FStarC_Tactics_Monad.tac) = + fun uu___ -> + (fun k -> + let uu___ = + FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () + (Obj.repr ()) in + Obj.magic + (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () + uu___ + (fun uu___1 -> + (fun uu___1 -> + let uu___1 = Obj.magic uu___1 in + let uu___2 = FStarC_Options_Ext.enabled k in + Obj.magic + (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac + () (Obj.magic uu___2))) uu___1))) uu___ let (ext_getns : Prims.string -> (Prims.string * Prims.string) Prims.list FStarC_Tactics_Monad.tac) @@ -10325,7 +10333,7 @@ let alloc : 'a . 'a -> 'a FStarC_Tactics_Types.tref FStarC_Tactics_Monad.tac (fun uu___1 -> (fun uu___1 -> let uu___1 = Obj.magic uu___1 in - let uu___2 = FStarC_Compiler_Util.mk_ref x in + let uu___2 = FStarC_Util.mk_ref x in Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () (Obj.magic uu___2))) uu___1))) uu___ @@ -10341,7 +10349,7 @@ let read : 'a . 'a FStarC_Tactics_Types.tref -> 'a FStarC_Tactics_Monad.tac = (fun uu___1 -> (fun uu___1 -> let uu___1 = Obj.magic uu___1 in - let uu___2 = FStarC_Compiler_Effect.op_Bang r in + let uu___2 = FStarC_Effect.op_Bang r in Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () (Obj.magic uu___2))) uu___1))) uu___ @@ -10357,16 +10365,16 @@ let write : (fun uu___1 -> (fun uu___1 -> let uu___1 = Obj.magic uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals r x; + FStarC_Effect.op_Colon_Equals r x; Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () (Obj.repr ()))) uu___1) let (dbg_refl : env -> (unit -> Prims.string) -> unit) = fun g -> fun msg -> - let uu___ = FStarC_Compiler_Effect.op_Bang dbg_ReflTc in + let uu___ = FStarC_Effect.op_Bang dbg_ReflTc in if uu___ - then let uu___1 = msg () in FStarC_Compiler_Util.print_string uu___1 + then let uu___1 = msg () in FStarC_Util.print_string uu___1 else () type issues = FStarC_Errors.issue Prims.list let (refl_typing_guard : @@ -10398,7 +10406,7 @@ let __refl_typing_builtin_wrapper : | uu___1 -> let issue = let uu___2 = - let uu___3 = FStarC_Compiler_Util.print_exn uu___1 in + let uu___3 = FStarC_Util.print_exn uu___1 in FStarC_Errors_Msg.mkmsg uu___3 in let uu___3 = FStarC_Errors.get_ctx () in { @@ -10417,7 +10425,7 @@ let __refl_typing_builtin_wrapper : then let allow_uvars = false in let allow_names = true in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (e, g) -> @@ -10428,8 +10436,7 @@ let __refl_typing_builtin_wrapper : (FStar_Pervasives_Native.snd (FStar_Pervasives_Native.__proj__Some__item__v r)) else [] in - let r1 = - FStarC_Compiler_Util.map_opt r FStar_Pervasives_Native.fst in + let r1 = FStarC_Util.map_opt r FStar_Pervasives_Native.fst in Obj.magic (FStarC_Class_Monad.op_let_Bang FStarC_Tactics_Monad.monad_tac () () (Obj.magic FStarC_Tactics_Monad.get) @@ -10441,7 +10448,7 @@ let __refl_typing_builtin_wrapper : (FStarC_TypeChecker_Tc.compress_and_norm ps.FStarC_Tactics_Types.main_context); FStarC_Syntax_Unionfind.rollback tx; - if (FStarC_Compiler_List.length errs) > Prims.int_zero + if (FStarC_List.length errs) > Prims.int_zero then Obj.magic (FStarC_Class_Monad.return @@ -10520,28 +10527,32 @@ let refl_typing_builtin_wrapper : match uu___1 with | (o, errs) -> let errs1 = - FStarC_Compiler_List.map - (fun is -> - let uu___2 = + let uu___2 = FStarC_Debug.any () in + if uu___2 + then + FStarC_List.map + (fun is -> let uu___3 = let uu___4 = - FStarC_Errors_Msg.text - (Prims.strcat - "Raised within Tactics." label) in - [uu___4] in - FStarC_Compiler_List.op_At - is.FStarC_Errors.issue_msg uu___3 in - { - FStarC_Errors.issue_msg = uu___2; - FStarC_Errors.issue_level = - (is.FStarC_Errors.issue_level); - FStarC_Errors.issue_range = - (is.FStarC_Errors.issue_range); - FStarC_Errors.issue_number = - (is.FStarC_Errors.issue_number); - FStarC_Errors.issue_ctx = - (is.FStarC_Errors.issue_ctx) - }) errs in + let uu___5 = + FStarC_Errors_Msg.text + (Prims.strcat + "Raised within Tactics." label) in + [uu___5] in + FStarC_List.op_At + is.FStarC_Errors.issue_msg uu___4 in + { + FStarC_Errors.issue_msg = uu___3; + FStarC_Errors.issue_level = + (is.FStarC_Errors.issue_level); + FStarC_Errors.issue_range = + (is.FStarC_Errors.issue_range); + FStarC_Errors.issue_number = + (is.FStarC_Errors.issue_number); + FStarC_Errors.issue_ctx = + (is.FStarC_Errors.issue_ctx) + }) errs + else errs in Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () @@ -10552,24 +10563,24 @@ let (no_uvars_in_term : FStarC_Syntax_Syntax.term -> Prims.bool) = (let uu___ = FStarC_Syntax_Free.uvars t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___)) && (let uu___ = FStarC_Syntax_Free.univs t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) + (Obj.magic uu___)) let (no_univ_uvars_in_term : FStarC_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = FStarC_Syntax_Free.univs t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) + (Obj.magic uu___) let (no_uvars_in_g : env -> Prims.bool) = fun g -> - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Binding_var bv -> @@ -10582,8 +10593,8 @@ let (uu___is_Subtyping : relation -> Prims.bool) = fun projectee -> match projectee with | Subtyping -> true | uu___ -> false let (uu___is_Equality : relation -> Prims.bool) = fun projectee -> match projectee with | Equality -> true | uu___ -> false -let (unexpected_uvars_issue : - FStarC_Compiler_Range_Type.range -> FStarC_Errors.issue) = +let (unexpected_uvars_issue : FStarC_Range_Type.range -> FStarC_Errors.issue) + = fun r -> let i = let uu___ = FStarC_Errors_Msg.mkmsg "Cannot check relation with uvars" in @@ -10624,7 +10635,7 @@ let (refl_is_non_informative : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_is_non_informative: %s\n" uu___4); (let b = FStarC_TypeChecker_Core.is_non_informative g1 t in @@ -10633,7 +10644,7 @@ let (refl_is_non_informative : let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool b in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_is_non_informative: returned %s" uu___5); if b then ((), []) @@ -10701,7 +10712,7 @@ let (refl_check_relation : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "refl_check_relation: %s %s %s\n" uu___4 (if rel = Subtyping @@ -10736,7 +10747,7 @@ let (refl_check_relation : let uu___6 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_check_relation failed: %s\n" uu___6); (let uu___5 = @@ -10830,16 +10841,14 @@ let (refl_core_compute_term_type : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_core_compute_term_type: %s\n" uu___4); - (let guards = FStarC_Compiler_Util.mk_ref [] in + (let guards = FStarC_Util.mk_ref [] in let gh g2 guard = (let uu___4 = - let uu___5 = - FStarC_Compiler_Effect.op_Bang guards in + let uu___5 = FStarC_Effect.op_Bang guards in (g2, guard) :: uu___5 in - FStarC_Compiler_Effect.op_Colon_Equals guards - uu___4); + FStarC_Effect.op_Colon_Equals guards uu___4); true in let uu___3 = FStarC_TypeChecker_Core.compute_term_type_handle_guards @@ -10855,18 +10864,17 @@ let (refl_core_compute_term_type : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "refl_core_compute_term_type for %s computed type %s\n" uu___6 uu___7); - (let uu___5 = - FStarC_Compiler_Effect.op_Bang guards in + (let uu___5 = FStarC_Effect.op_Bang guards in ((eff, t1), uu___5))) | FStar_Pervasives.Inr err -> (dbg_refl g1 (fun uu___5 -> let uu___6 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_core_compute_term_type: %s\n" uu___6); (let uu___5 = @@ -10928,7 +10936,7 @@ let (refl_core_check_term : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "refl_core_check_term: term: %s, type: %s, eff: %s\n" uu___4 uu___5 (tot_or_ghost_to_string eff)); @@ -10955,7 +10963,7 @@ let (refl_core_check_term : let uu___6 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_core_check_term failed: %s\n" uu___6); (let uu___5 = @@ -11021,7 +11029,7 @@ let (refl_core_check_term_at_type : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "refl_core_check_term_at_type: term: %s, type: %s\n" uu___4 uu___5); (let uu___3 = @@ -11032,7 +11040,7 @@ let (refl_core_check_term_at_type : (eff, FStar_Pervasives_Native.None) -> (dbg_refl g1 (fun uu___5 -> - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_core_check_term_at_type: succeeded with eff %s and no guard\n" (tot_or_ghost_to_string eff)); (eff, [])) @@ -11040,7 +11048,7 @@ let (refl_core_check_term_at_type : (eff, FStar_Pervasives_Native.Some guard) -> (dbg_refl g1 (fun uu___5 -> - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_core_check_term_at_type: succeeded with eff %s and guard\n" (tot_or_ghost_to_string eff)); (eff, [(g1, guard)])) @@ -11050,7 +11058,7 @@ let (refl_core_check_term_at_type : let uu___6 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_core_check_term_at_type failed: %s\n" uu___6); (let uu___5 = @@ -11103,13 +11111,13 @@ let (refl_tc_term : (fun uu___3 -> let uu___4 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range e.FStarC_Syntax_Syntax.pos in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format2 - "refl_tc_term@%s: %s\n" uu___4 uu___5); + FStarC_Util.format2 "refl_tc_term@%s: %s\n" + uu___4 uu___5); dbg_refl g1 (fun uu___4 -> "refl_tc_term: starting tc {\n"); (let g2 = @@ -11352,7 +11360,7 @@ let (refl_tc_term : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Elaborated term has unresolved implicits: %s" uu___7 in FStarC_Errors.raise_error @@ -11375,11 +11383,10 @@ let (refl_tc_term : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e2 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "} finished tc with e = %s\n" uu___9); - (let guards = - FStarC_Compiler_Util.mk_ref [] in + (let guards = FStarC_Util.mk_ref [] in let gh g3 guard = dbg_refl g3 (fun uu___9 -> @@ -11388,7 +11395,7 @@ let (refl_tc_term : FStarC_TypeChecker_Env.get_range g3 in FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range uu___11 in let uu___11 = FStarC_Class_Show.show @@ -11396,18 +11403,17 @@ let (refl_tc_term : guard in let uu___12 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range guard.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Got guard in Env@%s |- %s@%s\n" uu___10 uu___11 uu___12); (let uu___10 = let uu___11 = - FStarC_Compiler_Effect.op_Bang - guards in + FStarC_Effect.op_Bang guards in (g3, guard) :: uu___11 in - FStarC_Compiler_Effect.op_Colon_Equals - guards uu___10); + FStarC_Effect.op_Colon_Equals guards + uu___10); true in let uu___8 = FStarC_TypeChecker_Core.compute_term_type_handle_guards @@ -11419,7 +11425,7 @@ let (refl_tc_term : (fun uu___10 -> let uu___11 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range e2.FStarC_Syntax_Syntax.pos in let uu___12 = FStarC_Class_Show.show @@ -11429,12 +11435,11 @@ let (refl_tc_term : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "refl_tc_term@%s for %s computed type %s\n" uu___11 uu___12 uu___13); (let uu___10 = - FStarC_Compiler_Effect.op_Bang - guards in + FStarC_Effect.op_Bang guards in ((e2, (eff, t1)), uu___10))) | FStar_Pervasives.Inr err -> (dbg_refl g2 @@ -11442,7 +11447,7 @@ let (refl_tc_term : let uu___11 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_tc_term failed: %s\n" uu___11); (let uu___10 = @@ -11536,7 +11541,7 @@ let (refl_universe_of : let uu___6 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_universe_of failed: %s\n" uu___6); (let uu___5 = @@ -11587,7 +11592,7 @@ let (refl_check_prop_validity : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_check_prop_validity: %s\n" uu___4); (let must_tot = false in (let uu___4 = @@ -11619,7 +11624,7 @@ let (refl_check_prop_validity : let msg = let uu___5 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_check_prop_validity failed (not a prop): %s\n" uu___5 in (dbg_refl g1 (fun uu___6 -> msg); @@ -11647,162 +11652,81 @@ let (refl_check_match_complete : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> FStarC_Reflection_V2_Data.pattern Prims.list -> - (FStarC_Reflection_V2_Data.pattern Prims.list * + ((FStarC_Reflection_V2_Data.pattern Prims.list * FStarC_Reflection_V2_Data.binding Prims.list Prims.list) - FStar_Pervasives_Native.option FStarC_Tactics_Monad.tac) + FStar_Pervasives_Native.option * issues) FStarC_Tactics_Monad.tac) = - fun uu___3 -> - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun g -> - fun sc -> - fun scty -> - fun pats -> - let uu___ = - FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac - () (Obj.repr ()) in - Obj.magic - (FStarC_Class_Monad.op_let_Bang - FStarC_Tactics_Monad.monad_tac () () uu___ - (fun uu___1 -> - (fun uu___1 -> - let uu___1 = Obj.magic uu___1 in - let one = FStarC_Syntax_Util.exp_int "1" in - let brs = - FStarC_Compiler_List.map - (fun p -> - let p1 = - FStarC_Reflection_V2_Builtins.pack_pat - p in - (p1, FStar_Pervasives_Native.None, one)) - pats in - let mm = - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_match - { - FStarC_Syntax_Syntax.scrutinee = sc; - FStarC_Syntax_Syntax.ret_opt = - FStar_Pervasives_Native.None; - FStarC_Syntax_Syntax.brs = brs; - FStarC_Syntax_Syntax.rc_opt1 = - FStar_Pervasives_Native.None - }) sc.FStarC_Syntax_Syntax.pos in - let env1 = g in - let env2 = - FStarC_TypeChecker_Env.set_expected_typ env1 - FStarC_Syntax_Syntax.t_int in - let uu___2 = __tc env2 mm in - Obj.magic - (FStarC_Class_Monad.op_let_Bang - FStarC_Tactics_Monad.monad_tac () () - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___3 = Obj.magic uu___3 in - match uu___3 with - | (mm1, uu___4, g1) -> - let uu___5 = - FStarC_Errors.catch_errors_and_ignore_rest - (fun uu___6 -> - let uu___7 = - FStarC_TypeChecker_Rel.discharge_guard - env2 g1 in - FStarC_TypeChecker_Env.is_trivial - uu___7) in - (match uu___5 with - | (errs, b) -> - (match (errs, b) with - | ([], - FStar_Pervasives_Native.Some - (true)) -> - let get_pats t = - let uu___6 = - let uu___7 = - FStarC_Syntax_Util.unmeta - t in - uu___7.FStarC_Syntax_Syntax.n in - match uu___6 with - | FStarC_Syntax_Syntax.Tm_match - { - FStarC_Syntax_Syntax.scrutinee - = uu___7; - FStarC_Syntax_Syntax.ret_opt - = uu___8; - FStarC_Syntax_Syntax.brs - = brs1; - FStarC_Syntax_Syntax.rc_opt1 - = uu___9;_} - -> - FStarC_Compiler_List.map - (fun uu___10 - -> - match uu___10 - with - | (p, - uu___11, - uu___12) - -> p) - brs1 - | uu___7 -> - failwith - "refl_check_match_complete: not a match?" in - let pats1 = - get_pats mm1 in - let rec bnds_for_pat p - = - match p.FStarC_Syntax_Syntax.v - with - | FStarC_Syntax_Syntax.Pat_constant - uu___6 -> [] - | FStarC_Syntax_Syntax.Pat_cons - (fv, uu___6, - pats2) - -> - FStarC_Compiler_List.concatMap - (fun uu___7 -> - match uu___7 - with - | (p1, - uu___8) - -> - bnds_for_pat - p1) pats2 - | FStarC_Syntax_Syntax.Pat_var - bv -> - let uu___6 = - bv_to_binding - bv in - [uu___6] - | FStarC_Syntax_Syntax.Pat_dot_term - uu___6 -> [] in - let uu___6 = - let uu___7 = - let uu___8 = - FStarC_Compiler_List.map - FStarC_Reflection_V2_Builtins.inspect_pat - pats1 in - let uu___9 = - FStarC_Compiler_List.map - bnds_for_pat - pats1 in - (uu___8, uu___9) in - FStar_Pervasives_Native.Some - uu___7 in - Obj.magic - (FStarC_Class_Monad.return - FStarC_Tactics_Monad.monad_tac - () - (Obj.magic uu___6)) - | uu___6 -> - Obj.magic - (FStarC_Class_Monad.return - FStarC_Tactics_Monad.monad_tac - () - (Obj.magic - FStar_Pervasives_Native.None))))) - uu___3))) uu___1))) uu___3 uu___2 - uu___1 uu___ + fun g -> + fun sc -> + fun scty -> + fun pats -> + refl_typing_builtin_wrapper "refl_check_match_complete" + (fun uu___ -> + let one = FStarC_Syntax_Util.exp_int "1" in + let brs = + FStarC_List.map + (fun p -> + let p1 = FStarC_Reflection_V2_Builtins.pack_pat p in + (p1, FStar_Pervasives_Native.None, one)) pats in + let mm = + FStarC_Syntax_Syntax.mk + (FStarC_Syntax_Syntax.Tm_match + { + FStarC_Syntax_Syntax.scrutinee = sc; + FStarC_Syntax_Syntax.ret_opt = + FStar_Pervasives_Native.None; + FStarC_Syntax_Syntax.brs = brs; + FStarC_Syntax_Syntax.rc_opt1 = + FStar_Pervasives_Native.None + }) sc.FStarC_Syntax_Syntax.pos in + let env1 = g in + let env2 = + FStarC_TypeChecker_Env.set_expected_typ env1 + FStarC_Syntax_Syntax.t_int in + let uu___1 = + FStarC_TypeChecker_TcTerm.typeof_tot_or_gtot_term env2 mm + true in + match uu___1 with + | (mm1, uu___2, guard) -> + (FStarC_TypeChecker_Rel.force_trivial_guard env2 guard; + (let get_pats t = + let uu___4 = + let uu___5 = FStarC_Syntax_Util.unmeta t in + uu___5.FStarC_Syntax_Syntax.n in + match uu___4 with + | FStarC_Syntax_Syntax.Tm_match + { FStarC_Syntax_Syntax.scrutinee = uu___5; + FStarC_Syntax_Syntax.ret_opt = uu___6; + FStarC_Syntax_Syntax.brs = brs1; + FStarC_Syntax_Syntax.rc_opt1 = uu___7;_} + -> + FStarC_List.map + (fun uu___8 -> + match uu___8 with | (p, uu___9, uu___10) -> p) + brs1 + | uu___5 -> + failwith "refl_check_match_complete: not a match?" in + let mm2 = + FStarC_Syntax_Compress.deep_compress false true mm1 in + let pats1 = get_pats mm2 in + let rec bnds_for_pat p = + match p.FStarC_Syntax_Syntax.v with + | FStarC_Syntax_Syntax.Pat_constant uu___4 -> [] + | FStarC_Syntax_Syntax.Pat_cons (fv, uu___4, pats2) -> + FStarC_List.concatMap + (fun uu___5 -> + match uu___5 with + | (p1, uu___6) -> bnds_for_pat p1) pats2 + | FStarC_Syntax_Syntax.Pat_var bv -> + let uu___4 = bv_to_binding bv in [uu___4] + | FStarC_Syntax_Syntax.Pat_dot_term uu___4 -> [] in + let uu___4 = + let uu___5 = + FStarC_List.map + FStarC_Reflection_V2_Builtins.inspect_pat pats1 in + let uu___6 = FStarC_List.map bnds_for_pat pats1 in + (uu___5, uu___6) in + (uu___4, [])))) let (refl_instantiate_implicits : env -> FStarC_Syntax_Syntax.term -> @@ -11833,7 +11757,7 @@ let (refl_instantiate_implicits : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_instantiate_implicits: %s\n" uu___4); dbg_refl g1 (fun uu___4 -> @@ -11973,14 +11897,13 @@ let (refl_instantiate_implicits : let bvs_and_ts = let uu___5 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist - ()) + (FStarC_CList.listlike_clist ()) guard1.FStarC_TypeChecker_Common.implicits in match uu___5 with | [] -> [] | imps -> let l = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> match uu___6 with | { @@ -12000,13 +11923,13 @@ let (refl_instantiate_implicits : let uu___12 = FStarC_Syntax_Syntax.mk FStarC_Syntax_Syntax.Tm_unknown - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.new_bv FStar_Pervasives_Native.None uu___12 in ((imp_uvar.FStarC_Syntax_Syntax.ctx_uvar_head), uu___10, uu___11)) imps in - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun uu___7 -> match uu___7 with | (uv, uu___8, bv) -> @@ -12015,7 +11938,7 @@ let (refl_instantiate_implicits : bv in FStarC_Syntax_Util.set_uvar uv uu___9) l; - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (uu___8, t1, bv) -> (bv, t1)) @@ -12030,22 +11953,23 @@ let (refl_instantiate_implicits : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "refl_instantiate_implicits: inferred %s : %s" uu___7 uu___8); - (let uu___7 = - let uu___8 = no_univ_uvars_in_term e1 in - Prims.op_Negation uu___8 in - if uu___7 + FStarC_Errors.stop_if_err (); + (let uu___8 = + let uu___9 = no_univ_uvars_in_term e1 in + Prims.op_Negation uu___9 in + if uu___8 then - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Elaborated term has unresolved univ uvars: %s" - uu___9 in + uu___10 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e1 @@ -12053,21 +11977,21 @@ let (refl_instantiate_implicits : () (Obj.magic FStarC_Errors_Msg.is_error_message_string) - (Obj.magic uu___8) + (Obj.magic uu___9) else ()); - (let uu___8 = - let uu___9 = no_univ_uvars_in_term t in - Prims.op_Negation uu___9 in - if uu___8 + (let uu___9 = + let uu___10 = no_univ_uvars_in_term t in + Prims.op_Negation uu___10 in + if uu___9 then - let uu___9 = - let uu___10 = + let uu___10 = + let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Inferred type has unresolved univ uvars: %s" - uu___10 in + uu___11 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e1 @@ -12075,30 +11999,30 @@ let (refl_instantiate_implicits : () (Obj.magic FStarC_Errors_Msg.is_error_message_string) - (Obj.magic uu___9) + (Obj.magic uu___10) else ()); - FStarC_Compiler_List.iter - (fun uu___9 -> - match uu___9 with + FStarC_List.iter + (fun uu___10 -> + match uu___10 with | (x, t1) -> - let uu___10 = - let uu___11 = + let uu___11 = + let uu___12 = no_univ_uvars_in_term t1 in - Prims.op_Negation uu___11 in - if uu___10 + Prims.op_Negation uu___12 in + if uu___11 then - let uu___11 = - let uu___12 = + let uu___12 = + let uu___13 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in - let uu___13 = + let uu___14 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Inferred type has unresolved univ uvars: %s:%s" - uu___12 uu___13 in + uu___13 uu___14 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e1 @@ -12106,13 +12030,13 @@ let (refl_instantiate_implicits : () (Obj.magic FStarC_Errors_Msg.is_error_message_string) - (Obj.magic uu___11) + (Obj.magic uu___12) else ()) bvs_and_ts; (let g4 = - let uu___9 = - FStarC_Compiler_List.map - (fun uu___10 -> - match uu___10 with + let uu___10 = + FStarC_List.map + (fun uu___11 -> + match uu___11 with | (bv, t1) -> { FStarC_Syntax_Syntax.ppname @@ -12125,38 +12049,38 @@ let (refl_instantiate_implicits : t1 }) bvs_and_ts in FStarC_TypeChecker_Env.push_bvs g3 - uu___9 in + uu___10 in let allow_uvars = false in let allow_names = true in let e2 = FStarC_Syntax_Compress.deep_compress allow_uvars allow_names e1 in let t1 = - let uu___9 = refl_norm_type g4 t in + let uu___10 = refl_norm_type g4 t in FStarC_Syntax_Compress.deep_compress - allow_uvars allow_names uu___9 in + allow_uvars allow_names uu___10 in let bvs_and_ts1 = - FStarC_Compiler_List.map - (fun uu___9 -> - match uu___9 with + FStarC_List.map + (fun uu___10 -> + match uu___10 with | (bv, t2) -> - let uu___10 = + let uu___11 = FStarC_Syntax_Compress.deep_compress allow_uvars allow_names t2 in - (bv, uu___10)) bvs_and_ts in + (bv, uu___11)) bvs_and_ts in dbg_refl g4 - (fun uu___10 -> - let uu___11 = + (fun uu___11 -> + let uu___12 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e2 in - let uu___12 = + let uu___13 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "} finished tc with e = %s and t = %s\n" - uu___11 uu___12); + uu___12 uu___13); ((bvs_and_ts1, e2, t1), []))))))) else Obj.magic @@ -12192,9 +12116,8 @@ let (refl_try_unify : (no_uvars_in_term t1)) && (let uu___1 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.snd uvs in - FStarC_Compiler_List.for_all no_uvars_in_term uu___1) in + FStarC_List.map FStar_Pervasives_Native.snd uvs in + FStarC_List.for_all no_uvars_in_term uu___1) in if uu___ then Obj.magic @@ -12216,7 +12139,7 @@ let (refl_try_unify : FStarC_Syntax_Print.showable_bv FStarC_Syntax_Print.showable_term)) uvs in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "refl_try_unify %s and %s, with uvs: %s {\n" uu___4 uu___5 uu___6); (let g1 = @@ -12224,11 +12147,10 @@ let (refl_try_unify : t0.FStarC_Syntax_Syntax.pos in let uu___3 = let uu___4 = - let uu___5 = - FStarC_Compiler_Util.pimap_empty () in + let uu___5 = FStarC_Util.pimap_empty () in (FStarC_TypeChecker_Env.trivial_guard, [], uu___5) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___5 -> fun uu___6 -> match (uu___5, uu___6) with @@ -12243,7 +12165,7 @@ let (refl_try_unify : FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv bv in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_try_unify for %s" uu___8 in let should_check_uvar = @@ -12265,7 +12187,7 @@ let (refl_try_unify : FStarC_TypeChecker_Env.conj_guard guard_uvs guard_uv in let uu___10 = - FStarC_Compiler_Util.pimap_add + FStarC_Util.pimap_add tbl uv_id ((ctx_u.FStarC_Syntax_Syntax.ctx_uvar_head), bv) in @@ -12455,10 +12377,10 @@ let (refl_try_unify : let b = let uu___5 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ()) guard2.FStarC_TypeChecker_Common.implicits in - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___6 -> match uu___6 with | { @@ -12490,7 +12412,7 @@ let (refl_try_unify : let uu___18 = FStarC_Unionfind.puf_unique_id uv in - FStarC_Compiler_Util.pimap_try_find + FStarC_Util.pimap_try_find tbl uu___18 in uu___17 = FStar_Pervasives_Native.None) @@ -12498,8 +12420,7 @@ let (refl_try_unify : if b then [] else - FStarC_Compiler_Util.pimap_fold - tbl + FStarC_Util.pimap_fold tbl (fun id -> fun uu___6 -> fun l1 -> @@ -12530,7 +12451,7 @@ let (refl_try_unify : FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___9) in @@ -12551,7 +12472,7 @@ let (refl_try_unify : FStarC_Syntax_Print.showable_bv FStarC_Syntax_Print.showable_term)) l in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "} refl_try_unify, substitution is: %s\n" uu___7); (l, []))))))) @@ -12603,7 +12524,7 @@ let (refl_maybe_relate_after_unfolding : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "refl_maybe_relate_after_unfolding: %s and %s {\n" uu___4 uu___5); (let s = @@ -12614,7 +12535,7 @@ let (refl_maybe_relate_after_unfolding : let uu___5 = FStarC_Class_Show.show FStarC_TypeChecker_Core.showable_side s in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "} returning side: %s\n" uu___5); (s, []))))) else @@ -12655,7 +12576,7 @@ let (refl_maybe_unfold_head : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "refl_maybe_unfold_head: %s {\n" uu___4); (let eopt = FStarC_TypeChecker_Normalize.maybe_unfold_head g1 @@ -12668,15 +12589,14 @@ let (refl_maybe_unfold_head : | FStar_Pervasives_Native.Some e1 -> FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e1 in - FStarC_Compiler_Util.format1 "} eopt = %s\n" - uu___5); + FStarC_Util.format1 "} eopt = %s\n" uu___5); if eopt = FStar_Pervasives_Native.None then (let uu___4 = let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Could not unfold head: %s\n" uu___5 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e @@ -12685,7 +12605,7 @@ let (refl_maybe_unfold_head : FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___4)) else - (let uu___5 = FStarC_Compiler_Util.must eopt in + (let uu___5 = FStarC_Util.must eopt in (uu___5, [])))))) else Obj.magic @@ -12705,9 +12625,7 @@ let (push_open_namespace : fun uu___ -> (fun e -> fun ns -> - let lid = - FStarC_Ident.lid_of_path ns - FStarC_Compiler_Range_Type.dummyRange in + let lid = FStarC_Ident.lid_of_path ns FStarC_Range_Type.dummyRange in let uu___ = let uu___1 = FStarC_Syntax_DsEnv.push_namespace @@ -12831,8 +12749,7 @@ let (push_module_abbrev : fun n -> fun m -> let mlid = - FStarC_Ident.lid_of_path m - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Ident.lid_of_path m FStarC_Range_Type.dummyRange in let ident = FStarC_Ident.id_of_text n in let uu___ = let uu___1 = @@ -12958,8 +12875,7 @@ let (resolve_name : fun uu___ -> (fun e -> fun n -> - let l = - FStarC_Ident.lid_of_path n FStarC_Compiler_Range_Type.dummyRange in + let l = FStarC_Ident.lid_of_path n FStarC_Range_Type.dummyRange in let uu___ = FStarC_Syntax_DsEnv.resolve_name e.FStarC_TypeChecker_Env.dsenv l in @@ -12977,7 +12893,7 @@ let (log_issues : let is1 = if ps.FStarC_Tactics_Types.dump_on_failure then - FStarC_Compiler_List.map + FStarC_List.map (fun i -> let uu___ = let uu___1 = @@ -13320,7 +13236,7 @@ let (tac_env : FStarC_TypeChecker_Env.env -> FStarC_TypeChecker_Env.env) = } in env5 let (proofstate_of_goals : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> env -> FStarC_Tactics_Types.goal Prims.list -> FStarC_TypeChecker_Common.implicit Prims.list -> @@ -13332,8 +13248,8 @@ let (proofstate_of_goals : fun imps -> let env2 = tac_env env1 in let ps = - let uu___ = FStarC_Compiler_Effect.op_Bang dbg_TacVerbose in - let uu___1 = FStarC_Compiler_Util.psmap_empty () in + let uu___ = FStarC_Effect.op_Bang dbg_TacVerbose in + let uu___1 = FStarC_Util.psmap_empty () in { FStarC_Tactics_Types.main_context = env2; FStarC_Tactics_Types.all_implicits = imps; @@ -13354,7 +13270,7 @@ let (proofstate_of_goals : } in ps let (proofstate_of_goal_ty : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> env -> FStarC_Syntax_Syntax.typ -> (FStarC_Tactics_Types.proofstate * FStarC_Syntax_Syntax.term)) @@ -13474,12 +13390,12 @@ let (proofstate_of_goal_ty : let ps = let uu___1 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) g_u.FStarC_TypeChecker_Common.implicits in proofstate_of_goals rng env3 [g] uu___1 in let uu___1 = FStarC_Tactics_Types.goal_witness g in (ps, uu___1) let (proofstate_of_all_implicits : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> env -> implicits -> (FStarC_Tactics_Types.proofstate * FStarC_Syntax_Syntax.term)) @@ -13489,14 +13405,13 @@ let (proofstate_of_all_implicits : fun imps -> let env2 = tac_env env1 in let goals = - FStarC_Compiler_List.map - (FStarC_Tactics_Types.goal_of_implicit env2) imps in + FStarC_List.map (FStarC_Tactics_Types.goal_of_implicit env2) imps in let w = - let uu___ = FStarC_Compiler_List.hd goals in + let uu___ = FStarC_List.hd goals in FStarC_Tactics_Types.goal_witness uu___ in let ps = - let uu___ = FStarC_Compiler_Effect.op_Bang dbg_TacVerbose in - let uu___1 = FStarC_Compiler_Util.psmap_empty () in + let uu___ = FStarC_Effect.op_Bang dbg_TacVerbose in + let uu___1 = FStarC_Util.psmap_empty () in { FStarC_Tactics_Types.main_context = env2; FStarC_Tactics_Types.all_implicits = imps; @@ -13532,8 +13447,8 @@ let (getprop : FStarC_Syntax_Util.un_squash tn let run_unembedded_tactic_on_ps_and_solve_remaining : 'a 'b . - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> 'a -> ('a -> 'b FStarC_Tactics_Monad.tac) -> @@ -13550,7 +13465,7 @@ let run_unembedded_tactic_on_ps_and_solve_remaining : t_range g_range background t f ps in match uu___ with | (remaining_goals, r) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun g -> let uu___2 = let uu___3 = FStarC_Tactics_Types.goal_env g in @@ -13660,8 +13575,8 @@ let (call_subtac : uu___3 uu___2 uu___1 uu___ let run_tactic_on_ps_and_solve_remaining : 'a 'b . - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> 'a -> FStarC_Syntax_Syntax.term -> @@ -13679,7 +13594,7 @@ let run_tactic_on_ps_and_solve_remaining : FStarC_Syntax_Embeddings.e_unit f_tm false ps in match uu___ with | (remaining_goals, r) -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun g -> let uu___2 = let uu___3 = FStarC_Tactics_Types.goal_env g in diff --git a/stage0/fstar-lib/generated/FStarC_Tactics_V2_Primops.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V2_Primops.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Tactics_V2_Primops.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V2_Primops.ml index ee7a1ff8cde..aecac06da61 100644 --- a/stage0/fstar-lib/generated/FStarC_Tactics_V2_Primops.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Tactics_V2_Primops.ml @@ -5,7 +5,7 @@ let (uu___0 : FStarC_Reflection_V2_Embeddings.e_term let unseal : 'uuuuu 'a . - 'uuuuu -> 'a FStarC_Compiler_Sealed.sealed -> 'a FStarC_Tactics_Monad.tac + 'uuuuu -> 'a FStarC_Sealed.sealed -> 'a FStarC_Tactics_Monad.tac = fun uu___1 -> fun uu___ -> @@ -13,7 +13,7 @@ let unseal : fun x -> Obj.magic (FStarC_Class_Monad.return FStarC_Tactics_Monad.monad_tac () - (Obj.magic (FStarC_Compiler_Sealed.unseal x)))) uu___1 uu___ + (Obj.magic (FStarC_Sealed.unseal x)))) uu___1 uu___ let (unseal_step : FStarC_TypeChecker_Primops_Base.primitive_step) = let s = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one "unseal" @@ -179,58 +179,45 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___24 = let uu___25 = FStarC_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "compress" uu___0 uu___0 - FStarC_Reflection_V2_NBEEmbeddings.e_attribute - FStarC_Reflection_V2_NBEEmbeddings.e_attribute - FStarC_Tactics_V2_Basic.compress - FStarC_Tactics_V2_Basic.compress in + Prims.int_zero "fixup_range" + FStarC_Syntax_Embeddings.e_range + FStarC_Syntax_Embeddings.e_range + FStarC_TypeChecker_NBETerm.e_range + FStarC_TypeChecker_NBETerm.e_range + FStarC_Tactics_V2_Basic.fixup_range + FStarC_Tactics_V2_Basic.fixup_range in let uu___26 = let uu___27 = FStarC_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "set_goals" - (FStarC_Syntax_Embeddings.e_list - FStarC_Tactics_Embedding.e_goal) - FStarC_Syntax_Embeddings.e_unit - (FStarC_TypeChecker_NBETerm.e_list - FStarC_Tactics_Embedding.e_goal_nbe) - FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_Monad.set_goals - FStarC_Tactics_Monad.set_goals in + Prims.int_zero "compress" uu___0 uu___0 + FStarC_Reflection_V2_NBEEmbeddings.e_attribute + FStarC_Reflection_V2_NBEEmbeddings.e_attribute + FStarC_Tactics_V2_Basic.compress + FStarC_Tactics_V2_Basic.compress in let uu___28 = let uu___29 = FStarC_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "set_smt_goals" + Prims.int_zero "set_goals" (FStarC_Syntax_Embeddings.e_list FStarC_Tactics_Embedding.e_goal) FStarC_Syntax_Embeddings.e_unit (FStarC_TypeChecker_NBETerm.e_list FStarC_Tactics_Embedding.e_goal_nbe) FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_Monad.set_smt_goals - FStarC_Tactics_Monad.set_smt_goals in + FStarC_Tactics_Monad.set_goals + FStarC_Tactics_Monad.set_goals in let uu___30 = let uu___31 = - let uu___32 = - FStarC_Tactics_Interpreter.e_tactic_thunk - FStarC_Syntax_Embeddings.e_any in - let uu___33 = - FStarC_Tactics_Interpreter.e_tactic_nbe_thunk - FStarC_TypeChecker_NBETerm.e_any in - FStarC_Tactics_InterpFuns.mk_tac_step_2 - Prims.int_one "catch" - FStarC_Syntax_Embeddings.e_any uu___32 - (FStarC_Syntax_Embeddings.e_either - FStarC_Tactics_Embedding.e_exn - FStarC_Syntax_Embeddings.e_any) - FStarC_TypeChecker_NBETerm.e_any - uu___33 - (FStarC_TypeChecker_NBETerm.e_either - FStarC_Tactics_Embedding.e_exn_nbe - FStarC_TypeChecker_NBETerm.e_any) - (fun uu___34 -> - FStarC_Tactics_Monad.catch) - (fun uu___34 -> - FStarC_Tactics_Monad.catch) in + FStarC_Tactics_InterpFuns.mk_tac_step_1 + Prims.int_zero "set_smt_goals" + (FStarC_Syntax_Embeddings.e_list + FStarC_Tactics_Embedding.e_goal) + FStarC_Syntax_Embeddings.e_unit + (FStarC_TypeChecker_NBETerm.e_list + FStarC_Tactics_Embedding.e_goal_nbe) + FStarC_TypeChecker_NBETerm.e_unit + FStarC_Tactics_Monad.set_smt_goals + FStarC_Tactics_Monad.set_smt_goals in let uu___32 = let uu___33 = let uu___34 = @@ -240,7 +227,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Tactics_Interpreter.e_tactic_nbe_thunk FStarC_TypeChecker_NBETerm.e_any in FStarC_Tactics_InterpFuns.mk_tac_step_2 - Prims.int_one "recover" + Prims.int_one "catch" FStarC_Syntax_Embeddings.e_any uu___34 (FStarC_Syntax_Embeddings.e_either @@ -252,172 +239,197 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Tactics_Embedding.e_exn_nbe FStarC_TypeChecker_NBETerm.e_any) (fun uu___36 -> - FStarC_Tactics_Monad.recover) + FStarC_Tactics_Monad.catch) (fun uu___36 -> - FStarC_Tactics_Monad.recover) in + FStarC_Tactics_Monad.catch) in let uu___34 = let uu___35 = - FStarC_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "intro" - FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_Embeddings.e_binding - FStarC_TypeChecker_NBETerm.e_unit - FStarC_Reflection_V2_NBEEmbeddings.e_binding - FStarC_Tactics_V2_Basic.intro - FStarC_Tactics_V2_Basic.intro in + let uu___36 = + FStarC_Tactics_Interpreter.e_tactic_thunk + FStarC_Syntax_Embeddings.e_any in + let uu___37 = + FStarC_Tactics_Interpreter.e_tactic_nbe_thunk + FStarC_TypeChecker_NBETerm.e_any in + FStarC_Tactics_InterpFuns.mk_tac_step_2 + Prims.int_one "recover" + FStarC_Syntax_Embeddings.e_any + uu___36 + (FStarC_Syntax_Embeddings.e_either + FStarC_Tactics_Embedding.e_exn + FStarC_Syntax_Embeddings.e_any) + FStarC_TypeChecker_NBETerm.e_any + uu___37 + (FStarC_TypeChecker_NBETerm.e_either + FStarC_Tactics_Embedding.e_exn_nbe + FStarC_TypeChecker_NBETerm.e_any) + (fun uu___38 -> + FStarC_Tactics_Monad.recover) + (fun uu___38 -> + FStarC_Tactics_Monad.recover) in let uu___36 = let uu___37 = FStarC_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "intros" - FStarC_Syntax_Embeddings.e_int - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binding) - FStarC_TypeChecker_NBETerm.e_int - (FStarC_TypeChecker_NBETerm.e_list - FStarC_Reflection_V2_NBEEmbeddings.e_binding) - FStarC_Tactics_V2_Basic.intros - FStarC_Tactics_V2_Basic.intros in + Prims.int_zero "intro" + FStarC_Syntax_Embeddings.e_unit + FStarC_Reflection_V2_Embeddings.e_binding + FStarC_TypeChecker_NBETerm.e_unit + FStarC_Reflection_V2_NBEEmbeddings.e_binding + FStarC_Tactics_V2_Basic.intro + FStarC_Tactics_V2_Basic.intro in let uu___38 = let uu___39 = FStarC_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "intro_rec" - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_binding + Prims.int_zero "intros" + FStarC_Syntax_Embeddings.e_int + (FStarC_Syntax_Embeddings.e_list FStarC_Reflection_V2_Embeddings.e_binding) - FStarC_TypeChecker_NBETerm.e_unit - (FStarC_TypeChecker_NBETerm.e_tuple2 - FStarC_Reflection_V2_NBEEmbeddings.e_binding + FStarC_TypeChecker_NBETerm.e_int + (FStarC_TypeChecker_NBETerm.e_list FStarC_Reflection_V2_NBEEmbeddings.e_binding) - FStarC_Tactics_V2_Basic.intro_rec - FStarC_Tactics_V2_Basic.intro_rec in + FStarC_Tactics_V2_Basic.intros + FStarC_Tactics_V2_Basic.intros in let uu___40 = let uu___41 = FStarC_Tactics_InterpFuns.mk_tac_step_1 - Prims.int_zero "norm" - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_norm_step) + Prims.int_zero "intro_rec" FStarC_Syntax_Embeddings.e_unit - (FStarC_TypeChecker_NBETerm.e_list - FStarC_TypeChecker_NBETerm.e_norm_step) + (FStarC_Syntax_Embeddings.e_tuple2 + FStarC_Reflection_V2_Embeddings.e_binding + FStarC_Reflection_V2_Embeddings.e_binding) FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_V2_Basic.norm - FStarC_Tactics_V2_Basic.norm in + (FStarC_TypeChecker_NBETerm.e_tuple2 + FStarC_Reflection_V2_NBEEmbeddings.e_binding + FStarC_Reflection_V2_NBEEmbeddings.e_binding) + FStarC_Tactics_V2_Basic.intro_rec + FStarC_Tactics_V2_Basic.intro_rec in let uu___42 = let uu___43 = - FStarC_Tactics_InterpFuns.mk_tac_step_3 - Prims.int_zero - "norm_term_env" - FStarC_Reflection_V2_Embeddings.e_env + FStarC_Tactics_InterpFuns.mk_tac_step_1 + Prims.int_zero "norm" (FStarC_Syntax_Embeddings.e_list FStarC_Syntax_Embeddings.e_norm_step) - uu___0 uu___0 - FStarC_Reflection_V2_NBEEmbeddings.e_env + FStarC_Syntax_Embeddings.e_unit (FStarC_TypeChecker_NBETerm.e_list FStarC_TypeChecker_NBETerm.e_norm_step) - FStarC_Reflection_V2_NBEEmbeddings.e_attribute - FStarC_Reflection_V2_NBEEmbeddings.e_attribute - FStarC_Tactics_V2_Basic.norm_term_env - FStarC_Tactics_V2_Basic.norm_term_env in + FStarC_TypeChecker_NBETerm.e_unit + FStarC_Tactics_V2_Basic.norm + FStarC_Tactics_V2_Basic.norm in let uu___44 = let uu___45 = - FStarC_Tactics_InterpFuns.mk_tac_step_2 + FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero - "norm_binding_type" + "norm_term_env" + FStarC_Reflection_V2_Embeddings.e_env (FStarC_Syntax_Embeddings.e_list FStarC_Syntax_Embeddings.e_norm_step) - FStarC_Reflection_V2_Embeddings.e_binding - FStarC_Syntax_Embeddings.e_unit + uu___0 uu___0 + FStarC_Reflection_V2_NBEEmbeddings.e_env (FStarC_TypeChecker_NBETerm.e_list FStarC_TypeChecker_NBETerm.e_norm_step) - FStarC_Reflection_V2_NBEEmbeddings.e_binding - FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_V2_Basic.norm_binding_type - FStarC_Tactics_V2_Basic.norm_binding_type in + FStarC_Reflection_V2_NBEEmbeddings.e_attribute + FStarC_Reflection_V2_NBEEmbeddings.e_attribute + FStarC_Tactics_V2_Basic.norm_term_env + FStarC_Tactics_V2_Basic.norm_term_env in let uu___46 = let uu___47 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero - "rename_to" + "norm_binding_type" + (FStarC_Syntax_Embeddings.e_list + FStarC_Syntax_Embeddings.e_norm_step) FStarC_Reflection_V2_Embeddings.e_binding - FStarC_Syntax_Embeddings.e_string - FStarC_Reflection_V2_Embeddings.e_binding - FStarC_Reflection_V2_NBEEmbeddings.e_binding - FStarC_TypeChecker_NBETerm.e_string + FStarC_Syntax_Embeddings.e_unit + (FStarC_TypeChecker_NBETerm.e_list + FStarC_TypeChecker_NBETerm.e_norm_step) FStarC_Reflection_V2_NBEEmbeddings.e_binding - FStarC_Tactics_V2_Basic.rename_to - FStarC_Tactics_V2_Basic.rename_to in + FStarC_TypeChecker_NBETerm.e_unit + FStarC_Tactics_V2_Basic.norm_binding_type + FStarC_Tactics_V2_Basic.norm_binding_type in let uu___48 = let uu___49 = - FStarC_Tactics_InterpFuns.mk_tac_step_1 + FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero - "var_retype" + "rename_to" FStarC_Reflection_V2_Embeddings.e_binding - FStarC_Syntax_Embeddings.e_unit + FStarC_Syntax_Embeddings.e_string + FStarC_Reflection_V2_Embeddings.e_binding + FStarC_Reflection_V2_NBEEmbeddings.e_binding + FStarC_TypeChecker_NBETerm.e_string FStarC_Reflection_V2_NBEEmbeddings.e_binding - FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_V2_Basic.var_retype - FStarC_Tactics_V2_Basic.var_retype in + FStarC_Tactics_V2_Basic.rename_to + FStarC_Tactics_V2_Basic.rename_to in let uu___50 = let uu___51 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero - "revert" - FStarC_Syntax_Embeddings.e_unit + "var_retype" + FStarC_Reflection_V2_Embeddings.e_binding FStarC_Syntax_Embeddings.e_unit + FStarC_Reflection_V2_NBEEmbeddings.e_binding FStarC_TypeChecker_NBETerm.e_unit - FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_V2_Basic.revert - FStarC_Tactics_V2_Basic.revert in + FStarC_Tactics_V2_Basic.var_retype + FStarC_Tactics_V2_Basic.var_retype in let uu___52 = let uu___53 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero - "clear_top" + "revert" FStarC_Syntax_Embeddings.e_unit FStarC_Syntax_Embeddings.e_unit FStarC_TypeChecker_NBETerm.e_unit FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_V2_Basic.clear_top - FStarC_Tactics_V2_Basic.clear_top in + FStarC_Tactics_V2_Basic.revert + FStarC_Tactics_V2_Basic.revert in let uu___54 = let uu___55 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero - "clear" - FStarC_Reflection_V2_Embeddings.e_binding + "clear_top" + FStarC_Syntax_Embeddings.e_unit FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_NBEEmbeddings.e_binding FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_V2_Basic.clear - FStarC_Tactics_V2_Basic.clear in + FStarC_TypeChecker_NBETerm.e_unit + FStarC_Tactics_V2_Basic.clear_top + FStarC_Tactics_V2_Basic.clear_top in let uu___56 = let uu___57 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero - "rewrite" + "clear" FStarC_Reflection_V2_Embeddings.e_binding FStarC_Syntax_Embeddings.e_unit FStarC_Reflection_V2_NBEEmbeddings.e_binding FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_V2_Basic.rewrite - FStarC_Tactics_V2_Basic.rewrite in + FStarC_Tactics_V2_Basic.clear + FStarC_Tactics_V2_Basic.clear in let uu___58 = let uu___59 = - FStarC_Tactics_InterpFuns.mk_tac_step_2 + FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero - "grewrite" - uu___0 - uu___0 + "rewrite" + FStarC_Reflection_V2_Embeddings.e_binding FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_NBEEmbeddings.e_attribute - FStarC_Reflection_V2_NBEEmbeddings.e_attribute + FStarC_Reflection_V2_NBEEmbeddings.e_binding FStarC_TypeChecker_NBETerm.e_unit - FStarC_Tactics_V2_Basic.grewrite - FStarC_Tactics_V2_Basic.grewrite in + FStarC_Tactics_V2_Basic.rewrite + FStarC_Tactics_V2_Basic.rewrite in let uu___60 = let uu___61 = - FStarC_Tactics_InterpFuns.mk_tac_step_1 + FStarC_Tactics_InterpFuns.mk_tac_step_2 + Prims.int_zero + "grewrite" + uu___0 + uu___0 + FStarC_Syntax_Embeddings.e_unit + FStarC_Reflection_V2_NBEEmbeddings.e_attribute + FStarC_Reflection_V2_NBEEmbeddings.e_attribute + FStarC_TypeChecker_NBETerm.e_unit + FStarC_Tactics_V2_Basic.grewrite + FStarC_Tactics_V2_Basic.grewrite in + let uu___62 = + let uu___63 + = + FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero "refine_intro" FStarC_Syntax_Embeddings.e_unit @@ -426,8 +438,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.refine_intro FStarC_Tactics_V2_Basic.refine_intro in - let uu___62 = - let uu___63 + let uu___64 + = + let uu___65 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -442,9 +455,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.t_exact FStarC_Tactics_V2_Basic.t_exact in - let uu___64 + let uu___66 = - let uu___65 + let uu___67 = FStarC_Tactics_InterpFuns.mk_tac_step_4 Prims.int_zero @@ -461,9 +474,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.t_apply FStarC_Tactics_V2_Basic.t_apply in - let uu___66 + let uu___68 = - let uu___67 + let uu___69 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -478,9 +491,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.t_apply_lemma FStarC_Tactics_V2_Basic.t_apply_lemma in - let uu___68 + let uu___70 = - let uu___69 + let uu___71 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -491,9 +504,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.set_options FStarC_Tactics_V2_Basic.set_options in - let uu___70 + let uu___72 = - let uu___71 + let uu___73 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -506,9 +519,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_comp FStarC_Tactics_V2_Basic.tcc FStarC_Tactics_V2_Basic.tcc in - let uu___72 + let uu___74 = - let uu___73 + let uu___75 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -521,9 +534,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_attribute FStarC_Tactics_V2_Basic.tc FStarC_Tactics_V2_Basic.tc in - let uu___74 + let uu___76 = - let uu___75 + let uu___77 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -534,9 +547,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.unshelve FStarC_Tactics_V2_Basic.unshelve in - let uu___76 + let uu___78 = - let uu___77 + let uu___79 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one @@ -549,16 +562,16 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_any FStarC_Tactics_V2_Basic.unquote (fun - uu___78 + uu___80 -> fun - uu___79 + uu___81 -> failwith "NBE unquote") in - let uu___78 + let uu___80 = - let uu___79 + let uu___81 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -569,9 +582,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.prune FStarC_Tactics_V2_Basic.prune in - let uu___80 + let uu___82 = - let uu___81 + let uu___83 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -582,9 +595,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.addns FStarC_Tactics_V2_Basic.addns in - let uu___82 + let uu___84 = - let uu___83 + let uu___85 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -595,9 +608,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.print FStarC_Tactics_V2_Basic.print in - let uu___84 + let uu___86 = - let uu___85 + let uu___87 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -608,9 +621,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_bool FStarC_Tactics_V2_Basic.debugging FStarC_Tactics_V2_Basic.debugging in - let uu___86 + let uu___88 = - let uu___87 + let uu___89 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -621,9 +634,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_bool FStarC_Tactics_V2_Basic.ide FStarC_Tactics_V2_Basic.ide in - let uu___88 + let uu___90 = - let uu___89 + let uu___91 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -634,9 +647,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.dump FStarC_Tactics_V2_Basic.dump in - let uu___90 + let uu___92 = - let uu___91 + let uu___93 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -649,9 +662,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.dump_all FStarC_Tactics_V2_Basic.dump_all in - let uu___92 + let uu___94 = - let uu___93 + let uu___95 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -664,29 +677,29 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.dump_uvars_of FStarC_Tactics_V2_Basic.dump_uvars_of in - let uu___94 + let uu___96 = - let uu___95 + let uu___97 = - let uu___96 + let uu___98 = FStarC_Tactics_Interpreter.e_tactic_1 FStarC_Reflection_V2_Embeddings.e_term (FStarC_Syntax_Embeddings.e_tuple2 FStarC_Syntax_Embeddings.e_bool FStarC_Tactics_Embedding.e_ctrl_flag) in - let uu___97 + let uu___99 = FStarC_Tactics_Interpreter.e_tactic_thunk FStarC_Syntax_Embeddings.e_unit in - let uu___98 + let uu___100 = FStarC_Tactics_Interpreter.e_tactic_nbe_1 FStarC_Reflection_V2_NBEEmbeddings.e_term (FStarC_TypeChecker_NBETerm.e_tuple2 FStarC_TypeChecker_NBETerm.e_bool FStarC_Tactics_Embedding.e_ctrl_flag_nbe) in - let uu___99 + let uu___101 = FStarC_Tactics_Interpreter.e_tactic_nbe_thunk FStarC_TypeChecker_NBETerm.e_unit in @@ -694,18 +707,18 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "ctrl_rewrite" FStarC_Tactics_Embedding.e_direction - uu___96 - uu___97 - FStarC_Syntax_Embeddings.e_unit - FStarC_Tactics_Embedding.e_direction_nbe uu___98 uu___99 + FStarC_Syntax_Embeddings.e_unit + FStarC_Tactics_Embedding.e_direction_nbe + uu___100 + uu___101 FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_CtrlRewrite.ctrl_rewrite FStarC_Tactics_CtrlRewrite.ctrl_rewrite in - let uu___96 + let uu___98 = - let uu___97 + let uu___99 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -716,9 +729,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.t_trefl FStarC_Tactics_V2_Basic.t_trefl in - let uu___98 + let uu___100 = - let uu___99 + let uu___101 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -729,9 +742,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.dup FStarC_Tactics_V2_Basic.dup in - let uu___100 + let uu___102 = - let uu___101 + let uu___103 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -742,9 +755,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.tadmit_t FStarC_Tactics_V2_Basic.tadmit_t in - let uu___102 + let uu___104 = - let uu___103 + let uu___105 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -755,9 +768,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.join FStarC_Tactics_V2_Basic.join in - let uu___104 + let uu___106 = - let uu___105 + let uu___107 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -774,9 +787,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_int)) FStarC_Tactics_V2_Basic.t_destruct FStarC_Tactics_V2_Basic.t_destruct in - let uu___106 + let uu___108 = - let uu___107 + let uu___109 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -787,9 +800,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_env FStarC_Tactics_V2_Basic.top_env FStarC_Tactics_V2_Basic.top_env in - let uu___108 + let uu___110 = - let uu___109 + let uu___111 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -800,9 +813,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_int FStarC_Tactics_V2_Basic.fresh FStarC_Tactics_V2_Basic.fresh in - let uu___110 + let uu___112 = - let uu___111 + let uu___113 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -813,9 +826,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_int FStarC_Tactics_V2_Basic.curms FStarC_Tactics_V2_Basic.curms in - let uu___112 + let uu___114 = - let uu___113 + let uu___115 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -830,9 +843,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_attribute FStarC_Tactics_V2_Basic.uvar_env FStarC_Tactics_V2_Basic.uvar_env in - let uu___114 + let uu___116 = - let uu___115 + let uu___117 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -845,9 +858,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_attribute FStarC_Tactics_V2_Basic.ghost_uvar_env FStarC_Tactics_V2_Basic.ghost_uvar_env in - let uu___116 + let uu___118 = - let uu___117 + let uu___119 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -858,9 +871,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_attribute FStarC_Tactics_V2_Basic.fresh_universe_uvar FStarC_Tactics_V2_Basic.fresh_universe_uvar in - let uu___118 + let uu___120 = - let uu___119 + let uu___121 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -875,9 +888,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_bool FStarC_Tactics_V2_Basic.unify_env FStarC_Tactics_V2_Basic.unify_env in - let uu___120 + let uu___122 = - let uu___121 + let uu___123 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -892,9 +905,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_bool FStarC_Tactics_V2_Basic.unify_guard_env FStarC_Tactics_V2_Basic.unify_guard_env in - let uu___122 + let uu___124 = - let uu___123 + let uu___125 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -909,9 +922,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_bool FStarC_Tactics_V2_Basic.match_env FStarC_Tactics_V2_Basic.match_env in - let uu___124 + let uu___126 = - let uu___125 + let uu___127 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -926,9 +939,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_string FStarC_Tactics_V2_Basic.launch_process FStarC_Tactics_V2_Basic.launch_process in - let uu___126 + let uu___128 = - let uu___127 + let uu___129 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -939,9 +952,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.change FStarC_Tactics_V2_Basic.change in - let uu___128 + let uu___130 = - let uu___129 + let uu___131 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -952,9 +965,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Tactics_Embedding.e_guard_policy_nbe FStarC_Tactics_V2_Basic.get_guard_policy FStarC_Tactics_V2_Basic.get_guard_policy in - let uu___130 + let uu___132 = - let uu___131 + let uu___133 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -965,9 +978,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.set_guard_policy FStarC_Tactics_V2_Basic.set_guard_policy in - let uu___132 + let uu___134 = - let uu___133 + let uu___135 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -978,9 +991,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_bool FStarC_Tactics_V2_Basic.lax_on FStarC_Tactics_V2_Basic.lax_on in - let uu___134 + let uu___136 = - let uu___135 + let uu___137 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one @@ -993,16 +1006,16 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_any FStarC_Tactics_V2_Basic.lget (fun - uu___136 + uu___138 -> fun - uu___137 + uu___139 -> FStarC_Tactics_Monad.fail "sorry, `lget` does not work in NBE") in - let uu___136 + let uu___138 = - let uu___137 + let uu___139 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_one @@ -1017,19 +1030,19 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.lset (fun - uu___138 + uu___140 -> fun - uu___139 + uu___141 -> fun - uu___140 + uu___142 -> FStarC_Tactics_Monad.fail "sorry, `lset` does not work in NBE") in - let uu___138 + let uu___140 = - let uu___139 + let uu___141 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_one @@ -1040,9 +1053,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.set_urgency FStarC_Tactics_V2_Basic.set_urgency in - let uu___140 + let uu___142 = - let uu___141 + let uu___143 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_one @@ -1053,9 +1066,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.set_dump_on_failure FStarC_Tactics_V2_Basic.set_dump_on_failure in - let uu___142 + let uu___144 = - let uu___143 + let uu___145 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_one @@ -1066,9 +1079,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.t_commute_applied_match FStarC_Tactics_V2_Basic.t_commute_applied_match in - let uu___144 + let uu___146 = - let uu___145 + let uu___147 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1079,9 +1092,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.gather_explicit_guards_for_resolved_goals FStarC_Tactics_V2_Basic.gather_explicit_guards_for_resolved_goals in - let uu___146 + let uu___148 = - let uu___147 + let uu___149 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1094,9 +1107,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_attribute FStarC_Tactics_V2_Basic.string_to_term FStarC_Tactics_V2_Basic.string_to_term in - let uu___148 + let uu___150 = - let uu___149 + let uu___151 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1113,9 +1126,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_binding) FStarC_Tactics_V2_Basic.push_bv_dsenv FStarC_Tactics_V2_Basic.push_bv_dsenv in - let uu___150 + let uu___152 = - let uu___151 + let uu___153 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1126,9 +1139,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_string FStarC_Tactics_V2_Basic.term_to_string FStarC_Tactics_V2_Basic.term_to_string in - let uu___152 + let uu___154 = - let uu___153 + let uu___155 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1139,9 +1152,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_string FStarC_Tactics_V2_Basic.comp_to_string FStarC_Tactics_V2_Basic.comp_to_string in - let uu___154 + let uu___156 = - let uu___155 + let uu___157 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1152,9 +1165,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_document FStarC_Tactics_V2_Basic.term_to_doc FStarC_Tactics_V2_Basic.term_to_doc in - let uu___156 + let uu___158 = - let uu___157 + let uu___159 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1165,9 +1178,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_document FStarC_Tactics_V2_Basic.comp_to_doc FStarC_Tactics_V2_Basic.comp_to_doc in - let uu___158 + let uu___160 = - let uu___159 + let uu___161 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1178,9 +1191,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_string FStarC_Tactics_V2_Basic.range_to_string FStarC_Tactics_V2_Basic.range_to_string in - let uu___160 + let uu___162 = - let uu___161 + let uu___163 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1193,15 +1206,15 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_bool FStarC_Tactics_V2_Basic.term_eq_old FStarC_Tactics_V2_Basic.term_eq_old in - let uu___162 + let uu___164 = - let uu___163 + let uu___165 = - let uu___164 + let uu___166 = FStarC_Tactics_Interpreter.e_tactic_thunk FStarC_Syntax_Embeddings.e_any in - let uu___165 + let uu___167 = FStarC_Tactics_Interpreter.e_tactic_nbe_thunk FStarC_TypeChecker_NBETerm.e_any in @@ -1210,23 +1223,23 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = "with_compat_pre_core" FStarC_Syntax_Embeddings.e_any FStarC_Syntax_Embeddings.e_int - uu___164 + uu___166 FStarC_Syntax_Embeddings.e_any FStarC_TypeChecker_NBETerm.e_any FStarC_TypeChecker_NBETerm.e_int - uu___165 + uu___167 FStarC_TypeChecker_NBETerm.e_any (fun - uu___166 + uu___168 -> FStarC_Tactics_V2_Basic.with_compat_pre_core) (fun - uu___166 + uu___168 -> FStarC_Tactics_V2_Basic.with_compat_pre_core) in - let uu___164 + let uu___166 = - let uu___165 + let uu___167 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1237,9 +1250,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_vconfig FStarC_Tactics_V2_Basic.get_vconfig FStarC_Tactics_V2_Basic.get_vconfig in - let uu___166 + let uu___168 = - let uu___167 + let uu___169 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1250,9 +1263,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.set_vconfig FStarC_Tactics_V2_Basic.set_vconfig in - let uu___168 + let uu___170 = - let uu___169 + let uu___171 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1263,9 +1276,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.t_smt_sync FStarC_Tactics_V2_Basic.t_smt_sync in - let uu___170 + let uu___172 = - let uu___171 + let uu___173 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1278,9 +1291,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_int) FStarC_Tactics_V2_Basic.free_uvars FStarC_Tactics_V2_Basic.free_uvars in - let uu___172 + let uu___174 = - let uu___173 + let uu___175 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1297,9 +1310,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_string)) FStarC_Tactics_V2_Basic.all_ext_options FStarC_Tactics_V2_Basic.all_ext_options in - let uu___174 + let uu___176 = - let uu___175 + let uu___177 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1310,9 +1323,22 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_string FStarC_Tactics_V2_Basic.ext_getv FStarC_Tactics_V2_Basic.ext_getv in - let uu___176 + let uu___178 = - let uu___177 + let uu___179 + = + FStarC_Tactics_InterpFuns.mk_tac_step_1 + Prims.int_zero + "ext_enabled" + FStarC_Syntax_Embeddings.e_string + FStarC_Syntax_Embeddings.e_bool + FStarC_TypeChecker_NBETerm.e_string + FStarC_TypeChecker_NBETerm.e_bool + FStarC_Tactics_V2_Basic.ext_enabled + FStarC_Tactics_V2_Basic.ext_enabled in + let uu___180 + = + let uu___181 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1329,9 +1355,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_string)) FStarC_Tactics_V2_Basic.ext_getns FStarC_Tactics_V2_Basic.ext_getns in - let uu___178 + let uu___182 = - let uu___179 + let uu___183 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one @@ -1345,16 +1371,16 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStarC_Tactics_Embedding.e_tref_nbe ()) (fun - uu___180 + uu___184 -> FStarC_Tactics_V2_Basic.alloc) (fun - uu___180 + uu___184 -> FStarC_Tactics_V2_Basic.alloc) in - let uu___180 + let uu___184 = - let uu___181 + let uu___185 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_one @@ -1368,16 +1394,16 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = ()) FStarC_TypeChecker_NBETerm.e_any (fun - uu___182 + uu___186 -> FStarC_Tactics_V2_Basic.read) (fun - uu___182 + uu___186 -> FStarC_Tactics_V2_Basic.read) in - let uu___182 + let uu___186 = - let uu___183 + let uu___187 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_one @@ -1393,16 +1419,16 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_any FStarC_TypeChecker_NBETerm.e_unit (fun - uu___184 + uu___188 -> FStarC_Tactics_V2_Basic.write) (fun - uu___184 + uu___188 -> FStarC_Tactics_V2_Basic.write) in - let uu___184 + let uu___188 = - let uu___185 + let uu___189 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1423,9 +1449,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_is_non_informative FStarC_Tactics_V2_Basic.refl_is_non_informative in - let uu___186 + let uu___190 = - let uu___187 + let uu___191 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1448,9 +1474,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_check_subtyping FStarC_Tactics_V2_Basic.refl_check_subtyping in - let uu___188 + let uu___192 = - let uu___189 + let uu___193 = FStarC_Tactics_InterpFuns.mk_tac_step_5 Prims.int_zero @@ -1477,9 +1503,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.t_refl_check_equiv FStarC_Tactics_V2_Basic.t_refl_check_equiv in - let uu___190 + let uu___194 = - let uu___191 + let uu___195 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1504,9 +1530,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_core_compute_term_type FStarC_Tactics_V2_Basic.refl_core_compute_term_type in - let uu___192 + let uu___196 = - let uu___193 + let uu___197 = FStarC_Tactics_InterpFuns.mk_tac_step_4 Prims.int_zero @@ -1531,9 +1557,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_core_check_term FStarC_Tactics_V2_Basic.refl_core_check_term in - let uu___194 + let uu___198 = - let uu___195 + let uu___199 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1556,9 +1582,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_core_check_term_at_type FStarC_Tactics_V2_Basic.refl_core_check_term_at_type in - let uu___196 + let uu___200 = - let uu___197 + let uu___201 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1587,9 +1613,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_tc_term FStarC_Tactics_V2_Basic.refl_tc_term in - let uu___198 + let uu___202 = - let uu___199 + let uu___203 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1610,9 +1636,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_universe_of FStarC_Tactics_V2_Basic.refl_universe_of in - let uu___200 + let uu___204 = - let uu___201 + let uu___205 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1633,9 +1659,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_check_prop_validity FStarC_Tactics_V2_Basic.refl_check_prop_validity in - let uu___202 + let uu___206 = - let uu___203 + let uu___207 = FStarC_Tactics_InterpFuns.mk_tac_step_4 Prims.int_zero @@ -1645,6 +1671,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = uu___0 (FStarC_Syntax_Embeddings.e_list FStarC_Reflection_V2_Embeddings.e_pattern) + (FStarC_Syntax_Embeddings.e_tuple2 (FStarC_Syntax_Embeddings.e_option (FStarC_Syntax_Embeddings.e_tuple2 (FStarC_Syntax_Embeddings.e_list @@ -1652,11 +1679,14 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStarC_Syntax_Embeddings.e_list (FStarC_Syntax_Embeddings.e_list FStarC_Reflection_V2_Embeddings.e_binding)))) + (FStarC_Syntax_Embeddings.e_list + FStarC_Syntax_Embeddings.e_issue)) FStarC_Reflection_V2_NBEEmbeddings.e_env FStarC_Reflection_V2_NBEEmbeddings.e_attribute FStarC_Reflection_V2_NBEEmbeddings.e_attribute (FStarC_TypeChecker_NBETerm.e_list FStarC_Reflection_V2_NBEEmbeddings.e_pattern) + (FStarC_TypeChecker_NBETerm.e_tuple2 (FStarC_TypeChecker_NBETerm.e_option (FStarC_TypeChecker_NBETerm.e_tuple2 (FStarC_TypeChecker_NBETerm.e_list @@ -1664,13 +1694,15 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStarC_TypeChecker_NBETerm.e_list (FStarC_TypeChecker_NBETerm.e_list FStarC_Reflection_V2_NBEEmbeddings.e_binding)))) + (FStarC_TypeChecker_NBETerm.e_list + FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_check_match_complete FStarC_Tactics_V2_Basic.refl_check_match_complete in - let uu___204 + let uu___208 = - let uu___205 + let uu___209 = - let uu___206 + let uu___210 = e_ret_t (FStarC_Syntax_Embeddings.e_tuple3 @@ -1683,7 +1715,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = uu___0) (solve uu___0)) in - let uu___207 + let uu___211 = nbe_e_ret_t (FStarC_TypeChecker_NBETerm.e_tuple3 @@ -1703,26 +1735,26 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = uu___0 (FStarC_Syntax_Embeddings.e_option uu___0) - uu___206 + uu___210 FStarC_Reflection_V2_NBEEmbeddings.e_env FStarC_Reflection_V2_NBEEmbeddings.e_attribute (FStarC_TypeChecker_NBETerm.e_option FStarC_Reflection_V2_NBEEmbeddings.e_attribute) - uu___207 + uu___211 FStarC_Tactics_V2_Basic.refl_instantiate_implicits FStarC_Tactics_V2_Basic.refl_instantiate_implicits in - let uu___206 + let uu___210 = - let uu___207 + let uu___211 = - let uu___208 + let uu___212 = e_ret_t (FStarC_Syntax_Embeddings.e_list (FStarC_Syntax_Embeddings.e_tuple2 FStarC_Reflection_V2_Embeddings.e_namedv FStarC_Reflection_V2_Embeddings.e_term)) in - let uu___209 + let uu___213 = nbe_e_ret_t (FStarC_TypeChecker_NBETerm.e_list @@ -1739,7 +1771,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_Embeddings.e_term)) uu___0 uu___0 - uu___208 + uu___212 FStarC_Reflection_V2_NBEEmbeddings.e_env (FStarC_TypeChecker_NBETerm.e_list (FStarC_TypeChecker_NBETerm.e_tuple2 @@ -1747,12 +1779,12 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_term)) FStarC_Reflection_V2_NBEEmbeddings.e_attribute FStarC_Reflection_V2_NBEEmbeddings.e_attribute - uu___209 + uu___213 FStarC_Tactics_V2_Basic.refl_try_unify FStarC_Tactics_V2_Basic.refl_try_unify in - let uu___208 + let uu___212 = - let uu___209 + let uu___213 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1775,9 +1807,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_maybe_relate_after_unfolding FStarC_Tactics_V2_Basic.refl_maybe_relate_after_unfolding in - let uu___210 + let uu___214 = - let uu___211 + let uu___215 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1798,9 +1830,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.refl_maybe_unfold_head FStarC_Tactics_V2_Basic.refl_maybe_unfold_head in - let uu___212 + let uu___216 = - let uu___213 + let uu___217 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1817,9 +1849,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_attribute FStarC_Tactics_V2_Basic.refl_norm_well_typed_term FStarC_Tactics_V2_Basic.refl_norm_well_typed_term in - let uu___214 + let uu___218 = - let uu___215 + let uu___219 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1832,9 +1864,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_env FStarC_Tactics_V2_Basic.push_open_namespace FStarC_Tactics_V2_Basic.push_open_namespace in - let uu___216 + let uu___220 = - let uu___217 + let uu___221 = FStarC_Tactics_InterpFuns.mk_tac_step_3 Prims.int_zero @@ -1849,9 +1881,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_env FStarC_Tactics_V2_Basic.push_module_abbrev FStarC_Tactics_V2_Basic.push_module_abbrev in - let uu___218 + let uu___222 = - let uu___219 + let uu___223 = FStarC_Tactics_InterpFuns.mk_tac_step_2 Prims.int_zero @@ -1872,9 +1904,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Reflection_V2_NBEEmbeddings.e_fv))) FStarC_Tactics_V2_Basic.resolve_name FStarC_Tactics_V2_Basic.resolve_name in - let uu___220 + let uu___224 = - let uu___221 + let uu___225 = FStarC_Tactics_InterpFuns.mk_tac_step_1 Prims.int_zero @@ -1887,15 +1919,15 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_unit FStarC_Tactics_V2_Basic.log_issues FStarC_Tactics_V2_Basic.log_issues in - let uu___222 + let uu___226 = - let uu___223 + let uu___227 = - let uu___224 + let uu___228 = FStarC_Tactics_Interpreter.e_tactic_thunk FStarC_Syntax_Embeddings.e_unit in - let uu___225 + let uu___229 = FStarC_Tactics_Interpreter.e_tactic_nbe_thunk FStarC_TypeChecker_NBETerm.e_unit in @@ -1903,7 +1935,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = Prims.int_zero "call_subtac" FStarC_Reflection_V2_Embeddings.e_env - uu___224 + uu___228 FStarC_Reflection_V2_Embeddings.e_universe uu___0 (FStarC_Syntax_Embeddings.e_tuple2 @@ -1912,7 +1944,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = (FStarC_Syntax_Embeddings.e_list FStarC_Syntax_Embeddings.e_issue)) FStarC_Reflection_V2_NBEEmbeddings.e_env - uu___225 + uu___229 FStarC_Reflection_V2_NBEEmbeddings.e_universe FStarC_Reflection_V2_NBEEmbeddings.e_attribute (FStarC_TypeChecker_NBETerm.e_tuple2 @@ -1922,9 +1954,9 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.call_subtac FStarC_Tactics_V2_Basic.call_subtac in - let uu___224 + let uu___228 = - let uu___225 + let uu___229 = FStarC_Tactics_InterpFuns.mk_tac_step_4 Prims.int_zero @@ -1949,7 +1981,13 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_NBETerm.e_issue)) FStarC_Tactics_V2_Basic.call_subtac_tm FStarC_Tactics_V2_Basic.call_subtac_tm in - [uu___225] in + [uu___229] in + uu___227 + :: + uu___228 in + uu___225 + :: + uu___226 in uu___223 :: uu___224 in diff --git a/stage0/fstar-lib/generated/FStarC_Thunk.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Thunk.ml similarity index 52% rename from stage0/fstar-lib/generated/FStarC_Thunk.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Thunk.ml index f8f89d3cac2..de73623b757 100644 --- a/stage0/fstar-lib/generated/FStarC_Thunk.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Thunk.ml @@ -1,19 +1,17 @@ open Prims -type 'a thunk = - (unit -> 'a, 'a) FStar_Pervasives.either FStarC_Compiler_Effect.ref +type 'a thunk = (unit -> 'a, 'a) FStar_Pervasives.either FStarC_Effect.ref type 'a t = 'a thunk let mk : 'a . (unit -> 'a) -> 'a thunk = - fun f -> FStarC_Compiler_Effect.alloc (FStar_Pervasives.Inl f) + fun f -> FStarC_Effect.alloc (FStar_Pervasives.Inl f) let mkv : 'a . 'a -> 'a thunk = - fun v -> FStarC_Compiler_Effect.alloc (FStar_Pervasives.Inr v) + fun v -> FStarC_Effect.alloc (FStar_Pervasives.Inr v) let force : 'a . 'a thunk -> 'a = fun t1 -> - let uu___ = FStarC_Compiler_Effect.op_Bang t1 in + let uu___ = FStarC_Effect.op_Bang t1 in match uu___ with | FStar_Pervasives.Inr a1 -> a1 | FStar_Pervasives.Inl f -> let a1 = f () in - (FStarC_Compiler_Effect.op_Colon_Equals t1 (FStar_Pervasives.Inr a1); - a1) + (FStarC_Effect.op_Colon_Equals t1 (FStar_Pervasives.Inr a1); a1) let map : 'a 'b . ('a -> 'b) -> 'a thunk -> 'b thunk = fun f -> fun t1 -> mk (fun uu___ -> let uu___1 = force t1 in f uu___1) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_ToSyntax_Interleave.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_ToSyntax_Interleave.ml similarity index 88% rename from stage0/fstar-lib/generated/FStarC_ToSyntax_Interleave.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_ToSyntax_Interleave.ml index 7c3b5c7eb9c..531327b78d1 100644 --- a/stage0/fstar-lib/generated/FStarC_ToSyntax_Interleave.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_ToSyntax_Interleave.ml @@ -20,7 +20,7 @@ let (is_type : FStarC_Ident.ident -> FStarC_Parser_AST.decl -> Prims.bool) = fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Tycon (uu___, uu___1, tys) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun t -> let uu___2 = FStarC_Parser_AST.id_of_tycon t in let uu___3 = FStarC_Ident.string_of_id x in uu___2 = uu___3) @@ -33,7 +33,7 @@ let (definition_lids : | FStarC_Parser_AST.TopLevelLet (uu___, defs) -> FStarC_Parser_AST.lids_of_let defs | FStarC_Parser_AST.Tycon (uu___, uu___1, tys) -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___2 -> match uu___2 with | FStarC_Parser_AST.TyconAbbrev (id, uu___3, uu___4, uu___5) -> @@ -45,15 +45,14 @@ let (definition_lids : let uu___6 = FStarC_Ident.lid_of_ids [id] in [uu___6] | uu___3 -> []) tys | FStarC_Parser_AST.Splice (uu___, ids, uu___1) -> - FStarC_Compiler_List.map (fun id -> FStarC_Ident.lid_of_ids [id]) ids + FStarC_List.map (fun id -> FStarC_Ident.lid_of_ids [id]) ids | FStarC_Parser_AST.DeclToBeDesugared { FStarC_Parser_AST.lang_name = uu___; FStarC_Parser_AST.blob = uu___1; FStarC_Parser_AST.idents = ids; FStarC_Parser_AST.to_string = uu___2; FStarC_Parser_AST.eq = uu___3; FStarC_Parser_AST.dep_scan = uu___4;_} - -> - FStarC_Compiler_List.map (fun id -> FStarC_Ident.lid_of_ids [id]) ids + -> FStarC_List.map (fun id -> FStarC_Ident.lid_of_ids [id]) ids | FStarC_Parser_AST.DeclSyntaxExtension (extension_name, code, uu___, range) -> let ext_parser = @@ -61,7 +60,7 @@ let (definition_lids : (match ext_parser with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 "Unknown syntax extension %s" + FStarC_Util.format1 "Unknown syntax extension %s" extension_name in FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_decl d FStarC_Errors_Codes.Fatal_SyntaxError () @@ -86,7 +85,7 @@ let (is_definition_of : fun x -> fun d -> let uu___ = definition_lids d in - FStarC_Compiler_Util.for_some (id_eq_lid x) uu___ + FStarC_Util.for_some (id_eq_lid x) uu___ let rec (prefix_with_iface_decls : FStarC_Parser_AST.decl Prims.list -> FStarC_Parser_AST.decl -> @@ -117,7 +116,7 @@ let rec (prefix_with_iface_decls : | iface_hd::iface_tl -> (match iface_hd.FStarC_Parser_AST.d with | FStarC_Parser_AST.Tycon (uu___, uu___1, tys) when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Parser_AST.TyconAbstract uu___3 -> true @@ -134,18 +133,16 @@ let rec (prefix_with_iface_decls : (Obj.magic uu___2) | FStarC_Parser_AST.Splice (uu___, x::[], uu___1) -> let def_ids = definition_lids impl in - let defines_x = - FStarC_Compiler_Util.for_some (id_eq_lid x) def_ids in + let defines_x = FStarC_Util.for_some (id_eq_lid x) def_ids in if Prims.op_Negation defines_x then ((let uu___3 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun y -> let uu___4 = let uu___5 = FStarC_Ident.ident_of_lid y in is_val uu___5 in - FStarC_Compiler_Util.for_some uu___4 iface_tl) - def_ids in + FStarC_Util.for_some uu___4 iface_tl) def_ids in if uu___3 then let uu___4 = @@ -178,7 +175,7 @@ let rec (prefix_with_iface_decls : (iface, uu___3))) else (let mutually_defined_with_x = - FStarC_Compiler_List.filter + FStarC_List.filter (fun y -> let uu___3 = id_eq_lid x y in Prims.op_Negation uu___3) def_ids in @@ -198,8 +195,8 @@ let rec (prefix_with_iface_decls : let uu___4 = let uu___5 = FStarC_Ident.ident_of_lid y in is_val uu___5 in - FStarC_Compiler_List.tryFind uu___4 iface_tl1 in - FStarC_Compiler_Option.isSome uu___3 -> + FStarC_List.tryFind uu___4 iface_tl1 in + FStarC_Option.isSome uu___3 -> let uu___3 = let uu___4 = let uu___5 = @@ -207,7 +204,7 @@ let rec (prefix_with_iface_decls : FStarC_Class_Show.show FStarC_Parser_AST.showable_decl iface_hd1 in let uu___7 = FStarC_Ident.string_of_lid y in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is out of order with the definition of %s" uu___6 uu___7 in FStarC_Errors_Msg.text uu___5 in @@ -223,22 +220,19 @@ let rec (prefix_with_iface_decls : match uu___3 with | (take_iface, rest_iface) -> (rest_iface, - (FStarC_Compiler_List.op_At (iface_hd :: take_iface) - [impl]))) + (FStarC_List.op_At (iface_hd :: take_iface) [impl]))) | FStarC_Parser_AST.Val (x, uu___) -> let def_ids = definition_lids impl in - let defines_x = - FStarC_Compiler_Util.for_some (id_eq_lid x) def_ids in + let defines_x = FStarC_Util.for_some (id_eq_lid x) def_ids in if Prims.op_Negation defines_x then ((let uu___2 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun y -> let uu___3 = let uu___4 = FStarC_Ident.ident_of_lid y in is_val uu___4 in - FStarC_Compiler_Util.for_some uu___3 iface_tl) - def_ids in + FStarC_Util.for_some uu___3 iface_tl) def_ids in if uu___2 then let uu___3 = @@ -270,7 +264,7 @@ let rec (prefix_with_iface_decls : (iface, uu___2))) else (let mutually_defined_with_x = - FStarC_Compiler_List.filter + FStarC_List.filter (fun y -> let uu___2 = id_eq_lid x y in Prims.op_Negation uu___2) def_ids in @@ -290,8 +284,8 @@ let rec (prefix_with_iface_decls : let uu___3 = let uu___4 = FStarC_Ident.ident_of_lid y in is_val uu___4 in - FStarC_Compiler_List.tryFind uu___3 iface_tl1 in - FStarC_Compiler_Option.isSome uu___2 -> + FStarC_List.tryFind uu___3 iface_tl1 in + FStarC_Option.isSome uu___2 -> let uu___2 = let uu___3 = let uu___4 = @@ -299,7 +293,7 @@ let rec (prefix_with_iface_decls : FStarC_Class_Show.show FStarC_Parser_AST.showable_decl iface_hd1 in let uu___6 = FStarC_Ident.string_of_lid y in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is out of order with the definition of %s" uu___5 uu___6 in FStarC_Errors_Msg.text uu___4 in @@ -315,8 +309,7 @@ let rec (prefix_with_iface_decls : match uu___2 with | (take_iface, rest_iface) -> (rest_iface, - (FStarC_Compiler_List.op_At (iface_hd :: take_iface) - [impl]))) + (FStarC_List.op_At (iface_hd :: take_iface) [impl]))) | FStarC_Parser_AST.Pragma uu___ -> prefix_with_iface_decls iface_tl impl | uu___ -> @@ -332,7 +325,7 @@ let (check_initial_interface : | hd::tl -> (match hd.FStarC_Parser_AST.d with | FStarC_Parser_AST.Tycon (uu___, uu___1, tys) when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Parser_AST.TyconAbstract uu___3 -> true @@ -344,14 +337,13 @@ let (check_initial_interface : (Obj.magic "Interface contains an abstract 'type' declaration; use 'val' instead") | FStarC_Parser_AST.Val (x, t) -> - let uu___ = - FStarC_Compiler_Util.for_some (is_definition_of x) tl in + let uu___ = FStarC_Util.for_some (is_definition_of x) tl in if uu___ then let uu___1 = let uu___2 = FStarC_Ident.string_of_id x in let uu___3 = FStarC_Ident.string_of_id x in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "'val %s' and 'let %s' cannot both be provided in an interface" uu___2 uu___3 in FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_decl hd @@ -360,7 +352,7 @@ let (check_initial_interface : (Obj.magic uu___1) else if - FStarC_Compiler_List.contains FStarC_Parser_AST.Assumption + FStarC_List.contains FStarC_Parser_AST.Assumption hd.FStarC_Parser_AST.quals then FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_decl @@ -371,7 +363,7 @@ let (check_initial_interface : else () | uu___ -> ()) in aux iface; - FStarC_Compiler_List.filter + FStarC_List.filter (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.TopLevelModule uu___1 -> false @@ -386,7 +378,7 @@ let (ml_mode_prefix_with_iface_decls : match impl.FStarC_Parser_AST.d with | FStarC_Parser_AST.TopLevelModule uu___ -> let uu___1 = - FStarC_Compiler_List.span + FStarC_List.span (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Open uu___2 -> true @@ -395,17 +387,16 @@ let (ml_mode_prefix_with_iface_decls : (match uu___1 with | (iface_prefix_opens, iface1) -> let iface2 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Val uu___2 -> true | FStarC_Parser_AST.Tycon uu___2 -> true | uu___2 -> false) iface1 in - (iface2, - (FStarC_Compiler_List.op_At [impl] iface_prefix_opens))) + (iface2, (FStarC_List.op_At [impl] iface_prefix_opens))) | FStarC_Parser_AST.Open uu___ -> let uu___1 = - FStarC_Compiler_List.span + FStarC_List.span (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Open uu___2 -> true @@ -414,17 +405,16 @@ let (ml_mode_prefix_with_iface_decls : (match uu___1 with | (iface_prefix_opens, iface1) -> let iface2 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Val uu___2 -> true | FStarC_Parser_AST.Tycon uu___2 -> true | uu___2 -> false) iface1 in - (iface2, - (FStarC_Compiler_List.op_At [impl] iface_prefix_opens))) + (iface2, (FStarC_List.op_At [impl] iface_prefix_opens))) | FStarC_Parser_AST.Friend uu___ -> let uu___1 = - FStarC_Compiler_List.span + FStarC_List.span (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Open uu___2 -> true @@ -433,17 +423,16 @@ let (ml_mode_prefix_with_iface_decls : (match uu___1 with | (iface_prefix_opens, iface1) -> let iface2 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Val uu___2 -> true | FStarC_Parser_AST.Tycon uu___2 -> true | uu___2 -> false) iface1 in - (iface2, - (FStarC_Compiler_List.op_At [impl] iface_prefix_opens))) + (iface2, (FStarC_List.op_At [impl] iface_prefix_opens))) | FStarC_Parser_AST.Include uu___ -> let uu___1 = - FStarC_Compiler_List.span + FStarC_List.span (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Open uu___2 -> true @@ -452,17 +441,16 @@ let (ml_mode_prefix_with_iface_decls : (match uu___1 with | (iface_prefix_opens, iface1) -> let iface2 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Val uu___2 -> true | FStarC_Parser_AST.Tycon uu___2 -> true | uu___2 -> false) iface1 in - (iface2, - (FStarC_Compiler_List.op_At [impl] iface_prefix_opens))) + (iface2, (FStarC_List.op_At [impl] iface_prefix_opens))) | FStarC_Parser_AST.ModuleAbbrev uu___ -> let uu___1 = - FStarC_Compiler_List.span + FStarC_List.span (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Open uu___2 -> true @@ -471,17 +459,16 @@ let (ml_mode_prefix_with_iface_decls : (match uu___1 with | (iface_prefix_opens, iface1) -> let iface2 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Val uu___2 -> true | FStarC_Parser_AST.Tycon uu___2 -> true | uu___2 -> false) iface1 in - (iface2, - (FStarC_Compiler_List.op_At [impl] iface_prefix_opens))) + (iface2, (FStarC_List.op_At [impl] iface_prefix_opens))) | uu___ -> let uu___1 = - FStarC_Compiler_List.span + FStarC_List.span (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Tycon uu___2 -> true @@ -489,9 +476,9 @@ let (ml_mode_prefix_with_iface_decls : (match uu___1 with | (iface_prefix_tycons, iface1) -> let maybe_get_iface_vals lids iface2 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun d -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun x -> let uu___2 = FStarC_Ident.ident_of_lid x in is_val uu___2 d) lids) iface2 in @@ -502,19 +489,18 @@ let (ml_mode_prefix_with_iface_decls : (match uu___3 with | (val_xs, rest_iface) -> (rest_iface, - (FStarC_Compiler_List.op_At iface_prefix_tycons - (FStarC_Compiler_List.op_At val_xs [impl])))) + (FStarC_List.op_At iface_prefix_tycons + (FStarC_List.op_At val_xs [impl])))) | FStarC_Parser_AST.Tycon uu___2 -> let xs = definition_lids impl in let uu___3 = maybe_get_iface_vals xs iface1 in (match uu___3 with | (val_xs, rest_iface) -> (rest_iface, - (FStarC_Compiler_List.op_At iface_prefix_tycons - (FStarC_Compiler_List.op_At val_xs [impl])))) + (FStarC_List.op_At iface_prefix_tycons + (FStarC_List.op_At val_xs [impl])))) | uu___2 -> - (iface1, - (FStarC_Compiler_List.op_At iface_prefix_tycons [impl])))) + (iface1, (FStarC_List.op_At iface_prefix_tycons [impl])))) let ml_mode_check_initial_interface : 'uuuuu . 'uuuuu -> @@ -522,11 +508,11 @@ let ml_mode_check_initial_interface : = fun mname -> fun iface -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun d -> match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.Tycon (uu___, uu___1, tys) when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Parser_AST.TyconAbstract uu___3 -> true @@ -563,12 +549,12 @@ let (apply_ml_mode_optimizations : FStarC_Ident.lident -> Prims.bool) = (let uu___ = let uu___1 = FStarC_Ident.string_of_lid mname in let uu___2 = FStarC_Parser_Dep.core_modules () in - FStarC_Compiler_List.contains uu___1 uu___2 in + FStarC_List.contains uu___1 uu___2 in Prims.op_Negation uu___)) && (let uu___ = let uu___1 = FStarC_Ident.string_of_lid mname in - FStarC_Compiler_List.contains uu___1 ulib_modules in + FStarC_List.contains uu___1 ulib_modules in Prims.op_Negation uu___) let (prefix_one_decl : FStarC_Ident.lident -> @@ -605,8 +591,8 @@ let (initialize_interface : let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident mname in - FStarC_Compiler_Util.format1 - "Interface %s has already been processed" uu___3 in + FStarC_Util.format1 "Interface %s has already been processed" + uu___3 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident mname FStarC_Errors_Codes.Fatal_InterfaceAlreadyProcessed () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -627,7 +613,7 @@ let (fixup_interleaved_decls : FStarC_Parser_AST.interleaved = true } in d1 in - FStarC_Compiler_List.map fix1 iface + FStarC_List.map fix1 iface let (prefix_with_interface_decls : FStarC_Ident.lident -> FStarC_Parser_AST.decl -> @@ -662,7 +648,7 @@ let (prefix_with_interface_decls : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Parser_AST.showable_decl) decls in - FStarC_Compiler_Util.print1 "Interleaved decls:\n%s\n" uu___3 + FStarC_Util.print1 "Interleaved decls:\n%s\n" uu___3 else ()); (decls, env1)) let (interleave_module : @@ -681,7 +667,7 @@ let (interleave_module : | FStar_Pervasives_Native.Some iface -> let iface1 = fixup_interleaved_decls iface in let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun impl -> match uu___2 with @@ -690,13 +676,13 @@ let (interleave_module : (match uu___3 with | (iface3, impls') -> (iface3, - (FStarC_Compiler_List.op_At impls1 - impls')))) (iface1, []) impls in + (FStarC_List.op_At impls1 impls')))) + (iface1, []) impls in (match uu___1 with | (iface2, impls1) -> let uu___2 = let uu___3 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun uu___4 -> match uu___4 with | { @@ -722,8 +708,7 @@ let (interleave_module : -> (lets, (one_val :: rest)) in (match uu___2 with | (iface_lets, remaining_iface_vals) -> - let impls2 = - FStarC_Compiler_List.op_At impls1 iface_lets in + let impls2 = FStarC_List.op_At impls1 iface_lets in let env1 = let uu___3 = FStarC_Options.interactive () in if uu___3 @@ -741,13 +726,13 @@ let (interleave_module : let uu___10 = FStarC_Class_Show.show FStarC_Ident.showable_lident l in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Some interface elements were not implemented by module %s:" uu___10 in FStarC_Errors_Msg.text uu___9 in let uu___9 = let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map (fun d -> let uu___11 = FStarC_Class_Show.show @@ -776,7 +761,7 @@ let (interleave_module : then let uu___6 = FStarC_Parser_AST.modul_to_string a1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Interleaved module is:\n%s\n" uu___6 else ()); (a1, env1)))))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_ToSyntax_ToSyntax.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_ToSyntax_ToSyntax.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_ToSyntax_ToSyntax.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_ToSyntax_ToSyntax.ml index 41157d34b1c..33083afd4a6 100644 --- a/stage0/fstar-lib/generated/FStarC_ToSyntax_ToSyntax.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_ToSyntax_ToSyntax.ml @@ -3,27 +3,24 @@ type extension_tosyntax_decl_t = FStarC_Syntax_DsEnv.env -> FStarC_Dyn.dyn -> FStarC_Ident.lident Prims.list -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.sigelt' Prims.list -let (extension_tosyntax_table : - extension_tosyntax_decl_t FStarC_Compiler_Util.smap) = - FStarC_Compiler_Util.smap_create (Prims.of_int (20)) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt' Prims.list +let (extension_tosyntax_table : extension_tosyntax_decl_t FStarC_Util.smap) = + FStarC_Util.smap_create (Prims.of_int (20)) let (register_extension_tosyntax : Prims.string -> extension_tosyntax_decl_t -> unit) = fun lang_name -> - fun cb -> - FStarC_Compiler_Util.smap_add extension_tosyntax_table lang_name cb + fun cb -> FStarC_Util.smap_add extension_tosyntax_table lang_name cb let (lookup_extension_tosyntax : Prims.string -> extension_tosyntax_decl_t FStar_Pervasives_Native.option) = fun lang_name -> - FStarC_Compiler_Util.smap_try_find extension_tosyntax_table lang_name -let (dbg_attrs : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "attrs" -let (dbg_ToSyntax : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ToSyntax" + FStarC_Util.smap_try_find extension_tosyntax_table lang_name +let (dbg_attrs : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "attrs" +let (dbg_ToSyntax : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ToSyntax" type antiquotations_temp = (FStarC_Syntax_Syntax.bv * FStarC_Syntax_Syntax.term) Prims.list -let (tun_r : FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.term) = +let (tun_r : FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term) = fun r -> { FStarC_Syntax_Syntax.n = @@ -38,10 +35,7 @@ type annotated_pat = (FStarC_Syntax_Syntax.pat * (FStarC_Syntax_Syntax.bv * FStarC_Syntax_Syntax.typ * FStarC_Syntax_Syntax.term Prims.list) Prims.list) -let (mk_thunk : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = +let (mk_thunk : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun e -> let b = let uu___ = @@ -73,7 +67,7 @@ let (qualify_field_names : let uu___ = FStarC_Ident.ident_of_lid l in FStarC_Ident.lid_of_ns_and_id ns uu___ in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun l -> match uu___1 with @@ -81,7 +75,7 @@ let (qualify_field_names : let uu___2 = FStarC_Ident.nsstr l in (match uu___2 with | "" -> - if FStarC_Compiler_Option.isSome ns_opt + if FStarC_Option.isSome ns_opt then let uu___3 = let uu___4 = qualify_to_record l in uu___4 :: out in @@ -96,7 +90,7 @@ let (qualify_field_names : let uu___4 = FStarC_Class_Show.show FStarC_Ident.showable_lident l in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Field %s of record type was expected to be scoped to namespace %s" uu___4 ns' in FStarC_Errors.raise_error @@ -118,12 +112,12 @@ let (qualify_field_names : ((FStar_Pervasives_Native.Some ns), uu___3)))) (FStar_Pervasives_Native.None, []) field_names in match uu___ with - | (uu___1, field_names_rev) -> FStarC_Compiler_List.rev field_names_rev + | (uu___1, field_names_rev) -> FStarC_List.rev field_names_rev let desugar_disjunctive_pattern : 'uuuuu . (FStarC_Syntax_Syntax.pat' FStarC_Syntax_Syntax.withinfo_t * - (FStarC_Syntax_Syntax.bv * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax * 'uuuuu) Prims.list) Prims.list -> + (FStarC_Syntax_Syntax.bv * FStarC_Syntax_Syntax.term * 'uuuuu) + Prims.list) Prims.list -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.branch Prims.list @@ -131,12 +125,12 @@ let desugar_disjunctive_pattern : fun annotated_pats -> fun when_opt -> fun branch -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (pat, annots) -> let branch1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun br -> fun uu___1 -> match uu___1 with @@ -164,7 +158,7 @@ let desugar_disjunctive_pattern : FStarC_Syntax_Util.branch (pat, when_opt, branch1)) annotated_pats let (trans_qual : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Ident.lident FStar_Pervasives_Native.option -> FStarC_Parser_AST.qualifier -> FStarC_Syntax_Syntax.qualifier) = @@ -260,7 +254,7 @@ let arg_withimp_t : = fun imp -> fun t -> let uu___ = as_imp imp in (t, uu___) let (contains_binder : FStarC_Parser_AST.binder Prims.list -> Prims.bool) = fun binders -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun b -> match b.FStarC_Parser_AST.b with | FStarC_Parser_AST.Annotated uu___ -> true @@ -270,14 +264,13 @@ let rec (unparen : FStarC_Parser_AST.term -> FStarC_Parser_AST.term) = match t.FStarC_Parser_AST.tm with | FStarC_Parser_AST.Paren t1 -> unparen t1 | uu___ -> t -let (tm_type_z : FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.term) - = +let (tm_type_z : FStarC_Range_Type.range -> FStarC_Parser_AST.term) = fun r -> let uu___ = let uu___1 = FStarC_Ident.lid_of_path ["Type0"] r in FStarC_Parser_AST.Name uu___1 in FStarC_Parser_AST.mk_term uu___ r FStarC_Parser_AST.Kind -let (tm_type : FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.term) = +let (tm_type : FStarC_Range_Type.range -> FStarC_Parser_AST.term) = fun r -> let uu___ = let uu___1 = FStarC_Ident.lid_of_path ["Type"] r in @@ -299,17 +292,17 @@ let rec (is_comp_type : -> true | FStarC_Parser_AST.Name l -> let uu___1 = FStarC_Syntax_DsEnv.try_lookup_effect_name env l in - FStarC_Compiler_Option.isSome uu___1 + FStarC_Option.isSome uu___1 | FStarC_Parser_AST.Construct (l, uu___1) -> let uu___2 = FStarC_Syntax_DsEnv.try_lookup_effect_name env l in - FStarC_Compiler_Option.isSome uu___2 + FStarC_Option.isSome uu___2 | FStarC_Parser_AST.App (head, uu___1, uu___2) -> is_comp_type env head | FStarC_Parser_AST.Paren t1 -> failwith "impossible" | FStarC_Parser_AST.Ascribed (t1, uu___1, uu___2, uu___3) -> is_comp_type env t1 | FStarC_Parser_AST.LetOpen (uu___1, t1) -> is_comp_type env t1 | uu___1 -> false -let (unit_ty : FStarC_Compiler_Range_Type.range -> FStarC_Parser_AST.term) = +let (unit_ty : FStarC_Range_Type.range -> FStarC_Parser_AST.term) = fun rng -> FStarC_Parser_AST.mk_term (FStarC_Parser_AST.Name FStarC_Parser_Const.unit_lid) rng @@ -352,8 +345,7 @@ let desugar_name : FStarC_Syntax_DsEnv.fail_or env (desugar_name' setpos env resolve) l let (compile_op_lid : - Prims.int -> - Prims.string -> FStarC_Compiler_Range_Type.range -> FStarC_Ident.lident) + Prims.int -> Prims.string -> FStarC_Range_Type.range -> FStarC_Ident.lident) = fun n -> fun s -> @@ -441,17 +433,17 @@ let (sort_ftv : FStarC_Ident.ident Prims.list -> FStarC_Ident.ident Prims.list) = fun ftv -> let uu___ = - FStarC_Compiler_Util.remove_dups + FStarC_Util.remove_dups (fun x -> fun y -> let uu___1 = FStarC_Ident.string_of_id x in let uu___2 = FStarC_Ident.string_of_id y in uu___1 = uu___2) ftv in - FStarC_Compiler_Util.sort_with + FStarC_Util.sort_with (fun x -> fun y -> let uu___1 = FStarC_Ident.string_of_id x in let uu___2 = FStarC_Ident.string_of_id y in - FStarC_Compiler_String.compare uu___1 uu___2) uu___ + FStarC_String.compare uu___1 uu___2) uu___ let rec (free_vars_b : Prims.bool -> FStarC_Syntax_DsEnv.env -> @@ -496,15 +488,14 @@ and (free_vars_bs : fun tvars_only -> fun env -> fun binders -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___ -> fun binder -> match uu___ with | (env1, free) -> let uu___1 = free_vars_b tvars_only env1 binder in (match uu___1 with - | (env2, f) -> - (env2, (FStarC_Compiler_List.op_At f free)))) + | (env2, f) -> (env2, (FStarC_List.op_At f free)))) (env, []) binders and (free_vars : Prims.bool -> @@ -552,38 +543,38 @@ and (free_vars : | FStarC_Parser_AST.NamedTyp (uu___1, t1) -> free_vars tvars_only env t1 | FStarC_Parser_AST.LexList l -> - FStarC_Compiler_List.collect (free_vars tvars_only env) l + FStarC_List.collect (free_vars tvars_only env) l | FStarC_Parser_AST.WFOrder (rel, e) -> let uu___1 = free_vars tvars_only env rel in let uu___2 = free_vars tvars_only env e in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.Paren t1 -> failwith "impossible" | FStarC_Parser_AST.Ascribed (t1, t', tacopt, uu___1) -> let ts = t1 :: t' :: (match tacopt with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some t2 -> [t2]) in - FStarC_Compiler_List.collect (free_vars tvars_only env) ts + FStarC_List.collect (free_vars tvars_only env) ts | FStarC_Parser_AST.Construct (uu___1, ts) -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___2 -> match uu___2 with | (t1, uu___3) -> free_vars tvars_only env t1) ts | FStarC_Parser_AST.Op (uu___1, ts) -> - FStarC_Compiler_List.collect (free_vars tvars_only env) ts + FStarC_List.collect (free_vars tvars_only env) ts | FStarC_Parser_AST.App (t1, t2, uu___1) -> let uu___2 = free_vars tvars_only env t1 in let uu___3 = free_vars tvars_only env t2 in - FStarC_Compiler_List.op_At uu___2 uu___3 + FStarC_List.op_At uu___2 uu___3 | FStarC_Parser_AST.Refine (b, t1) -> let uu___1 = free_vars_b tvars_only env b in (match uu___1 with | (env1, f) -> let uu___2 = free_vars tvars_only env1 t1 in - FStarC_Compiler_List.op_At f uu___2) + FStarC_List.op_At f uu___2) | FStarC_Parser_AST.Sum (binders, body) -> let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun bt -> match uu___2 with @@ -596,30 +587,28 @@ and (free_vars : let uu___4 = free_vars tvars_only env1 t1 in (env1, uu___4) in (match uu___3 with - | (env2, f) -> - (env2, (FStarC_Compiler_List.op_At f free)))) + | (env2, f) -> (env2, (FStarC_List.op_At f free)))) (env, []) binders in (match uu___1 with | (env1, free) -> let uu___2 = free_vars tvars_only env1 body in - FStarC_Compiler_List.op_At free uu___2) + FStarC_List.op_At free uu___2) | FStarC_Parser_AST.Product (binders, body) -> let uu___1 = free_vars_bs tvars_only env binders in (match uu___1 with | (env1, free) -> let uu___2 = free_vars tvars_only env1 body in - FStarC_Compiler_List.op_At free uu___2) + FStarC_List.op_At free uu___2) | FStarC_Parser_AST.Project (t1, uu___1) -> free_vars tvars_only env t1 | FStarC_Parser_AST.Attributes cattributes -> - FStarC_Compiler_List.collect (free_vars tvars_only env) - cattributes + FStarC_List.collect (free_vars tvars_only env) cattributes | FStarC_Parser_AST.CalcProof (rel, init, steps) -> let uu___1 = free_vars tvars_only env rel in let uu___2 = let uu___3 = free_vars tvars_only env init in let uu___4 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___5 -> match uu___5 with | FStarC_Parser_AST.CalcStep (rel1, just, next) -> @@ -627,10 +616,10 @@ and (free_vars : let uu___7 = let uu___8 = free_vars tvars_only env just in let uu___9 = free_vars tvars_only env next in - FStarC_Compiler_List.op_At uu___8 uu___9 in - FStarC_Compiler_List.op_At uu___6 uu___7) steps in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___8 uu___9 in + FStarC_List.op_At uu___6 uu___7) steps in + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.ElimForall (bs, t1, ts) -> let uu___1 = free_vars_bs tvars_only env bs in (match uu___1 with @@ -638,10 +627,9 @@ and (free_vars : let uu___2 = let uu___3 = free_vars tvars_only env' t1 in let uu___4 = - FStarC_Compiler_List.collect (free_vars tvars_only env') - ts in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At free uu___2) + FStarC_List.collect (free_vars tvars_only env') ts in + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At free uu___2) | FStarC_Parser_AST.ElimExists (binders, p, q, y, e) -> let uu___1 = free_vars_bs tvars_only env binders in (match uu___1 with @@ -655,17 +643,17 @@ and (free_vars : let uu___6 = free_vars tvars_only env q in let uu___7 = let uu___8 = free_vars tvars_only env'' e in - FStarC_Compiler_List.op_At free' uu___8 in - FStarC_Compiler_List.op_At uu___6 uu___7 in - FStarC_Compiler_List.op_At uu___4 uu___5 in - FStarC_Compiler_List.op_At free uu___3)) + FStarC_List.op_At free' uu___8 in + FStarC_List.op_At uu___6 uu___7 in + FStarC_List.op_At uu___4 uu___5 in + FStarC_List.op_At free uu___3)) | FStarC_Parser_AST.ElimImplies (p, q, e) -> let uu___1 = free_vars tvars_only env p in let uu___2 = let uu___3 = free_vars tvars_only env q in let uu___4 = free_vars tvars_only env e in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.ElimOr (p, q, r, x, e, x', e') -> let uu___1 = free_vars tvars_only env p in let uu___2 = @@ -678,17 +666,17 @@ and (free_vars : match uu___8 with | (env', free) -> let uu___9 = free_vars tvars_only env' e in - FStarC_Compiler_List.op_At free uu___9 in + FStarC_List.op_At free uu___9 in let uu___8 = let uu___9 = free_vars_b tvars_only env x' in match uu___9 with | (env', free) -> let uu___10 = free_vars tvars_only env' e' in - FStarC_Compiler_List.op_At free uu___10 in - FStarC_Compiler_List.op_At uu___7 uu___8 in - FStarC_Compiler_List.op_At uu___5 uu___6 in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At free uu___10 in + FStarC_List.op_At uu___7 uu___8 in + FStarC_List.op_At uu___5 uu___6 in + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.ElimAnd (p, q, r, x, y, e) -> let uu___1 = free_vars tvars_only env p in let uu___2 = @@ -700,14 +688,14 @@ and (free_vars : match uu___7 with | (env', free) -> let uu___8 = free_vars tvars_only env' e in - FStarC_Compiler_List.op_At free uu___8 in - FStarC_Compiler_List.op_At uu___5 uu___6 in - FStarC_Compiler_List.op_At uu___3 uu___4 in - FStarC_Compiler_List.op_At uu___1 uu___2 + FStarC_List.op_At free uu___8 in + FStarC_List.op_At uu___5 uu___6 in + FStarC_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___1 uu___2 | FStarC_Parser_AST.ListLiteral ts -> - FStarC_Compiler_List.collect (free_vars tvars_only env) ts + FStarC_List.collect (free_vars tvars_only env) ts | FStarC_Parser_AST.SeqLiteral ts -> - FStarC_Compiler_List.collect (free_vars tvars_only env) ts + FStarC_List.collect (free_vars tvars_only env) ts | FStarC_Parser_AST.Abs uu___1 -> [] | FStarC_Parser_AST.Function uu___1 -> [] | FStarC_Parser_AST.Let uu___1 -> [] @@ -743,7 +731,7 @@ let (head_and_args : FStarC_Parser_AST.tm = (FStarC_Parser_AST.Name l); FStarC_Parser_AST.range = (t1.FStarC_Parser_AST.range); FStarC_Parser_AST.level = (t1.FStarC_Parser_AST.level) - }, (FStarC_Compiler_List.op_At args' args)) + }, (FStarC_List.op_At args' args)) | uu___1 -> (t1, args) in aux [] t let (close : @@ -752,11 +740,11 @@ let (close : fun env -> fun t -> let ftv = let uu___ = free_type_vars env t in sort_ftv uu___ in - if (FStarC_Compiler_List.length ftv) = Prims.int_zero + if (FStarC_List.length ftv) = Prims.int_zero then t else (let binders = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___1 = let uu___2 = @@ -780,11 +768,11 @@ let (close_fun : fun env -> fun t -> let ftv = let uu___ = free_type_vars env t in sort_ftv uu___ in - if (FStarC_Compiler_List.length ftv) = Prims.int_zero + if (FStarC_List.length ftv) = Prims.int_zero then t else (let binders = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___1 = let uu___2 = @@ -828,7 +816,7 @@ let rec (uncurry : fun t -> match t.FStarC_Parser_AST.tm with | FStarC_Parser_AST.Product (binders, t1) -> - uncurry (FStarC_Compiler_List.op_At bs binders) t1 + uncurry (FStarC_List.op_At bs binders) t1 | uu___ -> (bs, t) let rec (is_var_pattern : FStarC_Parser_AST.pattern -> Prims.bool) = fun p -> @@ -905,16 +893,15 @@ let rec (destruct_app_pattern : ((FStar_Pervasives.Inl id), args, FStar_Pervasives_Native.None) | uu___ -> failwith "Not an app pattern" let rec (gather_pattern_bound_vars_maybe_top : - FStarC_Ident.ident FStarC_Compiler_FlatSet.t -> - FStarC_Parser_AST.pattern -> FStarC_Ident.ident FStarC_Compiler_FlatSet.t) + FStarC_Ident.ident FStarC_FlatSet.t -> + FStarC_Parser_AST.pattern -> FStarC_Ident.ident FStarC_FlatSet.t) = fun uu___1 -> fun uu___ -> (fun acc -> fun p -> let gather_pattern_bound_vars_from_list = - FStarC_Compiler_List.fold_left - gather_pattern_bound_vars_maybe_top acc in + FStarC_List.fold_left gather_pattern_bound_vars_maybe_top acc in match p.FStarC_Parser_AST.pat with | FStarC_Parser_AST.PatWild uu___ -> Obj.magic (Obj.repr acc) | FStarC_Parser_AST.PatConst uu___ -> Obj.magic (Obj.repr acc) @@ -930,7 +917,7 @@ let rec (gather_pattern_bound_vars_maybe_top : (Obj.repr (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) x (Obj.magic acc))) | FStarC_Parser_AST.PatVar (x, uu___, uu___1) -> @@ -938,7 +925,7 @@ let rec (gather_pattern_bound_vars_maybe_top : (Obj.repr (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) x (Obj.magic acc))) | FStarC_Parser_AST.PatList pats -> @@ -954,7 +941,7 @@ let rec (gather_pattern_bound_vars_maybe_top : Obj.magic (Obj.repr (let uu___ = - FStarC_Compiler_List.map FStar_Pervasives_Native.snd + FStarC_List.map FStar_Pervasives_Native.snd guarded_pats in gather_pattern_bound_vars_from_list uu___)) | FStarC_Parser_AST.PatAscribed (pat, uu___) -> @@ -962,14 +949,13 @@ let rec (gather_pattern_bound_vars_maybe_top : (Obj.repr (gather_pattern_bound_vars_maybe_top acc pat))) uu___1 uu___ let (gather_pattern_bound_vars : - FStarC_Parser_AST.pattern -> FStarC_Ident.ident FStarC_Compiler_FlatSet.t) - = + FStarC_Parser_AST.pattern -> FStarC_Ident.ident FStarC_FlatSet.t) = let acc = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_ident)) ()) in + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) + ()) in fun p -> gather_pattern_bound_vars_maybe_top acc p type bnd = | LocalBinder of (FStarC_Syntax_Syntax.bv * FStarC_Syntax_Syntax.bqual * @@ -1014,7 +1000,7 @@ let (mk_lb : (FStarC_Syntax_Syntax.bv, FStarC_Syntax_Syntax.fv) FStar_Pervasives.either * FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax * FStarC_Compiler_Range_Type.range) -> + FStarC_Syntax_Syntax.syntax * FStarC_Range_Type.range) -> FStarC_Syntax_Syntax.letbinding) = fun uu___ -> @@ -1032,48 +1018,45 @@ let (mk_lb : } let (no_annot_abs : FStarC_Syntax_Syntax.binders -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun bs -> fun t -> FStarC_Syntax_Util.abs bs t FStar_Pervasives_Native.None let rec (generalize_annotated_univs : FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.sigelt) = fun s -> - let vars = FStarC_Compiler_Util.mk_ref [] in + let vars = FStarC_Util.mk_ref [] in let seen = let uu___ = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_ident)) ()) in - FStarC_Compiler_Util.mk_ref uu___ in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_ident)) + ()) in + FStarC_Util.mk_ref uu___ in let reg u = let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang seen in + let uu___2 = FStarC_Effect.op_Bang seen in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_ident)) u (Obj.magic uu___2) in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_ident)) u + (Obj.magic uu___2) in Prims.op_Negation uu___1 in if uu___ then ((let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang seen in + let uu___3 = FStarC_Effect.op_Bang seen in Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_ident)) u (Obj.magic uu___3)) in - FStarC_Compiler_Effect.op_Colon_Equals seen uu___2); - (let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang vars in u :: uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals vars uu___2)) + FStarC_Effect.op_Colon_Equals seen uu___2); + (let uu___2 = let uu___3 = FStarC_Effect.op_Bang vars in u :: uu___3 in + FStarC_Effect.op_Colon_Equals vars uu___2)) else () in let get uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang vars in - FStarC_Compiler_List.rev uu___1 in + let uu___1 = FStarC_Effect.op_Bang vars in FStarC_List.rev uu___1 in let uu___ = FStarC_Syntax_Visit.visit_sigelt false (fun t -> t) (fun u -> @@ -1097,7 +1080,7 @@ let rec (generalize_annotated_univs : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun se -> match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ @@ -1118,7 +1101,7 @@ let rec (generalize_annotated_univs : let uu___9 = let uu___10 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length bs) usubst in + (FStarC_List.length bs) usubst in FStarC_Syntax_Subst.subst uu___10 t in { FStarC_Syntax_Syntax.lid = lid; @@ -1237,7 +1220,7 @@ let rec (generalize_annotated_univs : let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___5 = FStarC_Syntax_Subst.subst usubst @@ -1332,8 +1315,7 @@ let rec (generalize_annotated_univs : -> let uu___1 = let uu___2 = - let uu___3 = - FStarC_Compiler_List.map generalize_annotated_univs ses in + let uu___3 = FStarC_List.map generalize_annotated_univs ses in { FStarC_Syntax_Syntax.errs = errs; FStarC_Syntax_Syntax.rng1 = rng; @@ -1359,7 +1341,7 @@ let rec (generalize_annotated_univs : let uu___2 = FStarC_Syntax_Free.univnames t in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic uu___2) in let usubst = FStarC_Syntax_Subst.univ_var_closing uvs in let uu___2 = @@ -1373,7 +1355,7 @@ let rec (generalize_annotated_univs : let uu___2 = FStarC_Syntax_Free.univnames t in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic uu___2) in let usubst = FStarC_Syntax_Subst.univ_var_closing uvs in let uu___2 = @@ -1469,7 +1451,7 @@ let rec (desugar_maybe_non_constant_universe : | FStarC_Parser_AST.Uvar u -> FStar_Pervasives.Inr (FStarC_Syntax_Syntax.U_name u) | FStarC_Parser_AST.Const (FStarC_Const.Const_int (repr, uu___1)) -> - let n = FStarC_Compiler_Util.int_of_string repr in + let n = FStarC_Util.int_of_string repr in (if n < Prims.int_zero then FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_term t @@ -1510,7 +1492,7 @@ let rec (desugar_maybe_non_constant_universe : aux t2 (uarg :: univargs) | FStarC_Parser_AST.Var max_lid -> let uu___4 = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___5 -> match uu___5 with | FStar_Pervasives.Inr uu___6 -> true @@ -1519,7 +1501,7 @@ let rec (desugar_maybe_non_constant_universe : then let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | FStar_Pervasives.Inl n -> int_to_universe n @@ -1528,14 +1510,14 @@ let rec (desugar_maybe_non_constant_universe : FStar_Pervasives.Inr uu___5 else (let nargs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> match uu___6 with | FStar_Pervasives.Inl n -> n | FStar_Pervasives.Inr uu___7 -> failwith "impossible") univargs in let uu___6 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun m -> fun n -> if m > n then m else n) Prims.int_zero nargs in FStar_Pervasives.Inl uu___6) @@ -1585,8 +1567,7 @@ let (check_no_aq : antiquotations_temp -> unit) = let uu___5 = let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "Unexpected antiquotation: `@(%s)" - uu___6 in + FStarC_Util.format1 "Unexpected antiquotation: `@(%s)" uu___6 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e FStarC_Errors_Codes.Fatal_UnexpectedAntiquotation () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -1595,15 +1576,14 @@ let (check_no_aq : antiquotations_temp -> unit) = let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "Unexpected antiquotation: `#(%s)" - uu___2 in + FStarC_Util.format1 "Unexpected antiquotation: `#(%s)" uu___2 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e FStarC_Errors_Codes.Fatal_UnexpectedAntiquotation () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___1) let (check_linear_pattern_variables : FStarC_Syntax_Syntax.pat' FStarC_Syntax_Syntax.withinfo_t Prims.list -> - FStarC_Compiler_Range_Type.range -> unit) + FStarC_Range_Type.range -> unit) = fun pats -> fun r -> @@ -1615,14 +1595,14 @@ let (check_linear_pattern_variables : (Obj.repr (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) ())) | FStarC_Syntax_Syntax.Pat_constant uu___ -> Obj.magic (Obj.repr (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) ())) | FStarC_Syntax_Syntax.Pat_var x -> Obj.magic @@ -1636,12 +1616,12 @@ let (check_linear_pattern_variables : then FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) () else FStarC_Class_Setlike.singleton () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) x)) | FStarC_Syntax_Syntax.Pat_cons (uu___, uu___1, pats1) -> Obj.magic @@ -1656,13 +1636,13 @@ let (check_linear_pattern_variables : Obj.magic (FStarC_Class_Setlike.inter () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) (Obj.magic p_vars) (Obj.magic out)) in let uu___4 = FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) (Obj.magic intersection) in if uu___4 @@ -1671,7 +1651,7 @@ let (check_linear_pattern_variables : (Obj.repr (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) (Obj.magic out) (Obj.magic p_vars))) else @@ -1681,16 +1661,16 @@ let (check_linear_pattern_variables : let uu___6 = FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) (Obj.magic intersection) in - FStarC_Compiler_List.hd uu___6 in + FStarC_List.hd uu___6 in let uu___6 = let uu___7 = FStarC_Class_Show.show FStarC_Ident.showable_ident duplicate_bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Non-linear patterns are not permitted: `%s` appears more than once in this pattern." uu___7 in FStarC_Errors.raise_error @@ -1705,9 +1685,9 @@ let (check_linear_pattern_variables : Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) ()) in - FStarC_Compiler_List.fold_left aux uu___2 pats1))) uu___ in + FStarC_List.fold_left aux uu___2 pats1))) uu___ in match pats with | [] -> () | p::[] -> let uu___ = pat_vars p in () @@ -1718,9 +1698,8 @@ let (check_linear_pattern_variables : let uu___1 = pat_vars p1 in FStarC_Class_Setlike.equal () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_bv)) (Obj.magic pvars) - (Obj.magic uu___1) in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) + (Obj.magic pvars) (Obj.magic uu___1) in if uu___ then () else @@ -1731,20 +1710,20 @@ let (check_linear_pattern_variables : Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) (Obj.magic s1) (Obj.magic s2)) in let uu___3 = Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) (Obj.magic s2) (Obj.magic s1)) in Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___2) (Obj.magic uu___3))) uu___3 uu___2 in @@ -1754,26 +1733,25 @@ let (check_linear_pattern_variables : let uu___2 = FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) (Obj.magic nonlinear_vars) in - FStarC_Compiler_List.hd uu___2 in + FStarC_List.hd uu___2 in let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_ident first_nonlinear_var.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Patterns in this match are incoherent, variable %s is bound in some but not all patterns." uu___3 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_IncoherentPatterns () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)) in - FStarC_Compiler_List.iter aux ps -let (smt_pat_lid : FStarC_Compiler_Range_Type.range -> FStarC_Ident.lident) = + FStarC_List.iter aux ps +let (smt_pat_lid : FStarC_Range_Type.range -> FStarC_Ident.lident) = fun r -> FStarC_Ident.set_lid_range FStarC_Parser_Const.smtpat_lid r -let (smt_pat_or_lid : - FStarC_Compiler_Range_Type.range -> FStarC_Ident.lident) = +let (smt_pat_or_lid : FStarC_Range_Type.range -> FStarC_Ident.lident) = fun r -> FStarC_Ident.set_lid_range FStarC_Parser_Const.smtpatOr_lid r let rec (hoist_pat_ascription' : FStarC_Parser_AST.pattern -> @@ -1786,18 +1764,17 @@ let rec (hoist_pat_ascription' : FStarC_Parser_AST.Type_level in let handle_list type_lid pat_cons pats = let uu___ = - let uu___1 = FStarC_Compiler_List.map hoist_pat_ascription' pats in - FStarC_Compiler_List.unzip uu___1 in + let uu___1 = FStarC_List.map hoist_pat_ascription' pats in + FStarC_List.unzip uu___1 in match uu___ with | (pats1, terms) -> let uu___1 = - FStarC_Compiler_List.for_all FStar_Pervasives_Native.uu___is_None - terms in + FStarC_List.for_all FStar_Pervasives_Native.uu___is_None terms in if uu___1 then (pat, FStar_Pervasives_Native.None) else (let terms1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | FStar_Pervasives_Native.Some t -> t @@ -1813,8 +1790,8 @@ let rec (hoist_pat_ascription' : let uu___5 = let uu___6 = mk type_lid in let uu___7 = - FStarC_Compiler_List.map - (fun t -> (t, FStarC_Parser_AST.Nothing)) terms1 in + FStarC_List.map (fun t -> (t, FStarC_Parser_AST.Nothing)) + terms1 in FStarC_Parser_AST.mkApp uu___6 uu___7 pat.FStarC_Parser_AST.prange in FStar_Pervasives_Native.Some uu___5 in @@ -1828,8 +1805,8 @@ let rec (hoist_pat_ascription' : let uu___1 = (if dep then FStarC_Parser_Const.mk_dtuple_lid - else FStarC_Parser_Const.mk_tuple_lid) - (FStarC_Compiler_List.length pats) pat.FStarC_Parser_AST.prange in + else FStarC_Parser_Const.mk_tuple_lid) (FStarC_List.length pats) + pat.FStarC_Parser_AST.prange in FStarC_Parser_AST.Var uu___1 in handle_list uu___ (fun pats1 -> FStarC_Parser_AST.PatTuple (pats1, dep)) pats @@ -1863,7 +1840,7 @@ let rec (desugar_data_pat : fun p -> let resolvex l e x = let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun y -> let uu___1 = FStarC_Ident.string_of_id y.FStarC_Syntax_Syntax.ppname in @@ -1933,7 +1910,7 @@ let rec (desugar_data_pat : } in ([(x1, t1, attrs)], (LocalBinder (x1, aq, attrs)), - (FStarC_Compiler_List.op_At aqs' aqs1))) in + (FStarC_List.op_At aqs' aqs1))) in (match uu___2 with | (annots', binder1, aqs2) -> ((match p3.FStarC_Syntax_Syntax.v with @@ -1949,10 +1926,10 @@ let rec (desugar_data_pat : (Obj.magic "Type ascriptions within patterns are only allowed on variables")); (loc1, aqs2, env', binder1, p3, - (FStarC_Compiler_List.op_At annots' annots)))))) + (FStarC_List.op_At annots' annots)))))) | FStarC_Parser_AST.PatWild (aq, attrs) -> let aq1 = trans_bqual env1 aq in - let attrs1 = FStarC_Compiler_List.map (desugar_term env1) attrs in + let attrs1 = FStarC_List.map (desugar_term env1) attrs in let x = let uu___ = tun_r p1.FStarC_Parser_AST.prange in FStarC_Syntax_Syntax.new_bv @@ -1986,7 +1963,7 @@ let rec (desugar_data_pat : } | FStarC_Parser_AST.PatTvar (x, aq, attrs) -> let aq1 = trans_bqual env1 aq in - let attrs1 = FStarC_Compiler_List.map (desugar_term env1) attrs in + let attrs1 = FStarC_List.map (desugar_term env1) attrs in let uu___ = resolvex loc env1 x in (match uu___ with | (loc1, env2, xbv) -> @@ -1995,7 +1972,7 @@ let rec (desugar_data_pat : uu___1, [])) | FStarC_Parser_AST.PatVar (x, aq, attrs) -> let aq1 = trans_bqual env1 aq in - let attrs1 = FStarC_Compiler_List.map (desugar_term env1) attrs in + let attrs1 = FStarC_List.map (desugar_term env1) attrs in let uu___ = resolvex loc env1 x in (match uu___ with | (loc1, env2, xbv) -> @@ -2024,7 +2001,7 @@ let rec (desugar_data_pat : args) -> let uu___1 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun arg -> fun uu___2 -> match uu___2 with @@ -2034,7 +2011,7 @@ let rec (desugar_data_pat : | (loc2, aqs2, env3, b, arg1, ans) -> let imp = is_implicit b in (loc2, aqs2, env3, - (FStarC_Compiler_List.op_At ans annots), + (FStarC_List.op_At ans annots), ((arg1, imp) :: args1)))) args (loc, aqs, env1, [], []) in (match uu___1 with @@ -2061,7 +2038,7 @@ let rec (desugar_data_pat : (Obj.magic "Unexpected pattern") | FStarC_Parser_AST.PatList pats -> let uu___ = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun pat -> fun uu___1 -> match uu___1 with @@ -2070,15 +2047,14 @@ let rec (desugar_data_pat : (match uu___2 with | (loc2, aqs2, env3, uu___3, pat1, ans) -> (loc2, aqs2, env3, - (FStarC_Compiler_List.op_At ans annots), - (pat1 :: pats1)))) pats - (loc, aqs, env1, [], []) in + (FStarC_List.op_At ans annots), (pat1 :: + pats1)))) pats (loc, aqs, env1, [], []) in (match uu___ with | (loc1, aqs1, env2, annots, pats1) -> let pat = let uu___1 = let uu___2 = - FStarC_Compiler_Range_Ops.end_range + FStarC_Range_Ops.end_range p1.FStarC_Parser_AST.prange in let uu___3 = let uu___4 = @@ -2090,11 +2066,11 @@ let rec (desugar_data_pat : (uu___5, FStar_Pervasives_Native.None, []) in FStarC_Syntax_Syntax.Pat_cons uu___4 in pos_r uu___2 uu___3 in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun hd -> fun tl -> let r = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges hd.FStarC_Syntax_Syntax.p tl.FStarC_Syntax_Syntax.p in let uu___2 = @@ -2118,7 +2094,7 @@ let rec (desugar_data_pat : pat, annots)) | FStarC_Parser_AST.PatTuple (args, dep) -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun p2 -> match uu___1 with @@ -2127,21 +2103,21 @@ let rec (desugar_data_pat : (match uu___2 with | (loc2, aqs2, env3, uu___3, pat, ans) -> (loc2, aqs2, env3, - (FStarC_Compiler_List.op_At ans annots), + (FStarC_List.op_At ans annots), ((pat, false) :: pats)))) (loc, aqs, env1, [], []) args in (match uu___ with | (loc1, aqs1, env2, annots, args1) -> - let args2 = FStarC_Compiler_List.rev args1 in + let args2 = FStarC_List.rev args1 in let l = if dep then FStarC_Parser_Const.mk_dtuple_data_lid - (FStarC_Compiler_List.length args2) + (FStarC_List.length args2) p1.FStarC_Parser_AST.prange else FStarC_Parser_Const.mk_tuple_data_lid - (FStarC_Compiler_List.length args2) + (FStarC_List.length args2) p1.FStarC_Parser_AST.prange in let constr = FStarC_Syntax_DsEnv.fail_or env2 @@ -2163,7 +2139,7 @@ let rec (desugar_data_pat : (LocalBinder (x, FStar_Pervasives_Native.None, [])), uu___1, annots)) | FStarC_Parser_AST.PatRecord fields -> - let uu___ = FStarC_Compiler_List.unzip fields in + let uu___ = FStarC_List.unzip fields in (match uu___ with | (field_names, pats) -> let uu___1 = @@ -2199,7 +2175,7 @@ let rec (desugar_data_pat : field_names1 })) in let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun p2 -> match uu___3 with @@ -2209,13 +2185,12 @@ let rec (desugar_data_pat : | (loc2, aqs2, env3, uu___5, pat, ann) -> (loc2, aqs2, env3, - (FStarC_Compiler_List.op_At ann - annots), ((pat, false) :: - pats1)))) + (FStarC_List.op_At ann annots), + ((pat, false) :: pats1)))) (loc, aqs, env1, [], []) pats in (match uu___2 with | (loc1, aqs1, env2, annots, pats1) -> - let pats2 = FStarC_Compiler_List.rev pats1 in + let pats2 = FStarC_List.rev pats1 in let pat = pos (FStarC_Syntax_Syntax.Pat_cons @@ -2240,7 +2215,7 @@ let rec (desugar_data_pat : (match uu___ with | (loc1, aqs, env2, var, p3, ans) -> let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun p4 -> match uu___2 with @@ -2252,8 +2227,7 @@ let rec (desugar_data_pat : (loc1, aqs, env2, []) ps in (match uu___1 with | (loc2, aqs1, env3, ps1) -> - let pats = (p3, ans) :: - (FStarC_Compiler_List.rev ps1) in + let pats = (p3, ans) :: (FStarC_List.rev ps1) in ((env3, var, pats), aqs1))) | uu___ -> let uu___1 = aux' true loc [] env1 p1 in @@ -2263,8 +2237,7 @@ let rec (desugar_data_pat : let uu___ = aux_maybe_or env p in match uu___ with | ((env1, b, pats), aqs) -> - ((let uu___2 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst pats in + ((let uu___2 = FStarC_List.map FStar_Pervasives_Native.fst pats in check_linear_pattern_variables uu___2 p.FStarC_Parser_AST.prange); ((env1, b, pats), aqs)) @@ -2313,8 +2286,7 @@ and (desugar_binding_pat_maybe_top : FStarC_Parser_AST.prange = uu___;_}, (t, tacopt)) -> - let tacopt1 = - FStarC_Compiler_Util.map_opt tacopt (desugar_term env) in + let tacopt1 = FStarC_Util.map_opt tacopt (desugar_term env) in let uu___1 = desugar_term_aq env t in (match uu___1 with | (t1, aq) -> @@ -2328,8 +2300,7 @@ and (desugar_binding_pat_maybe_top : FStarC_Parser_AST.prange = uu___2;_}, (t, tacopt)) -> - let tacopt1 = - FStarC_Compiler_Util.map_opt tacopt (desugar_term env) in + let tacopt1 = FStarC_Util.map_opt tacopt (desugar_term env) in let uu___3 = desugar_term_aq env t in (match uu___3 with | (t1, aq) -> let uu___4 = mklet x t1 tacopt1 in (uu___4, aq)) @@ -2411,7 +2382,7 @@ and (desugar_machine_integer : FStarC_Syntax_DsEnv.env -> Prims.string -> (FStarC_Const.signedness * FStarC_Const.width) -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.term) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term) = fun env -> fun repr -> @@ -2441,7 +2412,7 @@ and (desugar_machine_integer : if uu___2 then let uu___3 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is not in the expected range for %s" repr tnm in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range range @@ -2495,7 +2466,7 @@ and (desugar_machine_integer : intro_nm)) | FStar_Pervasives_Native.None -> let uu___3 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unexpected numeric literal. Restart F* to load %s." tnm in FStarC_Errors.raise_error @@ -2543,7 +2514,7 @@ and (desugar_term_maybe_top : fun top -> let mk e = FStarC_Syntax_Syntax.mk e top.FStarC_Parser_AST.range in let noaqs = [] in - let join_aqs aqs = FStarC_Compiler_List.flatten aqs in + let join_aqs aqs = FStarC_List.flatten aqs in let setpos e = { FStarC_Syntax_Syntax.n = (e.FStarC_Syntax_Syntax.n); @@ -2554,7 +2525,7 @@ and (desugar_term_maybe_top : } in let desugar_binders env1 binders = let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -2565,7 +2536,7 @@ and (desugar_term_maybe_top : (match uu___2 with | (b1, env3) -> (env3, (b1 :: bs)))) (env1, []) binders in match uu___ with - | (env2, bs_rev) -> (env2, (FStarC_Compiler_List.rev bs_rev)) in + | (env2, bs_rev) -> (env2, (FStarC_List.rev bs_rev)) in let unqual_bv_of_binder b = match b with | { FStarC_Syntax_Syntax.binder_bv = x; @@ -2577,12 +2548,12 @@ and (desugar_term_maybe_top : b FStarC_Errors_Codes.Fatal_UnexpectedTerm () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic "Unexpected qualified binder in ELIM_EXISTS") in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_ToSyntax in + (let uu___1 = FStarC_Effect.op_Bang dbg_ToSyntax in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Parser_AST.showable_term top in - FStarC_Compiler_Util.print1 "desugaring (%s)\n\n" uu___2 + FStarC_Util.print1 "desugaring (%s)\n\n" uu___2 else ()); (let uu___1 = let uu___2 = unparen top in uu___2.FStarC_Parser_AST.tm in match uu___1 with @@ -2629,7 +2600,7 @@ and (desugar_term_maybe_top : (let uu___2 = FStarC_Ident.string_of_id op_star in uu___2 = "*") && (let uu___2 = op_as_term env (Prims.of_int (2)) op_star in - FStarC_Compiler_Option.isNone uu___2) + FStarC_Option.isNone uu___2) -> let rec flatten t = match t.FStarC_Parser_AST.tm with @@ -2637,17 +2608,16 @@ and (desugar_term_maybe_top : (let uu___2 = FStarC_Ident.string_of_id id in uu___2 = "*") && (let uu___2 = op_as_term env (Prims.of_int (2)) op_star in - FStarC_Compiler_Option.isNone uu___2) + FStarC_Option.isNone uu___2) -> - let uu___2 = flatten t1 in - FStarC_Compiler_List.op_At uu___2 [t2] + let uu___2 = flatten t1 in FStarC_List.op_At uu___2 [t2] | uu___2 -> [t] in let terms = flatten lhs in let t = let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> FStar_Pervasives.Inr uu___5) terms in (uu___4, rhs) in FStarC_Parser_AST.Sum uu___3 in @@ -2687,7 +2657,7 @@ and (desugar_term_maybe_top : top.FStarC_Parser_AST.range in desugar_term_maybe_top top_level env uu___2 | FStarC_Parser_AST.Op (s, args) -> - let uu___2 = op_as_term env (FStarC_Compiler_List.length args) s in + let uu___2 = op_as_term env (FStarC_List.length args) s in (match uu___2 with | FStar_Pervasives_Native.None -> let uu___3 = @@ -2698,18 +2668,18 @@ and (desugar_term_maybe_top : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___3) | FStar_Pervasives_Native.Some op -> - if (FStarC_Compiler_List.length args) > Prims.int_zero + if (FStarC_List.length args) > Prims.int_zero then let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun t -> let uu___5 = desugar_term_aq env t in match uu___5 with | (t', s1) -> ((t', FStar_Pervasives_Native.None), s1)) args in - FStarC_Compiler_List.unzip uu___4 in + FStarC_List.unzip uu___4 in (match uu___3 with | (args1, aqs) -> let uu___4 = @@ -2869,7 +2839,7 @@ and (desugar_term_maybe_top : | FStar_Pervasives_Native.None -> let uu___3 = let uu___4 = FStarC_Ident.string_of_lid eff_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Member %s of effect %s is not accessible (using an effect abbreviation instead of the original effect ?)" uu___4 txt in failwith uu___3) @@ -2903,7 +2873,7 @@ and (desugar_term_maybe_top : | uu___2 -> let uu___3 = let uu___4 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Data constructor or effect %s not found" uu___4 in FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_term top FStarC_Errors_Codes.Fatal_EffectNotFound () @@ -2915,8 +2885,8 @@ and (desugar_term_maybe_top : | FStar_Pervasives_Native.None -> let uu___3 = let uu___4 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.format1 - "Data constructor %s not found" uu___4 in + FStarC_Util.format1 "Data constructor %s not found" + uu___4 in FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_term top FStarC_Errors_Codes.Fatal_DataContructorNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -2934,7 +2904,7 @@ and (desugar_term_maybe_top : | [] -> (head1, noaqs) | uu___3 -> let uu___4 = - FStarC_Compiler_Util.take + FStarC_Util.take (fun uu___5 -> match uu___5 with | (uu___6, imp) -> @@ -2942,14 +2912,14 @@ and (desugar_term_maybe_top : (match uu___4 with | (universes, args1) -> let universes1 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> desugar_universe (FStar_Pervasives_Native.fst x)) universes in let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (t, imp) -> @@ -2959,7 +2929,7 @@ and (desugar_term_maybe_top : let uu___9 = arg_withimp_t imp te in (uu___9, aq))) args1 in - FStarC_Compiler_List.unzip uu___6 in + FStarC_List.unzip uu___6 in (match uu___5 with | (args2, aqs) -> let head2 = @@ -2971,7 +2941,7 @@ and (desugar_term_maybe_top : (head1, universes1)) in let tm = if - (FStarC_Compiler_List.length args2) = + (FStarC_List.length args2) = Prims.int_zero then head2 else @@ -3008,7 +2978,7 @@ and (desugar_term_maybe_top : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___5))) | FStarC_Parser_AST.Sum (binders, t) when - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun uu___2 -> match uu___2 with | FStar_Pervasives.Inr uu___3 -> true @@ -3016,29 +2986,29 @@ and (desugar_term_maybe_top : -> let terms = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | FStar_Pervasives.Inr x -> x | FStar_Pervasives.Inl uu___4 -> failwith "Impossible") binders in - FStarC_Compiler_List.op_At uu___2 [t] in + FStarC_List.op_At uu___2 [t] in let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun t1 -> let uu___4 = desugar_typ_aq env t1 in match uu___4 with | (t', aq) -> let uu___5 = FStarC_Syntax_Syntax.as_arg t' in (uu___5, aq)) terms in - FStarC_Compiler_List.unzip uu___3 in + FStarC_List.unzip uu___3 in (match uu___2 with | (targs, aqs) -> let tup = let uu___3 = FStarC_Parser_Const.mk_tuple_lid - (FStarC_Compiler_List.length targs) + (FStarC_List.length targs) top.FStarC_Parser_AST.range in FStarC_Syntax_DsEnv.fail_or env (FStarC_Syntax_DsEnv.try_lookup_lid env) uu___3 in @@ -3063,8 +3033,8 @@ and (desugar_term_maybe_top : FStar_Pervasives_Native.None in FStar_Pervasives.Inl uu___6 in [uu___5] in - FStarC_Compiler_List.op_At binders uu___4 in - FStarC_Compiler_List.fold_left + FStarC_List.op_At binders uu___4 in + FStarC_List.fold_left (fun uu___4 -> fun b -> match uu___4 with @@ -3104,8 +3074,7 @@ and (desugar_term_maybe_top : } FStar_Pervasives_Native.None attrs in [uu___9] in - FStarC_Compiler_List.op_At tparams - uu___8 in + FStarC_List.op_At tparams uu___8 in let uu___8 = let uu___9 = let uu___10 = @@ -3113,7 +3082,7 @@ and (desugar_term_maybe_top : no_annot_abs tparams t1 in FStarC_Syntax_Syntax.as_arg uu___11 in [uu___10] in - FStarC_Compiler_List.op_At typs uu___9 in + FStarC_List.op_At typs uu___9 in (env2, uu___7, uu___8)))) (env, [], []) uu___3 in (match uu___2 with @@ -3121,7 +3090,7 @@ and (desugar_term_maybe_top : let tup = let uu___4 = FStarC_Parser_Const.mk_dtuple_lid - (FStarC_Compiler_List.length targs) + (FStarC_List.length targs) top.FStarC_Parser_AST.range in FStarC_Syntax_DsEnv.fail_or env1 (FStarC_Syntax_DsEnv.try_lookup_lid env1) uu___4 in @@ -3145,8 +3114,8 @@ and (desugar_term_maybe_top : t1 in let uu___4 = let uu___5 = - FStarC_Syntax_Util.arrow - (FStarC_Compiler_List.rev bs1) cod in + FStarC_Syntax_Util.arrow (FStarC_List.rev bs1) + cod in setpos uu___5 in (uu___4, aqs) | hd::tl -> @@ -3157,9 +3126,8 @@ and (desugar_term_maybe_top : as_binder env1 hd.FStarC_Parser_AST.aqual bb in (match uu___5 with | (b, env2) -> - aux env2 - (FStarC_Compiler_List.op_At aqs' aqs) (b - :: bs1) tl)) in + aux env2 (FStarC_List.op_At aqs' aqs) (b :: + bs1) tl)) in aux env [] [] bs) | FStarC_Parser_AST.Refine (b, f) -> let uu___2 = desugar_binder env b in @@ -3208,8 +3176,7 @@ and (desugar_term_maybe_top : FStarC_Parser_AST.Expr in desugar_term_maybe_top top_level env t' | FStarC_Parser_AST.Abs (binders, body) -> - let bvss = - FStarC_Compiler_List.map gather_pattern_bound_vars binders in + let bvss = FStarC_List.map gather_pattern_bound_vars binders in let check_disjoint sets = let rec aux acc sets1 = match sets1 with @@ -3219,13 +3186,13 @@ and (desugar_term_maybe_top : Obj.magic (FStarC_Class_Setlike.inter () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic acc) (Obj.magic set)) in let uu___2 = FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic i) in if uu___2 then @@ -3233,7 +3200,7 @@ and (desugar_term_maybe_top : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic acc) (Obj.magic set)) in aux uu___3 sets2 @@ -3242,16 +3209,16 @@ and (desugar_term_maybe_top : let uu___5 = FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic i) in - FStarC_Compiler_List.hd uu___5 in + FStarC_List.hd uu___5 in FStar_Pervasives_Native.Some uu___4) in let uu___2 = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) ()) in aux uu___2 sets in ((let uu___3 = check_disjoint bvss in @@ -3283,10 +3250,9 @@ and (desugar_term_maybe_top : () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___4)); - (let binders1 = - FStarC_Compiler_List.map replace_unit_pattern binders in + (let binders1 = FStarC_List.map replace_unit_pattern binders in let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun pat -> match uu___4 with @@ -3297,7 +3263,7 @@ and (desugar_term_maybe_top : -> let uu___6 = let uu___7 = free_type_vars env1 t in - FStarC_Compiler_List.op_At uu___7 ftvs in + FStarC_List.op_At uu___7 ftvs in (env1, uu___6) | FStarC_Parser_AST.PatAscribed (uu___5, @@ -3307,8 +3273,8 @@ and (desugar_term_maybe_top : let uu___7 = free_type_vars env1 t in let uu___8 = let uu___9 = free_type_vars env1 tac in - FStarC_Compiler_List.op_At uu___9 ftvs in - FStarC_Compiler_List.op_At uu___7 uu___8 in + FStarC_List.op_At uu___9 ftvs in + FStarC_List.op_At uu___7 uu___8 in (env1, uu___6) | uu___5 -> (env1, ftvs))) (env, []) binders1 in match uu___3 with @@ -3316,7 +3282,7 @@ and (desugar_term_maybe_top : let ftv1 = sort_ftv ftv in let binders2 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun a -> FStarC_Parser_AST.mk_pattern (FStarC_Parser_AST.PatTvar @@ -3324,7 +3290,7 @@ and (desugar_term_maybe_top : (FStar_Pervasives_Native.Some FStarC_Parser_AST.Implicit), [])) top.FStarC_Parser_AST.range) ftv1 in - FStarC_Compiler_List.op_At uu___5 binders1 in + FStarC_List.op_At uu___5 binders1 in let rec aux aqs env1 bs sc_pat_opt pats = match pats with | [] -> @@ -3338,7 +3304,7 @@ and (desugar_term_maybe_top : let uu___6 = let uu___7 = FStarC_Syntax_Syntax.pat_bvs pat in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder uu___7 in FStarC_Syntax_Subst.close uu___6 body1 in @@ -3359,10 +3325,9 @@ and (desugar_term_maybe_top : | FStar_Pervasives_Native.None -> body1 in let uu___6 = let uu___7 = - no_annot_abs (FStarC_Compiler_List.rev bs) - body2 in + no_annot_abs (FStarC_List.rev bs) body2 in setpos uu___7 in - (uu___6, (FStarC_Compiler_List.op_At aq aqs))) + (uu___6, (FStarC_List.op_At aq aqs))) | p::rest -> let uu___5 = desugar_binding_pat_aq env1 p in (match uu___5 with @@ -3447,7 +3412,7 @@ and (desugar_term_maybe_top : top.FStarC_Parser_AST.range in let p2 = let uu___9 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges p'.FStarC_Syntax_Syntax.p p1.FStarC_Syntax_Syntax.p in FStarC_Syntax_Syntax.withinfo @@ -3470,7 +3435,7 @@ and (desugar_term_maybe_top : let uu___10 = FStarC_Parser_Const.mk_tuple_data_lid (Prims.int_one + - (FStarC_Compiler_List.length + (FStarC_List.length args)) top.FStarC_Parser_AST.range in FStarC_Syntax_Syntax.lid_and_dd_as_fv @@ -3493,8 +3458,8 @@ and (desugar_term_maybe_top : FStarC_Syntax_Syntax.as_arg uu___16 in [uu___15] in - FStarC_Compiler_List.op_At - args uu___14 in + FStarC_List.op_At args + uu___14 in { FStarC_Syntax_Syntax.hd = uu___12; @@ -3506,14 +3471,14 @@ and (desugar_term_maybe_top : mk uu___10 in let p2 = let uu___10 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges p'.FStarC_Syntax_Syntax.p p1.FStarC_Syntax_Syntax.p in FStarC_Syntax_Syntax.withinfo (FStarC_Syntax_Syntax.Pat_cons (tupn, FStar_Pervasives_Native.None, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At pats1 [(p1, false)]))) uu___10 in @@ -3525,8 +3490,8 @@ and (desugar_term_maybe_top : (uu___7, sc_pat_opt1) in (match uu___6 with | (b1, sc_pat_opt1) -> - aux (FStarC_Compiler_List.op_At aq aqs) - env2 (b1 :: bs) sc_pat_opt1 rest)) in + aux (FStarC_List.op_At aq aqs) env2 (b1 :: + bs) sc_pat_opt1 rest)) in aux [] env [] FStar_Pervasives_Native.None binders2)) | FStarC_Parser_AST.App (uu___2, uu___3, FStarC_Parser_AST.UnivApp) -> @@ -3557,7 +3522,7 @@ and (desugar_term_maybe_top : let uu___4 = FStarC_Syntax_Syntax.extend_app head arg top.FStarC_Parser_AST.range in - (uu___4, (FStarC_Compiler_List.op_At aq1 aq2)))) + (uu___4, (FStarC_List.op_At aq1 aq2)))) | FStarC_Parser_AST.Bind (x, t1, t2) -> let xpat = let uu___2 = FStarC_Ident.range_of_id x in @@ -3632,7 +3597,7 @@ and (desugar_term_maybe_top : | uu___2 -> let uu___3 = let uu___4 = FStarC_Parser_AST.term_to_string rty in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "This type must be a (possibly applied) record name" uu___4 in FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_term @@ -3647,8 +3612,7 @@ and (desugar_term_maybe_top : | FStar_Pervasives_Native.None -> let uu___3 = let uu___4 = FStarC_Parser_AST.term_to_string rty in - FStarC_Compiler_Util.format1 "Not a record type: `%s`" - uu___4 in + FStarC_Util.format1 "Not a record type: `%s`" uu___4 in FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_term rty FStarC_Errors_Codes.Error_BadLetOpenRecord () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -3667,7 +3631,7 @@ and (desugar_term_maybe_top : let uu___4 = mk_pattern (FStarC_Parser_AST.PatName constrname) in let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> match uu___6 with | (field, uu___7) -> @@ -3705,7 +3669,7 @@ and (desugar_term_maybe_top : FStarC_Parser_AST.mk_term (FStarC_Parser_AST.Op (op, [])) uu___2 FStarC_Parser_AST.Expr in let mproduct_def = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun def -> fun uu___2 -> match uu___2 with @@ -3715,7 +3679,7 @@ and (desugar_term_maybe_top : [def; andDef] top.FStarC_Parser_AST.range) letDef tl in let mproduct_pat = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun pat -> fun uu___2 -> match uu___2 with @@ -3745,7 +3709,7 @@ and (desugar_term_maybe_top : let ds_let_rec_or_app uu___2 = let bindings = lbs in let funs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (attr_opt, (p, def)) -> @@ -3815,7 +3779,7 @@ and (desugar_term_maybe_top : (Obj.magic "Unexpected let binding")))) bindings in let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun uu___5 -> match (uu___4, uu___5) with @@ -3829,7 +3793,7 @@ and (desugar_term_maybe_top : (match uu___10 with | (env2, xx, used_marker) -> let dummy_ref = - FStarC_Compiler_Util.mk_ref true in + FStarC_Util.mk_ref true in let uu___11 = let uu___12 = FStarC_Syntax_Syntax.mk_binder xx in @@ -3854,14 +3818,14 @@ and (desugar_term_maybe_top : used_markers1))) (env, [], [], []) funs in match uu___3 with | (env', fnames, rec_bindings, used_markers) -> - let fnames1 = FStarC_Compiler_List.rev fnames in - let rec_bindings1 = FStarC_Compiler_List.rev rec_bindings in - let used_markers1 = FStarC_Compiler_List.rev used_markers in + let fnames1 = FStarC_List.rev fnames in + let rec_bindings1 = FStarC_List.rev rec_bindings in + let used_markers1 = FStarC_List.rev used_markers in let desugar_one_def env1 lbname uu___4 = match uu___4 with | (attrs_opt, (uu___5, args, result_t), def) -> let args1 = - FStarC_Compiler_List.map replace_unit_pattern args in + FStarC_List.map replace_unit_pattern args in let pos = def.FStarC_Parser_AST.range in let def1 = match result_t with @@ -3872,7 +3836,7 @@ and (desugar_term_maybe_top : if uu___6 then ((let uu___8 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun x -> let uu___9 = is_var_pattern x in Prims.op_Negation uu___9) args1 in @@ -3898,13 +3862,11 @@ and (desugar_term_maybe_top : () in FStarC_Syntax_DsEnv.try_lookup_effect_name env1 uu___10 in - FStarC_Compiler_Option.isSome - uu___9)) + FStarC_Option.isSome uu___9)) && ((Prims.op_Negation is_rec) || - ((FStarC_Compiler_List.length - args1) - <> Prims.int_zero)) in + ((FStarC_List.length args1) <> + Prims.int_zero)) in if uu___8 then FStarC_Parser_AST.ml_comp t else FStarC_Parser_AST.tot_comp t) in @@ -3944,8 +3906,7 @@ and (desugar_term_maybe_top : match attrs_opt with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some l -> - FStarC_Compiler_List.map - (desugar_term env1) l in + FStarC_List.map (desugar_term env1) l in let uu___7 = mk_lb (attrs, lbname1, @@ -3954,10 +3915,10 @@ and (desugar_term_maybe_top : (uu___7, aq)) in let uu___4 = let uu___5 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (desugar_one_def (if is_rec then env' else env)) fnames1 funs in - FStarC_Compiler_List.unzip uu___5 in + FStarC_List.unzip uu___5 in (match uu___4 with | (lbs1, aqss) -> let uu___5 = desugar_term_aq env' body in @@ -3965,7 +3926,7 @@ and (desugar_term_maybe_top : | (body1, aq) -> (if is_rec then - FStarC_Compiler_List.iter2 + FStarC_List.iter2 (fun uu___7 -> fun used_marker -> match uu___7 with @@ -3973,7 +3934,7 @@ and (desugar_term_maybe_top : uu___10) -> let uu___11 = let uu___12 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang used_marker in Prims.op_Negation uu___12 in if uu___11 @@ -4044,14 +4005,14 @@ and (desugar_term_maybe_top : FStarC_Syntax_Syntax.Tm_let uu___9 in mk uu___8 in (uu___7, - (FStarC_Compiler_List.op_At aq - (FStarC_Compiler_List.flatten aqss))))))) in + (FStarC_List.op_At aq + (FStarC_List.flatten aqss))))))) in let ds_non_rec attrs_opt pat t1 t2 = let attrs = match attrs_opt with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some l -> - FStarC_Compiler_List.map (desugar_term env) l in + FStarC_List.map (desugar_term env) l in let uu___2 = desugar_term_aq env t1 in match uu___2 with | (t11, aq0) -> @@ -4063,10 +4024,9 @@ and (desugar_term_maybe_top : (let uu___5 = match binder with | LetBinder (l, (t, tacopt)) -> - (if FStarC_Compiler_Util.is_some tacopt + (if FStarC_Util.is_some tacopt then - (let uu___7 = - FStarC_Compiler_Util.must tacopt in + (let uu___7 = FStarC_Util.must tacopt in FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) uu___7 @@ -4171,9 +4131,8 @@ and (desugar_term_maybe_top : mk uu___10 in (uu___9, aq)) in match uu___5 with - | (tm, aq1) -> - (tm, (FStarC_Compiler_List.op_At aq0 aq1))))) in - let uu___2 = FStarC_Compiler_List.hd lbs in + | (tm, aq1) -> (tm, (FStarC_List.op_At aq0 aq1))))) in + let uu___2 = FStarC_List.hd lbs in (match uu___2 with | (attrs, (head_pat, defn)) -> let uu___3 = is_rec || (is_app_pattern head_pat) in @@ -4350,7 +4309,7 @@ and (desugar_term_maybe_top : | (b1, aqB) -> let uu___5 = desugar_disjunctive_pattern pat1 wopt1 b1 in - (uu___5, (FStarC_Compiler_List.op_At aqP aqB)))) in + (uu___5, (FStarC_List.op_At aqP aqB)))) in let uu___2 = desugar_term_aq env e in (match uu___2 with | (e1, aq) -> @@ -4360,10 +4319,10 @@ and (desugar_term_maybe_top : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_List.map desugar_branch branches in - FStarC_Compiler_List.unzip uu___6 in + FStarC_List.map desugar_branch branches in + FStarC_List.unzip uu___6 in match uu___5 with - | (x, y) -> ((FStarC_Compiler_List.flatten x), y) in + | (x, y) -> ((FStarC_List.flatten x), y) in (match uu___4 with | (brs, aqs) -> let uu___5 = @@ -4393,7 +4352,7 @@ and (desugar_term_maybe_top : FStarC_Syntax_Syntax.eff_opt = FStar_Pervasives_Native.None }) in - (uu___4, (FStarC_Compiler_List.op_At aq0 aq)))) + (uu___4, (FStarC_List.op_At aq0 aq)))) | FStarC_Parser_AST.Record (uu___2, []) -> FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_term top FStarC_Errors_Codes.Fatal_UnexpectedEmptyRecord () @@ -4401,36 +4360,36 @@ and (desugar_term_maybe_top : (Obj.magic "Unexpected empty record") | FStarC_Parser_AST.Record (eopt, fields) -> let record_opt = - let uu___2 = FStarC_Compiler_List.hd fields in + let uu___2 = FStarC_List.hd fields in match uu___2 with | (f, uu___3) -> FStarC_Syntax_DsEnv.try_lookup_record_by_field_name env f in let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (fn, fval) -> let uu___5 = desugar_term_aq env fval in (match uu___5 with | (fval1, aq) -> ((fn, fval1), aq))) fields in - FStarC_Compiler_List.unzip uu___3 in + FStarC_List.unzip uu___3 in (match uu___2 with | (fields1, aqs) -> - let uu___3 = FStarC_Compiler_List.unzip fields1 in + let uu___3 = FStarC_List.unzip fields1 in (match uu___3 with | (field_names, assignments) -> let args = - FStarC_Compiler_List.map + FStarC_List.map (fun f -> (f, FStar_Pervasives_Native.None)) assignments in - let aqs1 = FStarC_Compiler_List.flatten aqs in + let aqs1 = FStarC_List.flatten aqs in let uc = match record_opt with | FStar_Pervasives_Native.None -> { FStarC_Syntax_Syntax.uc_base_term = - (FStarC_Compiler_Option.isSome eopt); + (FStarC_Option.isSome eopt); FStarC_Syntax_Syntax.uc_typename = FStar_Pervasives_Native.None; FStarC_Syntax_Syntax.uc_fields = field_names @@ -4442,7 +4401,7 @@ and (desugar_term_maybe_top : field_names in { FStarC_Syntax_Syntax.uc_base_term = - (FStarC_Compiler_Option.isSome eopt); + (FStarC_Option.isSome eopt); FStarC_Syntax_Syntax.uc_typename = (FStar_Pervasives_Native.Some (record.FStarC_Syntax_DsEnv.typename)); @@ -4518,7 +4477,7 @@ and (desugar_term_maybe_top : FStarC_Syntax_Syntax.body1 = body1 })) in - (tm, (FStarC_Compiler_List.op_At aq aqs1)))))) + (tm, (FStarC_List.op_At aq aqs1)))))) | FStarC_Parser_AST.Project (e, f) -> let uu___2 = desugar_term_aq env e in (match uu___2 with @@ -4557,7 +4516,7 @@ and (desugar_term_maybe_top : (FStar_Pervasives_Native.Some candidate_projector) in let f1 = let uu___4 = qualify_field_names constrname [f] in - FStarC_Compiler_List.hd uu___4 in + FStarC_List.hd uu___4 in FStarC_Syntax_Syntax.fvar_with_dd f1 (FStar_Pervasives_Native.Some qual1) in let uu___3 = @@ -4600,20 +4559,20 @@ and (desugar_term_maybe_top : (match uu___2 with | (tm, vts) -> let vt_binders = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (bv, _tm) -> FStarC_Syntax_Syntax.mk_binder bv) vts in let vt_tms = - FStarC_Compiler_List.map FStar_Pervasives_Native.snd vts in + FStarC_List.map FStar_Pervasives_Native.snd vts in let tm1 = FStarC_Syntax_Subst.close vt_binders tm in ((let fvs = FStarC_Syntax_Free.names tm1 in let uu___4 = let uu___5 = FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic fvs) in Prims.op_Negation uu___5 in if uu___4 @@ -4621,10 +4580,10 @@ and (desugar_term_maybe_top : let uu___5 = let uu___6 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set + (FStarC_FlatSet.showable_set FStarC_Syntax_Syntax.ord_bv FStarC_Syntax_Print.showable_bv) fvs in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Static quotation refers to external variables: %s" uu___6 in FStarC_Errors.raise_error @@ -4756,7 +4715,7 @@ and (desugar_term_maybe_top : FStarC_Parser_Const.calc_push_impl_lid) r FStarC_Parser_AST.Expr in let last_expr = - let uu___2 = FStarC_Compiler_List.last_opt steps in + let uu___2 = FStarC_List.last_opt steps in match uu___2 with | FStar_Pervasives_Native.Some (FStarC_Parser_AST.CalcStep (uu___3, uu___4, last_expr1)) -> last_expr1 @@ -4778,7 +4737,7 @@ and (desugar_term_maybe_top : [(init_expr, FStarC_Parser_AST.Nothing)] init_expr.FStarC_Parser_AST.range in let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun uu___4 -> match (uu___3, uu___4) with @@ -4833,7 +4792,7 @@ and (desugar_term_maybe_top : (init_expr, FStarC_Parser_AST.Hash) :: uu___9 in uu___7 :: uu___8 in FStarC_Parser_AST.mkApp uu___5 uu___6 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in (pf, next_expr)) (e, init_expr) steps in (match uu___2 with | (e1, uu___3) -> @@ -4897,7 +4856,7 @@ and (desugar_term_maybe_top : (match uu___2 with | (env', bs1) -> let p1 = desugar_term env' p in - let vs1 = FStarC_Compiler_List.map (desugar_term env) vs in + let vs1 = FStarC_List.map (desugar_term env) vs in let e1 = desugar_term env e in let mk_exists_intro t p2 v e2 = let head = @@ -5047,7 +5006,7 @@ and (desugar_term_maybe_top : (match uu___2 with | (env', bs1) -> let p1 = desugar_term env' p in - let vs1 = FStarC_Compiler_List.map (desugar_term env) vs in + let vs1 = FStarC_List.map (desugar_term env) vs in let mk_forall_elim a p2 v tok = let head = let uu___3 = @@ -5099,14 +5058,14 @@ and (desugar_term_maybe_top : (Obj.magic "Unexpected number of instantiations in _elim_forall_") in let range = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun bs2 -> fun r -> let uu___3 = FStarC_Syntax_Syntax.range_of_bv bs2.FStarC_Syntax_Syntax.binder_bv in - FStarC_Compiler_Range_Ops.union_ranges uu___3 r) - bs1 p1.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.union_ranges uu___3 r) bs1 + p1.FStarC_Syntax_Syntax.pos in let uu___3 = aux bs1 vs1 [] { @@ -5153,8 +5112,7 @@ and (desugar_term_maybe_top : let uu___6 = let uu___7 = let uu___8 = - let uu___9 = - FStarC_Compiler_List.hd bs1 in + let uu___9 = FStarC_List.hd bs1 in [uu___9] in FStarC_Syntax_Util.abs uu___8 p2 FStar_Pervasives_Native.None in @@ -5243,14 +5201,14 @@ and (desugar_term_maybe_top : uu___4 squash_token uu___5 squash_token.FStarC_Syntax_Syntax.pos in let range = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun bs1 -> fun r -> let uu___4 = FStarC_Syntax_Syntax.range_of_bv bs1.FStarC_Syntax_Syntax.binder_bv in - FStarC_Compiler_Range_Ops.union_ranges uu___4 - r) bs p1.FStarC_Syntax_Syntax.pos in + FStarC_Range_Ops.union_ranges uu___4 r) bs + p1.FStarC_Syntax_Syntax.pos in let uu___4 = aux bs { @@ -5279,7 +5237,7 @@ and (desugar_term_maybe_top : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges p1.FStarC_Syntax_Syntax.pos q1.FStarC_Syntax_Syntax.pos in { @@ -5338,7 +5296,7 @@ and (desugar_term_maybe_top : let uu___8 = let uu___9 = let uu___10 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges p1.FStarC_Syntax_Syntax.pos q1.FStarC_Syntax_Syntax.pos in { @@ -5398,7 +5356,7 @@ and (desugar_term_maybe_top : let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges p1.FStarC_Syntax_Syntax.pos q1.FStarC_Syntax_Syntax.pos in { @@ -5441,8 +5399,8 @@ and (desugar_term_maybe_top : FStarC_Parser_AST.Expr in let t' = let uu___2 = nil top.FStarC_Parser_AST.range in - FStarC_Compiler_List.fold_right - (cons top.FStarC_Parser_AST.range) ts uu___2 in + FStarC_List.fold_right (cons top.FStarC_Parser_AST.range) ts + uu___2 in desugar_term_aq env t' | FStarC_Parser_AST.SeqLiteral ts -> let nil r = @@ -5459,8 +5417,8 @@ and (desugar_term_maybe_top : (tl, FStarC_Parser_AST.Nothing)] r in let t' = let uu___2 = nil top.FStarC_Parser_AST.range in - FStarC_Compiler_List.fold_right - (cons top.FStarC_Parser_AST.range) ts uu___2 in + FStarC_List.fold_right (cons top.FStarC_Parser_AST.range) ts + uu___2 in desugar_term_aq env t' | uu___2 when top.FStarC_Parser_AST.level = FStarC_Parser_AST.Formula -> @@ -5475,7 +5433,7 @@ and (desugar_term_maybe_top : (Obj.magic uu___3)) and (desugar_match_returns : env_t -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.term -> (FStarC_Ident.ident FStar_Pervasives_Native.option * FStarC_Parser_AST.term * Prims.bool) FStar_Pervasives_Native.option -> @@ -5544,7 +5502,7 @@ and (desugar_match_returns : let b1 = let uu___3 = FStarC_Syntax_Subst.close_binders [b] in - FStarC_Compiler_List.hd uu___3 in + FStarC_List.hd uu___3 in ((FStar_Pervasives_Native.Some (b1, asc3)), aq)))) and (desugar_ascription : env_t -> @@ -5578,8 +5536,7 @@ and (desugar_ascription : match uu___ with | (annot, aq0) -> let uu___1 = - let uu___2 = - FStarC_Compiler_Util.map_opt tac_opt (desugar_term env) in + let uu___2 = FStarC_Util.map_opt tac_opt (desugar_term env) in (annot, uu___2, use_eq) in (uu___1, aq0) and (desugar_args : @@ -5590,14 +5547,14 @@ and (desugar_args : = fun env -> fun args -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (a, imp) -> let uu___1 = desugar_term env a in arg_withimp_t imp uu___1) args and (desugar_comp : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> FStarC_Syntax_DsEnv.env -> FStarC_Parser_AST.term -> FStarC_Syntax_Syntax.comp) @@ -5639,12 +5596,12 @@ and (desugar_comp : let uu___1 = unparen t1 in uu___1.FStarC_Parser_AST.tm in match uu___ with | FStarC_Parser_AST.Construct (smtpat, uu___1) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun s -> let uu___2 = FStarC_Ident.string_of_lid smtpat in uu___2 = s) ["SMTPat"; "SMTPatT"; "SMTPatOr"] | FStarC_Parser_AST.Var smtpat -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun s -> let uu___1 = FStarC_Ident.string_of_lid smtpat in uu___1 = s) ["smt_pat"; "smt_pat_or"] @@ -5656,7 +5613,7 @@ and (desugar_comp : let uu___3 = unparen t1 in uu___3.FStarC_Parser_AST.tm in (match uu___2 with | FStarC_Parser_AST.ListLiteral ts -> - FStarC_Compiler_Util.for_all is_smt_pat1 ts + FStarC_Util.for_all is_smt_pat1 ts | uu___3 -> false) in let pre_process_comp_typ t1 = let uu___ = head_and_args t1 in @@ -5723,8 +5680,8 @@ and (desugar_comp : "Invalid arguments to 'Lemma'; expected one of the following" in let uu___5 = let uu___6 = - FStarC_Compiler_List.map - FStarC_Pprint.doc_of_string expected_one_of in + FStarC_List.map FStarC_Pprint.doc_of_string + expected_one_of in FStarC_Errors_Msg.sublist FStarC_Pprint.empty uu___6 in FStarC_Pprint.op_Hat_Hat uu___4 uu___5 in @@ -5922,30 +5879,28 @@ and (desugar_comp : let uu___ = pre_process_comp_typ t in match uu___ with | ((eff, cattributes), args) -> - (if (FStarC_Compiler_List.length args) = Prims.int_zero + (if (FStarC_List.length args) = Prims.int_zero then (let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident eff in - FStarC_Compiler_Util.format1 - "Not enough args to effect %s" uu___3 in + FStarC_Util.format1 "Not enough args to effect %s" uu___3 in fail FStarC_Errors_Codes.Fatal_NotEnoughArgsToEffect uu___2) else (); (let is_universe uu___2 = match uu___2 with | (uu___3, imp) -> imp = FStarC_Parser_AST.UnivApp in - let uu___2 = FStarC_Compiler_Util.take is_universe args in + let uu___2 = FStarC_Util.take is_universe args in match uu___2 with | (universes, args1) -> let universes1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (u, imp) -> desugar_universe u) universes in let uu___3 = - let uu___4 = FStarC_Compiler_List.hd args1 in - let uu___5 = FStarC_Compiler_List.tl args1 in - (uu___4, uu___5) in + let uu___4 = FStarC_List.hd args1 in + let uu___5 = FStarC_List.tl args1 in (uu___4, uu___5) in (match uu___3 with | (result_arg, rest) -> let result_typ = @@ -5960,12 +5915,12 @@ and (desugar_comp : match uu___5 with | FStarC_Parser_AST.Decreases uu___6 -> true | uu___6 -> false in - FStarC_Compiler_List.partition is_decrease rest in + FStarC_List.partition is_decrease rest in (match uu___4 with | (dec, rest1) -> let rest2 = desugar_args env rest1 in let decreases_clause = - FStarC_Compiler_List.map + FStarC_List.map (fun t1 -> let uu___5 = let uu___6 = @@ -5980,7 +5935,7 @@ and (desugar_comp : match t3.FStarC_Parser_AST.tm with | FStarC_Parser_AST.LexList l -> let uu___7 = - FStarC_Compiler_List.map + FStarC_List.map (desugar_term env) l in FStarC_Syntax_Syntax.Decreases_lex uu___7 @@ -6060,8 +6015,7 @@ and (desugar_comp : [FStarC_Syntax_Syntax.SOMETRIVIAL] else []))) in let flags1 = - FStarC_Compiler_List.op_At flags - cattributes in + FStarC_List.op_At flags cattributes in let rest3 = let uu___9 = FStarC_Ident.lid_equals eff @@ -6134,7 +6088,7 @@ and (desugar_comp : FStarC_Syntax_Syntax.effect_args = rest3; FStarC_Syntax_Syntax.flags = - (FStarC_Compiler_List.op_At flags1 + (FStarC_List.op_At flags1 decreases_clause) })))))) and (desugar_formula : @@ -6172,7 +6126,7 @@ and (desugar_formula : "Impossible: Annotated pattern without binders in scope" | uu___1 -> let names1 = - FStarC_Compiler_List.map + FStarC_List.map (fun i -> let uu___2 = FStarC_Syntax_DsEnv.fail_or2 @@ -6188,9 +6142,9 @@ and (desugar_formula : (uu___2.FStarC_Syntax_Syntax.hash_code) }) names in let pats2 = - FStarC_Compiler_List.map + FStarC_List.map (fun es -> - FStarC_Compiler_List.map + FStarC_List.map (fun e -> let uu___2 = desugar_term env1 e in arg_withimp_t FStarC_Parser_AST.Nothing uu___2) @@ -6247,8 +6201,8 @@ and (desugar_formula : let body1 = let uu___ = q (rest, pats, body) in let uu___1 = - FStarC_Compiler_Range_Ops.union_ranges - b'.FStarC_Parser_AST.brange body.FStarC_Parser_AST.range in + FStarC_Range_Ops.union_ranges b'.FStarC_Parser_AST.brange + body.FStarC_Parser_AST.range in FStarC_Parser_AST.mk_term uu___ uu___1 FStarC_Parser_AST.Formula in let uu___ = q ([b], ([], []), body1) in @@ -6322,8 +6276,8 @@ and (desugar_formula : | FStar_Pervasives_Native.None -> let uu___2 = let uu___3 = FStarC_Ident.string_of_id i in - FStarC_Compiler_Util.format1 - "quantifier operator %s not found" uu___3 in + FStarC_Util.format1 "quantifier operator %s not found" + uu___3 in FStarC_Errors.raise_error FStarC_Ident.hasrange_ident i FStarC_Errors_Codes.Fatal_VariableNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -6342,8 +6296,7 @@ and (desugar_binder_aq : fun env -> fun b -> let attrs = - FStarC_Compiler_List.map (desugar_term env) - b.FStarC_Parser_AST.battributes in + FStarC_List.map (desugar_term env) b.FStarC_Parser_AST.battributes in match b.FStarC_Parser_AST.b with | FStarC_Parser_AST.TAnnotated (x, t) -> let uu___ = desugar_typ_aq env t in @@ -6386,9 +6339,7 @@ and (desugar_binder : let uu___ = desugar_binder_aq env b in match uu___ with | (r, aqs) -> (check_no_aq aqs; r) and (desugar_vquote : - env_t -> - FStarC_Parser_AST.term -> - FStarC_Compiler_Range_Type.range -> Prims.string) + env_t -> FStarC_Parser_AST.term -> FStarC_Range_Type.range -> Prims.string) = fun env -> fun e -> @@ -6465,7 +6416,7 @@ and (trans_bqual : let uu___1 = FStarC_Parser_AST.mk_term (FStarC_Parser_AST.Var FStarC_Parser_Const.tcresolve_lid) - FStarC_Compiler_Range_Type.dummyRange FStarC_Parser_AST.Expr in + FStarC_Range_Type.dummyRange FStarC_Parser_AST.Expr in desugar_term env uu___1 in FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Meta tcresolve) | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None @@ -6477,7 +6428,7 @@ let (typars_of_binders : fun env -> fun bs -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -6521,8 +6472,7 @@ let (typars_of_binders : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic "Unexpected binder"))) (env, []) bs in - match uu___ with - | (env1, tpars) -> (env1, (FStarC_Compiler_List.rev tpars)) + match uu___ with | (env1, tpars) -> (env1, (FStarC_List.rev tpars)) let (desugar_attributes : env_t -> FStarC_Parser_AST.term Prims.list -> @@ -6544,7 +6494,7 @@ let (desugar_attributes : FStarC_Errors_Codes.Fatal_UnknownAttribute () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2) in - FStarC_Compiler_List.map desugar_attribute cattributes + FStarC_List.map desugar_attribute cattributes let (binder_ident : FStarC_Parser_AST.binder -> FStarC_Ident.ident FStar_Pervasives_Native.option) @@ -6561,7 +6511,7 @@ let (binder_ident : let (binder_idents : FStarC_Parser_AST.binder Prims.list -> FStarC_Ident.ident Prims.list) = fun bs -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun b -> let uu___ = binder_ident b in FStarC_Common.list_of_option uu___) bs let (mk_data_discriminators : @@ -6576,7 +6526,7 @@ let (mk_data_discriminators : fun datas -> fun attrs -> let quals1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.NoExtract -> true @@ -6589,10 +6539,9 @@ let (mk_data_discriminators : (FStarC_Syntax_DsEnv.admitted_iface env) in if uu___ then - FStarC_Compiler_List.op_At (FStarC_Syntax_Syntax.Assumption :: - q) quals1 - else FStarC_Compiler_List.op_At q quals1 in - FStarC_Compiler_List.map + FStarC_List.op_At (FStarC_Syntax_Syntax.Assumption :: q) quals1 + else FStarC_List.op_At q quals1 in + FStarC_List.map (fun d -> let disc_name = FStarC_Syntax_Util.mk_discriminator d in let uu___ = FStarC_Ident.range_of_lid disc_name in @@ -6634,7 +6583,7 @@ let (mk_indexed_projector_names : fun fields -> let p = FStarC_Ident.range_of_lid lid in let uu___ = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun fld -> let x = fld.FStarC_Syntax_Syntax.binder_bv in @@ -6658,7 +6607,7 @@ let (mk_indexed_projector_names : else q in let quals1 = let iquals1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.NoExtract -> true @@ -6710,7 +6659,7 @@ let (mk_indexed_projector_names : FStarC_Syntax_Syntax.tun; FStarC_Syntax_Syntax.lbattrs = []; FStarC_Syntax_Syntax.lbpos = - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange } in let impl = let uu___2 = @@ -6718,7 +6667,7 @@ let (mk_indexed_projector_names : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in (uu___6.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in [uu___5] in @@ -6742,7 +6691,7 @@ let (mk_indexed_projector_names : FStar_Pervasives_Native.None } in if no_decl then [impl] else [decl; impl])) fields in - FStarC_Compiler_List.flatten uu___ + FStarC_List.flatten uu___ let (mk_data_projector_names : FStarC_Syntax_Syntax.qualifier Prims.list -> FStarC_Syntax_DsEnv.env -> @@ -6785,14 +6734,14 @@ let (mk_data_projector_names : | uu___8 -> FStar_Pervasives_Native.None in let fv_qual = let uu___7 = - FStarC_Compiler_Util.find_map + FStarC_Util.find_map se.FStarC_Syntax_Syntax.sigquals filter_records in match uu___7 with | FStar_Pervasives_Native.None -> FStarC_Syntax_Syntax.Data_ctor | FStar_Pervasives_Native.Some q -> q in - let uu___7 = FStarC_Compiler_Util.first_N n formals in + let uu___7 = FStarC_Util.first_N n formals in (match uu___7 with | (uu___8, rest) -> mk_indexed_projector_names iquals fv_qual @@ -6805,11 +6754,10 @@ let (mk_typ_abbrev : FStarC_Syntax_Syntax.univ_name Prims.list -> FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.term -> FStarC_Ident.lident Prims.list -> FStarC_Syntax_Syntax.qualifier Prims.list -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.sigelt) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt) = fun env -> fun d -> @@ -6823,7 +6771,7 @@ let (mk_typ_abbrev : fun rng -> let attrs = let uu___ = - FStarC_Compiler_List.map (desugar_term env) + FStarC_List.map (desugar_term env) d.FStarC_Parser_AST.attrs in FStarC_Syntax_Util.deduplicate_terms uu___ in let val_attrs = @@ -6838,10 +6786,10 @@ let (mk_typ_abbrev : FStar_Pervasives_Native.None in FStar_Pervasives.Inr uu___1 in let uu___1 = - if FStarC_Compiler_Util.is_some kopt + if FStarC_Util.is_some kopt then let uu___2 = - let uu___3 = FStarC_Compiler_Util.must kopt in + let uu___3 = FStarC_Util.must kopt in FStarC_Syntax_Syntax.mk_Total uu___3 in FStarC_Syntax_Util.arrow typars uu___2 else FStarC_Syntax_Syntax.tun in @@ -6858,7 +6806,7 @@ let (mk_typ_abbrev : } in let uu___ = FStarC_Syntax_Util.deduplicate_terms - (FStarC_Compiler_List.op_At val_attrs attrs) in + (FStarC_List.op_At val_attrs attrs) in let uu___1 = FStarC_Syntax_DsEnv.opens_and_abbrevs env in { FStarC_Syntax_Syntax.sigel = @@ -6929,7 +6877,7 @@ let rec (desugar_tycon : | FStarC_Parser_AST.TyconVariant (id, bds, k, variants) -> let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (cid, payload, attrs) -> @@ -6968,7 +6916,7 @@ let rec (desugar_tycon : } in let payload_typ = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun bd -> let uu___5 = binder_to_term bd in (uu___5, @@ -7062,18 +7010,17 @@ let rec (desugar_tycon : | uu___4 -> (FStar_Pervasives_Native.None, (cid, payload, attrs)))) variants in - FStarC_Compiler_List.unzip uu___2 in + FStarC_List.unzip uu___2 in (match uu___1 with | (additional_records, variants1) -> let concat_options = - FStarC_Compiler_List.filter_map (fun r -> r) in + FStarC_List.filter_map (fun r -> r) in let uu___2 = concat_options additional_records in - FStarC_Compiler_List.op_At uu___2 + FStarC_List.op_At uu___2 [((FStarC_Parser_AST.TyconVariant (id, bds, k, variants1)), d_attrs_initial)]) | tycon -> [(tycon, d_attrs_initial)] in - let tcs1 = - FStarC_Compiler_List.concatMap desugar_tycon_variant_record tcs in + let tcs1 = FStarC_List.concatMap desugar_tycon_variant_record tcs in let tot rng1 = FStarC_Parser_AST.mk_term (FStarC_Parser_AST.Name FStarC_Parser_Const.effect_Tot_lid) @@ -7097,7 +7044,7 @@ let rec (desugar_tycon : (FStarC_Parser_AST.TypeClassArg) -> FStarC_Parser_AST.Hash | uu___ -> FStarC_Parser_AST.Nothing in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun out -> fun b -> let uu___ = @@ -7121,7 +7068,7 @@ let rec (desugar_tycon : (uu___2, uu___3) in FStarC_Ident.mk_ident uu___1 in let mfields = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (x, q, attrs1, t) -> @@ -7149,19 +7096,19 @@ let rec (desugar_tycon : FStarC_Parser_AST.Type_level in let names = let uu___1 = binder_idents parms in id :: uu___1 in - (FStarC_Compiler_List.iter + (FStarC_List.iter (fun uu___2 -> match uu___2 with | (f, uu___3, uu___4, uu___5) -> let uu___6 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun i -> FStarC_Ident.ident_equals f i) names in if uu___6 then let uu___7 = let uu___8 = FStarC_Ident.string_of_id f in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Field %s shadows the record's name or a parameter of it, please rename it" uu___8 in FStarC_Errors.raise_error @@ -7172,7 +7119,7 @@ let rec (desugar_tycon : (Obj.magic uu___7) else ()) fields; (let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (f, uu___4, uu___5, uu___6) -> f) fields in @@ -7248,7 +7195,7 @@ let rec (desugar_tycon : | uu___1 -> failwith "Unexpected tycon" in let push_tparams env1 bs = let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -7265,8 +7212,7 @@ let rec (desugar_tycon : b.FStarC_Syntax_Syntax.binder_attrs in uu___4 :: tps in (env3, uu___3))) (env1, []) bs in - match uu___ with - | (env2, bs1) -> (env2, (FStarC_Compiler_List.rev bs1)) in + match uu___ with | (env2, bs1) -> (env2, (FStarC_List.rev bs1)) in match tcs1 with | (FStarC_Parser_AST.TyconAbstract (id, bs, kopt), d_attrs)::[] -> @@ -7298,7 +7244,7 @@ let rec (desugar_tycon : let quals1 = se.FStarC_Syntax_Syntax.sigquals in let quals2 = if - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Syntax_Syntax.Assumption quals1 then quals1 else @@ -7311,7 +7257,7 @@ let rec (desugar_tycon : let uu___11 = FStarC_Class_Show.show FStarC_Ident.showable_lident l in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Adding an implicit 'assume new' qualifier on %s" uu___11 in FStarC_Errors.log_issue @@ -7374,7 +7320,7 @@ let rec (desugar_tycon : match kopt with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Effect -> true @@ -7390,7 +7336,7 @@ let rec (desugar_tycon : let t0 = t in let quals1 = let uu___1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Logic -> true @@ -7406,8 +7352,8 @@ let rec (desugar_tycon : let qlid = FStarC_Syntax_DsEnv.qualify env id in let se = if - FStarC_Compiler_List.contains - FStarC_Syntax_Syntax.Effect quals1 + FStarC_List.contains FStarC_Syntax_Syntax.Effect + quals1 then let uu___1 = let uu___2 = @@ -7416,16 +7362,14 @@ let rec (desugar_tycon : match uu___2 with | FStarC_Parser_AST.Construct (head, args) -> let uu___3 = - match FStarC_Compiler_List.rev args with + match FStarC_List.rev args with | (last_arg, uu___4)::args_rev -> let uu___5 = let uu___6 = unparen last_arg in uu___6.FStarC_Parser_AST.tm in (match uu___5 with | FStarC_Parser_AST.Attributes ts -> - (ts, - (FStarC_Compiler_List.rev - args_rev)) + (ts, (FStarC_List.rev args_rev)) | uu___6 -> ([], args)) | uu___4 -> ([], args) in (match uu___3 with @@ -7450,34 +7394,37 @@ let rec (desugar_tycon : let c1 = FStarC_Syntax_Subst.close_comp typars1 c in let quals2 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.Effect -> false | uu___3 -> true) quals1 in - let uu___2 = FStarC_Ident.range_of_id id in - let uu___3 = + let uu___2 = + let uu___3 = + let uu___4 = + let uu___5 = + FStarC_Syntax_Util.comp_flags c1 in + FStarC_List.op_At cattributes uu___5 in + { + FStarC_Syntax_Syntax.lid4 = qlid; + FStarC_Syntax_Syntax.us4 = []; + FStarC_Syntax_Syntax.bs2 = typars1; + FStarC_Syntax_Syntax.comp1 = c1; + FStarC_Syntax_Syntax.cflags = uu___4 + } in + FStarC_Syntax_Syntax.Sig_effect_abbrev uu___3 in + let uu___3 = FStarC_Ident.range_of_id id in + let uu___4 = FStarC_Syntax_DsEnv.opens_and_abbrevs env in { - FStarC_Syntax_Syntax.sigel = - (FStarC_Syntax_Syntax.Sig_effect_abbrev - { - FStarC_Syntax_Syntax.lid4 = qlid; - FStarC_Syntax_Syntax.us4 = []; - FStarC_Syntax_Syntax.bs2 = typars1; - FStarC_Syntax_Syntax.comp1 = c1; - FStarC_Syntax_Syntax.cflags = - (FStarC_Compiler_List.op_At - cattributes - (FStarC_Syntax_Util.comp_flags c1)) - }); - FStarC_Syntax_Syntax.sigrng = uu___2; + FStarC_Syntax_Syntax.sigel = uu___2; + FStarC_Syntax_Syntax.sigrng = uu___3; FStarC_Syntax_Syntax.sigquals = quals2; FStarC_Syntax_Syntax.sigmeta = FStarC_Syntax_Syntax.default_sigmeta; FStarC_Syntax_Syntax.sigattrs = []; FStarC_Syntax_Syntax.sigopens_and_abbrevs = - uu___3; + uu___4; FStarC_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } @@ -7507,7 +7454,7 @@ let rec (desugar_tycon : | uu___::uu___1 -> let env0 = env in let mutuals = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (x, uu___3) -> @@ -7574,13 +7521,12 @@ let rec (desugar_tycon : (Obj.magic "Mutually defined type contains a non-inductive element"))) in let uu___2 = - FStarC_Compiler_List.fold_left (collect_tcs quals) - (env, []) tcs1 in + FStarC_List.fold_left (collect_tcs quals) (env, []) tcs1 in (match uu___2 with | (env1, tcs2) -> - let tcs3 = FStarC_Compiler_List.rev tcs2 in + let tcs3 = FStarC_List.rev tcs2 in let tps_sigelts = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___3 -> match uu___3 with | (tc, d_attrs) -> @@ -7684,7 +7630,7 @@ let rec (desugar_tycon : (match uu___10 with | (env_tps, tps) -> let data_tpars = - FStarC_Compiler_List.map + FStarC_List.map (fun tp -> { FStarC_Syntax_Syntax.binder_bv @@ -7711,7 +7657,7 @@ let rec (desugar_tycon : uu___11 in let uu___11 = let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> match uu___13 with | (id, payload, @@ -7774,7 +7720,7 @@ let rec (desugar_tycon : FStarC_Syntax_DsEnv.qualify env1 id in let quals2 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___14 -> match uu___14 with @@ -7785,7 +7731,7 @@ let rec (desugar_tycon : | uu___15 -> []) tname_quals in let ntps = - FStarC_Compiler_List.length + FStarC_List.length data_tpars in let uu___14 = let uu___15 = @@ -7830,14 +7776,14 @@ let rec (desugar_tycon : let uu___20 = let uu___21 = - FStarC_Compiler_List.map + FStarC_List.map (desugar_term env1) cons_attrs in - FStarC_Compiler_List.op_At + FStarC_List.op_At d_attrs uu___21 in - FStarC_Compiler_List.op_At + FStarC_List.op_At val_attrs uu___20 in FStarC_Syntax_Util.deduplicate_terms @@ -7866,12 +7812,11 @@ let rec (desugar_tycon : (tps, uu___15) in (name, uu___14)) constrs in - FStarC_Compiler_List.split - uu___12 in + FStarC_List.split uu___12 in (match uu___11 with | (constrNames, constrs1) -> ((let uu___13 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_attrs in if uu___13 then @@ -7889,7 +7834,7 @@ let rec (desugar_tycon : (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_term) d_attrs in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Adding attributes to type %s: val_attrs=[@@%s] attrs=[@@%s]\n" uu___14 uu___15 uu___16 else ()); @@ -7900,7 +7845,7 @@ let rec (desugar_tycon : tname in let uu___16 = FStarC_Syntax_Util.deduplicate_terms - (FStarC_Compiler_List.op_At + (FStarC_List.op_At val_attrs d_attrs) in let uu___17 = FStarC_Syntax_DsEnv.opens_and_abbrevs @@ -7947,42 +7892,41 @@ let rec (desugar_tycon : uu___13 :: constrs1)))) | uu___4 -> failwith "impossible")) tcs3 in let sigelts = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (uu___4, se) -> se) tps_sigelts in let uu___3 = let uu___4 = - FStarC_Compiler_List.collect + FStarC_List.collect FStarC_Syntax_Util.lids_of_sigelt sigelts in FStarC_Syntax_MutRecTy.disentangle_abbrevs_from_bundle sigelts quals uu___4 rng in (match uu___3 with | (bundle, abbrevs) -> - ((let uu___5 = - FStarC_Compiler_Effect.op_Bang dbg_attrs in + ((let uu___5 = FStarC_Effect.op_Bang dbg_attrs in if uu___5 then let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt bundle in - FStarC_Compiler_Util.print1 - "After disentangling: %s\n" uu___6 + FStarC_Util.print1 "After disentangling: %s\n" + uu___6 else ()); (let env2 = FStarC_Syntax_DsEnv.push_sigelt env0 bundle in let env3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left FStarC_Syntax_DsEnv.push_sigelt env2 abbrevs in let data_ops = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___5 -> match uu___5 with | (tps, se) -> mk_data_projector_names quals env3 se) tps_sigelts in let discs = - FStarC_Compiler_List.collect + FStarC_List.collect (fun se -> match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ @@ -8001,12 +7945,12 @@ let rec (desugar_tycon : let quals1 = se.FStarC_Syntax_Syntax.sigquals in let uu___9 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun data_lid -> let data_quals = let data_se = let uu___10 = - FStarC_Compiler_List.find + FStarC_List.find (fun se1 -> match se1.FStarC_Syntax_Syntax.sigel with @@ -8031,11 +7975,10 @@ let rec (desugar_tycon : name data_lid | uu___11 -> false) sigelts in - FStarC_Compiler_Util.must - uu___10 in + FStarC_Util.must uu___10 in data_se.FStarC_Syntax_Syntax.sigquals in let uu___10 = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___11 -> match uu___11 with | FStarC_Syntax_Syntax.RecordConstructor @@ -8048,14 +7991,13 @@ let rec (desugar_tycon : uu___9 se.FStarC_Syntax_Syntax.sigattrs | uu___5 -> []) sigelts in - let ops = - FStarC_Compiler_List.op_At discs data_ops in + let ops = FStarC_List.op_At discs data_ops in let env4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left FStarC_Syntax_DsEnv.push_sigelt env3 ops in (env4, - (FStarC_Compiler_List.op_At [bundle] - (FStarC_Compiler_List.op_At abbrevs ops))))))) + (FStarC_List.op_At [bundle] + (FStarC_List.op_At abbrevs ops))))))) | [] -> failwith "impossible" let (desugar_binders : FStarC_Syntax_DsEnv.env -> @@ -8065,7 +8007,7 @@ let (desugar_binders : fun env -> fun binders -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -8087,19 +8029,18 @@ let (desugar_binders : (Obj.magic "Missing name in binder"))) (env, []) binders in match uu___ with - | (env1, binders1) -> (env1, (FStarC_Compiler_List.rev binders1)) + | (env1, binders1) -> (env1, (FStarC_List.rev binders1)) let (push_reflect_effect : FStarC_Syntax_DsEnv.env -> FStarC_Syntax_Syntax.qualifier Prims.list -> - FStarC_Ident.lid -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_DsEnv.env) + FStarC_Ident.lid -> FStarC_Range_Type.range -> FStarC_Syntax_DsEnv.env) = fun env -> fun quals -> fun effect_name -> fun range -> let uu___ = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.Reflectable uu___2 -> true @@ -8139,7 +8080,7 @@ let (parse_attr_with_list : Prims.bool -> FStarC_Syntax_Syntax.term -> FStarC_Ident.lident -> - ((Prims.int Prims.list * FStarC_Compiler_Range_Type.range) + ((Prims.int Prims.list * FStarC_Range_Type.range) FStar_Pervasives_Native.option * Prims.bool)) = fun warn -> @@ -8150,7 +8091,7 @@ let (parse_attr_with_list : then let uu___1 = let uu___2 = FStarC_Ident.string_of_lid head in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Found ill-applied '%s', argument should be a non-empty list of integer literals" uu___2 in FStarC_Errors.log_issue @@ -8183,8 +8124,7 @@ let (parse_attr_with_list : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_List.map - FStarC_BigInt.to_int_fs es in + FStarC_List.map FStarC_BigInt.to_int_fs es in (uu___6, (at.FStarC_Syntax_Syntax.pos)) in FStar_Pervasives_Native.Some uu___5 in (uu___4, true) @@ -8196,7 +8136,7 @@ let (parse_attr_with_list : let (get_fail_attr1 : Prims.bool -> FStarC_Syntax_Syntax.term -> - (Prims.int Prims.list * FStarC_Compiler_Range_Type.range * Prims.bool) + (Prims.int Prims.list * FStarC_Range_Type.range * Prims.bool) FStar_Pervasives_Native.option) = fun warn -> @@ -8218,7 +8158,7 @@ let (get_fail_attr1 : let (get_fail_attr : Prims.bool -> FStarC_Syntax_Syntax.term Prims.list -> - (Prims.int Prims.list * FStarC_Compiler_Range_Type.range * Prims.bool) + (Prims.int Prims.list * FStarC_Range_Type.range * Prims.bool) FStar_Pervasives_Native.option) = fun warn -> @@ -8228,22 +8168,22 @@ let (get_fail_attr : | (FStar_Pervasives_Native.Some (e1, rng1, l1), FStar_Pervasives_Native.Some (e2, rng2, l2)) -> let uu___ = - let uu___1 = FStarC_Compiler_Range_Ops.union_ranges rng1 rng2 in - ((FStarC_Compiler_List.op_At e1 e2), uu___1, (l1 || l2)) in + let uu___1 = FStarC_Range_Ops.union_ranges rng1 rng2 in + ((FStarC_List.op_At e1 e2), uu___1, (l1 || l2)) in FStar_Pervasives_Native.Some uu___ | (FStar_Pervasives_Native.Some x, FStar_Pervasives_Native.None) -> FStar_Pervasives_Native.Some x | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some x) -> FStar_Pervasives_Native.Some x | uu___ -> FStar_Pervasives_Native.None in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun at -> fun acc -> let uu___ = get_fail_attr1 warn at in comb uu___ acc) ats FStar_Pervasives_Native.None let (lookup_effect_lid : FStarC_Syntax_DsEnv.env -> FStarC_Ident.lident -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.eff_decl) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.eff_decl) = fun env -> fun l -> @@ -8296,7 +8236,7 @@ let rec (desugar_effect : let uu___2 = FStarC_Syntax_Util.arrow_formals eff_t in FStar_Pervasives_Native.fst uu___2 in - FStarC_Compiler_List.length uu___1 in + FStarC_List.length uu___1 in let for_free = (num_indices = Prims.int_one) && (Prims.op_Negation is_layered) in @@ -8304,7 +8244,7 @@ let rec (desugar_effect : then (let uu___2 = let uu___3 = FStarC_Ident.string_of_id eff_name in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "DM4Free feature is deprecated and will be removed soon, use layered effects to define %s" uu___3 in FStarC_Errors.log_issue @@ -8322,10 +8262,10 @@ let rec (desugar_effect : else if is_layered then - FStarC_Compiler_List.op_At rr_members + FStarC_List.op_At rr_members ["subcomp"; "if_then_else"; "close"] else - FStarC_Compiler_List.op_At rr_members + FStarC_List.op_At rr_members ["return_wp"; "bind_wp"; "if_then_else"; @@ -8344,15 +8284,15 @@ let rec (desugar_effect : failwith "Malformed effect member declaration." in let uu___2 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun decl -> let uu___3 = name_of_eff_decl decl in - FStarC_Compiler_List.mem uu___3 - mandatory_members) eff_decls in + FStarC_List.mem uu___3 mandatory_members) + eff_decls in match uu___2 with | (mandatory_members_decls, actions) -> let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun decl -> match uu___4 with @@ -8363,8 +8303,7 @@ let rec (desugar_effect : | (env3, ses) -> let uu___6 = let uu___7 = - FStarC_Compiler_List.hd - ses in + FStarC_List.hd ses in uu___7 :: out in (env3, uu___6))) (env1, []) mandatory_members_decls in @@ -8374,7 +8313,7 @@ let rec (desugar_effect : FStarC_Syntax_Subst.close_binders binders in let actions1 = - FStarC_Compiler_List.map + FStarC_List.map (fun d1 -> match d1.FStarC_Parser_AST.d with | FStarC_Parser_AST.Tycon @@ -8408,7 +8347,7 @@ let rec (desugar_effect : let uu___15 = desugar_term env3 def in FStarC_Syntax_Subst.close - (FStarC_Compiler_List.op_At + (FStarC_List.op_At binders1 action_params2) uu___15 in @@ -8417,7 +8356,7 @@ let rec (desugar_effect : desugar_typ env3 cps_type in FStarC_Syntax_Subst.close - (FStarC_Compiler_List.op_At + (FStarC_List.op_At binders1 action_params2) uu___16 in @@ -8456,7 +8395,7 @@ let rec (desugar_effect : let uu___10 = desugar_term env3 defn in FStarC_Syntax_Subst.close - (FStarC_Compiler_List.op_At + (FStarC_List.op_At binders1 action_params2) uu___10 in @@ -8507,7 +8446,7 @@ let rec (desugar_effect : FStarC_Syntax_DsEnv.qualify env0 eff_name in let qualifiers = - FStarC_Compiler_List.map + FStarC_List.map (trans_qual d.FStarC_Parser_AST.drange (FStar_Pervasives_Native.Some mname)) quals in @@ -8559,21 +8498,21 @@ let rec (desugar_effect : if is_layered then (let has_subcomp = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun decl -> let uu___6 = name_of_eff_decl decl in uu___6 = "subcomp") eff_decls in let has_if_then_else = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun decl -> let uu___6 = name_of_eff_decl decl in uu___6 = "if_then_else") eff_decls in let has_close = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun decl -> let uu___6 = name_of_eff_decl decl in @@ -8601,7 +8540,7 @@ let rec (desugar_effect : (match uu___8 with | a::bs1 -> let uu___9 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___10 -> fun b -> match uu___10 @@ -8647,7 +8586,7 @@ let rec (desugar_effect : (allow_param && is_param), - (FStarC_Compiler_List.op_At + (FStarC_List.op_At bs2 [ { @@ -8761,7 +8700,7 @@ let rec (desugar_effect : ([], eff_t2))), uu___7)) else (let rr = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___7 -> match uu___7 with | FStarC_Syntax_Syntax.Reifiable @@ -8842,7 +8781,7 @@ let rec (desugar_effect : if for_free then (let uu___6 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___7 -> match uu___7 with | FStarC_Syntax_Syntax.Reifiable @@ -8901,7 +8840,7 @@ let rec (desugar_effect : FStarC_Syntax_DsEnv.push_sigelt env0 se in let env4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env5 -> fun a -> let uu___5 = @@ -8968,15 +8907,14 @@ and (desugar_redefine_effect : (FStarC_Syntax_DsEnv.try_lookup_effect_defn env2) lid in let uu___3 = - match FStarC_Compiler_List.rev args with + match FStarC_List.rev args with | (last_arg, uu___4)::args_rev -> let uu___5 = let uu___6 = unparen last_arg in uu___6.FStarC_Parser_AST.tm in (match uu___5 with | FStarC_Parser_AST.Attributes ts -> - (ts, - (FStarC_Compiler_List.rev args_rev)) + (ts, (FStarC_List.rev args_rev)) | uu___6 -> ([], args)) | uu___4 -> ([], args) in (match uu___3 with @@ -8990,8 +8928,8 @@ and (desugar_redefine_effect : let binders1 = FStarC_Syntax_Subst.close_binders binders in (if - (FStarC_Compiler_List.length args) <> - (FStarC_Compiler_List.length + (FStarC_List.length args) <> + (FStarC_List.length ed.FStarC_Syntax_Syntax.binders) then FStarC_Errors.raise_error @@ -9016,8 +8954,8 @@ and (desugar_redefine_effect : let uu___6 = FStarC_Syntax_Subst.shift_subst (shift_n + - (FStarC_Compiler_List.length - us)) ed_binders_opening in + (FStarC_List.length us)) + ed_binders_opening in FStarC_Syntax_Subst.subst uu___6 x in let s = FStarC_Syntax_Util.subst_of_list @@ -9040,10 +8978,10 @@ and (desugar_redefine_effect : sub ed.FStarC_Syntax_Syntax.combinators in let uu___7 = - FStarC_Compiler_List.map + FStarC_List.map (fun action -> let nparam = - FStarC_Compiler_List.length + FStarC_List.length action.FStarC_Syntax_Syntax.action_params in let uu___8 = FStarC_Syntax_DsEnv.qualify env2 @@ -9100,7 +9038,7 @@ and (desugar_redefine_effect : let uu___6 = trans_qual1 (FStar_Pervasives_Native.Some mname) in - FStarC_Compiler_List.map uu___6 quals in + FStarC_List.map uu___6 quals in let uu___6 = FStarC_Syntax_DsEnv.opens_and_abbrevs env2 in @@ -9123,7 +9061,7 @@ and (desugar_redefine_effect : let env3 = FStarC_Syntax_DsEnv.push_sigelt env0 se in let env4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env5 -> fun a -> let uu___5 = @@ -9135,7 +9073,7 @@ and (desugar_redefine_effect : ed1.FStarC_Syntax_Syntax.actions in let env5 = if - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Parser_AST.Reflectable quals then let reflect_lid = @@ -9183,14 +9121,13 @@ and (desugar_decl_maybe_fail_attr : fun env -> fun d -> let no_fail_attrs ats = - FStarC_Compiler_List.filter + FStarC_List.filter (fun at -> let uu___ = get_fail_attr1 false at in - FStarC_Compiler_Option.isNone uu___) ats in + FStarC_Option.isNone uu___) ats in let uu___ = let attrs = - FStarC_Compiler_List.map (desugar_term env) - d.FStarC_Parser_AST.attrs in + FStarC_List.map (desugar_term env) d.FStarC_Parser_AST.attrs in let attrs1 = FStarC_Syntax_Util.deduplicate_terms attrs in let uu___1 = get_fail_attr false attrs1 in match uu___1 with @@ -9217,7 +9154,7 @@ and (desugar_decl_maybe_fail_attr : (match (errs, r) with | ([], FStar_Pervasives_Native.Some (env1, ses)) -> let ses1 = - FStarC_Compiler_List.map + FStarC_List.map (fun se -> let uu___3 = no_fail_attrs attrs1 in { @@ -9260,7 +9197,7 @@ and (desugar_decl_maybe_fail_attr : (env0, [se]) | (errs1, ropt) -> let errnos = - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun i -> FStarC_Common.list_of_option i.FStarC_Errors.issue_number) errs1 in @@ -9268,11 +9205,9 @@ and (desugar_decl_maybe_fail_attr : FStarC_Options.print_expected_failures () in if uu___4 then - (FStarC_Compiler_Util.print_string - ">> Got issues: [\n"; - FStarC_Compiler_List.iter - FStarC_Errors.print_issue errs1; - FStarC_Compiler_Util.print_string ">>]\n") + (FStarC_Util.print_string ">> Got issues: [\n"; + FStarC_List.iter FStarC_Errors.print_issue errs1; + FStarC_Util.print_string ">>]\n") else ()); if expected_errs = [] then (env0, []) @@ -9283,8 +9218,8 @@ and (desugar_decl_maybe_fail_attr : match uu___5 with | FStar_Pervasives_Native.None -> (env0, []) | FStar_Pervasives_Native.Some (e, n1, n2) -> - (FStarC_Compiler_List.iter - FStarC_Errors.print_issue errs1; + (FStarC_List.iter FStarC_Errors.print_issue + errs1; (let uu___8 = let uu___9 = let uu___10 = @@ -9332,7 +9267,7 @@ and (desugar_decl_maybe_fail_attr : let uu___15 = FStarC_Class_Show.show FStarC_Class_Show.showable_int n1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Error #%s was raised %s times, instead of %s." uu___13 uu___14 uu___15 in FStarC_Errors_Msg.text uu___12 in @@ -9357,8 +9292,7 @@ and (desugar_decl : (let uu___1 = desugar_decl_maybe_fail_attr env d in match uu___1 with | (env1, ses) -> - let uu___2 = - FStarC_Compiler_List.map generalize_annotated_univs ses in + let uu___2 = FStarC_List.map generalize_annotated_univs ses in (env1, uu___2)) and (desugar_decl_core : FStarC_Syntax_DsEnv.env -> @@ -9514,12 +9448,12 @@ and (desugar_decl_core : else quals1 in let uu___ = let uu___1 = - FStarC_Compiler_List.map - (trans_qual1 FStar_Pervasives_Native.None) quals2 in + FStarC_List.map (trans_qual1 FStar_Pervasives_Native.None) + quals2 in desugar_tycon env d d_attrs uu___1 tcs in (match uu___ with | (env1, ses) -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_attrs in + ((let uu___2 = FStarC_Effect.op_Bang dbg_attrs in if uu___2 then let uu___3 = @@ -9529,8 +9463,8 @@ and (desugar_decl_core : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_sigelt) ses in - FStarC_Compiler_Util.print2 - "Desugared tycon from {%s} to {%s}\n" uu___3 uu___4 + FStarC_Util.print2 "Desugared tycon from {%s} to {%s}\n" + uu___3 uu___4 else ()); (let mkclass lid = let r = FStarC_Ident.range_of_lid lid in @@ -9594,7 +9528,7 @@ and (desugar_decl_core : [uu___3] in let formals = let bndl = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun uu___2 -> match uu___2 with | { @@ -9618,7 +9552,7 @@ and (desugar_decl_core : { FStarC_Syntax_Syntax.ses = ses1; FStarC_Syntax_Syntax.lids = uu___2;_} -> - FStarC_Compiler_Util.find_map ses1 + FStarC_Util.find_map ses1 (fun se -> match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -9646,9 +9580,7 @@ and (desugar_decl_core : | FStarC_Syntax_Syntax.Sig_bundle { FStarC_Syntax_Syntax.ses = ses1; FStarC_Syntax_Syntax.lids = uu___2;_} - -> - FStarC_Compiler_List.concatMap (splice_decl meths) - ses1 + -> FStarC_List.concatMap (splice_decl meths) ses1 | FStarC_Syntax_Syntax.Sig_inductive_typ { FStarC_Syntax_Syntax.lid = lid; FStarC_Syntax_Syntax.us = uu___2; @@ -9667,14 +9599,14 @@ and (desugar_decl_core : formals2 in let has_no_method_attr meth = let i = FStarC_Ident.ident_of_lid meth in - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun formal -> let uu___8 = FStarC_Ident.ident_equals i (formal.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.ppname in if uu___8 then - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun attr -> let uu___9 = let uu___10 = @@ -9688,7 +9620,7 @@ and (desugar_decl_core : formal.FStarC_Syntax_Syntax.binder_attrs else false) formals1 in let meths1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun x -> let uu___8 = has_no_method_attr x in Prims.op_Negation uu___8) meths in @@ -9723,16 +9655,14 @@ and (desugar_decl_core : let uu___2 = if typeclass then - let meths = - FStarC_Compiler_List.concatMap get_meths ses in + let meths = FStarC_List.concatMap get_meths ses in let rec add_class_attr se = match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_bundle { FStarC_Syntax_Syntax.ses = ses1; FStarC_Syntax_Syntax.lids = lids;_} -> - let ses2 = - FStarC_Compiler_List.map add_class_attr ses1 in + let ses2 = FStarC_List.map add_class_attr ses1 in let uu___3 = let uu___4 = let uu___5 = @@ -9785,19 +9715,17 @@ and (desugar_decl_core : (se.FStarC_Syntax_Syntax.sigopts) } | uu___3 -> se in - let uu___3 = - FStarC_Compiler_List.map add_class_attr ses in + let uu___3 = FStarC_List.map add_class_attr ses in let uu___4 = - FStarC_Compiler_List.concatMap (splice_decl meths) - ses in + FStarC_List.concatMap (splice_decl meths) ses in (uu___3, uu___4) else (ses, []) in match uu___2 with | (ses1, extra) -> let env2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left FStarC_Syntax_DsEnv.push_sigelt env1 extra in - (env2, (FStarC_Compiler_List.op_At ses1 extra))))) + (env2, (FStarC_List.op_At ses1 extra))))) | FStarC_Parser_AST.TopLevelLet (isrec, lets) -> let quals = d.FStarC_Parser_AST.quals in let expand_toplevel_pattern = @@ -9834,8 +9762,8 @@ and (desugar_decl_core : if Prims.op_Negation expand_toplevel_pattern then let lets1 = - FStarC_Compiler_List.map - (fun x -> (FStar_Pervasives_Native.None, x)) lets in + FStarC_List.map (fun x -> (FStar_Pervasives_Native.None, x)) + lets in let as_inner_let = let uu___ = let uu___1 = @@ -9860,13 +9788,13 @@ and (desugar_decl_core : FStarC_Syntax_Syntax.body1 = uu___3;_} -> let fvs = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname) (FStar_Pervasives_Native.snd lbs) in let uu___4 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun fv -> fun uu___5 -> match uu___5 with @@ -9877,26 +9805,24 @@ and (desugar_decl_core : (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in (match uu___6 with | (qs', ats') -> - ((FStarC_Compiler_List.rev_append - qs' qs), - (FStarC_Compiler_List.rev_append - ats' ats)))) fvs ([], []) in + ((FStarC_List.rev_append qs' qs), + (FStarC_List.rev_append ats' ats)))) + fvs ([], []) in (match uu___4 with | (val_quals, val_attrs) -> let top_attrs = FStarC_Syntax_Util.deduplicate_terms - (FStarC_Compiler_List.rev_append val_attrs - d_attrs) in + (FStarC_List.rev_append val_attrs d_attrs) in let lbs1 = let uu___5 = lbs in match uu___5 with | (isrec1, lbs0) -> let lbs01 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___6 = FStarC_Syntax_Util.deduplicate_terms - (FStarC_Compiler_List.rev_append + (FStarC_List.rev_append lb.FStarC_Syntax_Syntax.lbattrs top_attrs) in { @@ -9919,13 +9845,13 @@ and (desugar_decl_core : let quals1 = match quals with | uu___5::uu___6 -> - FStarC_Compiler_List.map + FStarC_List.map (trans_qual1 FStar_Pervasives_Native.None) quals | uu___5 -> val_quals in let quals2 = let uu___5 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___6 -> match uu___6 with | (uu___7, (uu___8, t)) -> @@ -9935,7 +9861,7 @@ and (desugar_decl_core : then FStarC_Syntax_Syntax.Logic :: quals1 else quals1 in let names = - FStarC_Compiler_List.map + FStarC_List.map (fun fv -> (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v) fvs in @@ -9975,8 +9901,7 @@ and (desugar_decl_core : match uu___1 with | (pat, body) -> let rec gen_fresh_toplevel_name uu___2 = - let nm = - FStarC_Ident.gen FStarC_Compiler_Range_Type.dummyRange in + let nm = FStarC_Ident.gen FStarC_Range_Type.dummyRange in let uu___3 = let uu___4 = let uu___5 = FStarC_Ident.lid_of_ids [nm] in @@ -9990,7 +9915,7 @@ and (desugar_decl_core : (FStarC_Parser_AST.PatVar (fresh_toplevel_name, FStar_Pervasives_Native.None, [])) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in match pat.FStarC_Parser_AST.pat with | FStarC_Parser_AST.PatAscribed (pat1, ty) -> { @@ -10003,7 +9928,7 @@ and (desugar_decl_core : let main_let = let quals1 = if - FStarC_Compiler_List.mem FStarC_Parser_AST.Private + FStarC_List.mem FStarC_Parser_AST.Private d.FStarC_Parser_AST.quals then d.FStarC_Parser_AST.quals else FStarC_Parser_AST.Private :: @@ -10053,7 +9978,7 @@ and (desugar_decl_core : FStarC_Parser_AST.mk_term (FStarC_Parser_AST.Const FStarC_Const.Const_unit) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange FStarC_Parser_AST.Expr in let bv_pat = let uu___4 = FStarC_Ident.range_of_id id in @@ -10091,7 +10016,7 @@ and (desugar_decl_core : (FStarC_Parser_AST.TopLevelLet (FStarC_Parser_AST.NoLetQualifier, [(bv_pat, body1)])) - FStarC_Compiler_Range_Type.dummyRange [] in + FStarC_Range_Type.dummyRange [] in let id_decl1 = { FStarC_Parser_AST.d = @@ -10108,8 +10033,7 @@ and (desugar_decl_core : let uu___4 = desugar_decl env1 id_decl1 in (match uu___4 with | (env2, ses') -> - (env2, - (FStarC_Compiler_List.op_At ses ses')))) in + (env2, (FStarC_List.op_At ses ses')))) in let build_projection uu___2 id = match uu___2 with | (env1, ses) -> @@ -10124,18 +10048,16 @@ and (desugar_decl_core : let uu___2 = gather_pattern_bound_vars pat in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic uu___2) in let uu___2 = - (FStarC_Compiler_List.isEmpty bvs) && + (FStarC_List.isEmpty bvs) && (let uu___3 = is_var_pattern pat in Prims.op_Negation uu___3) in if uu___2 then build_coverage_check main_let - else - FStarC_Compiler_List.fold_left build_projection main_let - bvs) + else FStarC_List.fold_left build_projection main_let bvs) | FStarC_Parser_AST.Assume (id, t) -> let f = desugar_formula env t in let lid = FStarC_Syntax_DsEnv.qualify env id in @@ -10172,8 +10094,8 @@ and (desugar_decl_core : let lid = FStarC_Syntax_DsEnv.qualify env id in let se = let uu___ = - FStarC_Compiler_List.map - (trans_qual1 FStar_Pervasives_Native.None) quals1 in + FStarC_List.map (trans_qual1 FStar_Pervasives_Native.None) + quals1 in let uu___1 = FStarC_Syntax_DsEnv.opens_and_abbrevs env in { FStarC_Syntax_Syntax.sigel = @@ -10259,9 +10181,9 @@ and (desugar_decl_core : let data_ops = mk_data_projector_names [] env1 se in let discs = mk_data_discriminators [] env1 [l] top_attrs in let env2 = - FStarC_Compiler_List.fold_left FStarC_Syntax_DsEnv.push_sigelt - env1 (FStarC_Compiler_List.op_At discs data_ops) in - (env2, (FStarC_Compiler_List.op_At (se' :: discs) data_ops)) + FStarC_List.fold_left FStarC_Syntax_DsEnv.push_sigelt env1 + (FStarC_List.op_At discs data_ops) in + (env2, (FStarC_List.op_At (se' :: discs) data_ops)) | FStarC_Parser_AST.NewEffect (FStarC_Parser_AST.RedefineEffect (eff_name, eff_binders, defn)) -> let quals = d.FStarC_Parser_AST.quals in @@ -10469,8 +10391,7 @@ and (desugar_decl_core : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.map - (FStarC_Syntax_DsEnv.qualify env) ids1 in + FStarC_List.map (FStarC_Syntax_DsEnv.qualify env) ids1 in { FStarC_Syntax_Syntax.is_typed = is_typed; FStarC_Syntax_Syntax.lids2 = uu___2; @@ -10478,8 +10399,7 @@ and (desugar_decl_core : } in FStarC_Syntax_Syntax.Sig_splice uu___1 in let uu___1 = - FStarC_Compiler_List.map - (trans_qual1 FStar_Pervasives_Native.None) + FStarC_List.map (trans_qual1 FStar_Pervasives_Native.None) d.FStarC_Parser_AST.quals in let uu___2 = FStarC_Syntax_DsEnv.opens_and_abbrevs env in { @@ -10506,7 +10426,7 @@ and (desugar_decl_core : (match extension_parser with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 "Unknown syntax extension %s" + FStarC_Util.format1 "Unknown syntax extension %s" extension_name in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range range @@ -10534,10 +10454,10 @@ and (desugar_decl_core : (Obj.magic error.FStarC_Parser_AST_Util.message) | FStar_Pervasives.Inr d' -> let quals = - FStarC_Compiler_List.op_At d'.FStarC_Parser_AST.quals + FStarC_List.op_At d'.FStarC_Parser_AST.quals d.FStarC_Parser_AST.quals in let attrs = - FStarC_Compiler_List.op_At d'.FStarC_Parser_AST.attrs + FStarC_List.op_At d'.FStarC_Parser_AST.attrs d.FStarC_Parser_AST.attrs in desugar_decl_maybe_fail_attr env { @@ -10555,7 +10475,7 @@ and (desugar_decl_core : (match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Could not find desugaring callback for extension %s" tbs.FStarC_Parser_AST.lang_name in FStarC_Errors.raise_error FStarC_Parser_AST.hasRange_decl d @@ -10582,7 +10502,7 @@ and (desugar_decl_core : else sigel in let se = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (trans_qual1 FStar_Pervasives_Native.None) d.FStarC_Parser_AST.quals in let uu___2 = FStarC_Syntax_DsEnv.opens_and_abbrevs env in @@ -10600,15 +10520,15 @@ and (desugar_decl_core : } in se in let lids = - FStarC_Compiler_List.map (FStarC_Syntax_DsEnv.qualify env) + FStarC_List.map (FStarC_Syntax_DsEnv.qualify env) tbs.FStarC_Parser_AST.idents in let sigelts' = desugar env tbs.FStarC_Parser_AST.blob lids d.FStarC_Parser_AST.drange in - let sigelts = FStarC_Compiler_List.map mk_sig sigelts' in + let sigelts = FStarC_List.map mk_sig sigelts' in let env1 = - FStarC_Compiler_List.fold_left - FStarC_Syntax_DsEnv.push_sigelt env sigelts in + FStarC_List.fold_left FStarC_Syntax_DsEnv.push_sigelt env + sigelts in (env1, sigelts)) let (desugar_decls : env_t -> @@ -10618,7 +10538,7 @@ let (desugar_decls : fun env -> fun decls -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun d -> match uu___1 with @@ -10626,10 +10546,9 @@ let (desugar_decls : let uu___2 = desugar_decl env1 d in (match uu___2 with | (env2, se) -> - (env2, (FStarC_Compiler_List.rev_append se sigelts)))) + (env2, (FStarC_List.rev_append se sigelts)))) (env, []) decls in - match uu___ with - | (env1, sigelts) -> (env1, (FStarC_Compiler_List.rev sigelts)) + match uu___ with | (env1, sigelts) -> (env1, (FStarC_List.rev sigelts)) let (desugar_modul_common : FStarC_Syntax_Syntax.modul FStar_Pervasives_Native.option -> FStarC_Syntax_DsEnv.env -> @@ -10697,9 +10616,9 @@ let (desugar_partial_modul : (let uu___1 = let uu___2 = let uu___3 = FStarC_Options.file_list () in - FStarC_Compiler_List.hd uu___3 in - FStarC_Compiler_Util.get_file_extension uu___2 in - FStarC_Compiler_List.mem uu___1 ["fsti"; "fsi"]) in + FStarC_List.hd uu___3 in + FStarC_Util.get_file_extension uu___2 in + FStarC_List.mem uu___1 ["fsti"; "fsi"]) in if uu___ then as_interface m else m in let uu___ = desugar_modul_common curmod env m1 in match uu___ with @@ -10738,8 +10657,8 @@ let (desugar_modul : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_modul modul1 in - FStarC_Compiler_Util.print1 - "Module after desugaring:\n%s\n" uu___6 + FStarC_Util.print1 "Module after desugaring:\n%s\n" + uu___6 else ()); (let uu___5 = if pop_when_done @@ -10815,7 +10734,7 @@ let (add_modul_to_env_core : FStarC_Syntax_Syntax.t_unit; FStarC_Syntax_Syntax.rc_opt = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in erase_univs uu___1 in let uu___1 = let uu___2 = FStarC_Syntax_Subst.compress t in @@ -10845,8 +10764,7 @@ let (add_modul_to_env_core : let t1 = let uu___3 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length us) - binders_opening in + (FStarC_List.length us) binders_opening in FStarC_Syntax_Subst.subst uu___3 t in let uu___3 = let uu___4 = erase_univs t1 in @@ -10855,7 +10773,7 @@ let (add_modul_to_env_core : let erase_action action = let opening = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length + (FStarC_List.length action.FStarC_Syntax_Syntax.action_univs) binders_opening in let erased_action_params = @@ -10876,7 +10794,7 @@ let (add_modul_to_env_core : FStarC_Syntax_Syntax.t_unit; FStarC_Syntax_Syntax.rc_opt = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in let uu___3 = let uu___4 = let uu___5 = @@ -10918,7 +10836,7 @@ let (add_modul_to_env_core : FStarC_Syntax_Util.apply_eff_combinators erase_tscheme ed.FStarC_Syntax_Syntax.combinators in let uu___5 = - FStarC_Compiler_List.map erase_action + FStarC_List.map erase_action ed.FStarC_Syntax_Syntax.actions in { FStarC_Syntax_Syntax.mname = @@ -10971,7 +10889,7 @@ let (add_modul_to_env_core : let uu___1 = FStarC_Syntax_DsEnv.set_current_module en1 m.FStarC_Syntax_Syntax.name in - FStarC_Compiler_List.fold_left push_sigelt uu___1 + FStarC_List.fold_left push_sigelt uu___1 m.FStarC_Syntax_Syntax.declarations in let en3 = if finish then FStarC_Syntax_DsEnv.finish en2 m else en2 in diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Cfg.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Cfg.ml similarity index 79% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Cfg.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Cfg.ml index 675106e440b..ddf4fcde7a1 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Cfg.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Cfg.ml @@ -12,11 +12,12 @@ type fsteps = unfold_until: FStarC_Syntax_Syntax.delta_depth FStar_Pervasives_Native.option ; unfold_only: FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option ; + unfold_once: FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option ; unfold_fully: FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option ; unfold_attr: FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option ; unfold_qual: Prims.string Prims.list FStar_Pervasives_Native.option ; unfold_namespace: - (Prims.string, Prims.bool) FStarC_Compiler_Path.forest + (Prims.string, Prims.bool) FStarC_Path.forest FStar_Pervasives_Native.option ; dont_unfold_attr: @@ -42,380 +43,416 @@ let (__proj__Mkfsteps__item__beta : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> beta + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> beta let (__proj__Mkfsteps__item__iota : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> iota + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> iota let (__proj__Mkfsteps__item__zeta : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> zeta + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> zeta let (__proj__Mkfsteps__item__zeta_full : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> zeta_full + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + zeta_full let (__proj__Mkfsteps__item__weak : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> weak + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> weak let (__proj__Mkfsteps__item__hnf : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> hnf + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> hnf let (__proj__Mkfsteps__item__primops : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> primops + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + primops let (__proj__Mkfsteps__item__do_not_unfold_pure_lets : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> do_not_unfold_pure_lets + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + do_not_unfold_pure_lets let (__proj__Mkfsteps__item__unfold_until : fsteps -> FStarC_Syntax_Syntax.delta_depth FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unfold_until + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unfold_until let (__proj__Mkfsteps__item__unfold_only : fsteps -> FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unfold_only + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unfold_only +let (__proj__Mkfsteps__item__unfold_once : + fsteps -> FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option) = + fun projectee -> + match projectee with + | { beta; iota; zeta; zeta_full; weak; hnf; primops; + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unfold_once let (__proj__Mkfsteps__item__unfold_fully : fsteps -> FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unfold_fully + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unfold_fully let (__proj__Mkfsteps__item__unfold_attr : fsteps -> FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unfold_attr + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unfold_attr let (__proj__Mkfsteps__item__unfold_qual : fsteps -> Prims.string Prims.list FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unfold_qual + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unfold_qual let (__proj__Mkfsteps__item__unfold_namespace : fsteps -> - (Prims.string, Prims.bool) FStarC_Compiler_Path.forest + (Prims.string, Prims.bool) FStarC_Path.forest FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unfold_namespace + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unfold_namespace let (__proj__Mkfsteps__item__dont_unfold_attr : fsteps -> FStarC_Ident.lid Prims.list FStar_Pervasives_Native.option) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> dont_unfold_attr + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + dont_unfold_attr let (__proj__Mkfsteps__item__pure_subterms_within_computations : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> pure_subterms_within_computations let (__proj__Mkfsteps__item__simplify : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> simplify + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + simplify let (__proj__Mkfsteps__item__erase_universes : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> erase_universes + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + erase_universes let (__proj__Mkfsteps__item__allow_unbound_universes : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> allow_unbound_universes + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + allow_unbound_universes let (__proj__Mkfsteps__item__reify_ : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> reify_ + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> reify_ let (__proj__Mkfsteps__item__compress_uvars : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> compress_uvars + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + compress_uvars let (__proj__Mkfsteps__item__no_full_norm : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> no_full_norm + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + no_full_norm let (__proj__Mkfsteps__item__check_no_uvars : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> check_no_uvars + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + check_no_uvars let (__proj__Mkfsteps__item__unmeta : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unmeta + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> unmeta let (__proj__Mkfsteps__item__unascribe : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unascribe + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unascribe let (__proj__Mkfsteps__item__in_full_norm_request : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> in_full_norm_request + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + in_full_norm_request let (__proj__Mkfsteps__item__weakly_reduce_scrutinee : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> weakly_reduce_scrutinee + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + weakly_reduce_scrutinee let (__proj__Mkfsteps__item__nbe_step : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> nbe_step + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + nbe_step let (__proj__Mkfsteps__item__for_extraction : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> for_extraction + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + for_extraction let (__proj__Mkfsteps__item__unrefine : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> unrefine + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + unrefine let (__proj__Mkfsteps__item__default_univs_to_zero : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> default_univs_to_zero + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + default_univs_to_zero let (__proj__Mkfsteps__item__tactics : fsteps -> Prims.bool) = fun projectee -> match projectee with | { beta; iota; zeta; zeta_full; weak; hnf; primops; - do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_fully; - unfold_attr; unfold_qual; unfold_namespace; dont_unfold_attr; - pure_subterms_within_computations; simplify; erase_universes; - allow_unbound_universes; reify_; compress_uvars; no_full_norm; - check_no_uvars; unmeta; unascribe; in_full_norm_request; - weakly_reduce_scrutinee; nbe_step; for_extraction; unrefine; - default_univs_to_zero; tactics;_} -> tactics + do_not_unfold_pure_lets; unfold_until; unfold_only; unfold_once; + unfold_fully; unfold_attr; unfold_qual; unfold_namespace; + dont_unfold_attr; pure_subterms_within_computations; simplify; + erase_universes; allow_unbound_universes; reify_; compress_uvars; + no_full_norm; check_no_uvars; unmeta; unascribe; + in_full_norm_request; weakly_reduce_scrutinee; nbe_step; + for_extraction; unrefine; default_univs_to_zero; tactics;_} -> + tactics let (steps_to_string : fsteps -> Prims.string) = fun f -> let format_opt f1 o = match o with | FStar_Pervasives_Native.None -> "None" | FStar_Pervasives_Native.Some x -> - let uu___ = - let uu___1 = f1 x in FStarC_Compiler_String.op_Hat uu___1 ")" in - FStarC_Compiler_String.op_Hat "Some (" uu___ in - let b = FStarC_Compiler_Util.string_of_bool in + let uu___ = let uu___1 = f1 x in FStarC_String.op_Hat uu___1 ")" in + FStarC_String.op_Hat "Some (" uu___ in + let b = FStarC_Util.string_of_bool in let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool f.beta in @@ -463,122 +500,133 @@ let (steps_to_string : fsteps -> Prims.string) = (FStarC_Class_Show.show_option (FStarC_Class_Show.show_list FStarC_Ident.showable_lident)) - f.unfold_fully in + f.unfold_once in let uu___22 = let uu___23 = FStarC_Class_Show.show (FStarC_Class_Show.show_option (FStarC_Class_Show.show_list FStarC_Ident.showable_lident)) - f.unfold_attr in + f.unfold_fully in let uu___24 = let uu___25 = FStarC_Class_Show.show (FStarC_Class_Show.show_option (FStarC_Class_Show.show_list - FStarC_Class_Show.showable_string)) - f.unfold_qual in + FStarC_Ident.showable_lident)) + f.unfold_attr in let uu___26 = let uu___27 = FStarC_Class_Show.show (FStarC_Class_Show.show_option - (FStarC_Class_Show.show_tuple2 - (FStarC_Class_Show.show_list - (FStarC_Class_Show.show_tuple2 - (FStarC_Class_Show.show_list - FStarC_Class_Show.showable_string) - FStarC_Class_Show.showable_bool)) - FStarC_Class_Show.showable_bool)) - f.unfold_namespace in + (FStarC_Class_Show.show_list + FStarC_Class_Show.showable_string)) + f.unfold_qual in let uu___28 = let uu___29 = FStarC_Class_Show.show (FStarC_Class_Show.show_option - (FStarC_Class_Show.show_list - FStarC_Ident.showable_lident)) - f.dont_unfold_attr in + (FStarC_Class_Show.show_tuple2 + (FStarC_Class_Show.show_list + (FStarC_Class_Show.show_tuple2 + (FStarC_Class_Show.show_list + FStarC_Class_Show.showable_string) + FStarC_Class_Show.showable_bool)) + FStarC_Class_Show.showable_bool)) + f.unfold_namespace in let uu___30 = let uu___31 = FStarC_Class_Show.show - FStarC_Class_Show.showable_bool - f.pure_subterms_within_computations in + (FStarC_Class_Show.show_option + (FStarC_Class_Show.show_list + FStarC_Ident.showable_lident)) + f.dont_unfold_attr in let uu___32 = let uu___33 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.simplify in + f.pure_subterms_within_computations in let uu___34 = let uu___35 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.erase_universes in + f.simplify in let uu___36 = let uu___37 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.allow_unbound_universes in + f.erase_universes in let uu___38 = let uu___39 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.reify_ in + f.allow_unbound_universes in let uu___40 = let uu___41 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.compress_uvars in + f.reify_ in let uu___42 = let uu___43 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.no_full_norm in + f.compress_uvars in let uu___44 = let uu___45 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.check_no_uvars in + f.no_full_norm in let uu___46 = let uu___47 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.unmeta in + f.check_no_uvars in let uu___48 = let uu___49 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.unascribe in + f.unmeta in let uu___50 = let uu___51 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.in_full_norm_request in + f.unascribe in let uu___52 = let uu___53 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.weakly_reduce_scrutinee in + f.in_full_norm_request in let uu___54 = let uu___55 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.for_extraction in + f.weakly_reduce_scrutinee in let uu___56 = let uu___57 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.unrefine in + f.for_extraction in let uu___58 = let uu___59 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool - f.default_univs_to_zero in + f.unrefine in let uu___60 = let uu___61 + = + FStarC_Class_Show.show + FStarC_Class_Show.showable_bool + f.default_univs_to_zero in + let uu___62 + = + let uu___63 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool f.tactics in - [uu___61] in + [uu___63] in + uu___61 :: + uu___62 in uu___59 :: uu___60 in uu___57 :: @@ -612,8 +660,8 @@ let (steps_to_string : fsteps -> Prims.string) = uu___5 :: uu___6 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStarC_Compiler_Util.format - "{\nbeta = %s;\niota = %s;\nzeta = %s;\nzeta_full = %s;\nweak = %s;\nhnf = %s;\nprimops = %s;\ndo_not_unfold_pure_lets = %s;\nunfold_until = %s;\nunfold_only = %s;\nunfold_fully = %s;\nunfold_attr = %s;\nunfold_qual = %s;\nunfold_namespace = %s;\ndont_unfold_attr = %s;\npure_subterms_within_computations = %s;\nsimplify = %s;\nerase_universes = %s;\nallow_unbound_universes = %s;\nreify_ = %s;\ncompress_uvars = %s;\nno_full_norm = %s;\ncheck_no_uvars = %s;\nunmeta = %s;\nunascribe = %s;\nin_full_norm_request = %s;\nweakly_reduce_scrutinee = %s;\nfor_extraction = %s;\nunrefine = %s;\ndefault_univs_to_zero = %s;\ntactics = %s;\n}" + FStarC_Util.format + "{\nbeta = %s;\niota = %s;\nzeta = %s;\nzeta_full = %s;\nweak = %s;\nhnf = %s;\nprimops = %s;\ndo_not_unfold_pure_lets = %s;\nunfold_until = %s;\nunfold_only = %s;\nunfold_once = %s;\nunfold_fully = %s;\nunfold_attr = %s;\nunfold_qual = %s;\nunfold_namespace = %s;\ndont_unfold_attr = %s;\npure_subterms_within_computations = %s;\nsimplify = %s;\nerase_universes = %s;\nallow_unbound_universes = %s;\nreify_ = %s;\ncompress_uvars = %s;\nno_full_norm = %s;\ncheck_no_uvars = %s;\nunmeta = %s;\nunascribe = %s;\nin_full_norm_request = %s;\nweakly_reduce_scrutinee = %s;\nfor_extraction = %s;\nunrefine = %s;\ndefault_univs_to_zero = %s;\ntactics = %s;\n}" uu___ let (deq_fsteps : fsteps FStarC_Class_Deq.deq) = { @@ -799,6 +847,7 @@ let (default_steps : fsteps) = do_not_unfold_pure_lets = false; unfold_until = FStar_Pervasives_Native.None; unfold_only = FStar_Pervasives_Native.None; + unfold_once = FStar_Pervasives_Native.None; unfold_fully = FStar_Pervasives_Native.None; unfold_attr = FStar_Pervasives_Native.None; unfold_qual = FStar_Pervasives_Native.None; @@ -838,6 +887,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -874,6 +924,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -910,6 +961,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -946,6 +998,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -982,6 +1035,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1018,6 +1072,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1054,6 +1109,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1091,6 +1147,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1127,6 +1184,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1163,6 +1221,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1201,6 +1260,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = true; unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1237,6 +1297,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (FStar_Pervasives_Native.Some d); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1273,6 +1334,44 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (FStar_Pervasives_Native.Some lids); + unfold_once = (fs.unfold_once); + unfold_fully = (fs.unfold_fully); + unfold_attr = (fs.unfold_attr); + unfold_qual = (fs.unfold_qual); + unfold_namespace = (fs.unfold_namespace); + dont_unfold_attr = (fs.dont_unfold_attr); + pure_subterms_within_computations = + (fs.pure_subterms_within_computations); + simplify = (fs.simplify); + erase_universes = (fs.erase_universes); + allow_unbound_universes = (fs.allow_unbound_universes); + reify_ = (fs.reify_); + compress_uvars = (fs.compress_uvars); + no_full_norm = (fs.no_full_norm); + check_no_uvars = (fs.check_no_uvars); + unmeta = (fs.unmeta); + unascribe = (fs.unascribe); + in_full_norm_request = (fs.in_full_norm_request); + weakly_reduce_scrutinee = (fs.weakly_reduce_scrutinee); + nbe_step = (fs.nbe_step); + for_extraction = (fs.for_extraction); + unrefine = (fs.unrefine); + default_univs_to_zero = (fs.default_univs_to_zero); + tactics = (fs.tactics) + } + | FStarC_TypeChecker_Env.UnfoldOnce lids -> + { + beta = (fs.beta); + iota = (fs.iota); + zeta = (fs.zeta); + zeta_full = (fs.zeta_full); + weak = (fs.weak); + hnf = (fs.hnf); + primops = (fs.primops); + do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); + unfold_until = (fs.unfold_until); + unfold_only = (fs.unfold_only); + unfold_once = (FStar_Pervasives_Native.Some lids); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1309,6 +1408,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (FStar_Pervasives_Native.Some lids); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1345,6 +1445,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (FStar_Pervasives_Native.Some lids); unfold_qual = (fs.unfold_qual); @@ -1382,6 +1483,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (FStar_Pervasives_Native.Some strs); @@ -1406,9 +1508,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = default_univs_to_zero = (fs.default_univs_to_zero); tactics = (fs.tactics) } in - if - FStarC_Compiler_List.contains "pure_subterms_within_computations" - strs + if FStarC_List.contains "pure_subterms_within_computations" strs then { beta = (fs1.beta); @@ -1421,6 +1521,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs1.do_not_unfold_pure_lets); unfold_until = (fs1.unfold_until); unfold_only = (fs1.unfold_only); + unfold_once = (fs1.unfold_once); unfold_fully = (fs1.unfold_fully); unfold_attr = (fs1.unfold_attr); unfold_qual = (fs1.unfold_qual); @@ -1449,7 +1550,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun s1 -> let uu___3 = FStarC_Ident.path_of_text s1 in (uu___3, true)) strs in @@ -1466,6 +1567,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1502,6 +1604,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1538,6 +1641,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1573,6 +1677,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1609,6 +1714,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1645,6 +1751,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1681,6 +1788,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1717,6 +1825,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1753,6 +1862,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1789,6 +1899,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1825,6 +1936,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1861,6 +1973,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1897,6 +2010,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1933,6 +2047,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -1969,6 +2084,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -2006,6 +2122,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -2042,6 +2159,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = do_not_unfold_pure_lets = (fs.do_not_unfold_pure_lets); unfold_until = (fs.unfold_until); unfold_only = (fs.unfold_only); + unfold_once = (fs.unfold_once); unfold_fully = (fs.unfold_fully); unfold_attr = (fs.unfold_attr); unfold_qual = (fs.unfold_qual); @@ -2067,7 +2185,7 @@ let (fstep_add_one : FStarC_TypeChecker_Env.step -> fsteps -> fsteps) = tactics = true } let (to_fsteps : FStarC_TypeChecker_Env.step Prims.list -> fsteps) = - fun s -> FStarC_Compiler_List.fold_right fstep_add_one s default_steps + fun s -> FStarC_List.fold_right fstep_add_one s default_steps type debug_switches = { gen: Prims.bool ; @@ -2164,7 +2282,7 @@ type cfg = debug: debug_switches ; delta_level: FStarC_TypeChecker_Env.delta_level Prims.list ; primitive_steps: - FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Compiler_Util.psmap ; + FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Util.psmap ; strong: Prims.bool ; memoize_lazy: Prims.bool ; normalize_pure_lets: Prims.bool ; @@ -2196,9 +2314,7 @@ let (__proj__Mkcfg__item__delta_level : memoize_lazy; normalize_pure_lets; reifying; compat_memo_ignore_cfg;_} -> delta_level let (__proj__Mkcfg__item__primitive_steps : - cfg -> - FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Compiler_Util.psmap) - = + cfg -> FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Util.psmap) = fun projectee -> match projectee with | { steps; tcenv; debug; delta_level; primitive_steps; strong; @@ -2235,40 +2351,39 @@ let (__proj__Mkcfg__item__compat_memo_ignore_cfg : cfg -> Prims.bool) = memoize_lazy; normalize_pure_lets; reifying; compat_memo_ignore_cfg;_} -> compat_memo_ignore_cfg type prim_step_set = - FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Compiler_Util.psmap + FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Util.psmap let (empty_prim_steps : unit -> prim_step_set) = - fun uu___ -> FStarC_Compiler_Util.psmap_empty () + fun uu___ -> FStarC_Util.psmap_empty () let (add_step : FStarC_TypeChecker_Primops_Base.primitive_step -> prim_step_set -> - FStarC_TypeChecker_Primops_Base.primitive_step - FStarC_Compiler_Util.psmap) + FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Util.psmap) = fun s -> fun ss -> let uu___ = FStarC_Ident.string_of_lid s.FStarC_TypeChecker_Primops_Base.name in - FStarC_Compiler_Util.psmap_add ss uu___ s + FStarC_Util.psmap_add ss uu___ s let (merge_steps : prim_step_set -> prim_step_set -> prim_step_set) = - fun s1 -> fun s2 -> FStarC_Compiler_Util.psmap_merge s1 s2 + fun s1 -> fun s2 -> FStarC_Util.psmap_merge s1 s2 let (add_steps : prim_step_set -> FStarC_TypeChecker_Primops_Base.primitive_step Prims.list -> prim_step_set) - = fun m -> fun l -> FStarC_Compiler_List.fold_right add_step l m + = fun m -> fun l -> FStarC_List.fold_right add_step l m let (prim_from_list : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list -> prim_step_set) = fun l -> let uu___ = empty_prim_steps () in add_steps uu___ l let (built_in_primitive_steps : - FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Compiler_Util.psmap) - = prim_from_list FStarC_TypeChecker_Primops.built_in_primitive_steps_list + FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Util.psmap) = + prim_from_list FStarC_TypeChecker_Primops.built_in_primitive_steps_list let (env_dependent_ops : FStarC_TypeChecker_Env.env_t -> prim_step_set) = fun env -> let uu___ = FStarC_TypeChecker_Primops.env_dependent_ops env in prim_from_list uu___ let (simplification_steps : FStarC_TypeChecker_Env.env_t -> - FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Compiler_Util.psmap) + FStarC_TypeChecker_Primops_Base.primitive_step FStarC_Util.psmap) = fun env -> let uu___ = FStarC_TypeChecker_Primops.simplification_ops_list env in @@ -2281,7 +2396,7 @@ let (showable_cfg : cfg FStarC_Class_Show.showable) = let uu___1 = let uu___2 = let uu___3 = steps_to_string cfg1.steps in - FStarC_Compiler_Util.format1 " steps = %s;" uu___3 in + FStarC_Util.format1 " steps = %s;" uu___3 in let uu___3 = let uu___4 = let uu___5 = @@ -2289,11 +2404,11 @@ let (showable_cfg : cfg FStarC_Class_Show.showable) = (FStarC_Class_Show.show_list FStarC_TypeChecker_Env.showable_delta_level) cfg1.delta_level in - FStarC_Compiler_Util.format1 " delta_level = %s;" uu___5 in + FStarC_Util.format1 " delta_level = %s;" uu___5 in [uu___4; "}"] in uu___2 :: uu___3 in "{" :: uu___1 in - FStarC_Compiler_String.concat "\n" uu___) + FStarC_String.concat "\n" uu___) } let (cfg_env : cfg -> FStarC_TypeChecker_Env.env) = fun cfg1 -> cfg1.tcenv let (find_prim_step : @@ -2307,7 +2422,7 @@ let (find_prim_step : let uu___ = FStarC_Ident.string_of_lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.psmap_try_find cfg1.primitive_steps uu___ + FStarC_Util.psmap_try_find cfg1.primitive_steps uu___ let (is_prim_step : cfg -> FStarC_Syntax_Syntax.fv -> Prims.bool) = fun cfg1 -> fun fv -> @@ -2315,8 +2430,8 @@ let (is_prim_step : cfg -> FStarC_Syntax_Syntax.fv -> Prims.bool) = let uu___1 = FStarC_Ident.string_of_lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.psmap_try_find cfg1.primitive_steps uu___1 in - FStarC_Compiler_Util.is_some uu___ + FStarC_Util.psmap_try_find cfg1.primitive_steps uu___1 in + FStarC_Util.is_some uu___ let (log : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).gen then f () else () let (log_top : cfg -> (unit -> unit) -> unit) = @@ -2325,50 +2440,48 @@ let (log_cfg : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).cfg then f () else () let (log_primops : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).primop then f () else () -let (dbg_unfolding : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Unfolding" +let (dbg_unfolding : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Unfolding" let (log_unfolding : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> - let uu___ = FStarC_Compiler_Effect.op_Bang dbg_unfolding in + let uu___ = FStarC_Effect.op_Bang dbg_unfolding in if uu___ then f () else () let (log_nbe : cfg -> (unit -> unit) -> unit) = fun cfg1 -> fun f -> if (cfg1.debug).debug_nbe then f () else () -let (primop_time_map : Prims.int FStarC_Compiler_Util.smap) = - FStarC_Compiler_Util.smap_create (Prims.of_int (50)) +let (primop_time_map : Prims.int FStarC_Util.smap) = + FStarC_Util.smap_create (Prims.of_int (50)) let (primop_time_reset : unit -> unit) = - fun uu___ -> FStarC_Compiler_Util.smap_clear primop_time_map + fun uu___ -> FStarC_Util.smap_clear primop_time_map let (primop_time_count : Prims.string -> Prims.int -> unit) = fun nm -> fun ns -> - let uu___ = FStarC_Compiler_Util.smap_try_find primop_time_map nm in + let uu___ = FStarC_Util.smap_try_find primop_time_map nm in match uu___ with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Util.smap_add primop_time_map nm ns + FStarC_Util.smap_add primop_time_map nm ns | FStar_Pervasives_Native.Some ns0 -> - FStarC_Compiler_Util.smap_add primop_time_map nm (ns0 + ns) + FStarC_Util.smap_add primop_time_map nm (ns0 + ns) let (fixto : Prims.int -> Prims.string -> Prims.string) = fun n -> fun s -> - if (FStarC_Compiler_String.length s) < n + if (FStarC_String.length s) < n then - let uu___ = - FStarC_Compiler_String.make (n - (FStarC_Compiler_String.length s)) - 32 in - FStarC_Compiler_String.op_Hat uu___ s + let uu___ = FStarC_String.make (n - (FStarC_String.length s)) 32 in + FStarC_String.op_Hat uu___ s else s let (primop_time_report : unit -> Prims.string) = fun uu___ -> let pairs = - FStarC_Compiler_Util.smap_fold primop_time_map + FStarC_Util.smap_fold primop_time_map (fun nm -> fun ns -> fun rest -> (nm, ns) :: rest) [] in let pairs1 = - FStarC_Compiler_Util.sort_with + FStarC_Util.sort_with (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with | ((uu___3, t1), (uu___4, t2)) -> t1 - t2) pairs in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___1 -> fun rest -> match uu___1 with @@ -2376,29 +2489,26 @@ let (primop_time_report : unit -> Prims.string) = let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_Util.string_of_int + FStarC_Util.string_of_int (ns / (Prims.parse_int "1000000")) in fixto (Prims.of_int (10)) uu___4 in - FStarC_Compiler_Util.format2 "%sms --- %s\n" uu___3 nm in - FStarC_Compiler_String.op_Hat uu___2 rest) pairs1 "" -let (extendable_primops_dirty : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref true + FStarC_Util.format2 "%sms --- %s\n" uu___3 nm in + FStarC_String.op_Hat uu___2 rest) pairs1 "" +let (extendable_primops_dirty : Prims.bool FStarC_Effect.ref) = + FStarC_Util.mk_ref true type register_prim_step_t = FStarC_TypeChecker_Primops_Base.primitive_step -> unit type retrieve_prim_step_t = unit -> prim_step_set let (mk_extendable_primop_set : unit -> (register_prim_step_t * retrieve_prim_step_t)) = fun uu___ -> - let steps = - let uu___1 = empty_prim_steps () in FStarC_Compiler_Util.mk_ref uu___1 in + let steps = let uu___1 = empty_prim_steps () in FStarC_Util.mk_ref uu___1 in let register p = - FStarC_Compiler_Effect.op_Colon_Equals extendable_primops_dirty true; + FStarC_Effect.op_Colon_Equals extendable_primops_dirty true; (let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang steps in - add_step p uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals steps uu___2) in - let retrieve uu___1 = FStarC_Compiler_Effect.op_Bang steps in - (register, retrieve) + let uu___3 = FStarC_Effect.op_Bang steps in add_step p uu___3 in + FStarC_Effect.op_Colon_Equals steps uu___2) in + let retrieve uu___1 = FStarC_Effect.op_Bang steps in (register, retrieve) let (plugins : (register_prim_step_t * retrieve_prim_step_t)) = mk_extendable_primop_set () let (extra_steps : (register_prim_step_t * retrieve_prim_step_t)) = @@ -2426,10 +2536,9 @@ let (list_extra_steps : fun uu___ -> let uu___1 = retrieve_extra_steps () in FStarC_Common.psmap_values uu___1 let (cached_steps : unit -> prim_step_set) = - let memo = - let uu___ = empty_prim_steps () in FStarC_Compiler_Util.mk_ref uu___ in + let memo = let uu___ = empty_prim_steps () in FStarC_Util.mk_ref uu___ in fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang extendable_primops_dirty in + let uu___1 = FStarC_Effect.op_Bang extendable_primops_dirty in if uu___1 then let steps = @@ -2437,10 +2546,10 @@ let (cached_steps : unit -> prim_step_set) = let uu___3 = retrieve_plugins () in let uu___4 = retrieve_extra_steps () in merge_steps uu___3 uu___4 in merge_steps built_in_primitive_steps uu___2 in - (FStarC_Compiler_Effect.op_Colon_Equals memo steps; - FStarC_Compiler_Effect.op_Colon_Equals extendable_primops_dirty false; + (FStarC_Effect.op_Colon_Equals memo steps; + FStarC_Effect.op_Colon_Equals extendable_primops_dirty false; steps) - else FStarC_Compiler_Effect.op_Bang memo + else FStarC_Effect.op_Bang memo let (add_nbe : fsteps -> fsteps) = fun s -> let uu___ = FStarC_Options.use_nbe () in @@ -2457,6 +2566,7 @@ let (add_nbe : fsteps -> fsteps) = do_not_unfold_pure_lets = (s.do_not_unfold_pure_lets); unfold_until = (s.unfold_until); unfold_only = (s.unfold_only); + unfold_once = (s.unfold_once); unfold_fully = (s.unfold_fully); unfold_attr = (s.unfold_attr); unfold_qual = (s.unfold_qual); @@ -2482,28 +2592,25 @@ let (add_nbe : fsteps -> fsteps) = tactics = (s.tactics) } else s -let (dbg_Norm : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Norm" -let (dbg_NormTop : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "NormTop" -let (dbg_NormCfg : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "NormCfg" -let (dbg_Primops : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Primops" -let (dbg_Unfolding : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Unfolding" -let (dbg_380 : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "380" -let (dbg_WPE : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "WPE" -let (dbg_NormDelayed : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "NormDelayed" -let (dbg_print_normalized : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "print_normalized_terms" -let (dbg_NBE : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "NBE" -let (dbg_UNSOUND_EraseErasableArgs : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "UNSOUND_EraseErasableArgs" +let (dbg_Norm : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Norm" +let (dbg_NormTop : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "NormTop" +let (dbg_NormCfg : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "NormCfg" +let (dbg_Primops : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Primops" +let (dbg_Unfolding : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Unfolding" +let (dbg_380 : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "380" +let (dbg_WPE : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "WPE" +let (dbg_NormDelayed : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "NormDelayed" +let (dbg_print_normalized : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "print_normalized_terms" +let (dbg_NBE : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "NBE" +let (dbg_UNSOUND_EraseErasableArgs : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "UNSOUND_EraseErasableArgs" let (config' : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list -> FStarC_TypeChecker_Env.step Prims.list -> @@ -2514,7 +2621,7 @@ let (config' : fun e -> let d = let uu___ = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___1 -> match uu___1 with | FStarC_TypeChecker_Env.UnfoldUntil k -> @@ -2522,15 +2629,15 @@ let (config' : | FStarC_TypeChecker_Env.Eager_unfolding -> [FStarC_TypeChecker_Env.Eager_unfolding_only] | FStarC_TypeChecker_Env.UnfoldQual l when - FStarC_Compiler_List.contains "unfold" l -> + FStarC_List.contains "unfold" l -> [FStarC_TypeChecker_Env.Eager_unfolding_only] | FStarC_TypeChecker_Env.Inlining -> [FStarC_TypeChecker_Env.InliningDelta] | FStarC_TypeChecker_Env.UnfoldQual l when - FStarC_Compiler_List.contains "inline_for_extraction" l - -> [FStarC_TypeChecker_Env.InliningDelta] + FStarC_List.contains "inline_for_extraction" l -> + [FStarC_TypeChecker_Env.InliningDelta] | uu___2 -> []) s in - FStarC_Compiler_List.unique uu___ in + FStarC_List.unique uu___ in let d1 = match d with | [] -> [FStarC_TypeChecker_Env.NoDelta] | uu___ -> d in let steps = let uu___ = to_fsteps s in add_nbe uu___ in @@ -2540,22 +2647,21 @@ let (config' : let uu___2 = cached_steps () in merge_steps uu___1 uu___2 in add_steps uu___ psteps in let dbg_flag = - FStarC_Compiler_List.contains FStarC_TypeChecker_Env.NormDebug s in + FStarC_List.contains FStarC_TypeChecker_Env.NormDebug s in let uu___ = - let uu___1 = (FStarC_Compiler_Effect.op_Bang dbg_Norm) || dbg_flag in - let uu___2 = - (FStarC_Compiler_Effect.op_Bang dbg_NormTop) || dbg_flag in - let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_NormCfg in - let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Primops in - let uu___5 = FStarC_Compiler_Effect.op_Bang dbg_Unfolding in - let uu___6 = FStarC_Compiler_Effect.op_Bang dbg_380 in - let uu___7 = FStarC_Compiler_Effect.op_Bang dbg_WPE in - let uu___8 = FStarC_Compiler_Effect.op_Bang dbg_NormDelayed in - let uu___9 = FStarC_Compiler_Effect.op_Bang dbg_print_normalized in - let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_NBE in + let uu___1 = (FStarC_Effect.op_Bang dbg_Norm) || dbg_flag in + let uu___2 = (FStarC_Effect.op_Bang dbg_NormTop) || dbg_flag in + let uu___3 = FStarC_Effect.op_Bang dbg_NormCfg in + let uu___4 = FStarC_Effect.op_Bang dbg_Primops in + let uu___5 = FStarC_Effect.op_Bang dbg_Unfolding in + let uu___6 = FStarC_Effect.op_Bang dbg_380 in + let uu___7 = FStarC_Effect.op_Bang dbg_WPE in + let uu___8 = FStarC_Effect.op_Bang dbg_NormDelayed in + let uu___9 = FStarC_Effect.op_Bang dbg_print_normalized in + let uu___10 = FStarC_Effect.op_Bang dbg_NBE in let uu___11 = (let uu___13 = - FStarC_Compiler_Effect.op_Bang dbg_UNSOUND_EraseErasableArgs in + FStarC_Effect.op_Bang dbg_UNSOUND_EraseErasableArgs in if uu___13 then FStarC_Errors.log_issue FStarC_TypeChecker_Env.hasRange_env e @@ -2564,7 +2670,7 @@ let (config' : (Obj.magic "The 'UNSOUND_EraseErasableArgs' setting is for debugging only; it is not sound") else ()); - FStarC_Compiler_Effect.op_Bang dbg_UNSOUND_EraseErasableArgs in + FStarC_Effect.op_Bang dbg_UNSOUND_EraseErasableArgs in { gen = uu___1; top = uu___2; @@ -2582,9 +2688,7 @@ let (config' : (Prims.op_Negation steps.pure_subterms_within_computations) || (FStarC_Options.normalize_pure_terms_for_extraction ()) in let uu___2 = - let uu___3 = - FStarC_Options_Ext.get "compat:normalizer_memo_ignore_cfg" in - uu___3 <> "" in + FStarC_Options_Ext.enabled "compat:normalizer_memo_ignore_cfg" in { steps; tcenv = e; @@ -2649,18 +2753,25 @@ let (translate_norm_step : | FStar_Pervasives.UnfoldOnly names -> let uu___1 = let uu___2 = - let uu___3 = - FStarC_Compiler_List.map FStarC_Ident.lid_of_str names in + let uu___3 = FStarC_List.map FStarC_Ident.lid_of_str names in FStarC_TypeChecker_Env.UnfoldOnly uu___3 in [uu___2] in (FStarC_TypeChecker_Env.UnfoldUntil FStarC_Syntax_Syntax.delta_constant) :: uu___1 + | FStar_Pervasives.UnfoldOnce names -> + let uu___1 = + let uu___2 = + let uu___3 = FStarC_List.map FStarC_Ident.lid_of_str names in + FStarC_TypeChecker_Env.UnfoldOnce uu___3 in + [uu___2] in + (FStarC_TypeChecker_Env.UnfoldUntil + FStarC_Syntax_Syntax.delta_constant) + :: uu___1 | FStar_Pervasives.UnfoldFully names -> let uu___1 = let uu___2 = - let uu___3 = - FStarC_Compiler_List.map FStarC_Ident.lid_of_str names in + let uu___3 = FStarC_List.map FStarC_Ident.lid_of_str names in FStarC_TypeChecker_Env.UnfoldFully uu___3 in [uu___2] in (FStarC_TypeChecker_Env.UnfoldUntil @@ -2669,8 +2780,7 @@ let (translate_norm_step : | FStar_Pervasives.UnfoldAttr names -> let uu___1 = let uu___2 = - let uu___3 = - FStarC_Compiler_List.map FStarC_Ident.lid_of_str names in + let uu___3 = FStarC_List.map FStarC_Ident.lid_of_str names in FStarC_TypeChecker_Env.UnfoldAttr uu___3 in [uu___2] in (FStarC_TypeChecker_Env.UnfoldUntil @@ -2692,10 +2802,10 @@ let (translate_norm_steps : FStarC_TypeChecker_Env.step Prims.list) = fun s -> - let s1 = FStarC_Compiler_List.concatMap translate_norm_step s in + let s1 = FStarC_List.concatMap translate_norm_step s in let add_exclude s2 z = let uu___ = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_Class_Deq.op_Equals_Question FStarC_TypeChecker_Env.deq_step z) s2 in if uu___ then s2 else (FStarC_TypeChecker_Env.Exclude z) :: s2 in diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Common.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Common.ml similarity index 87% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Common.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Common.ml index 0853dbdb87b..835b37c38c7 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Common.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Common.ml @@ -41,7 +41,7 @@ type 'a problem = logical_guard: FStarC_Syntax_Syntax.term ; logical_guard_uvar: FStarC_Syntax_Syntax.ctx_uvar ; reason: Prims.string Prims.list ; - loc: FStarC_Compiler_Range_Type.range ; + loc: FStarC_Range_Type.range ; rank: rank_t FStar_Pervasives_Native.option ; logical: Prims.bool } let __proj__Mkproblem__item__pid : 'a . 'a problem -> Prims.int = @@ -88,8 +88,8 @@ let __proj__Mkproblem__item__reason : match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; reason; loc; rank; logical;_} -> reason -let __proj__Mkproblem__item__loc : - 'a . 'a problem -> FStarC_Compiler_Range_Type.range = +let __proj__Mkproblem__item__loc : 'a . 'a problem -> FStarC_Range_Type.range + = fun projectee -> match projectee with | { pid; lhs; relation; rhs; element; logical_guard; logical_guard_uvar; @@ -147,7 +147,7 @@ let (mk_by_tactic : let uu___2 = let uu___3 = FStarC_Syntax_Syntax.as_arg f in [uu___3] in uu___1 :: uu___2 in FStarC_Syntax_Syntax.mk_Tm_app t_by_tactic uu___ - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let rec (delta_depth_greater_than : FStarC_Syntax_Syntax.delta_depth -> FStarC_Syntax_Syntax.delta_depth -> Prims.bool) @@ -262,8 +262,7 @@ let (showable_deferred_reason : deferred_reason FStarC_Class_Show.showable) = | Deferred_delay_match_heuristic -> "Deferred_delay_match_heuristic" | Deferred_to_user_tac -> "Deferred_to_user_tac") } -type deferred = - (deferred_reason * Prims.string * prob) FStarC_Compiler_CList.clist +type deferred = (deferred_reason * Prims.string * prob) FStarC_CList.clist type univ_ineq = (FStarC_Syntax_Syntax.universe * FStarC_Syntax_Syntax.universe) type identifier_info = @@ -273,7 +272,7 @@ type identifier_info = FStar_Pervasives.either ; identifier_ty: FStarC_Syntax_Syntax.typ ; - identifier_range: FStarC_Compiler_Range_Type.range } + identifier_range: FStarC_Range_Type.range } let (__proj__Mkidentifier_info__item__identifier : identifier_info -> (FStarC_Syntax_Syntax.bv, FStarC_Syntax_Syntax.fv) @@ -288,13 +287,13 @@ let (__proj__Mkidentifier_info__item__identifier_ty : match projectee with | { identifier; identifier_ty; identifier_range;_} -> identifier_ty let (__proj__Mkidentifier_info__item__identifier_range : - identifier_info -> FStarC_Compiler_Range_Type.range) = + identifier_info -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { identifier; identifier_ty; identifier_range;_} -> identifier_range type id_info_by_col = (Prims.int * identifier_info) Prims.list -type col_info_by_row = id_info_by_col FStarC_Compiler_Util.pimap -type row_info_by_file = col_info_by_row FStarC_Compiler_Util.psmap +type col_info_by_row = id_info_by_col FStarC_Util.pimap +type row_info_by_file = col_info_by_row FStarC_Util.psmap type id_info_table = { id_info_enabled: Prims.bool ; @@ -332,8 +331,7 @@ let (insert_col_info : then (aux, ((col, info) :: rest)) else __insert ((c, i) :: aux) rest' in let uu___ = __insert [] col_infos in - match uu___ with - | (l, r) -> FStarC_Compiler_List.op_At (FStarC_Compiler_List.rev l) r + match uu___ with | (l, r) -> FStarC_List.op_At (FStarC_List.rev l) r let (find_nearest_preceding_col_info : Prims.int -> (Prims.int * identifier_info) Prims.list -> @@ -350,12 +348,11 @@ let (find_nearest_preceding_col_info : else aux (FStar_Pervasives_Native.Some i) rest in aux FStar_Pervasives_Native.None col_infos let (id_info_table_empty : id_info_table) = - let uu___ = FStarC_Compiler_Util.psmap_empty () in + let uu___ = FStarC_Util.psmap_empty () in { id_info_enabled = false; id_info_db = uu___; id_info_buffer = [] } let (print_identifier_info : identifier_info -> Prims.string) = fun info -> - let uu___ = - FStarC_Compiler_Range_Ops.string_of_range info.identifier_range in + let uu___ = FStarC_Range_Ops.string_of_range info.identifier_range in let uu___1 = match info.identifier with | FStar_Pervasives.Inl x -> @@ -365,24 +362,24 @@ let (print_identifier_info : identifier_info -> Prims.string) = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term info.identifier_ty in - FStarC_Compiler_Util.format3 "id info { %s, %s : %s}" uu___ uu___1 uu___2 + FStarC_Util.format3 "id info { %s, %s : %s}" uu___ uu___1 uu___2 let (id_info__insert : (FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option) -> - (Prims.int * identifier_info) Prims.list FStarC_Compiler_Util.pimap - FStarC_Compiler_Util.psmap -> + (Prims.int * identifier_info) Prims.list FStarC_Util.pimap + FStarC_Util.psmap -> identifier_info -> - (Prims.int * identifier_info) Prims.list FStarC_Compiler_Util.pimap - FStarC_Compiler_Util.psmap) + (Prims.int * identifier_info) Prims.list FStarC_Util.pimap + FStarC_Util.psmap) = fun ty_map -> fun db -> fun info -> let range = info.identifier_range in let use_range = - let uu___ = FStarC_Compiler_Range_Type.use_range range in - FStarC_Compiler_Range_Type.set_def_range range uu___ in + let uu___ = FStarC_Range_Type.use_range range in + FStarC_Range_Type.set_def_range range uu___ in let id_ty = match info.identifier with | FStar_Pervasives.Inr uu___ -> ty_map info.identifier_ty @@ -396,29 +393,27 @@ let (id_info__insert : identifier_ty = id_ty1; identifier_range = use_range } in - let fn = FStarC_Compiler_Range_Ops.file_of_range use_range in - let start = FStarC_Compiler_Range_Ops.start_of_range use_range in + let fn = FStarC_Range_Ops.file_of_range use_range in + let start = FStarC_Range_Ops.start_of_range use_range in let uu___ = - let uu___1 = FStarC_Compiler_Range_Ops.line_of_pos start in - let uu___2 = FStarC_Compiler_Range_Ops.col_of_pos start in + let uu___1 = FStarC_Range_Ops.line_of_pos start in + let uu___2 = FStarC_Range_Ops.col_of_pos start in (uu___1, uu___2) in (match uu___ with | (row, col) -> let rows = - let uu___1 = FStarC_Compiler_Util.pimap_empty () in - FStarC_Compiler_Util.psmap_find_default db fn uu___1 in - let cols = - FStarC_Compiler_Util.pimap_find_default rows row [] in + let uu___1 = FStarC_Util.pimap_empty () in + FStarC_Util.psmap_find_default db fn uu___1 in + let cols = FStarC_Util.pimap_find_default rows row [] in let uu___1 = let uu___2 = insert_col_info col info1 cols in - FStarC_Compiler_Util.pimap_add rows row uu___2 in - FStarC_Compiler_Util.psmap_add db fn uu___1) + FStarC_Util.pimap_add rows row uu___2 in + FStarC_Util.psmap_add db fn uu___1) let (id_info_insert : id_info_table -> (FStarC_Syntax_Syntax.bv, FStarC_Syntax_Syntax.fv) FStar_Pervasives.either -> - FStarC_Syntax_Syntax.typ -> - FStarC_Compiler_Range_Type.range -> id_info_table) + FStarC_Syntax_Syntax.typ -> FStarC_Range_Type.range -> id_info_table) = fun table -> fun id -> @@ -472,8 +467,8 @@ let (id_info_promote : fun table -> fun ty_map -> let uu___ = - FStarC_Compiler_List.fold_left (id_info__insert ty_map) - table.id_info_db table.id_info_buffer in + FStarC_List.fold_left (id_info__insert ty_map) table.id_info_db + table.id_info_buffer in { id_info_enabled = (table.id_info_enabled); id_info_db = uu___; @@ -490,24 +485,23 @@ let (id_info_at_pos : fun row -> fun col -> let rows = - let uu___ = FStarC_Compiler_Util.pimap_empty () in - FStarC_Compiler_Util.psmap_find_default table.id_info_db fn uu___ in - let cols = FStarC_Compiler_Util.pimap_find_default rows row [] in + let uu___ = FStarC_Util.pimap_empty () in + FStarC_Util.psmap_find_default table.id_info_db fn uu___ in + let cols = FStarC_Util.pimap_find_default rows row [] in let uu___ = find_nearest_preceding_col_info col cols in match uu___ with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some info -> let last_col = let uu___1 = - FStarC_Compiler_Range_Ops.end_of_range - info.identifier_range in - FStarC_Compiler_Range_Ops.col_of_pos uu___1 in + FStarC_Range_Ops.end_of_range info.identifier_range in + FStarC_Range_Ops.col_of_pos uu___1 in if col <= last_col then FStar_Pervasives_Native.Some info else FStar_Pervasives_Native.None let (check_uvar_ctx_invariant : Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> FStarC_Syntax_Syntax.gamma -> FStarC_Syntax_Syntax.binders -> unit) = @@ -518,7 +512,7 @@ let (check_uvar_ctx_invariant : fun bs -> let fail uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Range_Ops.string_of_range r in + let uu___2 = FStarC_Range_Ops.string_of_range r in let uu___3 = FStarC_Class_Show.show (FStarC_Class_Show.show_list @@ -527,7 +521,7 @@ let (check_uvar_ctx_invariant : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) bs in - FStarC_Compiler_Util.format5 + FStarC_Util.format5 "Invariant violation: gamma and binders are out of sync\n\treason=%s, range=%s, should_check=%s\n\t\n gamma=%s\n\tbinders=%s\n" reason uu___2 (if should_check then "true" else "false") uu___3 uu___4 in @@ -537,7 +531,7 @@ let (check_uvar_ctx_invariant : else (let uu___1 = let uu___2 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.Binding_var uu___4 -> true @@ -547,7 +541,7 @@ let (check_uvar_ctx_invariant : | (FStar_Pervasives_Native.None, []) -> () | (FStar_Pervasives_Native.Some (uu___2, hd, gamma_tail), uu___3::uu___4) -> - let uu___5 = FStarC_Compiler_Util.prefix bs in + let uu___5 = FStarC_Util.prefix bs in (match uu___5 with | (uu___6, x) -> (match hd with @@ -562,7 +556,7 @@ type implicit = imp_reason: Prims.string ; imp_uvar: FStarC_Syntax_Syntax.ctx_uvar ; imp_tm: FStarC_Syntax_Syntax.term ; - imp_range: FStarC_Compiler_Range_Type.range } + imp_range: FStarC_Range_Type.range } let (__proj__Mkimplicit__item__imp_reason : implicit -> Prims.string) = fun projectee -> match projectee with @@ -578,7 +572,7 @@ let (__proj__Mkimplicit__item__imp_tm : match projectee with | { imp_reason; imp_uvar; imp_tm; imp_range;_} -> imp_tm let (__proj__Mkimplicit__item__imp_range : - implicit -> FStarC_Compiler_Range_Type.range) = + implicit -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { imp_reason; imp_uvar; imp_tm; imp_range;_} -> imp_range @@ -596,15 +590,15 @@ let (implicits_to_string : implicits -> Prims.string) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_uvar (i.imp_uvar).FStarC_Syntax_Syntax.ctx_uvar_head in FStarC_Common.string_of_list imp_to_string imps -type implicits_t = implicit FStarC_Compiler_CList.t +type implicits_t = implicit FStarC_CList.t type guard_t = { guard_f: guard_formula ; deferred_to_tac: deferred ; deferred: deferred ; univ_ineqs: - (FStarC_Syntax_Syntax.universe FStarC_Compiler_CList.clist * univ_ineq - FStarC_Compiler_CList.clist) + (FStarC_Syntax_Syntax.universe FStarC_CList.clist * univ_ineq + FStarC_CList.clist) ; implicits: implicits_t } let (__proj__Mkguard_t__item__guard_f : guard_t -> guard_formula) = @@ -624,8 +618,8 @@ let (__proj__Mkguard_t__item__deferred : guard_t -> deferred) = implicits = implicits1;_} -> deferred1 let (__proj__Mkguard_t__item__univ_ineqs : guard_t -> - (FStarC_Syntax_Syntax.universe FStarC_Compiler_CList.clist * univ_ineq - FStarC_Compiler_CList.clist)) + (FStarC_Syntax_Syntax.universe FStarC_CList.clist * univ_ineq + FStarC_CList.clist)) = fun projectee -> match projectee with @@ -642,22 +636,22 @@ let (trivial_guard : guard_t) = deferred_to_tac = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); deferred = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); univ_ineqs = ((Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))), + (Obj.magic (FStarC_CList.listlike_clist ())))), (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ()))))); + (Obj.magic (FStarC_CList.listlike_clist ()))))); implicits = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))) + (Obj.magic (FStarC_CList.listlike_clist ())))) } let (conj_guard_f : guard_formula -> guard_formula -> guard_formula) = fun g1 -> @@ -676,27 +670,24 @@ let (binop_guard : fun g2 -> let uu___ = f g1.guard_f g2.guard_f in let uu___1 = - FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) g1.deferred_to_tac - g2.deferred_to_tac in + FStarC_Class_Monoid.op_Plus_Plus (FStarC_CList.monoid_clist ()) + g1.deferred_to_tac g2.deferred_to_tac in let uu___2 = - FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) g1.deferred g2.deferred in + FStarC_Class_Monoid.op_Plus_Plus (FStarC_CList.monoid_clist ()) + g1.deferred g2.deferred in let uu___3 = let uu___4 = - FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) + FStarC_Class_Monoid.op_Plus_Plus (FStarC_CList.monoid_clist ()) (FStar_Pervasives_Native.fst g1.univ_ineqs) (FStar_Pervasives_Native.fst g2.univ_ineqs) in let uu___5 = - FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) + FStarC_Class_Monoid.op_Plus_Plus (FStarC_CList.monoid_clist ()) (FStar_Pervasives_Native.snd g1.univ_ineqs) (FStar_Pervasives_Native.snd g2.univ_ineqs) in (uu___4, uu___5) in let uu___4 = - FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) g1.implicits g2.implicits in + FStarC_Class_Monoid.op_Plus_Plus (FStarC_CList.monoid_clist ()) + g1.implicits g2.implicits in { guard_f = uu___; deferred_to_tac = uu___1; @@ -750,7 +741,7 @@ let (imp_guard_f : guard_formula -> guard_formula -> guard_formula) = let (imp_guard : guard_t -> guard_t -> guard_t) = fun g1 -> fun g2 -> binop_guard imp_guard_f g1 g2 let (conj_guards : guard_t Prims.list -> guard_t) = - fun gs -> FStarC_Compiler_List.fold_left conj_guard trivial_guard gs + fun gs -> FStarC_List.fold_left conj_guard trivial_guard gs let (split_guard : guard_t -> (guard_t * guard_t)) = fun g -> ({ @@ -790,8 +781,7 @@ type lcomp = cflags: FStarC_Syntax_Syntax.cflag Prims.list ; comp_thunk: (unit -> (FStarC_Syntax_Syntax.comp * guard_t), - FStarC_Syntax_Syntax.comp) FStar_Pervasives.either - FStarC_Compiler_Effect.ref + FStarC_Syntax_Syntax.comp) FStar_Pervasives.either FStarC_Effect.ref } let (__proj__Mklcomp__item__eff_name : lcomp -> FStarC_Ident.lident) = fun projectee -> @@ -809,8 +799,7 @@ let (__proj__Mklcomp__item__cflags : let (__proj__Mklcomp__item__comp_thunk : lcomp -> (unit -> (FStarC_Syntax_Syntax.comp * guard_t), - FStarC_Syntax_Syntax.comp) FStar_Pervasives.either - FStarC_Compiler_Effect.ref) + FStarC_Syntax_Syntax.comp) FStar_Pervasives.either FStarC_Effect.ref) = fun projectee -> match projectee with @@ -825,18 +814,17 @@ let (mk_lcomp : fun res_typ -> fun cflags -> fun comp_thunk -> - let uu___ = - FStarC_Compiler_Util.mk_ref (FStar_Pervasives.Inl comp_thunk) in + let uu___ = FStarC_Util.mk_ref (FStar_Pervasives.Inl comp_thunk) in { eff_name; res_typ; cflags; comp_thunk = uu___ } let (lcomp_comp : lcomp -> (FStarC_Syntax_Syntax.comp * guard_t)) = fun lc -> - let uu___ = FStarC_Compiler_Effect.op_Bang lc.comp_thunk in + let uu___ = FStarC_Effect.op_Bang lc.comp_thunk in match uu___ with | FStar_Pervasives.Inl thunk -> let uu___1 = thunk () in (match uu___1 with | (c, g) -> - (FStarC_Compiler_Effect.op_Colon_Equals lc.comp_thunk + (FStarC_Effect.op_Colon_Equals lc.comp_thunk (FStar_Pervasives.Inr c); (c, g))) | FStar_Pervasives.Inr c -> (c, trivial_guard) @@ -866,7 +854,7 @@ let (lcomp_to_string : lcomp -> Prims.string) = FStarC_Class_Show.show FStarC_Ident.showable_lident lc.eff_name in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lc.res_typ in - FStarC_Compiler_Util.format2 "%s %s" uu___2 uu___3) + FStarC_Util.format2 "%s %s" uu___2 uu___3) let (lcomp_set_flags : lcomp -> FStarC_Syntax_Syntax.cflag Prims.list -> lcomp) = fun lc -> @@ -903,7 +891,7 @@ let (is_total_lcomp : lcomp -> Prims.bool) = fun c -> (FStarC_Ident.lid_equals c.eff_name FStarC_Parser_Const.effect_Tot_lid) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.TOTAL -> true @@ -916,7 +904,7 @@ let (is_tot_or_gtot_lcomp : lcomp -> Prims.bool) = (FStarC_Ident.lid_equals c.eff_name FStarC_Parser_Const.effect_GTot_lid)) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.TOTAL -> true @@ -924,7 +912,7 @@ let (is_tot_or_gtot_lcomp : lcomp -> Prims.bool) = | uu___1 -> false) c.cflags) let (is_lcomp_partial_return : lcomp -> Prims.bool) = fun c -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.RETURN -> true @@ -934,7 +922,7 @@ let (is_pure_lcomp : lcomp -> Prims.bool) = fun lc -> ((is_total_lcomp lc) || (FStarC_Syntax_Util.is_pure_effect lc.eff_name)) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.LEMMA -> true @@ -976,8 +964,8 @@ let (lcomp_of_comp_guard : FStarC_Syntax_Syntax.comp -> guard_t -> lcomp) = (c.FStarC_Syntax_Syntax.flags)) in match uu___ with | (eff_name, flags) -> - mk_lcomp eff_name (FStarC_Syntax_Util.comp_result c0) flags - (fun uu___1 -> (c0, g)) + let uu___1 = FStarC_Syntax_Util.comp_result c0 in + mk_lcomp eff_name uu___1 flags (fun uu___2 -> (c0, g)) let (lcomp_of_comp : FStarC_Syntax_Syntax.comp -> lcomp) = fun c0 -> lcomp_of_comp_guard c0 trivial_guard let (check_positivity_qual : diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Core.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Core.ml similarity index 97% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Core.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Core.ml index 86b650ee70a..89315177748 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Core.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Core.ml @@ -6,22 +6,21 @@ let (uu___is_E_Total : tot_or_ghost -> Prims.bool) = fun projectee -> match projectee with | E_Total -> true | uu___ -> false let (uu___is_E_Ghost : tot_or_ghost -> Prims.bool) = fun projectee -> match projectee with | E_Ghost -> true | uu___ -> false -let (dbg : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Core" -let (dbg_Eq : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "CoreEq" -let (dbg_Top : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "CoreTop" -let (dbg_Exit : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "CoreExit" -let (goal_ctr : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero +let (dbg : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Core" +let (dbg_Eq : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "CoreEq" +let (dbg_Top : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "CoreTop" +let (dbg_Exit : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "CoreExit" +let (goal_ctr : Prims.int FStarC_Effect.ref) = + FStarC_Util.mk_ref Prims.int_zero let (get_goal_ctr : unit -> Prims.int) = - fun uu___ -> FStarC_Compiler_Effect.op_Bang goal_ctr + fun uu___ -> FStarC_Effect.op_Bang goal_ctr let (incr_goal_ctr : unit -> Prims.int) = fun uu___ -> - let v = FStarC_Compiler_Effect.op_Bang goal_ctr in - FStarC_Compiler_Effect.op_Colon_Equals goal_ctr (v + Prims.int_one); + let v = FStarC_Effect.op_Bang goal_ctr in + FStarC_Effect.op_Colon_Equals goal_ctr (v + Prims.int_one); v + Prims.int_one type guard_handler_t = FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.typ -> Prims.bool @@ -78,7 +77,7 @@ let (push_binder : env -> FStarC_Syntax_Syntax.binder -> env) = should_read_cache = (g.should_read_cache) }) let (push_binders : env -> FStarC_Syntax_Syntax.binder Prims.list -> env) = - FStarC_Compiler_List.fold_left push_binder + FStarC_List.fold_left push_binder let (fresh_binder : env -> FStarC_Syntax_Syntax.binder -> (env * FStarC_Syntax_Syntax.binder)) = @@ -107,7 +106,7 @@ let (open_binders : fun g -> fun bs -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -129,8 +128,7 @@ let (open_binders : FStarC_Syntax_Subst.subst_bqual subst b.FStarC_Syntax_Syntax.binder_qual in let uu___3 = - FStarC_Compiler_List.map - (FStarC_Syntax_Subst.subst subst) + FStarC_List.map (FStarC_Syntax_Subst.subst subst) b.FStarC_Syntax_Syntax.binder_attrs in { FStarC_Syntax_Syntax.binder_bv = bv; @@ -152,7 +150,7 @@ let (open_binders : :: uu___4 in (g2, (b' :: bs1), uu___3))) (g, [], []) bs in match uu___ with - | (g1, bs_rev, subst) -> (g1, (FStarC_Compiler_List.rev bs_rev), subst) + | (g1, bs_rev, subst) -> (g1, (FStarC_List.rev bs_rev), subst) let (open_pat : env -> FStarC_Syntax_Syntax.pat -> @@ -165,7 +163,7 @@ let (open_pat : | FStarC_Syntax_Syntax.Pat_constant uu___ -> (g1, p1, sub) | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -181,7 +179,7 @@ let (open_pat : { FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_cons - (fv, us_opt, (FStarC_Compiler_List.rev pats1))); + (fv, us_opt, (FStarC_List.rev pats1))); FStarC_Syntax_Syntax.p = (p1.FStarC_Syntax_Syntax.p) }, sub1)) | FStarC_Syntax_Syntax.Pat_var x -> @@ -214,8 +212,7 @@ let (open_pat : }, sub1)) | FStarC_Syntax_Syntax.Pat_dot_term eopt -> let eopt1 = - FStarC_Compiler_Util.map_option (FStarC_Syntax_Subst.subst sub) - eopt in + FStarC_Util.map_option (FStarC_Syntax_Subst.subst sub) eopt in (g1, { FStarC_Syntax_Syntax.v = @@ -313,8 +310,7 @@ let (open_branch : | (g1, p1, s) -> let uu___2 = let uu___3 = - FStarC_Compiler_Util.map_option - (FStarC_Syntax_Subst.subst s) wopt in + FStarC_Util.map_option (FStarC_Syntax_Subst.subst s) wopt in let uu___4 = FStarC_Syntax_Subst.subst s e in (p1, uu___3, uu___4) in (g1, uu___2)) @@ -341,13 +337,13 @@ let (open_branches_eq_pat : | (g1, p01, s) -> let uu___4 = let uu___5 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (FStarC_Syntax_Subst.subst s) wopt0 in let uu___6 = FStarC_Syntax_Subst.subst s e0 in (p01, uu___5, uu___6) in let uu___5 = let uu___6 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (FStarC_Syntax_Subst.subst s) wopt1 in let uu___7 = FStarC_Syntax_Subst.subst s e1 in (p01, uu___6, uu___7) in @@ -373,7 +369,7 @@ let (relation_to_string : relation -> Prims.string) = | SUBTYPING (FStar_Pervasives_Native.Some tm) -> let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.format1 "( <:? %s)" uu___1 + FStarC_Util.format1 "( <:? %s)" uu___1 type context_term = | CtxTerm of FStarC_Syntax_Syntax.term | CtxRel of FStarC_Syntax_Syntax.term * relation * @@ -402,7 +398,7 @@ let (context_term_to_string : context_term -> Prims.string) = let uu___1 = relation_to_string r in let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format3 "%s %s %s" uu___ uu___1 uu___2 + FStarC_Util.format3 "%s %s %s" uu___ uu___1 uu___2 type context = { no_guard: Prims.bool ; @@ -436,12 +432,12 @@ let (showable_context : context FStarC_Class_Show.showable) = context1.unfolding_ok in let uu___2 = let uu___3 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst + FStarC_List.map FStar_Pervasives_Native.fst context1.error_context in FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Class_Show.showable_string) uu___3 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "{no_guard=%s; unfolding_ok=%s; error_context=%s}" uu___ uu___1 uu___2) } @@ -457,9 +453,9 @@ let (print_context : context -> Prims.string) = | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some ctx_term1 -> context_term_to_string ctx_term1 in - FStarC_Compiler_Util.format3 "%s %s (%s)\n" depth msg uu___ in + FStarC_Util.format3 "%s %s (%s)\n" depth msg uu___ in let tl1 = aux (Prims.strcat depth ">") tl in Prims.strcat hd tl1 in - aux "" (FStarC_Compiler_List.rev ctx.error_context) + aux "" (FStarC_List.rev ctx.error_context) type error = (context * Prims.string) let (print_error : error -> Prims.string) = fun err -> @@ -467,7 +463,7 @@ let (print_error : error -> Prims.string) = match uu___ with | (ctx, msg) -> let uu___1 = print_context ctx in - FStarC_Compiler_Util.format2 "%s%s" uu___1 msg + FStarC_Util.format2 "%s%s" uu___1 msg let (print_error_short : error -> Prims.string) = fun err -> FStar_Pervasives_Native.snd err type 'a __result = @@ -540,25 +536,24 @@ let (__proj__Mkcache_stats_t__item__hits : cache_stats_t -> Prims.int) = fun projectee -> match projectee with | { hits; misses;_} -> hits let (__proj__Mkcache_stats_t__item__misses : cache_stats_t -> Prims.int) = fun projectee -> match projectee with | { hits; misses;_} -> misses -let (cache_stats : cache_stats_t FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref - { hits = Prims.int_zero; misses = Prims.int_zero } +let (cache_stats : cache_stats_t FStarC_Effect.ref) = + FStarC_Util.mk_ref { hits = Prims.int_zero; misses = Prims.int_zero } let (record_cache_hit : unit -> unit) = fun uu___ -> - let cs = FStarC_Compiler_Effect.op_Bang cache_stats in - FStarC_Compiler_Effect.op_Colon_Equals cache_stats + let cs = FStarC_Effect.op_Bang cache_stats in + FStarC_Effect.op_Colon_Equals cache_stats { hits = (cs.hits + Prims.int_one); misses = (cs.misses) } let (record_cache_miss : unit -> unit) = fun uu___ -> - let cs = FStarC_Compiler_Effect.op_Bang cache_stats in - FStarC_Compiler_Effect.op_Colon_Equals cache_stats + let cs = FStarC_Effect.op_Bang cache_stats in + FStarC_Effect.op_Colon_Equals cache_stats { hits = (cs.hits); misses = (cs.misses + Prims.int_one) } let (reset_cache_stats : unit -> unit) = fun uu___ -> - FStarC_Compiler_Effect.op_Colon_Equals cache_stats + FStarC_Effect.op_Colon_Equals cache_stats { hits = Prims.int_zero; misses = Prims.int_zero } let (report_cache_stats : unit -> cache_stats_t) = - fun uu___ -> FStarC_Compiler_Effect.op_Bang cache_stats + fun uu___ -> FStarC_Effect.op_Bang cache_stats let (clear_memo_table : unit -> unit) = fun uu___ -> FStarC_Syntax_TermHashTable.clear table type side = @@ -669,8 +664,7 @@ let fail : 'a . Prims.string -> 'a result = fun msg -> fun ctx -> Error (ctx, msg) let (dump_context : unit result) = fun ctx -> - (let uu___1 = print_context ctx in - FStarC_Compiler_Util.print_string uu___1); + (let uu___1 = print_context ctx in FStarC_Util.print_string uu___1); (let uu___1 uu___2 = Success ((), FStar_Pervasives_Native.None) in uu___1 ctx) let handle_with : 'a . 'a result -> (unit -> 'a result) -> 'a result = @@ -704,7 +698,7 @@ let (mk_type : = fun u -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u) - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange let (is_type : env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.universe result) = fun g -> @@ -720,7 +714,7 @@ let (is_type : let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format1 "Expected a type; got %s" uu___3 in + FStarC_Util.format1 "Expected a type; got %s" uu___3 in fail uu___2 in fun ctx -> let ctx1 = @@ -772,10 +766,11 @@ let rec (is_arrow : let eff = let uu___3 = FStarC_Syntax_Util.is_total_comp c1 in if uu___3 then E_Total else E_Ghost in - (fun uu___3 -> - Success - ((x1, eff, (FStarC_Syntax_Util.comp_result c1)), - FStar_Pervasives_Native.None))) + let uu___3 = + let uu___4 = FStarC_Syntax_Util.comp_result c1 in + (x1, eff, uu___4) in + (fun uu___4 -> + Success (uu___3, FStar_Pervasives_Native.None))) else (let e_tag = let uu___3 = c.FStarC_Syntax_Syntax.n in @@ -803,9 +798,9 @@ let rec (is_arrow : | FStar_Pervasives_Native.None -> let uu___3 = let uu___4 = - FStarC_Ident.string_of_lid - (FStarC_Syntax_Util.comp_effect_name c) in - FStarC_Compiler_Util.format1 + let uu___5 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_Ident.string_of_lid uu___5 in + FStarC_Util.format1 "Expected total or gtot arrow, got %s" uu___4 in fail uu___3 | FStar_Pervasives_Native.Some e_tag1 -> @@ -820,9 +815,10 @@ let rec (is_arrow : x1.FStarC_Syntax_Syntax.binder_bv pre in let res_typ = let r = + let uu___8 = + FStarC_Syntax_Util.comp_result c1 in FStarC_Syntax_Syntax.new_bv - FStar_Pervasives_Native.None - (FStarC_Syntax_Util.comp_result c1) in + FStar_Pervasives_Native.None uu___8 in let post1 = let uu___8 = let uu___9 = @@ -892,8 +888,8 @@ let rec (is_arrow : t1 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 "Expected an arrow, got (%s) %s" - uu___3 uu___4 in + FStarC_Util.format2 "Expected an arrow, got (%s) %s" uu___3 + uu___4 in fail uu___2 in fun ctx -> let ctx1 = @@ -953,16 +949,32 @@ let (check_bqual : | (FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Implicit b01), FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Implicit b11)) -> (fun uu___ -> Success ((), FStar_Pervasives_Native.None)) + | (FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Equality), + FStar_Pervasives_Native.None) -> + (fun uu___ -> Success ((), FStar_Pervasives_Native.None)) + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some + (FStarC_Syntax_Syntax.Equality)) -> + (fun uu___ -> Success ((), FStar_Pervasives_Native.None)) | (FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Equality), FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Equality)) -> (fun uu___ -> Success ((), FStar_Pervasives_Native.None)) | (FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Meta t1), - FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Meta t2)) -> - let uu___ = equal_term t1 t2 in - if uu___ - then (fun uu___1 -> Success ((), FStar_Pervasives_Native.None)) - else fail "Binder qualifier mismatch" - | uu___ -> fail "Binder qualifier mismatch" + FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Meta t2)) when + equal_term t1 t2 -> + (fun uu___ -> Success ((), FStar_Pervasives_Native.None)) + | uu___ -> + let uu___1 = + let uu___2 = + FStarC_Class_Show.show + (FStarC_Class_Show.show_option + FStarC_Syntax_Print.showable_bqual) b0 in + let uu___3 = + FStarC_Class_Show.show + (FStarC_Class_Show.show_option + FStarC_Syntax_Print.showable_bqual) b1 in + FStarC_Util.format2 "Binder qualifier mismatch, %s vs %s" uu___2 + uu___3 in + fail uu___1 let (check_aqual : FStarC_Syntax_Syntax.aqual -> FStarC_Syntax_Syntax.aqual -> unit result) = fun a0 -> @@ -981,9 +993,9 @@ let (check_aqual : then (fun uu___2 -> Success ((), FStar_Pervasives_Native.None)) else (let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_bool b0 in - let uu___5 = FStarC_Compiler_Util.string_of_bool b1 in - FStarC_Compiler_Util.format2 + let uu___4 = FStarC_Util.string_of_bool b0 in + let uu___5 = FStarC_Util.string_of_bool b1 in + FStarC_Util.format2 "Unequal arg qualifiers: lhs implicit=%s and rhs implicit=%s" uu___4 uu___5 in fail uu___3) @@ -1002,8 +1014,8 @@ let (check_aqual : FStarC_Class_Show.show FStarC_Syntax_Print.showable_aqual a0 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_aqual a1 in - FStarC_Compiler_Util.format2 - "Unequal arg qualifiers: lhs %s and rhs %s" uu___2 uu___3 in + FStarC_Util.format2 "Unequal arg qualifiers: lhs %s and rhs %s" + uu___2 uu___3 in fail uu___1 let (check_positivity_qual : relation -> @@ -1029,7 +1041,7 @@ let (mk_forall_l : fun us -> fun xs -> fun t -> - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun u -> fun x -> fun t1 -> @@ -1122,17 +1134,15 @@ let (abs : let (weaken_subtyping_guard : FStarC_Syntax_Syntax.term -> precondition -> precondition) = fun p -> - fun g -> - FStarC_Compiler_Util.map_opt g (fun q -> FStarC_Syntax_Util.mk_imp p q) + fun g -> FStarC_Util.map_opt g (fun q -> FStarC_Syntax_Util.mk_imp p q) let (strengthen_subtyping_guard : FStarC_Syntax_Syntax.term -> precondition -> precondition) = fun p -> fun g -> let uu___ = let uu___1 = - FStarC_Compiler_Util.map_opt g - (fun q -> FStarC_Syntax_Util.mk_conj p q) in - FStarC_Compiler_Util.dflt p uu___1 in + FStarC_Util.map_opt g (fun q -> FStarC_Syntax_Util.mk_conj p q) in + FStarC_Util.dflt p uu___1 in FStar_Pervasives_Native.Some uu___ let weaken : 'a . @@ -1198,7 +1208,7 @@ let no_guard : 'a . 'a result -> 'a result = let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term g1 in - FStarC_Compiler_Util.format1 "Unexpected guard: %s" uu___3 in + FStarC_Util.format1 "Unexpected guard: %s" uu___3 in fail uu___2 in uu___1 ctx | err -> err @@ -1231,7 +1241,7 @@ let (curry_arrow : FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = xs; FStarC_Syntax_Syntax.comp = c - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in let uu___ = let uu___1 = let uu___2 = FStarC_Syntax_Syntax.mk_Total tail in @@ -1240,7 +1250,7 @@ let (curry_arrow : FStarC_Syntax_Syntax.comp = uu___2 } in FStarC_Syntax_Syntax.Tm_arrow uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange let (curry_abs : FStarC_Syntax_Syntax.binder -> FStarC_Syntax_Syntax.binder -> @@ -1269,8 +1279,7 @@ let (curry_abs : FStarC_Syntax_Syntax.body = tail; FStarC_Syntax_Syntax.rc_opt = FStar_Pervasives_Native.None }) body.FStarC_Syntax_Syntax.pos -let (is_gtot_comp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> Prims.bool) = +let (is_gtot_comp : FStarC_Syntax_Syntax.comp -> Prims.bool) = fun c -> (FStarC_Syntax_Util.is_tot_or_gtot_comp c) && (let uu___ = FStarC_Syntax_Util.is_total_comp c in @@ -1281,7 +1290,7 @@ let rec (context_included : = fun g0 -> fun g1 -> - let uu___ = FStarC_Compiler_Util.physical_equality g0 g1 in + let uu___ = FStarC_Util.physical_equality g0 g1 in if uu___ then true else @@ -1312,7 +1321,7 @@ let (curry_application : (FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax * FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option) Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) = fun hd -> @@ -1352,7 +1361,7 @@ let (lookup : if uu___1 then (record_cache_hit (); - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___4 = FStarC_Effect.op_Bang dbg in if uu___4 then let uu___5 = @@ -1370,7 +1379,7 @@ let (lookup : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binding) he.he_gamma in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "cache hit\n %s |- %s : %s\nmatching env %s\n" uu___5 uu___6 uu___7 uu___8 else ()); @@ -1382,12 +1391,12 @@ let (check_no_escape : fun t -> let xs = FStarC_Syntax_Free.names t in let uu___ = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun b -> let uu___1 = FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) b.FStarC_Syntax_Syntax.binder_bv (Obj.magic xs) in Prims.op_Negation uu___1) bs in @@ -1623,14 +1632,16 @@ let (comp_as_tot_or_ghost_and_type : let uu___ = FStarC_Syntax_Util.is_total_comp c in if uu___ then - FStar_Pervasives_Native.Some - (E_Total, (FStarC_Syntax_Util.comp_result c)) + let uu___1 = + let uu___2 = FStarC_Syntax_Util.comp_result c in (E_Total, uu___2) in + FStar_Pervasives_Native.Some uu___1 else (let uu___2 = FStarC_Syntax_Util.is_tot_or_gtot_comp c in if uu___2 then - FStar_Pervasives_Native.Some - (E_Ghost, (FStarC_Syntax_Util.comp_result c)) + let uu___3 = + let uu___4 = FStarC_Syntax_Util.comp_result c in (E_Ghost, uu___4) in + FStar_Pervasives_Native.Some uu___3 else FStar_Pervasives_Native.None) let (join_eff : tot_or_ghost -> tot_or_ghost -> tot_or_ghost) = fun e0 -> @@ -1648,8 +1659,7 @@ let (unfolding_ok : Prims.bool result) = let debug : 'uuuuu . 'uuuuu -> (unit -> unit) -> unit = fun g -> fun f -> - let uu___ = FStarC_Compiler_Effect.op_Bang dbg in - if uu___ then f () else () + let uu___ = FStarC_Effect.op_Bang dbg in if uu___ then f () else () let (showable_side : side FStarC_Class_Show.showable) = { FStarC_Class_Show.show = @@ -1661,9 +1671,8 @@ let (showable_side : side FStarC_Class_Show.showable) = | Neither -> "Neither") } let (boolean_negation_simp : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax - FStar_Pervasives_Native.option) + FStarC_Syntax_Syntax.term -> + FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option) = fun b -> let uu___ = @@ -1740,8 +1749,8 @@ let rec (check_relation : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 "not equal terms: %s <> %s" - uu___2 uu___3 in + FStarC_Util.format2 "not equal terms: %s <> %s" uu___2 + uu___3 in fail uu___1 | uu___1 -> let uu___2 = @@ -1751,12 +1760,12 @@ let rec (check_relation : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 "%s is not a subtype of %s" - uu___3 uu___4 in + FStarC_Util.format2 "%s is not a subtype of %s" uu___3 + uu___4 in fail uu___2 in let rel_to_string rel1 = match rel1 with | EQUALITY -> "=?=" | SUBTYPING uu___ -> "<:?" in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___1 = FStarC_Effect.op_Bang dbg in if uu___1 then let uu___2 = @@ -1767,9 +1776,8 @@ let rec (check_relation : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print5 - "check_relation (%s) %s %s (%s) %s\n" uu___2 uu___3 - (rel_to_string rel) uu___4 uu___5 + FStarC_Util.print5 "check_relation (%s) %s %s (%s) %s\n" uu___2 + uu___3 (rel_to_string rel) uu___4 uu___5 else ()); (fun ctx0 -> let uu___1 = guard_not_allowed ctx0 in @@ -2281,8 +2289,7 @@ let rec (check_relation : match x2 with | FStar_Pervasives_Native.None -> ((let uu___13 = - FStarC_Compiler_Effect.op_Bang - dbg in + FStarC_Effect.op_Bang dbg in if uu___13 then let uu___14 = @@ -2293,7 +2300,7 @@ let rec (check_relation : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term x1.FStarC_Syntax_Syntax.sort in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Cannot match ref heads %s and %s\n" uu___14 uu___15 else ()); @@ -2739,11 +2746,8 @@ let rec (check_relation : if Prims.op_Negation (head_matches1 && - ((FStarC_Compiler_List.length - args0) - = - (FStarC_Compiler_List.length - args1))) + ((FStarC_List.length args0) = + (FStarC_List.length args1))) then maybe_unfold_and_retry t01 t11 else (let compare_head_and_args uu___11 = @@ -2811,11 +2815,8 @@ let rec (check_relation : if Prims.op_Negation (head_matches1 && - ((FStarC_Compiler_List.length - args0) - = - (FStarC_Compiler_List.length - args1))) + ((FStarC_List.length args0) = + (FStarC_List.length args1))) then maybe_unfold_and_retry t01 t11 else (let compare_head_and_args uu___11 = @@ -2883,11 +2884,8 @@ let rec (check_relation : if Prims.op_Negation (head_matches1 && - ((FStarC_Compiler_List.length - args0) - = - (FStarC_Compiler_List.length - args1))) + ((FStarC_List.length args0) = + (FStarC_List.length args1))) then maybe_unfold_and_retry t01 t11 else (let compare_head_and_args uu___11 = @@ -2955,11 +2953,8 @@ let rec (check_relation : if Prims.op_Negation (head_matches1 && - ((FStarC_Compiler_List.length - args0) - = - (FStarC_Compiler_List.length - args1))) + ((FStarC_List.length args0) = + (FStarC_List.length args1))) then maybe_unfold_and_retry t01 t11 else (let compare_head_and_args uu___11 = @@ -3027,11 +3022,8 @@ let rec (check_relation : if Prims.op_Negation (head_matches1 && - ((FStarC_Compiler_List.length - args0) - = - (FStarC_Compiler_List.length - args1))) + ((FStarC_List.length args0) = + (FStarC_List.length args1))) then maybe_unfold_and_retry t01 t11 else (let compare_head_and_args uu___11 = @@ -3099,11 +3091,8 @@ let rec (check_relation : if Prims.op_Negation (head_matches1 && - ((FStarC_Compiler_List.length - args0) - = - (FStarC_Compiler_List.length - args1))) + ((FStarC_List.length args0) = + (FStarC_List.length args1))) then maybe_unfold_and_retry t01 t11 else (let compare_head_and_args uu___11 = @@ -3441,7 +3430,7 @@ let rec (check_relation : FStarC_Syntax_Syntax.mk_Tm_app e1 uu___24 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStar_Pervasives_Native.Some uu___23) else @@ -3600,7 +3589,7 @@ let rec (check_relation : | FStar_Pervasives_Native.Some (uu___17, bvs0) -> let bs0 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs0 in let uu___18 = @@ -3689,9 +3678,7 @@ and (check_relation_args : fun rel -> fun a0 -> fun a1 -> - if - (FStarC_Compiler_List.length a0) = - (FStarC_Compiler_List.length a1) + if (FStarC_List.length a0) = (FStarC_List.length a1) then iter2 a0 a1 (fun uu___ -> @@ -3729,14 +3716,18 @@ and (check_relation_comp : let uu___ = FStarC_Syntax_Util.is_total_comp c in if uu___ then - FStar_Pervasives_Native.Some - (E_Total, (FStarC_Syntax_Util.comp_result c)) + let uu___1 = + let uu___2 = FStarC_Syntax_Util.comp_result c in + (E_Total, uu___2) in + FStar_Pervasives_Native.Some uu___1 else (let uu___2 = FStarC_Syntax_Util.is_tot_or_gtot_comp c in if uu___2 then - FStar_Pervasives_Native.Some - (E_Ghost, (FStarC_Syntax_Util.comp_result c)) + let uu___3 = + let uu___4 = FStarC_Syntax_Util.comp_result c in + (E_Ghost, uu___4) in + FStar_Pervasives_Native.Some uu___3 else FStar_Pervasives_Native.None) in let uu___ = let uu___1 = destruct_comp c0 in @@ -3803,7 +3794,7 @@ and (check_relation_comp : let uu___12 = FStarC_Ident.string_of_lid ct1.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Subcomp failed: Unequal computation types %s and %s" uu___11 uu___12 in fail uu___10)))) @@ -3868,7 +3859,7 @@ and (check_relation_comp : let uu___12 = FStarC_Ident.string_of_lid ct1.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Subcomp failed: Unequal computation types %s and %s" uu___11 uu___12 in fail uu___10)))) @@ -4052,7 +4043,7 @@ and (do_check : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in - FStarC_Compiler_Util.format1 "Variable not found: %s" uu___2 in + FStarC_Util.format1 "Variable not found: %s" uu___2 in fail uu___1 | FStar_Pervasives_Native.Some (t, uu___1) -> (fun uu___2 -> @@ -4082,8 +4073,7 @@ and (do_check : let uu___5 = FStarC_Ident.string_of_lid (f.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 "Top-level name not found: %s" - uu___5 in + FStarC_Util.format1 "Top-level name not found: %s" uu___5 in fail uu___4 | FStar_Pervasives_Native.Some (t, uu___4) -> (fun uu___5 -> @@ -5039,7 +5029,7 @@ and (do_check : (let uu___5 = let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect ascriptions are not fully handled yet: %s" uu___6 in fail uu___5) | FStarC_Syntax_Syntax.Tm_let @@ -5303,7 +5293,7 @@ and (do_check : FStarC_Class_Show.show FStarC_Ident.showable_lident lb.FStarC_Syntax_Syntax.lbeff in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Let binding is effectful (lbeff = %s)" uu___5 in fail uu___4))) | FStarC_Syntax_Syntax.Tm_match @@ -5455,7 +5445,7 @@ and (do_check : FStarC_TypeChecker_PatternUtils.raw_pat_as_exp g.tcenv p1 in - FStarC_Compiler_Util.must + FStarC_Util.must uu___21 in FStar_Pervasives_Native.fst uu___20 in @@ -6209,7 +6199,7 @@ and (do_check : FStarC_TypeChecker_PatternUtils.raw_pat_as_exp g.tcenv p1 in - FStarC_Compiler_Util.must + FStarC_Util.must uu___30 in FStar_Pervasives_Native.fst uu___29 in @@ -6624,7 +6614,7 @@ and (do_check : let uu___1 = let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term e1 in - FStarC_Compiler_Util.format1 "Unexpected term: %s" uu___2 in + FStarC_Util.format1 "Unexpected term: %s" uu___2 in fail uu___1 and (check_binders : env -> @@ -6704,7 +6694,8 @@ and (check_comp : match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Total t -> let uu___ = - check "(G)Tot comp result" g (FStarC_Syntax_Util.comp_result c) in + let uu___1 = FStarC_Syntax_Util.comp_result c in + check "(G)Tot comp result" g uu___1 in (fun ctx0 -> let uu___1 = uu___ ctx0 in match uu___1 with @@ -6720,7 +6711,8 @@ and (check_comp : | Error err -> Error err) | FStarC_Syntax_Syntax.GTotal t -> let uu___ = - check "(G)Tot comp result" g (FStarC_Syntax_Util.comp_result c) in + let uu___1 = FStarC_Syntax_Util.comp_result c in + check "(G)Tot comp result" g uu___1 in (fun ctx0 -> let uu___1 = uu___ ctx0 in match uu___1 with @@ -6736,12 +6728,11 @@ and (check_comp : | Error err -> Error err) | FStarC_Syntax_Syntax.Comp ct -> if - (FStarC_Compiler_List.length ct.FStarC_Syntax_Syntax.comp_univs) - <> Prims.int_one + (FStarC_List.length ct.FStarC_Syntax_Syntax.comp_univs) <> + Prims.int_one then fail "Unexpected/missing universe instantitation in comp" else - (let u = - FStarC_Compiler_List.hd ct.FStarC_Syntax_Syntax.comp_univs in + (let u = FStarC_List.hd ct.FStarC_Syntax_Syntax.comp_univs in let effect_app_tm = let head = let uu___1 = @@ -6793,7 +6784,7 @@ and (check_comp : let uu___10 = FStarC_TypeChecker_Env.lookup_effect_quals g.tcenv c_lid in - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun q -> q = FStarC_Syntax_Syntax.TotalEffect) @@ -6822,13 +6813,15 @@ and (check_comp : | FStar_Pervasives_Native.None -> let uu___14 = let uu___15 = + let uu___16 = + FStarC_Syntax_Util.comp_effect_name + c in FStarC_Ident.string_of_lid - (FStarC_Syntax_Util.comp_effect_name - c) in + uu___16 in let uu___16 = FStarC_Ident.string_of_lid c_lid in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Total effect %s (normalized to %s) does not have a representation" uu___15 uu___16 in fail uu___14 @@ -6989,9 +6982,9 @@ and (check_pat : | Error err -> Error err) | FStarC_Syntax_Syntax.Pat_cons (fv, usopt, pats) -> let us = - if FStarC_Compiler_Util.is_none usopt + if FStarC_Util.is_none usopt then [] - else FStarC_Compiler_Util.must usopt in + else FStarC_Util.must usopt in let uu___ = let uu___1 = let uu___2 = FStarC_Syntax_Syntax.lid_of_fv fv in @@ -7002,27 +6995,26 @@ and (check_pat : | (formals, t_pat) -> let uu___1 = let pats1 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - pats in + FStarC_List.map FStar_Pervasives_Native.fst pats in let uu___2 = let uu___3 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun p1 -> match p1.FStarC_Syntax_Syntax.v with | FStarC_Syntax_Syntax.Pat_dot_term uu___4 -> false | uu___4 -> true) pats1 in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun uu___4 -> match uu___4 with | (dot_pats, pat, rest_pats) -> (dot_pats, (pat :: rest_pats))) uu___3 in - FStarC_Compiler_Util.dflt (pats1, []) uu___2 in + FStarC_Util.dflt (pats1, []) uu___2 in (match uu___1 with | (dot_pats, rest_pats) -> let uu___2 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length dot_pats) formals in + FStarC_List.splitAt (FStarC_List.length dot_pats) + formals in (match uu___2 with | (dot_formals, rest_formals) -> let uu___3 = @@ -7229,7 +7221,7 @@ and (check_pat : FStarC_TypeChecker_PatternUtils.raw_pat_as_exp g2.tcenv p1 in - FStarC_Compiler_Util.must + FStarC_Util.must uu___18 in FStar_Pervasives_Native.fst uu___17 in @@ -7355,7 +7347,7 @@ and (check_scrutinee_pattern_type_compatible : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t_sc in let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t_pat in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Scrutinee type %s and Pattern type %s are not compatible because %s" uu___1 uu___2 s in fail uu___ in @@ -7417,7 +7409,7 @@ and (check_scrutinee_pattern_type_compatible : let uu___8 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term head_pat in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Head constructors(%s and %s) not fvar" uu___7 uu___8 in err uu___6 in @@ -7441,7 +7433,7 @@ and (check_scrutinee_pattern_type_compatible : let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv x in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "%s is not a type constructor" uu___10 in err uu___9) in fun ctx01 -> @@ -7452,11 +7444,8 @@ and (check_scrutinee_pattern_type_compatible : let uu___9 = let uu___10 = if - (FStarC_Compiler_List.length - args_sc) - = - (FStarC_Compiler_List.length - args_pat) + (FStarC_List.length args_sc) = + (FStarC_List.length args_pat) then fun uu___11 -> Success @@ -7465,14 +7454,12 @@ and (check_scrutinee_pattern_type_compatible : else (let uu___12 = let uu___13 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length - args_sc) in + FStarC_Util.string_of_int + (FStarC_List.length args_sc) in let uu___14 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length - args_pat) in - FStarC_Compiler_Util.format2 + FStarC_Util.string_of_int + (FStarC_List.length args_pat) in + FStarC_Util.format2 "Number of arguments don't match (%s and %s)" uu___13 uu___14 in err uu___12) in @@ -7496,13 +7483,13 @@ and (check_scrutinee_pattern_type_compatible : n -> let uu___16 = let uu___17 = - FStarC_Compiler_Util.first_N + FStarC_Util.first_N n args_sc in FStar_Pervasives_Native.fst uu___17 in let uu___17 = let uu___18 = - FStarC_Compiler_Util.first_N + FStarC_Util.first_N n args_pat in FStar_Pervasives_Native.fst uu___18 in @@ -7643,7 +7630,7 @@ and (pattern_branch_condition : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (s, b) -> @@ -7690,7 +7677,7 @@ and (pattern_branch_condition : match uu___ with | (ith_pat_var, ith_pat) -> let sub_pats1 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun j -> fun uu___1 -> match uu___1 with @@ -7729,7 +7716,7 @@ and (pattern_branch_condition : | (is_induc, datacons) -> if (Prims.op_Negation is_induc) || - ((FStarC_Compiler_List.length datacons) > Prims.int_one) + ((FStarC_List.length datacons) > Prims.int_one) then let discriminator = FStarC_Syntax_Util.mk_discriminator @@ -7772,7 +7759,7 @@ and (pattern_branch_condition : let uu___2 = let uu___3 = let guards = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___4 -> match uu___4 with | FStar_Pervasives_Native.None -> [] @@ -7805,7 +7792,7 @@ let (initial_env : fun g -> fun gh -> let max_index = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun index -> fun b -> match b with @@ -7954,17 +7941,16 @@ let (check_term_top_gh : fun topt -> fun must_tot -> fun gh -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Eq in + (let uu___1 = FStarC_Effect.op_Bang dbg_Eq in if uu___1 then let uu___2 = let uu___3 = get_goal_ctr () in FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___3 in - FStarC_Compiler_Util.print1 "(%s) Entering core ... \n" uu___2 + FStarC_Util.print1 "(%s) Entering core ... \n" uu___2 else ()); (let uu___2 = - (FStarC_Compiler_Effect.op_Bang dbg) || - (FStarC_Compiler_Effect.op_Bang dbg_Top) in + (FStarC_Effect.op_Bang dbg) || (FStarC_Effect.op_Bang dbg_Top) in if uu___2 then let uu___3 = @@ -7976,8 +7962,8 @@ let (check_term_top_gh : FStarC_Class_Show.show (FStarC_Class_Show.show_option FStarC_Syntax_Print.showable_term) topt in - FStarC_Compiler_Util.print3 - "(%s) Entering core with %s <: %s\n" uu___3 uu___4 uu___5 + FStarC_Util.print3 "(%s) Entering core with %s <: %s\n" uu___3 + uu___4 uu___5 else ()); FStarC_Syntax_TermHashTable.reset_counters table; reset_cache_stats (); @@ -8004,34 +7990,34 @@ let (check_term_top_gh : FStarC_TypeChecker_Normalize.normalize simplify_steps g guard0 in ((let uu___5 = - ((FStarC_Compiler_Effect.op_Bang dbg) || - (FStarC_Compiler_Effect.op_Bang dbg_Top)) - || (FStarC_Compiler_Effect.op_Bang dbg_Exit) in + ((FStarC_Effect.op_Bang dbg) || + (FStarC_Effect.op_Bang dbg_Top)) + || (FStarC_Effect.op_Bang dbg_Exit) in if uu___5 then ((let uu___7 = let uu___8 = get_goal_ctr () in - FStarC_Compiler_Util.string_of_int uu___8 in + FStarC_Util.string_of_int uu___8 in let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term guard0 in let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term guard1 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "(%s) Exiting core: Simplified guard from {{%s}} to {{%s}}\n" uu___7 uu___8 uu___9); (let guard_names = let uu___7 = FStarC_Syntax_Free.names guard1 in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___7) in let uu___7 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun bv -> - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun binding_env -> match binding_env with | FStarC_Syntax_Syntax.Binding_var @@ -8049,7 +8035,7 @@ let (check_term_top_gh : FStarC_Syntax_Syntax.bv_to_name bv in FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___9 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "WARNING: %s is free in the core generated guard\n" uu___8 | uu___8 -> ())) @@ -8057,38 +8043,37 @@ let (check_term_top_gh : Success (et, (FStar_Pervasives_Native.Some guard1))) | Success uu___4 -> ((let uu___6 = - (FStarC_Compiler_Effect.op_Bang dbg) || - (FStarC_Compiler_Effect.op_Bang dbg_Top) in + (FStarC_Effect.op_Bang dbg) || + (FStarC_Effect.op_Bang dbg_Top) in if uu___6 then let uu___7 = let uu___8 = get_goal_ctr () in - FStarC_Compiler_Util.string_of_int uu___8 in - FStarC_Compiler_Util.print1 "(%s) Exiting core (ok)\n" - uu___7 + FStarC_Util.string_of_int uu___8 in + FStarC_Util.print1 "(%s) Exiting core (ok)\n" uu___7 else ()); res) | Error uu___4 -> ((let uu___6 = - (FStarC_Compiler_Effect.op_Bang dbg) || - (FStarC_Compiler_Effect.op_Bang dbg_Top) in + (FStarC_Effect.op_Bang dbg) || + (FStarC_Effect.op_Bang dbg_Top) in if uu___6 then let uu___7 = let uu___8 = get_goal_ctr () in - FStarC_Compiler_Util.string_of_int uu___8 in - FStarC_Compiler_Util.print1 - "(%s) Exiting core (failed)\n" uu___7 + FStarC_Util.string_of_int uu___8 in + FStarC_Util.print1 "(%s) Exiting core (failed)\n" + uu___7 else ()); res) in - (let uu___5 = FStarC_Compiler_Effect.op_Bang dbg_Eq in + (let uu___5 = FStarC_Effect.op_Bang dbg_Eq in if uu___5 then (FStarC_Syntax_TermHashTable.print_stats table; (let cs = report_cache_stats () in - let uu___7 = FStarC_Compiler_Util.string_of_int cs.hits in - let uu___8 = FStarC_Compiler_Util.string_of_int cs.misses in - FStarC_Compiler_Util.print2 + let uu___7 = FStarC_Util.string_of_int cs.hits in + let uu___8 = FStarC_Util.string_of_int cs.misses in + FStarC_Util.print2 "Cache_stats { hits = %s; misses = %s }\n" uu___7 uu___8)) else ()); res1) @@ -8191,7 +8176,7 @@ let (check_term_equality : fun t0 -> fun t1 -> let g1 = initial_env g FStar_Pervasives_Native.None in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Top in + (let uu___1 = FStarC_Effect.op_Bang dbg_Top in if uu___1 then let uu___2 = @@ -8204,7 +8189,7 @@ let (check_term_equality : let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool unfolding_ok1 in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Entering check_term_equality with %s and %s (guard_ok=%s; unfolding_ok=%s) {\n" uu___2 uu___3 uu___4 uu___5 else ()); @@ -8216,7 +8201,7 @@ let (check_term_equality : } in let r = let uu___1 = check_relation g1 EQUALITY t0 t1 in uu___1 ctx in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Top in + (let uu___2 = FStarC_Effect.op_Bang dbg_Top in if uu___2 then let uu___3 = @@ -8230,7 +8215,7 @@ let (check_term_equality : FStarC_Class_Show.showable_unit (FStarC_Class_Show.show_option FStarC_Syntax_Print.showable_term))) r in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "} Exiting check_term_equality (%s, %s). Result = %s.\n" uu___3 uu___4 uu___5 else ()); diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_DMFF.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_DMFF.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_DMFF.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_DMFF.ml index 833313ca41a..42d96271952 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_DMFF.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_DMFF.ml @@ -15,10 +15,9 @@ let (__proj__Mkenv__item__tc_const : env -> FStarC_Const.sconst -> FStarC_Syntax_Syntax.typ) = fun projectee -> match projectee with | { tcenv; subst; tc_const;_} -> tc_const -let (dbg : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ED" +let (dbg : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "ED" let (d : Prims.string -> unit) = - fun s -> FStarC_Compiler_Util.print1 "\027[01;36m%s\027[00m\n" s + fun s -> FStarC_Util.print1 "\027[01;36m%s\027[00m\n" s let (mk_toplevel_definition : FStarC_TypeChecker_Env.env_t -> FStarC_Ident.lident -> @@ -28,7 +27,7 @@ let (mk_toplevel_definition : fun env1 -> fun lident -> fun def -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___1 = FStarC_Effect.op_Bang dbg in if uu___1 then ((let uu___3 = FStarC_Ident.string_of_lid lident in d uu___3); @@ -36,18 +35,21 @@ let (mk_toplevel_definition : FStarC_Class_Show.show FStarC_Ident.showable_lident lident in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term def in - FStarC_Compiler_Util.print2 - "Registering top-level definition: %s\n%s\n" uu___3 uu___4)) + FStarC_Util.print2 "Registering top-level definition: %s\n%s\n" + uu___3 uu___4)) else ()); (let fv = FStarC_Syntax_Syntax.lid_and_dd_as_fv lident FStar_Pervasives_Native.None in let lbname = FStar_Pervasives.Inr fv in let lb = - (false, - [FStarC_Syntax_Util.mk_letbinding lbname [] - FStarC_Syntax_Syntax.tun FStarC_Parser_Const.effect_Tot_lid - def [] FStarC_Compiler_Range_Type.dummyRange]) in + let uu___1 = + let uu___2 = + FStarC_Syntax_Util.mk_letbinding lbname [] + FStarC_Syntax_Syntax.tun FStarC_Parser_Const.effect_Tot_lid + def [] FStarC_Range_Type.dummyRange in + [uu___2] in + (false, uu___1) in let sig_ctx = FStarC_Syntax_Syntax.mk_sigelt (FStarC_Syntax_Syntax.Sig_let @@ -57,7 +59,7 @@ let (mk_toplevel_definition : }) in let uu___1 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_fvar fv) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in ({ FStarC_Syntax_Syntax.sigel = (sig_ctx.FStarC_Syntax_Syntax.sigel); FStarC_Syntax_Syntax.sigrng = @@ -104,16 +106,15 @@ let (gen_wps_for_free : FStarC_Syntax_Syntax.index = (a.FStarC_Syntax_Syntax.index); FStarC_Syntax_Syntax.sort = uu___ } in - let d1 s = - FStarC_Compiler_Util.print1 "\027[01;36m%s\027[00m\n" s in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg in + let d1 s = FStarC_Util.print1 "\027[01;36m%s\027[00m\n" s in + (let uu___1 = FStarC_Effect.op_Bang dbg in if uu___1 then (d1 "Elaborating extra WP combinators"; (let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term wp_a1 in - FStarC_Compiler_Util.print1 "wp_a is: %s\n" uu___3)) + FStarC_Util.print1 "wp_a is: %s\n" uu___3)) else ()); (let rec collect_binders t = let t1 = FStarC_Syntax_Util.unascribe t in @@ -133,7 +134,7 @@ let (gen_wps_for_free : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp comp in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "wp_a contains non-Tot arrow: %s" uu___4 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) comp @@ -142,14 +143,14 @@ let (gen_wps_for_free : FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___3) in let uu___2 = collect_binders rest in - FStarC_Compiler_List.op_At bs uu___2 + FStarC_List.op_At bs uu___2 | FStarC_Syntax_Syntax.Tm_type uu___2 -> [] | uu___2 -> let uu___3 = let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "wp_a doesn't end in Type0, but rather in %s" uu___4 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) t1 @@ -160,7 +161,7 @@ let (gen_wps_for_free : let gamma = let uu___1 = collect_binders wp_a1 in FStarC_Syntax_Util.name_binders uu___1 in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___2 = FStarC_Effect.op_Bang dbg in if uu___2 then let uu___3 = @@ -168,14 +169,13 @@ let (gen_wps_for_free : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) gamma in - FStarC_Compiler_Util.format1 "Gamma is %s\n" uu___4 in + FStarC_Util.format1 "Gamma is %s\n" uu___4 in d1 uu___3 else ()); (let unknown = FStarC_Syntax_Syntax.tun in let mk x = - FStarC_Syntax_Syntax.mk x - FStarC_Compiler_Range_Type.dummyRange in - let sigelts = FStarC_Compiler_Util.mk_ref [] in + FStarC_Syntax_Syntax.mk x FStarC_Range_Type.dummyRange in + let sigelts = FStarC_Util.mk_ref [] in let register env2 lident def = let uu___2 = mk_toplevel_definition env2 lident def in match uu___2 with @@ -211,12 +211,12 @@ let (gen_wps_for_free : (sigelt.FStarC_Syntax_Syntax.sigopts) } in ((let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang sigelts in - sigelt1 :: uu___5 in - FStarC_Compiler_Effect.op_Colon_Equals sigelts uu___4); + let uu___5 = FStarC_Effect.op_Bang sigelts in sigelt1 + :: uu___5 in + FStarC_Effect.op_Colon_Equals sigelts uu___4); fv) in let binders_of_list = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (t, b) -> @@ -225,7 +225,7 @@ let (gen_wps_for_free : FStarC_Syntax_Syntax.mk_binder_with_attrs t uu___3 FStar_Pervasives_Native.None []) in let mk_all_implicit = - FStarC_Compiler_List.map + FStarC_List.map (fun t -> let uu___2 = FStarC_Syntax_Syntax.as_bqual_implicit true in { @@ -238,7 +238,7 @@ let (gen_wps_for_free : (t.FStarC_Syntax_Syntax.binder_attrs) }) in let args_of_binders = - FStarC_Compiler_List.map + FStarC_List.map (fun bv -> let uu___2 = FStarC_Syntax_Syntax.bv_to_name @@ -262,7 +262,7 @@ let (gen_wps_for_free : let uu___8 = FStarC_Syntax_Syntax.mk_binder t in [uu___8] in uu___6 :: uu___7 in - FStarC_Compiler_List.op_At binders uu___5 in + FStarC_List.op_At binders uu___5 in FStarC_Syntax_Util.abs uu___4 body FStar_Pervasives_Native.None in let uu___4 = mk1 FStarC_Syntax_Syntax.mk_Total in @@ -279,7 +279,7 @@ let (gen_wps_for_free : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | { FStarC_Syntax_Syntax.binder_bv = bv; @@ -312,7 +312,7 @@ let (gen_wps_for_free : (t, uu___12) in [uu___11] in uu___9 :: uu___10 in - FStarC_Compiler_List.op_At uu___7 uu___8 in + FStarC_List.op_At uu___7 uu___8 in { FStarC_Syntax_Syntax.hd = fv; FStarC_Syntax_Syntax.args = uu___6 @@ -344,7 +344,7 @@ let (gen_wps_for_free : let uu___4 = mk_all_implicit binders in let uu___5 = binders_of_list [(a1, true); (t, true); (x, false)] in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___4 uu___5 in FStarC_Syntax_Util.abs uu___3 body ret in let c_pure1 = let uu___3 = mk_lid "pure" in register env2 uu___3 c_pure in @@ -401,7 +401,7 @@ let (gen_wps_for_free : gamma_as_args in FStarC_Syntax_Syntax.as_arg uu___7 in [uu___6] in - FStarC_Compiler_List.op_At gamma_as_args uu___5 in + FStarC_List.op_At gamma_as_args uu___5 in FStarC_Syntax_Util.mk_app uu___3 uu___4 in FStarC_Syntax_Util.abs gamma inner_body ret in let uu___3 = @@ -413,7 +413,7 @@ let (gen_wps_for_free : (t2, true); (l, false); (r, false)] in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___4 uu___5 in FStarC_Syntax_Util.abs uu___3 outer_body ret in let c_app1 = let uu___3 = mk_lid "app" in register env2 uu___3 c_app in @@ -459,7 +459,7 @@ let (gen_wps_for_free : (t2, true); (f, false); (a11, false)] in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___4 uu___5 in let uu___4 = let uu___5 = let uu___6 = @@ -469,15 +469,14 @@ let (gen_wps_for_free : let uu___10 = FStarC_Syntax_Syntax.bv_to_name f in [uu___10] in - FStarC_Compiler_List.map - FStarC_Syntax_Syntax.as_arg uu___9 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg + uu___9 in FStarC_Syntax_Util.mk_app c_pure1 uu___8 in let uu___8 = let uu___9 = FStarC_Syntax_Syntax.bv_to_name a11 in [uu___9] in uu___7 :: uu___8 in - FStarC_Compiler_List.map FStarC_Syntax_Syntax.as_arg - uu___6 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___6 in FStarC_Syntax_Util.mk_app c_app1 uu___5 in FStarC_Syntax_Util.abs uu___3 uu___4 ret in let c_lift11 = @@ -541,7 +540,7 @@ let (gen_wps_for_free : (f, false); (a11, false); (a2, false)] in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___4 uu___5 in let uu___4 = let uu___5 = let uu___6 = @@ -554,7 +553,7 @@ let (gen_wps_for_free : let uu___13 = FStarC_Syntax_Syntax.bv_to_name f in [uu___13] in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___12 in FStarC_Syntax_Util.mk_app c_pure1 uu___11 in let uu___11 = @@ -562,15 +561,14 @@ let (gen_wps_for_free : FStarC_Syntax_Syntax.bv_to_name a11 in [uu___12] in uu___10 :: uu___11 in - FStarC_Compiler_List.map - FStarC_Syntax_Syntax.as_arg uu___9 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg + uu___9 in FStarC_Syntax_Util.mk_app c_app1 uu___8 in let uu___8 = let uu___9 = FStarC_Syntax_Syntax.bv_to_name a2 in [uu___9] in uu___7 :: uu___8 in - FStarC_Compiler_List.map FStarC_Syntax_Syntax.as_arg - uu___6 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___6 in FStarC_Syntax_Util.mk_app c_app1 uu___5 in FStarC_Syntax_Util.abs uu___3 uu___4 ret in let c_lift21 = @@ -624,7 +622,7 @@ let (gen_wps_for_free : let uu___4 = let uu___5 = FStarC_Syntax_Syntax.mk_binder e1 in [uu___5] in - FStarC_Compiler_List.op_At gamma uu___4 in + FStarC_List.op_At gamma uu___4 in let uu___4 = let uu___5 = FStarC_Syntax_Syntax.bv_to_name f in let uu___6 = @@ -640,15 +638,15 @@ let (gen_wps_for_free : let uu___5 = binders_of_list [(a1, true); (t1, true); (t2, true); (f, false)] in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.op_At uu___4 uu___5 in FStarC_Syntax_Util.abs uu___3 body ret in let c_push1 = let uu___3 = mk_lid "push" in register env2 uu___3 c_push in let ret_tot_wp_a = - FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot wp_a1) in + let uu___3 = FStarC_Syntax_Util.residual_tot wp_a1 in + FStar_Pervasives_Native.Some uu___3 in let mk_generic_app c = - if (FStarC_Compiler_List.length binders) > Prims.int_zero + if (FStarC_List.length binders) > Prims.int_zero then let uu___3 = let uu___4 = @@ -679,7 +677,7 @@ let (gen_wps_for_free : let uu___3 = let uu___4 = FStarC_Syntax_Syntax.binders_of_list [a1; c] in - FStarC_Compiler_List.op_At binders uu___4 in + FStarC_List.op_At binders uu___4 in let uu___4 = let l_ite = FStarC_Syntax_Syntax.fvar_with_dd @@ -697,8 +695,7 @@ let (gen_wps_for_free : [uu___10] in FStarC_Syntax_Util.mk_app l_ite uu___9 in [uu___8] in - FStarC_Compiler_List.map - FStarC_Syntax_Syntax.as_arg uu___7 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___7 in FStarC_Syntax_Util.mk_app c_lift21 uu___6 in FStarC_Syntax_Util.ascribe uu___5 ((FStar_Pervasives.Inr result_comp), @@ -732,8 +729,7 @@ let (gen_wps_for_free : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_List.map - FStarC_Syntax_Syntax.as_arg + FStarC_List.map FStarC_Syntax_Syntax.as_arg [FStarC_Syntax_Util.tforall] in FStarC_Syntax_Util.mk_app c_pure1 uu___6 in let uu___6 = @@ -743,27 +739,27 @@ let (gen_wps_for_free : let uu___10 = FStarC_Syntax_Syntax.bv_to_name f in [uu___10] in - FStarC_Compiler_List.map - FStarC_Syntax_Syntax.as_arg uu___9 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg + uu___9 in FStarC_Syntax_Util.mk_app c_push1 uu___8 in [uu___7] in uu___5 :: uu___6 in - FStarC_Compiler_List.map FStarC_Syntax_Syntax.as_arg - uu___4 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___4 in FStarC_Syntax_Util.mk_app c_app1 uu___3 in let uu___3 = let uu___4 = FStarC_Syntax_Syntax.binders_of_list [a1; b; f] in - FStarC_Compiler_List.op_At binders uu___4 in + FStarC_List.op_At binders uu___4 in FStarC_Syntax_Util.abs uu___3 body ret_tot_wp_a in let wp_close1 = let uu___3 = mk_lid "wp_close" in register env2 uu___3 wp_close in let wp_close2 = mk_generic_app wp_close1 in let ret_tot_type = - FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot - FStarC_Syntax_Util.ktype) in + let uu___3 = + FStarC_Syntax_Util.residual_tot + FStarC_Syntax_Util.ktype in + FStar_Pervasives_Native.Some uu___3 in let ret_gtot_type = let uu___3 = let uu___4 = @@ -792,7 +788,7 @@ let (gen_wps_for_free : } in FStarC_Syntax_Syntax.Tm_app uu___4 in FStarC_Syntax_Syntax.mk uu___3 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let rec is_discrete t = let uu___3 = let uu___4 = FStarC_Syntax_Subst.compress t in @@ -803,7 +799,7 @@ let (gen_wps_for_free : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} -> - (FStarC_Compiler_List.for_all + (FStarC_List.for_all (fun uu___4 -> match uu___4 with | { FStarC_Syntax_Syntax.binder_bv = b; @@ -813,7 +809,9 @@ let (gen_wps_for_free : FStarC_Syntax_Syntax.binder_attrs = uu___7;_} -> is_discrete b.FStarC_Syntax_Syntax.sort) bs) - && (is_discrete (FStarC_Syntax_Util.comp_result c)) + && + (let uu___4 = FStarC_Syntax_Util.comp_result c in + is_discrete uu___4) | uu___4 -> true in let rec is_monotonic t = let uu___3 = @@ -825,7 +823,7 @@ let (gen_wps_for_free : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} -> - (FStarC_Compiler_List.for_all + (FStarC_List.for_all (fun uu___4 -> match uu___4 with | { FStarC_Syntax_Syntax.binder_bv = b; @@ -836,7 +834,8 @@ let (gen_wps_for_free : -> is_discrete b.FStarC_Syntax_Syntax.sort) bs) && - (is_monotonic (FStarC_Syntax_Util.comp_result c)) + (let uu___4 = FStarC_Syntax_Util.comp_result c in + is_monotonic uu___4) | uu___4 -> is_discrete t in let rec mk_rel rel t x y = let mk_rel1 = mk_rel rel in @@ -1061,8 +1060,8 @@ let (gen_wps_for_free : let uu___4 = let uu___5 = FStarC_Parser_Const.mk_tuple_data_lid - (FStarC_Compiler_List.length args) - FStarC_Compiler_Range_Type.dummyRange in + (FStarC_List.length args) + FStarC_Range_Type.dummyRange in FStarC_TypeChecker_Env.lookup_projector env2 uu___5 i in FStarC_Syntax_Syntax.fvar_with_dd uu___4 @@ -1071,7 +1070,7 @@ let (gen_wps_for_free : [(tuple, FStar_Pervasives_Native.None)] in let uu___4 = let uu___5 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___6 -> match uu___6 with @@ -1086,7 +1085,7 @@ let (gen_wps_for_free : | rel0::rels -> (rel0, rels) in (match uu___4 with | (rel0, rels) -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left FStarC_Syntax_Util.mk_conj rel0 rels) | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = binders1; @@ -1099,7 +1098,7 @@ let (gen_wps_for_free : FStarC_Syntax_Syntax.hash_code = uu___6;_};_} -> let bvs = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___7 -> match uu___7 with @@ -1112,15 +1111,14 @@ let (gen_wps_for_free : -> let uu___10 = let uu___11 = - FStarC_Compiler_Util.string_of_int - i in + FStarC_Util.string_of_int i in Prims.strcat "a" uu___11 in FStarC_Syntax_Syntax.gen_bv uu___10 FStar_Pervasives_Native.None bv.FStarC_Syntax_Syntax.sort) binders1 in let args = - FStarC_Compiler_List.map + FStarC_List.map (fun ai -> let uu___7 = FStarC_Syntax_Syntax.bv_to_name ai in @@ -1129,7 +1127,7 @@ let (gen_wps_for_free : let uu___7 = FStarC_Syntax_Util.mk_app x args in let uu___8 = FStarC_Syntax_Util.mk_app y args in mk_stronger b uu___7 uu___8 in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun bv -> fun body1 -> mk_forall bv body1) bvs body | FStarC_Syntax_Syntax.Tm_arrow @@ -1143,7 +1141,7 @@ let (gen_wps_for_free : FStarC_Syntax_Syntax.hash_code = uu___6;_};_} -> let bvs = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___7 -> match uu___7 with @@ -1156,15 +1154,14 @@ let (gen_wps_for_free : -> let uu___10 = let uu___11 = - FStarC_Compiler_Util.string_of_int - i in + FStarC_Util.string_of_int i in Prims.strcat "a" uu___11 in FStarC_Syntax_Syntax.gen_bv uu___10 FStar_Pervasives_Native.None bv.FStarC_Syntax_Syntax.sort) binders1 in let args = - FStarC_Compiler_List.map + FStarC_List.map (fun ai -> let uu___7 = FStarC_Syntax_Syntax.bv_to_name ai in @@ -1173,7 +1170,7 @@ let (gen_wps_for_free : let uu___7 = FStarC_Syntax_Util.mk_app x args in let uu___8 = FStarC_Syntax_Util.mk_app y args in mk_stronger b uu___7 uu___8 in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun bv -> fun body1 -> mk_forall bv body1) bvs body | uu___4 -> failwith "Not a DM elaborated type" in @@ -1186,7 +1183,7 @@ let (gen_wps_for_free : let uu___4 = binders_of_list [(a1, false); (wp1, false); (wp2, false)] in - FStarC_Compiler_List.op_At binders uu___4 in + FStarC_List.op_At binders uu___4 in FStarC_Syntax_Util.abs uu___3 body ret_tot_type in let stronger1 = let uu___3 = mk_lid "stronger" in @@ -1196,7 +1193,7 @@ let (gen_wps_for_free : let wp = FStarC_Syntax_Syntax.gen_bv "wp" FStar_Pervasives_Native.None wp_a1 in - let uu___3 = FStarC_Compiler_Util.prefix gamma in + let uu___3 = FStarC_Util.prefix gamma in match uu___3 with | (wp_args, post) -> let k = @@ -1274,7 +1271,7 @@ let (gen_wps_for_free : FStarC_Syntax_Syntax.bv_to_name k in FStarC_Syntax_Syntax.as_arg uu___12 in [uu___11] in - FStarC_Compiler_List.op_At uu___9 uu___10 in + FStarC_List.op_At uu___9 uu___10 in FStarC_Syntax_Util.mk_app uu___7 uu___8 in FStarC_Syntax_Util.mk_imp equiv uu___6 in FStarC_Syntax_Util.mk_forall_no_univ k uu___5 in @@ -1282,7 +1279,7 @@ let (gen_wps_for_free : let uu___4 = let uu___5 = FStarC_Syntax_Syntax.binders_of_list [a1; wp] in - FStarC_Compiler_List.op_At binders uu___5 in + FStarC_List.op_At binders uu___5 in FStarC_Syntax_Util.abs uu___4 body ret_gtot_type in let ite_wp1 = let uu___3 = mk_lid "ite_wp" in @@ -1292,7 +1289,7 @@ let (gen_wps_for_free : let wp = FStarC_Syntax_Syntax.gen_bv "wp" FStar_Pervasives_Native.None wp_a1 in - let uu___3 = FStarC_Compiler_Util.prefix gamma in + let uu___3 = FStarC_Util.prefix gamma in match uu___3 with | (wp_args, post) -> let x = @@ -1316,8 +1313,8 @@ let (gen_wps_for_free : let uu___5 = let uu___6 = FStarC_Syntax_Syntax.binders_of_list [a1] in - FStarC_Compiler_List.op_At uu___6 gamma in - FStarC_Compiler_List.op_At binders uu___5 in + FStarC_List.op_At uu___6 gamma in + FStarC_List.op_At binders uu___5 in FStarC_Syntax_Util.abs uu___4 body ret_gtot_type in let null_wp1 = let uu___3 = mk_lid "null_wp" in @@ -1345,19 +1342,18 @@ let (gen_wps_for_free : [uu___9] in uu___7 :: uu___8 in uu___5 :: uu___6 in - FStarC_Compiler_List.map FStarC_Syntax_Syntax.as_arg - uu___4 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___4 in FStarC_Syntax_Util.mk_app stronger2 uu___3 in let uu___3 = let uu___4 = FStarC_Syntax_Syntax.binders_of_list [a1; wp] in - FStarC_Compiler_List.op_At binders uu___4 in + FStarC_List.op_At binders uu___4 in FStarC_Syntax_Util.abs uu___3 body ret_tot_type in let wp_trivial1 = let uu___3 = mk_lid "wp_trivial" in register env2 uu___3 wp_trivial in let wp_trivial2 = mk_generic_app wp_trivial1 in - ((let uu___4 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___4 = FStarC_Effect.op_Bang dbg in if uu___4 then d1 "End Dijkstra monads for free" else ()); (let c = FStarC_Syntax_Subst.close binders in let ed_combs = @@ -1396,8 +1392,8 @@ let (gen_wps_for_free : failwith "Impossible! For a DM4F effect combinators must be in DM4f_eff" in let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang sigelts in - FStarC_Compiler_List.rev uu___5 in + let uu___5 = FStarC_Effect.op_Bang sigelts in + FStarC_List.rev uu___5 in (uu___4, { FStarC_Syntax_Syntax.mname = @@ -1446,7 +1442,7 @@ let (nm_of_comp : match c.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Total t -> N t | FStarC_Syntax_Syntax.Comp c1 when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.CPS -> true @@ -1456,8 +1452,8 @@ let (nm_of_comp : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.format1 - "[nm_of_comp]: unexpected computation type %s" uu___2 in + FStarC_Util.format1 "[nm_of_comp]: unexpected computation type %s" + uu___2 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) c FStarC_Errors_Codes.Error_UnexpectedDM4FType () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -1468,11 +1464,11 @@ let (string_of_nm : nm -> Prims.string) = | N t -> let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 "N[%s]" uu___1 + FStarC_Util.format1 "N[%s]" uu___1 | M t -> let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 "M[%s]" uu___1 + FStarC_Util.format1 "M[%s]" uu___1 let (is_monadic_arrow : FStarC_Syntax_Syntax.term' -> nm) = fun n -> match n with @@ -1546,7 +1542,7 @@ and (star_type' : FStarC_Syntax_Syntax.comp = uu___;_} -> let binders1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___1 = let uu___2 = b.FStarC_Syntax_Syntax.binder_bv in @@ -1618,7 +1614,7 @@ and (star_type' : FStarC_Syntax_Syntax.mk_binder_with_attrs uu___8 uu___9 FStar_Pervasives_Native.None [] in [uu___7] in - FStarC_Compiler_List.op_At binders1 uu___6 in + FStarC_List.op_At binders1 uu___6 in let uu___6 = FStarC_Syntax_Syntax.mk_Total FStarC_Syntax_Util.ktype0 in @@ -1638,11 +1634,10 @@ and (star_type' : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in let uu___2 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set - FStarC_Syntax_Syntax.ord_bv + (FStarC_FlatSet.showable_set FStarC_Syntax_Syntax.ord_bv FStarC_Syntax_Print.showable_bv) s in - FStarC_Compiler_Util.format2 "Dependency found in term %s : %s" - uu___1 uu___2 in + FStarC_Util.format2 "Dependency found in term %s : %s" uu___1 + uu___2 in FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) t2 FStarC_Errors_Codes.Warning_DependencyFound () @@ -1673,21 +1668,21 @@ and (star_type' : Obj.magic (FStarC_Class_Setlike.inter () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___4) (Obj.magic s)) in let uu___4 = let uu___5 = FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic sinter) in Prims.op_Negation uu___5 in if uu___4 then (debug ty1 sinter; - FStarC_Compiler_Effect.raise Not_found) + FStarC_Effect.raise Not_found) else () in let uu___4 = FStarC_Syntax_Subst.open_comp binders c in @@ -1698,10 +1693,10 @@ and (star_type' : Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) ()) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___7 -> fun uu___6 -> (fun s1 -> @@ -1723,15 +1718,13 @@ and (star_type' : (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) bv (Obj.magic s1)))) uu___7 uu___6) uu___5 binders1 in let ct = FStarC_Syntax_Util.comp_result c1 in (non_dependent_or_raise s ct; - (let k = - n - - (FStarC_Compiler_List.length binders1) in + (let k = n - (FStarC_List.length binders1) in if k > Prims.int_zero then is_non_dependent_arrow ct k else true)))) () @@ -1741,8 +1734,7 @@ and (star_type' : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ty in - FStarC_Compiler_Util.format1 "Not a dependent arrow : %s" - uu___4 in + FStarC_Util.format1 "Not a dependent arrow : %s" uu___4 in FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) ty FStarC_Errors_Codes.Warning_NotDependentArrow () @@ -1774,8 +1766,7 @@ and (star_type' : (match uu___1 with | ((uu___2, ty), uu___3) -> let uu___4 = - is_non_dependent_arrow ty - (FStarC_Compiler_List.length args) in + is_non_dependent_arrow ty (FStarC_List.length args) in if uu___4 then let res = @@ -1797,7 +1788,7 @@ and (star_type' : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term head1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Got a term which might be a non-dependent user-defined data-type %s\n" uu___9 in FStarC_Errors.log_issue @@ -1821,7 +1812,7 @@ and (star_type' : let uu___1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (t2, qual) -> @@ -1837,7 +1828,7 @@ and (star_type' : (let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "For now, only [either], [option] and [eq2] are supported in the definition language (got: %s)" uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_WrongTerm @@ -1933,7 +1924,8 @@ and (star_type' : let uu___3 = let uu___4 = let uu___5 = - star_type' env1 (FStarC_Syntax_Util.comp_result c) in + let uu___6 = FStarC_Syntax_Util.comp_result c in + star_type' env1 uu___6 in FStar_Pervasives.Inl uu___5 in (uu___4, FStar_Pervasives_Native.None, use_eq) in { @@ -1952,7 +1944,7 @@ and (star_type' : let uu___5 = let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Ascriptions with tactics are outside of the definition language: %s" uu___6 in FStarC_Errors.raise_error0 @@ -1965,7 +1957,7 @@ and (star_type' : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is outside of the definition language: %s" uu___2 uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TermOutsideOfDefLanguage () @@ -1977,7 +1969,7 @@ and (star_type' : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is outside of the definition language: %s" uu___2 uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TermOutsideOfDefLanguage () @@ -1989,7 +1981,7 @@ and (star_type' : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is outside of the definition language: %s" uu___2 uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TermOutsideOfDefLanguage () @@ -2001,7 +1993,7 @@ and (star_type' : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is outside of the definition language: %s" uu___2 uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TermOutsideOfDefLanguage () @@ -2013,7 +2005,7 @@ and (star_type' : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is outside of the definition language: %s" uu___2 uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TermOutsideOfDefLanguage () @@ -2025,7 +2017,7 @@ and (star_type' : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is outside of the definition language: %s" uu___2 uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TermOutsideOfDefLanguage () @@ -2037,7 +2029,7 @@ and (star_type' : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is outside of the definition language: %s" uu___2 uu___3 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TermOutsideOfDefLanguage () @@ -2049,7 +2041,7 @@ and (star_type' : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t1 in let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "%s is outside of the definition language: %s" uu___1 uu___2 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_TermOutsideOfDefLanguage () @@ -2067,7 +2059,7 @@ let (is_monadic : match uu___ with | FStar_Pervasives_Native.None -> failwith "un-annotated lambda?!" | FStar_Pervasives_Native.Some rc -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.CPS -> true @@ -2083,14 +2075,14 @@ let rec (is_C : FStarC_Syntax_Syntax.typ -> Prims.bool) = when FStarC_Syntax_Util.is_tuple_constructor head -> let r = let uu___1 = - let uu___2 = FStarC_Compiler_List.hd args in + let uu___2 = FStarC_List.hd args in FStar_Pervasives_Native.fst uu___2 in is_C uu___1 in if r then ((let uu___2 = let uu___3 = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___4 -> match uu___4 with | (h, uu___5) -> is_C h) args in Prims.op_Negation uu___3 in @@ -2099,8 +2091,7 @@ let rec (is_C : FStarC_Syntax_Syntax.typ -> Prims.bool) = let uu___3 = let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 "Not a C-type (A * C): %s" - uu___4 in + FStarC_Util.format1 "Not a C-type (A * C): %s" uu___4 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) t FStarC_Errors_Codes.Error_UnexpectedDM4FType () @@ -2111,7 +2102,7 @@ let rec (is_C : FStarC_Syntax_Syntax.typ -> Prims.bool) = else ((let uu___3 = let uu___4 = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___5 -> match uu___5 with | (h, uu___6) -> @@ -2123,8 +2114,7 @@ let rec (is_C : FStarC_Syntax_Syntax.typ -> Prims.bool) = let uu___4 = let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 "Not a C-type (C * A): %s" - uu___5 in + FStarC_Util.format1 "Not a C-type (C * A): %s" uu___5 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) t FStarC_Errors_Codes.Error_UnexpectedDM4FType () @@ -2146,8 +2136,7 @@ let rec (is_C : FStarC_Syntax_Syntax.typ -> Prims.bool) = let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format1 "Not a C-type (C -> C): %s" - uu___5 in + FStarC_Util.format1 "Not a C-type (C -> C): %s" uu___5 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) t1 FStarC_Errors_Codes.Error_UnexpectedDM4FType () @@ -2169,8 +2158,7 @@ let rec (is_C : FStarC_Syntax_Syntax.typ -> Prims.bool) = let (mk_return : env -> FStarC_Syntax_Syntax.typ -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = fun env1 -> fun t -> @@ -2196,9 +2184,11 @@ let (mk_return : FStarC_Syntax_Syntax.Tm_app uu___1 in mk uu___ in let uu___ = let uu___1 = FStarC_Syntax_Syntax.mk_binder p in [uu___1] in - FStarC_Syntax_Util.abs uu___ body - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot FStarC_Syntax_Util.ktype0)) + let uu___1 = + let uu___2 = + FStarC_Syntax_Util.residual_tot FStarC_Syntax_Util.ktype0 in + FStar_Pervasives_Native.Some uu___2 in + FStarC_Syntax_Util.abs uu___ body uu___1 let (is_unknown : FStarC_Syntax_Syntax.term' -> Prims.bool) = fun uu___ -> match uu___ with @@ -2236,7 +2226,7 @@ let rec (check : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "[check]: the expression [%s] has type [%s] but should have type [%s]" uu___3 uu___4 uu___5 in FStarC_Errors.raise_error0 @@ -2262,7 +2252,7 @@ let rec (check : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "[check %s]: got an effectful computation [%s] in lieu of a pure computation [%s]" uu___2 uu___3 uu___4 in FStarC_Errors.raise_error0 @@ -2339,7 +2329,7 @@ let rec (check : let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "[check]: Tm_let %s" uu___3 in + FStarC_Util.format1 "[check]: Tm_let %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_type uu___1 -> failwith "impossible (DM stratification)" @@ -2349,13 +2339,13 @@ let rec (check : let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "[check]: Tm_refine %s" uu___3 in + FStarC_Util.format1 "[check]: Tm_refine %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_uvar uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "[check]: Tm_uvar %s" uu___3 in + FStarC_Util.format1 "[check]: Tm_uvar %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_delayed uu___1 -> failwith "impossible (compressed)" @@ -2363,7 +2353,7 @@ let rec (check : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "[check]: Tm_unknown %s" uu___2 in + FStarC_Util.format1 "[check]: Tm_unknown %s" uu___2 in failwith uu___1 and (infer : env -> @@ -2411,8 +2401,7 @@ and (infer : let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_Util.must - rc.FStarC_Syntax_Syntax.residual_typ in + FStarC_Util.must rc.FStarC_Syntax_Syntax.residual_typ in FStarC_Syntax_Subst.subst subst uu___4 in FStar_Pervasives_Native.Some uu___3 in { @@ -2436,7 +2425,7 @@ and (infer : tc_const = (env1.tc_const) } in let s_binders = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let sort = star_type' env2 @@ -2459,7 +2448,7 @@ and (infer : (b.FStarC_Syntax_Syntax.binder_attrs) }) binders1 in let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun uu___3 -> match (uu___2, uu___3) with @@ -2531,7 +2520,7 @@ and (infer : (env3, uu___9))) (env2, []) binders1 in (match uu___1 with | (env3, u_binders) -> - let u_binders1 = FStarC_Compiler_List.rev u_binders in + let u_binders1 = FStarC_List.rev u_binders in let uu___2 = let check_what = let uu___3 = is_monadic rc_opt1 in @@ -2557,7 +2546,7 @@ and (infer : | FStar_Pervasives_Native.None -> let rc1 = let uu___3 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___4 -> match uu___4 with | FStarC_Syntax_Syntax.CPS -> true @@ -2566,7 +2555,7 @@ and (infer : if uu___3 then let uu___4 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___5 -> match uu___5 with | FStarC_Syntax_Syntax.CPS -> false @@ -2590,7 +2579,7 @@ and (infer : FStarC_TypeChecker_Env.EraseUniverses] uu___3 rt in let uu___3 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___4 -> match uu___4 with | FStarC_Syntax_Syntax.CPS -> true @@ -2599,7 +2588,7 @@ and (infer : if uu___3 then let flags = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___4 -> match uu___4 with | FStarC_Syntax_Syntax.CPS -> false @@ -2629,11 +2618,11 @@ and (infer : FStar_Pervasives_Native.Some uu___5)) in let uu___3 = let comp1 = - let uu___4 = is_monadic rc_opt1 in - let uu___5 = + let uu___4 = FStarC_Syntax_Util.comp_result comp in + let uu___5 = is_monadic rc_opt1 in + let uu___6 = FStarC_Syntax_Subst.subst env3.subst s_body in - trans_G env3 (FStarC_Syntax_Util.comp_result comp) - uu___4 uu___5 in + trans_G env3 uu___4 uu___5 uu___6 in let uu___4 = FStarC_Syntax_Util.ascribe u_body ((FStar_Pervasives.Inr comp1), @@ -2861,8 +2850,7 @@ and (infer : let uu___5 = let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "DMFF: Ill-applied constant %s" - uu___6 in + FStarC_Util.format1 "DMFF: Ill-applied constant %s" uu___6 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e FStarC_Errors_Codes.Fatal_IllAppliedConstant () @@ -2882,8 +2870,7 @@ and (infer : let uu___5 = let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "DMFF: Ill-applied constant %s" - uu___6 in + FStarC_Util.format1 "DMFF: Ill-applied constant %s" uu___6 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e FStarC_Errors_Codes.Fatal_IllAppliedConstant () @@ -2921,8 +2908,7 @@ and (infer : let uu___6 = flatten t1 in (match uu___6 with | (binders', comp) -> - ((FStarC_Compiler_List.op_At binders binders'), - comp)) + ((FStarC_List.op_At binders binders'), comp)) | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = binders; FStarC_Syntax_Syntax.comp = comp;_} @@ -2937,8 +2923,7 @@ and (infer : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t_head in - FStarC_Compiler_Util.format1 "%s: not a function type" - uu___5 in + FStarC_Util.format1 "%s: not a function type" uu___5 in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_NotFunctionType () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -2946,20 +2931,19 @@ and (infer : let uu___2 = flatten t_head in (match uu___2 with | (binders, comp) -> - let n = FStarC_Compiler_List.length binders in - let n' = FStarC_Compiler_List.length args in + let n = FStarC_List.length binders in + let n' = FStarC_List.length args in (if - (FStarC_Compiler_List.length binders) < - (FStarC_Compiler_List.length args) + (FStarC_List.length binders) < + (FStarC_List.length args) then (let uu___4 = - let uu___5 = FStarC_Compiler_Util.string_of_int n in - let uu___6 = - FStarC_Compiler_Util.string_of_int (n' - n) in + let uu___5 = FStarC_Util.string_of_int n in + let uu___6 = FStarC_Util.string_of_int (n' - n) in let uu___7 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat n in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "The head of this application, after being applied to %s arguments, is an effectful computation (leaving %s arguments to be applied). Please let-bind the head applied to the %s first arguments." uu___5 uu___6 uu___7 in FStarC_Errors.raise_error0 @@ -3037,13 +3021,12 @@ and (infer : :: subst) (binders3, comp2) args2) in let final_type1 = final_type [] (binders1, comp1) args in - let uu___5 = - FStarC_Compiler_List.splitAt n' binders1 in + let uu___5 = FStarC_List.splitAt n' binders1 in (match uu___5 with | (binders2, uu___6) -> let uu___7 = let uu___8 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___9 -> fun uu___10 -> match (uu___9, uu___10) with @@ -3093,11 +3076,10 @@ and (infer : else [(u_arg, q)] in ((s_arg, q), uu___18)))) binders2 args in - FStarC_Compiler_List.split uu___8 in + FStarC_List.split uu___8 in (match uu___7 with | (s_args, u_args) -> - let u_args1 = - FStarC_Compiler_List.flatten u_args in + let u_args1 = FStarC_List.flatten u_args in let uu___8 = mk (FStarC_Syntax_Syntax.Tm_app @@ -3143,7 +3125,7 @@ and (infer : let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "[infer]: Tm_let %s" uu___3 in + FStarC_Util.format1 "[infer]: Tm_let %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_type uu___1 -> failwith "impossible (DM stratification)" @@ -3153,13 +3135,13 @@ and (infer : let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "[infer]: Tm_refine %s" uu___3 in + FStarC_Util.format1 "[infer]: Tm_refine %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_uvar uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "[infer]: Tm_uvar %s" uu___3 in + FStarC_Util.format1 "[infer]: Tm_uvar %s" uu___3 in failwith uu___2 | FStarC_Syntax_Syntax.Tm_delayed uu___1 -> failwith "impossible (compressed)" @@ -3167,7 +3149,7 @@ and (infer : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 "[infer]: Tm_unknown %s" uu___2 in + FStarC_Util.format1 "[infer]: Tm_unknown %s" uu___2 in failwith uu___1 and (mk_match : env -> @@ -3191,7 +3173,7 @@ and (mk_match : | (uu___1, s_e0, u_e0) -> let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___4 = FStarC_Syntax_Subst.open_branch b in match uu___4 with @@ -3199,7 +3181,7 @@ and (mk_match : let env2 = let uu___5 = let uu___6 = FStarC_Syntax_Syntax.pat_bvs pat in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left FStarC_TypeChecker_Env.push_bv env1.tcenv uu___6 in { @@ -3222,21 +3204,21 @@ and (mk_match : (Obj.magic "No when clauses in the definition language")) branches in - FStarC_Compiler_List.split uu___3 in + FStarC_List.split uu___3 in (match uu___2 with | (nms, branches1) -> let t1 = - let uu___3 = FStarC_Compiler_List.hd nms in + let uu___3 = FStarC_List.hd nms in match uu___3 with | M t11 -> t11 | N t11 -> t11 in let has_m = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___3 -> match uu___3 with | M uu___4 -> true | uu___4 -> false) nms in let uu___3 = let uu___4 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun nm1 -> fun uu___5 -> match uu___5 with @@ -3258,7 +3240,7 @@ and (mk_match : (pat, guard, u_body1))) | (M uu___6, false) -> failwith "impossible")) nms branches1 in - FStarC_Compiler_List.unzip3 uu___4 in + FStarC_List.unzip3 uu___4 in (match uu___3 with | (nms1, s_branches, u_branches) -> if has_m @@ -3268,7 +3250,7 @@ and (mk_match : FStarC_Syntax_Syntax.gen_bv "p''" FStar_Pervasives_Native.None p_type in let s_branches1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (pat, guard, s_body) -> @@ -3294,11 +3276,11 @@ and (mk_match : mk uu___5 in (pat, guard, s_body1)) s_branches in let s_branches2 = - FStarC_Compiler_List.map - FStarC_Syntax_Subst.close_branch s_branches1 in + FStarC_List.map FStarC_Syntax_Subst.close_branch + s_branches1 in let u_branches1 = - FStarC_Compiler_List.map - FStarC_Syntax_Subst.close_branch u_branches in + FStarC_List.map FStarC_Syntax_Subst.close_branch + u_branches in let s_e = let uu___4 = let uu___5 = FStarC_Syntax_Syntax.mk_binder p in @@ -3314,10 +3296,12 @@ and (mk_match : FStarC_Syntax_Syntax.rc_opt1 = FStar_Pervasives_Native.None }) in - FStarC_Syntax_Util.abs uu___4 uu___5 - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot - FStarC_Syntax_Util.ktype0)) in + let uu___6 = + let uu___7 = + FStarC_Syntax_Util.residual_tot + FStarC_Syntax_Util.ktype0 in + FStar_Pervasives_Native.Some uu___7 in + FStarC_Syntax_Util.abs uu___4 uu___5 uu___6 in let t1_star = let uu___4 = let uu___5 = @@ -3355,11 +3339,11 @@ and (mk_match : ((M t1), uu___4, uu___5) else (let s_branches1 = - FStarC_Compiler_List.map - FStarC_Syntax_Subst.close_branch s_branches in + FStarC_List.map FStarC_Syntax_Subst.close_branch + s_branches in let u_branches1 = - FStarC_Compiler_List.map - FStarC_Syntax_Subst.close_branch u_branches in + FStarC_List.map FStarC_Syntax_Subst.close_branch + u_branches in let t1_star = t1 in let uu___5 = let uu___6 = @@ -3420,8 +3404,7 @@ and (mk_let : fun ensure_m -> let mk x = FStarC_Syntax_Syntax.mk x e2.FStarC_Syntax_Syntax.pos in let e1 = binding.FStarC_Syntax_Syntax.lbdef in - let x = - FStarC_Compiler_Util.left binding.FStarC_Syntax_Syntax.lbname in + let x = FStarC_Util.left binding.FStarC_Syntax_Syntax.lbname in let x_binders = let uu___ = FStarC_Syntax_Syntax.mk_binder x in [uu___] in let uu___ = FStarC_Syntax_Subst.open_term x_binders e2 in @@ -3604,10 +3587,12 @@ and (mk_let : FStarC_Syntax_Syntax.Tm_app uu___4 in mk uu___3 in let s_e22 = - FStarC_Syntax_Util.abs x_binders1 s_e21 - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot - FStarC_Syntax_Util.ktype0)) in + let uu___3 = + let uu___4 = + FStarC_Syntax_Util.residual_tot + FStarC_Syntax_Util.ktype0 in + FStar_Pervasives_Native.Some uu___4 in + FStarC_Syntax_Util.abs x_binders1 s_e21 uu___3 in let body = let uu___3 = let uu___4 = @@ -3628,10 +3613,12 @@ and (mk_let : let uu___4 = let uu___5 = FStarC_Syntax_Syntax.mk_binder p in [uu___5] in - FStarC_Syntax_Util.abs uu___4 body - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot - FStarC_Syntax_Util.ktype0)) in + let uu___5 = + let uu___6 = + FStarC_Syntax_Util.residual_tot + FStarC_Syntax_Util.ktype0 in + FStar_Pervasives_Native.Some uu___6 in + FStarC_Syntax_Util.abs uu___4 body uu___5 in let uu___4 = let uu___5 = let uu___6 = @@ -3708,10 +3695,8 @@ and (mk_M : FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.comp) = FStarC_Syntax_Syntax.flags = [FStarC_Syntax_Syntax.CPS; FStarC_Syntax_Syntax.TOTAL] } -and (type_of_comp : - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = fun t -> FStarC_Syntax_Util.comp_result t +and (type_of_comp : FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.typ) = + fun t -> FStarC_Syntax_Util.comp_result t and (trans_F_ : env_ -> FStarC_Syntax_Syntax.typ -> @@ -3726,7 +3711,7 @@ and (trans_F_ : let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term c in - FStarC_Compiler_Util.format1 "Not a DM4F C-type: %s" uu___3 in + FStarC_Util.format1 "Not a DM4F C-type: %s" uu___3 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) c FStarC_Errors_Codes.Error_UnexpectedDM4FType () @@ -3747,21 +3732,21 @@ and (trans_F_ : | (wp_head, wp_args) -> ((let uu___4 = (Prims.op_Negation - ((FStarC_Compiler_List.length wp_args) = - (FStarC_Compiler_List.length args))) + ((FStarC_List.length wp_args) = + (FStarC_List.length args))) || (let uu___5 = let uu___6 = FStarC_Parser_Const.mk_tuple_data_lid - (FStarC_Compiler_List.length wp_args) - FStarC_Compiler_Range_Type.dummyRange in + (FStarC_List.length wp_args) + FStarC_Range_Type.dummyRange in FStarC_Syntax_Util.is_constructor wp_head uu___6 in Prims.op_Negation uu___5) in if uu___4 then failwith "mismatch" else ()); (let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___7 -> fun uu___8 -> match (uu___7, uu___8) with @@ -3782,7 +3767,7 @@ and (trans_F_ : let uu___11 = let uu___12 = print_implicit q in let uu___13 = print_implicit q' in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Incoherent implicit qualifiers %s %s\n" uu___12 uu___13 in FStarC_Errors.log_issue @@ -3812,7 +3797,7 @@ and (trans_F_ : | (binders_orig, comp1) -> let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___5 = ((b.FStarC_Syntax_Syntax.binder_bv), @@ -3885,10 +3870,10 @@ and (trans_F_ : FStarC_Syntax_Syntax.binder_attrs = (b.FStarC_Syntax_Syntax.binder_attrs) }]))) binders_orig in - FStarC_Compiler_List.split uu___4 in + FStarC_List.split uu___4 in (match uu___3 with | (bvs, binders2) -> - let binders3 = FStarC_Compiler_List.flatten binders2 in + let binders3 = FStarC_List.flatten binders2 in let comp2 = let uu___4 = let uu___5 = @@ -3900,7 +3885,7 @@ and (trans_F_ : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun bv -> let uu___7 = FStarC_Syntax_Syntax.bv_to_name bv in @@ -3994,25 +3979,25 @@ let (recheck_debug : fun s -> fun env1 -> fun t -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___1 = FStarC_Effect.op_Bang dbg in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Term has been %s-transformed to:\n%s\n----------\n" s uu___2 else ()); (let uu___1 = FStarC_TypeChecker_TcTerm.tc_term env1 t in match uu___1 with | (t', uu___2, uu___3) -> - ((let uu___5 = FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___5 = FStarC_Effect.op_Bang dbg in if uu___5 then let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t' in - FStarC_Compiler_Util.print1 - "Re-checked; got:\n%s\n----------\n" uu___6 + FStarC_Util.print1 "Re-checked; got:\n%s\n----------\n" + uu___6 else ()); t')) let (cps_and_elaborate : @@ -4047,7 +4032,7 @@ let (cps_and_elaborate : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic msg) in let effect_binders1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___5 = let uu___6 = b.FStarC_Syntax_Syntax.binder_bv in @@ -4107,7 +4092,7 @@ let (cps_and_elaborate : let open_and_check env3 other_binders t = let subst = FStarC_Syntax_Subst.opening_of_binders - (FStarC_Compiler_List.op_At effect_binders1 + (FStarC_List.op_At effect_binders1 other_binders) in let t1 = FStarC_Syntax_Subst.subst subst t in let uu___6 = @@ -4122,19 +4107,18 @@ let (cps_and_elaborate : let uu___8 = let uu___9 = FStarC_Syntax_Util.get_eff_repr ed in - FStarC_Compiler_Util.must uu___9 in + FStarC_Util.must uu___9 in FStar_Pervasives_Native.snd uu___8 in open_and_check env2 [] uu___7 in (match uu___6 with | (repr, _comp) -> - ((let uu___8 = - FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___8 = FStarC_Effect.op_Bang dbg in if uu___8 then let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term repr in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Representation is: %s\n" uu___9 else ()); (let ed_range = @@ -4142,8 +4126,7 @@ let (cps_and_elaborate : let dmff_env = empty env2 (FStarC_TypeChecker_TcTerm.tc_constant - env2 - FStarC_Compiler_Range_Type.dummyRange) in + env2 FStarC_Range_Type.dummyRange) in let wp_type = star_type dmff_env repr in let uu___8 = recheck_debug "*" env2 wp_type in let wp_a = @@ -4200,7 +4183,7 @@ let (cps_and_elaborate : recheck_debug "turned into the effect signature" env2 effect_signature in - let sigelts = FStarC_Compiler_Util.mk_ref [] in + let sigelts = FStarC_Util.mk_ref [] in let mk_lid name = FStarC_Syntax_Util.dm4f_lid ed name in let elaborate_and_star dmff_env1 @@ -4229,7 +4212,7 @@ let (cps_and_elaborate : let uu___16 = FStarC_TypeChecker_Common.lcomp_to_string item_comp in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Computation for [%s] is not total : %s !" uu___15 uu___16 in FStarC_Errors.raise_error0 @@ -4256,7 +4239,7 @@ let (cps_and_elaborate : let uu___11 = let uu___12 = FStarC_Syntax_Util.get_bind_repr ed in - FStarC_Compiler_Util.must uu___12 in + FStarC_Util.must uu___12 in elaborate_and_star dmff_env [] uu___11 in match uu___10 with | (dmff_env1, uu___11, bind_wp, bind_elab) -> @@ -4265,7 +4248,7 @@ let (cps_and_elaborate : let uu___14 = FStarC_Syntax_Util.get_return_repr ed in - FStarC_Compiler_Util.must uu___14 in + FStarC_Util.must uu___14 in elaborate_and_star dmff_env1 [] uu___13 in (match uu___12 with | (dmff_env2, uu___13, return_wp, @@ -4370,7 +4353,7 @@ let (cps_and_elaborate : rc -> FStarC_Ident.string_of_lid rc.FStarC_Syntax_Syntax.residual_effect in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "The body of return_wp (%s) should be of type Type0 but is of type %s" uu___18 uu___19 in @@ -4395,7 +4378,7 @@ let (cps_and_elaborate : else ()); (let uu___19 = - FStarC_Compiler_Util.map_opt + FStarC_Util.map_opt rc.FStarC_Syntax_Syntax.residual_typ (fun rt -> @@ -4515,7 +4498,7 @@ let (cps_and_elaborate : "unexpected shape for bind" in let apply_close t = if - (FStarC_Compiler_List.length + (FStarC_List.length effect_binders1) = Prims.int_zero then t @@ -4574,14 +4557,13 @@ let (cps_and_elaborate : | FStar_Pervasives_Native.Some (_us, _t) -> ((let uu___16 = - FStarC_Compiler_Debug.any - () in + FStarC_Debug.any () in if uu___16 then let uu___17 = FStarC_Ident.string_of_lid l' in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "DM4F: Applying override %s\n" uu___17 else ()); @@ -4651,10 +4633,10 @@ let (cps_and_elaborate : else sigelt in ((let uu___17 = let uu___18 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang sigelts in sigelt1 :: uu___18 in - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals sigelts uu___17); fv)) in let register_admit = register true in @@ -4694,7 +4676,7 @@ let (cps_and_elaborate : register_admit "bind_elab" bind_elab in let uu___14 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___15 -> fun action -> match uu___15 with @@ -4712,7 +4694,7 @@ let (cps_and_elaborate : env', uu___17) -> let action_params1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___18 = @@ -4815,7 +4797,7 @@ let (cps_and_elaborate : uu___20 in ((let uu___20 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg in if uu___20 then @@ -4841,7 +4823,7 @@ let (cps_and_elaborate : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term action_elab2 in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "original action_params %s, end action_params %s, type %s, term %s\n" uu___21 uu___22 @@ -4901,8 +4883,7 @@ let (cps_and_elaborate : (match uu___14 with | (dmff_env3, actions) -> let actions1 = - FStarC_Compiler_List.rev - actions in + FStarC_List.rev actions in let repr1 = let wp = FStarC_Syntax_Syntax.gen_bv @@ -5017,7 +4998,7 @@ let (cps_and_elaborate : c1) -> let uu___22 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___23 -> @@ -5043,7 +5024,7 @@ let (cps_and_elaborate : FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) type_param1.FStarC_Syntax_Syntax.binder_bv (Obj.magic @@ -5073,7 +5054,7 @@ let (cps_and_elaborate : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term arrow1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible to generate DM effect: no post candidate %s (Type variable does not appear)" uu___23 in FStarC_Errors.raise_error0 @@ -5093,7 +5074,7 @@ let (cps_and_elaborate : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term arrow1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible to generate DM effect: multiple post candidates %s" uu___24 in FStarC_Errors.raise_error0 @@ -5124,7 +5105,7 @@ let (cps_and_elaborate : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term arrow1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: pre/post arrow %s" uu___23 in raise_error @@ -5136,7 +5117,7 @@ let (cps_and_elaborate : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term wp_type in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: pre/post abs %s" uu___20 in raise_error @@ -5276,7 +5257,7 @@ let (cps_and_elaborate : match uu___20 with | (sigelts', ed2) -> ((let uu___22 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg in if uu___22 then @@ -5284,13 +5265,13 @@ let (cps_and_elaborate : FStarC_Class_Show.show FStarC_Syntax_Print.showable_eff_decl ed2 in - FStarC_Compiler_Util.print_string + FStarC_Util.print_string uu___23 else ()); (let lift_from_pure_opt = if - (FStarC_Compiler_List.length + (FStarC_List.length effect_binders1) = Prims.int_zero @@ -5336,11 +5317,11 @@ let (cps_and_elaborate : let uu___22 = let uu___23 = let uu___24 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang sigelts in - FStarC_Compiler_List.rev + FStarC_List.rev uu___24 in - FStarC_Compiler_List.op_At + FStarC_List.op_At uu___23 sigelts' in (uu___22, ed2, diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_DeferredImplicits.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_DeferredImplicits.ml similarity index 95% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_DeferredImplicits.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_DeferredImplicits.ml index cce680972df..1b17105ccdf 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_DeferredImplicits.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_DeferredImplicits.ml @@ -112,10 +112,9 @@ let (find_user_tac_for_uvar : let candidate_names candidates = let uu___ = let uu___1 = - FStarC_Compiler_List.collect FStarC_Syntax_Util.lids_of_sigelt - candidates in - FStarC_Compiler_List.map FStarC_Ident.string_of_lid uu___1 in - FStarC_Compiler_String.concat ", " uu___ in + FStarC_List.collect FStarC_Syntax_Util.lids_of_sigelt candidates in + FStarC_List.map FStarC_Ident.string_of_lid uu___1 in + FStarC_String.concat ", " uu___ in match u.FStarC_Syntax_Syntax.ctx_uvar_meta with | FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Ctx_uvar_meta_attr a) -> @@ -123,30 +122,28 @@ let (find_user_tac_for_uvar : FStarC_TypeChecker_Env.lookup_attr env FStarC_Parser_Const.resolve_implicits_attr_string in let candidates = - FStarC_Compiler_List.filter + FStarC_List.filter (fun hook -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_TypeChecker_TermEqAndSimplify.eq_tm_bool env a) hook.FStarC_Syntax_Syntax.sigattrs) hooks in let candidates1 = - FStarC_Compiler_Util.remove_dups + FStarC_Util.remove_dups (fun s0 -> fun s1 -> let l0 = FStarC_Syntax_Util.lids_of_sigelt s0 in let l1 = FStarC_Syntax_Util.lids_of_sigelt s1 in - if - (FStarC_Compiler_List.length l0) = - (FStarC_Compiler_List.length l1) + if (FStarC_List.length l0) = (FStarC_List.length l1) then - FStarC_Compiler_List.forall2 + FStarC_List.forall2 (fun l01 -> fun l11 -> FStarC_Ident.lid_equals l01 l11) l0 l1 else false) candidates in let is_overridden candidate = let candidate_lids = FStarC_Syntax_Util.lids_of_sigelt candidate in - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun other -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun attr -> let uu___ = FStarC_Syntax_Util.head_and_args attr in match uu___ with @@ -170,9 +167,9 @@ let (find_user_tac_for_uvar : (match uu___5 with | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some names -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun n -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun l -> let uu___6 = FStarC_Ident.string_of_lid l in @@ -190,9 +187,9 @@ let (find_user_tac_for_uvar : (match uu___4 with | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some names -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun n -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun l -> let uu___5 = FStarC_Ident.string_of_lid l in @@ -201,7 +198,7 @@ let (find_user_tac_for_uvar : | uu___2 -> false)) other.FStarC_Syntax_Syntax.sigattrs) candidates1 in let candidates2 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun c -> let uu___ = is_overridden c in Prims.op_Negation uu___) candidates1 in @@ -213,7 +210,7 @@ let (find_user_tac_for_uvar : let attr = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term a in ((let uu___2 = - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Multiple resolve_implicits hooks are eligible for attribute %s; \nplease resolve the ambiguity by using the `override_resolve_implicits_handler` attribute to choose among these candidates {%s}" attr candidates3 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range @@ -700,16 +697,14 @@ let (solve_deferred_to_tactic_goals : | uu___3 -> failwith "Unexpected problem deferred to tactic") in let eqs = let uu___1 = - FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + FStarC_Class_Listlike.to_list (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.deferred_to_tac in - FStarC_Compiler_List.map prob_as_implicit uu___1 in + FStarC_List.map prob_as_implicit uu___1 in let uu___1 = let uu___2 = - FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + FStarC_Class_Listlike.to_list (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun imp -> fun uu___3 -> match uu___3 with @@ -733,8 +728,8 @@ let (solve_deferred_to_tactic_goals : match uu___1 with | (more, imps) -> let bucketize is = - let map = FStarC_Compiler_Util.smap_create (Prims.of_int (17)) in - FStarC_Compiler_List.iter + let map = FStarC_Util.smap_create (Prims.of_int (17)) in + FStarC_List.iter (fun uu___3 -> match uu___3 with | (i, s) -> @@ -744,34 +739,32 @@ let (solve_deferred_to_tactic_goals : failwith "Unexpected: tactic without a name" | FStar_Pervasives_Native.Some l -> let lstr = FStarC_Ident.string_of_lid l in - let uu___5 = - FStarC_Compiler_Util.smap_try_find map lstr in + let uu___5 = FStarC_Util.smap_try_find map lstr in (match uu___5 with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Util.smap_add map lstr - ([i], s) + FStarC_Util.smap_add map lstr ([i], s) | FStar_Pervasives_Native.Some (is1, s1) -> - (FStarC_Compiler_Util.smap_remove map lstr; - FStarC_Compiler_Util.smap_add map lstr + (FStarC_Util.smap_remove map lstr; + FStarC_Util.smap_add map lstr ((i :: is1), s1))))) is; - FStarC_Compiler_Util.smap_fold map + FStarC_Util.smap_fold map (fun uu___3 -> fun is1 -> fun out -> is1 :: out) [] in - let buckets = bucketize (FStarC_Compiler_List.op_At eqs more) in - (FStarC_Compiler_List.iter + let buckets = bucketize (FStarC_List.op_At eqs more) in + (FStarC_List.iter (fun uu___3 -> match uu___3 with | (imps1, sigel) -> solve_goals_with_tac env g imps1 sigel) buckets; (let uu___3 = FStarC_Class_Listlike.from_list - (FStarC_Compiler_CList.listlike_clist ()) imps in + (FStarC_CList.listlike_clist ()) imps in { FStarC_TypeChecker_Common.guard_f = (g.FStarC_TypeChecker_Common.guard_f); FStarC_TypeChecker_Common.deferred_to_tac = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); FStarC_TypeChecker_Common.deferred = (g.FStarC_TypeChecker_Common.deferred); FStarC_TypeChecker_Common.univ_ineqs = diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Env.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Env.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Env.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Env.ml index 1f71e05cc5e..9b89631b66d 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Env.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Env.ml @@ -13,6 +13,7 @@ type step = | DoNotUnfoldPureLets | UnfoldUntil of FStarC_Syntax_Syntax.delta_depth | UnfoldOnly of FStarC_Ident.lid Prims.list + | UnfoldOnce of FStarC_Ident.lid Prims.list | UnfoldFully of FStarC_Ident.lid Prims.list | UnfoldAttr of FStarC_Ident.lid Prims.list | UnfoldQual of Prims.string Prims.list @@ -71,6 +72,11 @@ let (uu___is_UnfoldOnly : step -> Prims.bool) = match projectee with | UnfoldOnly _0 -> true | uu___ -> false let (__proj__UnfoldOnly__item___0 : step -> FStarC_Ident.lid Prims.list) = fun projectee -> match projectee with | UnfoldOnly _0 -> _0 +let (uu___is_UnfoldOnce : step -> Prims.bool) = + fun projectee -> + match projectee with | UnfoldOnce _0 -> true | uu___ -> false +let (__proj__UnfoldOnce__item___0 : step -> FStarC_Ident.lid Prims.list) = + fun projectee -> match projectee with | UnfoldOnce _0 -> _0 let (uu___is_UnfoldFully : step -> Prims.bool) = fun projectee -> match projectee with | UnfoldFully _0 -> true | uu___ -> false @@ -138,10 +144,10 @@ let (uu___is_DefaultUnivsToZero : step -> Prims.bool) = let (uu___is_Tactics : step -> Prims.bool) = fun projectee -> match projectee with | Tactics -> true | uu___ -> false type steps = step Prims.list -let (dbg_ImplicitTrace : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ImplicitTrace" -let (dbg_LayeredEffectsEqns : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LayeredEffectsEqns" +let (dbg_ImplicitTrace : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ImplicitTrace" +let (dbg_LayeredEffectsEqns : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LayeredEffectsEqns" let rec (eq_step : step -> step -> Prims.bool) = fun s1 -> fun s2 -> @@ -327,7 +333,7 @@ type cached_elt = (((FStarC_Syntax_Syntax.universes * FStarC_Syntax_Syntax.typ), (FStarC_Syntax_Syntax.sigelt * FStarC_Syntax_Syntax.universes FStar_Pervasives_Native.option)) - FStar_Pervasives.either * FStarC_Compiler_Range_Type.range) + FStar_Pervasives.either * FStarC_Range_Type.range) type goal = FStarC_Syntax_Syntax.term type must_tot = Prims.bool type mlift = @@ -367,7 +373,7 @@ and effects = FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.cflag Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.comp * FStarC_TypeChecker_Common.guard_t))) Prims.list @@ -379,16 +385,16 @@ and effects = and env = { solver: solver_t ; - range: FStarC_Compiler_Range_Type.range ; + range: FStarC_Range_Type.range ; curmodule: FStarC_Ident.lident ; gamma: FStarC_Syntax_Syntax.binding Prims.list ; gamma_sig: sig_binding Prims.list ; - gamma_cache: cached_elt FStarC_Compiler_Util.smap ; + gamma_cache: cached_elt FStarC_Util.smap ; modules: FStarC_Syntax_Syntax.modul Prims.list ; expected_typ: (FStarC_Syntax_Syntax.typ * Prims.bool) FStar_Pervasives_Native.option ; - sigtab: FStarC_Syntax_Syntax.sigelt FStarC_Compiler_Util.smap ; - attrtab: FStarC_Syntax_Syntax.sigelt Prims.list FStarC_Compiler_Util.smap ; + sigtab: FStarC_Syntax_Syntax.sigelt FStarC_Util.smap ; + attrtab: FStarC_Syntax_Syntax.sigelt Prims.list FStarC_Util.smap ; instantiate_imp: Prims.bool ; effects: effects ; generalize: Prims.bool ; @@ -439,10 +445,10 @@ and env = ; qtbl_name_and_index: ((FStarC_Ident.lident * FStarC_Syntax_Syntax.typ * Prims.int) - FStar_Pervasives_Native.option * Prims.int FStarC_Compiler_Util.smap) + FStar_Pervasives_Native.option * Prims.int FStarC_Util.smap) ; - normalized_eff_names: FStarC_Ident.lident FStarC_Compiler_Util.smap ; - fv_delta_depths: FStarC_Syntax_Syntax.delta_depth FStarC_Compiler_Util.smap ; + normalized_eff_names: FStarC_Ident.lident FStarC_Util.smap ; + fv_delta_depths: FStarC_Syntax_Syntax.delta_depth FStarC_Util.smap ; proof_ns: proof_namespace ; synth_hook: env -> @@ -459,8 +465,7 @@ and env = Prims.bool -> FStarC_Ident.lident Prims.list -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.sigelt Prims.list + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt Prims.list ; mpreprocess: env -> @@ -473,8 +478,7 @@ and env = FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term ; - identifier_info: - FStarC_TypeChecker_Common.id_info_table FStarC_Compiler_Effect.ref ; + identifier_info: FStarC_TypeChecker_Common.id_info_table FStarC_Effect.ref ; tc_hooks: tcenv_hooks ; dsenv: FStarC_Syntax_DsEnv.env ; nbe: @@ -482,10 +486,8 @@ and env = env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term ; strict_args_tab: - Prims.int Prims.list FStar_Pervasives_Native.option - FStarC_Compiler_Util.smap - ; - erasable_types_tab: Prims.bool FStarC_Compiler_Util.smap ; + Prims.int Prims.list FStar_Pervasives_Native.option FStarC_Util.smap ; + erasable_types_tab: Prims.bool FStarC_Util.smap ; enable_defer_to_tac: Prims.bool ; unif_allow_ref_guards: Prims.bool ; erase_erasable_args: Prims.bool ; @@ -497,7 +499,7 @@ and env = (FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option, Prims.bool -> Prims.string) FStar_Pervasives.either ; - missing_decl: FStarC_Ident.lident FStarC_Compiler_RBSet.t } + missing_decl: FStarC_Ident.lident FStarC_RBSet.t } and solver_t = { init: env -> unit ; @@ -597,7 +599,7 @@ let (__proj__Mkeffects__item__polymonadic_binds : FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.cflag Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.comp * FStarC_TypeChecker_Common.guard_t))) Prims.list) @@ -630,7 +632,7 @@ let (__proj__Mkenv__item__solver : env -> solver_t) = dsenv; nbe; strict_args_tab; erasable_types_tab; enable_defer_to_tac; unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> solver -let (__proj__Mkenv__item__range : env -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mkenv__item__range : env -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -691,8 +693,7 @@ let (__proj__Mkenv__item__gamma_sig : env -> sig_binding Prims.list) = dsenv; nbe; strict_args_tab; erasable_types_tab; enable_defer_to_tac; unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> gamma_sig -let (__proj__Mkenv__item__gamma_cache : - env -> cached_elt FStarC_Compiler_Util.smap) = +let (__proj__Mkenv__item__gamma_cache : env -> cached_elt FStarC_Util.smap) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -742,7 +743,7 @@ let (__proj__Mkenv__item__expected_typ : unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> expected_typ let (__proj__Mkenv__item__sigtab : - env -> FStarC_Syntax_Syntax.sigelt FStarC_Compiler_Util.smap) = + env -> FStarC_Syntax_Syntax.sigelt FStarC_Util.smap) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -758,7 +759,7 @@ let (__proj__Mkenv__item__sigtab : unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> sigtab let (__proj__Mkenv__item__attrtab : - env -> FStarC_Syntax_Syntax.sigelt Prims.list FStarC_Compiler_Util.smap) = + env -> FStarC_Syntax_Syntax.sigelt Prims.list FStarC_Util.smap) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -1138,7 +1139,7 @@ let (__proj__Mkenv__item__subtype_nosmt_force : let (__proj__Mkenv__item__qtbl_name_and_index : env -> ((FStarC_Ident.lident * FStarC_Syntax_Syntax.typ * Prims.int) - FStar_Pervasives_Native.option * Prims.int FStarC_Compiler_Util.smap)) + FStar_Pervasives_Native.option * Prims.int FStarC_Util.smap)) = fun projectee -> match projectee with @@ -1155,7 +1156,7 @@ let (__proj__Mkenv__item__qtbl_name_and_index : unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> qtbl_name_and_index let (__proj__Mkenv__item__normalized_eff_names : - env -> FStarC_Ident.lident FStarC_Compiler_Util.smap) = + env -> FStarC_Ident.lident FStarC_Util.smap) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -1171,7 +1172,7 @@ let (__proj__Mkenv__item__normalized_eff_names : unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> normalized_eff_names let (__proj__Mkenv__item__fv_delta_depths : - env -> FStarC_Syntax_Syntax.delta_depth FStarC_Compiler_Util.smap) = + env -> FStarC_Syntax_Syntax.delta_depth FStarC_Util.smap) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -1247,8 +1248,7 @@ let (__proj__Mkenv__item__splice : Prims.bool -> FStarC_Ident.lident Prims.list -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.sigelt Prims.list) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt Prims.list) = fun projectee -> match projectee with @@ -1306,8 +1306,7 @@ let (__proj__Mkenv__item__postprocess : unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> postprocess let (__proj__Mkenv__item__identifier_info : - env -> FStarC_TypeChecker_Common.id_info_table FStarC_Compiler_Effect.ref) - = + env -> FStarC_TypeChecker_Common.id_info_table FStarC_Effect.ref) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -1372,9 +1371,7 @@ let (__proj__Mkenv__item__nbe : unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> nbe let (__proj__Mkenv__item__strict_args_tab : - env -> - Prims.int Prims.list FStar_Pervasives_Native.option - FStarC_Compiler_Util.smap) + env -> Prims.int Prims.list FStar_Pervasives_Native.option FStarC_Util.smap) = fun projectee -> match projectee with @@ -1391,7 +1388,7 @@ let (__proj__Mkenv__item__strict_args_tab : unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> strict_args_tab let (__proj__Mkenv__item__erasable_types_tab : - env -> Prims.bool FStarC_Compiler_Util.smap) = + env -> Prims.bool FStarC_Util.smap) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -1475,7 +1472,7 @@ let (__proj__Mkenv__item__core_check : unif_allow_ref_guards; erase_erasable_args; core_check; missing_decl;_} -> core_check let (__proj__Mkenv__item__missing_decl : - env -> FStarC_Ident.lident FStarC_Compiler_RBSet.t) = + env -> FStarC_Ident.lident FStarC_RBSet.t) = fun projectee -> match projectee with | { solver; range; curmodule; gamma; gamma_sig; gamma_cache; modules; @@ -1600,7 +1597,7 @@ type polymonadic_bind_t = FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.cflag Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.comp * FStarC_TypeChecker_Common.guard_t) type solver_depth_t = (Prims.int * Prims.int * Prims.int) type core_check_t = @@ -1628,7 +1625,7 @@ let (rename_gamma : = fun subst -> fun gamma -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Binding_var x -> @@ -1842,8 +1839,8 @@ let (record_val_for : env -> FStarC_Ident.lident -> env) = Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_fv)) l (Obj.magic e.missing_decl)) in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) l + (Obj.magic e.missing_decl)) in { solver = (e.solver); range = (e.range); @@ -1906,8 +1903,8 @@ let (record_definition_for : env -> FStarC_Ident.lident -> env) = Obj.magic (FStarC_Class_Setlike.remove () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_fv)) l (Obj.magic e.missing_decl)) in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) l + (Obj.magic e.missing_decl)) in { solver = (e.solver); range = (e.range); @@ -1966,8 +1963,7 @@ let (record_definition_for : env -> FStarC_Ident.lident -> env) = let (missing_definition_list : env -> FStarC_Ident.lident Prims.list) = fun e -> FStarC_Class_Setlike.elems () - (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) + (Obj.magic (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) (Obj.magic e.missing_decl) type implicit = FStarC_TypeChecker_Common.implicit type implicits = FStarC_TypeChecker_Common.implicits @@ -1977,10 +1973,10 @@ type qninfo = (((FStarC_Syntax_Syntax.universes * FStarC_Syntax_Syntax.typ), (FStarC_Syntax_Syntax.sigelt * FStarC_Syntax_Syntax.universes FStar_Pervasives_Native.option)) - FStar_Pervasives.either * FStarC_Compiler_Range_Type.range) + FStar_Pervasives.either * FStarC_Range_Type.range) FStar_Pervasives_Native.option type env_t = env -type sigtable = FStarC_Syntax_Syntax.sigelt FStarC_Compiler_Util.smap +type sigtable = FStarC_Syntax_Syntax.sigelt FStarC_Util.smap let (should_verify : env -> Prims.bool) = fun env1 -> ((let uu___ = FStarC_Options.lax () in Prims.op_Negation uu___) && @@ -2002,10 +1998,10 @@ let (visible_at : | (InliningDelta, FStarC_Syntax_Syntax.Inline_for_extraction) -> true | uu___ -> false let (default_table_size : Prims.int) = (Prims.of_int (200)) -let new_sigtab : 'uuuuu . unit -> 'uuuuu FStarC_Compiler_Util.smap = - fun uu___ -> FStarC_Compiler_Util.smap_create default_table_size -let new_gamma_cache : 'uuuuu . unit -> 'uuuuu FStarC_Compiler_Util.smap = - fun uu___ -> FStarC_Compiler_Util.smap_create (Prims.of_int (100)) +let new_sigtab : 'uuuuu . unit -> 'uuuuu FStarC_Util.smap = + fun uu___ -> FStarC_Util.smap_create default_table_size +let new_gamma_cache : 'uuuuu . unit -> 'uuuuu FStarC_Util.smap = + fun uu___ -> FStarC_Util.smap_create (Prims.of_int (100)) let (initial_env : FStarC_Parser_Dep.deps -> (env -> @@ -2057,35 +2053,30 @@ let (initial_env : let uu___2 = new_sigtab () in let uu___3 = let uu___4 = - FStarC_Compiler_Util.smap_create - (Prims.of_int (10)) in + FStarC_Util.smap_create (Prims.of_int (10)) in (FStar_Pervasives_Native.None, uu___4) in let uu___4 = - FStarC_Compiler_Util.smap_create - (Prims.of_int (20)) in + FStarC_Util.smap_create (Prims.of_int (20)) in let uu___5 = - FStarC_Compiler_Util.smap_create - (Prims.of_int (50)) in + FStarC_Util.smap_create (Prims.of_int (50)) in let uu___6 = FStarC_Options.using_facts_from () in let uu___7 = - FStarC_Compiler_Util.mk_ref + FStarC_Util.mk_ref FStarC_TypeChecker_Common.id_info_table_empty in let uu___8 = FStarC_Syntax_DsEnv.empty_env deps in let uu___9 = - FStarC_Compiler_Util.smap_create - (Prims.of_int (20)) in + FStarC_Util.smap_create (Prims.of_int (20)) in let uu___10 = - FStarC_Compiler_Util.smap_create - (Prims.of_int (20)) in + FStarC_Util.smap_create (Prims.of_int (20)) in let uu___11 = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) ()) in { solver; - range = FStarC_Compiler_Range_Type.dummyRange; + range = FStarC_Range_Type.dummyRange; curmodule = module_lid; gamma = []; gamma_sig = []; @@ -2184,36 +2175,35 @@ let (initial_env : missing_decl = uu___11 } let (dsenv : env -> FStarC_Syntax_DsEnv.env) = fun env1 -> env1.dsenv -let (sigtab : env -> FStarC_Syntax_Syntax.sigelt FStarC_Compiler_Util.smap) = +let (sigtab : env -> FStarC_Syntax_Syntax.sigelt FStarC_Util.smap) = fun env1 -> env1.sigtab let (attrtab : - env -> FStarC_Syntax_Syntax.sigelt Prims.list FStarC_Compiler_Util.smap) = + env -> FStarC_Syntax_Syntax.sigelt Prims.list FStarC_Util.smap) = fun env1 -> env1.attrtab -let (gamma_cache : env -> cached_elt FStarC_Compiler_Util.smap) = +let (gamma_cache : env -> cached_elt FStarC_Util.smap) = fun env1 -> env1.gamma_cache let (query_indices : - (FStarC_Ident.lident * Prims.int) Prims.list Prims.list - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref [[]] + (FStarC_Ident.lident * Prims.int) Prims.list Prims.list FStarC_Effect.ref) + = FStarC_Util.mk_ref [[]] let (push_query_indices : unit -> unit) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang query_indices in + let uu___1 = FStarC_Effect.op_Bang query_indices in match uu___1 with | [] -> failwith "Empty query indices!" | uu___2 -> let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang query_indices in - FStarC_Compiler_List.hd uu___5 in - let uu___5 = FStarC_Compiler_Effect.op_Bang query_indices in uu___4 - :: uu___5 in - FStarC_Compiler_Effect.op_Colon_Equals query_indices uu___3 + let uu___5 = FStarC_Effect.op_Bang query_indices in + FStarC_List.hd uu___5 in + let uu___5 = FStarC_Effect.op_Bang query_indices in uu___4 :: + uu___5 in + FStarC_Effect.op_Colon_Equals query_indices uu___3 let (pop_query_indices : unit -> unit) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang query_indices in + let uu___1 = FStarC_Effect.op_Bang query_indices in match uu___1 with | [] -> failwith "Empty query indices!" - | hd::tl -> FStarC_Compiler_Effect.op_Colon_Equals query_indices tl + | hd::tl -> FStarC_Effect.op_Colon_Equals query_indices tl let (snapshot_query_indices : unit -> (Prims.int * unit)) = fun uu___ -> FStarC_Common.snapshot push_query_indices query_indices () let (rollback_query_indices : @@ -2223,39 +2213,36 @@ let (add_query_index : (FStarC_Ident.lident * Prims.int) -> unit) = fun uu___ -> match uu___ with | (l, n) -> - let uu___1 = FStarC_Compiler_Effect.op_Bang query_indices in + let uu___1 = FStarC_Effect.op_Bang query_indices in (match uu___1 with | hd::tl -> - FStarC_Compiler_Effect.op_Colon_Equals query_indices (((l, n) :: - hd) :: tl) + FStarC_Effect.op_Colon_Equals query_indices (((l, n) :: hd) :: + tl) | uu___2 -> failwith "Empty query indices") let (peek_query_indices : unit -> (FStarC_Ident.lident * Prims.int) Prims.list) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang query_indices in - FStarC_Compiler_List.hd uu___1 -let (stack : env Prims.list FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref [] + let uu___1 = FStarC_Effect.op_Bang query_indices in FStarC_List.hd uu___1 +let (stack : env Prims.list FStarC_Effect.ref) = FStarC_Util.mk_ref [] let (push_stack : env -> env) = fun env1 -> - (let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang stack in env1 :: uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals stack uu___1); - (let uu___1 = FStarC_Compiler_Util.smap_copy (gamma_cache env1) in - let uu___2 = FStarC_Compiler_Util.smap_copy (sigtab env1) in - let uu___3 = FStarC_Compiler_Util.smap_copy (attrtab env1) in + (let uu___1 = let uu___2 = FStarC_Effect.op_Bang stack in env1 :: uu___2 in + FStarC_Effect.op_Colon_Equals stack uu___1); + (let uu___1 = FStarC_Util.smap_copy (gamma_cache env1) in + let uu___2 = FStarC_Util.smap_copy (sigtab env1) in + let uu___3 = FStarC_Util.smap_copy (attrtab env1) in let uu___4 = let uu___5 = - FStarC_Compiler_Util.smap_copy + FStarC_Util.smap_copy (FStar_Pervasives_Native.snd env1.qtbl_name_and_index) in ((FStar_Pervasives_Native.fst env1.qtbl_name_and_index), uu___5) in - let uu___5 = FStarC_Compiler_Util.smap_copy env1.normalized_eff_names in - let uu___6 = FStarC_Compiler_Util.smap_copy env1.fv_delta_depths in + let uu___5 = FStarC_Util.smap_copy env1.normalized_eff_names in + let uu___6 = FStarC_Util.smap_copy env1.fv_delta_depths in let uu___7 = - let uu___8 = FStarC_Compiler_Effect.op_Bang env1.identifier_info in - FStarC_Compiler_Util.mk_ref uu___8 in - let uu___8 = FStarC_Compiler_Util.smap_copy env1.strict_args_tab in - let uu___9 = FStarC_Compiler_Util.smap_copy env1.erasable_types_tab in + let uu___8 = FStarC_Effect.op_Bang env1.identifier_info in + FStarC_Util.mk_ref uu___8 in + let uu___8 = FStarC_Util.smap_copy env1.strict_args_tab in + let uu___9 = FStarC_Util.smap_copy env1.erasable_types_tab in { solver = (env1.solver); range = (env1.range); @@ -2313,9 +2300,9 @@ let (push_stack : env -> env) = }) let (pop_stack : unit -> env) = fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang stack in + let uu___1 = FStarC_Effect.op_Bang stack in match uu___1 with - | env1::tl -> (FStarC_Compiler_Effect.op_Colon_Equals stack tl; env1) + | env1::tl -> (FStarC_Effect.op_Colon_Equals stack tl; env1) | uu___2 -> failwith "Impossible: Too many pops" let (snapshot_stack : env -> (Prims.int * env)) = fun env1 -> FStarC_Common.snapshot push_stack stack env1 @@ -2324,7 +2311,7 @@ let (rollback_stack : Prims.int FStar_Pervasives_Native.option -> env) = let (snapshot : env -> Prims.string -> (tcenv_depth_t * env)) = fun env1 -> fun msg -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> let uu___1 = snapshot_stack env1 in match uu___1 with @@ -2411,7 +2398,7 @@ let (rollback : fun solver -> fun msg -> fun depth -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> let uu___1 = match depth with @@ -2438,8 +2425,8 @@ let (rollback : let dsenv1 = FStarC_Syntax_DsEnv.rollback dsenv_depth in ((let uu___5 = - FStarC_Compiler_Util.physical_equality - tcenv.dsenv dsenv1 in + FStarC_Util.physical_equality tcenv.dsenv + dsenv1 in FStarC_Common.runtime_assert uu___5 "Inconsistent stack state"); tcenv)))))) @@ -2457,7 +2444,7 @@ let (incr_query_index : env -> env) = | (FStar_Pervasives_Native.None, uu___) -> env1 | (FStar_Pervasives_Native.Some (l, typ, n), tbl) -> let uu___ = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | (m, uu___2) -> FStarC_Ident.lid_equals l m) qix in @@ -2466,7 +2453,7 @@ let (incr_query_index : env -> env) = let next = n + Prims.int_one in (add_query_index (l, next); (let uu___3 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_add tbl uu___3 next); + FStarC_Util.smap_add tbl uu___3 next); { solver = (env1.solver); range = (env1.range); @@ -2527,7 +2514,7 @@ let (incr_query_index : env -> env) = let next = m + Prims.int_one in (add_query_index (l, next); (let uu___4 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_add tbl uu___4 next); + FStarC_Util.smap_add tbl uu___4 next); { solver = (env1.solver); range = (env1.range); @@ -2584,10 +2571,10 @@ let (incr_query_index : env -> env) = core_check = (env1.core_check); missing_decl = (env1.missing_decl) })) -let (set_range : env -> FStarC_Compiler_Range_Type.range -> env) = +let (set_range : env -> FStarC_Range_Type.range -> env) = fun e -> fun r -> - if r = FStarC_Compiler_Range_Type.dummyRange + if r = FStarC_Range_Type.dummyRange then e else { @@ -2645,7 +2632,7 @@ let (set_range : env -> FStarC_Compiler_Range_Type.range -> env) = core_check = (e.core_check); missing_decl = (e.missing_decl) } -let (get_range : env -> FStarC_Compiler_Range_Type.range) = fun e -> e.range +let (get_range : env -> FStarC_Range_Type.range) = fun e -> e.range let (hasRange_env : env FStarC_Class_HasRange.hasRange) = { FStarC_Class_HasRange.pos = get_range; @@ -2655,27 +2642,27 @@ let (toggle_id_info : env -> Prims.bool -> unit) = fun env1 -> fun enabled -> let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang env1.identifier_info in + let uu___1 = FStarC_Effect.op_Bang env1.identifier_info in FStarC_TypeChecker_Common.id_info_toggle uu___1 enabled in - FStarC_Compiler_Effect.op_Colon_Equals env1.identifier_info uu___ + FStarC_Effect.op_Colon_Equals env1.identifier_info uu___ let (insert_bv_info : env -> FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.typ -> unit) = fun env1 -> fun bv -> fun ty -> let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang env1.identifier_info in + let uu___1 = FStarC_Effect.op_Bang env1.identifier_info in FStarC_TypeChecker_Common.id_info_insert_bv uu___1 bv ty in - FStarC_Compiler_Effect.op_Colon_Equals env1.identifier_info uu___ + FStarC_Effect.op_Colon_Equals env1.identifier_info uu___ let (insert_fv_info : env -> FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.typ -> unit) = fun env1 -> fun fv -> fun ty -> let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang env1.identifier_info in + let uu___1 = FStarC_Effect.op_Bang env1.identifier_info in FStarC_TypeChecker_Common.id_info_insert_fv uu___1 fv ty in - FStarC_Compiler_Effect.op_Colon_Equals env1.identifier_info uu___ + FStarC_Effect.op_Colon_Equals env1.identifier_info uu___ let (promote_id_info : env -> (FStarC_Syntax_Syntax.typ -> @@ -2685,9 +2672,9 @@ let (promote_id_info : fun env1 -> fun ty_map -> let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang env1.identifier_info in + let uu___1 = FStarC_Effect.op_Bang env1.identifier_info in FStarC_TypeChecker_Common.id_info_promote uu___1 ty_map in - FStarC_Compiler_Effect.op_Colon_Equals env1.identifier_info uu___ + FStarC_Effect.op_Colon_Equals env1.identifier_info uu___ let (modules : env -> FStarC_Syntax_Syntax.modul Prims.list) = fun env1 -> env1.modules let (current_module : env -> FStarC_Ident.lident) = @@ -2753,7 +2740,7 @@ let (set_current_module : env -> FStarC_Ident.lident -> env) = let (has_interface : env -> FStarC_Ident.lident -> Prims.bool) = fun env1 -> fun l -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun m -> m.FStarC_Syntax_Syntax.is_interface && (FStarC_Ident.lid_equals m.FStarC_Syntax_Syntax.name l)) @@ -2766,12 +2753,11 @@ let (find_in_sigtab : fun env1 -> fun lid -> let uu___ = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_try_find (sigtab env1) uu___ + FStarC_Util.smap_try_find (sigtab env1) uu___ let (new_u_univ : unit -> FStarC_Syntax_Syntax.universe) = fun uu___ -> let uu___1 = - FStarC_Syntax_Unionfind.univ_fresh - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Syntax_Unionfind.univ_fresh FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.U_unif uu___1 let (mk_univ_subst : FStarC_Syntax_Syntax.univ_name Prims.list -> @@ -2780,8 +2766,8 @@ let (mk_univ_subst : = fun formals -> fun us -> - let n = (FStarC_Compiler_List.length formals) - Prims.int_one in - FStarC_Compiler_List.mapi + let n = (FStarC_List.length formals) - Prims.int_one in + FStarC_List.mapi (fun i -> fun u -> FStarC_Syntax_Syntax.UN ((n - i), u)) us let (inst_tscheme_with : FStarC_Syntax_Syntax.tscheme -> @@ -2803,10 +2789,10 @@ let (inst_tscheme : match uu___ with | ([], t) -> ([], t) | (us, t) -> - let us' = FStarC_Compiler_List.map (fun uu___1 -> new_u_univ ()) us in + let us' = FStarC_List.map (fun uu___1 -> new_u_univ ()) us in inst_tscheme_with (us, t) us' let (inst_tscheme_with_range : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.tscheme -> (FStarC_Syntax_Syntax.universes * FStarC_Syntax_Syntax.term)) = @@ -2817,15 +2803,13 @@ let (inst_tscheme_with_range : | (us, t1) -> let uu___1 = FStarC_Syntax_Subst.set_use_range r t1 in (us, uu___1) let (check_effect_is_not_a_template : - FStarC_Syntax_Syntax.eff_decl -> FStarC_Compiler_Range_Type.range -> unit) - = + FStarC_Syntax_Syntax.eff_decl -> FStarC_Range_Type.range -> unit) = fun ed -> fun rng -> if - ((FStarC_Compiler_List.length ed.FStarC_Syntax_Syntax.univs) <> - Prims.int_zero) + ((FStarC_List.length ed.FStarC_Syntax_Syntax.univs) <> Prims.int_zero) || - ((FStarC_Compiler_List.length ed.FStarC_Syntax_Syntax.binders) <> + ((FStarC_List.length ed.FStarC_Syntax_Syntax.binders) <> Prims.int_zero) then let msg = @@ -2834,11 +2818,10 @@ let (check_effect_is_not_a_template : ed.FStarC_Syntax_Syntax.mname in let uu___1 = let uu___2 = - FStarC_Compiler_List.map - FStarC_Syntax_Print.binder_to_string_with_type + FStarC_List.map FStarC_Syntax_Print.binder_to_string_with_type ed.FStarC_Syntax_Syntax.binders in - FStarC_Compiler_String.concat "," uu___2 in - FStarC_Compiler_Util.format2 + FStarC_String.concat "," uu___2 in + FStarC_Util.format2 "Effect template %s should be applied to arguments for its binders (%s) before it can be used at an effect position" uu___ uu___1 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range rng @@ -2859,24 +2842,20 @@ let (inst_effect_fun_with : match uu___ with | (us, t) -> (check_effect_is_not_a_template ed env1.range; - if - (FStarC_Compiler_List.length insts) <> - (FStarC_Compiler_List.length us) + if (FStarC_List.length insts) <> (FStarC_List.length us) then (let uu___3 = let uu___4 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length us) in + FStarC_Util.string_of_int (FStarC_List.length us) in let uu___5 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length insts) in + FStarC_Util.string_of_int (FStarC_List.length insts) in let uu___6 = FStarC_Class_Show.show FStarC_Ident.showable_lident ed.FStarC_Syntax_Syntax.mname in let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Expected %s instantiations; got %s; failed universe instantiation in effect %s\n\t%s\n" uu___4 uu___5 uu___6 uu___7 in failwith uu___3) @@ -2906,19 +2885,19 @@ let (in_cur_mod : env -> FStarC_Ident.lident -> tri) = (let uu___2 = let uu___3 = FStarC_Ident.nsstr l in let uu___4 = FStarC_Ident.string_of_lid cur in - FStarC_Compiler_Util.starts_with uu___3 uu___4 in + FStarC_Util.starts_with uu___3 uu___4 in if uu___2 then let lns = let uu___3 = FStarC_Ident.ns_of_lid l in let uu___4 = let uu___5 = FStarC_Ident.ident_of_lid l in [uu___5] in - FStarC_Compiler_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___3 uu___4 in let cur1 = let uu___3 = FStarC_Ident.ns_of_lid cur in let uu___4 = let uu___5 = FStarC_Ident.ident_of_lid cur in [uu___5] in - FStarC_Compiler_List.op_At uu___3 uu___4 in + FStarC_List.op_At uu___3 uu___4 in let rec aux c l1 = match (c, l1) with | ([], uu___3) -> Maybe @@ -2936,23 +2915,23 @@ let (lookup_qname : env -> FStarC_Ident.lident -> qninfo) = let cur_mod = in_cur_mod env1 lid in let cache t = (let uu___1 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_add (gamma_cache env1) uu___1 t); + FStarC_Util.smap_add (gamma_cache env1) uu___1 t); FStar_Pervasives_Native.Some t in let found = if cur_mod <> No then let uu___ = let uu___1 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_try_find (gamma_cache env1) uu___1 in + FStarC_Util.smap_try_find (gamma_cache env1) uu___1 in match uu___ with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Util.find_map env1.gamma + FStarC_Util.find_map env1.gamma (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.Binding_lid (l, (us_names, t)) when FStarC_Ident.lid_equals lid l -> let us = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> FStarC_Syntax_Syntax.U_name uu___2) us_names in let uu___2 = @@ -2962,15 +2941,17 @@ let (lookup_qname : env -> FStarC_Ident.lident -> qninfo) = | uu___2 -> FStar_Pervasives_Native.None) | se -> se else FStar_Pervasives_Native.None in - if FStarC_Compiler_Util.is_some found + if FStarC_Util.is_some found then found else (let uu___1 = find_in_sigtab env1 lid in match uu___1 with | FStar_Pervasives_Native.Some se -> - FStar_Pervasives_Native.Some + let uu___2 = + let uu___3 = FStarC_Syntax_Util.range_of_sigelt se in ((FStar_Pervasives.Inr (se, FStar_Pervasives_Native.None)), - (FStarC_Syntax_Util.range_of_sigelt se)) + uu___3) in + FStar_Pervasives_Native.Some uu___2 | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None) let (lookup_sigelt : env -> @@ -2990,7 +2971,7 @@ let (lookup_attr : env -> Prims.string -> FStarC_Syntax_Syntax.sigelt Prims.list) = fun env1 -> fun attr -> - let uu___ = FStarC_Compiler_Util.smap_try_find (attrtab env1) attr in + let uu___ = FStarC_Util.smap_try_find (attrtab env1) attr in match uu___ with | FStar_Pervasives_Native.Some ses -> ses | FStar_Pervasives_Native.None -> [] @@ -2999,8 +2980,8 @@ let (add_se_to_attrtab : env -> FStarC_Syntax_Syntax.sigelt -> unit) = fun se -> let add_one env2 se1 attr = let uu___ = let uu___1 = lookup_attr env2 attr in se1 :: uu___1 in - FStarC_Compiler_Util.smap_add (attrtab env2) attr uu___ in - FStarC_Compiler_List.iter + FStarC_Util.smap_add (attrtab env2) attr uu___ in + FStarC_List.iter (fun attr -> let uu___ = FStarC_Syntax_Util.head_and_args attr in match uu___ with @@ -3026,14 +3007,12 @@ let (try_add_sigelt : let s = FStarC_Ident.string_of_lid l in (let uu___1 = (Prims.op_Negation force) && - (let uu___2 = - FStarC_Compiler_Util.smap_try_find (sigtab env1) s in + (let uu___2 = FStarC_Util.smap_try_find (sigtab env1) s in FStar_Pervasives_Native.uu___is_Some uu___2) in if uu___1 then let old_se = - let uu___2 = - FStarC_Compiler_Util.smap_try_find (sigtab env1) s in + let uu___2 = FStarC_Util.smap_try_find (sigtab env1) s in FStar_Pervasives_Native.__proj__Some__item__v uu___2 in (if (FStarC_Syntax_Syntax.uu___is_Sig_declare_typ @@ -3062,7 +3041,7 @@ let (try_add_sigelt : let uu___8 = let uu___9 = let uu___10 = FStarC_Ident.range_of_lid l in - FStarC_Compiler_Range_Ops.string_of_range uu___10 in + FStarC_Range_Ops.string_of_range uu___10 in FStarC_Pprint.arbitrary_string uu___9 in FStarC_Pprint.op_Hat_Slash_Hat uu___7 uu___8 in [uu___6] in @@ -3072,7 +3051,7 @@ let (try_add_sigelt : (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___3))) else ()); - FStarC_Compiler_Util.smap_add (sigtab env1) s se + FStarC_Util.smap_add (sigtab env1) s se let rec (add_sigelt : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> unit) = fun force -> @@ -3085,22 +3064,21 @@ let rec (add_sigelt : -> add_sigelts force env1 ses | uu___ -> let lids = FStarC_Syntax_Util.lids_of_sigelt se in - (FStarC_Compiler_List.iter (try_add_sigelt force env1 se) lids; + (FStarC_List.iter (try_add_sigelt force env1 se) lids; add_se_to_attrtab env1 se) and (add_sigelts : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt Prims.list -> unit) = fun force -> - fun env1 -> - fun ses -> FStarC_Compiler_List.iter (add_sigelt force env1) ses + fun env1 -> fun ses -> FStarC_List.iter (add_sigelt force env1) ses let (try_lookup_bv : env -> FStarC_Syntax_Syntax.bv -> - (FStarC_Syntax_Syntax.typ * FStarC_Compiler_Range_Type.range) + (FStarC_Syntax_Syntax.typ * FStarC_Range_Type.range) FStar_Pervasives_Native.option) = fun env1 -> fun bv -> - FStarC_Compiler_Util.find_map env1.gamma + FStarC_Util.find_map env1.gamma (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Binding_var id when @@ -3116,7 +3094,7 @@ let (lookup_type_of_let : FStarC_Syntax_Syntax.sigelt -> FStarC_Ident.lident -> ((FStarC_Syntax_Syntax.universes * FStarC_Syntax_Syntax.term) * - FStarC_Compiler_Range_Type.range) FStar_Pervasives_Native.option) + FStarC_Range_Type.range) FStar_Pervasives_Native.option) = fun us_opt -> fun se -> @@ -3144,7 +3122,7 @@ let (lookup_type_of_let : { FStarC_Syntax_Syntax.lbs1 = (uu___, lbs); FStarC_Syntax_Syntax.lids1 = uu___1;_} -> - FStarC_Compiler_Util.find_map lbs + FStarC_Util.find_map lbs (fun lb -> match lb.FStarC_Syntax_Syntax.lbname with | FStar_Pervasives.Inl uu___2 -> failwith "impossible" @@ -3165,9 +3143,9 @@ let (lookup_type_of_let : let (effect_signature : FStarC_Syntax_Syntax.universes FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.sigelt -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> ((FStarC_Syntax_Syntax.universes * FStarC_Syntax_Syntax.typ) * - FStarC_Compiler_Range_Type.range) FStar_Pervasives_Native.option) + FStarC_Range_Type.range) FStar_Pervasives_Native.option) = fun us_opt -> fun se -> @@ -3186,8 +3164,8 @@ let (effect_signature : | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some us -> if - (FStarC_Compiler_List.length us) <> - (FStarC_Compiler_List.length + (FStarC_List.length us) <> + (FStarC_List.length (FStar_Pervasives_Native.fst sig_ts)) then let uu___2 = @@ -3198,13 +3176,13 @@ let (effect_signature : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length + FStarC_Util.string_of_int + (FStarC_List.length (FStar_Pervasives_Native.fst sig_ts)) in let uu___8 = let uu___9 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length us) in + FStarC_Util.string_of_int + (FStarC_List.length us) in Prims.strcat ", got " uu___9 in Prims.strcat uu___7 uu___8 in Prims.strcat ", expected " uu___6 in @@ -3241,7 +3219,7 @@ let (try_lookup_lid_aux : env -> FStarC_Ident.lident -> ((FStarC_Syntax_Syntax.universes * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax) * FStarC_Compiler_Range_Type.range) + FStarC_Syntax_Syntax.syntax) * FStarC_Range_Type.range) FStar_Pervasives_Native.option) = fun us_opt -> @@ -3300,8 +3278,8 @@ let (try_lookup_lid_aux : if uu___6 then (if - (FStarC_Compiler_List.contains - FStarC_Syntax_Syntax.Assumption qs) + (FStarC_List.contains FStarC_Syntax_Syntax.Assumption + qs) || env1.is_iface then let uu___7 = @@ -3405,13 +3383,13 @@ let (try_lookup_lid_aux : | uu___2 -> effect_signature us_opt (FStar_Pervasives_Native.fst se) env1.range in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun uu___2 -> match uu___2 with | (us_t, rng1) -> (us_t, rng1)) uu___1) in let uu___ = let uu___1 = lookup_qname env1 lid in - FStarC_Compiler_Util.bind_opt uu___1 mapper in + FStarC_Util.bind_opt uu___1 mapper in match uu___ with | FStar_Pervasives_Native.Some ((us, t), r) -> let uu___1 = @@ -3439,7 +3417,7 @@ let (lid_exists : env -> FStarC_Ident.lident -> Prims.bool) = let (lookup_bv : env -> FStarC_Syntax_Syntax.bv -> - (FStarC_Syntax_Syntax.typ * FStarC_Compiler_Range_Type.range)) + (FStarC_Syntax_Syntax.typ * FStarC_Range_Type.range)) = fun env1 -> fun bv -> @@ -3450,7 +3428,7 @@ let (lookup_bv : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv bv in - FStarC_Compiler_Util.format1 "Variable \"%s\" not found" uu___2 in + FStarC_Util.format1 "Variable \"%s\" not found" uu___2 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range bvr FStarC_Errors_Codes.Fatal_VariableNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -3458,14 +3436,14 @@ let (lookup_bv : | FStar_Pervasives_Native.Some (t, r) -> let uu___1 = FStarC_Syntax_Subst.set_use_range bvr t in let uu___2 = - let uu___3 = FStarC_Compiler_Range_Type.use_range bvr in - FStarC_Compiler_Range_Type.set_use_range r uu___3 in + let uu___3 = FStarC_Range_Type.use_range bvr in + FStarC_Range_Type.set_use_range r uu___3 in (uu___1, uu___2) let (try_lookup_lid : env -> FStarC_Ident.lident -> ((FStarC_Syntax_Syntax.universes * FStarC_Syntax_Syntax.typ) * - FStarC_Compiler_Range_Type.range) FStar_Pervasives_Native.option) + FStarC_Range_Type.range) FStar_Pervasives_Native.option) = fun env1 -> fun l -> @@ -3475,8 +3453,8 @@ let (try_lookup_lid : | FStar_Pervasives_Native.Some ((us, t), r) -> let use_range = FStarC_Ident.range_of_lid l in let r1 = - let uu___1 = FStarC_Compiler_Range_Type.use_range use_range in - FStarC_Compiler_Range_Type.set_use_range r uu___1 in + let uu___1 = FStarC_Range_Type.use_range use_range in + FStarC_Range_Type.set_use_range r uu___1 in let uu___1 = let uu___2 = let uu___3 = FStarC_Syntax_Subst.set_use_range use_range t in @@ -3487,7 +3465,7 @@ let (try_lookup_and_inst_lid : env -> FStarC_Syntax_Syntax.universes -> FStarC_Ident.lident -> - (FStarC_Syntax_Syntax.typ * FStarC_Compiler_Range_Type.range) + (FStarC_Syntax_Syntax.typ * FStarC_Range_Type.range) FStar_Pervasives_Native.option) = fun env1 -> @@ -3500,8 +3478,8 @@ let (try_lookup_and_inst_lid : | FStar_Pervasives_Native.Some ((uu___1, t), r) -> let use_range = FStarC_Ident.range_of_lid l in let r1 = - let uu___2 = FStarC_Compiler_Range_Type.use_range use_range in - FStarC_Compiler_Range_Type.set_use_range r uu___2 in + let uu___2 = FStarC_Range_Type.use_range use_range in + FStarC_Range_Type.set_use_range r uu___2 in let uu___2 = let uu___3 = FStarC_Syntax_Subst.set_use_range use_range t in (uu___3, r1) in @@ -3510,7 +3488,7 @@ let name_not_found : 'a . FStarC_Ident.lid -> 'a = fun l -> let uu___ = let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 "Name \"%s\" not found" uu___1 in + FStarC_Util.format1 "Name \"%s\" not found" uu___1 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident l FStarC_Errors_Codes.Fatal_NameNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___) @@ -3518,7 +3496,7 @@ let (lookup_lid : env -> FStarC_Ident.lident -> ((FStarC_Syntax_Syntax.universes * FStarC_Syntax_Syntax.typ) * - FStarC_Compiler_Range_Type.range)) + FStarC_Range_Type.range)) = fun env1 -> fun l -> @@ -3530,14 +3508,14 @@ let (lookup_univ : env -> FStarC_Syntax_Syntax.univ_name -> Prims.bool) = fun env1 -> fun x -> let uu___ = - FStarC_Compiler_List.find + FStarC_List.find (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.Binding_univ y -> let uu___2 = FStarC_Ident.string_of_id x in let uu___3 = FStarC_Ident.string_of_id y in uu___2 = uu___3 | uu___2 -> false) env1.gamma in - FStarC_Compiler_Option.isSome uu___ + FStarC_Option.isSome uu___ let (try_lookup_val_decl : env -> FStarC_Ident.lident -> @@ -3727,7 +3705,7 @@ let (typ_of_datacon : env -> FStarC_Ident.lident -> FStarC_Ident.lident) = let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident lid in - FStarC_Compiler_Util.format1 "Not a datacon: %s" uu___3 in + FStarC_Util.format1 "Not a datacon: %s" uu___3 in failwith uu___2 let (num_datacon_non_injective_ty_params : env -> FStarC_Ident.lident -> Prims.int FStar_Pervasives_Native.option) = @@ -3766,9 +3744,8 @@ let (visible_with : = fun delta_levels -> fun quals -> - FStarC_Compiler_Util.for_some - (fun dl -> FStarC_Compiler_Util.for_some (visible_at dl) quals) - delta_levels + FStarC_Util.for_some + (fun dl -> FStarC_Util.for_some (visible_at dl) quals) delta_levels let (lookup_definition_qninfo_aux : Prims.bool -> delta_level Prims.list -> @@ -3796,11 +3773,10 @@ let (lookup_definition_qninfo_aux : se.FStarC_Syntax_Syntax.sigquals) && ((Prims.op_Negation is_rec) || rec_ok) -> - FStarC_Compiler_Util.find_map lbs + FStarC_Util.find_map lbs (fun lb -> let fv = - FStarC_Compiler_Util.right - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let uu___2 = FStarC_Syntax_Syntax.fv_eq_lid fv lid in if uu___2 then @@ -3870,13 +3846,12 @@ let rec (delta_depth_of_qninfo_lid : then FStarC_Syntax_Syntax.delta_equational else FStarC_Syntax_Syntax.delta_constant in let uu___3 = - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some FStarC_Syntax_Syntax.uu___is_Assumption se.FStarC_Syntax_Syntax.sigquals) && (let uu___4 = - FStarC_Compiler_Util.for_some - FStarC_Syntax_Syntax.uu___is_New + FStarC_Util.for_some FStarC_Syntax_Syntax.uu___is_New se.FStarC_Syntax_Syntax.sigquals in Prims.op_Negation uu___4) in if uu___3 @@ -3887,11 +3862,10 @@ let rec (delta_depth_of_qninfo_lid : FStarC_Syntax_Syntax.lids1 = uu___3;_} -> let uu___4 = - FStarC_Compiler_Util.find_map lbs + FStarC_Util.find_map lbs (fun lb -> let fv = - FStarC_Compiler_Util.right - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let uu___5 = FStarC_Syntax_Syntax.fv_eq_lid fv lid in if uu___5 then @@ -3902,7 +3876,7 @@ let rec (delta_depth_of_qninfo_lid : FStarC_Syntax_Util.incr_delta_depth uu___7 in FStar_Pervasives_Native.Some uu___6 else FStar_Pervasives_Native.None) in - FStarC_Compiler_Util.must uu___4 + FStarC_Util.must uu___4 | FStarC_Syntax_Syntax.Sig_fail uu___2 -> failwith "impossible: delta_depth_of_qninfo" | FStarC_Syntax_Syntax.Sig_splice uu___2 -> @@ -3937,12 +3911,12 @@ and (delta_depth_of_fv : let lid = (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in let uu___ = let uu___1 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_try_find env1.fv_delta_depths uu___1 in + FStarC_Util.smap_try_find env1.fv_delta_depths uu___1 in match uu___ with | FStar_Pervasives_Native.Some dd -> dd | FStar_Pervasives_Native.None -> ((let uu___2 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_add env1.fv_delta_depths uu___2 + FStarC_Util.smap_add env1.fv_delta_depths uu___2 FStarC_Syntax_Syntax.delta_equational); (let d = let uu___2 = @@ -3950,7 +3924,7 @@ and (delta_depth_of_fv : (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in delta_depth_of_qninfo env1 fv uu___2 in (let uu___3 = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_add env1.fv_delta_depths uu___3 d); + FStarC_Util.smap_add env1.fv_delta_depths uu___3 d); d)) and (fv_delta_depth : env -> FStarC_Syntax_Syntax.fv -> FStarC_Syntax_Syntax.delta_depth) = @@ -4065,7 +4039,7 @@ let (fv_exists_and_has_attr : | FStar_Pervasives_Native.None -> (false, false) | FStar_Pervasives_Native.Some attrs -> let uu___1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun tm -> let uu___2 = let uu___3 = FStarC_Syntax_Util.un_uinst tm in @@ -4091,7 +4065,7 @@ let (fv_has_attr : (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v attr_lid let cache_in_fv_tab : 'a . - 'a FStarC_Compiler_Util.smap -> + 'a FStarC_Util.smap -> FStarC_Syntax_Syntax.fv -> (unit -> (Prims.bool * 'a)) -> 'a = fun tab -> @@ -4100,15 +4074,13 @@ let cache_in_fv_tab : let s = let uu___ = FStarC_Syntax_Syntax.lid_of_fv fv in FStarC_Ident.string_of_lid uu___ in - let uu___ = FStarC_Compiler_Util.smap_try_find tab s in + let uu___ = FStarC_Util.smap_try_find tab s in match uu___ with | FStar_Pervasives_Native.None -> let uu___1 = f () in (match uu___1 with | (should_cache, res) -> - (if should_cache - then FStarC_Compiler_Util.smap_add tab s res - else (); + (if should_cache then FStarC_Util.smap_add tab s res else (); res)) | FStar_Pervasives_Native.Some r -> r let (fv_has_erasable_attr : env -> FStarC_Syntax_Syntax.fv -> Prims.bool) = @@ -4137,14 +4109,13 @@ let (fv_has_strict_args : (false, FStar_Pervasives_Native.None) | FStar_Pervasives_Native.Some attrs1 -> let res = - FStarC_Compiler_Util.find_map attrs1 + FStarC_Util.find_map attrs1 (fun x -> let uu___1 = FStarC_ToSyntax_ToSyntax.parse_attr_with_list false x FStarC_Parser_Const.strict_on_arguments_attr in FStar_Pervasives_Native.fst uu___1) in - let uu___1 = - FStarC_Compiler_Util.map_opt res FStar_Pervasives_Native.fst in + let uu___1 = FStarC_Util.map_opt res FStar_Pervasives_Native.fst in (true, uu___1) in cache_in_fv_tab env1.strict_args_tab fv f let (try_lookup_effect_lid : @@ -4213,11 +4184,11 @@ let (lookup_effect_abbrev : let uu___9 = FStarC_Ident.range_of_lid lid in let uu___10 = let uu___11 = FStarC_Ident.range_of_lid lid0 in - FStarC_Compiler_Range_Type.use_range uu___11 in - FStarC_Compiler_Range_Type.set_use_range uu___9 uu___10 in + FStarC_Range_Type.use_range uu___11 in + FStarC_Range_Type.set_use_range uu___9 uu___10 in FStarC_Ident.set_lid_range lid uu___8 in let uu___8 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___9 -> match uu___9 with | FStarC_Syntax_Syntax.Irreducible -> true @@ -4227,21 +4198,21 @@ let (lookup_effect_abbrev : else (let insts = if - (FStarC_Compiler_List.length univ_insts) = - (FStarC_Compiler_List.length univs) + (FStarC_List.length univ_insts) = + (FStarC_List.length univs) then univ_insts else (let uu___11 = let uu___12 = let uu___13 = get_range env1 in - FStarC_Compiler_Range_Ops.string_of_range uu___13 in + FStarC_Range_Ops.string_of_range uu___13 in let uu___13 = FStarC_Class_Show.show FStarC_Ident.showable_lident lid1 in let uu___14 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length univ_insts) in - FStarC_Compiler_Util.format3 + FStarC_Util.string_of_int + (FStarC_List.length univ_insts) in + FStarC_Util.format3 "(%s) Unexpected instantiation of effect %s with %s universes" uu___12 uu___13 uu___14 in failwith uu___11) in @@ -4255,9 +4226,8 @@ let (lookup_effect_abbrev : FStarC_Class_Show.show FStarC_Ident.showable_lident lid1 in let uu___16 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length univs) in - FStarC_Compiler_Util.format2 + FStarC_Util.string_of_int (FStarC_List.length univs) in + FStarC_Util.format2 "Unexpected effect abbreviation %s; polymorphic in %s universes" uu___15 uu___16 in failwith uu___14 @@ -4301,7 +4271,7 @@ let (norm_eff_name : env -> FStarC_Ident.lident -> FStarC_Ident.lident) = let res = let uu___ = let uu___1 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_try_find env1.normalized_eff_names uu___1 in + FStarC_Util.smap_try_find env1.normalized_eff_names uu___1 in match uu___ with | FStar_Pervasives_Native.Some l1 -> l1 | FStar_Pervasives_Native.None -> @@ -4310,8 +4280,7 @@ let (norm_eff_name : env -> FStarC_Ident.lident -> FStarC_Ident.lident) = | FStar_Pervasives_Native.None -> l | FStar_Pervasives_Native.Some m -> ((let uu___3 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.smap_add env1.normalized_eff_names - uu___3 m); + FStarC_Util.smap_add env1.normalized_eff_names uu___3 m); m)) in let uu___ = FStarC_Ident.range_of_lid l in FStarC_Ident.set_lid_range res uu___ @@ -4350,13 +4319,14 @@ let rec (non_informative : env -> FStarC_Syntax_Syntax.typ -> Prims.bool) = FStarC_Syntax_Syntax.comp = c;_} -> ((FStarC_Syntax_Util.is_pure_or_ghost_comp c) && - (non_informative env1 (FStarC_Syntax_Util.comp_result c))) + (let uu___2 = FStarC_Syntax_Util.comp_result c in + non_informative env1 uu___2)) || - (is_erasable_effect env1 (FStarC_Syntax_Util.comp_effect_name c)) + (let uu___2 = FStarC_Syntax_Util.comp_effect_name c in + is_erasable_effect env1 uu___2) | uu___1 -> false let (num_effect_indices : - env -> FStarC_Ident.lident -> FStarC_Compiler_Range_Type.range -> Prims.int) - = + env -> FStarC_Ident.lident -> FStarC_Range_Type.range -> Prims.int) = fun env1 -> fun name -> fun r -> @@ -4367,7 +4337,7 @@ let (num_effect_indices : | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = _a::bs; FStarC_Syntax_Syntax.comp = uu___;_} - -> FStarC_Compiler_List.length bs + -> FStarC_List.length bs | uu___ -> let uu___1 = let uu___2 = @@ -4375,8 +4345,8 @@ let (num_effect_indices : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term sig_t in - FStarC_Compiler_Util.format2 - "Signature for %s not an arrow (%s)" uu___2 uu___3 in + FStarC_Util.format2 "Signature for %s not an arrow (%s)" uu___2 + uu___3 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_UnexpectedSignatureForMonad () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -4410,10 +4380,10 @@ let (lookup_projector : fun i -> let fail uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int i in + let uu___2 = FStarC_Util.string_of_int i in let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident lid in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: projecting field #%s from constructor %s is undefined" uu___2 uu___3 in failwith uu___1 in @@ -4430,10 +4400,10 @@ let (lookup_projector : -> if (i < Prims.int_zero) || - (i >= (FStarC_Compiler_List.length binders)) + (i >= (FStarC_List.length binders)) then fail () else - (let b = FStarC_Compiler_List.nth binders i in + (let b = FStarC_List.nth binders i in FStarC_Syntax_Util.mk_field_projector_name lid b.FStarC_Syntax_Syntax.binder_bv i) | uu___3 -> fail ()) @@ -4456,7 +4426,7 @@ let (is_projector : env -> FStarC_Ident.lident -> Prims.bool) = uu___7), uu___8) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___9 -> match uu___9 with | FStarC_Syntax_Syntax.Projector uu___10 -> true @@ -4501,7 +4471,7 @@ let (is_record : env -> FStarC_Ident.lident -> Prims.bool) = uu___7), uu___8) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___9 -> match uu___9 with | FStarC_Syntax_Syntax.RecordType uu___10 -> true @@ -4523,7 +4493,7 @@ let (qninfo_is_action : qninfo -> Prims.bool) = uu___6), uu___7) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___8 -> match uu___8 with | FStarC_Syntax_Syntax.Action uu___9 -> true @@ -4556,7 +4526,7 @@ let (is_interpreted : env -> FStarC_Syntax_Syntax.term -> Prims.bool) = uu___1.FStarC_Syntax_Syntax.n in match uu___ with | FStarC_Syntax_Syntax.Tm_fvar fv -> - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (FStarC_Ident.lid_equals (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v) interpreted_symbols) @@ -4573,7 +4543,7 @@ let (is_irreducible : env -> FStarC_Ident.lident -> Prims.bool) = match uu___ with | FStar_Pervasives_Native.Some (FStar_Pervasives.Inr (se, uu___1), uu___2) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.Irreducible -> true @@ -4589,14 +4559,14 @@ let (is_type_constructor : env -> FStarC_Ident.lident -> Prims.bool) = (match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_declare_typ uu___1 -> FStar_Pervasives_Native.Some - (FStarC_Compiler_List.contains FStarC_Syntax_Syntax.New + (FStarC_List.contains FStarC_Syntax_Syntax.New se.FStarC_Syntax_Syntax.sigquals) | FStarC_Syntax_Syntax.Sig_inductive_typ uu___1 -> FStar_Pervasives_Native.Some true | uu___1 -> FStar_Pervasives_Native.Some false) in let uu___ = let uu___1 = lookup_qname env1 lid in - FStarC_Compiler_Util.bind_opt uu___1 mapper in + FStarC_Util.bind_opt uu___1 mapper in match uu___ with | FStar_Pervasives_Native.Some b -> b | FStar_Pervasives_Native.None -> false @@ -4627,7 +4597,7 @@ let (num_inductive_ty_params : FStarC_Syntax_Syntax.sigopts = uu___13;_}, uu___14), uu___15) - -> FStar_Pervasives_Native.Some (FStarC_Compiler_List.length tps) + -> FStar_Pervasives_Native.Some (FStarC_List.length tps) | uu___1 -> FStar_Pervasives_Native.None let (num_inductive_uniform_ty_params : env -> FStarC_Ident.lident -> Prims.int FStar_Pervasives_Native.option) = @@ -4662,7 +4632,7 @@ let (num_inductive_uniform_ty_params : let uu___16 = let uu___17 = FStarC_Class_Show.show FStarC_Ident.showable_lident lid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Internal error: Inductive %s is not decorated with its uniform type parameters" uu___17 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident lid @@ -4679,7 +4649,7 @@ let (effect_decl_opt : = fun env1 -> fun l -> - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___ -> match uu___ with | (d, uu___1) -> @@ -4709,15 +4679,15 @@ let (get_lid_valued_effect_attr : let uu___1 = let uu___2 = norm_eff_name env1 eff_lid in lookup_attrs_of_lid env1 uu___2 in - FStarC_Compiler_Util.dflt [] uu___1 in + FStarC_Util.dflt [] uu___1 in FStarC_Syntax_Util.get_attribute attr_name_lid uu___ in match attr_args with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some args -> - if (FStarC_Compiler_List.length args) = Prims.int_zero + if (FStarC_List.length args) = Prims.int_zero then default_if_attr_has_no_arg else - (let uu___1 = FStarC_Compiler_List.hd args in + (let uu___1 = FStarC_List.hd args in match uu___1 with | (t, uu___2) -> let uu___3 = @@ -4736,7 +4706,7 @@ let (get_lid_valued_effect_attr : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "The argument for the effect attribute for %s is not a constant string, it is %s\n" uu___6 uu___7 in FStarC_Errors.raise_error @@ -4773,8 +4743,7 @@ let (identity_mlift : mlift) = (fun uu___ -> fun c -> (c, FStarC_TypeChecker_Common.trivial_guard)); mlift_term = (FStar_Pervasives_Native.Some - (fun uu___ -> - fun uu___1 -> fun e -> FStarC_Compiler_Util.return_all e)) + (fun uu___ -> fun uu___1 -> fun e -> FStarC_Util.return_all e)) } let (join_opt : env -> @@ -4808,7 +4777,7 @@ let (join_opt : identity_mlift) else (let uu___4 = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___5 -> match uu___5 with | (m1, m2, uu___6, uu___7, uu___8) -> @@ -4835,8 +4804,8 @@ let (join : FStarC_Class_Show.show FStarC_Ident.showable_lident l1 in let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident l2 in - FStarC_Compiler_Util.format2 - "Effects %s and %s cannot be composed" uu___2 uu___3 in + FStarC_Util.format2 "Effects %s and %s cannot be composed" + uu___2 uu___3 in FStarC_Errors.raise_error hasRange_env env1 FStarC_Errors_Codes.Fatal_EffectsCannotBeComposed () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -4862,7 +4831,7 @@ let (monad_leq : { msource = l1; mtarget = l2; mlift = identity_mlift; mpath = [] } else - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun e -> (FStarC_Ident.lid_equals l1 e.msource) && (FStarC_Ident.lid_equals l2 e.mtarget)) (env1.effects).order @@ -4876,7 +4845,7 @@ let wp_sig_aux : fun decls -> fun m -> let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | (d, uu___2) -> @@ -4886,7 +4855,7 @@ let wp_sig_aux : | FStar_Pervasives_Native.None -> let uu___1 = let uu___2 = FStarC_Ident.string_of_lid m in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: declaration for monad %s not found" uu___2 in failwith uu___1 | FStar_Pervasives_Native.Some (md, _q) -> @@ -4905,9 +4874,8 @@ let wp_sig_aux : { FStarC_Syntax_Syntax.bs1 = b::wp_b::[]; FStarC_Syntax_Syntax.comp = c;_}) when - FStarC_Syntax_Syntax.is_teff - (FStarC_Syntax_Util.comp_result c) - -> + let uu___3 = FStarC_Syntax_Util.comp_result c in + FStarC_Syntax_Syntax.is_teff uu___3 -> ((b.FStarC_Syntax_Syntax.binder_bv), ((wp_b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort)) | uu___3 -> failwith "Impossible")) @@ -4921,7 +4889,7 @@ let (bound_vars_of_bindings : FStarC_Syntax_Syntax.bv Prims.list) = fun bs -> - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Binding_var x -> [x] @@ -4932,8 +4900,8 @@ let (binders_of_bindings : fun bs -> let uu___ = let uu___1 = bound_vars_of_bindings bs in - FStarC_Compiler_List.map FStarC_Syntax_Syntax.mk_binder uu___1 in - FStarC_Compiler_List.rev uu___ + FStarC_List.map FStarC_Syntax_Syntax.mk_binder uu___1 in + FStarC_List.rev uu___ let (all_binders : env -> FStarC_Syntax_Syntax.binders) = fun env1 -> binders_of_bindings env1.gamma let (bound_vars : env -> FStarC_Syntax_Syntax.bv Prims.list) = @@ -4947,7 +4915,7 @@ let (hasBinders_env : env FStarC_Class_Binders.hasBinders) = Obj.magic (FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) uu___)) uu___) } let (hasNames_lcomp : @@ -4974,7 +4942,7 @@ let (hasNames_guard : guard_t FStarC_Class_Binders.hasNames) = (Obj.repr (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) ())) | FStarC_TypeChecker_Common.NonTrivial f -> Obj.magic @@ -5015,13 +4983,13 @@ let (comp_to_comp_typ : | (effect_name, result_typ) -> let uu___3 = let uu___4 = env1.universe_of env1 result_typ in [uu___4] in + let uu___4 = FStarC_Syntax_Util.comp_flags c in { FStarC_Syntax_Syntax.comp_univs = uu___3; FStarC_Syntax_Syntax.effect_name = effect_name; FStarC_Syntax_Syntax.result_typ = result_typ; FStarC_Syntax_Syntax.effect_args = []; - FStarC_Syntax_Syntax.flags = - (FStarC_Syntax_Util.comp_flags c) + FStarC_Syntax_Syntax.flags = uu___4 })) let (comp_set_flags : env -> @@ -5079,25 +5047,24 @@ let rec (unfold_effect_abbrev : (match uu___2 with | (binders1, cdef1) -> (if - (FStarC_Compiler_List.length binders1) <> - ((FStarC_Compiler_List.length - c.FStarC_Syntax_Syntax.effect_args) + (FStarC_List.length binders1) <> + ((FStarC_List.length c.FStarC_Syntax_Syntax.effect_args) + Prims.int_one) then (let uu___4 = let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length binders1) in + (FStarC_List.length binders1) in let uu___6 = FStarC_Class_Show.show FStarC_Class_Show.showable_int - ((FStarC_Compiler_List.length + ((FStarC_List.length c.FStarC_Syntax_Syntax.effect_args) + Prims.int_one) in let uu___7 = let uu___8 = FStarC_Syntax_Syntax.mk_Comp c in FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp uu___8 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Effect constructor is not fully applied; expected %s args, got %s args, i.e., %s" uu___5 uu___6 uu___7 in FStarC_Errors.raise_error @@ -5113,7 +5080,7 @@ let rec (unfold_effect_abbrev : FStarC_Syntax_Syntax.as_arg c.FStarC_Syntax_Syntax.result_typ in uu___5 :: (c.FStarC_Syntax_Syntax.effect_args) in - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun uu___5 -> match uu___5 with @@ -5143,7 +5110,7 @@ let effect_repr_aux : 'uuuuu . 'uuuuu -> env -> - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.universe -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax FStar_Pervasives_Native.option @@ -5156,7 +5123,7 @@ let effect_repr_aux : let r = get_range env1 in let uu___ = let uu___1 = num_effect_indices env1 eff_name r in - ((FStarC_Compiler_List.length args), uu___1) in + ((FStarC_List.length args), uu___1) in match uu___ with | (given, expected) -> if given = expected @@ -5164,9 +5131,9 @@ let effect_repr_aux : else (let message = let uu___2 = FStarC_Ident.string_of_lid eff_name in - let uu___3 = FStarC_Compiler_Util.string_of_int given in - let uu___4 = FStarC_Compiler_Util.string_of_int expected in - FStarC_Compiler_Util.format3 + let uu___3 = FStarC_Util.string_of_int given in + let uu___4 = FStarC_Util.string_of_int expected in + FStarC_Util.format3 "Not enough arguments for effect %s, This usually happens when you use a partially applied DM4F effect, like [TAC int] instead of [Tac int] (given:%s, expected:%s)." uu___2 uu___3 uu___4 in FStarC_Errors.raise_error @@ -5175,7 +5142,8 @@ let effect_repr_aux : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic message)) in let effect_name = - norm_eff_name env1 (FStarC_Syntax_Util.comp_effect_name c) in + let uu___ = FStarC_Syntax_Util.comp_effect_name c in + norm_eff_name env1 uu___ in let uu___ = effect_decl_opt env1 effect_name in match uu___ with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None @@ -5214,13 +5182,13 @@ let (is_user_reifiable_effect : env -> FStarC_Ident.lident -> Prims.bool) = fun effect_lid -> let effect_lid1 = norm_eff_name env1 effect_lid in let quals = lookup_effect_quals env1 effect_lid1 in - FStarC_Compiler_List.contains FStarC_Syntax_Syntax.Reifiable quals + FStarC_List.contains FStarC_Syntax_Syntax.Reifiable quals let (is_user_reflectable_effect : env -> FStarC_Ident.lident -> Prims.bool) = fun env1 -> fun effect_lid -> let effect_lid1 = norm_eff_name env1 effect_lid in let quals = lookup_effect_quals env1 effect_lid1 in - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Reflectable uu___1 -> true @@ -5230,7 +5198,7 @@ let (is_total_effect : env -> FStarC_Ident.lident -> Prims.bool) = fun effect_lid -> let effect_lid1 = norm_eff_name env1 effect_lid in let quals = lookup_effect_quals env1 effect_lid1 in - FStarC_Compiler_List.contains FStarC_Syntax_Syntax.TotalEffect quals + FStarC_List.contains FStarC_Syntax_Syntax.TotalEffect quals let (is_reifiable_effect : env -> FStarC_Ident.lident -> Prims.bool) = fun env1 -> fun effect_lid -> @@ -5278,8 +5246,7 @@ let (reify_comp : then let uu___2 = let uu___3 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 "Effect %s cannot be reified" - uu___3 in + FStarC_Util.format1 "Effect %s cannot be reified" uu___3 in FStarC_Errors.raise_error hasRange_env env1 FStarC_Errors_Codes.Fatal_EffectCannotBeReified () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -5295,14 +5262,14 @@ let rec (record_vals_and_defns : env -> FStarC_Syntax_Syntax.sigelt -> env) = fun se -> match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_declare_typ uu___ when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.OnlyName -> true | uu___2 -> false) se.FStarC_Syntax_Syntax.sigquals -> g | FStarC_Syntax_Syntax.Sig_let uu___ when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.OnlyName -> true @@ -5314,7 +5281,7 @@ let rec (record_vals_and_defns : env -> FStarC_Syntax_Syntax.sigelt -> env) = FStarC_Syntax_Syntax.t2 = uu___1;_} -> if - (FStarC_Compiler_List.contains FStarC_Syntax_Syntax.Assumption + (FStarC_List.contains FStarC_Syntax_Syntax.Assumption se.FStarC_Syntax_Syntax.sigquals) || g.is_iface then g @@ -5322,7 +5289,7 @@ let rec (record_vals_and_defns : env -> FStarC_Syntax_Syntax.sigelt -> env) = | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = uu___; FStarC_Syntax_Syntax.lids1 = lids;_} - -> FStarC_Compiler_List.fold_left record_definition_for g lids + -> FStarC_List.fold_left record_definition_for g lids | FStarC_Syntax_Syntax.Sig_datacon { FStarC_Syntax_Syntax.lid1 = lid; FStarC_Syntax_Syntax.us1 = uu___; @@ -5344,14 +5311,15 @@ let rec (record_vals_and_defns : env -> FStarC_Syntax_Syntax.sigelt -> env) = | FStarC_Syntax_Syntax.Sig_bundle { FStarC_Syntax_Syntax.ses = ses; FStarC_Syntax_Syntax.lids = uu___;_} - -> FStarC_Compiler_List.fold_left record_vals_and_defns g ses + -> FStarC_List.fold_left record_vals_and_defns g ses | uu___ -> g let (push_sigelt' : Prims.bool -> env -> FStarC_Syntax_Syntax.sigelt -> env) = fun force -> fun env1 -> fun s -> - let sb = ((FStarC_Syntax_Util.lids_of_sigelt s), s) in + let sb = + let uu___ = FStarC_Syntax_Util.lids_of_sigelt s in (uu___, s) in let env2 = { solver = (env1.solver); @@ -5427,9 +5395,7 @@ let (push_new_effect : let effects1 = let uu___1 = env1.effects in { - decls = - (FStarC_Compiler_List.op_At (env1.effects).decls - [(ed, quals)]); + decls = (FStarC_List.op_At (env1.effects).decls [(ed, quals)]); order = (uu___1.order); joins = (uu___1.joins); polymonadic_binds = (uu___1.polymonadic_binds); @@ -5501,7 +5467,7 @@ let (exists_polymonadic_bind : fun m -> fun n -> let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | (m1, n1, uu___2, uu___3) -> @@ -5524,7 +5490,7 @@ let (exists_polymonadic_subcomp : fun m -> fun n -> let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | (m1, n1, uu___2, uu___3) -> @@ -5541,35 +5507,33 @@ let (print_effects_graph : env -> Prims.string) = let uu___ = FStarC_Ident.ident_of_lid lid in FStarC_Ident.string_of_id uu___ in let path_str path = - let uu___ = FStarC_Compiler_List.map eff_name path in - FStarC_Compiler_String.concat ";" uu___ in - let pbinds = FStarC_Compiler_Util.smap_create (Prims.of_int (10)) in - let lifts = FStarC_Compiler_Util.smap_create (Prims.of_int (20)) in - let psubcomps = FStarC_Compiler_Util.smap_create (Prims.of_int (10)) in - FStarC_Compiler_List.iter + let uu___ = FStarC_List.map eff_name path in + FStarC_String.concat ";" uu___ in + let pbinds = FStarC_Util.smap_create (Prims.of_int (10)) in + let lifts = FStarC_Util.smap_create (Prims.of_int (20)) in + let psubcomps = FStarC_Util.smap_create (Prims.of_int (10)) in + FStarC_List.iter (fun uu___1 -> match uu___1 with | { msource = src; mtarget = tgt; mlift = uu___2; mpath = path;_} -> let key = eff_name src in let m = - let uu___3 = FStarC_Compiler_Util.smap_try_find lifts key in + let uu___3 = FStarC_Util.smap_try_find lifts key in match uu___3 with | FStar_Pervasives_Native.None -> - let m1 = - FStarC_Compiler_Util.smap_create (Prims.of_int (10)) in - (FStarC_Compiler_Util.smap_add lifts key m1; m1) + let m1 = FStarC_Util.smap_create (Prims.of_int (10)) in + (FStarC_Util.smap_add lifts key m1; m1) | FStar_Pervasives_Native.Some m1 -> m1 in let uu___3 = let uu___4 = eff_name tgt in - FStarC_Compiler_Util.smap_try_find m uu___4 in + FStarC_Util.smap_try_find m uu___4 in (match uu___3 with | FStar_Pervasives_Native.Some uu___4 -> () | FStar_Pervasives_Native.None -> let uu___4 = eff_name tgt in let uu___5 = path_str path in - FStarC_Compiler_Util.smap_add m uu___4 uu___5)) - (env1.effects).order; - FStarC_Compiler_List.iter + FStarC_Util.smap_add m uu___4 uu___5)) (env1.effects).order; + FStarC_List.iter (fun uu___2 -> match uu___2 with | (m, n, p, uu___3) -> @@ -5577,58 +5541,55 @@ let (print_effects_graph : env -> Prims.string) = let uu___4 = eff_name m in let uu___5 = eff_name n in let uu___6 = eff_name p in - FStarC_Compiler_Util.format3 "%s, %s |> %s" uu___4 uu___5 - uu___6 in - FStarC_Compiler_Util.smap_add pbinds key "") + FStarC_Util.format3 "%s, %s |> %s" uu___4 uu___5 uu___6 in + FStarC_Util.smap_add pbinds key "") (env1.effects).polymonadic_binds; - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___3 -> match uu___3 with | (m, n, uu___4, uu___5) -> let key = let uu___6 = eff_name m in let uu___7 = eff_name n in - FStarC_Compiler_Util.format2 "%s <: %s" uu___6 uu___7 in - FStarC_Compiler_Util.smap_add psubcomps key "") + FStarC_Util.format2 "%s <: %s" uu___6 uu___7 in + FStarC_Util.smap_add psubcomps key "") (env1.effects).polymonadic_subcomps; (let uu___3 = let uu___4 = - FStarC_Compiler_Util.smap_fold lifts + FStarC_Util.smap_fold lifts (fun src -> fun m -> fun s -> - FStarC_Compiler_Util.smap_fold m + FStarC_Util.smap_fold m (fun tgt -> fun path -> fun s1 -> let uu___5 = - FStarC_Compiler_Util.format3 - "%s -> %s [label=\"%s\"]" src tgt path in + FStarC_Util.format3 "%s -> %s [label=\"%s\"]" + src tgt path in uu___5 :: s1) s) [] in - FStarC_Compiler_String.concat "\n" uu___4 in + FStarC_String.concat "\n" uu___4 in let uu___4 = let uu___5 = - FStarC_Compiler_Util.smap_fold pbinds + FStarC_Util.smap_fold pbinds (fun k -> fun uu___6 -> fun s -> let uu___7 = - FStarC_Compiler_Util.format1 - "\"%s\" [shape=\"plaintext\"]" k in + FStarC_Util.format1 "\"%s\" [shape=\"plaintext\"]" k in uu___7 :: s) [] in - FStarC_Compiler_String.concat "\n" uu___5 in + FStarC_String.concat "\n" uu___5 in let uu___5 = let uu___6 = - FStarC_Compiler_Util.smap_fold psubcomps + FStarC_Util.smap_fold psubcomps (fun k -> fun uu___7 -> fun s -> let uu___8 = - FStarC_Compiler_Util.format1 - "\"%s\" [shape=\"plaintext\"]" k in + FStarC_Util.format1 "\"%s\" [shape=\"plaintext\"]" k in uu___8 :: s) [] in - FStarC_Compiler_String.concat "\n" uu___6 in - FStarC_Compiler_Util.format3 + FStarC_String.concat "\n" uu___6 in + FStarC_Util.format3 "digraph {\nlabel=\"Effects ordering\"\nsubgraph cluster_lifts {\nlabel = \"Lifts\"\n\n %s\n}\nsubgraph cluster_polymonadic_binds {\nlabel = \"Polymonadic binds\"\n%s\n}\nsubgraph cluster_polymonadic_subcomps {\nlabel = \"Polymonadic subcomps\"\n%s\n}}\n" uu___3 uu___4 uu___5) let (update_effect_lattice : @@ -5664,8 +5625,8 @@ let (update_effect_lattice : mtarget = (e2.mtarget); mlift = composed_lift; mpath = - (FStarC_Compiler_List.op_At e1.mpath - (FStarC_Compiler_List.op_At [e1.mtarget] e2.mpath)) + (FStarC_List.op_At e1.mpath + (FStarC_List.op_At [e1.mtarget] e2.mpath)) } in let edge1 = { msource = src; mtarget = tgt; mlift = st_mlift; mpath = [] } in @@ -5683,18 +5644,18 @@ let (update_effect_lattice : if uu___1 then FStar_Pervasives_Native.Some (id_edge i) else - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun e -> (FStarC_Ident.lid_equals e.msource i) && (FStarC_Ident.lid_equals e.mtarget j)) order in let ms = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (e, uu___1) -> e.FStarC_Syntax_Syntax.mname) (env1.effects).decls in let all_i_src = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun edges -> fun i -> let uu___ = FStarC_Ident.lid_equals i edge1.msource in @@ -5707,7 +5668,7 @@ let (update_effect_lattice : | FStar_Pervasives_Native.Some e -> e :: edges | FStar_Pervasives_Native.None -> edges)) [] ms in let all_tgt_j = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun edges -> fun j -> let uu___ = FStarC_Ident.lid_equals edge1.mtarget j in @@ -5732,7 +5693,7 @@ let (update_effect_lattice : edge1.mtarget in let uu___4 = FStarC_Class_Show.show FStarC_Ident.showable_lident src1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Adding an edge %s~>%s induces a cycle %s" uu___2 uu___3 uu___4 in FStarC_Errors.raise_error hasRange_env env1 @@ -5741,24 +5702,24 @@ let (update_effect_lattice : (Obj.magic uu___1) else () in let new_i_edge_target = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun edges -> fun i_src -> check_cycle i_src.msource edge1.mtarget; (let uu___1 = compose_edges i_src edge1 in uu___1 :: edges)) [] all_i_src in let new_edge_source_j = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun edges -> fun tgt_j -> check_cycle edge1.msource tgt_j.mtarget; (let uu___1 = compose_edges edge1 tgt_j in uu___1 :: edges)) [] all_tgt_j in let new_i_j = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun edges -> fun i_src -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun edges1 -> fun tgt_j -> check_cycle i_src.msource tgt_j.mtarget; @@ -5767,26 +5728,25 @@ let (update_effect_lattice : compose_edges uu___2 tgt_j in uu___1 :: edges1)) edges all_tgt_j) [] all_i_src in let new_edges = edge1 :: - (FStarC_Compiler_List.op_At new_i_edge_target - (FStarC_Compiler_List.op_At new_edge_source_j new_i_j)) in - let order = - FStarC_Compiler_List.op_At new_edges (env1.effects).order in - FStarC_Compiler_List.iter + (FStarC_List.op_At new_i_edge_target + (FStarC_List.op_At new_edge_source_j new_i_j)) in + let order = FStarC_List.op_At new_edges (env1.effects).order in + FStarC_List.iter (fun edge2 -> let uu___1 = (FStarC_Ident.lid_equals edge2.msource FStarC_Parser_Const.effect_DIV_lid) && (let uu___2 = lookup_effect_quals env1 edge2.mtarget in - FStarC_Compiler_List.contains - FStarC_Syntax_Syntax.TotalEffect uu___2) in + FStarC_List.contains FStarC_Syntax_Syntax.TotalEffect + uu___2) in if uu___1 then let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident edge2.mtarget in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Divergent computations cannot be included in an effect %s marked 'total'" uu___3 in FStarC_Errors.raise_error hasRange_env env1 @@ -5795,7 +5755,7 @@ let (update_effect_lattice : (Obj.magic uu___2) else ()) order; (let joins = - let ubs = FStarC_Compiler_Util.smap_create (Prims.of_int (10)) in + let ubs = FStarC_Util.smap_create (Prims.of_int (10)) in let add_ub i j k ik jk = let key = let uu___1 = FStarC_Ident.string_of_lid i in @@ -5804,21 +5764,21 @@ let (update_effect_lattice : Prims.strcat ":" uu___3 in Prims.strcat uu___1 uu___2 in let v = - let uu___1 = FStarC_Compiler_Util.smap_try_find ubs key in + let uu___1 = FStarC_Util.smap_try_find ubs key in match uu___1 with | FStar_Pervasives_Native.Some ubs1 -> (i, j, k, ik, jk) :: ubs1 | FStar_Pervasives_Native.None -> [(i, j, k, ik, jk)] in - FStarC_Compiler_Util.smap_add ubs key v in - FStarC_Compiler_List.iter + FStarC_Util.smap_add ubs key v in + FStarC_List.iter (fun i -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun j -> let uu___2 = FStarC_Ident.lid_equals i j in if uu___2 then () else - FStarC_Compiler_List.iter + FStarC_List.iter (fun k -> let uu___4 = let uu___5 = find_edge order (i, k) in @@ -5829,28 +5789,27 @@ let (update_effect_lattice : FStar_Pervasives_Native.Some jk) -> add_ub i j k ik.mlift jk.mlift | uu___5 -> ()) ms) ms) ms; - FStarC_Compiler_Util.smap_fold ubs + FStarC_Util.smap_fold ubs (fun s -> fun l -> fun joins1 -> let lubs = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | (i, j, k, ik, jk) -> - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___3 -> match uu___3 with | (uu___4, uu___5, k', uu___6, uu___7) -> let uu___8 = find_edge order (k, k') in - FStarC_Compiler_Util.is_some uu___8) - l) l in - if (FStarC_Compiler_List.length lubs) <> Prims.int_one + FStarC_Util.is_some uu___8) l) l in + if (FStarC_List.length lubs) <> Prims.int_one then let uu___2 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effects %s have incomparable upper bounds" s in FStarC_Errors.raise_error hasRange_env env1 FStarC_Errors_Codes.Fatal_Effects_Ordering_Coherence @@ -5858,7 +5817,7 @@ let (update_effect_lattice : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2) - else FStarC_Compiler_List.op_At lubs joins1) [] in + else FStarC_List.op_At lubs joins1) [] in let effects1 = let uu___1 = env1.effects in { @@ -6138,8 +6097,7 @@ let (push_bv : env -> FStarC_Syntax_Syntax.bv -> env) = let (push_bvs : env -> FStarC_Syntax_Syntax.bv Prims.list -> env) = fun env1 -> fun bvs -> - FStarC_Compiler_List.fold_left (fun env2 -> fun bv -> push_bv env2 bv) - env1 bvs + FStarC_List.fold_left (fun env2 -> fun bv -> push_bv env2 bv) env1 bvs let (pop_bv : env -> (FStarC_Syntax_Syntax.bv * env) FStar_Pervasives_Native.option) = fun env1 -> @@ -6206,7 +6164,7 @@ let (pop_bv : let (push_binders : env -> FStarC_Syntax_Syntax.binders -> env) = fun env1 -> fun bs -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun b -> push_bv env2 b.FStarC_Syntax_Syntax.binder_bv) env1 bs let (binding_of_lb : @@ -6236,7 +6194,7 @@ let (push_let_binding : let (push_univ_vars : env -> FStarC_Syntax_Syntax.univ_names -> env) = fun env1 -> fun xs -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun x -> push_local_binding env2 (FStarC_Syntax_Syntax.Binding_univ x)) @@ -6256,8 +6214,7 @@ let (open_universes_in : | (univ_subst, univ_vars) -> let env' = push_univ_vars env1 univ_vars in let uu___1 = - FStarC_Compiler_List.map (FStarC_Syntax_Subst.subst univ_subst) - terms in + FStarC_List.map (FStarC_Syntax_Subst.subst univ_subst) terms in (env', univ_vars, uu___1) let (set_expected_typ : env -> FStarC_Syntax_Syntax.typ -> env) = fun env1 -> @@ -6514,7 +6471,7 @@ let (uvars_in_env : env -> FStarC_Syntax_Syntax.uvars) = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) ()) in let rec aux out g = match g with @@ -6526,7 +6483,7 @@ let (uvars_in_env : env -> FStarC_Syntax_Syntax.uvars) = Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic out) (Obj.magic uu___3)) in aux uu___2 tl @@ -6540,19 +6497,19 @@ let (uvars_in_env : env -> FStarC_Syntax_Syntax.uvars) = Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic out) (Obj.magic uu___3)) in aux uu___2 tl in aux no_uvs env1.gamma -let (univ_vars : - env -> FStarC_Syntax_Syntax.universe_uvar FStarC_Compiler_FlatSet.t) = +let (univ_vars : env -> FStarC_Syntax_Syntax.universe_uvar FStarC_FlatSet.t) + = fun env1 -> let no_univs = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) ()) in let rec aux out g = match g with @@ -6564,7 +6521,7 @@ let (univ_vars : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic out) (Obj.magic uu___3)) in aux uu___2 tl @@ -6578,20 +6535,19 @@ let (univ_vars : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic out) (Obj.magic uu___3)) in aux uu___2 tl in aux no_univs env1.gamma -let (univnames : - env -> FStarC_Syntax_Syntax.univ_name FStarC_Compiler_FlatSet.t) = +let (univnames : env -> FStarC_Syntax_Syntax.univ_name FStarC_FlatSet.t) = fun env1 -> let no_univ_names = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_ident)) ()) in + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) + ()) in let rec aux out g = match g with | [] -> out @@ -6600,7 +6556,7 @@ let (univnames : Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) uname (Obj.magic out)) in aux uu___ tl | (FStarC_Syntax_Syntax.Binding_lid (uu___, (uu___1, t)))::tl -> @@ -6609,7 +6565,7 @@ let (univnames : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic out) (Obj.magic uu___3)) in aux uu___2 tl @@ -6623,21 +6579,20 @@ let (univnames : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic out) (Obj.magic uu___3)) in aux uu___2 tl in aux no_univ_names env1.gamma let (lidents : env -> FStarC_Ident.lident Prims.list) = fun env1 -> - let keys = - FStarC_Compiler_List.collect FStar_Pervasives_Native.fst env1.gamma_sig in - FStarC_Compiler_Util.smap_fold (sigtab env1) + let keys = FStarC_List.collect FStar_Pervasives_Native.fst env1.gamma_sig in + FStarC_Util.smap_fold (sigtab env1) (fun uu___ -> fun v -> fun keys1 -> - FStarC_Compiler_List.op_At (FStarC_Syntax_Util.lids_of_sigelt v) - keys1) keys + let uu___1 = FStarC_Syntax_Util.lids_of_sigelt v in + FStarC_List.op_At uu___1 keys1) keys let (should_enc_path : (Prims.string Prims.list * Prims.bool) Prims.list -> Prims.string Prims.list -> Prims.bool) @@ -6648,12 +6603,11 @@ let (should_enc_path : match (xs, ys) with | ([], uu___) -> true | (x::xs1, y::ys1) -> - ((FStarC_Compiler_String.lowercase x) = - (FStarC_Compiler_String.lowercase y)) - && (str_i_prefix xs1 ys1) + ((FStarC_String.lowercase x) = (FStarC_String.lowercase y)) && + (str_i_prefix xs1 ys1) | (uu___, uu___1) -> false in let uu___ = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___1 -> match uu___1 with | (p, uu___2) -> str_i_prefix p path) proof_ns in match uu___ with @@ -6788,14 +6742,13 @@ let (set_proof_ns : proof_namespace -> env -> env) = } let (unbound_vars : env -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.t) = fun e -> fun t -> let uu___ = FStarC_Syntax_Free.names t in let uu___1 = bound_vars e in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun uu___2 -> (fun s -> @@ -6803,7 +6756,7 @@ let (unbound_vars : Obj.magic (FStarC_Class_Setlike.remove () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) bv (Obj.magic s))) uu___3 uu___2) uu___ uu___1 let (closed : env -> FStarC_Syntax_Syntax.term -> Prims.bool) = @@ -6812,15 +6765,15 @@ let (closed : env -> FStarC_Syntax_Syntax.term -> Prims.bool) = let uu___ = unbound_vars e t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) + (Obj.magic uu___) let (closed' : FStarC_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = FStarC_Syntax_Free.names t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) + (Obj.magic uu___) let (string_of_proof_ns : env -> Prims.string) = fun env1 -> let aux uu___ = @@ -6832,9 +6785,9 @@ let (string_of_proof_ns : env -> Prims.string) = (let uu___2 = FStarC_Ident.text_of_path p in Prims.strcat (if b then "+" else "-") uu___2) in let uu___ = - let uu___1 = FStarC_Compiler_List.map aux env1.proof_ns in - FStarC_Compiler_List.rev uu___1 in - FStarC_Compiler_String.concat " " uu___ + let uu___1 = FStarC_List.map aux env1.proof_ns in + FStarC_List.rev uu___1 in + FStarC_String.concat " " uu___ let (guard_of_guard_formula : FStarC_TypeChecker_Common.guard_formula -> guard_t) = fun g -> @@ -6843,22 +6796,22 @@ let (guard_of_guard_formula : FStarC_TypeChecker_Common.deferred_to_tac = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); FStarC_TypeChecker_Common.deferred = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); FStarC_TypeChecker_Common.univ_ineqs = ((Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))), + (Obj.magic (FStarC_CList.listlike_clist ())))), (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ()))))); + (Obj.magic (FStarC_CList.listlike_clist ()))))); FStarC_TypeChecker_Common.implicits = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))) + (Obj.magic (FStarC_CList.listlike_clist ())))) } let (guard_form : guard_t -> FStarC_TypeChecker_Common.guard_formula) = fun g -> g.FStarC_TypeChecker_Common.guard_f @@ -6868,22 +6821,19 @@ let (is_trivial : guard_t -> Prims.bool) = (((FStarC_TypeChecker_Common.uu___is_Trivial g.FStarC_TypeChecker_Common.guard_f) && - (FStarC_Class_Listlike.is_empty - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_Class_Listlike.is_empty (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.deferred)) && - (FStarC_Class_Listlike.is_empty - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_Class_Listlike.is_empty (FStarC_CList.listlike_clist ()) (FStar_Pervasives_Native.fst g.FStarC_TypeChecker_Common.univ_ineqs))) && - (FStarC_Class_Listlike.is_empty - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_Class_Listlike.is_empty (FStarC_CList.listlike_clist ()) (FStar_Pervasives_Native.snd g.FStarC_TypeChecker_Common.univ_ineqs)) in if uu___ then - FStarC_Compiler_CList.for_all + FStarC_CList.for_all (fun imp -> (let uu___1 = FStarC_Syntax_Util.ctx_uvar_should_check @@ -6916,9 +6866,11 @@ let (abstract_guard_n : | FStarC_TypeChecker_Common.Trivial -> g | FStarC_TypeChecker_Common.NonTrivial f -> let f' = - FStarC_Syntax_Util.abs bs f - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot FStarC_Syntax_Util.ktype0)) in + let uu___ = + let uu___1 = + FStarC_Syntax_Util.residual_tot FStarC_Syntax_Util.ktype0 in + FStar_Pervasives_Native.Some uu___1 in + FStarC_Syntax_Util.abs bs f uu___ in { FStarC_TypeChecker_Common.guard_f = (FStarC_TypeChecker_Common.NonTrivial f'); @@ -7050,7 +7002,7 @@ let (close_guard_univs : | FStarC_TypeChecker_Common.Trivial -> g | FStarC_TypeChecker_Common.NonTrivial f -> let f1 = - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun u -> fun b -> fun f2 -> @@ -7090,11 +7042,11 @@ let (close_forall : FStarC_Syntax_Print.pretty_term f.FStarC_Syntax_Syntax.pos "close_forall" env1 uu___2); (let bvs = - FStarC_Compiler_List.map - (fun b -> b.FStarC_Syntax_Syntax.binder_bv) bs in + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) + bs in let env_full = push_bvs env1 bvs in let uu___2 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun bv -> fun uu___3 -> match uu___3 with @@ -7102,12 +7054,12 @@ let (close_forall : let e' = let uu___4 = let uu___5 = pop_bv e in - FStarC_Compiler_Util.must uu___5 in + FStarC_Util.must uu___5 in FStar_Pervasives_Native.snd uu___4 in (FStarC_Defensive.def_check_scoped hasBinders_env FStarC_Class_Binders.hasNames_term FStarC_Syntax_Print.pretty_term - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange "close_forall.sort" e' bv.FStarC_Syntax_Syntax.sort; (let f' = @@ -7146,7 +7098,7 @@ let (close_guard : env -> FStarC_Syntax_Syntax.binders -> guard_t -> guard_t) } let (new_tac_implicit_var : Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> env -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.should_check_uvar -> @@ -7155,7 +7107,7 @@ let (new_tac_implicit_var : FStar_Pervasives_Native.option -> Prims.bool -> (FStarC_Syntax_Syntax.term * (FStarC_Syntax_Syntax.ctx_uvar - * FStarC_Compiler_Range_Type.range) * guard_t)) + * FStarC_Range_Type.range) * guard_t)) = fun reason -> fun r -> @@ -7201,27 +7153,23 @@ let (new_tac_implicit_var : FStarC_TypeChecker_Common.imp_tm = t; FStarC_TypeChecker_Common.imp_range = r } in - (let uu___2 = - FStarC_Compiler_Effect.op_Bang dbg_ImplicitTrace in + (let uu___2 = FStarC_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_uvar ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_head in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Just created uvar for implicit {%s}\n" uu___3 else ()); (let g = let uu___2 = Obj.magic (FStarC_Class_Listlike.cons () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ())) - imp + (Obj.magic (FStarC_CList.listlike_clist ())) imp (FStarC_Class_Listlike.empty () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ())))) in + (Obj.magic (FStarC_CList.listlike_clist ())))) in { FStarC_TypeChecker_Common.guard_f = (trivial_guard.FStarC_TypeChecker_Common.guard_f); @@ -7236,7 +7184,7 @@ let (new_tac_implicit_var : (t, (ctx_uvar, r), g))) let (new_implicit_var_aux : Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> env -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.should_check_uvar -> @@ -7244,7 +7192,7 @@ let (new_implicit_var_aux : FStar_Pervasives_Native.option -> Prims.bool -> (FStarC_Syntax_Syntax.term * (FStarC_Syntax_Syntax.ctx_uvar * - FStarC_Compiler_Range_Type.range) * guard_t)) + FStarC_Range_Type.range) * guard_t)) = fun reason -> fun r -> @@ -7291,7 +7239,7 @@ let (uvar_meta_for_binder : -> FStar_Pervasives_Native.Some a | uu___3 -> FStar_Pervasives_Native.None) in let uu___1 = - FStarC_Compiler_List.tryPick is_unification_tag + FStarC_List.tryPick is_unification_tag b.FStarC_Syntax_Syntax.binder_attrs in (match uu___1 with | FStar_Pervasives_Native.Some tag -> @@ -7304,7 +7252,7 @@ let (uvars_for_binders : FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.subst_t -> (FStarC_Syntax_Syntax.binder -> Prims.string) -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.term Prims.list * guard_t)) = fun env1 -> @@ -7313,7 +7261,7 @@ let (uvars_for_binders : fun reason -> fun r -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -7340,7 +7288,7 @@ let (uvars_for_binders : (match uu___3 with | (t, l_ctx_uvars, g_t) -> ((let uu___5 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsEqns in if uu___5 then @@ -7348,18 +7296,17 @@ let (uvars_for_binders : FStarC_Class_Show.show (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_ctxu - FStarC_Compiler_Range_Ops.showable_range) + FStarC_Range_Ops.showable_range) l_ctx_uvars in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Layered Effect uvar: %s\n" uu___6 else ()); (let uu___5 = conj_guards [g; g_t] in - ((FStarC_Compiler_List.op_At substs1 + ((FStarC_List.op_At substs1 [FStarC_Syntax_Syntax.NT ((b.FStarC_Syntax_Syntax.binder_bv), t)]), - (FStarC_Compiler_List.op_At uvars [t]), - uu___5)))))) + (FStarC_List.op_At uvars [t]), uu___5)))))) (substs, [], trivial_guard) bs in match uu___ with | (uu___1, uvars, g) -> (uvars, g) let (pure_precondition_for_trivial_post : @@ -7367,7 +7314,7 @@ let (pure_precondition_for_trivial_post : FStarC_Syntax_Syntax.universe -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.typ) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.typ) = fun env1 -> fun u -> @@ -7379,7 +7326,7 @@ let (pure_precondition_for_trivial_post : let uu___ = lookup_definition [NoDelta] env1 FStarC_Parser_Const.trivial_pure_post_lid in - FStarC_Compiler_Util.must uu___ in + FStarC_Util.must uu___ in let uu___ = inst_tscheme_with post_ts [u] in match uu___ with | (uu___1, post) -> @@ -7402,7 +7349,7 @@ let (get_letrec_arity : | (FStar_Pervasives.Inr v1, FStar_Pervasives.Inr v2) -> f2 v1 v2 | uu___ -> false in let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | (lbname', uu___2, uu___3, uu___4) -> diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Err.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Err.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Err.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Err.ml index 1cfb4464221..25f94ae9095 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Err.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Err.ml @@ -5,7 +5,7 @@ let (info_at_pos : Prims.int -> Prims.int -> ((Prims.string, FStarC_Ident.lident) FStar_Pervasives.either * - FStarC_Syntax_Syntax.typ * FStarC_Compiler_Range_Type.range) + FStarC_Syntax_Syntax.typ * FStarC_Range_Type.range) FStar_Pervasives_Native.option) = fun env -> @@ -14,7 +14,7 @@ let (info_at_pos : fun col -> let uu___ = let uu___1 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang env.FStarC_TypeChecker_Env.identifier_info in FStarC_TypeChecker_Common.id_info_at_pos uu___1 file row col in match uu___ with @@ -58,7 +58,7 @@ let print_discrepancy : 'a 'b . ('a -> 'b) -> 'a -> 'a -> ('b * 'b) = | (false)::t -> true :: t | (true)::t -> let uu___ = succ t in false :: uu___ | [] -> failwith "" in - let full l = FStarC_Compiler_List.for_all (fun b1 -> b1) l in + let full l = FStarC_List.for_all (fun b1 -> b1) l in let get_bool_option s = let uu___ = FStarC_Options.get_option s in match uu___ with @@ -104,26 +104,25 @@ let (errors_smt_detail : fun errs -> fun smt_detail -> let errs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (e, msg, r, ctx) -> let uu___1 = - let msg1 = FStarC_Compiler_List.op_At msg smt_detail in - if r = FStarC_Compiler_Range_Type.dummyRange + let msg1 = FStar_List_Tot_Base.append msg smt_detail in + if r = FStarC_Range_Type.dummyRange then let uu___2 = FStarC_TypeChecker_Env.get_range env in (e, msg1, uu___2, ctx) else (let r' = - let uu___3 = FStarC_Compiler_Range_Type.use_range r in - FStarC_Compiler_Range_Type.set_def_range r uu___3 in + let uu___3 = FStarC_Range_Type.use_range r in + FStarC_Range_Type.set_def_range r uu___3 in let uu___3 = - let uu___4 = - FStarC_Compiler_Range_Ops.file_of_range r' in + let uu___4 = FStarC_Range_Ops.file_of_range r' in let uu___5 = let uu___6 = FStarC_TypeChecker_Env.get_range env in - FStarC_Compiler_Range_Ops.file_of_range uu___6 in + FStarC_Range_Ops.file_of_range uu___6 in uu___4 <> uu___5 in if uu___3 then @@ -132,23 +131,22 @@ let (errors_smt_detail : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_Range_Ops.string_of_use_range - r in + FStarC_Range_Ops.string_of_use_range r in Prims.strcat "Also see: " uu___7 in FStarC_Pprint.doc_of_string uu___6 in let uu___6 = let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Range_Type.use_range r in + FStarC_Range_Type.use_range r in let uu___10 = - FStarC_Compiler_Range_Type.def_range r in + FStarC_Range_Type.def_range r in uu___9 <> uu___10 in if uu___8 then let uu___9 = let uu___10 = - FStarC_Compiler_Range_Ops.string_of_def_range + FStarC_Range_Ops.string_of_def_range r in Prims.strcat "Other related locations: " uu___10 in @@ -156,7 +154,7 @@ let (errors_smt_detail : else FStarC_Pprint.empty in [uu___7] in uu___5 :: uu___6 in - FStarC_Compiler_List.op_At msg1 uu___4 in + FStar_List_Tot_Base.append msg1 uu___4 in let uu___4 = FStarC_TypeChecker_Env.get_range env in (e, msg2, uu___4, ctx) else (e, msg1, r, ctx)) in @@ -171,7 +169,7 @@ let (add_errors : FStarC_Errors.add_errors uu___ let (log_issue : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Errors_Codes.error_code * FStarC_Errors_Msg.error_message) -> unit) = @@ -187,7 +185,7 @@ let (log_issue : add_errors env uu___1 let (log_issue_text : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Errors_Codes.error_code * Prims.string) -> unit) = fun env -> @@ -252,7 +250,7 @@ let (ill_kinded_type : FStarC_Errors_Msg.error_message) = let unexpected_signature_for_monad : 'a . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Ident.lident -> FStarC_Syntax_Syntax.term -> 'a = fun env -> @@ -263,7 +261,7 @@ let unexpected_signature_for_monad : let uu___1 = FStarC_Class_Show.show FStarC_Ident.showable_lident m in let uu___2 = FStarC_TypeChecker_Normalize.term_to_string env k in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unexpected signature for monad \"%s\". Expected a signature of the form (a:Type -> WP a -> Effect); got %s" uu___1 uu___2 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range rng @@ -273,7 +271,7 @@ let unexpected_signature_for_monad : let expected_a_term_of_type_t_got_a_function : 'uuuuu . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.string -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.term -> 'uuuuu = @@ -286,7 +284,7 @@ let expected_a_term_of_type_t_got_a_function : let uu___1 = FStarC_TypeChecker_Normalize.term_to_string env t in let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Expected a term of type \"%s\"; got a function \"%s\" (%s)" uu___1 uu___2 msg in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range @@ -300,7 +298,7 @@ let (unexpected_implicit_argument : let expected_expression_of_type : 'a . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> 'a = @@ -352,13 +350,13 @@ let (expected_pattern_of_type : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Expected pattern of type \"%s\"; got pattern \"%s\" of type \"%s\"" s1 uu___2 s2 in (FStarC_Errors_Codes.Fatal_UnexpectedPattern, uu___1) let (basic_type_error : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> unit) = @@ -419,7 +417,7 @@ let (basic_type_error : let raise_basic_type_error : 'a . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term -> 'a = @@ -494,7 +492,7 @@ let constructor_fails_the_positivity_check : let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term d in let uu___2 = FStarC_Class_Show.show FStarC_Ident.showable_lident l in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Constructor \"%s\" fails the strict positivity check; the constructed type \"%s\" occurs to the left of a pure function type" uu___1 uu___2 in (FStarC_Errors_Codes.Fatal_ConstructorFailedCheck, uu___) @@ -503,7 +501,7 @@ let (inline_type_annotation_and_val_decl : fun l -> let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Ident.showable_lident l in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "\"%s\" has a val declaration as well as an inlined type annotation; remove one" uu___1 in (FStarC_Errors_Codes.Fatal_DuplicateTypeAnnotationAndValDecl, uu___) @@ -520,14 +518,14 @@ let (inferred_type_causes_variable_to_escape : let uu___1 = FStarC_TypeChecker_Normalize.term_to_string env t in let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Inferred type \"%s\" causes variable \"%s\" to escape its scope" uu___1 uu___2 in (FStarC_Errors_Codes.Fatal_InferredTypeCauseVarEscape, uu___) let expected_function_typ : 'a . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.term -> 'a + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> 'a = fun env -> fun rng -> @@ -563,7 +561,7 @@ let (expected_poly_typ : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f in let uu___2 = FStarC_TypeChecker_Normalize.term_to_string env t in let uu___3 = FStarC_TypeChecker_Normalize.term_to_string env targ in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Expected a polymorphic function; got an expression \"%s\" of type \"%s\" applied to a type \"%s\"" uu___1 uu___2 uu___3 in (FStarC_Errors_Codes.Fatal_PolyTypeExpected, uu___) @@ -576,13 +574,13 @@ let (disjunctive_pattern_vars : fun v2 -> let vars v = let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv) v in - FStarC_Compiler_String.concat ", " uu___ in + FStarC_String.concat ", " uu___ in let uu___ = let uu___1 = vars v1 in let uu___2 = vars v2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Every alternative of an 'or' pattern must bind the same variables; here one branch binds (\"%s\") and another (\"%s\")" uu___1 uu___2 in (FStarC_Errors_Codes.Fatal_DisjuctivePatternVarsMismatch, uu___) @@ -602,7 +600,7 @@ let (name_and_result : let computed_computation_type_does_not_match_annotation : 'uuuuu 'a . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> 'uuuuu -> FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> 'a @@ -660,7 +658,7 @@ let computed_computation_type_does_not_match_annotation : let computed_computation_type_does_not_match_annotation_eq : 'uuuuu 'a . FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> 'uuuuu -> FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.comp -> 'a = @@ -699,7 +697,7 @@ let unexpected_non_trivial_precondition_on_term : fun f -> let uu___ = let uu___1 = FStarC_TypeChecker_Normalize.term_to_string env f in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Term has an unexpected non-trivial pre-condition: %s" uu___1 in FStarC_Errors.raise_error FStarC_TypeChecker_Env.hasRange_env env FStarC_Errors_Codes.Fatal_UnExpectedPreCondition () @@ -708,7 +706,7 @@ let unexpected_non_trivial_precondition_on_term : let __expected_eff_expression : 'uuuuu . Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.comp -> Prims.string FStar_Pervasives_Native.option -> 'uuuuu @@ -766,7 +764,7 @@ let __expected_eff_expression : (Obj.magic uu___) let expected_pure_expression : 'uuuuu . - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.comp -> Prims.string FStar_Pervasives_Native.option -> 'uuuuu @@ -776,7 +774,7 @@ let expected_pure_expression : fun c -> fun reason -> __expected_eff_expression "pure" rng e c reason let expected_ghost_expression : 'uuuuu . - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.comp -> Prims.string FStar_Pervasives_Native.option -> 'uuuuu @@ -793,7 +791,7 @@ let (expected_effect_1_got_effect_2 : let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Ident.showable_lident c1 in let uu___2 = FStarC_Class_Show.show FStarC_Ident.showable_lident c2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Expected a computation with effect %s; but it has effect %s" uu___1 uu___2 in (FStarC_Errors_Codes.Fatal_UnexpectedEffect, uu___) @@ -809,11 +807,11 @@ let (failed_to_prove_specification_of : FStarC_Class_Show.show (FStarC_Class_Show.show_either FStarC_Syntax_Print.showable_bv FStarC_Syntax_Print.showable_fv) l in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Failed to prove specification of %s; assertions at [%s] may fail" - uu___1 (FStarC_Compiler_String.concat ", " lbls) in + uu___1 (FStarC_String.concat ", " lbls) in (FStarC_Errors_Codes.Error_TypeCheckerFailToProve, uu___) -let (warn_top_level_effect : FStarC_Compiler_Range_Type.range -> unit) = +let (warn_top_level_effect : FStarC_Range_Type.range -> unit) = fun rng -> FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range rng FStarC_Errors_Codes.Warning_TopLevelEffect () diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Generalize.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Generalize.ml similarity index 86% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Generalize.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Generalize.ml index 56d0cd6a18b..e9027441835 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Generalize.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Generalize.ml @@ -1,6 +1,5 @@ open Prims -let (dbg_Gen : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Gen" +let (dbg_Gen : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Gen" let (showable_univ_var : FStarC_Syntax_Syntax.universe_uvar FStarC_Class_Show.showable) = { @@ -11,7 +10,7 @@ let (showable_univ_var : } let (gen_univs : FStarC_TypeChecker_Env.env -> - FStarC_Syntax_Syntax.universe_uvar FStarC_Compiler_FlatSet.t -> + FStarC_Syntax_Syntax.universe_uvar FStarC_FlatSet.t -> FStarC_Syntax_Syntax.univ_name Prims.list) = fun env -> @@ -19,7 +18,7 @@ let (gen_univs : let uu___ = FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic x) in if uu___ then [] @@ -30,36 +29,36 @@ let (gen_univs : Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic x) (Obj.magic uu___3)) in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___2) in - (let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Gen in + (let uu___3 = FStarC_Effect.op_Bang dbg_Gen in if uu___3 then let uu___4 = let uu___5 = FStarC_TypeChecker_Env.univ_vars env in FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set - FStarC_Syntax_Free.ord_univ_uvar showable_univ_var) uu___5 in - FStarC_Compiler_Util.print1 "univ_vars in env: %s\n" uu___4 + (FStarC_FlatSet.showable_set FStarC_Syntax_Free.ord_univ_uvar + showable_univ_var) uu___5 in + FStarC_Util.print1 "univ_vars in env: %s\n" uu___4 else ()); (let r = let uu___3 = FStarC_TypeChecker_Env.get_range env in FStar_Pervasives_Native.Some uu___3 in let u_names = - FStarC_Compiler_List.map + FStarC_List.map (fun u -> let u_name = FStarC_Syntax_Syntax.new_univ_name r in - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Gen in + (let uu___4 = FStarC_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = let uu___6 = FStarC_Syntax_Unionfind.univ_uvar_id u in - FStarC_Compiler_Util.string_of_int uu___6 in + FStarC_Util.string_of_int uu___6 in let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ @@ -68,8 +67,8 @@ let (gen_univs : FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ (FStarC_Syntax_Syntax.U_name u_name) in - FStarC_Compiler_Util.print3 "Setting ?%s (%s) to %s\n" - uu___5 uu___6 uu___7 + FStarC_Util.print3 "Setting ?%s (%s) to %s\n" uu___5 + uu___6 uu___7 else ()); FStarC_Syntax_Unionfind.univ_change u (FStarC_Syntax_Syntax.U_name u_name); @@ -78,7 +77,7 @@ let (gen_univs : let (gather_free_univnames : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.univ_name FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.univ_name FStarC_FlatSet.t) = fun env -> fun t -> @@ -88,7 +87,7 @@ let (gather_free_univnames : Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic tm_univnames) (Obj.magic ctx_univnames)) in univnames @@ -132,9 +131,9 @@ let (generalize_universes : let uu___1 = gather_free_univnames env t in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic uu___1) in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Gen in + (let uu___2 = FStarC_Effect.op_Bang dbg_Gen in if uu___2 then let uu___3 = @@ -143,23 +142,23 @@ let (generalize_universes : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Ident.showable_ident) univnames in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "generalizing universes in the term (post norm): %s with univnames: %s\n" uu___3 uu___4 else ()); (let univs = FStarC_Syntax_Free.univs t in - (let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Gen in + (let uu___3 = FStarC_Effect.op_Bang dbg_Gen in if uu___3 then let uu___4 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set + (FStarC_FlatSet.showable_set FStarC_Syntax_Free.ord_univ_uvar showable_univ_var) univs in - FStarC_Compiler_Util.print1 "univs to gen : %s\n" uu___4 + FStarC_Util.print1 "univs to gen : %s\n" uu___4 else ()); (let gen = gen_univs env univs in - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Gen in + (let uu___4 = FStarC_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = @@ -168,7 +167,7 @@ let (generalize_universes : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Ident.showable_ident) gen in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "After generalization, t: %s and univs: %s\n" uu___5 uu___6 else ()); (let univs1 = check_universe_generalization univnames gen t0 in @@ -191,7 +190,7 @@ let (gen : fun lecs -> let uu___ = let uu___1 = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun uu___2 -> match uu___2 with | (uu___3, uu___4, c) -> @@ -201,12 +200,12 @@ let (gen : then FStar_Pervasives_Native.None else (let norm c = - (let uu___3 = FStarC_Compiler_Debug.medium () in + (let uu___3 = FStarC_Debug.medium () in if uu___3 then let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Normalizing before generalizing:\n\t %s\n" uu___4 else ()); (let c1 = @@ -215,13 +214,13 @@ let (gen : FStarC_TypeChecker_Env.Exclude FStarC_TypeChecker_Env.Zeta; FStarC_TypeChecker_Env.NoFullNorm; FStarC_TypeChecker_Env.DoNotUnfoldPureLets] env c in - (let uu___4 = FStarC_Compiler_Debug.medium () in + (let uu___4 = FStarC_Debug.medium () in if uu___4 then let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c1 in - FStarC_Compiler_Util.print1 "Normalized to:\n\t %s\n" uu___5 + FStarC_Util.print1 "Normalized to:\n\t %s\n" uu___5 else ()); c1) in let env_uvars = FStarC_TypeChecker_Env.uvars_in_env env in @@ -230,12 +229,12 @@ let (gen : Obj.magic (FStarC_Class_Setlike.diff () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs) (Obj.magic env_uvars)) in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___2) in let univs_and_uvars_of_lec uu___2 = match uu___2 with @@ -244,20 +243,20 @@ let (gen : let t = FStarC_Syntax_Util.comp_result c1 in let univs = FStarC_Syntax_Free.univs t in let uvt = FStarC_Syntax_Free.uvars t in - ((let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Gen in + ((let uu___4 = FStarC_Effect.op_Bang dbg_Gen in if uu___4 then let uu___5 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set + (FStarC_FlatSet.showable_set FStarC_Syntax_Free.ord_univ_uvar showable_univ_var) univs in let uu___6 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set + (FStarC_FlatSet.showable_set FStarC_Syntax_Free.ord_ctx_uvar FStarC_Syntax_Print.showable_ctxu) uvt in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "^^^^\n\tFree univs = %s\n\tFree uvt=%s\n" uu___5 uu___6 else ()); @@ -265,10 +264,10 @@ let (gen : let uu___4 = FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvt) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___6 -> fun uu___5 -> (fun univs2 -> @@ -280,30 +279,30 @@ let (gen : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic univs2) (Obj.magic uu___5))) uu___6 uu___5) univs uu___4 in let uvs = gen_uvars uvt in - (let uu___5 = FStarC_Compiler_Effect.op_Bang dbg_Gen in + (let uu___5 = FStarC_Effect.op_Bang dbg_Gen in if uu___5 then let uu___6 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set + (FStarC_FlatSet.showable_set FStarC_Syntax_Free.ord_univ_uvar showable_univ_var) univs1 in let uu___7 = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_ctxu) uvs in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "^^^^\n\tFree univs = %s\n\tgen_uvars = %s\n" uu___6 uu___7 else ()); (univs1, uvs, (lbname, e, c1)))) in let uu___2 = - let uu___3 = FStarC_Compiler_List.hd lecs in + let uu___3 = FStarC_List.hd lecs in univs_and_uvars_of_lec uu___3 in match uu___2 with | (univs, uvs, lec_hd) -> @@ -311,7 +310,7 @@ let (gen : let uu___3 = FStarC_Class_Setlike.equal () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic u1) (Obj.magic u2) in if uu___3 @@ -334,7 +333,7 @@ let (gen : (FStarC_Class_Show.show_either FStarC_Syntax_Print.showable_bv FStarC_Syntax_Print.showable_fv) lb2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Generalizing the types of these mutually recursive definitions requires an incompatible set of universes for %s and %s" uu___11 uu___12 in FStarC_Errors.raise_error @@ -346,9 +345,9 @@ let (gen : (Obj.magic msg))) in let force_uvars_eq lec2 u1 u2 = let uvars_subseteq u11 u21 = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun u -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun u' -> FStarC_Syntax_Unionfind.equiv u.FStarC_Syntax_Syntax.ctx_uvar_head @@ -376,7 +375,7 @@ let (gen : (FStarC_Class_Show.show_either FStarC_Syntax_Print.showable_bv FStarC_Syntax_Print.showable_fv) lb2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Generalizing the types of these mutually recursive definitions requires an incompatible number of types for %s and %s" uu___11 uu___12 in FStarC_Errors.raise_error @@ -387,8 +386,8 @@ let (gen : FStarC_Errors_Msg.is_error_message_string) (Obj.magic msg))) in let lecs1 = - let uu___3 = FStarC_Compiler_List.tl lecs in - FStarC_Compiler_List.fold_right + let uu___3 = FStarC_List.tl lecs in + FStarC_List.fold_right (fun this_lec -> fun lecs2 -> let uu___4 = univs_and_uvars_of_lec this_lec in @@ -401,7 +400,7 @@ let (gen : lecs2)) uu___3 [] in let lecs2 = lec_hd :: lecs1 in let gen_types uvs1 = - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun u -> if FStar_Pervasives_Native.uu___is_Some @@ -440,7 +439,7 @@ let (gen : let uu___10 = FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic free) in Prims.op_Negation uu___10 in @@ -465,11 +464,14 @@ let (gen : let uu___12 = FStarC_Syntax_Syntax.bv_to_name a in + let uu___13 = + let uu___14 = + FStarC_Syntax_Util.residual_tot + kres in + FStar_Pervasives_Native.Some + uu___14 in FStarC_Syntax_Util.abs bs - uu___12 - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot - kres)) in + uu___12 uu___13 in FStarC_Syntax_Util.set_uvar u.FStarC_Syntax_Syntax.ctx_uvar_head t; @@ -483,7 +485,7 @@ let (gen : let gen_univs1 = gen_univs env univs in let gen_tvars = gen_types uvs in let ecs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (lbname, e, c) -> @@ -509,7 +511,7 @@ let (gen : if is_rec then let tvar_args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (x, uu___8) -> @@ -522,8 +524,7 @@ let (gen : fv = let uu___7 = let uu___8 = - FStarC_Compiler_Util.right - lbname in + FStarC_Util.right lbname in FStarC_Syntax_Syntax.fv_eq fv uu___8 in if uu___7 @@ -536,7 +537,7 @@ let (gen : instantiate_lbname_with_app e1 else e1 in let tvars_bs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (x, q) -> @@ -547,9 +548,11 @@ let (gen : let t = let uu___7 = let uu___8 = + let uu___9 = + FStarC_Syntax_Util.comp_result + c1 in FStarC_Syntax_Subst.compress - (FStarC_Syntax_Util.comp_result - c1) in + uu___9 in uu___8.FStarC_Syntax_Syntax.n in match uu___7 with | FStarC_Syntax_Syntax.Tm_arrow @@ -562,8 +565,8 @@ let (gen : (match uu___8 with | (bs1, cod1) -> FStarC_Syntax_Util.arrow - (FStarC_Compiler_List.op_At - tvars_bs bs1) cod1) + (FStarC_List.op_At tvars_bs + bs1) cod1) | uu___8 -> FStarC_Syntax_Util.arrow tvars_bs c1 in @@ -594,12 +597,12 @@ let (generalize' : fun env -> fun is_rec -> fun lecs -> - (let uu___2 = FStarC_Compiler_Debug.low () in + (let uu___2 = FStarC_Debug.low () in if uu___2 then let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (lb, uu___6, uu___7) -> @@ -610,16 +613,16 @@ let (generalize' : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Class_Show.showable_string) uu___4 in - FStarC_Compiler_Util.print1 "Generalizing: %s\n" uu___3 + FStarC_Util.print1 "Generalizing: %s\n" uu___3 else ()); (let univnames_lecs = let empty = Obj.magic (FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) []) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun uu___2 -> (fun out -> @@ -630,34 +633,34 @@ let (generalize' : Obj.magic (FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic out) (Obj.magic uu___3))) uu___3 uu___2) empty lecs in let univnames_lecs1 = FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_ident)) (Obj.magic univnames_lecs) in let generalized_lecs = let uu___2 = gen env is_rec lecs in match uu___2 with | FStar_Pervasives_Native.None -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (l, t, c) -> (l, [], t, c, [])) lecs | FStar_Pervasives_Native.Some luecs -> - ((let uu___4 = FStarC_Compiler_Debug.medium () in + ((let uu___4 = FStarC_Debug.medium () in if uu___4 then - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___5 -> match uu___5 with | (l, us, e, c, gvs) -> let uu___6 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range e.FStarC_Syntax_Syntax.pos in let uu___7 = FStarC_Class_Show.show @@ -665,9 +668,9 @@ let (generalize' : FStarC_Syntax_Print.showable_bv FStarC_Syntax_Print.showable_fv) l in let uu___8 = + let uu___9 = FStarC_Syntax_Util.comp_result c in FStarC_Class_Show.show - FStarC_Syntax_Print.showable_term - (FStarC_Syntax_Util.comp_result c) in + FStarC_Syntax_Print.showable_term uu___9 in let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in @@ -675,12 +678,12 @@ let (generalize' : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) gvs in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "(%s) Generalized %s at type %s\n%s\nVars = (%s)\n" uu___6 uu___7 uu___8 uu___9 uu___10) luecs else ()); luecs) in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (l, generalized_univs, t, c, gvs) -> diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_NBE.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_NBE.ml similarity index 90% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_NBE.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_NBE.ml index bd693ee0c9b..fe8ee2d53ab 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_NBE.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_NBE.ml @@ -1,8 +1,7 @@ open Prims -let (dbg_NBE : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "NBE" -let (dbg_NBETop : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "NBETop" +let (dbg_NBE : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "NBE" +let (dbg_NBETop : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "NBETop" let (max : Prims.int -> Prims.int -> Prims.int) = fun a -> fun b -> if a > b then a else b let map_rev : 'a 'b . ('a -> 'b) -> 'a Prims.list -> 'b Prims.list = @@ -48,7 +47,7 @@ let fmap_opt : = fun f -> fun x -> - FStarC_Compiler_Util.bind_opt x + FStarC_Util.bind_opt x (fun x1 -> let uu___ = f x1 in FStar_Pervasives_Native.Some uu___) let drop_until : 'a . ('a -> Prims.bool) -> 'a Prims.list -> 'a Prims.list = fun f -> @@ -60,8 +59,8 @@ let drop_until : 'a . ('a -> Prims.bool) -> 'a Prims.list -> 'a Prims.list = aux l let (trim : Prims.bool Prims.list -> Prims.bool Prims.list) = fun l -> - let uu___ = drop_until (fun x -> x) (FStarC_Compiler_List.rev l) in - FStarC_Compiler_List.rev uu___ + let uu___ = drop_until (fun x -> x) (FStarC_List.rev l) in + FStarC_List.rev uu___ let (implies : Prims.bool -> Prims.bool -> Prims.bool) = fun b1 -> fun b2 -> @@ -80,29 +79,28 @@ let (let_rec_arity : let (debug_term : FStarC_Syntax_Syntax.term -> unit) = fun t -> let uu___ = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 "%s\n" uu___ -let (debug_sigmap : - FStarC_Syntax_Syntax.sigelt FStarC_Compiler_Util.smap -> unit) = + FStarC_Util.print1 "%s\n" uu___ +let (debug_sigmap : FStarC_Syntax_Syntax.sigelt FStarC_Util.smap -> unit) = fun m -> - FStarC_Compiler_Util.smap_fold m + FStarC_Util.smap_fold m (fun k -> fun v -> fun u -> let uu___ = FStarC_Syntax_Print.sigelt_to_string_short v in - FStarC_Compiler_Util.print2 "%s -> %%s\n" k uu___) () + FStarC_Util.print2 "%s -> %%s\n" k uu___) () type config = { core_cfg: FStarC_TypeChecker_Cfg.cfg ; - fv_cache: FStarC_TypeChecker_NBETerm.t FStarC_Compiler_Util.smap } + fv_cache: FStarC_TypeChecker_NBETerm.t FStarC_Util.smap } let (__proj__Mkconfig__item__core_cfg : config -> FStarC_TypeChecker_Cfg.cfg) = fun projectee -> match projectee with | { core_cfg; fv_cache;_} -> core_cfg let (__proj__Mkconfig__item__fv_cache : - config -> FStarC_TypeChecker_NBETerm.t FStarC_Compiler_Util.smap) = + config -> FStarC_TypeChecker_NBETerm.t FStarC_Util.smap) = fun projectee -> match projectee with | { core_cfg; fv_cache;_} -> fv_cache let (new_config : FStarC_TypeChecker_Cfg.cfg -> config) = fun cfg -> - let uu___ = FStarC_Compiler_Util.smap_create (Prims.of_int (51)) in + let uu___ = FStarC_Util.smap_create (Prims.of_int (51)) in { core_cfg = cfg; fv_cache = uu___ } let (reifying_false : config -> config) = fun cfg -> @@ -189,6 +187,8 @@ let (zeta_false : config -> config) = (uu___.FStarC_TypeChecker_Cfg.unfold_until); FStarC_TypeChecker_Cfg.unfold_only = (uu___.FStarC_TypeChecker_Cfg.unfold_only); + FStarC_TypeChecker_Cfg.unfold_once = + (uu___.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = (uu___.FStarC_TypeChecker_Cfg.unfold_fully); FStarC_TypeChecker_Cfg.unfold_attr = @@ -263,7 +263,7 @@ let (cache_add : fun v -> let lid = (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in let uu___ = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_add cfg.fv_cache uu___ v + FStarC_Util.smap_add cfg.fv_cache uu___ v let (try_in_cache : config -> FStarC_Syntax_Syntax.fv -> @@ -273,7 +273,7 @@ let (try_in_cache : fun fv -> let lid = (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in let uu___ = FStarC_Ident.string_of_lid lid in - FStarC_Compiler_Util.smap_try_find cfg.fv_cache uu___ + FStarC_Util.smap_try_find cfg.fv_cache uu___ let (debug : config -> (unit -> unit) -> unit) = fun cfg -> fun f -> FStarC_TypeChecker_Cfg.log_nbe cfg.core_cfg f let rec (unlazy_unmeta : @@ -309,8 +309,7 @@ let (pickBranch : FStarC_TypeChecker_NBETerm.t_to_string scrutinee0 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p in - FStarC_Compiler_Util.print2 "matches_pat (%s, %s)\n" uu___2 - uu___3); + FStarC_Util.print2 "matches_pat (%s, %s)\n" uu___2 uu___3); (let scrutinee = unlazy_unmeta scrutinee0 in let r = match p.FStarC_Syntax_Syntax.v with @@ -327,7 +326,7 @@ let (pickBranch : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const s1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Testing term %s against pattern %s\n" uu___3 uu___4); (match c.FStarC_TypeChecker_NBETerm.nbe_t with @@ -372,8 +371,8 @@ let (pickBranch : let uu___3 = matches_pat t p2 in (match uu___3 with | FStar_Pervasives.Inl s -> - matches_args (FStarC_Compiler_List.op_At out s) - rest_a rest_p + matches_args (FStarC_List.op_At out s) rest_a + rest_p | m -> m) | uu___1 -> FStar_Pervasives.Inr false in (match scrutinee.FStarC_TypeChecker_NBETerm.nbe_t with @@ -382,19 +381,17 @@ let (pickBranch : let uu___1 = FStarC_Syntax_Syntax.fv_eq fv fv' in if uu___1 then - matches_args [] (FStarC_Compiler_List.rev args_rev) - arg_pats + matches_args [] (FStarC_List.rev args_rev) arg_pats else FStar_Pervasives.Inr false | uu___1 -> FStar_Pervasives.Inr true) in let res_to_string uu___1 = match uu___1 with | FStar_Pervasives.Inr b -> - let uu___2 = FStarC_Compiler_Util.string_of_bool b in + let uu___2 = FStarC_Util.string_of_bool b in Prims.strcat "Inr " uu___2 | FStar_Pervasives.Inl bs -> let uu___2 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length bs) in + FStarC_Util.string_of_int (FStarC_List.length bs) in Prims.strcat "Inl " uu___2 in debug cfg (fun uu___2 -> @@ -403,8 +400,8 @@ let (pickBranch : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p in let uu___5 = res_to_string r in - FStarC_Compiler_Util.print3 "matches_pat (%s, %s) = %s\n" - uu___3 uu___4 uu___5); + FStarC_Util.print3 "matches_pat (%s, %s) = %s\n" uu___3 + uu___4 uu___5); r) in match branches1 with | [] -> FStar_Pervasives_Native.None @@ -417,8 +414,7 @@ let (pickBranch : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p in - FStarC_Compiler_Util.print1 "Pattern %s matches\n" - uu___3); + FStarC_Util.print1 "Pattern %s matches\n" uu___3); FStar_Pervasives_Native.Some (e, matches)) | FStar_Pervasives.Inr (false) -> pickBranch_aux scrut1 branches2 branches0 @@ -442,7 +438,7 @@ let (should_reduce_recursive_definition : (FStarC_TypeChecker_NBETerm.isAccu (FStar_Pervasives_Native.fst t)) in if uu___ - then (false, (FStarC_Compiler_List.rev_append ts1 acc), []) + then (false, (FStarC_List.rev_append ts1 acc), []) else aux ts1 bs (t :: acc) in aux arguments formals_in_decreases [] let (find_sigelt_in_gamma : @@ -468,12 +464,12 @@ let (find_sigelt_in_gamma : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_univ) us in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Universes in local declaration: %s\n" uu___3); FStar_Pervasives_Native.Some elt) | uu___1 -> FStar_Pervasives_Native.None) in let uu___ = FStarC_TypeChecker_Env.lookup_qname env lid in - FStarC_Compiler_Util.bind_opt uu___ mapper + FStarC_Util.bind_opt uu___ mapper let (is_univ : FStarC_TypeChecker_NBETerm.t -> Prims.bool) = fun tm -> match tm.FStarC_TypeChecker_NBETerm.nbe_t with @@ -523,8 +519,8 @@ let (translate_univ : let u2 = FStarC_Syntax_Subst.compress_univ u1 in match u2 with | FStarC_Syntax_Syntax.U_bvar i -> - if i < (FStarC_Compiler_List.length bs) - then let u' = FStarC_Compiler_List.nth bs i in un_univ u' + if i < (FStarC_List.length bs) + then let u' = FStarC_List.nth bs i in un_univ u' else if ((cfg.core_cfg).FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.allow_unbound_universes @@ -533,7 +529,7 @@ let (translate_univ : | FStarC_Syntax_Syntax.U_succ u3 -> let uu___ = aux u3 in FStarC_Syntax_Syntax.U_succ uu___ | FStarC_Syntax_Syntax.U_max us -> - let uu___ = FStarC_Compiler_List.map aux us in + let uu___ = FStarC_List.map aux us in FStarC_Syntax_Syntax.U_max uu___ | FStarC_Syntax_Syntax.U_unknown -> u2 | FStarC_Syntax_Syntax.U_name uu___ -> u2 @@ -547,7 +543,7 @@ let (find_let : = fun lbs -> fun fvar -> - FStarC_Compiler_Util.find_map lbs + FStarC_Util.find_map lbs (fun lb -> match lb.FStarC_Syntax_Syntax.lbname with | FStar_Pervasives.Inl uu___ -> failwith "find_let : impossible" @@ -557,7 +553,7 @@ let (find_let : then FStar_Pervasives_Native.Some lb else FStar_Pervasives_Native.None) let (mk_rt : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_TypeChecker_NBETerm.t' -> FStarC_TypeChecker_NBETerm.t) = fun r -> @@ -570,8 +566,7 @@ let (mk_t : FStarC_TypeChecker_NBETerm.t' -> FStarC_TypeChecker_NBETerm.t) = fun t -> { FStarC_TypeChecker_NBETerm.nbe_t = t; - FStarC_TypeChecker_NBETerm.nbe_r = - FStarC_Compiler_Range_Type.dummyRange + FStarC_TypeChecker_NBETerm.nbe_r = FStarC_Range_Type.dummyRange } let rec (translate : config -> @@ -593,7 +588,7 @@ let rec (translate : let uu___4 = FStarC_Syntax_Subst.compress e in FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___4 in - FStarC_Compiler_Util.print2 "Term: %s - %s\n" uu___2 uu___3); + FStarC_Util.print2 "Term: %s - %s\n" uu___2 uu___3); (let uu___1 = let uu___2 = FStarC_Syntax_Subst.compress e in uu___2.FStarC_Syntax_Syntax.n in @@ -608,21 +603,18 @@ let rec (translate : FStarC_TypeChecker_NBETerm.Constant uu___3 in mk_t1 uu___2 | FStarC_Syntax_Syntax.Tm_bvar db -> - if - db.FStarC_Syntax_Syntax.index < - (FStarC_Compiler_List.length bs) + if db.FStarC_Syntax_Syntax.index < (FStarC_List.length bs) then - let t = - FStarC_Compiler_List.nth bs db.FStarC_Syntax_Syntax.index in + let t = FStarC_List.nth bs db.FStarC_Syntax_Syntax.index in (debug1 (fun uu___3 -> let uu___4 = FStarC_TypeChecker_NBETerm.t_to_string t in let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_TypeChecker_NBETerm.t_to_string bs in - FStarC_Compiler_String.concat "; " uu___6 in - FStarC_Compiler_Util.print2 + FStarC_String.concat "; " uu___6 in + FStarC_Util.print2 "Resolved bvar to %s\n\tcontext is [%s]\n" uu___4 uu___5); t) @@ -635,15 +627,15 @@ let rec (translate : t in let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ) us in - FStarC_Compiler_String.concat ", " uu___6 in - FStarC_Compiler_Util.print2 - "Uinst term : %s\nUnivs : %s\n" uu___4 uu___5); + FStarC_String.concat ", " uu___6 in + FStarC_Util.print2 "Uinst term : %s\nUnivs : %s\n" uu___4 + uu___5); (let uu___3 = translate cfg bs t in let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___5 = let uu___6 = @@ -663,7 +655,7 @@ let rec (translate : -> let norm uu___2 = let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun b -> match uu___4 with @@ -701,8 +693,7 @@ let rec (translate : let c1 = let uu___4 = translate_comp cfg ctx c in readback_comp cfg uu___4 in - FStarC_Syntax_Util.arrow - (FStarC_Compiler_List.rev binders_rev) c1 in + FStarC_Syntax_Util.arrow (FStarC_List.rev binders_rev) c1 in let uu___2 = let uu___3 = let uu___4 = FStarC_Thunk.mk norm in @@ -762,8 +753,7 @@ let rec (translate : | uu___4 -> failwith "Impossible: subst invariant of uvar nodes" in let subst1 = - FStarC_Compiler_List.map - (FStarC_Compiler_List.map norm_subst_elt) subst in + FStarC_List.map (FStarC_List.map norm_subst_elt) subst in { FStarC_Syntax_Syntax.n = (FStarC_Syntax_Syntax.Tm_uvar (u, (subst1, set_use_range))); @@ -799,14 +789,13 @@ let rec (translate : (fun ys -> let uu___2 = let uu___3 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst ys in - FStarC_Compiler_List.append uu___3 bs in + FStarC_List.map FStar_Pervasives_Native.fst ys in + FStarC_List.append uu___3 bs in translate cfg uu___2 body); FStarC_TypeChecker_NBETerm.shape = (FStarC_TypeChecker_NBETerm.Lam_bs (bs, xs, resc)); FStarC_TypeChecker_NBETerm.arity = - (FStarC_Compiler_List.length xs) + (FStarC_List.length xs) }) | FStarC_Syntax_Syntax.Tm_fvar fvar -> let uu___2 = try_in_cache cfg fvar in @@ -936,7 +925,7 @@ let rec (translate : -> (debug1 (fun uu___7 -> - FStarC_Compiler_Util.print_string "Eliminated assertion\n"); + FStarC_Util.print_string "Eliminated assertion\n"); mk_t1 (FStarC_TypeChecker_NBETerm.Constant FStarC_TypeChecker_NBETerm.Unit)) @@ -952,7 +941,7 @@ let rec (translate : -> let uu___2 = translate cfg bs head in let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___4 = FStarC_Syntax_Util.aqual_is_erasable @@ -965,7 +954,7 @@ let rec (translate : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term (FStar_Pervasives_Native.fst x) in - FStarC_Compiler_Util.print1 "Erasing %s\n" uu___7); + FStarC_Util.print1 "Erasing %s\n" uu___7); ((mk_t1 (FStarC_TypeChecker_NBETerm.Constant FStarC_TypeChecker_NBETerm.Unit)), @@ -990,11 +979,10 @@ let rec (translate : (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) args in - FStarC_Compiler_Util.print2 "Application: %s @ %s\n" - uu___4 uu___5); + FStarC_Util.print2 "Application: %s @ %s\n" uu___4 uu___5); (let uu___3 = translate cfg bs head in let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___5 = translate cfg bs (FStar_Pervasives_Native.fst x) in @@ -1047,7 +1035,7 @@ let rec (translate : FStarC_Syntax_Subst.close_ascription [b1] asc1 in let b2 = let uu___4 = FStarC_Syntax_Subst.close_binders [b1] in - FStarC_Compiler_List.hd uu___4 in + FStarC_List.hd uu___4 in FStar_Pervasives_Native.Some (b2, asc2)) in let make_rc uu___2 = match rc with @@ -1066,7 +1054,7 @@ let rec (translate : (bs1, (FStarC_Syntax_Syntax.Pat_constant c)) | FStarC_Syntax_Syntax.Pat_cons (fvar, us_opt, args) -> let uu___4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___5 -> fun uu___6 -> match (uu___5, uu___6) with @@ -1084,13 +1072,12 @@ let rec (translate : FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some us -> let uu___5 = - FStarC_Compiler_List.map - (translate_univ cfg1 bs1) us in + FStarC_List.map (translate_univ cfg1 bs1) + us in FStar_Pervasives_Native.Some uu___5 in (bs', (FStarC_Syntax_Syntax.Pat_cons - (fvar, us_opt1, - (FStarC_Compiler_List.rev args'))))) + (fvar, us_opt1, (FStarC_List.rev args'))))) | FStarC_Syntax_Syntax.Pat_var bvar -> let x = let uu___4 = @@ -1108,7 +1095,7 @@ let rec (translate : | FStarC_Syntax_Syntax.Pat_dot_term eopt -> let uu___4 = let uu___5 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun e1 -> let uu___6 = translate cfg1 bs1 e1 in readback cfg1 uu___6) eopt in @@ -1121,7 +1108,7 @@ let rec (translate : FStarC_Syntax_Syntax.v = p_new; FStarC_Syntax_Syntax.p = (p.FStarC_Syntax_Syntax.p) }) in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (pat, when_clause, e1) -> @@ -1138,13 +1125,13 @@ let rec (translate : (debug1 (fun uu___3 -> let uu___4 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range e.FStarC_Syntax_Syntax.pos in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print2 "%s: Translating match %s\n" - uu___4 uu___5); + FStarC_Util.print2 "%s: Translating match %s\n" uu___4 + uu___5); (let scrut2 = unlazy_unmeta scrut1 in match scrut2.FStarC_TypeChecker_NBETerm.nbe_t with | FStarC_TypeChecker_NBETerm.Construct (c, us, args) -> @@ -1152,7 +1139,7 @@ let rec (translate : (fun uu___4 -> let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (x, q) -> @@ -1160,17 +1147,16 @@ let rec (translate : FStarC_TypeChecker_NBETerm.t_to_string x in Prims.strcat - (if FStarC_Compiler_Util.is_some q + (if FStarC_Util.is_some q then "#" else "") uu___8) args in - FStarC_Compiler_String.concat "; " uu___6 in - FStarC_Compiler_Util.print1 "Match args: %s\n" - uu___5); + FStarC_String.concat "; " uu___6 in + FStarC_Util.print1 "Match args: %s\n" uu___5); (let uu___4 = pickBranch cfg scrut2 branches in match uu___4 with | FStar_Pervasives_Native.Some (branch, args1) -> let uu___5 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun bs1 -> fun x -> x :: bs1) bs args1 in translate cfg uu___5 branch | FStar_Pervasives_Native.None -> @@ -1181,8 +1167,7 @@ let rec (translate : (fun uu___4 -> let uu___5 = FStarC_TypeChecker_NBETerm.t_to_string scrut2 in - FStarC_Compiler_Util.print1 "Match constant : %s\n" - uu___5); + FStarC_Util.print1 "Match constant : %s\n" uu___5); (let uu___4 = pickBranch cfg scrut2 branches in match uu___4 with | FStar_Pervasives_Native.Some (branch, []) -> @@ -1223,10 +1208,10 @@ let rec (translate : | FStarC_Syntax_Syntax.Meta_desugared uu___3 -> meta | FStarC_Syntax_Syntax.Meta_pattern (ts, args) -> let uu___3 = - let uu___4 = FStarC_Compiler_List.map norm ts in + let uu___4 = FStarC_List.map norm ts in let uu___5 = - FStarC_Compiler_List.map - (FStarC_Compiler_List.map + FStarC_List.map + (FStarC_List.map (fun uu___6 -> match uu___6 with | (t, a) -> let uu___7 = norm t in (uu___7, a))) @@ -1297,7 +1282,7 @@ let rec (translate : translate cfg bs lb.FStarC_Syntax_Syntax.lbtyp in let name = let uu___4 = - FStarC_Compiler_Util.left lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.freshen_bv uu___4 in let bs1 = let uu___4 = @@ -1330,27 +1315,26 @@ let rec (translate : ((cfg.core_cfg).FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.pure_subterms_within_computations then let vars = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___2 = - FStarC_Compiler_Util.left - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.freshen_bv uu___2) lbs in let typs = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> translate cfg bs lb.FStarC_Syntax_Syntax.lbtyp) lbs in let rec_bs = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun v -> let uu___3 = FStarC_Syntax_Syntax.range_of_bv v in mk_rt uu___3 (FStarC_TypeChecker_NBETerm.Accu ((FStarC_TypeChecker_NBETerm.Var v), []))) vars in - FStarC_Compiler_List.op_At uu___2 bs in + FStarC_List.op_At uu___2 bs in let defs = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> translate cfg rec_bs lb.FStarC_Syntax_Syntax.lbdef) lbs in let body1 = translate cfg rec_bs body in @@ -1358,7 +1342,7 @@ let rec (translate : let uu___3 = let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_List.zip3 vars typs defs in + let uu___6 = FStarC_List.zip3 vars typs defs in (uu___6, body1, lbs) in FStarC_TypeChecker_NBETerm.UnreducedLetRec uu___5 in (uu___4, []) in @@ -1369,17 +1353,17 @@ let rec (translate : | FStarC_Syntax_Syntax.Tm_quoted (qt, qi) -> let close t = let bvs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> FStarC_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStarC_Syntax_Syntax.tun) bs in let s1 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun bv -> FStarC_Syntax_Syntax.DB (i, bv)) bvs in let s2 = - let uu___2 = FStarC_Compiler_List.zip bvs bs in - FStarC_Compiler_List.map + let uu___2 = FStarC_List.zip bvs bs in + FStarC_List.map (fun uu___3 -> match uu___3 with | (bv, t1) -> @@ -1403,8 +1387,7 @@ let rec (translate : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 - ">> Unfolding Tm_lazy to %s\n" uu___5); + FStarC_Util.print1 ">> Unfolding Tm_lazy to %s\n" uu___5); translate cfg bs t in let uu___2 = let uu___3 = @@ -1448,54 +1431,53 @@ and (iapp : FStarC_TypeChecker_NBETerm.shape = shape; FStarC_TypeChecker_NBETerm.arity = n;_} -> - let m = FStarC_Compiler_List.length args in + let m = FStarC_List.length args in if m < n then - let arg_values_rev = FStarC_Compiler_List.rev args in + let arg_values_rev = FStarC_List.rev args in let shape1 = match shape with | FStarC_TypeChecker_NBETerm.Lam_args raw_args -> - let uu___1 = FStarC_Compiler_List.splitAt m raw_args in + let uu___1 = FStarC_List.splitAt m raw_args in (match uu___1 with | (uu___2, raw_args1) -> FStarC_TypeChecker_NBETerm.Lam_args raw_args1) | FStarC_TypeChecker_NBETerm.Lam_bs (ctx, xs, rc) -> - let uu___1 = FStarC_Compiler_List.splitAt m xs in + let uu___1 = FStarC_List.splitAt m xs in (match uu___1 with | (uu___2, xs1) -> let ctx1 = let uu___3 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst arg_values_rev in - FStarC_Compiler_List.append uu___3 ctx in + FStarC_List.map FStar_Pervasives_Native.fst + arg_values_rev in + FStarC_List.append uu___3 ctx in FStarC_TypeChecker_NBETerm.Lam_bs (ctx1, xs1, rc)) | FStarC_TypeChecker_NBETerm.Lam_primop (f2, args_acc) -> FStarC_TypeChecker_NBETerm.Lam_primop - (f2, (FStarC_Compiler_List.op_At args_acc args)) in + (f2, (FStarC_List.op_At args_acc args)) in mk (FStarC_TypeChecker_NBETerm.Lam { FStarC_TypeChecker_NBETerm.interp = - (fun l -> - f1 (FStarC_Compiler_List.append l arg_values_rev)); + (fun l -> f1 (FStarC_List.append l arg_values_rev)); FStarC_TypeChecker_NBETerm.shape = shape1; FStarC_TypeChecker_NBETerm.arity = (n - m) }) else if m = n then - (let arg_values_rev = FStarC_Compiler_List.rev args in + (let arg_values_rev = FStarC_List.rev args in f1 arg_values_rev) else - (let uu___3 = FStarC_Compiler_List.splitAt n args in + (let uu___3 = FStarC_List.splitAt n args in match uu___3 with | (args1, args') -> - let uu___4 = f1 (FStarC_Compiler_List.rev args1) in + let uu___4 = f1 (FStarC_List.rev args1) in iapp cfg uu___4 args') | FStarC_TypeChecker_NBETerm.Accu (a, ts) -> mk (FStarC_TypeChecker_NBETerm.Accu - (a, (FStarC_Compiler_List.rev_append args ts))) + (a, (FStarC_List.rev_append args ts))) | FStarC_TypeChecker_NBETerm.Construct (i, us, ts) -> let rec aux args1 us1 ts1 = match args1 with @@ -1524,10 +1506,9 @@ and (iapp : (match uu___1 with | (us', ts') -> mk (FStarC_TypeChecker_NBETerm.FV (i, us', ts'))) | FStarC_TypeChecker_NBETerm.TopLevelLet (lb, arity, args_rev) -> - let args_rev1 = FStarC_Compiler_List.rev_append args args_rev in - let n_args_rev = FStarC_Compiler_List.length args_rev1 in - let n_univs = - FStarC_Compiler_List.length lb.FStarC_Syntax_Syntax.lbunivs in + let args_rev1 = FStarC_List.rev_append args args_rev in + let n_args_rev = FStarC_List.length args_rev1 in + let n_univs = FStarC_List.length lb.FStarC_Syntax_Syntax.lbunivs in (debug cfg (fun uu___2 -> let uu___3 = @@ -1542,7 +1523,7 @@ and (iapp : let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat n_args_rev in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Reached iapp for %s with arity %s and n_args = %s\n" uu___3 uu___4 uu___5); if n_args_rev >= arity @@ -1562,11 +1543,10 @@ and (iapp : | uu___4 -> ([], (lb.FStarC_Syntax_Syntax.lbdef)) in match uu___2 with | (bs, body) -> - if (n_univs + (FStarC_Compiler_List.length bs)) = arity + if (n_univs + (FStarC_List.length bs)) = arity then let uu___3 = - FStarC_Compiler_Util.first_N (n_args_rev - arity) - args_rev1 in + FStarC_Util.first_N (n_args_rev - arity) args_rev1 in (match uu___3 with | (extra, args_rev2) -> (debug cfg @@ -1584,39 +1564,37 @@ and (iapp : FStarC_Class_Show.show FStarC_TypeChecker_NBETerm.showable_args args_rev2 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Reducing body of %s = %s,\n\twith args = %s\n" uu___6 uu___7 uu___8); (let t = let uu___5 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst args_rev2 in + FStarC_List.map FStar_Pervasives_Native.fst + args_rev2 in translate cfg uu___5 body in match extra with | [] -> t - | uu___5 -> - iapp cfg t (FStarC_Compiler_List.rev extra)))) + | uu___5 -> iapp cfg t (FStarC_List.rev extra)))) else (let uu___4 = - FStarC_Compiler_Util.first_N (n_args_rev - n_univs) - args_rev1 in + FStarC_Util.first_N (n_args_rev - n_univs) args_rev1 in match uu___4 with | (extra, univs) -> let uu___5 = let uu___6 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst univs in + FStarC_List.map FStar_Pervasives_Native.fst + univs in translate cfg uu___6 lb.FStarC_Syntax_Syntax.lbdef in - iapp cfg uu___5 (FStarC_Compiler_List.rev extra))) + iapp cfg uu___5 (FStarC_List.rev extra))) else mk (FStarC_TypeChecker_NBETerm.TopLevelLet (lb, arity, args_rev1))) | FStarC_TypeChecker_NBETerm.TopLevelRec (lb, arity, decreases_list, args') -> - let args1 = FStarC_Compiler_List.append args' args in - if (FStarC_Compiler_List.length args1) >= arity + let args1 = FStarC_List.append args' args in + if (FStarC_List.length args1) >= arity then let uu___1 = should_reduce_recursive_definition args1 decreases_list in @@ -1625,14 +1603,13 @@ and (iapp : if Prims.op_Negation should_reduce then let fv = - FStarC_Compiler_Util.right - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in (debug cfg (fun uu___5 -> let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fv in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Decided to not unfold recursive definition %s\n" uu___6); (let uu___5 = @@ -1645,25 +1622,25 @@ and (iapp : (fun uu___6 -> let uu___7 = let uu___8 = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv uu___8 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Yes, Decided to unfold recursive definition %s\n" uu___7); (let uu___6 = - FStarC_Compiler_Util.first_N - (FStarC_Compiler_List.length + FStarC_Util.first_N + (FStarC_List.length lb.FStarC_Syntax_Syntax.lbunivs) args1 in match uu___6 with | (univs, rest) -> let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst univs in - FStarC_Compiler_List.rev uu___9 in + FStarC_List.map FStar_Pervasives_Native.fst + univs in + FStarC_List.rev uu___9 in translate cfg uu___8 lb.FStarC_Syntax_Syntax.lbdef in iapp cfg uu___7 rest))) @@ -1680,19 +1657,19 @@ and (iapp : mk (FStarC_TypeChecker_NBETerm.LocalLetRec (i, lb, mutual_lbs, local_env, - (FStarC_Compiler_List.op_At acc_args args), - remaining_arity, decreases_list)) + (FStarC_List.op_At acc_args args), remaining_arity, + decreases_list)) else - (let n_args = FStarC_Compiler_List.length args in + (let n_args = FStarC_List.length args in if n_args < remaining_arity then mk (FStarC_TypeChecker_NBETerm.LocalLetRec (i, lb, mutual_lbs, local_env, - (FStarC_Compiler_List.op_At acc_args args), + (FStarC_List.op_At acc_args args), (remaining_arity - n_args), decreases_list)) else - (let args1 = FStarC_Compiler_List.op_At acc_args args in + (let args1 = FStarC_List.op_At acc_args args in let uu___3 = should_reduce_recursive_definition args1 decreases_list in match uu___3 with @@ -1709,24 +1686,22 @@ and (iapp : (fun uu___8 -> (let uu___10 = let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_TypeChecker_NBETerm.t_to_string env in - FStarC_Compiler_String.concat ",\n\t " - uu___11 in - FStarC_Compiler_Util.print1 + FStarC_String.concat ",\n\t " uu___11 in + FStarC_Util.print1 "LocalLetRec Env = {\n\t%s\n}\n" uu___10); (let uu___10 = let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___12 -> match uu___12 with | (t, uu___13) -> FStarC_TypeChecker_NBETerm.t_to_string t) args1 in - FStarC_Compiler_String.concat ",\n\t " - uu___11 in - FStarC_Compiler_Util.print1 + FStarC_String.concat ",\n\t " uu___11 in + FStarC_Util.print1 "LocalLetRec Args = {\n\t%s\n}\n" uu___10)); (let uu___8 = translate cfg env lb.FStarC_Syntax_Syntax.lbdef in @@ -1813,8 +1788,8 @@ and (translate_fv : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 - "(1) Decided to not unfold %s\n" uu___5); + FStarC_Util.print1 "(1) Decided to not unfold %s\n" + uu___5); (let uu___4 = FStarC_TypeChecker_Cfg.find_prim_step cfg.core_cfg fvar in match uu___4 with @@ -1829,15 +1804,13 @@ and (translate_fv : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 "Found a primop %s\n" - uu___7); + FStarC_Util.print1 "Found a primop %s\n" uu___7); mk_t (FStarC_TypeChecker_NBETerm.Lam { FStarC_TypeChecker_NBETerm.interp = (fun args_rev -> - let args' = - FStarC_Compiler_List.rev args_rev in + let args' = FStarC_List.rev args_rev in let callbacks = { FStarC_TypeChecker_NBETerm.iapp = @@ -1851,11 +1824,11 @@ and (translate_fv : FStarC_Class_Show.show FStarC_TypeChecker_NBETerm.showable_args args' in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Caling primop with args = [%s]\n" uu___8); (let uu___7 = - FStarC_Compiler_List.span + FStarC_List.span (fun uu___8 -> match uu___8 with | ({ @@ -1870,7 +1843,7 @@ and (translate_fv : match uu___7 with | (univs, rest) -> let univs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | ({ @@ -1898,7 +1871,7 @@ and (translate_fv : let uu___12 = FStarC_TypeChecker_NBETerm.t_to_string x in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Primitive operator %s returned %s\n" uu___11 uu___12); x) @@ -1909,7 +1882,7 @@ and (translate_fv : FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Primitive operator %s failed\n" uu___11); (let uu___10 = @@ -1927,7 +1900,7 @@ and (translate_fv : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(2) Decided to not unfold %s\n" uu___8); FStarC_TypeChecker_NBETerm.mkFV fvar [] []) | uu___5 -> @@ -1936,7 +1909,7 @@ and (translate_fv : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(3) Decided to not unfold %s\n" uu___8); FStarC_TypeChecker_NBETerm.mkFV fvar [] []))) | FStarC_TypeChecker_Normalize_Unfolding.Should_unfold_reify -> @@ -1947,7 +1920,7 @@ and (translate_fv : (cfg.core_cfg).FStarC_TypeChecker_Cfg.delta_level (fvar.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v qninfo in - FStarC_Compiler_Option.isSome uu___3 in + FStarC_Option.isSome uu___3 in if is_qninfo_visible then match qninfo with @@ -1972,8 +1945,8 @@ and (translate_fv : let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 - "(1) Decided to unfold %s\n" uu___11); + FStarC_Util.print1 "(1) Decided to unfold %s\n" + uu___11); (let lbm = find_let lbs fvar in match lbm with | FStar_Pervasives_Native.Some lb -> @@ -1998,7 +1971,7 @@ and (translate_fv : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(1) qninfo is None for (%s)\n" uu___6); FStarC_TypeChecker_NBETerm.mkFV fvar [] []) else @@ -2007,7 +1980,7 @@ and (translate_fv : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(1) qninfo is not visible at this level (%s)\n" uu___6); FStarC_TypeChecker_NBETerm.mkFV fvar [] []) in @@ -2020,7 +1993,7 @@ and (translate_fv : (cfg.core_cfg).FStarC_TypeChecker_Cfg.delta_level (fvar.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v qninfo in - FStarC_Compiler_Option.isSome uu___3 in + FStarC_Option.isSome uu___3 in if is_qninfo_visible then match qninfo with @@ -2045,8 +2018,8 @@ and (translate_fv : let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 - "(1) Decided to unfold %s\n" uu___11); + FStarC_Util.print1 "(1) Decided to unfold %s\n" + uu___11); (let lbm = find_let lbs fvar in match lbm with | FStar_Pervasives_Native.Some lb -> @@ -2071,7 +2044,7 @@ and (translate_fv : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(1) qninfo is None for (%s)\n" uu___6); FStarC_TypeChecker_NBETerm.mkFV fvar [] []) else @@ -2080,7 +2053,7 @@ and (translate_fv : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fvar in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(1) qninfo is not visible at this level (%s)\n" uu___6); FStarC_TypeChecker_NBETerm.mkFV fvar [] []) in @@ -2100,13 +2073,12 @@ and (translate_letbinding : match uu___ with | (formals, uu___1) -> let arity = - (FStarC_Compiler_List.length us) + - (FStarC_Compiler_List.length formals) in + (FStarC_List.length us) + (FStarC_List.length formals) in if arity = Prims.int_zero then translate cfg bs lb.FStarC_Syntax_Syntax.lbdef else (let uu___3 = - FStarC_Compiler_Util.is_right lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.is_right lb.FStarC_Syntax_Syntax.lbname in if uu___3 then (debug1 @@ -2120,7 +2092,7 @@ and (translate_letbinding : let uu___7 = FStarC_Class_Show.show FStarC_Class_Show.showable_int arity in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Making TopLevelLet for %s with arity %s\n" uu___6 uu___7); (let uu___5 = @@ -2154,9 +2126,9 @@ and (make_rec_env : fun all_lbs -> fun all_outer_bs -> let rec_bindings = - FStarC_Compiler_List.mapi - (fun i -> fun lb -> mkRec i lb all_lbs all_outer_bs) all_lbs in - FStarC_Compiler_List.rev_append rec_bindings all_outer_bs + FStarC_List.mapi (fun i -> fun lb -> mkRec i lb all_lbs all_outer_bs) + all_lbs in + FStarC_List.rev_append rec_bindings all_outer_bs and (translate_constant : FStarC_Syntax_Syntax.sconst -> FStarC_TypeChecker_NBETerm.constant) = fun c -> @@ -2185,7 +2157,7 @@ and (readback_comp : | FStarC_TypeChecker_NBETerm.Comp ctyp -> let uu___ = readback_comp_typ cfg ctyp in FStarC_Syntax_Syntax.Comp uu___ in - FStarC_Syntax_Syntax.mk c' FStarC_Compiler_Range_Type.dummyRange + FStarC_Syntax_Syntax.mk c' FStarC_Range_Type.dummyRange and (translate_comp_typ : config -> FStarC_TypeChecker_NBETerm.t Prims.list -> @@ -2201,17 +2173,15 @@ and (translate_comp_typ : FStarC_Syntax_Syntax.result_typ = result_typ; FStarC_Syntax_Syntax.effect_args = effect_args; FStarC_Syntax_Syntax.flags = flags;_} -> - let uu___1 = - FStarC_Compiler_List.map (translate_univ cfg bs) comp_univs in + let uu___1 = FStarC_List.map (translate_univ cfg bs) comp_univs in let uu___2 = translate cfg bs result_typ in let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___4 = translate cfg bs (FStar_Pervasives_Native.fst x) in (uu___4, (FStar_Pervasives_Native.snd x))) effect_args in - let uu___4 = - FStarC_Compiler_List.map (translate_flag cfg bs) flags in + let uu___4 = FStarC_List.map (translate_flag cfg bs) flags in { FStarC_TypeChecker_NBETerm.comp_univs = uu___1; FStarC_TypeChecker_NBETerm.effect_name = effect_name; @@ -2227,13 +2197,13 @@ and (readback_comp_typ : fun c -> let uu___ = readback cfg c.FStarC_TypeChecker_NBETerm.result_typ in let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___2 = readback cfg (FStar_Pervasives_Native.fst x) in (uu___2, (FStar_Pervasives_Native.snd x))) c.FStarC_TypeChecker_NBETerm.effect_args in let uu___2 = - FStarC_Compiler_List.map (readback_flag cfg) + FStarC_List.map (readback_flag cfg) c.FStarC_TypeChecker_NBETerm.flags in { FStarC_Syntax_Syntax.comp_univs = @@ -2262,10 +2232,9 @@ and (translate_residual_comp : if ((cfg.core_cfg).FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.for_extraction then FStar_Pervasives_Native.None - else - FStarC_Compiler_Util.map_opt residual_typ (translate cfg bs) in + else FStarC_Util.map_opt residual_typ (translate cfg bs) in let uu___2 = - FStarC_Compiler_List.map (translate_flag cfg bs) residual_flags in + FStarC_List.map (translate_flag cfg bs) residual_flags in { FStarC_TypeChecker_NBETerm.residual_effect = residual_effect; FStarC_TypeChecker_NBETerm.residual_typ = uu___1; @@ -2279,17 +2248,15 @@ and (readback_residual_comp : fun cfg -> fun c -> let uu___ = - FStarC_Compiler_Util.map_opt - c.FStarC_TypeChecker_NBETerm.residual_typ + FStarC_Util.map_opt c.FStarC_TypeChecker_NBETerm.residual_typ (fun x -> debug cfg (fun uu___2 -> let uu___3 = FStarC_TypeChecker_NBETerm.t_to_string x in - FStarC_Compiler_Util.print1 - "Reading back residualtype %s\n" uu___3); + FStarC_Util.print1 "Reading back residualtype %s\n" uu___3); readback cfg x) in let uu___1 = - FStarC_Compiler_List.map (readback_flag cfg) + FStarC_List.map (readback_flag cfg) c.FStarC_TypeChecker_NBETerm.residual_flags in { FStarC_Syntax_Syntax.residual_effect = @@ -2322,7 +2289,7 @@ and (translate_flag : | FStarC_Syntax_Syntax.CPS -> FStarC_TypeChecker_NBETerm.CPS | FStarC_Syntax_Syntax.DECREASES (FStarC_Syntax_Syntax.Decreases_lex l) -> - let uu___ = FStarC_Compiler_List.map (translate cfg bs) l in + let uu___ = FStarC_List.map (translate cfg bs) l in FStarC_TypeChecker_NBETerm.DECREASES_lex uu___ | FStarC_Syntax_Syntax.DECREASES (FStarC_Syntax_Syntax.Decreases_wf (rel, e)) -> @@ -2350,7 +2317,7 @@ and (readback_flag : | FStarC_TypeChecker_NBETerm.CPS -> FStarC_Syntax_Syntax.CPS | FStarC_TypeChecker_NBETerm.DECREASES_lex l -> let uu___ = - let uu___1 = FStarC_Compiler_List.map (readback cfg) l in + let uu___1 = FStarC_List.map (readback cfg) l in FStarC_Syntax_Syntax.Decreases_lex uu___1 in FStarC_Syntax_Syntax.DECREASES uu___ | FStarC_TypeChecker_NBETerm.DECREASES_wf (rel, e) -> @@ -2390,7 +2357,7 @@ and (translate_monadic : | FStar_Pervasives_Native.None -> let uu___2 = let uu___3 = FStarC_Ident.string_of_lid m in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect declaration not found: %s" uu___3 in failwith uu___2 | FStar_Pervasives_Native.Some (ed, q) -> @@ -2408,7 +2375,7 @@ and (translate_monadic : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.left + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.mk_binder uu___6 in [uu___5] in @@ -2423,7 +2390,7 @@ and (translate_monadic : body.FStarC_Syntax_Syntax.pos in let maybe_range_arg = let uu___2 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_TypeChecker_TermEqAndSimplify.eq_tm_bool (cfg.core_cfg).FStarC_TypeChecker_Cfg.tcenv FStarC_Syntax_Util.dm4f_bind_range_attr) @@ -2460,7 +2427,7 @@ and (translate_monadic : let uu___6 = let uu___7 = FStarC_Syntax_Util.get_bind_repr ed in - FStarC_Compiler_Util.must uu___7 in + FStarC_Util.must uu___7 in FStar_Pervasives_Native.snd uu___6 in FStarC_Syntax_Util.un_uinst uu___5 in translate cfg' [] uu___4 in @@ -2508,16 +2475,15 @@ and (translate_monadic : uu___8 :: uu___9 in ((mk_t FStarC_TypeChecker_NBETerm.Unknown), FStar_Pervasives_Native.None) :: uu___7 in - FStarC_Compiler_List.op_At maybe_range_arg - uu___6 in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.op_At maybe_range_arg uu___6 in + FStarC_List.op_At uu___4 uu___5 in iapp cfg uu___2 uu___3 in (debug cfg (fun uu___3 -> let uu___4 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.print1 - "translate_monadic: %s\n" uu___4); + FStarC_Util.print1 "translate_monadic: %s\n" + uu___4); t)) | FStarC_Syntax_Syntax.Tm_app { @@ -2547,7 +2513,7 @@ and (translate_monadic : (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) args in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "translate_monadic app (%s) @ (%s)\n" uu___3 uu___4); (let fallback1 uu___2 = translate cfg bs e1 in @@ -2586,7 +2552,7 @@ and (translate_monadic : (cfg.core_cfg).FStarC_TypeChecker_Cfg.delta_level (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v qninfo in - FStarC_Compiler_Option.isNone uu___6 in + FStarC_Option.isNone uu___6 in if uu___5 then fallback2 () else @@ -2606,7 +2572,7 @@ and (translate_monadic : FStarC_Syntax_Syntax.rc_opt1 = lopt;_} -> let branches1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (pat, wopt, tm) -> @@ -2640,7 +2606,7 @@ and (translate_monadic : let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term e1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unexpected case in translate_monadic: %s" uu___3 in failwith uu___2) and (translate_monadic_lift : @@ -2675,7 +2641,7 @@ and (translate_monadic_lift : let uu___4 = let uu___5 = let uu___6 = FStarC_Syntax_Util.get_return_repr ed in - FStarC_Compiler_Util.must uu___6 in + FStarC_Util.must uu___6 in FStar_Pervasives_Native.snd uu___5 in FStarC_Syntax_Subst.compress uu___4 in uu___3.FStarC_Syntax_Syntax.n in @@ -2710,8 +2676,8 @@ and (translate_monadic_lift : (debug cfg (fun uu___3 -> let uu___4 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.print1 - "translate_monadic_lift(1): %s\n" uu___4); + FStarC_Util.print1 "translate_monadic_lift(1): %s\n" + uu___4); t) else (let uu___3 = @@ -2722,7 +2688,7 @@ and (translate_monadic_lift : let uu___4 = let uu___5 = FStarC_Ident.string_of_lid msrc in let uu___6 = FStarC_Ident.string_of_lid mtgt in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible : trying to reify a lift between unrelated effects (%s and %s)" uu___5 uu___6 in failwith uu___4 @@ -2738,7 +2704,7 @@ and (translate_monadic_lift : let uu___8 = let uu___9 = FStarC_Ident.string_of_lid msrc in let uu___10 = FStarC_Ident.string_of_lid mtgt in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible : trying to reify a non-reifiable lift (from %s to %s)" uu___9 uu___10 in failwith uu___8 @@ -2777,7 +2743,7 @@ and (translate_monadic_lift : (fun uu___9 -> let uu___10 = FStarC_TypeChecker_NBETerm.t_to_string t in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "translate_monadic_lift(2): %s\n" uu___10); t)) and (readback : @@ -2801,7 +2767,7 @@ and (readback : debug1 (fun uu___1 -> let uu___2 = FStarC_TypeChecker_NBETerm.t_to_string x in - FStarC_Compiler_Util.print1 "Readback: %s\n" uu___2); + FStarC_Util.print1 "Readback: %s\n" uu___2); (match x.FStarC_TypeChecker_NBETerm.nbe_t with | FStarC_TypeChecker_NBETerm.Univ u -> failwith "Readback of universes should not occur" @@ -2838,7 +2804,7 @@ and (readback : r) -> FStarC_TypeChecker_Primops_Base.embed_simple FStarC_Syntax_Embeddings.e_real - x.FStarC_TypeChecker_NBETerm.nbe_r (FStarC_Compiler_Real.Real r) + x.FStarC_TypeChecker_NBETerm.nbe_r (FStarC_Real.Real r) | FStarC_TypeChecker_NBETerm.Constant (FStarC_TypeChecker_NBETerm.SConst c) -> mk (FStarC_Syntax_Syntax.Tm_constant c) @@ -2863,7 +2829,7 @@ and (readback : (match shape with | FStarC_TypeChecker_NBETerm.Lam_bs (ctx, binders, rc) -> let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun b -> match uu___2 with @@ -2915,14 +2881,14 @@ and (readback : translate_residual_comp cfg ctx1 rc2 in readback_residual_comp cfg uu___3 in FStar_Pervasives_Native.Some uu___2 in - let binders1 = FStarC_Compiler_List.rev binders_rev in + let binders1 = FStarC_List.rev binders_rev in let body = let uu___2 = f accus_rev in readback cfg uu___2 in let uu___2 = FStarC_Syntax_Util.abs binders1 body rc1 in with_range uu___2) | FStarC_TypeChecker_NBETerm.Lam_args args -> let uu___1 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___2 -> fun uu___3 -> match (uu___2, uu___3) with @@ -2956,7 +2922,7 @@ and (readback : (uu___6, uu___7)))) args ([], []) in (match uu___1 with | (binders, accus_rev) -> - let accus = FStarC_Compiler_List.rev accus_rev in + let accus = FStarC_List.rev accus_rev in let rc = FStar_Pervasives_Native.None in let body = let uu___2 = f accus_rev in readback cfg uu___2 in @@ -3009,7 +2975,7 @@ and (readback : let uu___1 = FStarC_Thunk.force f in with_range uu___1 | FStarC_TypeChecker_NBETerm.Arrow (FStar_Pervasives.Inr (args, c)) -> let binders = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (t, q) -> @@ -3043,8 +3009,7 @@ and (readback : FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_fvar fv) uu___1 in let app = let uu___1 = - FStarC_Syntax_Syntax.mk_Tm_uinst fv1 - (FStarC_Compiler_List.rev us) in + FStarC_Syntax_Syntax.mk_Tm_uinst fv1 (FStarC_List.rev us) in FStarC_Syntax_Util.mk_app uu___1 args1 in with_range app | FStarC_TypeChecker_NBETerm.FV (fv, us, args) -> @@ -3056,11 +3021,10 @@ and (readback : args in let fv1 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_fvar fv) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let app = let uu___1 = - FStarC_Syntax_Syntax.mk_Tm_uinst fv1 - (FStarC_Compiler_List.rev us) in + FStarC_Syntax_Syntax.mk_Tm_uinst fv1 (FStarC_List.rev us) in FStarC_Syntax_Util.mk_app uu___1 args1 in let uu___1 = if @@ -3134,8 +3098,7 @@ and (readback : FStarC_Syntax_Subst.close uu___1 uu___2 in let lbname = let uu___1 = - let uu___2 = - FStarC_Compiler_Util.left lb.FStarC_Syntax_Syntax.lbname in + let uu___2 = FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in { FStarC_Syntax_Syntax.ppname = (uu___2.FStarC_Syntax_Syntax.ppname); @@ -3162,7 +3125,7 @@ and (readback : { FStarC_Syntax_Syntax.lbs = (false, [lb1]); FStarC_Syntax_Syntax.body1 = body1 - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in let args1 = readback_args cfg args in let uu___1 = FStarC_Syntax_Util.mk_app hd args1 in with_range uu___1 @@ -3171,7 +3134,7 @@ and (readback : (vars_typs_defns, body, lbs), args) -> let lbs1 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___1 -> fun lb -> match uu___1 with @@ -3210,7 +3173,7 @@ and (readback : { FStarC_Syntax_Syntax.lbs = (true, lbs2); FStarC_Syntax_Syntax.body1 = body2 - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in let args1 = readback_args cfg args in let uu___2 = FStarC_Syntax_Util.mk_app hd args1 in with_range uu___2) @@ -3221,28 +3184,25 @@ and (readback : let uu___1 = FStarC_Syntax_Util.mk_app hd args1 in with_range uu___1 | FStarC_TypeChecker_NBETerm.TopLevelLet (lb, arity, args_rev) -> - let n_univs = - FStarC_Compiler_List.length lb.FStarC_Syntax_Syntax.lbunivs in - let n_args = FStarC_Compiler_List.length args_rev in - let uu___1 = - FStarC_Compiler_Util.first_N (n_args - n_univs) args_rev in + let n_univs = FStarC_List.length lb.FStarC_Syntax_Syntax.lbunivs in + let n_args = FStarC_List.length args_rev in + let uu___1 = FStarC_Util.first_N (n_args - n_univs) args_rev in (match uu___1 with | (args_rev1, univs) -> let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - univs in + FStarC_List.map FStar_Pervasives_Native.fst univs in translate cfg uu___4 lb.FStarC_Syntax_Syntax.lbdef in - iapp cfg uu___3 (FStarC_Compiler_List.rev args_rev1) in + iapp cfg uu___3 (FStarC_List.rev args_rev1) in readback cfg uu___2) | FStarC_TypeChecker_NBETerm.TopLevelRec (lb, uu___1, uu___2, args) -> - let fv = FStarC_Compiler_Util.right lb.FStarC_Syntax_Syntax.lbname in + let fv = FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let head = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_fvar fv) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let args1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (t, q) -> let uu___4 = readback cfg t in (uu___4, q)) @@ -3252,13 +3212,12 @@ and (readback : | FStarC_TypeChecker_NBETerm.LocalLetRec (i, uu___1, lbs, bs, args, _ar, _ar_lst) -> let lbnames = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_Util.left - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in uu___4.FStarC_Syntax_Syntax.ppname in FStarC_Ident.string_of_id uu___3 in FStarC_Syntax_Syntax.gen_bv uu___2 @@ -3266,15 +3225,15 @@ and (readback : lb.FStarC_Syntax_Syntax.lbtyp) lbs in let let_rec_env = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun x1 -> let uu___3 = FStarC_Syntax_Syntax.range_of_bv x1 in mk_rt uu___3 (FStarC_TypeChecker_NBETerm.Accu ((FStarC_TypeChecker_NBETerm.Var x1), []))) lbnames in - FStarC_Compiler_List.rev_append uu___2 bs in + FStarC_List.rev_append uu___2 bs in let lbs1 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun lb -> fun lbname -> let lbdef = @@ -3301,7 +3260,7 @@ and (readback : (lb.FStarC_Syntax_Syntax.lbpos) }) lbs lbnames in let body = - let uu___2 = FStarC_Compiler_List.nth lbnames i in + let uu___2 = FStarC_List.nth lbnames i in FStarC_Syntax_Syntax.bv_to_name uu___2 in let uu___2 = FStarC_Syntax_Subst.close_let_rec lbs1 body in (match uu___2 with @@ -3312,9 +3271,9 @@ and (readback : { FStarC_Syntax_Syntax.lbs = (true, lbs2); FStarC_Syntax_Syntax.body1 = body1 - }) FStarC_Compiler_Range_Type.dummyRange in + }) FStarC_Range_Type.dummyRange in let args1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (x1, q) -> @@ -3370,6 +3329,8 @@ let (normalize : (uu___.FStarC_TypeChecker_Cfg.unfold_until); FStarC_TypeChecker_Cfg.unfold_only = (uu___.FStarC_TypeChecker_Cfg.unfold_only); + FStarC_TypeChecker_Cfg.unfold_once = + (uu___.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = (uu___.FStarC_TypeChecker_Cfg.unfold_fully); FStarC_TypeChecker_Cfg.unfold_attr = @@ -3434,24 +3395,24 @@ let (normalize : (cfg.FStarC_TypeChecker_Cfg.compat_memo_ignore_cfg) } in (let uu___1 = - (FStarC_Compiler_Effect.op_Bang dbg_NBETop) || - (FStarC_Compiler_Effect.op_Bang dbg_NBE) in + (FStarC_Effect.op_Bang dbg_NBETop) || + (FStarC_Effect.op_Bang dbg_NBE) in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print1 "Calling NBE with (%s) {\n" uu___2 + FStarC_Util.print1 "Calling NBE with (%s) {\n" uu___2 else ()); (let cfg2 = new_config cfg1 in let r = let uu___1 = translate cfg2 [] e in readback cfg2 uu___1 in (let uu___2 = - (FStarC_Compiler_Effect.op_Bang dbg_NBETop) || - (FStarC_Compiler_Effect.op_Bang dbg_NBE) in + (FStarC_Effect.op_Bang dbg_NBETop) || + (FStarC_Effect.op_Bang dbg_NBE) in if uu___2 then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term r in - FStarC_Compiler_Util.print1 "}\nNBE returned (%s)\n" uu___3 + FStarC_Util.print1 "}\nNBE returned (%s)\n" uu___3 else ()); r) let (normalize_for_unit_test : @@ -3488,6 +3449,8 @@ let (normalize_for_unit_test : (uu___.FStarC_TypeChecker_Cfg.unfold_until); FStarC_TypeChecker_Cfg.unfold_only = (uu___.FStarC_TypeChecker_Cfg.unfold_only); + FStarC_TypeChecker_Cfg.unfold_once = + (uu___.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = (uu___.FStarC_TypeChecker_Cfg.unfold_fully); FStarC_TypeChecker_Cfg.unfold_attr = @@ -3554,11 +3517,11 @@ let (normalize_for_unit_test : (fun uu___1 -> let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print1 "Calling NBE with (%s) {\n" uu___2); + FStarC_Util.print1 "Calling NBE with (%s) {\n" uu___2); (let r = let uu___1 = translate cfg2 [] e in readback cfg2 uu___1 in debug cfg2 (fun uu___2 -> let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term r in - FStarC_Compiler_Util.print1 "}\nNBE returned (%s)\n" uu___3); + FStarC_Util.print1 "}\nNBE returned (%s)\n" uu___3); r) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_NBETerm.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_NBETerm.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_NBETerm.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_NBETerm.ml index f1e7d4e8d7f..9163d73f85f 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_NBETerm.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_NBETerm.ml @@ -6,9 +6,9 @@ type constant = | Unit | Bool of Prims.bool | Int of FStarC_BigInt.t - | String of (Prims.string * FStarC_Compiler_Range_Type.range) + | String of (Prims.string * FStarC_Range_Type.range) | Char of FStar_Char.char - | Range of FStarC_Compiler_Range_Type.range + | Range of FStarC_Range_Type.range | SConst of FStarC_Const.sconst | Real of Prims.string let (uu___is_Unit : constant -> Prims.bool) = @@ -24,7 +24,7 @@ let (__proj__Int__item___0 : constant -> FStarC_BigInt.t) = let (uu___is_String : constant -> Prims.bool) = fun projectee -> match projectee with | String _0 -> true | uu___ -> false let (__proj__String__item___0 : - constant -> (Prims.string * FStarC_Compiler_Range_Type.range)) = + constant -> (Prims.string * FStarC_Range_Type.range)) = fun projectee -> match projectee with | String _0 -> _0 let (uu___is_Char : constant -> Prims.bool) = fun projectee -> match projectee with | Char _0 -> true | uu___ -> false @@ -32,8 +32,8 @@ let (__proj__Char__item___0 : constant -> FStar_Char.char) = fun projectee -> match projectee with | Char _0 -> _0 let (uu___is_Range : constant -> Prims.bool) = fun projectee -> match projectee with | Range _0 -> true | uu___ -> false -let (__proj__Range__item___0 : constant -> FStarC_Compiler_Range_Type.range) - = fun projectee -> match projectee with | Range _0 -> _0 +let (__proj__Range__item___0 : constant -> FStarC_Range_Type.range) = + fun projectee -> match projectee with | Range _0 -> _0 let (uu___is_SConst : constant -> Prims.bool) = fun projectee -> match projectee with | SConst _0 -> true | uu___ -> false let (__proj__SConst__item___0 : constant -> FStarC_Const.sconst) = @@ -97,7 +97,7 @@ and t' = FStarC_Syntax_Syntax.aqual) Prims.list * Prims.int * Prims.bool Prims.list) and t = { nbe_t: t' ; - nbe_r: FStarC_Compiler_Range_Type.range } + nbe_r: FStarC_Range_Type.range } and comp = | Tot of t | GTot of t @@ -295,7 +295,7 @@ let (__proj__LocalLetRec__item___0 : = fun projectee -> match projectee with | LocalLetRec _0 -> _0 let (__proj__Mkt__item__nbe_t : t -> t') = fun projectee -> match projectee with | { nbe_t; nbe_r;_} -> nbe_t -let (__proj__Mkt__item__nbe_r : t -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mkt__item__nbe_r : t -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { nbe_t; nbe_r;_} -> nbe_r let (uu___is_Tot : comp -> Prims.bool) = fun projectee -> match projectee with | Tot _0 -> true | uu___ -> false @@ -389,10 +389,9 @@ let (isAccu : t -> Prims.bool) = fun trm -> match trm.nbe_t with | Accu uu___ -> true | uu___ -> false let (isNotAccu : t -> Prims.bool) = fun x -> match x.nbe_t with | Accu (uu___, uu___1) -> false | uu___ -> true -let (mk_rt : FStarC_Compiler_Range_Type.range -> t' -> t) = +let (mk_rt : FStarC_Range_Type.range -> t' -> t) = fun r -> fun t1 -> { nbe_t = t1; nbe_r = r } -let (mk_t : t' -> t) = - fun t1 -> mk_rt FStarC_Compiler_Range_Type.dummyRange t1 +let (mk_t : t' -> t) = fun t1 -> mk_rt FStarC_Range_Type.dummyRange t1 let (nbe_t_of_t : t -> t') = fun t1 -> t1.nbe_t let (mkConstruct : FStarC_Syntax_Syntax.fv -> @@ -495,9 +494,7 @@ let rec (eq_t : let uu___ = FStarC_Syntax_Syntax.fv_eq v1 v2 in if uu___ then - (if - (FStarC_Compiler_List.length args1) <> - (FStarC_Compiler_List.length args2) + (if (FStarC_List.length args1) <> (FStarC_List.length args2) then failwith "eq_t, different number of args on Construct" else (); (let uu___2 = @@ -508,10 +505,10 @@ let rec (eq_t : | FStar_Pervasives_Native.None -> FStarC_TypeChecker_TermEqAndSimplify.Unknown | FStar_Pervasives_Native.Some n -> - if n <= (FStarC_Compiler_List.length args1) + if n <= (FStarC_List.length args1) then let eq_args1 as1 as2 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun acc -> fun uu___3 -> fun uu___4 -> @@ -520,10 +517,10 @@ let rec (eq_t : let uu___7 = eq_t env a1 a2 in eq_inj acc uu___7) FStarC_TypeChecker_TermEqAndSimplify.Equal as1 as2 in - let uu___3 = FStarC_Compiler_List.splitAt n args1 in + let uu___3 = FStarC_List.splitAt n args1 in (match uu___3 with | (parms1, args11) -> - let uu___4 = FStarC_Compiler_List.splitAt n args2 in + let uu___4 = FStarC_List.splitAt n args2 in (match uu___4 with | (parms2, args21) -> eq_args1 args11 args21)) else FStarC_TypeChecker_TermEqAndSimplify.Unknown)) @@ -595,21 +592,19 @@ let (constant_to_string : constant -> Prims.string) = | Unit -> "Unit" | Bool b -> if b then "Bool true" else "Bool false" | Int i -> FStarC_BigInt.string_of_big_int i - | Char c1 -> - FStarC_Compiler_Util.format1 "'%s'" - (FStarC_Compiler_Util.string_of_char c1) - | String (s, uu___) -> FStarC_Compiler_Util.format1 "\"%s\"" s + | Char c1 -> FStarC_Util.format1 "'%s'" (FStarC_Util.string_of_char c1) + | String (s, uu___) -> FStarC_Util.format1 "\"%s\"" s | Range r -> - let uu___ = FStarC_Compiler_Range_Ops.string_of_range r in - FStarC_Compiler_Util.format1 "Range %s" uu___ + let uu___ = FStarC_Range_Ops.string_of_range r in + FStarC_Util.format1 "Range %s" uu___ | SConst s -> FStarC_Class_Show.show FStarC_Syntax_Print.showable_const s - | Real s -> FStarC_Compiler_Util.format1 "Real %s" s + | Real s -> FStarC_Util.format1 "Real %s" s let rec (t_to_string : t -> Prims.string) = fun x -> match x.nbe_t with | Lam { interp = b; shape = uu___; arity;_} -> - let uu___1 = FStarC_Compiler_Util.string_of_int arity in - FStarC_Compiler_Util.format1 "Lam (_, %s args)" uu___1 + let uu___1 = FStarC_Util.string_of_int arity in + FStarC_Util.format1 "Lam (_, %s args)" uu___1 | Accu (a, l) -> let uu___ = let uu___1 = atom_to_string a in @@ -617,10 +612,10 @@ let rec (t_to_string : t -> Prims.string) = let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun x1 -> t_to_string (FStar_Pervasives_Native.fst x1)) l in - FStarC_Compiler_String.concat "; " uu___5 in + FStarC_String.concat "; " uu___5 in Prims.strcat uu___4 ")" in Prims.strcat ") (" uu___3 in Prims.strcat uu___1 uu___2 in @@ -633,18 +628,18 @@ let rec (t_to_string : t -> Prims.string) = let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ) us in - FStarC_Compiler_String.concat "; " uu___5 in + FStarC_String.concat "; " uu___5 in let uu___5 = let uu___6 = let uu___7 = let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map (fun x1 -> t_to_string (FStar_Pervasives_Native.fst x1)) l in - FStarC_Compiler_String.concat "; " uu___8 in + FStarC_String.concat "; " uu___8 in Prims.strcat uu___7 "]" in Prims.strcat "] [" uu___6 in Prims.strcat uu___4 uu___5 in @@ -659,18 +654,18 @@ let rec (t_to_string : t -> Prims.string) = let uu___3 = let uu___4 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ) us in - FStarC_Compiler_String.concat "; " uu___5 in + FStarC_String.concat "; " uu___5 in let uu___5 = let uu___6 = let uu___7 = let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map (fun x1 -> t_to_string (FStar_Pervasives_Native.fst x1)) l in - FStarC_Compiler_String.concat "; " uu___8 in + FStarC_String.concat "; " uu___8 in Prims.strcat uu___7 "]" in Prims.strcat "] [" uu___6 in Prims.strcat uu___4 uu___5 in @@ -717,11 +712,11 @@ let rec (t_to_string : t -> Prims.string) = let uu___1 = let uu___2 = FStarC_Syntax_Util.unfold_lazy li in FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___2 in - FStarC_Compiler_Util.format1 "Lazy (Inl {%s})" uu___1 + FStarC_Util.format1 "Lazy (Inl {%s})" uu___1 | Lazy (FStar_Pervasives.Inr (uu___, et), uu___1) -> let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ et in - FStarC_Compiler_Util.format1 "Lazy (Inr (?, %s))" uu___2 + FStarC_Util.format1 "Lazy (Inr (?, %s))" uu___2 | LocalLetRec (uu___, l, uu___1, uu___2, uu___3, uu___4, uu___5) -> let uu___6 = let uu___7 = @@ -734,16 +729,14 @@ let rec (t_to_string : t -> Prims.string) = | TopLevelLet (lb, uu___, uu___1) -> let uu___2 = let uu___3 = - let uu___4 = - FStarC_Compiler_Util.right lb.FStarC_Syntax_Syntax.lbname in + let uu___4 = FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv uu___4 in Prims.strcat uu___3 ")" in Prims.strcat "TopLevelLet (" uu___2 | TopLevelRec (lb, uu___, uu___1, uu___2) -> let uu___3 = let uu___4 = - let uu___5 = - FStarC_Compiler_Util.right lb.FStarC_Syntax_Syntax.lbname in + let uu___5 = FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv uu___5 in Prims.strcat uu___4 ")" in Prims.strcat "TopLevelRec (" uu___3 @@ -784,8 +777,8 @@ let (arg_to_string : arg -> Prims.string) = fun a -> t_to_string (FStar_Pervasives_Native.fst a) let (args_to_string : args -> Prims.string) = fun args1 -> - let uu___ = FStarC_Compiler_List.map arg_to_string args1 in - FStarC_Compiler_String.concat " " uu___ + let uu___ = FStarC_List.map arg_to_string args1 in + FStarC_String.concat " " uu___ let (showable_t : t FStarC_Class_Show.showable) = { FStarC_Class_Show.show = t_to_string } let (showable_args : args FStarC_Class_Show.showable) = @@ -880,7 +873,7 @@ let embed_as : (fun cbs -> fun t1 -> let uu___ = unembed ea cbs t1 in - FStarC_Compiler_Util.map_opt uu___ ab) + FStarC_Util.map_opt uu___ ab) (fun uu___ -> match ot with | FStar_Pervasives_Native.Some t1 -> t1 @@ -917,18 +910,16 @@ let lazy_embed : fun et -> fun x -> fun f -> - (let uu___1 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + (let uu___1 = FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___1 then let uu___2 = let uu___3 = et () in FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ uu___3 in - FStarC_Compiler_Util.print1 "Embedding\n\temb_typ=%s\n" uu___2 + FStarC_Util.print1 "Embedding\n\temb_typ=%s\n" uu___2 else ()); - (let uu___1 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.eager_embedding in + (let uu___1 = FStarC_Effect.op_Bang FStarC_Options.eager_embedding in if uu___1 then f () else @@ -953,14 +944,12 @@ let lazy_unembed : | Lazy (FStar_Pervasives.Inr (b, et'), thunk) -> let uu___ = (let uu___1 = et () in uu___1 <> et') || - (FStarC_Compiler_Effect.op_Bang - FStarC_Options.eager_embedding) in + (FStarC_Effect.op_Bang FStarC_Options.eager_embedding) in if uu___ then let res = let uu___1 = FStarC_Thunk.force thunk in f uu___1 in ((let uu___2 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___2 then let uu___3 = @@ -970,37 +959,34 @@ let lazy_unembed : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ et' in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Unembed cancellation failed\n\t%s <> %s\n" uu___3 uu___4 else ()); res) else (let a1 = FStarC_Dyn.undyn b in (let uu___3 = - FStarC_Compiler_Effect.op_Bang - FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___3 then let uu___4 = let uu___5 = et () in FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ uu___5 in - FStarC_Compiler_Util.print1 "Unembed cancelled for %s\n" - uu___4 + FStarC_Util.print1 "Unembed cancelled for %s\n" uu___4 else ()); FStar_Pervasives_Native.Some a1) | uu___ -> let aopt = f x in ((let uu___2 = - FStarC_Compiler_Effect.op_Bang FStarC_Options.debug_embedding in + FStarC_Effect.op_Bang FStarC_Options.debug_embedding in if uu___2 then let uu___3 = let uu___4 = et () in FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_emb_typ uu___4 in - FStarC_Compiler_Util.print1 "Unembedding:\n\temb_typ=%s\n" - uu___3 + FStarC_Util.print1 "Unembedding:\n\temb_typ=%s\n" uu___3 else ()); aopt) let lazy_unembed_lazy_kind : @@ -1059,8 +1045,7 @@ let (e_char : FStar_String.char embedding) = (fun uu___ -> lid_as_typ FStarC_Parser_Const.char_lid [] []) (FStarC_Syntax_Embeddings_Base.emb_typ_of FStarC_Syntax_Embeddings.e_char) let (e_string : Prims.string embedding) = - let em1 _cb s = - Constant (String (s, FStarC_Compiler_Range_Type.dummyRange)) in + let em1 _cb s = Constant (String (s, FStarC_Range_Type.dummyRange)) in let un1 _cb s = match s with | Constant (String (s1, uu___)) -> FStar_Pervasives_Native.Some s1 @@ -1078,13 +1063,12 @@ let (e_int : FStarC_BigInt.t embedding) = mk_emb' em1 un1 (fun uu___ -> lid_as_typ FStarC_Parser_Const.int_lid [] []) (FStarC_Syntax_Embeddings_Base.emb_typ_of FStarC_Syntax_Embeddings.e_fsint) -let (e_real : FStarC_Compiler_Real.real embedding) = +let (e_real : FStarC_Real.real embedding) = let em1 _cb uu___ = - match uu___ with | FStarC_Compiler_Real.Real c -> Constant (Real c) in + match uu___ with | FStarC_Real.Real c -> Constant (Real c) in let un1 _cb c = match c with - | Constant (Real a) -> - FStar_Pervasives_Native.Some (FStarC_Compiler_Real.Real a) + | Constant (Real a) -> FStar_Pervasives_Native.Some (FStarC_Real.Real a) | uu___ -> FStar_Pervasives_Native.None in mk_emb' em1 un1 (fun uu___ -> lid_as_typ FStarC_Parser_Const.real_lid [] []) @@ -1133,7 +1117,7 @@ let e_option : FStarC_Parser_Const.some_lid -> let uu___2 = unembed ea cb a1 in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun a2 -> FStar_Pervasives_Native.Some (FStar_Pervasives_Native.Some a2)) @@ -1753,7 +1737,7 @@ let e_either : FStarC_Parser_Const.inl_lid -> let uu___3 = unembed ea cb a1 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun a2 -> FStar_Pervasives_Native.Some (FStar_Pervasives.Inl a2)) | Construct (fvar, us, (b1, uu___)::uu___1::uu___2::[]) when @@ -1761,7 +1745,7 @@ let e_either : FStarC_Parser_Const.inr_lid -> let uu___3 = unembed eb cb b1 in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun b2 -> FStar_Pervasives_Native.Some (FStar_Pervasives.Inr b2)) | uu___ -> FStar_Pervasives_Native.None) in @@ -1776,7 +1760,7 @@ let e_either : lid_as_typ FStarC_Parser_Const.either_lid [FStarC_Syntax_Syntax.U_zero; FStarC_Syntax_Syntax.U_zero] uu___1) etyp -let (e___range : FStarC_Compiler_Range_Type.range embedding) = +let (e___range : FStarC_Range_Type.range embedding) = let em1 cb r = Constant (Range r) in let un1 cb t1 = match t1 with @@ -1786,8 +1770,7 @@ let (e___range : FStarC_Compiler_Range_Type.range embedding) = (fun uu___ -> lid_as_typ FStarC_Parser_Const.__range_lid [] []) (FStarC_Syntax_Embeddings_Base.emb_typ_of FStarC_Syntax_Embeddings.e_range) -let e_sealed : - 'a . 'a embedding -> 'a FStarC_Compiler_Sealed.sealed embedding = +let e_sealed : 'a . 'a embedding -> 'a FStarC_Sealed.sealed embedding = fun ea -> let etyp uu___ = let uu___1 = @@ -1800,7 +1783,7 @@ let e_sealed : (fun uu___ -> let uu___1 = let uu___2 = - let uu___3 = embed ea cb (FStarC_Compiler_Sealed.unseal x) in + let uu___3 = embed ea cb (FStarC_Sealed.unseal x) in as_arg uu___3 in let uu___3 = let uu___4 = let uu___5 = type_of ea in as_iarg uu___5 in @@ -1823,7 +1806,7 @@ let e_sealed : FStarC_Class_Monad.fmap FStarC_Class_Monad.monad_option () () (fun uu___3 -> - (Obj.magic FStarC_Compiler_Sealed.seal) uu___3) + (Obj.magic FStarC_Sealed.seal) uu___3) (Obj.magic uu___2))) | uu___ -> Obj.magic (Obj.repr FStar_Pervasives_Native.None)) uu___) in @@ -1833,9 +1816,9 @@ let e_sealed : let uu___2 = let uu___3 = type_of ea in as_arg uu___3 in [uu___2] in lid_as_typ FStarC_Parser_Const.sealed_lid [FStarC_Syntax_Syntax.U_zero] uu___1) etyp -let (e_range : FStarC_Compiler_Range_Type.range embedding) = - embed_as (e_sealed e___range) FStarC_Compiler_Sealed.unseal - FStarC_Compiler_Sealed.seal FStar_Pervasives_Native.None +let (e_range : FStarC_Range_Type.range embedding) = + embed_as (e_sealed e___range) FStarC_Sealed.unseal FStarC_Sealed.seal + FStar_Pervasives_Native.None let (e_issue : FStarC_Errors.issue embedding) = let t_issue = FStarC_Syntax_Embeddings_Base.type_of FStarC_Syntax_Embeddings.e_issue in @@ -1850,7 +1833,7 @@ let (e_issue : FStarC_Errors.issue embedding) = let em1 cb iss = let uu___ = let uu___1 = - let uu___2 = li iss FStarC_Compiler_Range_Type.dummyRange in + let uu___2 = li iss FStarC_Range_Type.dummyRange in FStar_Pervasives.Inl uu___2 in let uu___2 = FStarC_Thunk.mk (fun uu___3 -> failwith "Cannot unembed issue") in @@ -1887,7 +1870,7 @@ let (e_document : FStarC_Pprint.document embedding) = let em1 cb doc = let uu___ = let uu___1 = - let uu___2 = li doc FStarC_Compiler_Range_Type.dummyRange in + let uu___2 = li doc FStarC_Range_Type.dummyRange in FStar_Pervasives.Inl uu___2 in let uu___2 = FStarC_Thunk.mk (fun uu___3 -> failwith "Cannot unembed document") in @@ -1940,7 +1923,7 @@ let e_list : 'a . 'a embedding -> 'a Prims.list embedding = uu___2 :: uu___3 in lid_as_constr FStarC_Parser_Const.cons_lid [FStarC_Syntax_Syntax.U_zero] uu___1 in - FStarC_Compiler_List.fold_right cons l nil) in + FStarC_List.fold_right cons l nil) in let rec un1 cb trm = lazy_unembed etyp trm (fun trm1 -> @@ -1959,10 +1942,10 @@ let e_list : 'a . 'a embedding -> 'a Prims.list embedding = FStarC_Syntax_Syntax.fv_eq_lid fv FStarC_Parser_Const.cons_lid -> let uu___3 = unembed ea cb hd in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun hd1 -> let uu___4 = un1 cb tl in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun tl1 -> FStar_Pervasives_Native.Some (hd1 :: tl1))) | Construct (fv, uu___, @@ -1972,10 +1955,10 @@ let e_list : 'a . 'a embedding -> 'a Prims.list embedding = FStarC_Syntax_Syntax.fv_eq_lid fv FStarC_Parser_Const.cons_lid -> let uu___1 = unembed ea cb hd in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun hd1 -> let uu___2 = un1 cb tl in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun tl1 -> FStar_Pervasives_Native.Some (hd1 :: tl1))) | uu___ -> FStar_Pervasives_Native.None) in mk_emb em1 un1 @@ -2008,7 +1991,7 @@ let e_arrow : 'a 'b . 'a embedding -> 'b embedding -> ('a -> 'b) embedding = (fun tas -> let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_List.hd tas in + let uu___6 = FStarC_List.hd tas in FStar_Pervasives_Native.fst uu___6 in unembed ea cb uu___5 in match uu___4 with @@ -2198,7 +2181,7 @@ let (e_norm_step : FStar_Pervasives.norm_step embedding) = FStarC_Parser_Const.steps_unfoldonly -> let uu___2 = unembed (e_list e_string) cb l in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldOnly ss)) | FV (fv, uu___, (l, uu___1)::[]) when @@ -2206,7 +2189,7 @@ let (e_norm_step : FStar_Pervasives.norm_step embedding) = FStarC_Parser_Const.steps_unfoldfully -> let uu___2 = unembed (e_list e_string) cb l in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldFully ss)) | FV (fv, uu___, (l, uu___1)::[]) when @@ -2214,7 +2197,7 @@ let (e_norm_step : FStar_Pervasives.norm_step embedding) = FStarC_Parser_Const.steps_unfoldattr -> let uu___2 = unembed (e_list e_string) cb l in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldAttr ss)) | FV (fv, uu___, (l, uu___1)::[]) when @@ -2222,7 +2205,7 @@ let (e_norm_step : FStar_Pervasives.norm_step embedding) = FStarC_Parser_Const.steps_unfoldqual -> let uu___2 = unembed (e_list e_string) cb l in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldQual ss)) | FV (fv, uu___, (l, uu___1)::[]) when @@ -2230,15 +2213,14 @@ let (e_norm_step : FStar_Pervasives.norm_step embedding) = FStarC_Parser_Const.steps_unfoldnamespace -> let uu___2 = unembed (e_list e_string) cb l in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun ss -> FStar_Pervasives_Native.Some (FStar_Pervasives.UnfoldNamespace ss)) | uu___ -> ((let uu___2 = let uu___3 = t_to_string t0 in - FStarC_Compiler_Util.format1 "Not an embedded norm_step: %s" - uu___3 in + FStarC_Util.format1 "Not an embedded norm_step: %s" uu___3 in FStarC_Errors.log_issue0 FStarC_Errors_Codes.Warning_NotEmbedded () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2)); @@ -2409,11 +2391,11 @@ let arrow_as_prim_step_1 : fun _fv_lid -> fun cb -> let f_wrapped _us args1 = - let uu___ = FStarC_Compiler_List.hd args1 in + let uu___ = FStarC_List.hd args1 in match uu___ with | (x, uu___1) -> let uu___2 = unembed ea cb x in - FStarC_Compiler_Util.map_opt uu___2 + FStarC_Util.map_opt uu___2 (fun x1 -> let uu___3 = f x1 in embed eb cb uu___3) in f_wrapped let arrow_as_prim_step_2 : @@ -2434,19 +2416,19 @@ let arrow_as_prim_step_2 : fun _fv_lid -> fun cb -> let f_wrapped _us args1 = - let uu___ = FStarC_Compiler_List.hd args1 in + let uu___ = FStarC_List.hd args1 in match uu___ with | (x, uu___1) -> let uu___2 = - let uu___3 = FStarC_Compiler_List.tl args1 in - FStarC_Compiler_List.hd uu___3 in + let uu___3 = FStarC_List.tl args1 in + FStarC_List.hd uu___3 in (match uu___2 with | (y, uu___3) -> let uu___4 = unembed ea cb x in - FStarC_Compiler_Util.bind_opt uu___4 + FStarC_Util.bind_opt uu___4 (fun x1 -> let uu___5 = unembed eb cb y in - FStarC_Compiler_Util.bind_opt uu___5 + FStarC_Util.bind_opt uu___5 (fun y1 -> let uu___6 = let uu___7 = f x1 y1 in @@ -2473,30 +2455,29 @@ let arrow_as_prim_step_3 : fun _fv_lid -> fun cb -> let f_wrapped _us args1 = - let uu___ = FStarC_Compiler_List.hd args1 in + let uu___ = FStarC_List.hd args1 in match uu___ with | (x, uu___1) -> let uu___2 = - let uu___3 = FStarC_Compiler_List.tl args1 in - FStarC_Compiler_List.hd uu___3 in + let uu___3 = FStarC_List.tl args1 in + FStarC_List.hd uu___3 in (match uu___2 with | (y, uu___3) -> let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_List.tl args1 in - FStarC_Compiler_List.tl uu___6 in - FStarC_Compiler_List.hd uu___5 in + let uu___6 = FStarC_List.tl args1 in + FStarC_List.tl uu___6 in + FStarC_List.hd uu___5 in (match uu___4 with | (z, uu___5) -> let uu___6 = unembed ea cb x in - FStarC_Compiler_Util.bind_opt uu___6 + FStarC_Util.bind_opt uu___6 (fun x1 -> let uu___7 = unembed eb cb y in - FStarC_Compiler_Util.bind_opt uu___7 + FStarC_Util.bind_opt uu___7 (fun y1 -> let uu___8 = unembed ec cb z in - FStarC_Compiler_Util.bind_opt - uu___8 + FStarC_Util.bind_opt uu___8 (fun z1 -> let uu___9 = let uu___10 = f x1 y1 z1 in @@ -2504,16 +2485,16 @@ let arrow_as_prim_step_3 : FStar_Pervasives_Native.Some uu___9))))) in f_wrapped -let (e_order : FStar_Order.order embedding) = +let (e_order : FStarC_Order.order embedding) = let ord_Lt_lid = FStarC_Ident.lid_of_path ["FStar"; "Order"; "Lt"] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let ord_Eq_lid = FStarC_Ident.lid_of_path ["FStar"; "Order"; "Eq"] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let ord_Gt_lid = FStarC_Ident.lid_of_path ["FStar"; "Order"; "Gt"] - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let ord_Lt = FStarC_Syntax_Syntax.tdataconstr ord_Lt_lid in let ord_Eq = FStarC_Syntax_Syntax.tdataconstr ord_Eq_lid in let ord_Gt = FStarC_Syntax_Syntax.tdataconstr ord_Gt_lid in @@ -2528,20 +2509,20 @@ let (e_order : FStar_Order.order embedding) = (FStar_Pervasives_Native.Some FStarC_Syntax_Syntax.Data_ctor) in let embed_order cb o = match o with - | FStar_Order.Lt -> mkConstruct ord_Lt_fv [] [] - | FStar_Order.Eq -> mkConstruct ord_Eq_fv [] [] - | FStar_Order.Gt -> mkConstruct ord_Gt_fv [] [] in + | FStarC_Order.Lt -> mkConstruct ord_Lt_fv [] [] + | FStarC_Order.Eq -> mkConstruct ord_Eq_fv [] [] + | FStarC_Order.Gt -> mkConstruct ord_Gt_fv [] [] in let unembed_order cb t1 = match t1.nbe_t with | Construct (fv, uu___, []) when FStarC_Syntax_Syntax.fv_eq_lid fv ord_Lt_lid -> - FStar_Pervasives_Native.Some FStar_Order.Lt + FStar_Pervasives_Native.Some FStarC_Order.Lt | Construct (fv, uu___, []) when FStarC_Syntax_Syntax.fv_eq_lid fv ord_Eq_lid -> - FStar_Pervasives_Native.Some FStar_Order.Eq + FStar_Pervasives_Native.Some FStarC_Order.Eq | Construct (fv, uu___, []) when FStarC_Syntax_Syntax.fv_eq_lid fv ord_Gt_lid -> - FStar_Pervasives_Native.Some FStar_Order.Gt + FStar_Pervasives_Native.Some FStarC_Order.Gt | uu___ -> FStar_Pervasives_Native.None in let fv_as_emb_typ fv = let uu___ = diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Normalize.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Normalize.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Normalize.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Normalize.ml index a69ab6d7624..b38bc1148c9 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Normalize.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Normalize.ml @@ -1,12 +1,12 @@ open Prims -let (dbg_univ_norm : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "univ_norm" -let (dbg_NormRebuild : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "NormRebuild" +let (dbg_univ_norm : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "univ_norm" +let (dbg_NormRebuild : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "NormRebuild" let (maybe_debug : FStarC_TypeChecker_Cfg.cfg -> FStarC_Syntax_Syntax.term -> - (FStarC_Syntax_Syntax.term * FStarC_Compiler_Util.time_ns) + (FStarC_Syntax_Syntax.term * FStarC_Util.time_ns) FStar_Pervasives_Native.option -> unit) = fun cfg -> @@ -17,10 +17,9 @@ let (maybe_debug : then match dbg with | FStar_Pervasives_Native.Some (tm, time_then) -> - let time_now = FStarC_Compiler_Util.now_ns () in + let time_now = FStarC_Util.now_ns () in let uu___ = - let uu___1 = - FStarC_Compiler_Util.time_diff_ms time_then time_now in + let uu___1 = FStarC_Util.time_diff_ms time_then time_now in FStarC_Class_Show.show FStarC_Class_Show.showable_int uu___1 in let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in @@ -29,7 +28,7 @@ let (maybe_debug : cfg in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Normalizer result timing (%s ms){\nOn term {\n%s\n}\nwith steps {%s}\nresult is{\n\n%s\n}\n}\n" uu___ uu___1 uu___2 uu___3 | uu___ -> () @@ -48,7 +47,7 @@ let cases : type 'a cfg_memo = (FStarC_TypeChecker_Cfg.cfg * 'a) FStarC_Syntax_Syntax.memo let fresh_memo : 'a . unit -> 'a FStarC_Syntax_Syntax.memo = - fun uu___ -> FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + fun uu___ -> FStarC_Util.mk_ref FStar_Pervasives_Native.None type closure = | Clos of ((FStarC_Syntax_Syntax.binder FStar_Pervasives_Native.option * closure * FStarC_Syntax_Syntax.subst_t FStarC_Syntax_Syntax.memo) @@ -87,7 +86,7 @@ let showable_memo : { FStarC_Class_Show.show = (fun m -> - let uu___1 = FStarC_Compiler_Effect.op_Bang m in + let uu___1 = FStarC_Effect.op_Bang m in match uu___1 with | FStar_Pervasives_Native.None -> "no_memo" | FStar_Pervasives_Native.Some x -> @@ -107,39 +106,36 @@ type branches = (FStarC_Syntax_Syntax.pat * FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option * FStarC_Syntax_Syntax.term) Prims.list type stack_elt = - | Arg of (closure * FStarC_Syntax_Syntax.aqual * - FStarC_Compiler_Range_Type.range) + | Arg of (closure * FStarC_Syntax_Syntax.aqual * FStarC_Range_Type.range) | UnivArgs of (FStarC_Syntax_Syntax.universe Prims.list * - FStarC_Compiler_Range_Type.range) + FStarC_Range_Type.range) | MemoLazy of (env * FStarC_Syntax_Syntax.term) cfg_memo | Match of (env * FStarC_Syntax_Syntax.match_returns_ascription FStar_Pervasives_Native.option * branches * FStarC_Syntax_Syntax.residual_comp FStar_Pervasives_Native.option * - FStarC_TypeChecker_Cfg.cfg * FStarC_Compiler_Range_Type.range) + FStarC_TypeChecker_Cfg.cfg * FStarC_Range_Type.range) | Abs of (env * FStarC_Syntax_Syntax.binders * env * FStarC_Syntax_Syntax.residual_comp FStar_Pervasives_Native.option * - FStarC_Compiler_Range_Type.range) + FStarC_Range_Type.range) | App of (env * FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.aqual * - FStarC_Compiler_Range_Type.range) + FStarC_Range_Type.range) | CBVApp of (env * FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.aqual * - FStarC_Compiler_Range_Type.range) - | Meta of (env * FStarC_Syntax_Syntax.metadata * - FStarC_Compiler_Range_Type.range) + FStarC_Range_Type.range) + | Meta of (env * FStarC_Syntax_Syntax.metadata * FStarC_Range_Type.range) | Let of (env * FStarC_Syntax_Syntax.binders * - FStarC_Syntax_Syntax.letbinding * FStarC_Compiler_Range_Type.range) + FStarC_Syntax_Syntax.letbinding * FStarC_Range_Type.range) let (uu___is_Arg : stack_elt -> Prims.bool) = fun projectee -> match projectee with | Arg _0 -> true | uu___ -> false let (__proj__Arg__item___0 : stack_elt -> - (closure * FStarC_Syntax_Syntax.aqual * FStarC_Compiler_Range_Type.range)) + (closure * FStarC_Syntax_Syntax.aqual * FStarC_Range_Type.range)) = fun projectee -> match projectee with | Arg _0 -> _0 let (uu___is_UnivArgs : stack_elt -> Prims.bool) = fun projectee -> match projectee with | UnivArgs _0 -> true | uu___ -> false let (__proj__UnivArgs__item___0 : stack_elt -> - (FStarC_Syntax_Syntax.universe Prims.list * - FStarC_Compiler_Range_Type.range)) + (FStarC_Syntax_Syntax.universe Prims.list * FStarC_Range_Type.range)) = fun projectee -> match projectee with | UnivArgs _0 -> _0 let (uu___is_MemoLazy : stack_elt -> Prims.bool) = fun projectee -> @@ -154,7 +150,7 @@ let (__proj__Match__item___0 : (env * FStarC_Syntax_Syntax.match_returns_ascription FStar_Pervasives_Native.option * branches * FStarC_Syntax_Syntax.residual_comp FStar_Pervasives_Native.option * - FStarC_TypeChecker_Cfg.cfg * FStarC_Compiler_Range_Type.range)) + FStarC_TypeChecker_Cfg.cfg * FStarC_Range_Type.range)) = fun projectee -> match projectee with | Match _0 -> _0 let (uu___is_Abs : stack_elt -> Prims.bool) = fun projectee -> match projectee with | Abs _0 -> true | uu___ -> false @@ -162,34 +158,34 @@ let (__proj__Abs__item___0 : stack_elt -> (env * FStarC_Syntax_Syntax.binders * env * FStarC_Syntax_Syntax.residual_comp FStar_Pervasives_Native.option * - FStarC_Compiler_Range_Type.range)) + FStarC_Range_Type.range)) = fun projectee -> match projectee with | Abs _0 -> _0 let (uu___is_App : stack_elt -> Prims.bool) = fun projectee -> match projectee with | App _0 -> true | uu___ -> false let (__proj__App__item___0 : stack_elt -> (env * FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.aqual * - FStarC_Compiler_Range_Type.range)) + FStarC_Range_Type.range)) = fun projectee -> match projectee with | App _0 -> _0 let (uu___is_CBVApp : stack_elt -> Prims.bool) = fun projectee -> match projectee with | CBVApp _0 -> true | uu___ -> false let (__proj__CBVApp__item___0 : stack_elt -> (env * FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.aqual * - FStarC_Compiler_Range_Type.range)) + FStarC_Range_Type.range)) = fun projectee -> match projectee with | CBVApp _0 -> _0 let (uu___is_Meta : stack_elt -> Prims.bool) = fun projectee -> match projectee with | Meta _0 -> true | uu___ -> false let (__proj__Meta__item___0 : stack_elt -> - (env * FStarC_Syntax_Syntax.metadata * FStarC_Compiler_Range_Type.range)) + (env * FStarC_Syntax_Syntax.metadata * FStarC_Range_Type.range)) = fun projectee -> match projectee with | Meta _0 -> _0 let (uu___is_Let : stack_elt -> Prims.bool) = fun projectee -> match projectee with | Let _0 -> true | uu___ -> false let (__proj__Let__item___0 : stack_elt -> (env * FStarC_Syntax_Syntax.binders * FStarC_Syntax_Syntax.letbinding * - FStarC_Compiler_Range_Type.range)) + FStarC_Range_Type.range)) = fun projectee -> match projectee with | Let _0 -> _0 type stack = stack_elt Prims.list let (head_of : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = @@ -220,11 +216,11 @@ let read_memo : = fun cfg -> fun r -> - let uu___ = FStarC_Compiler_Effect.op_Bang r in + let uu___ = FStarC_Effect.op_Bang r in match uu___ with | FStar_Pervasives_Native.Some (cfg', a1) when (cfg.FStarC_TypeChecker_Cfg.compat_memo_ignore_cfg || - (FStarC_Compiler_Util.physical_equality cfg cfg')) + (FStarC_Util.physical_equality cfg cfg')) || (cfg_equivalent cfg' cfg) -> FStar_Pervasives_Native.Some a1 | uu___1 -> FStar_Pervasives_Native.None @@ -240,24 +236,21 @@ let set_memo : if cfg.FStarC_TypeChecker_Cfg.memoize_lazy then ((let uu___1 = - let uu___2 = read_memo cfg r in - FStarC_Compiler_Option.isSome uu___2 in + let uu___2 = read_memo cfg r in FStarC_Option.isSome uu___2 in if uu___1 then failwith "Unexpected set_memo: thunk already evaluated" else ()); - FStarC_Compiler_Effect.op_Colon_Equals r + FStarC_Effect.op_Colon_Equals r (FStar_Pervasives_Native.Some (cfg, t))) else () let (closure_to_string : closure -> Prims.string) = fun uu___ -> match uu___ with | Clos (env1, t, uu___1, uu___2) -> - let uu___3 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length env1) in + let uu___3 = FStarC_Util.string_of_int (FStarC_List.length env1) in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 "(env=%s elts; %s)" uu___3 uu___4 + FStarC_Util.format2 "(env=%s elts; %s)" uu___3 uu___4 | Univ uu___1 -> "Univ" | Dummy -> "dummy" let (showable_closure : closure FStarC_Class_Show.showable) = @@ -269,23 +262,23 @@ let (showable_stack_elt : stack_elt FStarC_Class_Show.showable) = match uu___ with | Arg (c, uu___1, uu___2) -> let uu___3 = FStarC_Class_Show.show showable_closure c in - FStarC_Compiler_Util.format1 "Closure %s" uu___3 + FStarC_Util.format1 "Closure %s" uu___3 | MemoLazy uu___1 -> "MemoLazy" | Abs (uu___1, bs, uu___2, uu___3, uu___4) -> let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length bs) in - FStarC_Compiler_Util.format1 "Abs %s" uu___5 + (FStarC_List.length bs) in + FStarC_Util.format1 "Abs %s" uu___5 | UnivArgs uu___1 -> "UnivArgs" | Match uu___1 -> "Match" | App (uu___1, t, uu___2, uu___3) -> let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 "App %s" uu___4 + FStarC_Util.format1 "App %s" uu___4 | CBVApp (uu___1, t, uu___2, uu___3) -> let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 "CBVApp %s" uu___4 + FStarC_Util.format1 "CBVApp %s" uu___4 | Meta (uu___1, m, uu___2) -> "Meta" | Let uu___1 -> "Let") } @@ -298,8 +291,7 @@ let (lookup_bvar : env -> FStarC_Syntax_Syntax.bv -> closure) = (fun uu___ -> match () with | () -> - let uu___1 = - FStarC_Compiler_List.nth env1 x.FStarC_Syntax_Syntax.index in + let uu___1 = FStarC_List.nth env1 x.FStarC_Syntax_Syntax.index in FStar_Pervasives_Native.__proj__Mktuple3__item___2 uu___1) () with | uu___ -> @@ -316,8 +308,8 @@ let (lookup_bvar : env -> FStarC_Syntax_Syntax.bv -> closure) = (showable_memo (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_subst_elt)))) env1 in - FStarC_Compiler_Util.format2 "Failed to find %s\nEnv is %s\n" - uu___2 uu___3 in + FStarC_Util.format2 "Failed to find %s\nEnv is %s\n" uu___2 + uu___3 in failwith uu___1 let (downgrade_ghost_effect_name : FStarC_Ident.lident -> FStarC_Ident.lident FStar_Pervasives_Native.option) @@ -347,11 +339,9 @@ let (norm_universe : fun env1 -> fun u -> let norm_univs_for_max us = - let us1 = - FStarC_Compiler_Util.sort_with FStarC_Syntax_Util.compare_univs - us in + let us1 = FStarC_Util.sort_with FStarC_Syntax_Util.compare_univs us in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun u1 -> match uu___1 with @@ -366,8 +356,7 @@ let (norm_universe : else (k_u, u1, (cur_max :: out)))) (FStarC_Syntax_Syntax.U_zero, FStarC_Syntax_Syntax.U_zero, []) us1 in - match uu___ with - | (uu___1, u1, out) -> FStarC_Compiler_List.rev (u1 :: out) in + match uu___ with | (uu___1, u1, out) -> FStarC_List.rev (u1 :: out) in let rec aux u1 = let u2 = FStarC_Syntax_Subst.compress_univ u1 in match u2 with @@ -377,28 +366,27 @@ let (norm_universe : match () with | () -> let uu___1 = - let uu___2 = FStarC_Compiler_List.nth env1 x in + let uu___2 = FStarC_List.nth env1 x in FStar_Pervasives_Native.__proj__Mktuple3__item___2 uu___2 in (match uu___1 with | Univ u3 -> ((let uu___3 = - FStarC_Compiler_Effect.op_Bang dbg_univ_norm in + FStarC_Effect.op_Bang dbg_univ_norm in if uu___3 then let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u3 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Univ (in norm_universe): %s\n" uu___4 else ()); aux u3) | Dummy -> [u2] | uu___2 -> let uu___3 = - let uu___4 = - FStarC_Compiler_Util.string_of_int x in - FStarC_Compiler_Util.format1 + let uu___4 = FStarC_Util.string_of_int x in + FStarC_Util.format1 "Impossible: universe variable u@%s bound to a term" uu___4 in failwith uu___3)) () @@ -409,7 +397,7 @@ let (norm_universe : then [FStarC_Syntax_Syntax.U_unknown] else (let uu___2 = - let uu___3 = FStarC_Compiler_Util.string_of_int x in + let uu___3 = FStarC_Util.string_of_int x in Prims.strcat "Universe variable not found: u@" uu___3 in failwith uu___2)) | FStarC_Syntax_Syntax.U_unif uu___ when @@ -423,10 +411,10 @@ let (norm_universe : let uu___3 = FStarC_TypeChecker_Env.get_range cfg.FStarC_TypeChecker_Cfg.tcenv in - FStarC_Compiler_Range_Ops.string_of_range uu___3 in + FStarC_Range_Ops.string_of_range uu___3 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "(%s) CheckNoUvars: unexpected universes variable remains: %s" uu___2 uu___3 in failwith uu___1 @@ -437,7 +425,7 @@ let (norm_universe : | FStarC_Syntax_Syntax.U_max [] -> [FStarC_Syntax_Syntax.U_zero] | FStarC_Syntax_Syntax.U_max us -> let us1 = - let uu___ = FStarC_Compiler_List.collect aux us in + let uu___ = FStarC_List.collect aux us in norm_univs_for_max uu___ in (match us1 with | u_k::hd::rest -> @@ -446,7 +434,7 @@ let (norm_universe : (match uu___ with | (FStarC_Syntax_Syntax.U_zero, n) -> let uu___1 = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun u3 -> let uu___2 = FStarC_Syntax_Util.univ_kernel u3 in match uu___2 with | (uu___3, m) -> n <= m) @@ -456,7 +444,7 @@ let (norm_universe : | uu___ -> us1) | FStarC_Syntax_Syntax.U_succ u3 -> let uu___ = aux u3 in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> FStarC_Syntax_Syntax.U_succ uu___1) uu___ in if (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.erase_universes @@ -474,19 +462,18 @@ let (norm_universe : let memo_or : 'a . 'a FStarC_Syntax_Syntax.memo -> (unit -> 'a) -> 'a = fun m -> fun f -> - let uu___ = FStarC_Compiler_Effect.op_Bang m in + let uu___ = FStarC_Effect.op_Bang m in match uu___ with | FStar_Pervasives_Native.Some v -> v | FStar_Pervasives_Native.None -> let v = f () in - (FStarC_Compiler_Effect.op_Colon_Equals m - (FStar_Pervasives_Native.Some v); + (FStarC_Effect.op_Colon_Equals m (FStar_Pervasives_Native.Some v); v) let rec (env_subst : env -> FStarC_Syntax_Syntax.subst_t) = fun env1 -> let compute uu___ = let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun uu___3 -> match (uu___2, uu___3) with @@ -508,12 +495,12 @@ let rec (env_subst : env -> FStarC_Syntax_Syntax.subst_t) = match env1 with | [] -> [] | (uu___, uu___1, memo)::uu___2 -> - let uu___3 = FStarC_Compiler_Effect.op_Bang memo in + let uu___3 = FStarC_Effect.op_Bang memo in (match uu___3 with | FStar_Pervasives_Native.Some s -> s | FStar_Pervasives_Native.None -> let s = compute () in - (FStarC_Compiler_Effect.op_Colon_Equals memo + (FStarC_Effect.op_Colon_Equals memo (FStar_Pervasives_Native.Some s); s)) let (filter_out_lcomp_cflags : @@ -521,7 +508,7 @@ let (filter_out_lcomp_cflags : FStarC_Syntax_Syntax.cflag Prims.list) = fun flags -> - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.DECREASES uu___1 -> false @@ -562,8 +549,8 @@ let (closure_as_term : FStarC_Syntax_Print.showable_subst_elt)))) env1 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print3 - ">>> %s (env=%s)\nClosure_as_term %s\n" uu___2 uu___3 uu___4); + FStarC_Util.print3 ">>> %s (env=%s)\nClosure_as_term %s\n" + uu___2 uu___3 uu___4); (let es = env_subst env1 in let t1 = FStarC_Syntax_Subst.subst es t in let t2 = @@ -593,20 +580,20 @@ let (closure_as_term : FStarC_Syntax_Print.showable_subst_elt)))) env1 in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t3 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 ">>> %s (env=%s)\nClosure_as_term RESULT %s\n" uu___3 uu___4 uu___5); t3) let (unembed_binder_knot : FStarC_Syntax_Syntax.binder FStarC_Syntax_Embeddings_Base.embedding - FStar_Pervasives_Native.option FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + FStar_Pervasives_Native.option FStarC_Effect.ref) + = FStarC_Util.mk_ref FStar_Pervasives_Native.None let (unembed_binder : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.binder FStar_Pervasives_Native.option) = fun t -> - let uu___ = FStarC_Compiler_Effect.op_Bang unembed_binder_knot in + let uu___ = FStarC_Effect.op_Bang unembed_binder_knot in match uu___ with | FStar_Pervasives_Native.Some e -> FStarC_Syntax_Embeddings_Base.try_unembed e t @@ -623,7 +610,7 @@ let (mk_psc_subst : = fun cfg -> fun env1 -> - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___ -> fun subst -> match uu___ with @@ -666,7 +653,7 @@ let (mk_psc_subst : ((x.FStarC_Syntax_Syntax.binder_bv), uu___8) in FStarC_Syntax_Syntax.NT uu___7 in let subst1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___7 -> match uu___7 with | FStarC_Syntax_Syntax.NT @@ -727,7 +714,7 @@ let (reduce_primops : (Prims.op_Negation cfg.FStarC_TypeChecker_Cfg.strong) -> - let l = FStarC_Compiler_List.length args in + let l = FStarC_List.length args in if l < prim_step.FStarC_TypeChecker_Primops_Base.arity @@ -745,7 +732,7 @@ let (reduce_primops : FStarC_Class_Show.show FStarC_Class_Show.showable_int prim_step.FStarC_TypeChecker_Primops_Base.arity in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "primop: found partially applied %s (%s/%s args)\n" uu___6 uu___7 uu___8); (tm, false)) @@ -756,7 +743,7 @@ let (reduce_primops : prim_step.FStarC_TypeChecker_Primops_Base.arity then (args, []) else - FStarC_Compiler_List.splitAt + FStarC_List.splitAt prim_step.FStarC_TypeChecker_Primops_Base.arity args in match uu___5 with @@ -768,7 +755,7 @@ let (reduce_primops : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "primop: trying to reduce <%s>\n" uu___8); (let psc = @@ -796,7 +783,7 @@ let (reduce_primops : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "primop: <%s> did not reduce\n" uu___9); (tm, false)) @@ -813,7 +800,7 @@ let (reduce_primops : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term reduced in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "primop: <%s> reduced to %s\n" uu___9 uu___10); (let uu___8 = @@ -828,7 +815,7 @@ let (reduce_primops : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "primop: not reducing <%s> since we're doing strong reduction\n" uu___7); (tm, false)) @@ -843,8 +830,8 @@ let (reduce_primops : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 - "primop: reducing <%s>\n" uu___5); + FStarC_Util.print1 "primop: reducing <%s>\n" + uu___5); (match args with | (a1, uu___4)::[] -> let uu___5 = @@ -864,8 +851,8 @@ let (reduce_primops : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 - "primop: reducing <%s>\n" uu___5); + FStarC_Util.print1 "primop: reducing <%s>\n" + uu___5); (match args with | (t, uu___4)::(r, uu___5)::[] -> let uu___6 = @@ -917,6 +904,8 @@ let (reduce_equality : (FStarC_TypeChecker_Cfg.default_steps.FStarC_TypeChecker_Cfg.unfold_until); FStarC_TypeChecker_Cfg.unfold_only = (FStarC_TypeChecker_Cfg.default_steps.FStarC_TypeChecker_Cfg.unfold_only); + FStarC_TypeChecker_Cfg.unfold_once = + (FStarC_TypeChecker_Cfg.default_steps.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = (FStarC_TypeChecker_Cfg.default_steps.FStarC_TypeChecker_Cfg.unfold_fully); FStarC_TypeChecker_Cfg.unfold_attr = @@ -999,10 +988,10 @@ let (is_norm_request : fun hd -> fun args -> let aux min_args = - if (FStarC_Compiler_List.length args) < min_args + if (FStarC_List.length args) < min_args then Norm_request_none else - if (FStarC_Compiler_List.length args) = min_args + if (FStarC_List.length args) = min_args then Norm_request_ready else Norm_request_requires_rejig in let uu___ = @@ -1046,8 +1035,7 @@ let (rejig_norm_request : FStarC_Parser_Const.normalize_term -> (match args with - | t1::t2::rest when - (FStarC_Compiler_List.length rest) > Prims.int_zero -> + | t1::t2::rest when (FStarC_List.length rest) > Prims.int_zero -> let uu___1 = FStarC_Syntax_Util.mk_app hd [t1; t2] in FStarC_Syntax_Util.mk_app uu___1 rest | uu___1 -> @@ -1056,8 +1044,7 @@ let (rejig_norm_request : | FStarC_Syntax_Syntax.Tm_fvar fv when FStarC_Syntax_Syntax.fv_eq_lid fv FStarC_Parser_Const.normalize -> (match args with - | t::rest when (FStarC_Compiler_List.length rest) > Prims.int_zero - -> + | t::rest when (FStarC_List.length rest) > Prims.int_zero -> let uu___1 = FStarC_Syntax_Util.mk_app hd [t] in FStarC_Syntax_Util.mk_app uu___1 rest | uu___1 -> @@ -1066,8 +1053,8 @@ let (rejig_norm_request : | FStarC_Syntax_Syntax.Tm_fvar fv when FStarC_Syntax_Syntax.fv_eq_lid fv FStarC_Parser_Const.norm -> (match args with - | t1::t2::t3::rest when - (FStarC_Compiler_List.length rest) > Prims.int_zero -> + | t1::t2::t3::rest when (FStarC_List.length rest) > Prims.int_zero + -> let uu___1 = FStarC_Syntax_Util.mk_app hd [t1; t2; t3] in FStarC_Syntax_Util.mk_app uu___1 rest | uu___1 -> @@ -1081,7 +1068,7 @@ let (rejig_norm_request : failwith uu___2 let (is_nbe_request : FStarC_TypeChecker_Env.step Prims.list -> Prims.bool) = fun s -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_Class_Deq.op_Equals_Question FStarC_TypeChecker_Env.deq_step FStarC_TypeChecker_Env.NBE) s let get_norm_request : @@ -1106,12 +1093,12 @@ let get_norm_request : FStar_Pervasives_Native.Some uu___1 | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None in let inherited_steps = - FStarC_Compiler_List.op_At + FStarC_List.op_At (if (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.erase_universes then [FStarC_TypeChecker_Env.EraseUniverses] else []) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At (if (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.allow_unbound_universes then [FStarC_TypeChecker_Env.AllowUnboundUniverses] @@ -1131,7 +1118,7 @@ let get_norm_request : FStarC_Syntax_Syntax.delta_constant; FStarC_TypeChecker_Env.Reify] in FStar_Pervasives_Native.Some - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ((FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]) :: inherited_steps) s), tm) @@ -1145,7 +1132,7 @@ let get_norm_request : FStarC_Syntax_Syntax.delta_constant; FStarC_TypeChecker_Env.Reify] in FStar_Pervasives_Native.Some - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ((FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]) :: inherited_steps) s), tm) @@ -1155,7 +1142,7 @@ let get_norm_request : | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some s -> FStar_Pervasives_Native.Some - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ((FStarC_TypeChecker_Env.DontUnfoldAttr [FStarC_Parser_Const.tac_opaque_attr]) :: inherited_steps) s), tm)) @@ -1170,7 +1157,7 @@ let (nbe_eval : fun tm -> let delta_level = let uu___ = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_TypeChecker_Env.UnfoldUntil uu___2 -> true @@ -1186,7 +1173,7 @@ let (nbe_eval : (fun uu___1 -> let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 "Invoking NBE with %s\n" uu___2); + FStarC_Util.print1 "Invoking NBE with %s\n" uu___2); (let tm_norm = let uu___1 = FStarC_TypeChecker_Cfg.cfg_env cfg in uu___1.FStarC_TypeChecker_Env.nbe s @@ -1196,7 +1183,7 @@ let (nbe_eval : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm_norm in - FStarC_Compiler_Util.print1 "Result of NBE is %s\n" uu___3); + FStarC_Util.print1 "Result of NBE is %s\n" uu___3); tm_norm) let firstn : 'uuuuu . @@ -1204,9 +1191,7 @@ let firstn : = fun k -> fun l -> - if (FStarC_Compiler_List.length l) < k - then (l, []) - else FStarC_Compiler_Util.first_N k l + if (FStarC_List.length l) < k then (l, []) else FStarC_Util.first_N k l let (should_reify : FStarC_TypeChecker_Cfg.cfg -> stack_elt Prims.list -> Prims.bool) = fun cfg -> @@ -1238,7 +1223,7 @@ let rec (maybe_weakly_reduced : | FStarC_Syntax_Syntax.Total t -> maybe_weakly_reduced t | FStarC_Syntax_Syntax.Comp ct -> (maybe_weakly_reduced ct.FStarC_Syntax_Syntax.result_typ) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___ -> match uu___ with | (a, uu___1) -> maybe_weakly_reduced a) ct.FStarC_Syntax_Syntax.effect_args) in @@ -1264,7 +1249,7 @@ let rec (maybe_weakly_reduced : { FStarC_Syntax_Syntax.hd = t1; FStarC_Syntax_Syntax.args = args;_} -> (maybe_weakly_reduced t1) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___ -> match uu___ with | (a, uu___1) -> maybe_weakly_reduced a) args) @@ -1288,8 +1273,8 @@ let rec (maybe_weakly_reduced : (maybe_weakly_reduced t1) || ((match m with | FStarC_Syntax_Syntax.Meta_pattern (uu___, args) -> - FStarC_Compiler_Util.for_some - (FStarC_Compiler_Util.for_some + FStarC_Util.for_some + (FStarC_Util.for_some (fun uu___1 -> match uu___1 with | (a, uu___2) -> maybe_weakly_reduced a)) args @@ -1321,6 +1306,113 @@ let (decide_unfolding : | FStarC_TypeChecker_Normalize_Unfolding.Should_unfold_yes -> FStar_Pervasives_Native.Some (FStar_Pervasives_Native.None, stack1) + | FStarC_TypeChecker_Normalize_Unfolding.Should_unfold_once -> + let uu___ = + (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.unfold_once in + (match uu___ with + | FStar_Pervasives_Native.Some once -> + let cfg' = + let uu___1 = + let uu___2 = cfg.FStarC_TypeChecker_Cfg.steps in + let uu___3 = + let uu___4 = + FStarC_List.filter + (fun lid -> + let uu___5 = + FStarC_Syntax_Syntax.fv_eq_lid fv lid in + Prims.op_Negation uu___5) once in + FStar_Pervasives_Native.Some uu___4 in + { + FStarC_TypeChecker_Cfg.beta = + (uu___2.FStarC_TypeChecker_Cfg.beta); + FStarC_TypeChecker_Cfg.iota = + (uu___2.FStarC_TypeChecker_Cfg.iota); + FStarC_TypeChecker_Cfg.zeta = + (uu___2.FStarC_TypeChecker_Cfg.zeta); + FStarC_TypeChecker_Cfg.zeta_full = + (uu___2.FStarC_TypeChecker_Cfg.zeta_full); + FStarC_TypeChecker_Cfg.weak = + (uu___2.FStarC_TypeChecker_Cfg.weak); + FStarC_TypeChecker_Cfg.hnf = + (uu___2.FStarC_TypeChecker_Cfg.hnf); + FStarC_TypeChecker_Cfg.primops = + (uu___2.FStarC_TypeChecker_Cfg.primops); + FStarC_TypeChecker_Cfg.do_not_unfold_pure_lets = + (uu___2.FStarC_TypeChecker_Cfg.do_not_unfold_pure_lets); + FStarC_TypeChecker_Cfg.unfold_until = + (uu___2.FStarC_TypeChecker_Cfg.unfold_until); + FStarC_TypeChecker_Cfg.unfold_only = + (uu___2.FStarC_TypeChecker_Cfg.unfold_only); + FStarC_TypeChecker_Cfg.unfold_once = uu___3; + FStarC_TypeChecker_Cfg.unfold_fully = + (uu___2.FStarC_TypeChecker_Cfg.unfold_fully); + FStarC_TypeChecker_Cfg.unfold_attr = + (uu___2.FStarC_TypeChecker_Cfg.unfold_attr); + FStarC_TypeChecker_Cfg.unfold_qual = + (uu___2.FStarC_TypeChecker_Cfg.unfold_qual); + FStarC_TypeChecker_Cfg.unfold_namespace = + (uu___2.FStarC_TypeChecker_Cfg.unfold_namespace); + FStarC_TypeChecker_Cfg.dont_unfold_attr = + (uu___2.FStarC_TypeChecker_Cfg.dont_unfold_attr); + FStarC_TypeChecker_Cfg.pure_subterms_within_computations + = + (uu___2.FStarC_TypeChecker_Cfg.pure_subterms_within_computations); + FStarC_TypeChecker_Cfg.simplify = + (uu___2.FStarC_TypeChecker_Cfg.simplify); + FStarC_TypeChecker_Cfg.erase_universes = + (uu___2.FStarC_TypeChecker_Cfg.erase_universes); + FStarC_TypeChecker_Cfg.allow_unbound_universes = + (uu___2.FStarC_TypeChecker_Cfg.allow_unbound_universes); + FStarC_TypeChecker_Cfg.reify_ = + (uu___2.FStarC_TypeChecker_Cfg.reify_); + FStarC_TypeChecker_Cfg.compress_uvars = + (uu___2.FStarC_TypeChecker_Cfg.compress_uvars); + FStarC_TypeChecker_Cfg.no_full_norm = + (uu___2.FStarC_TypeChecker_Cfg.no_full_norm); + FStarC_TypeChecker_Cfg.check_no_uvars = + (uu___2.FStarC_TypeChecker_Cfg.check_no_uvars); + FStarC_TypeChecker_Cfg.unmeta = + (uu___2.FStarC_TypeChecker_Cfg.unmeta); + FStarC_TypeChecker_Cfg.unascribe = + (uu___2.FStarC_TypeChecker_Cfg.unascribe); + FStarC_TypeChecker_Cfg.in_full_norm_request = + (uu___2.FStarC_TypeChecker_Cfg.in_full_norm_request); + FStarC_TypeChecker_Cfg.weakly_reduce_scrutinee = + (uu___2.FStarC_TypeChecker_Cfg.weakly_reduce_scrutinee); + FStarC_TypeChecker_Cfg.nbe_step = + (uu___2.FStarC_TypeChecker_Cfg.nbe_step); + FStarC_TypeChecker_Cfg.for_extraction = + (uu___2.FStarC_TypeChecker_Cfg.for_extraction); + FStarC_TypeChecker_Cfg.unrefine = + (uu___2.FStarC_TypeChecker_Cfg.unrefine); + FStarC_TypeChecker_Cfg.default_univs_to_zero = + (uu___2.FStarC_TypeChecker_Cfg.default_univs_to_zero); + FStarC_TypeChecker_Cfg.tactics = + (uu___2.FStarC_TypeChecker_Cfg.tactics) + } in + { + FStarC_TypeChecker_Cfg.steps = uu___1; + FStarC_TypeChecker_Cfg.tcenv = + (cfg.FStarC_TypeChecker_Cfg.tcenv); + FStarC_TypeChecker_Cfg.debug = + (cfg.FStarC_TypeChecker_Cfg.debug); + FStarC_TypeChecker_Cfg.delta_level = + (cfg.FStarC_TypeChecker_Cfg.delta_level); + FStarC_TypeChecker_Cfg.primitive_steps = + (cfg.FStarC_TypeChecker_Cfg.primitive_steps); + FStarC_TypeChecker_Cfg.strong = + (cfg.FStarC_TypeChecker_Cfg.strong); + FStarC_TypeChecker_Cfg.memoize_lazy = + (cfg.FStarC_TypeChecker_Cfg.memoize_lazy); + FStarC_TypeChecker_Cfg.normalize_pure_lets = + (cfg.FStarC_TypeChecker_Cfg.normalize_pure_lets); + FStarC_TypeChecker_Cfg.reifying = + (cfg.FStarC_TypeChecker_Cfg.reifying); + FStarC_TypeChecker_Cfg.compat_memo_ignore_cfg = + (cfg.FStarC_TypeChecker_Cfg.compat_memo_ignore_cfg) + } in + FStar_Pervasives_Native.Some + ((FStar_Pervasives_Native.Some cfg'), stack1)) | FStarC_TypeChecker_Normalize_Unfolding.Should_unfold_fully -> let cfg' = { @@ -1348,6 +1440,8 @@ let (decide_unfolding : FStarC_Syntax_Syntax.delta_constant); FStarC_TypeChecker_Cfg.unfold_only = FStar_Pervasives_Native.None; + FStarC_TypeChecker_Cfg.unfold_once = + (uu___.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = FStar_Pervasives_Native.None; FStarC_TypeChecker_Cfg.unfold_attr = @@ -1428,13 +1522,12 @@ let (decide_unfolding : let uu___2 = FStarC_Syntax_Syntax.lid_of_fv fv in FStarC_Const.Const_reflect uu___2 in FStarC_Syntax_Syntax.Tm_constant uu___1 in - FStarC_Syntax_Syntax.mk uu___ - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Syntax_Syntax.mk uu___ FStarC_Range_Type.dummyRange in let stack2 = push (App (empty_env, ref, FStar_Pervasives_Native.None, - FStarC_Compiler_Range_Type.dummyRange)) stack1 in + FStarC_Range_Type.dummyRange)) stack1 in FStar_Pervasives_Native.Some (FStar_Pervasives_Native.None, stack2) let (on_domain_lids : FStarC_Ident.lident Prims.list) = @@ -1448,8 +1541,8 @@ let (is_fext_on_domain : = fun t -> let is_on_dom fv = - FStarC_Compiler_List.existsb - (fun l -> FStarC_Syntax_Syntax.fv_eq_lid fv l) on_domain_lids in + FStarC_List.existsb (fun l -> FStarC_Syntax_Syntax.fv_eq_lid fv l) + on_domain_lids in let uu___ = let uu___1 = FStarC_Syntax_Subst.compress t in uu___1.FStarC_Syntax_Syntax.n in @@ -1463,14 +1556,13 @@ let (is_fext_on_domain : (match uu___1 with | FStarC_Syntax_Syntax.Tm_fvar fv when (is_on_dom fv) && - ((FStarC_Compiler_List.length args) = (Prims.of_int (3))) + ((FStarC_List.length args) = (Prims.of_int (3))) -> let f = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_List.tl args in - FStarC_Compiler_List.tl uu___4 in - FStarC_Compiler_List.hd uu___3 in + let uu___4 = FStarC_List.tl args in FStarC_List.tl uu___4 in + FStarC_List.hd uu___3 in FStar_Pervasives_Native.fst uu___2 in FStar_Pervasives_Native.Some f | uu___2 -> FStar_Pervasives_Native.None) @@ -1482,9 +1574,9 @@ let (__get_n_binders : FStarC_Syntax_Syntax.term -> (FStarC_Syntax_Syntax.binder Prims.list * FStarC_Syntax_Syntax.comp)) - FStarC_Compiler_Effect.ref) + FStarC_Effect.ref) = - FStarC_Compiler_Util.mk_ref + FStarC_Util.mk_ref (fun e -> fun s -> fun n -> fun t -> failwith "Impossible: __get_n_binders unset") @@ -1504,7 +1596,7 @@ let (is_partial_primop_app : (match uu___2 with | FStar_Pervasives_Native.Some prim_step -> prim_step.FStarC_TypeChecker_Primops_Base.arity > - (FStarC_Compiler_List.length args) + (FStarC_List.length args) | FStar_Pervasives_Native.None -> false) | uu___2 -> false) let (maybe_drop_rc_typ : @@ -1574,8 +1666,7 @@ let (is_applied : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 - uu___2) + FStarC_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 uu___2) else (); (let uu___1 = FStarC_Syntax_Util.head_and_args_full t in match uu___1 with @@ -1598,7 +1689,7 @@ let (is_applied : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term hd in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" uu___4 uu___5 uu___6) else (); @@ -1619,8 +1710,8 @@ let (is_applied_maybe_squashed : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.print2 - "WPE> is_applied_maybe_squashed %s -- %s\n" uu___1 uu___2) + FStarC_Util.print2 "WPE> is_applied_maybe_squashed %s -- %s\n" + uu___1 uu___2) else (); (let uu___1 = FStarC_Syntax_Util.is_squash t in match uu___1 with @@ -1650,12 +1741,10 @@ let (is_quantified_const : let phi0 = phi in let types_match bs = let uu___ = - let uu___1 = - FStarC_Compiler_Effect.op_Bang __get_n_binders in + let uu___1 = FStarC_Effect.op_Bang __get_n_binders in uu___1 cfg.FStarC_TypeChecker_Cfg.tcenv [FStarC_TypeChecker_Env.AllowUnboundUniverses] - (FStarC_Compiler_List.length bs) - bv.FStarC_Syntax_Syntax.sort in + (FStarC_List.length bs) bv.FStarC_Syntax_Syntax.sort in match uu___ with | (bs_q, uu___1) -> let rec unrefine_true t = @@ -1671,10 +1760,8 @@ let (is_quantified_const : FStarC_Syntax_Util.t_true -> unrefine_true b.FStarC_Syntax_Syntax.sort | uu___3 -> t in - ((FStarC_Compiler_List.length bs) = - (FStarC_Compiler_List.length bs_q)) - && - (FStarC_Compiler_List.forall2 + ((FStarC_List.length bs) = (FStarC_List.length bs_q)) && + (FStarC_List.forall2 (fun b1 -> fun b2 -> let s1 = @@ -1693,7 +1780,7 @@ let (is_quantified_const : FStarC_Syntax_Syntax.bv_eq bv1 bv' | uu___1 -> false in let replace_full_applications_with bv1 arity s t = - let chgd = FStarC_Compiler_Util.mk_ref false in + let chgd = FStarC_Util.mk_ref false in let t' = FStarC_Syntax_Visit.visit_term false (fun t1 -> @@ -1701,16 +1788,12 @@ let (is_quantified_const : match uu___ with | (hd, args) -> let uu___1 = - ((FStarC_Compiler_List.length args) = arity) && + ((FStarC_List.length args) = arity) && (is_bv bv1 hd) in if uu___1 - then - (FStarC_Compiler_Effect.op_Colon_Equals chgd - true; - s) + then (FStarC_Effect.op_Colon_Equals chgd true; s) else t1) t in - let uu___ = FStarC_Compiler_Effect.op_Bang chgd in - (t', uu___) in + let uu___ = FStarC_Effect.op_Bang chgd in (t', uu___) in let uu___ = FStarC_Syntax_Formula.destruct_typ_as_formula phi in Obj.magic (FStarC_Class_Monad.op_let_Bang @@ -1737,7 +1820,7 @@ let (is_quantified_const : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term q in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "WPE> p = (%s); q = (%s)\n" uu___4 uu___5) else (); @@ -1763,7 +1846,7 @@ let (is_quantified_const : (if (cfg.FStarC_TypeChecker_Cfg.debug).FStarC_TypeChecker_Cfg.wpe then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "WPE> Case 1\n" else (); (let q' = @@ -1798,7 +1881,7 @@ let (is_quantified_const : (if (cfg.FStarC_TypeChecker_Cfg.debug).FStarC_TypeChecker_Cfg.wpe then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "WPE> Case 2\n" else (); (let q' = @@ -1859,7 +1942,7 @@ let (is_quantified_const : if (cfg.FStarC_TypeChecker_Cfg.debug).FStarC_TypeChecker_Cfg.wpe then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "WPE> Case 3\n" else (); ( @@ -1867,7 +1950,7 @@ let (is_quantified_const : = replace_full_applications_with bv - (FStarC_Compiler_List.length + (FStarC_List.length bs) FStarC_Syntax_Util.t_true q in @@ -1947,7 +2030,7 @@ let (is_quantified_const : if (cfg.FStarC_TypeChecker_Cfg.debug).FStarC_TypeChecker_Cfg.wpe then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "WPE> Case 4\n" else (); ( @@ -1955,7 +2038,7 @@ let (is_quantified_const : = replace_full_applications_with bv - (FStarC_Compiler_List.length + (FStarC_List.length bs) FStarC_Syntax_Util.t_false q in @@ -2051,8 +2134,8 @@ let (is_forall_const : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term phi' in - FStarC_Compiler_Util.print2 "WPE> QAll [%s] %s\n" - uu___3 uu___4) + FStarC_Util.print2 "WPE> QAll [%s] %s\n" uu___3 + uu___4) else (); (let uu___3 = is_quantified_const cfg @@ -2110,7 +2193,7 @@ let (has_extract_as_attr : let uu___ = FStarC_TypeChecker_Env.lookup_attrs_of_lid g lid in match uu___ with | FStar_Pervasives_Native.Some attrs -> - FStarC_Compiler_Util.find_map attrs is_extract_as_attr + FStarC_Util.find_map attrs is_extract_as_attr | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None let rec (norm : FStarC_TypeChecker_Cfg.cfg -> @@ -2139,7 +2222,7 @@ let rec (norm : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 "NORM delayed: %s\n" uu___2 + FStarC_Util.print1 "NORM delayed: %s\n" uu___2 | uu___1 -> ()) else (); FStarC_Syntax_Subst.compress t in @@ -2155,14 +2238,14 @@ let rec (norm : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length env1) in + (FStarC_List.length env1) in let uu___6 = let uu___7 = let uu___8 = firstn (Prims.of_int (4)) stack2 in FStar_Pervasives_Native.fst uu___8 in FStarC_Class_Show.show (FStarC_Class_Show.show_list showable_stack_elt) uu___7 in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 ">>> %s (no_full_norm=%s)\nNorm %s with %s env elements; top of the stack = %s\n" uu___2 uu___3 uu___4 uu___5 uu___6); FStarC_TypeChecker_Cfg.log_cfg cfg @@ -2170,7 +2253,7 @@ let rec (norm : let uu___3 = FStarC_Class_Show.show FStarC_TypeChecker_Cfg.showable_cfg cfg in - FStarC_Compiler_Util.print1 ">>> cfg = %s\n" uu___3); + FStarC_Util.print1 ">>> cfg = %s\n" uu___3); (match t1.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_unknown -> rebuild cfg empty_env stack2 t1 @@ -2190,8 +2273,8 @@ let rec (norm : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print1 - " >> This is a constructor: %s\n" uu___5); + FStarC_Util.print1 " >> This is a constructor: %s\n" + uu___5); rebuild cfg empty_env stack2 t1) | FStarC_Syntax_Syntax.Tm_fvar { FStarC_Syntax_Syntax.fv_name = uu___2; @@ -2203,8 +2286,8 @@ let rec (norm : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print1 - " >> This is a constructor: %s\n" uu___6); + FStarC_Util.print1 " >> This is a constructor: %s\n" + uu___6); rebuild cfg empty_env stack2 t1) | FStarC_Syntax_Syntax.Tm_fvar fv -> let lid = FStarC_Syntax_Syntax.lid_of_fv fv in @@ -2222,8 +2305,8 @@ let rec (norm : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print1 - " >> This is a constant: %s\n" uu___6); + FStarC_Util.print1 " >> This is a constant: %s\n" + uu___6); rebuild cfg empty_env stack2 t1) | uu___3 -> let uu___4 = decide_unfolding cfg stack2 fv qninfo in @@ -2255,9 +2338,7 @@ let rec (norm : -> (if (cfg.FStarC_TypeChecker_Cfg.debug).FStarC_TypeChecker_Cfg.print_normalized - then - FStarC_Compiler_Util.print_string - "Rejigging norm request ... \n" + then FStarC_Util.print_string "Rejigging norm request ... \n" else (); (let uu___3 = rejig_norm_request hd args in norm cfg env1 stack2 uu___3)) @@ -2276,7 +2357,7 @@ let rec (norm : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term hd in let uu___4 = FStarC_Syntax_Print.args_to_string args in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Potential norm request with hd = %s and args = %s ... \n" uu___3 uu___4) else (); @@ -2305,6 +2386,8 @@ let rec (norm : (uu___3.FStarC_TypeChecker_Cfg.unfold_until); FStarC_TypeChecker_Cfg.unfold_only = FStar_Pervasives_Native.None; + FStarC_TypeChecker_Cfg.unfold_once = + (uu___3.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = FStar_Pervasives_Native.None; FStarC_TypeChecker_Cfg.unfold_attr = @@ -2376,11 +2459,10 @@ let rec (norm : (if (cfg.FStarC_TypeChecker_Cfg.debug).FStarC_TypeChecker_Cfg.print_normalized then - FStarC_Compiler_Util.print_string - "Norm request None ... \n" + FStarC_Util.print_string "Norm request None ... \n" else (); (let stack3 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___5 -> fun stack4 -> match uu___5 with @@ -2399,16 +2481,16 @@ let rec (norm : FStarC_TypeChecker_Cfg.log cfg (fun uu___6 -> let uu___7 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length args) in - FStarC_Compiler_Util.print1 - "\tPushed %s arguments\n" uu___7); + FStarC_Util.string_of_int + (FStarC_List.length args) in + FStarC_Util.print1 "\tPushed %s arguments\n" + uu___7); norm cfg env1 stack3 hd)) | FStar_Pervasives_Native.Some (s, tm) when is_nbe_request s -> let tm' = closure_as_term cfg env1 tm in let uu___4 = - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___5 -> nbe_eval cfg s tm') in (match uu___4 with | (tm_norm, elapsed) -> @@ -2430,7 +2512,7 @@ let rec (norm : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm_norm in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "NBE result timing (%s ms){\nOn term {\n%s\n}\nwith steps {%s}\nresult is{\n\n%s\n}\n}\n" uu___6 uu___7 uu___8 uu___9) else (); @@ -2445,7 +2527,7 @@ let rec (norm : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Starting norm request on `%s`." uu___8 in FStarC_Errors_Msg.text uu___7 in let uu___7 = @@ -2470,7 +2552,7 @@ let rec (norm : else (); (let delta_level = let uu___5 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___6 -> match uu___6 with | FStarC_TypeChecker_Env.UnfoldUntil uu___7 @@ -2515,6 +2597,8 @@ let rec (norm : (uu___6.FStarC_TypeChecker_Cfg.unfold_until); FStarC_TypeChecker_Cfg.unfold_only = (uu___6.FStarC_TypeChecker_Cfg.unfold_only); + FStarC_TypeChecker_Cfg.unfold_once = + (uu___6.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = (uu___6.FStarC_TypeChecker_Cfg.unfold_fully); FStarC_TypeChecker_Cfg.unfold_attr = @@ -2580,7 +2664,7 @@ let rec (norm : FStarC_TypeChecker_Cfg.compat_memo_ignore_cfg = (cfg.FStarC_TypeChecker_Cfg.compat_memo_ignore_cfg) } in - let t0 = FStarC_Compiler_Util.now_ns () in + let t0 = FStarC_Util.now_ns () in let tm_normed = norm cfg'1 env1 [] tm in maybe_debug cfg tm_normed (FStar_Pervasives_Native.Some (tm, t0)); @@ -2599,7 +2683,7 @@ let rec (norm : (let us1 = let uu___3 = let uu___4 = - FStarC_Compiler_List.map (norm_universe cfg env1) us in + FStarC_List.map (norm_universe cfg env1) us in (uu___4, (t1.FStarC_Syntax_Syntax.pos)) in UnivArgs uu___3 in let stack3 = us1 :: stack2 in norm cfg env1 stack3 t') @@ -2628,7 +2712,7 @@ let rec (norm : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t' in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Lazy hit: %s cached to %s\n" uu___6 uu___7); (let uu___5 = maybe_weakly_reduced t' in @@ -2684,7 +2768,7 @@ let rec (norm : match uu___4 with | (bs1, body1, opening) -> let env' = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun uu___5 -> let uu___6 = dummy () in uu___6 :: env2) @@ -2700,7 +2784,7 @@ let rec (norm : let rc1 = maybe_drop_rc_typ cfg rc in let uu___5 = let uu___6 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (FStarC_Syntax_Subst.subst opening) rc1.FStarC_Syntax_Syntax.residual_typ in { @@ -2719,10 +2803,10 @@ let rec (norm : (FStarC_TypeChecker_Cfg.log cfg (fun uu___6 -> let uu___7 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length bs1) in - FStarC_Compiler_Util.print1 - "\tShifted %s dummies\n" uu___7); + FStarC_Util.string_of_int + (FStarC_List.length bs1) in + FStarC_Util.print1 "\tShifted %s dummies\n" + uu___7); (let cfg' = { FStarC_TypeChecker_Cfg.steps = @@ -2770,8 +2854,7 @@ let rec (norm : (fun uu___5 -> let uu___6 = FStarC_Class_Show.show showable_closure c in - FStarC_Compiler_Util.print1 "\tShifted %s\n" - uu___6); + FStarC_Util.print1 "\tShifted %s\n" uu___6); (let uu___5 = let uu___6 = let uu___7 = fresh_memo () in @@ -2783,8 +2866,7 @@ let rec (norm : (fun uu___5 -> let uu___6 = FStarC_Class_Show.show showable_closure c in - FStarC_Compiler_Util.print1 "\tShifted %s\n" - uu___6); + FStarC_Util.print1 "\tShifted %s\n" uu___6); (let body1 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_abs @@ -2806,8 +2888,7 @@ let rec (norm : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print1 "\tSet memo %s\n" - uu___5); + FStarC_Util.print1 "\tSet memo %s\n" uu___5); norm cfg env1 stack3 t1) | (Meta uu___2)::uu___3 -> let uu___4 = maybe_strip_meta_divs stack2 in @@ -2839,7 +2920,7 @@ let rec (norm : (match strict_args with | FStar_Pervasives_Native.None -> let stack3 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___2 -> fun stack4 -> match uu___2 with @@ -2888,28 +2969,26 @@ let rec (norm : (FStarC_TypeChecker_Cfg.log cfg (fun uu___3 -> let uu___4 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length args) in - FStarC_Compiler_Util.print1 - "\tPushed %s arguments\n" uu___4); + FStarC_Util.string_of_int + (FStarC_List.length args) in + FStarC_Util.print1 "\tPushed %s arguments\n" uu___4); norm cfg env1 stack3 head) | FStar_Pervasives_Native.Some strict_args1 -> let norm_args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (a, i) -> let uu___3 = norm cfg env1 [] a in (uu___3, i)) args in - let norm_args_len = FStarC_Compiler_List.length norm_args in + let norm_args_len = FStarC_List.length norm_args in let uu___2 = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun i -> if i >= norm_args_len then false else - (let uu___4 = - FStarC_Compiler_List.nth norm_args i in + (let uu___4 = FStarC_List.nth norm_args i in match uu___4 with | (arg_i, uu___5) -> let uu___6 = @@ -2936,7 +3015,7 @@ let rec (norm : if uu___2 then let stack3 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___3 -> fun stack4 -> match uu___3 with @@ -2946,7 +3025,7 @@ let rec (norm : let uu___6 = let uu___7 = let uu___8 = - FStarC_Compiler_Util.mk_ref + FStarC_Util.mk_ref (FStar_Pervasives_Native.Some (cfg, ([], a))) in (env1, a, uu___8, false) in @@ -2958,10 +3037,10 @@ let rec (norm : (FStarC_TypeChecker_Cfg.log cfg (fun uu___4 -> let uu___5 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length args) in - FStarC_Compiler_Util.print1 - "\tPushed %s arguments\n" uu___5); + FStarC_Util.string_of_int + (FStarC_List.length args) in + FStarC_Util.print1 "\tPushed %s arguments\n" + uu___5); norm cfg env1 stack3 head) else (let head1 = closure_as_term cfg env1 head in @@ -3050,7 +3129,7 @@ let rec (norm : | (bs1, c1) -> let c2 = let uu___4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun uu___5 -> let uu___6 = dummy () in uu___6 :: env2) @@ -3108,18 +3187,16 @@ let rec (norm : then (FStarC_TypeChecker_Cfg.log cfg (fun uu___4 -> - FStarC_Compiler_Util.print_string - "+++ Dropping ascription \n"); + FStarC_Util.print_string "+++ Dropping ascription \n"); norm cfg env1 stack2 t11) else (FStarC_TypeChecker_Cfg.log cfg (fun uu___5 -> - FStarC_Compiler_Util.print_string - "+++ Keeping ascription \n"); + FStarC_Util.print_string "+++ Keeping ascription \n"); (let t12 = norm cfg env1 [] t11 in FStarC_TypeChecker_Cfg.log cfg (fun uu___6 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "+++ Normalizing ascription \n"); (let asc1 = norm_ascription cfg env1 asc in let uu___6 = @@ -3142,7 +3219,7 @@ let rec (norm : FStarC_Syntax_Syntax.rc_opt1 = lopt;_} -> let lopt1 = - FStarC_Compiler_Util.map_option (maybe_drop_rc_typ cfg) lopt in + FStarC_Util.map_option (maybe_drop_rc_typ cfg) lopt in let stack3 = (Match (env1, asc_opt, branches1, lopt1, cfg, @@ -3180,6 +3257,8 @@ let rec (norm : (uu___2.FStarC_TypeChecker_Cfg.unfold_until); FStarC_TypeChecker_Cfg.unfold_only = (uu___2.FStarC_TypeChecker_Cfg.unfold_only); + FStarC_TypeChecker_Cfg.unfold_once = + (uu___2.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = (uu___2.FStarC_TypeChecker_Cfg.unfold_fully); FStarC_TypeChecker_Cfg.unfold_attr = @@ -3256,7 +3335,7 @@ let rec (norm : (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.compress_uvars -> let lbs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___2 = FStarC_Syntax_Subst.univ_var_opening @@ -3343,7 +3422,7 @@ let rec (norm : then let binder = let uu___3 = - FStarC_Compiler_Util.left lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.mk_binder uu___3 in let def = FStarC_Syntax_Util.unmeta_lift @@ -3360,8 +3439,7 @@ let rec (norm : uu___3 :: env1 in (FStarC_TypeChecker_Cfg.log cfg (fun uu___4 -> - FStarC_Compiler_Util.print_string - "+++ Reducing Tm_let\n"); + FStarC_Util.print_string "+++ Reducing Tm_let\n"); norm cfg env2 stack2 body) else (let uu___4 = @@ -3380,7 +3458,7 @@ let rec (norm : let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Util.left + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.mk_binder uu___9 in [uu___8] in @@ -3400,7 +3478,7 @@ let rec (norm : :: stack2 in (FStarC_TypeChecker_Cfg.log cfg (fun uu___6 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "+++ Evaluating DIV Tm_let\n"); norm cfg env1 stack3 lb.FStarC_Syntax_Syntax.lbdef) else @@ -3409,7 +3487,7 @@ let rec (norm : then (FStarC_TypeChecker_Cfg.log cfg (fun uu___7 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "+++ Not touching Tm_let\n"); (let uu___7 = closure_as_term cfg env1 t1 in rebuild cfg env1 stack2 uu___7)) @@ -3418,7 +3496,7 @@ let rec (norm : let uu___8 = let uu___9 = let uu___10 = - FStarC_Compiler_Util.left + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.mk_binder uu___10 in [uu___9] in @@ -3427,13 +3505,13 @@ let rec (norm : | (bs, body1) -> (FStarC_TypeChecker_Cfg.log cfg (fun uu___9 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "+++ Normalizing Tm_let -- type"); (let ty = norm cfg env1 [] lb.FStarC_Syntax_Syntax.lbtyp in let lbname = let x = - let uu___9 = FStarC_Compiler_List.hd bs in + let uu___9 = FStarC_List.hd bs in uu___9.FStarC_Syntax_Syntax.binder_bv in FStar_Pervasives.Inl { @@ -3445,14 +3523,14 @@ let rec (norm : } in FStarC_TypeChecker_Cfg.log cfg (fun uu___10 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "+++ Normalizing Tm_let -- definiens\n"); (let lb1 = let uu___10 = norm cfg env1 [] lb.FStarC_Syntax_Syntax.lbdef in let uu___11 = - FStarC_Compiler_List.map (norm cfg env1 []) + FStarC_List.map (norm cfg env1 []) lb.FStarC_Syntax_Syntax.lbattrs in { FStarC_Syntax_Syntax.lbname = lbname; @@ -3467,14 +3545,14 @@ let rec (norm : (lb.FStarC_Syntax_Syntax.lbpos) } in let env' = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun uu___10 -> let uu___11 = dummy () in uu___11 :: env2) env1 bs in FStarC_TypeChecker_Cfg.log cfg (fun uu___11 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "+++ Normalizing Tm_let -- body\n"); (let cfg' = { @@ -3524,14 +3602,14 @@ let rec (norm : (match uu___2 with | (lbs1, body1) -> let lbs2 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let ty = norm cfg env1 [] lb.FStarC_Syntax_Syntax.lbtyp in let lbname = let uu___3 = let uu___4 = - FStarC_Compiler_Util.left + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in { FStarC_Syntax_Syntax.ppname = @@ -3549,21 +3627,21 @@ let rec (norm : let xs1 = norm_binders cfg env1 xs in let env2 = let uu___4 = - FStarC_Compiler_List.map - (fun uu___5 -> dummy ()) xs1 in + FStarC_List.map (fun uu___5 -> dummy ()) + xs1 in let uu___5 = let uu___6 = - FStarC_Compiler_List.map - (fun uu___7 -> dummy ()) lbs1 in - FStarC_Compiler_List.op_At uu___6 env1 in - FStarC_Compiler_List.op_At uu___4 uu___5 in + FStarC_List.map (fun uu___7 -> dummy ()) + lbs1 in + FStarC_List.op_At uu___6 env1 in + FStarC_List.op_At uu___4 uu___5 in let def_body1 = norm cfg env2 [] def_body in let lopt1 = match lopt with | FStar_Pervasives_Native.Some rc -> let uu___4 = let uu___5 = - FStarC_Compiler_Util.map_opt + FStarC_Util.map_opt rc.FStarC_Syntax_Syntax.residual_typ (norm cfg env2 []) in { @@ -3595,9 +3673,8 @@ let rec (norm : }) lbs1 in let env' = let uu___3 = - FStarC_Compiler_List.map (fun uu___4 -> dummy ()) - lbs2 in - FStarC_Compiler_List.op_At uu___3 env1 in + FStarC_List.map (fun uu___4 -> dummy ()) lbs2 in + FStarC_List.op_At uu___3 env1 in let body2 = norm cfg env' [] body1 in let uu___3 = FStarC_Syntax_Subst.close_let_rec lbs2 body2 in (match uu___3 with @@ -3635,14 +3712,14 @@ let rec (norm : FStarC_Syntax_Syntax.body1 = body;_} -> let uu___2 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun lb -> fun uu___3 -> match uu___3 with | (rec_env, memos, i) -> let bv = let uu___4 = - FStarC_Compiler_Util.left + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in { FStarC_Syntax_Syntax.ppname = @@ -3672,17 +3749,17 @@ let rec (norm : (match uu___2 with | (rec_env, memos, uu___3) -> let uu___4 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun lb -> fun memo -> - FStarC_Compiler_Effect.op_Colon_Equals memo + FStarC_Effect.op_Colon_Equals memo (FStar_Pervasives_Native.Some (cfg, (rec_env, (lb.FStarC_Syntax_Syntax.lbdef))))) (FStar_Pervasives_Native.snd lbs) memos in let body_env = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun lb -> let uu___5 = @@ -3698,8 +3775,7 @@ let rec (norm : (FStar_Pervasives_Native.snd lbs) in (FStarC_TypeChecker_Cfg.log cfg (fun uu___6 -> - FStarC_Compiler_Util.print1 - "reducing with knot %s\n" ""); + FStarC_Util.print1 "reducing with knot %s\n" ""); norm cfg body_env stack2 body)) | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = head; @@ -3710,7 +3786,7 @@ let rec (norm : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_metadata m in - FStarC_Compiler_Util.print1 ">> metadata = %s\n" uu___4); + FStarC_Util.print1 ">> metadata = %s\n" uu___4); (match m with | FStarC_Syntax_Syntax.Meta_monadic (m_from, ty) -> if @@ -3788,8 +3864,7 @@ let rec (norm : (names, args) -> let args1 = norm_pattern_args cfg env1 args in let names1 = - FStarC_Compiler_List.map - (norm cfg env1 []) names in + FStarC_List.map (norm cfg env1 []) names in norm cfg env1 ((Meta (env1, @@ -3822,8 +3897,7 @@ let rec (norm : | FStarC_Syntax_Syntax.Meta_pattern (names, args) -> let names1 = - FStarC_Compiler_List.map - (norm cfg env1 []) names in + FStarC_List.map (norm cfg env1 []) names in let uu___5 = let uu___6 = norm_pattern_args cfg env1 args in @@ -3846,13 +3920,12 @@ let rec (norm : then (let uu___4 = let uu___5 = - FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Class_Show.show FStarC_Range_Ops.showable_range t1.FStarC_Syntax_Syntax.pos in let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "(%s) CheckNoUvars: Unexpected unification variable remains: %s" uu___5 uu___6 in failwith uu___4) @@ -3892,8 +3965,8 @@ and (do_unfold_fv : se.FStarC_Syntax_Syntax.sigquals -> let uu___2 = - FStarC_Compiler_Util.find_map - se.FStarC_Syntax_Syntax.sigattrs is_extract_as_attr in + FStarC_Util.find_map se.FStarC_Syntax_Syntax.sigattrs + is_extract_as_attr in (match uu___2 with | FStar_Pervasives_Native.Some impl -> FStar_Pervasives_Native.Some ([], impl) @@ -3913,7 +3986,7 @@ and (do_unfold_fv : (FStarC_Class_Show.show_list FStarC_TypeChecker_Env.showable_delta_level) cfg.FStarC_TypeChecker_Cfg.delta_level in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 " >> No definition found for %s (delta_level = %s)\n" uu___3 uu___4); rebuild cfg empty_env stack1 t0) @@ -3926,8 +3999,8 @@ and (do_unfold_fv : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 " >> Unfolded %s to %s\n" - uu___3 uu___4); + FStarC_Util.print2 " >> Unfolded %s to %s\n" uu___3 + uu___4); (let t1 = if (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.unfold_until @@ -3938,25 +4011,24 @@ and (do_unfold_fv : else FStarC_Syntax_Subst.set_use_range t0.FStarC_Syntax_Syntax.pos t in - let n = FStarC_Compiler_List.length us in + let n = FStarC_List.length us in if n > Prims.int_zero then match stack1 with | (UnivArgs (us', uu___2))::stack2 -> - ((let uu___4 = - FStarC_Compiler_Effect.op_Bang dbg_univ_norm in + ((let uu___4 = FStarC_Effect.op_Bang dbg_univ_norm in if uu___4 then - FStarC_Compiler_List.iter + FStarC_List.iter (fun x -> let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ x in - FStarC_Compiler_Util.print1 - "Univ (normalizer) %s\n" uu___5) us' + FStarC_Util.print1 "Univ (normalizer) %s\n" + uu___5) us' else ()); (let env1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env2 -> fun u -> let uu___4 = @@ -3976,7 +4048,7 @@ and (do_unfold_fv : FStarC_Class_Show.show FStarC_Ident.showable_lident (f.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: missing universe instantiation on %s" uu___4 in failwith uu___3 @@ -4042,7 +4114,7 @@ and (do_reify_monadic : FStarC_Class_Show.show (FStarC_Class_Show.show_list showable_stack_elt) stack1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "INTERNAL ERROR: do_reify_monadic: bad stack: %s" uu___3 in failwith uu___2); @@ -4056,8 +4128,7 @@ and (do_reify_monadic : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top1 in - FStarC_Compiler_Util.print2 "Reifying: (%s) %s\n" - uu___3 uu___4); + FStarC_Util.print2 "Reifying: (%s) %s\n" uu___3 uu___4); (let top2 = FStarC_Syntax_Util.unmeta_safe top1 in let uu___2 = let uu___3 = FStarC_Syntax_Subst.compress top2 in @@ -4075,12 +4146,12 @@ and (do_reify_monadic : cfg.FStarC_TypeChecker_Cfg.tcenv eff_name in let uu___3 = let uu___4 = FStarC_Syntax_Util.get_eff_repr ed in - FStarC_Compiler_Util.must uu___4 in + FStarC_Util.must uu___4 in (match uu___3 with | (uu___4, repr) -> let uu___5 = let uu___6 = FStarC_Syntax_Util.get_bind_repr ed in - FStarC_Compiler_Util.must uu___6 in + FStarC_Util.must uu___6 in (match uu___5 with | (uu___6, bind_repr) -> (match lb.FStarC_Syntax_Syntax.lbname with @@ -4147,8 +4218,7 @@ and (do_reify_monadic : FStarC_Syntax_Syntax.lbpos = (lb.FStarC_Syntax_Syntax.lbpos) } in - let uu___8 = - FStarC_Compiler_List.tl stack1 in + let uu___8 = FStarC_List.tl stack1 in let uu___9 = let uu___10 = let uu___11 = @@ -4316,21 +4386,20 @@ and (do_reify_monadic : FStarC_Syntax_Syntax.comp = uu___14;_} when - (FStarC_Compiler_List.length - bs) + (FStarC_List.length bs) >= num_fixed_binders -> let uu___15 = let uu___16 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length + FStarC_List.splitAt + ((FStarC_List.length bs) - num_fixed_binders) bs in FStar_Pervasives_Native.fst uu___16 in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___16 -> FStarC_Syntax_Syntax.as_arg FStarC_Syntax_Syntax.unit_const) @@ -4358,7 +4427,7 @@ and (do_reify_monadic : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___17 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "bind_wp for layered effect %s is not an arrow with >= %s arguments (%s)" uu___14 uu___15 uu___16 in @@ -4412,16 +4481,16 @@ and (do_reify_monadic : body2 in [uu___19] in uu___17 :: uu___18 in - FStarC_Compiler_List.op_At + FStarC_List.op_At range_args uu___16 in - FStarC_Compiler_List.op_At + FStarC_List.op_At unit_args uu___15 in uu___13 :: uu___14 in uu___11 :: uu___12 else (let maybe_range_arg = let uu___12 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_TypeChecker_TermEqAndSimplify.eq_tm_bool cfg.FStarC_TypeChecker_Cfg.tcenv FStarC_Syntax_Util.dm4f_bind_range_attr) @@ -4479,10 +4548,10 @@ and (do_reify_monadic : uu___19 :: uu___20 in uu___17 :: uu___18 in uu___15 :: uu___16 in - FStarC_Compiler_List.op_At + FStarC_List.op_At maybe_range_arg uu___14 in - FStarC_Compiler_List.op_At - uu___12 uu___13) in + FStarC_List.op_At uu___12 + uu___13) in let reified = let is_total_effect = FStarC_TypeChecker_Env.is_total_effect @@ -4600,12 +4669,11 @@ and (do_reify_monadic : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term reified in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Reified (1) <%s> to %s\n" uu___12 uu___13); (let uu___11 = - FStarC_Compiler_List.tl - stack1 in + FStarC_List.tl stack1 in norm cfg env1 uu___11 reified)))))) | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = head; @@ -4635,15 +4703,14 @@ and (do_reify_monadic : let uu___6 = let uu___7 = FStarC_Syntax_Syntax.as_arg head in uu___7 :: args in - FStarC_Compiler_Util.for_some is_arg_impure - uu___6 in + FStarC_Util.for_some is_arg_impure uu___6 in (if uu___5 then let uu___6 = let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top2 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Incompatibility between typechecker and normalizer; this monadic application contains impure terms %s\n" uu___7 in FStarC_Errors.log_issue @@ -4660,9 +4727,9 @@ and (do_reify_monadic : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top0 in - FStarC_Compiler_Util.print2 - "Reified (2) <%s> to %s\n" uu___7 ""); - (let uu___6 = FStarC_Compiler_List.tl stack1 in + FStarC_Util.print2 "Reified (2) <%s> to %s\n" + uu___7 ""); + (let uu___6 = FStarC_List.tl stack1 in let uu___7 = FStarC_Syntax_Util.mk_reify top2 (FStar_Pervasives_Native.Some m) in @@ -4673,9 +4740,9 @@ and (do_reify_monadic : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top0 in - FStarC_Compiler_Util.print2 - "Reified (3) <%s> to %s\n" uu___7 ""); - (let uu___6 = FStarC_Compiler_List.tl stack1 in + FStarC_Util.print2 "Reified (3) <%s> to %s\n" + uu___7 ""); + (let uu___6 = FStarC_List.tl stack1 in let uu___7 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_meta @@ -4709,7 +4776,7 @@ and (do_reify_monadic : cfg.FStarC_TypeChecker_Cfg.delta_level (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v qninfo in - FStarC_Compiler_Option.isNone uu___8 in + FStarC_Option.isNone uu___8 in if uu___7 then fallback2 () else @@ -4719,7 +4786,7 @@ and (do_reify_monadic : (FStar_Pervasives_Native.Some m) in FStarC_Syntax_Syntax.mk_Tm_app uu___9 args t.FStarC_Syntax_Syntax.pos in - let uu___9 = FStarC_Compiler_List.tl stack1 in + let uu___9 = FStarC_List.tl stack1 in norm cfg env1 uu___9 t1)) | uu___5 -> fallback1 ())) | FStarC_Syntax_Syntax.Tm_meta @@ -4741,9 +4808,9 @@ and (do_reify_monadic : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lifted in - FStarC_Compiler_Util.print1 - "Reified lift to (2): %s\n" uu___5); - (let uu___4 = FStarC_Compiler_List.tl stack1 in + FStarC_Util.print1 "Reified lift to (2): %s\n" + uu___5); + (let uu___4 = FStarC_List.tl stack1 in norm cfg env1 uu___4 lifted)) | FStarC_Syntax_Syntax.Tm_match { FStarC_Syntax_Syntax.scrutinee = e; @@ -4752,7 +4819,7 @@ and (do_reify_monadic : FStarC_Syntax_Syntax.rc_opt1 = lopt;_} -> let branches2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> match uu___3 with | (pat, wopt, tm) -> @@ -4769,7 +4836,7 @@ and (do_reify_monadic : FStarC_Syntax_Syntax.brs = branches2; FStarC_Syntax_Syntax.rc_opt1 = lopt }) top2.FStarC_Syntax_Syntax.pos in - let uu___3 = FStarC_Compiler_List.tl stack1 in + let uu___3 = FStarC_List.tl stack1 in norm cfg env1 uu___3 tm | uu___3 -> fallback ())) and (reify_lift : @@ -4791,8 +4858,8 @@ and (reify_lift : let uu___3 = FStarC_Ident.string_of_lid mtgt in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print3 "Reifying lift %s -> %s: %s\n" - uu___2 uu___3 uu___4); + FStarC_Util.print3 "Reifying lift %s -> %s: %s\n" uu___2 + uu___3 uu___4); (let uu___1 = ((FStarC_Syntax_Util.is_pure_effect msrc) || (FStarC_Syntax_Util.is_div_effect msrc)) @@ -4809,12 +4876,12 @@ and (reify_lift : FStarC_TypeChecker_Env.get_effect_decl env1 uu___2 in let uu___2 = let uu___3 = FStarC_Syntax_Util.get_eff_repr ed in - FStarC_Compiler_Util.must uu___3 in + FStarC_Util.must uu___3 in match uu___2 with | (uu___3, repr) -> let uu___4 = let uu___5 = FStarC_Syntax_Util.get_return_repr ed in - FStarC_Compiler_Util.must uu___5 in + FStarC_Util.must uu___5 in (match uu___4 with | (uu___5, return_repr) -> let return_inst = @@ -4905,7 +4972,7 @@ and (reify_lift : let uu___4 = let uu___5 = FStarC_Ident.string_of_lid msrc in let uu___6 = FStarC_Ident.string_of_lid mtgt in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible : trying to reify a lift between unrelated effects (%s and %s)" uu___5 uu___6 in failwith uu___4 @@ -4921,7 +4988,7 @@ and (reify_lift : let uu___8 = let uu___9 = FStarC_Ident.string_of_lid msrc in let uu___10 = FStarC_Ident.string_of_lid mtgt in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible : trying to reify a non-reifiable lift (from %s to %s)" uu___9 uu___10 in failwith uu___8 @@ -4982,8 +5049,8 @@ and (norm_pattern_args : fun cfg -> fun env1 -> fun args -> - FStarC_Compiler_List.map - (FStarC_Compiler_List.map + FStarC_List.map + (FStarC_List.map (fun uu___ -> match uu___ with | (a, imp) -> @@ -5001,8 +5068,8 @@ and (norm_comp : FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp comp in let uu___3 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length env1) in - FStarC_Compiler_Util.print2 + (FStarC_List.length env1) in + FStarC_Util.print2 ">>> %s\nNormComp with with %s env elements\n" uu___2 uu___3); (match comp.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Total t -> @@ -5040,12 +5107,12 @@ and (norm_comp : Prims.op_Negation uu___3) in if uu___2 then - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> FStarC_Syntax_Syntax.as_arg FStarC_Syntax_Syntax.unit_const) else - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun idx -> fun uu___4 -> match uu___4 with @@ -5053,14 +5120,13 @@ and (norm_comp : let uu___5 = norm cfg env1 [] a in (uu___5, i)) in uu___1 ct.FStarC_Syntax_Syntax.effect_args in let flags = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.DECREASES (FStarC_Syntax_Syntax.Decreases_lex l) -> let uu___2 = - let uu___3 = - FStarC_Compiler_List.map (norm cfg env1 []) l in + let uu___3 = FStarC_List.map (norm cfg env1 []) l in FStarC_Syntax_Syntax.Decreases_lex uu___3 in FStarC_Syntax_Syntax.DECREASES uu___2 | FStarC_Syntax_Syntax.DECREASES @@ -5074,7 +5140,7 @@ and (norm_comp : FStarC_Syntax_Syntax.DECREASES uu___2 | f -> f) ct.FStarC_Syntax_Syntax.flags in let comp_univs = - FStarC_Compiler_List.map (norm_universe cfg env1) + FStarC_List.map (norm_universe cfg env1) ct.FStarC_Syntax_Syntax.comp_univs in let result_typ = norm cfg env1 [] ct.FStarC_Syntax_Syntax.result_typ in @@ -5121,7 +5187,7 @@ and (norm_binder : FStar_Pervasives_Native.Some uu___ | i -> i in let attrs = - FStarC_Compiler_List.map (norm cfg env1 []) + FStarC_List.map (norm cfg env1 []) b.FStarC_Syntax_Syntax.binder_attrs in FStarC_Syntax_Syntax.mk_binder_with_attrs x imp b.FStarC_Syntax_Syntax.binder_positivity attrs @@ -5133,7 +5199,7 @@ and (norm_binders : fun env1 -> fun bs -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -5141,7 +5207,7 @@ and (norm_binders : let b1 = norm_binder cfg env2 b in let uu___2 = let uu___3 = dummy () in uu___3 :: env2 in ((b1 :: nbs'), uu___2)) ([], env1) bs in - match uu___ with | (nbs, uu___1) -> FStarC_Compiler_List.rev nbs + match uu___ with | (nbs, uu___1) -> FStarC_List.rev nbs and (maybe_simplify : FStarC_TypeChecker_Cfg.cfg -> env -> @@ -5167,7 +5233,7 @@ and (maybe_simplify : let uu___4 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool renorm in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "%sSimplified\n\t%s to\n\t%s\nrenorm = %s\n" (if (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.simplify @@ -5257,7 +5323,7 @@ and (maybe_simplify_aux : FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some b -> let uu___10 = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___11 -> match uu___11 with | (uu___12, uu___13, e') -> @@ -5290,8 +5356,7 @@ and (maybe_simplify_aux : match uu___2 with | (head, args) -> let args1 = - FStarC_Compiler_List.map maybe_un_auto_squash_arg - args in + FStarC_List.map maybe_un_auto_squash_arg args in let uu___3 = FStarC_Syntax_Syntax.mk_Tm_app head args1 t.FStarC_Syntax_Syntax.pos in @@ -5307,7 +5372,8 @@ and (maybe_simplify_aux : { FStarC_Syntax_Syntax.bs1 = uu___3; FStarC_Syntax_Syntax.comp = c;_} -> - clearly_inhabited (FStarC_Syntax_Util.comp_result c) + let uu___4 = FStarC_Syntax_Util.comp_result c in + clearly_inhabited uu___4 | FStarC_Syntax_Syntax.Tm_fvar fv -> let l = FStarC_Syntax_Syntax.lid_of_fv fv in (((FStarC_Ident.lid_equals l @@ -5337,8 +5403,7 @@ and (maybe_simplify_aux : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm' in - FStarC_Compiler_Util.print2 "WPE> %s ~> %s\n" uu___4 - uu___5) + FStarC_Util.print2 "WPE> %s ~> %s\n" uu___4 uu___5) else (); (let uu___4 = norm cfg env1 [] tm' in maybe_simplify_aux cfg env1 stack1 uu___4)) @@ -5376,8 +5441,7 @@ and (maybe_simplify_aux : FStarC_Parser_Const.and_lid in if uu___13 then - let uu___14 = - FStarC_Compiler_List.map simplify args in + let uu___14 = FStarC_List.map simplify args in match uu___14 with | (FStar_Pervasives_Native.Some (true), uu___15)::(uu___16, (arg, uu___17))::[] -> @@ -5402,8 +5466,7 @@ and (maybe_simplify_aux : FStarC_Parser_Const.or_lid in if uu___15 then - let uu___16 = - FStarC_Compiler_List.map simplify args in + let uu___16 = FStarC_List.map simplify args in match uu___16 with | (FStar_Pervasives_Native.Some (true), uu___17)::uu___18::[] -> @@ -5432,7 +5495,7 @@ and (maybe_simplify_aux : if uu___17 then let uu___18 = - FStarC_Compiler_List.map simplify args in + FStarC_List.map simplify args in match uu___18 with | uu___19::(FStar_Pervasives_Native.Some (true), uu___20)::[] @@ -5470,8 +5533,7 @@ and (maybe_simplify_aux : if uu___19 then let uu___20 = - FStarC_Compiler_List.map simplify - args in + FStarC_List.map simplify args in match uu___20 with | (FStar_Pervasives_Native.Some (true), uu___21)::(FStar_Pervasives_Native.Some @@ -5556,8 +5618,7 @@ and (maybe_simplify_aux : if uu___21 then let uu___22 = - FStarC_Compiler_List.map - simplify args in + FStarC_List.map simplify args in match uu___22 with | (FStar_Pervasives_Native.Some (true), uu___23)::[] -> @@ -5792,7 +5853,7 @@ and (maybe_simplify_aux : match uu___30 with | FStarC_Syntax_Syntax.Tm_fvar fv1 when - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun l -> FStarC_Syntax_Syntax.fv_eq_lid fv1 l) @@ -5800,13 +5861,13 @@ and (maybe_simplify_aux : -> true | uu___31 -> false in (if - (FStarC_Compiler_List.length + (FStarC_List.length args) = Prims.int_one then let t = let uu___30 = - FStarC_Compiler_List.hd + FStarC_List.hd args in FStar_Pervasives_Native.fst uu___30 in @@ -5963,8 +6024,7 @@ and (maybe_simplify_aux : FStarC_Parser_Const.and_lid in if uu___9 then - let uu___10 = - FStarC_Compiler_List.map simplify args in + let uu___10 = FStarC_List.map simplify args in match uu___10 with | (FStar_Pervasives_Native.Some (true), uu___11)::(uu___12, (arg, uu___13))::[] -> @@ -5989,8 +6049,7 @@ and (maybe_simplify_aux : FStarC_Parser_Const.or_lid in if uu___11 then - let uu___12 = - FStarC_Compiler_List.map simplify args in + let uu___12 = FStarC_List.map simplify args in match uu___12 with | (FStar_Pervasives_Native.Some (true), uu___13)::uu___14::[] -> @@ -6019,7 +6078,7 @@ and (maybe_simplify_aux : if uu___13 then let uu___14 = - FStarC_Compiler_List.map simplify args in + FStarC_List.map simplify args in match uu___14 with | uu___15::(FStar_Pervasives_Native.Some (true), uu___16)::[] @@ -6057,8 +6116,7 @@ and (maybe_simplify_aux : if uu___15 then let uu___16 = - FStarC_Compiler_List.map simplify - args in + FStarC_List.map simplify args in match uu___16 with | (FStar_Pervasives_Native.Some (true), uu___17)::(FStar_Pervasives_Native.Some @@ -6143,8 +6201,7 @@ and (maybe_simplify_aux : if uu___17 then let uu___18 = - FStarC_Compiler_List.map - simplify args in + FStarC_List.map simplify args in match uu___18 with | (FStar_Pervasives_Native.Some (true), uu___19)::[] -> @@ -6379,7 +6436,7 @@ and (maybe_simplify_aux : match uu___26 with | FStarC_Syntax_Syntax.Tm_fvar fv1 when - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun l -> FStarC_Syntax_Syntax.fv_eq_lid fv1 l) @@ -6387,13 +6444,13 @@ and (maybe_simplify_aux : -> true | uu___27 -> false in (if - (FStarC_Compiler_List.length + (FStarC_List.length args) = Prims.int_one then let t = let uu___26 = - FStarC_Compiler_List.hd + FStarC_List.hd args in FStar_Pervasives_Native.fst uu___26 in @@ -6565,17 +6622,17 @@ and (rebuild : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length env1) in + (FStarC_List.length env1) in let uu___6 = let uu___7 = let uu___8 = firstn (Prims.of_int (4)) stack1 in FStar_Pervasives_Native.fst uu___8 in FStarC_Class_Show.show (FStarC_Class_Show.show_list showable_stack_elt) uu___7 in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 ">>> %s\nRebuild %s with %s env elements and top of the stack %s\n" uu___3 uu___4 uu___5 uu___6); - (let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_NormRebuild in + (let uu___3 = FStarC_Effect.op_Bang dbg_NormRebuild in if uu___3 then let uu___4 = FStarC_Syntax_Util.unbound_variables t in @@ -6592,19 +6649,19 @@ and (rebuild : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_bv) bvs in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "!!! Rebuild (%s) %s, free vars=%s\n" uu___6 uu___7 uu___8); failwith "DIE!") else ())); (let f_opt = is_fext_on_domain t in if - (FStarC_Compiler_Util.is_some f_opt) && + (FStarC_Util.is_some f_opt) && (match stack1 with | (Arg uu___1)::uu___2 -> true | uu___1 -> false) then - let uu___1 = FStarC_Compiler_Util.must f_opt in + let uu___1 = FStarC_Util.must f_opt in norm cfg env1 stack1 uu___1 else (let uu___2 = maybe_simplify cfg env1 stack1 t in @@ -6664,7 +6721,7 @@ and (do_rebuild : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 "\tSet memo %s\n" uu___3); + FStarC_Util.print1 "\tSet memo %s\n" uu___3); rebuild cfg env1 stack2 t) | (Let (env', bs, lb, r))::stack2 -> let body = FStarC_Syntax_Subst.close bs t in @@ -6679,8 +6736,7 @@ and (do_rebuild : | (Abs (env', bs, env'', lopt, r))::stack2 -> let bs1 = norm_binders cfg env' bs in let lopt1 = - FStarC_Compiler_Util.map_option - (norm_residual_comp cfg env'') lopt in + FStarC_Util.map_option (norm_residual_comp cfg env'') lopt in let uu___ = let uu___1 = FStarC_Syntax_Util.abs bs1 t lopt1 in { @@ -6712,8 +6768,7 @@ and (do_rebuild : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tm in - FStarC_Compiler_Util.print1 "Rebuilding with arg %s\n" - uu___3); + FStarC_Util.print1 "Rebuilding with arg %s\n" uu___3); (let uu___2 = (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.hnf && @@ -6748,8 +6803,7 @@ and (do_rebuild : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 "Not reifying%s: %s\n" msg - uu___3); + FStarC_Util.print2 "Not reifying%s: %s\n" msg uu___3); (let t1 = FStarC_Syntax_Syntax.extend_app head (t, aq) r in rebuild cfg env2 stack' t1) in let is_non_tac_layered_effect m = @@ -6777,7 +6831,7 @@ and (do_rebuild : -> let uu___3 = let uu___4 = FStarC_Ident.string_of_lid m in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Meta_monadic for a non-TAC layered effect %s in non-extraction mode" uu___4 in fallback uu___3 () @@ -6800,7 +6854,7 @@ and (do_rebuild : | FStarC_Syntax_Syntax.Extract_none msg -> let uu___4 = let uu___5 = FStarC_Ident.string_of_lid m in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Normalizer cannot reify effect %s for extraction since %s" uu___5 msg in FStarC_Errors.raise_error @@ -6824,7 +6878,7 @@ and (do_rebuild : -> let uu___3 = let uu___4 = FStarC_Ident.string_of_lid m in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Meta_monadic for a non-TAC layered effect %s which is Extract_primtiive" uu___4 in fallback uu___3 () @@ -6843,7 +6897,7 @@ and (do_rebuild : let uu___3 = let uu___4 = FStarC_Ident.string_of_lid msrc in let uu___5 = FStarC_Ident.string_of_lid mtgt in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Meta_monadic_lift for a non-TAC layered effect %s ~> %s in non extraction mode" uu___4 uu___5 in fallback uu___3 () @@ -6870,7 +6924,7 @@ and (do_rebuild : let uu___3 = let uu___4 = FStarC_Ident.string_of_lid msrc in let uu___5 = FStarC_Ident.string_of_lid mtgt in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Normalizer cannot reify %s ~> %s for extraction" uu___4 uu___5 in FStarC_Errors.raise_error @@ -6898,9 +6952,9 @@ and (do_rebuild : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lifted in - FStarC_Compiler_Util.print1 - "Reified lift to (1): %s\n" uu___3); - (let uu___2 = FStarC_Compiler_List.tl stack1 in + FStarC_Util.print1 "Reified lift to (1): %s\n" + uu___3); + (let uu___2 = FStarC_List.tl stack1 in norm cfg env2 uu___2 lifted)) | FStarC_Syntax_Syntax.Tm_app { @@ -6949,8 +7003,8 @@ and (do_rebuild : = uu___11; FStarC_TypeChecker_Primops_Base.interpretation_nbe = uu___12;_} - when (FStarC_Compiler_List.length args) = n - -> norm cfg env2 stack' t + when (FStarC_List.length args) = n -> + norm cfg env2 stack' t | uu___5 -> fallback " (3)" ()) | uu___4 -> fallback " (4)" ())) | uu___1 -> fallback " (2)" ()) @@ -6972,14 +7026,13 @@ and (do_rebuild : norm cfg env' uu___ head | (Match (env', asc_opt, branches1, lopt, cfg1, r))::stack2 -> let lopt1 = - FStarC_Compiler_Util.map_option - (norm_residual_comp cfg1 env') lopt in + FStarC_Util.map_option (norm_residual_comp cfg1 env') lopt in (FStarC_TypeChecker_Cfg.log cfg1 (fun uu___1 -> let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Rebuilding with match, scrutinee is %s ...\n" uu___2); (let scrutinee_env = env1 in let env2 = env' in @@ -6992,15 +7045,15 @@ and (do_rebuild : FStarC_Syntax_Print.showable_term scrutinee in let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (p, uu___8, uu___9) -> FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p) branches1 in - FStarC_Compiler_String.concat "\n\t" uu___6 in - FStarC_Compiler_Util.print2 + FStarC_String.concat "\n\t" uu___6 in + FStarC_Util.print2 "match is irreducible: scrutinee=%s\nbranches=%s\n" uu___4 uu___5); (let whnf = @@ -7013,7 +7066,7 @@ and (do_rebuild : then cfg1 else (let new_delta = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___4 -> match uu___4 with | FStarC_TypeChecker_Env.InliningDelta -> true @@ -7043,6 +7096,8 @@ and (do_rebuild : FStar_Pervasives_Native.None; FStarC_TypeChecker_Cfg.unfold_only = FStar_Pervasives_Native.None; + FStarC_TypeChecker_Cfg.unfold_once = + (uu___4.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = (uu___4.FStarC_TypeChecker_Cfg.unfold_fully); FStarC_TypeChecker_Cfg.unfold_attr = @@ -7126,11 +7181,11 @@ and (do_rebuild : FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some us -> let uu___4 = - FStarC_Compiler_List.map - (norm_universe cfg1 env3) us in + FStarC_List.map (norm_universe cfg1 env3) + us in FStar_Pervasives_Native.Some uu___4) in let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun uu___5 -> match (uu___4, uu___5) with @@ -7145,8 +7200,7 @@ and (do_rebuild : ({ FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_cons - (fv, us_opt1, - (FStarC_Compiler_List.rev pats1))); + (fv, us_opt1, (FStarC_List.rev pats1))); FStarC_Syntax_Syntax.p = (p.FStarC_Syntax_Syntax.p) }, env4)) @@ -7170,8 +7224,7 @@ and (do_rebuild : }, uu___3) | FStarC_Syntax_Syntax.Pat_dot_term eopt -> let eopt1 = - FStarC_Compiler_Util.map_option - (norm_or_whnf env3) eopt in + FStarC_Util.map_option (norm_or_whnf env3) eopt in ({ FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_dot_term eopt1); @@ -7182,7 +7235,7 @@ and (do_rebuild : match env2 with | [] when whnf -> branches1 | uu___4 -> - FStarC_Compiler_List.map + FStarC_List.map (fun branch -> let uu___5 = FStarC_Syntax_Subst.open_branch branch in @@ -7246,7 +7299,7 @@ and (do_rebuild : let e1 = norm cfg1 branch_env stack3 e in FStarC_Syntax_Util.branch (p1, wopt1, e1)) in let branches01 = - FStarC_Compiler_List.map reduce_branch branches0 in + FStarC_List.map reduce_branch branches0 in let uu___5 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_match @@ -7299,6 +7352,8 @@ and (do_rebuild : (uu___7.FStarC_TypeChecker_Cfg.unfold_until); FStarC_TypeChecker_Cfg.unfold_only = (uu___7.FStarC_TypeChecker_Cfg.unfold_only); + FStarC_TypeChecker_Cfg.unfold_once = + (uu___7.FStarC_TypeChecker_Cfg.unfold_once); FStarC_TypeChecker_Cfg.unfold_fully = (uu___7.FStarC_TypeChecker_Cfg.unfold_fully); FStarC_TypeChecker_Cfg.unfold_attr = @@ -7463,8 +7518,8 @@ and (do_rebuild : let uu___3 = matches_pat t1 p1 in (match uu___3 with | FStar_Pervasives.Inl s -> - matches_args (FStarC_Compiler_List.op_At out s) - rest_a rest_p + matches_args (FStarC_List.op_At out s) rest_a + rest_p | m -> m) | uu___1 -> FStar_Pervasives.Inr false in let rec matches scrutinee1 p = @@ -7485,20 +7540,20 @@ and (do_rebuild : FStarC_Syntax_Print.showable_pat p1 in let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (uu___8, t1) -> FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1) s in - FStarC_Compiler_String.concat "; " uu___6 in - FStarC_Compiler_Util.print2 + FStarC_String.concat "; " uu___6 in + FStarC_Util.print2 "Matches pattern %s with subst = %s\n" uu___4 uu___5); (let env0 = env2 in let env3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env4 -> fun uu___3 -> match uu___3 with @@ -7513,7 +7568,7 @@ and (do_rebuild : let uu___6 = let uu___7 = let uu___8 = - FStarC_Compiler_Util.mk_ref + FStarC_Util.mk_ref (if (cfg1.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.hnf then @@ -7589,8 +7644,7 @@ and (norm_ascription : | FStar_Pervasives.Inr c -> let uu___2 = norm_comp cfg env1 c in FStar_Pervasives.Inr uu___2 in - let uu___2 = - FStarC_Compiler_Util.map_opt tacopt (norm cfg env1 []) in + let uu___2 = FStarC_Util.map_opt tacopt (norm cfg env1 []) in (uu___1, uu___2, use_eq) and (norm_residual_comp : FStarC_TypeChecker_Cfg.cfg -> @@ -7602,7 +7656,7 @@ and (norm_residual_comp : fun env1 -> fun rc -> let uu___ = - FStarC_Compiler_Util.map_option (closure_as_term cfg env1) + FStarC_Util.map_option (closure_as_term cfg env1) rc.FStarC_Syntax_Syntax.residual_typ in { FStarC_Syntax_Syntax.residual_effect = @@ -7612,9 +7666,8 @@ and (norm_residual_comp : (rc.FStarC_Syntax_Syntax.residual_flags) } let (reflection_env_hook : - FStarC_TypeChecker_Env.env FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + FStarC_TypeChecker_Env.env FStar_Pervasives_Native.option FStarC_Effect.ref) + = FStarC_Util.mk_ref FStar_Pervasives_Native.None let (normalize_with_primitive_steps : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list -> FStarC_TypeChecker_Env.steps -> @@ -7638,9 +7691,9 @@ let (normalize_with_primitive_steps : FStarC_Profiling.profile (fun uu___2 -> let c = FStarC_TypeChecker_Cfg.config' ps s e in - FStarC_Compiler_Effect.op_Colon_Equals - reflection_env_hook (FStar_Pervasives_Native.Some e); - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals reflection_env_hook + (FStar_Pervasives_Native.Some e); + FStarC_Effect.op_Colon_Equals FStarC_TypeChecker_Normalize_Unfolding.plugin_unfold_warn_ctr (Prims.of_int (10)); FStarC_TypeChecker_Cfg.log_top c @@ -7648,7 +7701,7 @@ let (normalize_with_primitive_steps : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "\nStarting normalizer%s for (%s) {\n" maybe_nbe uu___7); FStarC_TypeChecker_Cfg.log_top c @@ -7656,7 +7709,7 @@ let (normalize_with_primitive_steps : let uu___8 = FStarC_Class_Show.show FStarC_TypeChecker_Cfg.showable_cfg c in - FStarC_Compiler_Util.print1 ">>> cfg = %s\n" uu___8); + FStarC_Util.print1 ">>> cfg = %s\n" uu___8); FStarC_Defensive.def_check_scoped FStarC_TypeChecker_Env.hasBinders_env FStarC_Class_Binders.hasNames_term @@ -7664,7 +7717,7 @@ let (normalize_with_primitive_steps : t.FStarC_Syntax_Syntax.pos "normalize_with_primitive_steps call" e t; (let uu___8 = - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___9 -> if is_nbe then nbe_eval c s t else norm c [] [] t) in match uu___8 with @@ -7677,7 +7730,7 @@ let (normalize_with_primitive_steps : let uu___12 = FStarC_Class_Show.show FStarC_Class_Show.showable_int ms in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "}\nNormalization%s result = (%s) in %s ms\n" maybe_nbe uu___11 uu___12); r))) uu___1 @@ -7714,9 +7767,9 @@ let (normalize_comp : FStarC_Profiling.profile (fun uu___1 -> let cfg = FStarC_TypeChecker_Cfg.config s e in - FStarC_Compiler_Effect.op_Colon_Equals reflection_env_hook + FStarC_Effect.op_Colon_Equals reflection_env_hook (FStar_Pervasives_Native.Some e); - FStarC_Compiler_Effect.op_Colon_Equals + FStarC_Effect.op_Colon_Equals FStarC_TypeChecker_Normalize_Unfolding.plugin_unfold_warn_ctr (Prims.of_int (10)); FStarC_TypeChecker_Cfg.log_top cfg @@ -7724,14 +7777,14 @@ let (normalize_comp : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Starting normalizer for computation (%s) {\n" uu___6); FStarC_TypeChecker_Cfg.log_top cfg (fun uu___6 -> let uu___7 = FStarC_Class_Show.show FStarC_TypeChecker_Cfg.showable_cfg cfg in - FStarC_Compiler_Util.print1 ">>> cfg = %s\n" uu___7); + FStarC_Util.print1 ">>> cfg = %s\n" uu___7); FStarC_Defensive.def_check_scoped FStarC_TypeChecker_Env.hasBinders_env FStarC_Class_Binders.hasNames_comp @@ -7740,7 +7793,7 @@ let (normalize_comp : (let uu___7 = FStarC_Errors.with_ctx "While normalizing a computation type" (fun uu___8 -> - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___9 -> norm_comp cfg [] c)) in match uu___7 with | (c1, ms) -> @@ -7752,7 +7805,7 @@ let (normalize_comp : let uu___11 = FStarC_Class_Show.show FStarC_Class_Show.showable_int ms in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "}\nNormalization result = (%s) in %s ms\n" uu___10 uu___11); c1))) uu___ "FStarC.TypeChecker.Normalize.normalize_comp" @@ -7936,11 +7989,11 @@ let (ghost_to_pure2 : (match uu___1 with | (c11, c21) -> let c1_eff = - FStarC_TypeChecker_Env.norm_eff_name env1 - (FStarC_Syntax_Util.comp_effect_name c11) in + let uu___2 = FStarC_Syntax_Util.comp_effect_name c11 in + FStarC_TypeChecker_Env.norm_eff_name env1 uu___2 in let c2_eff = - FStarC_TypeChecker_Env.norm_eff_name env1 - (FStarC_Syntax_Util.comp_effect_name c21) in + let uu___2 = FStarC_Syntax_Util.comp_effect_name c21 in + FStarC_TypeChecker_Env.norm_eff_name env1 uu___2 in let uu___2 = FStarC_Ident.lid_equals c1_eff c2_eff in if uu___2 then (c11, c21) @@ -8011,14 +8064,12 @@ let (ghost_to_pure_lcomp2 : let uu___7 = ghost_to_pure_lcomp env1 lc11 in (uu___7, lc21) else (lc11, lc21)))) -let (warn_norm_failure : - FStarC_Compiler_Range_Type.range -> Prims.exn -> unit) = +let (warn_norm_failure : FStarC_Range_Type.range -> Prims.exn -> unit) = fun r -> fun e -> let uu___ = - let uu___1 = FStarC_Compiler_Util.message_of_exn e in - FStarC_Compiler_Util.format1 "Normalization failed with error %s\n" - uu___1 in + let uu___1 = FStarC_Util.message_of_exn e in + FStarC_Util.format1 "Normalization failed with error %s\n" uu___1 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Warning_NormalizationFailure () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -8122,8 +8173,7 @@ let (normalize_refinement : fun env1 -> fun t0 -> let t = - normalize - (FStarC_Compiler_List.op_At steps [FStarC_TypeChecker_Env.Beta]) + normalize (FStarC_List.op_At steps [FStarC_TypeChecker_Env.Beta]) env1 t0 in FStarC_Syntax_Util.flatten_refinement t let (whnf_steps : FStarC_TypeChecker_Env.step Prims.list) = @@ -8139,7 +8189,7 @@ let (unfold_whnf' : = fun steps -> fun env1 -> - fun t -> normalize (FStarC_Compiler_List.op_At steps whnf_steps) env1 t + fun t -> normalize (FStarC_List.op_At steps whnf_steps) env1 t let (unfold_whnf : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) @@ -8153,7 +8203,7 @@ let (reduce_or_remove_uvar_solutions : fun env1 -> fun t -> normalize - (FStarC_Compiler_List.op_At + (FStarC_List.op_At (if remove then [FStarC_TypeChecker_Env.DefaultUnivsToZero; @@ -8191,8 +8241,8 @@ let (eta_expand_with_type : (match uu___2 with | (actuals, uu___3, uu___4) -> if - (FStarC_Compiler_List.length actuals) = - (FStarC_Compiler_List.length formals) + (FStarC_List.length actuals) = + (FStarC_List.length formals) then e else (let uu___6 = @@ -8233,8 +8283,8 @@ let (eta_expand : (match uu___3 with | (formals, _tres) -> if - (FStarC_Compiler_List.length formals) = - (FStarC_Compiler_List.length args) + (FStarC_List.length formals) = + (FStarC_List.length args) then t else (let uu___5 = @@ -8529,9 +8579,10 @@ let (elim_uvars_aux_tc : { FStarC_Syntax_Syntax.bs1 = binders1; FStarC_Syntax_Syntax.comp = c;_}, FStar_Pervasives.Inl uu___4) -> - (binders1, - (FStar_Pervasives.Inl - (FStarC_Syntax_Util.comp_result c))) + let uu___5 = + let uu___6 = FStarC_Syntax_Util.comp_result c in + FStar_Pervasives.Inl uu___6 in + (binders1, uu___5) | (uu___4, FStar_Pervasives.Inl uu___5) -> ([], (FStar_Pervasives.Inl t3)) | uu___4 -> failwith "Impossible") in @@ -8555,7 +8606,7 @@ let (elim_uvars_aux_t : (FStar_Pervasives.Inl t) in match uu___ with | (univ_names1, binders1, tc) -> - let uu___1 = FStarC_Compiler_Util.left tc in + let uu___1 = FStarC_Util.left tc in (univ_names1, binders1, uu___1) let (elim_uvars_aux_c : FStarC_TypeChecker_Env.env -> @@ -8575,7 +8626,7 @@ let (elim_uvars_aux_c : (FStar_Pervasives.Inr c) in match uu___ with | (univ_names1, binders1, tc) -> - let uu___1 = FStarC_Compiler_Util.right tc in + let uu___1 = FStarC_Util.right tc in (univ_names1, binders1, uu___1) let rec (elim_uvars : FStarC_TypeChecker_Env.env -> @@ -8585,10 +8636,10 @@ let rec (elim_uvars : fun s -> let sigattrs = let uu___ = - FStarC_Compiler_List.map (elim_uvars_aux_t env1 [] []) + FStarC_List.map (elim_uvars_aux_t env1 [] []) s.FStarC_Syntax_Syntax.sigattrs in - FStarC_Compiler_List.map - FStar_Pervasives_Native.__proj__Mktuple3__item___3 uu___ in + FStarC_List.map FStar_Pervasives_Native.__proj__Mktuple3__item___3 + uu___ in let s1 = { FStarC_Syntax_Syntax.sigel = (s.FStarC_Syntax_Syntax.sigel); @@ -8648,7 +8699,7 @@ let rec (elim_uvars : -> let uu___ = let uu___1 = - let uu___2 = FStarC_Compiler_List.map (elim_uvars env1) sigs in + let uu___2 = FStarC_List.map (elim_uvars env1) sigs in { FStarC_Syntax_Syntax.ses = uu___2; FStarC_Syntax_Syntax.lids = lids @@ -8739,7 +8790,7 @@ let rec (elim_uvars : FStarC_Syntax_Syntax.lids1 = lids;_} -> let lbs1 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___ = FStarC_Syntax_Subst.univ_var_opening @@ -8834,12 +8885,12 @@ let rec (elim_uvars : (uu___4, uu___5) in (match uu___3 with | (b_opening, b_closing) -> - let n = FStarC_Compiler_List.length univs in - let n_binders = FStarC_Compiler_List.length binders in + let n = FStarC_List.length univs in + let n_binders = FStarC_List.length binders in let elim_tscheme uu___4 = match uu___4 with | (us, t) -> - let n_us = FStarC_Compiler_List.length us in + let n_us = FStarC_List.length us in let uu___5 = FStarC_Syntax_Subst.open_univ_vars us t in (match uu___5 with @@ -8987,7 +9038,7 @@ let rec (elim_uvars : elim_tscheme ed.FStarC_Syntax_Syntax.combinators in let uu___6 = - FStarC_Compiler_List.map elim_action + FStarC_List.map elim_action ed.FStarC_Syntax_Syntax.actions in { FStarC_Syntax_Syntax.mname = @@ -9231,7 +9282,7 @@ let (get_n_binders' : let uu___ = FStarC_Syntax_Util.arrow_formals_comp t1 in match uu___ with | (bs, c) -> - let len = FStarC_Compiler_List.length bs in + let len = FStarC_List.length bs in (match (bs, c) with | ([], uu___1) when retry -> let uu___2 = unfold_whnf' steps env1 t1 in @@ -9239,7 +9290,7 @@ let (get_n_binders' : | ([], uu___1) when Prims.op_Negation retry -> (bs, c) | (bs1, c1) when len = n1 -> (bs1, c1) | (bs1, c1) when len > n1 -> - let uu___1 = FStarC_Compiler_List.splitAt n1 bs1 in + let uu___1 = FStarC_List.splitAt n1 bs1 in (match uu___1 with | (bs_l, bs_r) -> let uu___2 = @@ -9252,11 +9303,10 @@ let (get_n_binders' : Prims.op_Negation uu___1) -> let uu___1 = - aux true (n1 - len) - (FStarC_Syntax_Util.comp_result c1) in + let uu___2 = FStarC_Syntax_Util.comp_result c1 in + aux true (n1 - len) uu___2 in (match uu___1 with - | (bs', c') -> - ((FStarC_Compiler_List.op_At bs1 bs'), c')) + | (bs', c') -> ((FStarC_List.op_At bs1 bs'), c')) | (bs1, c1) -> (bs1, c1)) in aux true n t let (get_n_binders : @@ -9266,7 +9316,7 @@ let (get_n_binders : (FStarC_Syntax_Syntax.binder Prims.list * FStarC_Syntax_Syntax.comp)) = fun env1 -> fun n -> fun t -> get_n_binders' env1 [] n t let (uu___0 : unit) = - FStarC_Compiler_Effect.op_Colon_Equals __get_n_binders get_n_binders' + FStarC_Effect.op_Colon_Equals __get_n_binders get_n_binders' let (maybe_unfold_head_fv : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> @@ -9321,7 +9371,7 @@ let rec (maybe_unfold_aux : FStarC_Syntax_Syntax.rc_opt1 = rc_opt;_} -> let uu___1 = maybe_unfold_aux env1 t0 in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun t01 -> FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_match @@ -9357,7 +9407,7 @@ let (maybe_unfold_head : fun env1 -> fun t -> let uu___ = maybe_unfold_aux env1 t in - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (normalize [FStarC_TypeChecker_Env.Beta; FStarC_TypeChecker_Env.Iota; diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Normalize_Unfolding.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Normalize_Unfolding.ml similarity index 80% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Normalize_Unfolding.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Normalize_Unfolding.ml index 0c944c36775..069d966e8d1 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Normalize_Unfolding.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Normalize_Unfolding.ml @@ -1,9 +1,10 @@ open Prims -let (plugin_unfold_warn_ctr : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero +let (plugin_unfold_warn_ctr : Prims.int FStarC_Effect.ref) = + FStarC_Util.mk_ref Prims.int_zero type should_unfold_res = | Should_unfold_no | Should_unfold_yes + | Should_unfold_once | Should_unfold_fully | Should_unfold_reify let (uu___is_Should_unfold_no : should_unfold_res -> Prims.bool) = @@ -12,6 +13,9 @@ let (uu___is_Should_unfold_no : should_unfold_res -> Prims.bool) = let (uu___is_Should_unfold_yes : should_unfold_res -> Prims.bool) = fun projectee -> match projectee with | Should_unfold_yes -> true | uu___ -> false +let (uu___is_Should_unfold_once : should_unfold_res -> Prims.bool) = + fun projectee -> + match projectee with | Should_unfold_once -> true | uu___ -> false let (uu___is_Should_unfold_fully : should_unfold_res -> Prims.bool) = fun projectee -> match projectee with | Should_unfold_fully -> true | uu___ -> false @@ -38,19 +42,21 @@ let (should_unfold : match uu___ with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some quals1 -> quals1 in - let yes = (true, false, false) in - let no = (false, false, false) in - let fully = (true, true, false) in - let reif = (true, false, true) in + let yes = (true, false, false, false) in + let no = (false, false, false, false) in + let fully = (true, true, false, false) in + let reif = (true, false, true, false) in + let once = (true, false, false, true) in let yesno b = if b then yes else no in let fullyno b = if b then fully else no in let comb_or l = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___ -> fun uu___1 -> match (uu___, uu___1) with - | ((a, b, c), (x, y, z)) -> ((a || x), (b || y), (c || z))) - l (false, false, false) in + | ((a, b, c, d), (x, y, z, w)) -> + ((a || x), (b || y), (c || z), (d || w))) l + (false, false, false, false) in let default_unfolding uu___ = FStarC_TypeChecker_Cfg.log_unfolding cfg (fun uu___2 -> @@ -67,11 +73,11 @@ let (should_unfold : (FStarC_Class_Show.show_list FStarC_TypeChecker_Env.showable_delta_level) cfg.FStarC_TypeChecker_Cfg.delta_level in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "should_unfold: Reached a %s with delta_depth = %s\n >> Our delta_level is %s\n" uu___3 uu___4 uu___5); (let uu___2 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_TypeChecker_Env.NoDelta -> false @@ -85,8 +91,11 @@ let (should_unfold : uu___4 l) cfg.FStarC_TypeChecker_Cfg.delta_level in yesno uu___2) in let selective_unfold = - ((((FStar_Pervasives_Native.uu___is_Some - (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.unfold_only) + (((((FStar_Pervasives_Native.uu___is_Some + (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.unfold_only) + || + (FStar_Pervasives_Native.uu___is_Some + (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.unfold_once)) || (FStar_Pervasives_Native.uu___is_Some (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.unfold_fully)) @@ -111,18 +120,18 @@ let (should_unfold : let uu___3 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool b in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "should_unfold: For DM4F action %s, should_reify = %s\n" uu___2 uu___3); if b then reif else no) else if (let uu___ = FStarC_TypeChecker_Cfg.find_prim_step cfg fv in - FStarC_Compiler_Option.isSome uu___) + FStarC_Option.isSome uu___) then (FStarC_TypeChecker_Cfg.log_unfolding cfg (fun uu___1 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string " >> It's a primop, not unfolding\n"); no) else @@ -143,14 +152,27 @@ let (should_unfold : uu___7), uu___8), uu___9) when - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Syntax_Syntax.HasMaskedEffect qs -> (FStarC_TypeChecker_Cfg.log_unfolding cfg (fun uu___11 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string " >> HasMaskedEffect, not unfolding\n"); no) + | (uu___, true) when + (FStar_Pervasives_Native.uu___is_Some + (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.unfold_once) + && + (FStarC_Util.for_some + (FStarC_Syntax_Syntax.fv_eq_lid fv) + (FStar_Pervasives_Native.__proj__Some__item__v + (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.unfold_once)) + -> + (FStarC_TypeChecker_Cfg.log_unfolding cfg + (fun uu___2 -> + FStarC_Util.print_string " >> UnfoldOnce\n"); + once) | (FStar_Pervasives_Native.Some (FStar_Pervasives.Inr ({ @@ -176,7 +198,7 @@ let (should_unfold : -> (FStarC_TypeChecker_Cfg.log_unfolding cfg (fun uu___11 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string " >> It's a recursive definition but we're not doing Zeta, not unfolding\n"); no) | (uu___, true) -> @@ -185,7 +207,7 @@ let (should_unfold : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fv in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "should_unfold: Reached a %s with selective unfolding\n" uu___3); (let meets_some_criterion = @@ -201,7 +223,7 @@ let (should_unfold : FStarC_TypeChecker_Env.InliningDelta] (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v qninfo in - FStarC_Compiler_Option.isSome uu___5 in + FStarC_Option.isSome uu___5 in yesno uu___4 else no in let uu___4 = @@ -211,7 +233,7 @@ let (should_unfold : | FStar_Pervasives_Native.None -> no | FStar_Pervasives_Native.Some lids -> let uu___6 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_Syntax_Syntax.fv_eq_lid fv) lids in yesno uu___6 in @@ -222,9 +244,9 @@ let (should_unfold : | FStar_Pervasives_Native.None -> no | FStar_Pervasives_Native.Some lids -> let uu___8 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun at -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun lid -> FStarC_Syntax_Util.is_fvar lid at) lids) attrs in @@ -236,7 +258,7 @@ let (should_unfold : | FStar_Pervasives_Native.None -> no | FStar_Pervasives_Native.Some lids -> let uu___10 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_Syntax_Syntax.fv_eq_lid fv) lids in fullyno uu___10 in @@ -247,9 +269,9 @@ let (should_unfold : | FStar_Pervasives_Native.None -> no | FStar_Pervasives_Native.Some qs -> let uu___12 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun q -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun qual -> let uu___13 = FStarC_Class_Show.show @@ -270,7 +292,7 @@ let (should_unfold : fv in FStarC_Ident.path_of_lid uu___14 in let r = - FStarC_Compiler_Path.search_forest + FStarC_Path.search_forest (FStarC_Class_Ord.ord_eq FStarC_Class_Ord.ord_string) p namespaces in @@ -287,7 +309,7 @@ let (should_unfold : (FStar_Pervasives_Native.uu___is_Some (cfg.FStarC_TypeChecker_Cfg.steps).FStarC_TypeChecker_Cfg.dont_unfold_attr) && - (FStarC_Compiler_List.existsb + (FStarC_List.existsb (fun fa -> FStarC_Syntax_Util.has_attribute attrs fa) (FStar_Pervasives_Native.__proj__Some__item__v @@ -295,7 +317,7 @@ let (should_unfold : -> (FStarC_TypeChecker_Cfg.log_unfolding cfg (fun uu___2 -> - FStarC_Compiler_Util.print_string + FStarC_Util.print_string " >> forbidden by attribute, not unfolding\n"); no) | uu___ -> default_unfolding ()) in @@ -305,33 +327,36 @@ let (should_unfold : FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fv in let uu___3 = let uu___4 = FStarC_Syntax_Syntax.range_of_fv fv in - FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range uu___4 in + FStarC_Class_Show.show FStarC_Range_Ops.showable_range + uu___4 in let uu___4 = FStarC_Class_Show.show - (FStarC_Class_Show.show_tuple3 + (FStarC_Class_Show.show_tuple4 + FStarC_Class_Show.showable_bool FStarC_Class_Show.showable_bool FStarC_Class_Show.showable_bool FStarC_Class_Show.showable_bool) res in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "should_unfold: For %s (%s), unfolding res = %s\n" uu___2 uu___3 uu___4); (let r = match res with - | (false, uu___1, uu___2) -> Should_unfold_no - | (true, false, false) -> Should_unfold_yes - | (true, true, false) -> Should_unfold_fully - | (true, false, true) -> Should_unfold_reify + | (false, uu___1, uu___2, uu___3) -> Should_unfold_no + | (true, false, false, false) -> Should_unfold_yes + | (true, false, false, true) -> Should_unfold_once + | (true, true, false, false) -> Should_unfold_fully + | (true, false, true, false) -> Should_unfold_reify | uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Show.show - (FStarC_Class_Show.show_tuple3 + (FStarC_Class_Show.show_tuple4 + FStarC_Class_Show.showable_bool FStarC_Class_Show.showable_bool FStarC_Class_Show.showable_bool FStarC_Class_Show.showable_bool) res in - FStarC_Compiler_Util.format1 - "Unexpected unfolding result: %s" uu___3 in + FStarC_Util.format1 "Unexpected unfolding result: %s" + uu___3 in failwith uu___2 in (let uu___2 = ((((FStar_Pervasives_Native.uu___is_Some @@ -341,19 +366,18 @@ let (should_unfold : Prims.op_Negation uu___3)) && (r <> Should_unfold_no)) && - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (FStarC_Syntax_Util.is_fvar FStarC_Parser_Const.plugin_attr) attrs)) && - (let uu___3 = - FStarC_Compiler_Effect.op_Bang plugin_unfold_warn_ctr in + (let uu___3 = FStarC_Effect.op_Bang plugin_unfold_warn_ctr in uu___3 > Prims.int_zero) in if uu___2 then let msg = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv fv in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unfolding name which is marked as a plugin: %s" uu___3 in (FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.p @@ -361,10 +385,8 @@ let (should_unfold : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic msg); (let uu___4 = - let uu___5 = - FStarC_Compiler_Effect.op_Bang plugin_unfold_warn_ctr in + let uu___5 = FStarC_Effect.op_Bang plugin_unfold_warn_ctr in uu___5 - Prims.int_one in - FStarC_Compiler_Effect.op_Colon_Equals plugin_unfold_warn_ctr - uu___4)) + FStarC_Effect.op_Colon_Equals plugin_unfold_warn_ctr uu___4)) else ()); r) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_PatternUtils.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_PatternUtils.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_PatternUtils.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_PatternUtils.ml index df0c6fa5525..5232824637b 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_PatternUtils.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_PatternUtils.ml @@ -2,8 +2,8 @@ open Prims type lcomp_with_binder = (FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option * FStarC_TypeChecker_Common.lcomp) -let (dbg_Patterns : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Patterns" +let (dbg_Patterns : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Patterns" let rec (elaborate_pat : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.pat -> FStarC_Syntax_Syntax.pat) @@ -26,7 +26,7 @@ let rec (elaborate_pat : -> p | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let pats1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (p1, imp) -> @@ -52,7 +52,7 @@ let rec (elaborate_pat : FStarC_Errors_Msg.is_error_message_string) (Obj.magic "Too many pattern arguments") | (uu___4::uu___5, []) -> - FStarC_Compiler_List.map + FStarC_List.map (fun fml -> let uu___6 = ((fml.FStarC_Syntax_Syntax.binder_bv), @@ -84,7 +84,7 @@ let rec (elaborate_pat : FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Insufficient pattern arguments (%s)" uu___9 in FStarC_Errors.raise_error @@ -128,7 +128,7 @@ let rec (elaborate_pat : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "This pattern (%s) binds an inaccesible argument; use a wildcard ('_') pattern" uu___7 in FStarC_Errors.raise_error @@ -207,7 +207,7 @@ let (raw_pat_as_exp : | FStarC_Syntax_Syntax.Pat_dot_term eopt -> (match eopt with | FStar_Pervasives_Native.None -> - FStarC_Compiler_Effect.raise Raw_pat_cannot_be_translated + FStarC_Effect.raise Raw_pat_cannot_be_translated | FStar_Pervasives_Native.Some e -> let uu___ = FStarC_Syntax_Subst.compress e in (uu___, bs)) | FStarC_Syntax_Syntax.Pat_var x -> @@ -217,7 +217,7 @@ let (raw_pat_as_exp : (uu___, (x :: bs)) | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let uu___ = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -313,8 +313,7 @@ let (pat_as_exp : | FStarC_Syntax_Syntax.Pat_dot_term eopt -> (match eopt with | FStar_Pervasives_Native.None -> - ((let uu___1 = - FStarC_Compiler_Effect.op_Bang dbg_Patterns in + ((let uu___1 = FStarC_Effect.op_Bang dbg_Patterns in if uu___1 then (if @@ -324,7 +323,7 @@ let (pat_as_exp : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Found a non-instantiated dot pattern in phase2 (%s)\n" uu___2 else ()) @@ -376,7 +375,7 @@ let (pat_as_exp : ([x1], [x1], [], env2, e, g, p1)) | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with @@ -417,9 +416,7 @@ let (pat_as_exp : FStarC_TypeChecker_Env.lookup_datacon env2 uu___4 in match uu___3 with | (us, uu___4) -> - if - (FStarC_Compiler_List.length us) = - Prims.int_zero + if (FStarC_List.length us) = Prims.int_zero then (hd, (FStar_Pervasives_Native.Some [])) else (let uu___6 = @@ -429,19 +426,16 @@ let (pat_as_exp : | (hd, us_opt1) -> let e = FStarC_Syntax_Syntax.mk_Tm_app hd - (FStarC_Compiler_List.rev args) + (FStarC_List.rev args) p1.FStarC_Syntax_Syntax.p in - ((FStarC_Compiler_List.flatten - (FStarC_Compiler_List.rev b)), - (FStarC_Compiler_List.flatten - (FStarC_Compiler_List.rev a)), - (FStarC_Compiler_List.flatten - (FStarC_Compiler_List.rev w)), env2, e, guard, + ((FStarC_List.flatten (FStarC_List.rev b)), + (FStarC_List.flatten (FStarC_List.rev a)), + (FStarC_List.flatten (FStarC_List.rev w)), env2, + e, guard, { FStarC_Syntax_Syntax.v = (FStarC_Syntax_Syntax.Pat_cons - (fv, us_opt1, - (FStarC_Compiler_List.rev pats1))); + (fv, us_opt1, (FStarC_List.rev pats1))); FStarC_Syntax_Syntax.p = (p1.FStarC_Syntax_Syntax.p) }))) in @@ -451,14 +445,14 @@ let (pat_as_exp : match uu___ with | (b, a, w, env2, arg, guard, p3) -> let uu___1 = - FStarC_Compiler_Util.find_dup FStarC_Syntax_Syntax.bv_eq b in + FStarC_Util.find_dup FStarC_Syntax_Syntax.bv_eq b in (match uu___1 with | FStar_Pervasives_Native.Some x -> let m = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in let uu___2 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "The pattern variable \"%s\" was used more than once" m in FStarC_Errors.raise_error diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Positivity.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Positivity.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Positivity.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Positivity.ml index 138f6961b78..24452317471 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Positivity.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Positivity.ml @@ -1,22 +1,22 @@ open Prims -let (dbg_Positivity : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Positivity" +let (dbg_Positivity : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Positivity" let (debug_positivity : FStarC_TypeChecker_Env.env_t -> (unit -> Prims.string) -> unit) = fun env -> fun msg -> - let uu___ = FStarC_Compiler_Effect.op_Bang dbg_Positivity in + let uu___ = FStarC_Effect.op_Bang dbg_Positivity in if uu___ then let uu___1 = let uu___2 = let uu___3 = msg () in Prims.strcat uu___3 "\n" in Prims.strcat "Positivity::" uu___2 in - FStarC_Compiler_Util.print_string uu___1 + FStarC_Util.print_string uu___1 else () let (string_of_lids : FStarC_Ident.lident Prims.list -> Prims.string) = fun lids -> - let uu___ = FStarC_Compiler_List.map FStarC_Ident.string_of_lid lids in - FStarC_Compiler_String.concat ", " uu___ + let uu___ = FStarC_List.map FStarC_Ident.string_of_lid lids in + FStarC_String.concat ", " uu___ let (normalize : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) @@ -78,7 +78,7 @@ let (apply_constr_arrow : FStarC_Class_Show.show FStarC_Ident.showable_lident dlid in let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term dt in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Unexpected application of type parameters %s to a data constructor %s : %s" uu___4 uu___5 uu___6 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range @@ -93,8 +93,7 @@ let (ty_occurs_in : fun t -> let uu___ = FStarC_Syntax_Free.fvars t in FStarC_Class_Setlike.mem () - (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) + (Obj.magic (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) ty_lid (Obj.magic uu___) let rec (term_as_fv_or_name : FStarC_Syntax_Syntax.term -> @@ -203,7 +202,7 @@ let (max_uniformly_recursive_parameters : | uu___ -> FStar_Pervasives_Native.None in aux Prims.int_zero longer shorter in let ty1 = normalize env ty in - let n_params = FStarC_Compiler_List.length params in + let n_params = FStarC_List.length params in let compare_name_bv x y = let uu___ = let uu___1 = @@ -216,16 +215,16 @@ let (max_uniformly_recursive_parameters : let min_l1 f l = min_l n_params f l in let params_to_string uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv) params in - FStarC_Compiler_String.concat ", " uu___1 in + FStarC_String.concat ", " uu___1 in debug_positivity env (fun uu___1 -> let uu___2 = params_to_string () in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ty1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "max_uniformly_recursive_parameters? params=%s in %s" uu___2 uu___3); (let rec aux ty2 = @@ -234,10 +233,10 @@ let (max_uniformly_recursive_parameters : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ty2 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "max_uniformly_recursive_parameters.aux? %s" uu___3); (let uu___2 = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun mutual -> let uu___3 = ty_occurs_in mutual ty2 in Prims.op_Negation uu___3) mutuals in @@ -276,7 +275,7 @@ let (max_uniformly_recursive_parameters : (match uu___7 with | FStarC_Syntax_Syntax.Tm_fvar fv -> let uu___8 = - FStarC_Compiler_List.existsML + FStarC_List.existsML (FStarC_Syntax_Syntax.fv_eq_lid fv) mutuals in if uu___8 @@ -287,7 +286,7 @@ let (max_uniformly_recursive_parameters : let uu___12 = FStarC_Syntax_Print.args_to_string args in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Searching for max matching prefix of params=%s in args=%s" uu___11 uu___12); (let uu___10 = @@ -345,7 +344,7 @@ let (max_uniformly_recursive_parameters : let bs = let uu___11 = FStarC_Syntax_Syntax.pat_bvs p in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder uu___11 in let uu___11 = FStarC_Syntax_Subst.open_term bs t in @@ -368,7 +367,7 @@ let (max_uniformly_recursive_parameters : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ty1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "result: max_uniformly_recursive_parameters(params=%s in %s) = %s" uu___3 uu___4 (Prims.string_of_int res)); res) @@ -399,7 +398,7 @@ let (mark_uniform_type_parameters : (match uu___3 with | (uu___4, ty_param_args) -> let datacon_fields = - FStarC_Compiler_List.filter_map + FStarC_List.filter_map (fun data -> match data.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -420,7 +419,7 @@ let (mark_uniform_type_parameters : let dt1 = let uu___9 = let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___11 -> FStarC_Syntax_Syntax.U_name uu___11) us1 in @@ -439,10 +438,10 @@ let (mark_uniform_type_parameters : else FStar_Pervasives_Native.None | uu___5 -> FStar_Pervasives_Native.None) datas in let ty_param_bvs = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) ty_params in - let n_params = FStarC_Compiler_List.length ty_params in + let n_params = FStarC_List.length ty_params in let min_l1 f l = min_l n_params f l in let max_uniform_prefix = min_l1 datacon_fields @@ -455,11 +454,11 @@ let (mark_uniform_type_parameters : (if max_uniform_prefix < n_params then (let uu___6 = - FStarC_Compiler_List.splitAt max_uniform_prefix + FStarC_List.splitAt max_uniform_prefix ty_param_binders in match uu___6 with | (uu___7, non_uniform_params) -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun param -> if param.FStarC_Syntax_Syntax.binder_positivity @@ -475,7 +474,7 @@ let (mark_uniform_type_parameters : FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder param in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Binder %s is marked strictly positive, but it is not uniformly recursive" uu___10 in FStarC_Errors.raise_error @@ -524,15 +523,15 @@ let (mark_uniform_type_parameters : FStarC_Syntax_Syntax.lids = lids;_} -> let uu___ = - FStarC_Compiler_List.partition + FStarC_List.partition (fun se -> FStarC_Syntax_Syntax.uu___is_Sig_inductive_typ se.FStarC_Syntax_Syntax.sigel) ses in (match uu___ with | (tcs, datas) -> let tcs1 = - FStarC_Compiler_List.map - (fun tc -> mark_tycon_parameters tc datas) tcs in + FStarC_List.map (fun tc -> mark_tycon_parameters tc datas) + tcs in { FStarC_Syntax_Syntax.sigel = (FStarC_Syntax_Syntax.Sig_bundle @@ -641,14 +640,13 @@ let (may_be_an_arity : FStarC_Syntax_Syntax.brs = branches; FStarC_Syntax_Syntax.rc_opt1 = uu___3;_} -> - FStarC_Compiler_List.existsML + FStarC_List.existsML (fun uu___4 -> match uu___4 with | (p, uu___5, t3) -> let bs = let uu___6 = FStarC_Syntax_Syntax.pat_bvs p in - FStarC_Compiler_List.map - FStarC_Syntax_Syntax.mk_binder uu___6 in + FStarC_List.map FStarC_Syntax_Syntax.mk_binder uu___6 in let uu___6 = FStarC_Syntax_Subst.open_term bs t3 in (match uu___6 with | (bs1, t4) -> aux t4)) branches | FStarC_Syntax_Syntax.Tm_meta @@ -678,7 +676,7 @@ let (check_no_index_occurrences_in_arities : let uu___2 = string_of_lids mutuals in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "check_no_index_occurrences of (mutuals %s) in arities of %s" uu___2 uu___3); (let no_occurrence_in_index fv mutuals1 index = @@ -705,7 +703,7 @@ let (check_no_index_occurrences_in_arities : let uu___1 = index in match uu___1 with | (index1, uu___2) -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun mutual -> let uu___3 = let uu___4 = fext_on_domain_index_sub_term index1 in @@ -718,7 +716,7 @@ let (check_no_index_occurrences_in_arities : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term index1 in let uu___7 = FStarC_Ident.string_of_lid fv in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Type %s is not strictly positive since it instantiates a non-uniformly recursive parameter or index %s of %s" uu___5 uu___6 uu___7 in FStarC_Errors.raise_error @@ -729,8 +727,7 @@ let (check_no_index_occurrences_in_arities : (Obj.magic uu___4) else ()) mutuals1 in let no_occurrence_in_indexes fv mutuals1 indexes = - FStarC_Compiler_List.iter (no_occurrence_in_index fv mutuals1) - indexes in + FStarC_List.iter (no_occurrence_in_index fv mutuals1) indexes in let uu___1 = FStarC_Syntax_Util.head_and_args t in match uu___1 with | (head, args) -> @@ -746,7 +743,7 @@ let (check_no_index_occurrences_in_arities : (match uu___3 with | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some n -> - if (FStarC_Compiler_List.length args) <= n + if (FStarC_List.length args) <= n then () else (let uu___5 = @@ -764,11 +761,10 @@ let (check_no_index_occurrences_in_arities : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Checking arity indexes of %s (num uniform params = %s)" uu___9 (Prims.string_of_int n)); - (let uu___8 = - FStarC_Compiler_List.splitAt n args in + (let uu___8 = FStarC_List.splitAt n args in match uu___8 with | (params, indices) -> let inst_i_typ = @@ -804,7 +800,7 @@ let (check_no_index_occurrences_in_arities : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Checking %s : %s (arity)" uu___14 uu___15); no_occurrence_in_index @@ -822,7 +818,7 @@ let (check_no_index_occurrences_in_arities : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Skipping %s : %s (non-arity)" uu___14 uu___15)); (let subst1 = @@ -845,8 +841,7 @@ let (mutuals_unused_in_type : fun mutuals -> fun t -> let mutuals_occur_in t1 = - FStarC_Compiler_Util.for_some (fun lid -> ty_occurs_in lid t1) - mutuals in + FStarC_Util.for_some (fun lid -> ty_occurs_in lid t1) mutuals in let rec ok t1 = let uu___ = let uu___1 = mutuals_occur_in t1 in Prims.op_Negation uu___1 in @@ -884,7 +879,7 @@ let (mutuals_unused_in_type : if uu___3 then false else - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___5 -> match uu___5 with | (a, qual) -> @@ -901,7 +896,7 @@ let (mutuals_unused_in_type : FStarC_Syntax_Syntax.rc_opt1 = uu___4;_} -> (ok t2) && - (FStarC_Compiler_List.for_all + (FStarC_List.for_all (fun uu___5 -> match uu___5 with | (uu___6, uu___7, br) -> ok br) branches) @@ -914,7 +909,7 @@ let (mutuals_unused_in_type : { FStarC_Syntax_Syntax.lbs = (uu___3, lbs); FStarC_Syntax_Syntax.body1 = t2;_} -> - (FStarC_Compiler_List.for_all + (FStarC_List.for_all (fun lb -> (ok lb.FStarC_Syntax_Syntax.lbtyp) && (ok lb.FStarC_Syntax_Syntax.lbdef)) lbs) @@ -927,7 +922,7 @@ let (mutuals_unused_in_type : -> ok t2 | uu___3 -> false) and binders_ok bs = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun b -> ok (b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort) bs @@ -937,13 +932,13 @@ let (mutuals_unused_in_type : | FStarC_Syntax_Syntax.GTotal t1 -> ok t1 | FStarC_Syntax_Syntax.Comp c1 -> (ok c1.FStarC_Syntax_Syntax.result_typ) && - (FStarC_Compiler_List.for_all + (FStarC_List.for_all (fun uu___ -> match uu___ with | (a, uu___1) -> ok a) c1.FStarC_Syntax_Syntax.effect_args) in ok t type unfolded_memo_elt = (FStarC_Ident.lident * FStarC_Syntax_Syntax.args * Prims.int) Prims.list -type unfolded_memo_t = unfolded_memo_elt FStarC_Compiler_Effect.ref +type unfolded_memo_t = unfolded_memo_elt FStarC_Effect.ref let (already_unfolded : FStarC_Ident.lident -> FStarC_Syntax_Syntax.args -> @@ -953,18 +948,18 @@ let (already_unfolded : fun args -> fun unfolded -> fun env -> - let uu___ = FStarC_Compiler_Effect.op_Bang unfolded in - FStarC_Compiler_List.existsML + let uu___ = FStarC_Effect.op_Bang unfolded in + FStarC_List.existsML (fun uu___1 -> match uu___1 with | (lid, l, n) -> ((FStarC_Ident.lid_equals lid ilid) && - ((FStarC_Compiler_List.length args) >= n)) + ((FStarC_List.length args) >= n)) && (let args1 = - let uu___2 = FStarC_Compiler_List.splitAt n args in + let uu___2 = FStarC_List.splitAt n args in FStar_Pervasives_Native.fst uu___2 in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun b -> fun a -> fun a' -> @@ -989,11 +984,11 @@ let rec (ty_strictly_positive_in_type : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term in_type1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Checking strict positivity of {%s} in type, after normalization %s " uu___2 uu___3); (let uu___1 = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun mutual -> let uu___2 = ty_occurs_in mutual in_type1 in Prims.op_Negation uu___2) mutuals in @@ -1043,7 +1038,7 @@ let rec (ty_strictly_positive_in_type : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Failed to check positivity of %s in a term with head %s" uu___7 uu___8); false) @@ -1065,7 +1060,7 @@ let rec (ty_strictly_positive_in_type : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term head_ty in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Tm_app, head bv, in_type=%s, head_bv=%s, head_ty=%s" uu___8 uu___9 uu___10); ty_strictly_positive_in_args env mutuals @@ -1073,7 +1068,7 @@ let rec (ty_strictly_positive_in_type : | FStar_Pervasives_Native.Some (FStar_Pervasives.Inl (fv, us)) -> let uu___5 = - FStarC_Compiler_List.existsML + FStarC_List.existsML (FStarC_Ident.lid_equals (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v) mutuals in @@ -1084,10 +1079,10 @@ let rec (ty_strictly_positive_in_type : let uu___8 = FStarC_Ident.string_of_lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Checking strict positivity in the Tm_app node where head lid is %s itself, checking that ty does not occur in the arguments" uu___8); - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___7 -> match uu___7 with | (t1, uu___8) -> @@ -1096,7 +1091,7 @@ let rec (ty_strictly_positive_in_type : (debug_positivity env (fun uu___8 -> let uu___9 = string_of_lids mutuals in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Checking strict positivity in the Tm_app node, head lid is not in %s, so checking nested positivity" uu___9); ty_strictly_positive_in_arguments_to_fvar env @@ -1113,11 +1108,12 @@ let rec (ty_strictly_positive_in_type : (FStarC_Syntax_Util.is_pure_or_ghost_comp c) || (let uu___7 = let uu___8 = - FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + let uu___9 = + FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Env.norm_eff_name env uu___9 in FStarC_TypeChecker_Env.lookup_effect_quals env uu___8 in - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Syntax_Syntax.TotalEffect uu___7) in if Prims.op_Negation check_comp then @@ -1136,7 +1132,7 @@ let rec (ty_strictly_positive_in_type : let return_type = FStarC_Syntax_Util.comp_result c1 in let ty_lid_not_to_left_of_arrow = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___10 -> match uu___10 with | { FStarC_Syntax_Syntax.binder_bv = b; @@ -1191,26 +1187,26 @@ let rec (ty_strictly_positive_in_type : (fun uu___8 -> "Checking strict positivity in an Tm_match, recur in the branches)"); (let uu___8 = - FStarC_Compiler_List.existsML + FStarC_List.existsML (fun mutual -> ty_occurs_in mutual scrutinee) mutuals in if uu___8 then - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___9 -> match uu___9 with | (p, uu___10, t) -> let bs = let uu___11 = FStarC_Syntax_Syntax.pat_bvs p in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder uu___11 in let uu___11 = FStarC_Syntax_Subst.open_term bs t in (match uu___11 with | (bs1, t1) -> let uu___12 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___13 -> fun b -> match uu___13 with @@ -1227,14 +1223,14 @@ let rec (ty_strictly_positive_in_type : ty_strictly_positive_in_type env mutuals1 t2 unfolded))) branches else - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___10 -> match uu___10 with | (p, uu___11, t) -> let bs = let uu___12 = FStarC_Syntax_Syntax.pat_bvs p in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder uu___12 in let uu___12 = FStarC_Syntax_Subst.open_term bs t in @@ -1276,7 +1272,7 @@ let rec (ty_strictly_positive_in_type : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term in_type1 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Checking strict positivity, unexpected tag: %s and term %s" uu___8 uu___9); false)))) @@ -1298,7 +1294,7 @@ and (ty_strictly_positive_in_args : match (bs1, args1) with | (uu___2, []) -> true | ([], uu___2) -> - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___3 -> match uu___3 with | (arg, uu___4) -> @@ -1313,7 +1309,7 @@ and (ty_strictly_positive_in_args : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Checking positivity of %s in argument %s and binder %s" uu___5 uu___6 uu___7); (let this_occurrence_ok = @@ -1336,7 +1332,7 @@ and (ty_strictly_positive_in_args : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Failed checking positivity of %s in argument %s and binder %s" uu___6 uu___7 uu___8); false) @@ -1365,13 +1361,13 @@ and (ty_strictly_positive_in_arguments_to_fvar : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Checking positivity of %s in application of fv %s to %s (t=%s)" uu___2 uu___3 uu___4 uu___5); (let uu___1 = FStarC_TypeChecker_Env.is_datacon env fv in if uu___1 then - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___2 -> match uu___2 with | (a, uu___3) -> @@ -1387,7 +1383,7 @@ and (ty_strictly_positive_in_arguments_to_fvar : | uu___4 -> let uu___5 = let uu___6 = FStarC_Ident.string_of_lid fv in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Type of %s not found when checking positivity" uu___6 in FStarC_Errors.raise_error @@ -1418,8 +1414,7 @@ and (ty_strictly_positive_in_arguments_to_fvar : failwith "Unexpected type" | FStar_Pervasives_Native.Some n -> n in let uu___6 = - FStarC_Compiler_List.splitAt num_uniform_params - args in + FStarC_List.splitAt num_uniform_params args in match uu___6 with | (params, _rest) -> let uu___7 = @@ -1438,20 +1433,19 @@ and (ty_strictly_positive_in_arguments_to_fvar : let uu___12 = FStarC_Syntax_Print.args_to_string params in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Checking positivity in datacon, number of type parameters is %s, adding %s %s to the memo table" (Prims.string_of_int num_uniform_params) uu___11 uu___12); (let uu___11 = let uu___12 = - FStarC_Compiler_Effect.op_Bang - unfolded in + FStarC_Effect.op_Bang unfolded in FStar_List_Tot_Base.op_At uu___12 [(ilid, params, num_uniform_params)] in - FStarC_Compiler_Effect.op_Colon_Equals - unfolded uu___11); - FStarC_Compiler_List.for_all + FStarC_Effect.op_Colon_Equals unfolded + uu___11); + FStarC_List.for_all (fun d -> ty_strictly_positive_in_datacon_of_applied_inductive env mutuals d ilid us args @@ -1478,7 +1472,7 @@ and (ty_strictly_positive_in_datacon_of_applied_inductive : let uu___2 = string_of_lids mutuals in let uu___3 = FStarC_Ident.string_of_lid dlid in let uu___4 = FStarC_Ident.string_of_lid ilid in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Checking positivity of %s in data constructor %s : %s" uu___2 uu___3 uu___4); (let dt = @@ -1491,7 +1485,7 @@ and (ty_strictly_positive_in_datacon_of_applied_inductive : let uu___2 = FStarC_Ident.range_of_lid dlid in let uu___3 = let uu___4 = FStarC_Ident.string_of_lid dlid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Data constructor %s not found when checking positivity" uu___4 in FStarC_Errors.raise_error @@ -1507,10 +1501,10 @@ and (ty_strictly_positive_in_datacon_of_applied_inductive : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term dt in let uu___4 = FStarC_Syntax_Print.args_to_string args in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Checking positivity in the data constructor type: %s\n\tnum_ibs=%s, args=%s," uu___3 (Prims.string_of_int num_ibs) uu___4); - (let uu___2 = FStarC_Compiler_List.splitAt num_ibs args in + (let uu___2 = FStarC_List.splitAt num_ibs args in match uu___2 with | (args1, rest) -> let applied_dt = apply_constr_arrow dlid dt args1 in @@ -1523,7 +1517,7 @@ and (ty_strictly_positive_in_datacon_of_applied_inductive : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term applied_dt in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Applied data constructor type: %s %s : %s" uu___5 uu___6 uu___7); (let uu___4 = @@ -1547,7 +1541,7 @@ and (ty_strictly_positive_in_datacon_of_applied_inductive : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term (f.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Checking field %s : %s for indexes and positivity" uu___8 uu___9); check_no_index_occurrences_in_arities @@ -1577,7 +1571,7 @@ let (name_strictly_positive_in_type : let uu___ = name_as_fv_in_t t bv in match uu___ with | (t1, fv_lid) -> - let uu___1 = FStarC_Compiler_Util.mk_ref [] in + let uu___1 = FStarC_Util.mk_ref [] in ty_strictly_positive_in_type env [fv_lid] t1 uu___1 let (name_unused_in_type : FStarC_TypeChecker_Env.env -> @@ -1614,7 +1608,7 @@ let (ty_strictly_positive_in_datacon_decl : | FStar_Pervasives_Native.None -> let uu___1 = let uu___2 = FStarC_Ident.string_of_lid dlid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Error looking up data constructor %s when checking positivity" uu___2 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident @@ -1641,7 +1635,7 @@ let (ty_strictly_positive_in_datacon_decl : (let check_annotated_binders_are_strictly_positive_in_field f = let incorrectly_annotated_binder = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun b -> ((FStarC_Syntax_Util.is_binder_unused b) && @@ -1666,14 +1660,16 @@ let (ty_strictly_positive_in_datacon_decl : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - FStarC_Compiler_Util.format2 + let uu___6 = + let uu___7 = + FStarC_Syntax_Util.is_binder_strictly_positive + b in + if uu___7 + then "strictly_positive" + else "unused" in + FStarC_Util.format2 "Binder %s is marked %s, but its use in the definition is not" - uu___5 - (if - FStarC_Syntax_Util.is_binder_strictly_positive - b - then "strictly_positive" - else "unused") in + uu___5 uu___6 in FStarC_Errors.raise_error FStarC_Syntax_Syntax.hasRange_binder b FStarC_Errors_Codes.Error_InductiveTypeNotSatisfyPositivityCondition @@ -1710,27 +1706,27 @@ let (check_strict_positivity : fun env -> fun mutuals -> fun ty -> - let unfolded_inductives = FStarC_Compiler_Util.mk_ref [] in + let unfolded_inductives = FStarC_Util.mk_ref [] in let uu___ = open_sig_inductive_typ env ty in match uu___ with | (env1, (ty_lid, ty_us, ty_params)) -> let mutuals1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun m -> let uu___1 = FStarC_TypeChecker_Env.is_datacon env1 m in Prims.op_Negation uu___1) mutuals in let mutuals2 = let uu___1 = - FStarC_Compiler_List.existsML - (FStarC_Ident.lid_equals ty_lid) mutuals1 in + FStarC_List.existsML (FStarC_Ident.lid_equals ty_lid) + mutuals1 in if uu___1 then mutuals1 else ty_lid :: mutuals1 in let datacons = let uu___1 = FStarC_TypeChecker_Env.datacons_of_typ env1 ty_lid in FStar_Pervasives_Native.snd uu___1 in let us = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> FStarC_Syntax_Syntax.U_name uu___1) ty_us in - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun d -> ty_strictly_positive_in_datacon_decl env1 mutuals2 d ty_params us unfolded_inductives) datacons @@ -1738,6 +1734,6 @@ let (check_exn_strict_positivity : FStarC_TypeChecker_Env.env -> FStarC_Ident.lident -> Prims.bool) = fun env -> fun data_ctor_lid -> - let unfolded_inductives = FStarC_Compiler_Util.mk_ref [] in + let unfolded_inductives = FStarC_Util.mk_ref [] in ty_strictly_positive_in_datacon_decl env [FStarC_Parser_Const.exn_lid] data_ctor_lid [] [] unfolded_inductives \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops.ml index 26c515379aa..476c20b98cd 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops.ml @@ -104,7 +104,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) (FStarC_TypeChecker_NBETerm.e_option FStarC_TypeChecker_NBETerm.e_int) (fun uu___3 -> (fun s -> - let uu___3 = FStarC_Compiler_Util.safe_int_of_string s in + let uu___3 = FStarC_Util.safe_int_of_string s in Obj.magic (FStarC_Class_Monad.fmap FStarC_Class_Monad.monad_option () () @@ -260,7 +260,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) FStarC_TypeChecker_NBETerm.e_string_list FStarC_Syntax_Embeddings.e_string FStarC_TypeChecker_NBETerm.e_string - FStarC_Compiler_String.concat in + FStarC_String.concat in let uu___31 = let uu___32 = FStarC_TypeChecker_Primops_Base.mk2 @@ -274,7 +274,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) FStarC_TypeChecker_NBETerm.e_string FStarC_Syntax_Embeddings.e_string_list FStarC_TypeChecker_NBETerm.e_string_list - FStarC_Compiler_String.split in + FStarC_String.split in let uu___33 = let uu___34 = FStarC_TypeChecker_Primops_Base.mk2 @@ -302,8 +302,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) (fun s1 -> fun s2 -> FStarC_BigInt.of_int_fs - (FStarC_Compiler_String.compare - s1 s2)) in + (FStarC_String.compare s1 s2)) in let uu___37 = let uu___38 = FStarC_TypeChecker_Primops_Base.mk1 @@ -332,8 +331,8 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) let uu___41 = FStarC_BigInt.to_int_fs x in - FStarC_Compiler_String.make - uu___41 y) in + FStarC_String.make uu___41 + y) in let uu___41 = let uu___42 = FStarC_TypeChecker_Primops_Base.mk1 @@ -355,7 +354,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) FStarC_TypeChecker_NBETerm.e_string FStarC_Syntax_Embeddings.e_string FStarC_TypeChecker_NBETerm.e_string - FStarC_Compiler_String.lowercase in + FStarC_String.lowercase in let uu___45 = let uu___46 = FStarC_TypeChecker_Primops_Base.mk1 @@ -365,7 +364,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) FStarC_TypeChecker_NBETerm.e_string FStarC_Syntax_Embeddings.e_string FStarC_TypeChecker_NBETerm.e_string - FStarC_Compiler_String.uppercase in + FStarC_String.uppercase in let uu___47 = let uu___48 = FStarC_TypeChecker_Primops_Base.mk2 @@ -377,7 +376,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) FStarC_TypeChecker_NBETerm.e_int FStarC_Syntax_Embeddings.e_char FStarC_TypeChecker_NBETerm.e_char - FStarC_Compiler_String.index in + FStarC_String.index in let uu___49 = let uu___50 = FStarC_TypeChecker_Primops_Base.mk2 @@ -389,7 +388,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) FStarC_TypeChecker_NBETerm.e_char FStarC_Syntax_Embeddings.e_int FStarC_TypeChecker_NBETerm.e_int - FStarC_Compiler_String.index_of in + FStarC_String.index_of in let uu___51 = let uu___52 = FStarC_TypeChecker_Primops_Base.mk3 @@ -414,7 +413,7 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_BigInt.to_int_fs l in - FStarC_Compiler_String.substring + FStarC_String.substring s uu___53 uu___54) in [uu___52] in @@ -446,28 +445,25 @@ let (simple_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) uu___ :: uu___1 let (short_circuit_ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = - FStarC_Compiler_List.map (as_primitive_step true) + FStarC_List.map (as_primitive_step true) [(FStarC_Parser_Const.op_And, (Prims.of_int (2)), Prims.int_zero, and_op, ((fun _us -> FStarC_TypeChecker_NBETerm.and_op))); (FStarC_Parser_Const.op_Or, (Prims.of_int (2)), Prims.int_zero, or_op, ((fun _us -> FStarC_TypeChecker_NBETerm.or_op)))] let (built_in_primitive_steps_list : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = - FStarC_Compiler_List.op_At simple_ops - (FStarC_Compiler_List.op_At short_circuit_ops - (FStarC_Compiler_List.op_At FStarC_TypeChecker_Primops_Issue.ops - (FStarC_Compiler_List.op_At FStarC_TypeChecker_Primops_Array.ops - (FStarC_Compiler_List.op_At - FStarC_TypeChecker_Primops_Sealed.ops - (FStarC_Compiler_List.op_At - FStarC_TypeChecker_Primops_Erased.ops - (FStarC_Compiler_List.op_At - FStarC_TypeChecker_Primops_Docs.ops - (FStarC_Compiler_List.op_At + FStarC_List.op_At simple_ops + (FStarC_List.op_At short_circuit_ops + (FStarC_List.op_At FStarC_TypeChecker_Primops_Issue.ops + (FStarC_List.op_At FStarC_TypeChecker_Primops_Array.ops + (FStarC_List.op_At FStarC_TypeChecker_Primops_Sealed.ops + (FStarC_List.op_At FStarC_TypeChecker_Primops_Erased.ops + (FStarC_List.op_At FStarC_TypeChecker_Primops_Docs.ops + (FStarC_List.op_At FStarC_TypeChecker_Primops_MachineInts.ops - (FStarC_Compiler_List.op_At + (FStarC_List.op_At FStarC_TypeChecker_Primops_Errors_Msg.ops - (FStarC_Compiler_List.op_At + (FStarC_List.op_At FStarC_TypeChecker_Primops_Range.ops FStarC_TypeChecker_Primops_Real.ops))))))))) let (env_dependent_ops : @@ -480,5 +476,4 @@ let (simplification_ops_list : = fun env -> let uu___ = FStarC_TypeChecker_Primops_Eq.prop_eq_ops env in - FStarC_Compiler_List.op_At uu___ - FStarC_TypeChecker_Primops_Real.simplify_ops \ No newline at end of file + FStarC_List.op_At uu___ FStarC_TypeChecker_Primops_Real.simplify_ops \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Array.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Array.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Array.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Array.ml index 262d85d9e06..e418dc9a54c 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Array.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Array.ml @@ -35,9 +35,8 @@ let mixed_binary_op : 'a 'b 'c . (FStarC_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> (FStarC_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> - (FStarC_Compiler_Range_Type.range -> 'c -> FStarC_Syntax_Syntax.term) - -> - (FStarC_Compiler_Range_Type.range -> + (FStarC_Range_Type.range -> 'c -> FStarC_Syntax_Syntax.term) -> + (FStarC_Range_Type.range -> FStarC_Syntax_Syntax.universes -> 'a -> 'b -> 'c FStar_Pervasives_Native.option) -> @@ -81,10 +80,8 @@ let mixed_ternary_op : (FStarC_Syntax_Syntax.arg -> 'a FStar_Pervasives_Native.option) -> (FStarC_Syntax_Syntax.arg -> 'b FStar_Pervasives_Native.option) -> (FStarC_Syntax_Syntax.arg -> 'c FStar_Pervasives_Native.option) -> - (FStarC_Compiler_Range_Type.range -> - 'd -> FStarC_Syntax_Syntax.term) - -> - (FStarC_Compiler_Range_Type.range -> + (FStarC_Range_Type.range -> 'd -> FStarC_Syntax_Syntax.term) -> + (FStarC_Range_Type.range -> FStarC_Syntax_Syntax.universes -> 'a -> 'b -> 'c -> 'd FStar_Pervasives_Native.option) -> @@ -314,8 +311,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Syntax_Embeddings.e_int r i in let run_op blob = let uu___ = - let uu___1 = FStarC_Dyn.undyn blob in - FStarC_Compiler_Util.array_length uu___1 in + let uu___1 = FStarC_Dyn.undyn blob in FStarC_Util.array_length uu___1 in FStar_Pervasives_Native.Some uu___ in (FStarC_Parser_Const.immutable_array_length_lid, (Prims.of_int (2)), Prims.int_one, @@ -342,7 +338,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = fun i -> let uu___ = let uu___1 = FStarC_Dyn.undyn blob in - FStarC_Compiler_Util.array_index uu___1 i in + FStarC_Util.array_index uu___1 i in FStar_Pervasives_Native.Some uu___)), (FStarC_TypeChecker_NBETerm.mixed_ternary_op (fun uu___ -> @@ -356,7 +352,6 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = fun i -> let uu___ = let uu___1 = FStarC_Dyn.undyn blob in - FStarC_Compiler_Util.array_index uu___1 i in + FStarC_Util.array_index uu___1 i in FStar_Pervasives_Native.Some uu___))) in - FStarC_Compiler_List.map (as_primitive_step true) - [of_list_op; length_op; index_op] \ No newline at end of file + FStarC_List.map (as_primitive_step true) [of_list_op; length_op; index_op] \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Base.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Base.ml similarity index 99% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Base.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Base.ml index 5b3d48a13e0..d692bb777c8 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Base.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Base.ml @@ -1,10 +1,9 @@ open Prims type psc = { - psc_range: FStarC_Compiler_Range_Type.range ; + psc_range: FStarC_Range_Type.range ; psc_subst: unit -> FStarC_Syntax_Syntax.subst_t } -let (__proj__Mkpsc__item__psc_range : - psc -> FStarC_Compiler_Range_Type.range) = +let (__proj__Mkpsc__item__psc_range : psc -> FStarC_Range_Type.range) = fun projectee -> match projectee with | { psc_range; psc_subst;_} -> psc_range let (__proj__Mkpsc__item__psc_subst : @@ -12,12 +11,8 @@ let (__proj__Mkpsc__item__psc_subst : fun projectee -> match projectee with | { psc_range; psc_subst;_} -> psc_subst let (null_psc : psc) = - { - psc_range = FStarC_Compiler_Range_Type.dummyRange; - psc_subst = (fun uu___ -> []) - } -let (psc_range : psc -> FStarC_Compiler_Range_Type.range) = - fun psc1 -> psc1.psc_range + { psc_range = FStarC_Range_Type.dummyRange; psc_subst = (fun uu___ -> []) } +let (psc_range : psc -> FStarC_Range_Type.range) = fun psc1 -> psc1.psc_range let (psc_subst : psc -> FStarC_Syntax_Syntax.subst_t) = fun psc1 -> psc1.psc_subst () type interp_t = @@ -107,7 +102,7 @@ let (__proj__Mkprimitive_step__item__interpretation_nbe : let embed_simple : 'a . 'a FStarC_Syntax_Embeddings_Base.embedding -> - FStarC_Compiler_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term + FStarC_Range_Type.range -> 'a -> FStarC_Syntax_Syntax.term = fun uu___ -> fun r -> diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Docs.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Docs.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Docs.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Docs.ml diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Eq.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Eq.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Eq.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Eq.ml diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Erased.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Erased.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Erased.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Erased.ml diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Errors_Msg.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Errors_Msg.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Errors_Msg.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Errors_Msg.ml diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Issue.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Issue.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Issue.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Issue.ml diff --git a/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_MachineInts.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_MachineInts.ml new file mode 100644 index 00000000000..d714d2078bd --- /dev/null +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_MachineInts.ml @@ -0,0 +1,585 @@ +open Prims +type 'a mymon = + (FStarC_TypeChecker_Primops_Base.primitive_step Prims.list, unit, 'a) + FStarC_Writer.writer +let (bounded_arith_ops_for : FStarC_MachineInts.machint_kind -> unit mymon) = + fun k -> + let mod_name = FStarC_MachineInts.module_name_for k in + let nm s = + let uu___ = + let uu___1 = + let uu___2 = FStarC_MachineInts.module_name_for k in [uu___2; s] in + "FStar" :: uu___1 in + FStarC_Parser_Const.p2l uu___ in + let uu___ = + let uu___1 = + let uu___2 = + let uu___3 = nm "v" in + FStarC_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___3 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) FStarC_Syntax_Embeddings.e_int + FStarC_TypeChecker_NBETerm.e_int (FStarC_MachineInts.v k) in + let uu___3 = + let uu___4 = + let uu___5 = nm "add" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___5 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___6 = + let uu___7 = FStarC_MachineInts.v k x in + let uu___8 = FStarC_MachineInts.v k y in + FStarC_BigInt.add_big_int uu___7 uu___8 in + FStarC_MachineInts.make_as k x uu___6) in + let uu___5 = + let uu___6 = + let uu___7 = nm "sub" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___7 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___8 = + let uu___9 = FStarC_MachineInts.v k x in + let uu___10 = FStarC_MachineInts.v k y in + FStarC_BigInt.sub_big_int uu___9 uu___10 in + FStarC_MachineInts.make_as k x uu___8) in + let uu___7 = + let uu___8 = + let uu___9 = nm "mul" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___9 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___10 = + let uu___11 = FStarC_MachineInts.v k x in + let uu___12 = FStarC_MachineInts.v k y in + FStarC_BigInt.mult_big_int uu___11 uu___12 in + FStarC_MachineInts.make_as k x uu___10) in + let uu___9 = + let uu___10 = + let uu___11 = nm "gt" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___11 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + FStarC_Syntax_Embeddings.e_bool + FStarC_TypeChecker_NBETerm.e_bool + (fun x -> + fun y -> + let uu___12 = FStarC_MachineInts.v k x in + let uu___13 = FStarC_MachineInts.v k y in + FStarC_BigInt.gt_big_int uu___12 uu___13) in + let uu___11 = + let uu___12 = + let uu___13 = nm "gte" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero + uu___13 (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + FStarC_Syntax_Embeddings.e_bool + FStarC_TypeChecker_NBETerm.e_bool + (fun x -> + fun y -> + let uu___14 = FStarC_MachineInts.v k x in + let uu___15 = FStarC_MachineInts.v k y in + FStarC_BigInt.ge_big_int uu___14 uu___15) in + let uu___13 = + let uu___14 = + let uu___15 = nm "lt" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero + uu___15 (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + FStarC_Syntax_Embeddings.e_bool + FStarC_TypeChecker_NBETerm.e_bool + (fun x -> + fun y -> + let uu___16 = FStarC_MachineInts.v k x in + let uu___17 = FStarC_MachineInts.v k y in + FStarC_BigInt.lt_big_int uu___16 uu___17) in + let uu___15 = + let uu___16 = + let uu___17 = nm "lte" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero + uu___17 (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + FStarC_Syntax_Embeddings.e_bool + FStarC_TypeChecker_NBETerm.e_bool + (fun x -> + fun y -> + let uu___18 = FStarC_MachineInts.v k x in + let uu___19 = FStarC_MachineInts.v k y in + FStarC_BigInt.le_big_int uu___18 uu___19) in + [uu___16] in + uu___14 :: uu___15 in + uu___12 :: uu___13 in + uu___10 :: uu___11 in + uu___8 :: uu___9 in + uu___6 :: uu___7 in + uu___4 :: uu___5 in + uu___2 :: uu___3 in + FStarC_Writer.emit (FStarC_Class_Monoid.monoid_list ()) uu___1 in + FStarC_Class_Monad.op_let_Bang + (FStarC_Writer.monad_writer (FStarC_Class_Monoid.monoid_list ())) () () + uu___ + (fun uu___1 -> + (fun uu___1 -> + let uu___1 = Obj.magic uu___1 in + let sz = FStarC_MachineInts.width k in + let modulus = + let uu___2 = FStarC_BigInt.of_int_fs sz in + FStarC_BigInt.shift_left_big_int FStarC_BigInt.one uu___2 in + let mod1 x = FStarC_BigInt.mod_big_int x modulus in + let uu___2 = + let uu___3 = FStarC_MachineInts.is_unsigned k in + if uu___3 + then + let uu___4 = + let uu___5 = + let uu___6 = nm "add_mod" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___6 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___7 = + let uu___8 = + let uu___9 = FStarC_MachineInts.v k x in + let uu___10 = FStarC_MachineInts.v k y in + FStarC_BigInt.add_big_int uu___9 uu___10 in + mod1 uu___8 in + FStarC_MachineInts.make_as k x uu___7) in + let uu___6 = + let uu___7 = + let uu___8 = nm "sub_mod" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero + uu___8 (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___9 = + let uu___10 = + let uu___11 = FStarC_MachineInts.v k x in + let uu___12 = FStarC_MachineInts.v k y in + FStarC_BigInt.sub_big_int uu___11 uu___12 in + mod1 uu___10 in + FStarC_MachineInts.make_as k x uu___9) in + let uu___8 = + let uu___9 = + let uu___10 = nm "div" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero + uu___10 (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___11 = + let uu___12 = + let uu___13 = FStarC_MachineInts.v k x in + let uu___14 = FStarC_MachineInts.v k y in + FStarC_BigInt.div_big_int uu___13 uu___14 in + mod1 uu___12 in + FStarC_MachineInts.make_as k x uu___11) in + let uu___10 = + let uu___11 = + let uu___12 = nm "rem" in + FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero + uu___12 (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___13 = + let uu___14 = + let uu___15 = FStarC_MachineInts.v k x in + let uu___16 = FStarC_MachineInts.v k y in + FStarC_BigInt.mod_big_int uu___15 + uu___16 in + mod1 uu___14 in + FStarC_MachineInts.make_as k x uu___13) in + let uu___12 = + let uu___13 = + let uu___14 = nm "logor" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___14 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___15 = + let uu___16 = FStarC_MachineInts.v k x in + let uu___17 = FStarC_MachineInts.v k y in + FStarC_BigInt.logor_big_int uu___16 + uu___17 in + FStarC_MachineInts.make_as k x uu___15) in + let uu___14 = + let uu___15 = + let uu___16 = nm "logand" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___16 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___17 = + let uu___18 = FStarC_MachineInts.v k x in + let uu___19 = FStarC_MachineInts.v k y in + FStarC_BigInt.logand_big_int uu___18 + uu___19 in + FStarC_MachineInts.make_as k x uu___17) in + let uu___16 = + let uu___17 = + let uu___18 = nm "logxor" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___18 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___19 = + let uu___20 = + FStarC_MachineInts.v k x in + let uu___21 = + FStarC_MachineInts.v k y in + FStarC_BigInt.logxor_big_int uu___20 + uu___21 in + FStarC_MachineInts.make_as k x uu___19) in + let uu___18 = + let uu___19 = + let uu___20 = nm "lognot" in + FStarC_TypeChecker_Primops_Base.mk1 + Prims.int_zero uu___20 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + let uu___21 = + let uu___22 = + let uu___23 = + FStarC_MachineInts.v k x in + FStarC_BigInt.lognot_big_int + uu___23 in + let uu___23 = + FStarC_MachineInts.mask k in + FStarC_BigInt.logand_big_int uu___22 + uu___23 in + FStarC_MachineInts.make_as k x uu___21) in + let uu___20 = + let uu___21 = + let uu___22 = nm "shift_left" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___22 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint + FStarC_MachineInts.UInt32) + (FStarC_MachineInts.nbe_machint + FStarC_MachineInts.UInt32) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___23 = + let uu___24 = + let uu___25 = + FStarC_MachineInts.v k x in + let uu___26 = + FStarC_MachineInts.v + FStarC_MachineInts.UInt32 + y in + FStarC_BigInt.shift_left_big_int + uu___25 uu___26 in + let uu___25 = + FStarC_MachineInts.mask k in + FStarC_BigInt.logand_big_int + uu___24 uu___25 in + FStarC_MachineInts.make_as k x + uu___23) in + let uu___22 = + let uu___23 = + let uu___24 = nm "shift_right" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___24 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint + FStarC_MachineInts.UInt32) + (FStarC_MachineInts.nbe_machint + FStarC_MachineInts.UInt32) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___25 = + let uu___26 = + let uu___27 = + FStarC_MachineInts.v k x in + let uu___28 = + FStarC_MachineInts.v + FStarC_MachineInts.UInt32 + y in + FStarC_BigInt.shift_right_big_int + uu___27 uu___28 in + let uu___27 = + FStarC_MachineInts.mask k in + FStarC_BigInt.logand_big_int + uu___26 uu___27 in + FStarC_MachineInts.make_as k x + uu___25) in + [uu___23] in + uu___21 :: uu___22 in + uu___19 :: uu___20 in + uu___17 :: uu___18 in + uu___15 :: uu___16 in + uu___13 :: uu___14 in + uu___11 :: uu___12 in + uu___9 :: uu___10 in + uu___7 :: uu___8 in + uu___5 :: uu___6 in + FStarC_Writer.emit (FStarC_Class_Monoid.monoid_list ()) + uu___4 + else + FStarC_Class_Monad.return + (FStarC_Writer.monad_writer + (FStarC_Class_Monoid.monoid_list ())) () (Obj.repr ()) in + Obj.magic + (FStarC_Class_Monad.op_let_Bang + (FStarC_Writer.monad_writer + (FStarC_Class_Monoid.monoid_list ())) () () uu___2 + (fun uu___3 -> + (fun uu___3 -> + let uu___3 = Obj.magic uu___3 in + let uu___4 = + let uu___5 = + (FStarC_MachineInts.is_unsigned k) && + (k <> FStarC_MachineInts.SizeT) in + if uu___5 + then + let uu___6 = + let uu___7 = + let uu___8 = nm "add_underspec" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___8 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___9 = + let uu___10 = + let uu___11 = + FStarC_MachineInts.v k x in + let uu___12 = + FStarC_MachineInts.v k y in + FStarC_BigInt.add_big_int uu___11 + uu___12 in + mod1 uu___10 in + FStarC_MachineInts.make_as k x uu___9) in + let uu___8 = + let uu___9 = + let uu___10 = nm "sub_underspec" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___10 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___11 = + let uu___12 = + let uu___13 = + FStarC_MachineInts.v k x in + let uu___14 = + FStarC_MachineInts.v k y in + FStarC_BigInt.sub_big_int uu___13 + uu___14 in + mod1 uu___12 in + FStarC_MachineInts.make_as k x + uu___11) in + let uu___10 = + let uu___11 = + let uu___12 = nm "mul_underspec" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___12 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___13 = + let uu___14 = + let uu___15 = + FStarC_MachineInts.v k x in + let uu___16 = + FStarC_MachineInts.v k y in + FStarC_BigInt.mult_big_int + uu___15 uu___16 in + mod1 uu___14 in + FStarC_MachineInts.make_as k x + uu___13) in + [uu___11] in + uu___9 :: uu___10 in + uu___7 :: uu___8 in + FStarC_Writer.emit + (FStarC_Class_Monoid.monoid_list ()) uu___6 + else + FStarC_Class_Monad.return + (FStarC_Writer.monad_writer + (FStarC_Class_Monoid.monoid_list ())) () + (Obj.repr ()) in + Obj.magic + (FStarC_Class_Monad.op_let_Bang + (FStarC_Writer.monad_writer + (FStarC_Class_Monoid.monoid_list ())) () () + uu___4 + (fun uu___5 -> + (fun uu___5 -> + let uu___5 = Obj.magic uu___5 in + let uu___6 = + let uu___7 = + (FStarC_MachineInts.is_unsigned k) && + ((k <> FStarC_MachineInts.SizeT) && + (k <> FStarC_MachineInts.UInt128)) in + if uu___7 + then + let uu___8 = + let uu___9 = + let uu___10 = nm "mul_mod" in + FStarC_TypeChecker_Primops_Base.mk2 + Prims.int_zero uu___10 + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (FStarC_MachineInts.e_machint k) + (FStarC_MachineInts.nbe_machint k) + (fun x -> + fun y -> + let uu___11 = + let uu___12 = + let uu___13 = + FStarC_MachineInts.v k + x in + let uu___14 = + FStarC_MachineInts.v k + y in + FStarC_BigInt.mult_big_int + uu___13 uu___14 in + mod1 uu___12 in + FStarC_MachineInts.make_as k + x uu___11) in + [uu___9] in + FStarC_Writer.emit + (FStarC_Class_Monoid.monoid_list ()) + uu___8 + else + FStarC_Class_Monad.return + (FStarC_Writer.monad_writer + (FStarC_Class_Monoid.monoid_list + ())) () (Obj.repr ()) in + Obj.magic + (FStarC_Class_Monad.op_let_Bang + (FStarC_Writer.monad_writer + (FStarC_Class_Monoid.monoid_list ())) + () () uu___6 + (fun uu___7 -> + (fun uu___7 -> + let uu___7 = Obj.magic uu___7 in + Obj.magic + (FStarC_Class_Monad.return + (FStarC_Writer.monad_writer + (FStarC_Class_Monoid.monoid_list + ())) () (Obj.repr ()))) + uu___7))) uu___5))) uu___3))) + uu___1) +let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = + let uu___ = + let uu___1 = + let uu___2 = + FStarC_Class_Monad.iterM + (FStarC_Writer.monad_writer (FStarC_Class_Monoid.monoid_list ())) + () (fun uu___3 -> (Obj.magic bounded_arith_ops_for) uu___3) + (Obj.magic FStarC_MachineInts.all_machint_kinds) in + FStarC_Class_Monad.op_let_Bang + (FStarC_Writer.monad_writer (FStarC_Class_Monoid.monoid_list ())) () + () uu___2 + (fun uu___3 -> + (fun uu___3 -> + let uu___3 = Obj.magic uu___3 in + let uu___4 = + let uu___5 = + FStarC_TypeChecker_Primops_Base.mk1 Prims.int_zero + FStarC_Parser_Const.char_u32_of_char + FStarC_Syntax_Embeddings.e_char + FStarC_TypeChecker_NBETerm.e_char + (FStarC_MachineInts.e_machint FStarC_MachineInts.UInt32) + (FStarC_MachineInts.nbe_machint FStarC_MachineInts.UInt32) + (fun c -> + let n = + FStarC_BigInt.of_int_fs (FStarC_Util.int_of_char c) in + FStarC_MachineInts.mk FStarC_MachineInts.UInt32 n + FStar_Pervasives_Native.None) in + [uu___5] in + Obj.magic + (FStarC_Writer.emit (FStarC_Class_Monoid.monoid_list ()) + uu___4)) uu___3) in + Obj.magic + (FStarC_Writer.run_writer (FStarC_Class_Monoid.monoid_list ()) () + (Obj.magic uu___1)) in + FStar_Pervasives_Native.fst uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Range.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Range.ml similarity index 79% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Range.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Range.ml index 0384c162a97..1ed6fcb6b66 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Range.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Range.ml @@ -1,15 +1,14 @@ open Prims type unsealedRange = - | U of FStarC_Compiler_Range_Type.range + | U of FStarC_Range_Type.range let (uu___is_U : unsealedRange -> Prims.bool) = fun projectee -> true -let (__proj__U__item___0 : unsealedRange -> FStarC_Compiler_Range_Type.range) - = fun projectee -> match projectee with | U _0 -> _0 +let (__proj__U__item___0 : unsealedRange -> FStarC_Range_Type.range) = + fun projectee -> match projectee with | U _0 -> _0 let (mk_range : Prims.string -> FStarC_BigInt.t -> FStarC_BigInt.t -> - FStarC_BigInt.t -> - FStarC_BigInt.t -> FStarC_Compiler_Range_Type.range) + FStarC_BigInt.t -> FStarC_BigInt.t -> FStarC_Range_Type.range) = fun fn -> fun from_l -> @@ -19,12 +18,12 @@ let (mk_range : let uu___ = let uu___1 = FStarC_BigInt.to_int_fs from_l in let uu___2 = FStarC_BigInt.to_int_fs from_c in - FStarC_Compiler_Range_Type.mk_pos uu___1 uu___2 in + FStarC_Range_Type.mk_pos uu___1 uu___2 in let uu___1 = let uu___2 = FStarC_BigInt.to_int_fs to_l in let uu___3 = FStarC_BigInt.to_int_fs to_c in - FStarC_Compiler_Range_Type.mk_pos uu___2 uu___3 in - FStarC_Compiler_Range_Type.mk_range fn uu___ uu___1 + FStarC_Range_Type.mk_pos uu___2 uu___3 in + FStarC_Range_Type.mk_range fn uu___ uu___1 let (__mk_range : Prims.string -> FStarC_BigInt.t -> @@ -44,26 +43,26 @@ let (explode : fun r -> match r with | U r1 -> - let uu___ = FStarC_Compiler_Range_Ops.file_of_range r1 in + let uu___ = FStarC_Range_Ops.file_of_range r1 in let uu___1 = let uu___2 = - let uu___3 = FStarC_Compiler_Range_Ops.start_of_range r1 in - FStarC_Compiler_Range_Ops.line_of_pos uu___3 in + let uu___3 = FStarC_Range_Ops.start_of_range r1 in + FStarC_Range_Ops.line_of_pos uu___3 in FStarC_BigInt.of_int_fs uu___2 in let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Range_Ops.start_of_range r1 in - FStarC_Compiler_Range_Ops.col_of_pos uu___4 in + let uu___4 = FStarC_Range_Ops.start_of_range r1 in + FStarC_Range_Ops.col_of_pos uu___4 in FStarC_BigInt.of_int_fs uu___3 in let uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_Range_Ops.end_of_range r1 in - FStarC_Compiler_Range_Ops.line_of_pos uu___5 in + let uu___5 = FStarC_Range_Ops.end_of_range r1 in + FStarC_Range_Ops.line_of_pos uu___5 in FStarC_BigInt.of_int_fs uu___4 in let uu___4 = let uu___5 = - let uu___6 = FStarC_Compiler_Range_Ops.end_of_range r1 in - FStarC_Compiler_Range_Ops.col_of_pos uu___6 in + let uu___6 = FStarC_Range_Ops.end_of_range r1 in + FStarC_Range_Ops.col_of_pos uu___6 in FStarC_BigInt.of_int_fs uu___5 in (uu___, uu___1, uu___2, uu___3, uu___4) let (e_unsealedRange : unsealedRange FStarC_Syntax_Embeddings_Base.embedding) @@ -120,8 +119,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_Syntax_Embeddings.e_range FStarC_TypeChecker_NBETerm.e_range FStarC_Syntax_Embeddings.e_range - FStarC_TypeChecker_NBETerm.e_range - FStarC_Compiler_Range_Ops.union_ranges in + FStarC_TypeChecker_NBETerm.e_range FStarC_Range_Ops.union_ranges in [uu___6] in uu___4 :: uu___5 in uu___2 :: uu___3 in diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Real.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Real.ml similarity index 76% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Real.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Real.ml index 9be0918a6f9..1ac7e3e110f 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Real.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Real.ml @@ -53,37 +53,26 @@ let (nbe_e_tf : tf FStarC_TypeChecker_NBETerm.embedding) = (fun uu___ -> lid_as_typ FStarC_Parser_Const.bool_lid [] []) (FStarC_Syntax_Embeddings_Base.emb_typ_of e_tf) let (cmp : - FStarC_Compiler_Real.real -> - FStarC_Compiler_Real.real -> - FStarC_Compiler_Order.order FStar_Pervasives_Native.option) + FStarC_Real.real -> + FStarC_Real.real -> FStarC_Order.order FStar_Pervasives_Native.option) = fun r1 -> fun r2 -> - match ((FStarC_Compiler_Real.__proj__Real__item___0 r1), - (FStarC_Compiler_Real.__proj__Real__item___0 r2)) + match ((FStarC_Real.__proj__Real__item___0 r1), + (FStarC_Real.__proj__Real__item___0 r2)) with - | ("0.0", "0.0") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Eq - | ("0.0", "0.5") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Lt - | ("0.0", "1.0") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Lt - | ("0.5", "0.0") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Gt - | ("0.5", "0.5") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Eq - | ("0.5", "1.0") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Lt - | ("1.0", "0.0") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Gt - | ("1.0", "0.5") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Gt - | ("1.0", "1.0") -> - FStar_Pervasives_Native.Some FStarC_Compiler_Order.Eq + | ("0.0", "0.0") -> FStar_Pervasives_Native.Some FStarC_Order.Eq + | ("0.0", "0.5") -> FStar_Pervasives_Native.Some FStarC_Order.Lt + | ("0.0", "1.0") -> FStar_Pervasives_Native.Some FStarC_Order.Lt + | ("0.5", "0.0") -> FStar_Pervasives_Native.Some FStarC_Order.Gt + | ("0.5", "0.5") -> FStar_Pervasives_Native.Some FStarC_Order.Eq + | ("0.5", "1.0") -> FStar_Pervasives_Native.Some FStarC_Order.Lt + | ("1.0", "0.0") -> FStar_Pervasives_Native.Some FStarC_Order.Gt + | ("1.0", "0.5") -> FStar_Pervasives_Native.Some FStarC_Order.Gt + | ("1.0", "1.0") -> FStar_Pervasives_Native.Some FStarC_Order.Eq | uu___ -> FStar_Pervasives_Native.None let (lt : - FStarC_Compiler_Real.real -> - FStarC_Compiler_Real.real -> tf FStar_Pervasives_Native.option) + FStarC_Real.real -> FStarC_Real.real -> tf FStar_Pervasives_Native.option) = fun uu___1 -> fun uu___ -> @@ -96,12 +85,11 @@ let (lt : (fun uu___1 -> let uu___1 = Obj.magic uu___1 in match uu___1 with - | FStarC_Compiler_Order.Lt -> Obj.magic T + | FStarC_Order.Lt -> Obj.magic T | uu___2 -> Obj.magic F) uu___1) (Obj.magic uu___))) uu___1 uu___ let (le : - FStarC_Compiler_Real.real -> - FStarC_Compiler_Real.real -> tf FStar_Pervasives_Native.option) + FStarC_Real.real -> FStarC_Real.real -> tf FStar_Pervasives_Native.option) = fun uu___1 -> fun uu___ -> @@ -114,13 +102,12 @@ let (le : (fun uu___1 -> let uu___1 = Obj.magic uu___1 in match uu___1 with - | FStarC_Compiler_Order.Lt -> Obj.magic T - | FStarC_Compiler_Order.Eq -> Obj.magic T + | FStarC_Order.Lt -> Obj.magic T + | FStarC_Order.Eq -> Obj.magic T | uu___2 -> Obj.magic F) uu___1) (Obj.magic uu___))) uu___1 uu___ let (gt : - FStarC_Compiler_Real.real -> - FStarC_Compiler_Real.real -> tf FStar_Pervasives_Native.option) + FStarC_Real.real -> FStarC_Real.real -> tf FStar_Pervasives_Native.option) = fun uu___1 -> fun uu___ -> @@ -133,12 +120,11 @@ let (gt : (fun uu___1 -> let uu___1 = Obj.magic uu___1 in match uu___1 with - | FStarC_Compiler_Order.Gt -> Obj.magic T + | FStarC_Order.Gt -> Obj.magic T | uu___2 -> Obj.magic F) uu___1) (Obj.magic uu___))) uu___1 uu___ let (ge : - FStarC_Compiler_Real.real -> - FStarC_Compiler_Real.real -> tf FStar_Pervasives_Native.option) + FStarC_Real.real -> FStarC_Real.real -> tf FStar_Pervasives_Native.option) = fun uu___1 -> fun uu___ -> @@ -151,17 +137,17 @@ let (ge : (fun uu___1 -> let uu___1 = Obj.magic uu___1 in match uu___1 with - | FStarC_Compiler_Order.Gt -> Obj.magic T - | FStarC_Compiler_Order.Eq -> Obj.magic T + | FStarC_Order.Gt -> Obj.magic T + | FStarC_Order.Eq -> Obj.magic T | uu___2 -> Obj.magic F) uu___1) (Obj.magic uu___))) uu___1 uu___ -let (of_int : FStarC_BigInt.t -> FStarC_Compiler_Real.real) = +let (of_int : FStarC_BigInt.t -> FStarC_Real.real) = fun i -> let uu___ = let uu___1 = let uu___2 = FStarC_BigInt.to_int_fs i in Prims.string_of_int uu___2 in Prims.strcat uu___1 ".0" in - FStarC_Compiler_Real.Real uu___ + FStarC_Real.Real uu___ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___ = FStarC_TypeChecker_Primops_Base.mk1 Prims.int_zero diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Sealed.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Sealed.ml similarity index 95% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Sealed.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Sealed.ml index 856520e91fd..e6bf373a830 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_Sealed.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Primops_Sealed.ml @@ -6,7 +6,7 @@ let (bogus_cbs : FStarC_TypeChecker_NBETerm.nbe_cbs) = (fun uu___ -> failwith "bogus_cbs translate") } let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = - FStarC_Compiler_List.map + FStarC_List.map (fun p -> let uu___ = FStarC_TypeChecker_Primops_Base.as_primitive_step_nbecbs true p in @@ -61,7 +61,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___5 = let uu___6 = FStarC_Syntax_Syntax.as_arg - (FStarC_Compiler_Sealed.unseal s1) in + (FStarC_Sealed.unseal s1) in [uu___6] in FStarC_Syntax_Util.mk_app f1 uu___5 in let emb = @@ -71,7 +71,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = FStarC_TypeChecker_Primops_Base.embed_simple (FStarC_Syntax_Embeddings.e_sealed emb) psc.FStarC_TypeChecker_Primops_Base.psc_range - (FStarC_Compiler_Sealed.seal r) in + (FStarC_Sealed.seal r) in FStar_Pervasives_Native.Some uu___5 | uu___5 -> FStar_Pervasives_Native.None) | uu___ -> FStar_Pervasives_Native.None)), @@ -103,7 +103,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___5 = let uu___6 = FStarC_TypeChecker_NBETerm.as_arg - (FStarC_Compiler_Sealed.unseal s1) in + (FStarC_Sealed.unseal s1) in [uu___6] in cb.FStarC_TypeChecker_NBETerm.iapp f1 uu___5 in let emb = @@ -112,7 +112,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___5 = FStarC_TypeChecker_NBETerm.embed (FStarC_TypeChecker_NBETerm.e_sealed emb) cb - (FStarC_Compiler_Sealed.seal r) in + (FStarC_Sealed.seal r) in FStar_Pervasives_Native.Some uu___5 | uu___5 -> FStar_Pervasives_Native.None) | uu___ -> FStar_Pervasives_Native.None))); @@ -148,7 +148,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___5 = let uu___6 = FStarC_Syntax_Syntax.as_arg - (FStarC_Compiler_Sealed.unseal s1) in + (FStarC_Sealed.unseal s1) in [uu___6] in FStarC_Syntax_Util.mk_app f1 uu___5 in let uu___5 = @@ -186,7 +186,7 @@ let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = let uu___5 = let uu___6 = FStarC_TypeChecker_NBETerm.as_arg - (FStarC_Compiler_Sealed.unseal s1) in + (FStarC_Sealed.unseal s1) in [uu___6] in cb.FStarC_TypeChecker_NBETerm.iapp f1 uu___5 in let emb = diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Quals.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Quals.ml similarity index 77% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Quals.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Quals.ml index 31a3603adb5..e8bbe93dc5b 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Quals.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Quals.ml @@ -1,4 +1,27 @@ open Prims +let pairwise_compat : + 'a . + ('a -> 'a -> Prims.bool) -> + 'a Prims.list -> ('a * 'a) FStar_Pervasives_Native.option + = + fun compat -> + fun xs -> + let rec go prev next = + match next with + | [] -> FStar_Pervasives_Native.None + | x::xs1 -> + let rec go2 ys k = + match ys with + | [] -> k () + | y::ys1 -> + let uu___ = + let uu___1 = compat x y in Prims.op_Negation uu___1 in + if uu___ + then FStar_Pervasives_Native.Some (x, y) + else go2 ys1 k in + go2 prev + (fun uu___ -> go2 xs1 (fun uu___1 -> go (x :: prev) xs1)) in + go [] xs let (check_sigelt_quals_pre : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.sigelt -> unit) = fun env -> @@ -39,111 +62,82 @@ let (check_sigelt_quals_pre : | FStarC_Syntax_Syntax.Noeq -> true | FStarC_Syntax_Syntax.Unopteq -> true | uu___1 -> false in - let quals_combo_ok quals q = - match q with + let qual_compat q1 q2 = + match q1 with | FStarC_Syntax_Syntax.Assumption -> - FStarC_Compiler_List.for_all - (fun x -> - ((((((x = q) || (x = FStarC_Syntax_Syntax.Logic)) || - (inferred x)) - || (visibility x)) - || (assumption x)) - || - (env.FStarC_TypeChecker_Env.is_iface && - (x = FStarC_Syntax_Syntax.Inline_for_extraction))) - || (x = FStarC_Syntax_Syntax.NoExtract)) quals + (((((q2 = FStarC_Syntax_Syntax.Logic) || (inferred q2)) || + (visibility q2)) + || (assumption q2)) + || + (env.FStarC_TypeChecker_Env.is_iface && + (q2 = FStarC_Syntax_Syntax.Inline_for_extraction))) + || (q2 = FStarC_Syntax_Syntax.NoExtract) | FStarC_Syntax_Syntax.New -> - FStarC_Compiler_List.for_all - (fun x -> - (((x = q) || (inferred x)) || (visibility x)) || - (assumption x)) quals + ((inferred q2) || (visibility q2)) || (assumption q2) | FStarC_Syntax_Syntax.Inline_for_extraction -> - FStarC_Compiler_List.for_all - (fun x -> - ((((((((x = q) || (x = FStarC_Syntax_Syntax.Logic)) || - (visibility x)) - || (reducibility x)) - || (reification x)) - || (inferred x)) - || (has_eq x)) - || - (env.FStarC_TypeChecker_Env.is_iface && - (x = FStarC_Syntax_Syntax.Assumption))) - || (x = FStarC_Syntax_Syntax.NoExtract)) quals + (((((((q2 = FStarC_Syntax_Syntax.Logic) || (visibility q2)) || + (reducibility q2)) + || (reification q2)) + || (inferred q2)) + || (has_eq q2)) + || + (env.FStarC_TypeChecker_Env.is_iface && + (q2 = FStarC_Syntax_Syntax.Assumption))) + || (q2 = FStarC_Syntax_Syntax.NoExtract) | FStarC_Syntax_Syntax.Unfold_for_unification_and_vcgen -> - FStarC_Compiler_List.for_all - (fun x -> - (((((((x = q) || (x = FStarC_Syntax_Syntax.Logic)) || - (x = FStarC_Syntax_Syntax.Inline_for_extraction)) - || (x = FStarC_Syntax_Syntax.NoExtract)) - || (has_eq x)) - || (inferred x)) - || (visibility x)) - || (reification x)) quals + ((((((q2 = FStarC_Syntax_Syntax.Logic) || + (q2 = FStarC_Syntax_Syntax.Inline_for_extraction)) + || (q2 = FStarC_Syntax_Syntax.NoExtract)) + || (has_eq q2)) + || (inferred q2)) + || (visibility q2)) + || (reification q2) | FStarC_Syntax_Syntax.Visible_default -> - FStarC_Compiler_List.for_all - (fun x -> - (((((((x = q) || (x = FStarC_Syntax_Syntax.Logic)) || - (x = FStarC_Syntax_Syntax.Inline_for_extraction)) - || (x = FStarC_Syntax_Syntax.NoExtract)) - || (has_eq x)) - || (inferred x)) - || (visibility x)) - || (reification x)) quals + ((((((q2 = FStarC_Syntax_Syntax.Logic) || + (q2 = FStarC_Syntax_Syntax.Inline_for_extraction)) + || (q2 = FStarC_Syntax_Syntax.NoExtract)) + || (has_eq q2)) + || (inferred q2)) + || (visibility q2)) + || (reification q2) | FStarC_Syntax_Syntax.Irreducible -> - FStarC_Compiler_List.for_all - (fun x -> - (((((((x = q) || (x = FStarC_Syntax_Syntax.Logic)) || - (x = FStarC_Syntax_Syntax.Inline_for_extraction)) - || (x = FStarC_Syntax_Syntax.NoExtract)) - || (has_eq x)) - || (inferred x)) - || (visibility x)) - || (reification x)) quals + ((((((q2 = FStarC_Syntax_Syntax.Logic) || + (q2 = FStarC_Syntax_Syntax.Inline_for_extraction)) + || (q2 = FStarC_Syntax_Syntax.NoExtract)) + || (has_eq q2)) + || (inferred q2)) + || (visibility q2)) + || (reification q2) | FStarC_Syntax_Syntax.Noeq -> - FStarC_Compiler_List.for_all - (fun x -> - (((((((x = q) || (x = FStarC_Syntax_Syntax.Logic)) || - (x = FStarC_Syntax_Syntax.Inline_for_extraction)) - || (x = FStarC_Syntax_Syntax.NoExtract)) - || (has_eq x)) - || (inferred x)) - || (visibility x)) - || (reification x)) quals + ((((((q2 = FStarC_Syntax_Syntax.Logic) || + (q2 = FStarC_Syntax_Syntax.Inline_for_extraction)) + || (q2 = FStarC_Syntax_Syntax.NoExtract)) + || (has_eq q2)) + || (inferred q2)) + || (visibility q2)) + || (reification q2) | FStarC_Syntax_Syntax.Unopteq -> - FStarC_Compiler_List.for_all - (fun x -> - (((((((x = q) || (x = FStarC_Syntax_Syntax.Logic)) || - (x = FStarC_Syntax_Syntax.Inline_for_extraction)) - || (x = FStarC_Syntax_Syntax.NoExtract)) - || (has_eq x)) - || (inferred x)) - || (visibility x)) - || (reification x)) quals + ((((((q2 = FStarC_Syntax_Syntax.Logic) || + (q2 = FStarC_Syntax_Syntax.Inline_for_extraction)) + || (q2 = FStarC_Syntax_Syntax.NoExtract)) + || (has_eq q2)) + || (inferred q2)) + || (visibility q2)) + || (reification q2) | FStarC_Syntax_Syntax.TotalEffect -> - FStarC_Compiler_List.for_all - (fun x -> - (((x = q) || (inferred x)) || (visibility x)) || - (reification x)) quals + ((inferred q2) || (visibility q2)) || (reification q2) | FStarC_Syntax_Syntax.Logic -> - FStarC_Compiler_List.for_all - (fun x -> - ((((x = q) || (x = FStarC_Syntax_Syntax.Assumption)) || - (inferred x)) - || (visibility x)) - || (reducibility x)) quals + (((q2 = FStarC_Syntax_Syntax.Assumption) || (inferred q2)) || + (visibility q2)) + || (reducibility q2) | FStarC_Syntax_Syntax.Reifiable -> - FStarC_Compiler_List.for_all - (fun x -> - ((((reification x) || (inferred x)) || (visibility x)) || - (x = FStarC_Syntax_Syntax.TotalEffect)) - || (x = FStarC_Syntax_Syntax.Visible_default)) quals + ((((reification q2) || (inferred q2)) || (visibility q2)) || + (q2 = FStarC_Syntax_Syntax.TotalEffect)) + || (q2 = FStarC_Syntax_Syntax.Visible_default) | FStarC_Syntax_Syntax.Reflectable uu___ -> - FStarC_Compiler_List.for_all - (fun x -> - ((((reification x) || (inferred x)) || (visibility x)) || - (x = FStarC_Syntax_Syntax.TotalEffect)) - || (x = FStarC_Syntax_Syntax.Visible_default)) quals + ((((reification q2) || (inferred q2)) || (visibility q2)) || + (q2 = FStarC_Syntax_Syntax.TotalEffect)) + || (q2 = FStarC_Syntax_Syntax.Visible_default) | FStarC_Syntax_Syntax.Private -> true | uu___ -> true in let check_no_subtyping_attribute se1 = @@ -168,12 +162,13 @@ let (check_sigelt_quals_pre : else () in check_no_subtyping_attribute se; (let quals = - FStarC_Compiler_List.filter + let uu___1 = FStarC_Syntax_Util.quals_of_sigelt se in + FStarC_List.filter (fun x -> Prims.op_Negation (x = FStarC_Syntax_Syntax.Logic)) - (FStarC_Syntax_Util.quals_of_sigelt se) in + uu___1 in let uu___1 = let uu___2 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.OnlyName -> true @@ -183,50 +178,64 @@ let (check_sigelt_quals_pre : then let r = FStarC_Syntax_Util.range_of_sigelt se in let no_dup_quals = - FStarC_Compiler_Util.remove_dups (fun x -> fun y -> x = y) quals in + FStarC_Util.remove_dups (fun x -> fun y -> x = y) quals in let err msg = let uu___2 = let uu___3 = let uu___4 = - let uu___5 = FStarC_Errors_Msg.text "The qualifier list" in + let uu___5 = + FStarC_Errors_Msg.text + "Invalid qualifiers for declaration" in let uu___6 = let uu___7 = let uu___8 = - FStarC_Class_Show.show - (FStarC_Class_Show.show_list - FStarC_Syntax_Print.showable_qualifier) quals in + FStarC_Syntax_Print.sigelt_to_string_short se in FStarC_Pprint.doc_of_string uu___8 in - let uu___8 = - FStarC_Errors_Msg.text - "is not permissible for this element" in - FStarC_Pprint.op_Hat_Slash_Hat uu___7 uu___8 in - FStarC_Pprint.op_Hat_Slash_Hat uu___5 uu___6 in + FStarC_Pprint.bquotes uu___7 in + FStarC_Pprint.prefix (Prims.of_int (2)) Prims.int_one uu___5 + uu___6 in [uu___4] in FStar_List_Tot_Base.append uu___3 msg in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_QulifierListNotPermitted () (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___2) in - (if - (FStarC_Compiler_List.length quals) <> - (FStarC_Compiler_List.length no_dup_quals) + (if (FStarC_List.length quals) <> (FStarC_List.length no_dup_quals) then (let uu___3 = let uu___4 = FStarC_Errors_Msg.text "Duplicate qualifiers." in [uu___4] in err uu___3) else (); - (let uu___4 = - let uu___5 = - FStarC_Compiler_List.for_all (quals_combo_ok quals) quals in - Prims.op_Negation uu___5 in - if uu___4 - then - let uu___5 = - let uu___6 = FStarC_Errors_Msg.text "Ill-formed combination." in - [uu___6] in - err uu___5 - else ()); + (let uu___4 = pairwise_compat qual_compat quals in + match uu___4 with + | FStar_Pervasives_Native.Some (q, q') -> + let uu___5 = + let uu___6 = + let uu___7 = FStarC_Errors_Msg.text "Qualifiers" in + let uu___8 = + let uu___9 = + let uu___10 = + FStarC_Class_PP.pp + FStarC_Syntax_Print.pretty_qualifier q in + FStarC_Pprint.bquotes uu___10 in + let uu___10 = + let uu___11 = FStarC_Errors_Msg.text "and" in + let uu___12 = + let uu___13 = + let uu___14 = + FStarC_Class_PP.pp + FStarC_Syntax_Print.pretty_qualifier q' in + FStarC_Pprint.bquotes uu___14 in + let uu___14 = + FStarC_Errors_Msg.text "are not compatible." in + FStarC_Pprint.op_Hat_Slash_Hat uu___13 uu___14 in + FStarC_Pprint.op_Hat_Slash_Hat uu___11 uu___12 in + FStarC_Pprint.op_Hat_Slash_Hat uu___9 uu___10 in + FStarC_Pprint.op_Hat_Slash_Hat uu___7 uu___8 in + [uu___6] in + err uu___5 + | FStar_Pervasives_Native.None -> ()); (match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_let { FStarC_Syntax_Syntax.lbs1 = (is_rec, uu___4); @@ -234,7 +243,7 @@ let (check_sigelt_quals_pre : -> (if is_rec && - (FStarC_Compiler_List.contains + (FStarC_List.contains FStarC_Syntax_Syntax.Unfold_for_unification_and_vcgen quals) then @@ -245,22 +254,31 @@ let (check_sigelt_quals_pre : [uu___8] in err uu___7) else (); - (let uu___7 = - FStarC_Compiler_Util.for_some - (fun x -> (assumption x) || (has_eq x)) quals in - if uu___7 + (let uu___8 = + FStarC_Util.for_some (fun x -> assumption x) quals in + if uu___8 then - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStarC_Errors_Msg.text - "Definitions cannot be assumed or marked with equality qualifiers." in - [uu___9] in - err uu___8 + "Definitions cannot be marked `assume`." in + [uu___10] in + err uu___9 + else ()); + (let uu___9 = FStarC_Util.for_some (fun x -> has_eq x) quals in + if uu___9 + then + let uu___10 = + let uu___11 = + FStarC_Errors_Msg.text + "Definitions cannot be marked with equality qualifiers." in + [uu___11] in + err uu___10 else ())) | FStarC_Syntax_Syntax.Sig_bundle uu___4 -> ((let uu___6 = let uu___7 = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun x -> ((((x = FStarC_Syntax_Syntax.Inline_for_extraction) || (x = FStarC_Syntax_Syntax.NoExtract)) @@ -270,7 +288,7 @@ let (check_sigelt_quals_pre : Prims.op_Negation uu___7 in if uu___6 then err [] else ()); (let uu___6 = - (FStarC_Compiler_List.existsb + (FStarC_List.existsb (fun uu___7 -> match uu___7 with | FStarC_Syntax_Syntax.Unopteq -> true @@ -289,12 +307,12 @@ let (check_sigelt_quals_pre : err uu___7 else ())) | FStarC_Syntax_Syntax.Sig_declare_typ uu___4 -> - let uu___5 = FStarC_Compiler_Util.for_some has_eq quals in + let uu___5 = FStarC_Util.for_some has_eq quals in if uu___5 then err [] else () | FStarC_Syntax_Syntax.Sig_assume uu___4 -> let uu___5 = let uu___6 = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun x -> ((visibility x) || (x = FStarC_Syntax_Syntax.Assumption)) @@ -305,7 +323,7 @@ let (check_sigelt_quals_pre : | FStarC_Syntax_Syntax.Sig_new_effect uu___4 -> let uu___5 = let uu___6 = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun x -> (((x = FStarC_Syntax_Syntax.TotalEffect) || (inferred x)) @@ -316,7 +334,7 @@ let (check_sigelt_quals_pre : | FStarC_Syntax_Syntax.Sig_effect_abbrev uu___4 -> let uu___5 = let uu___6 = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun x -> (inferred x) || (visibility x)) quals in Prims.op_Negation uu___6 in if uu___5 then err [] else () @@ -325,7 +343,7 @@ let (check_sigelt_quals_pre : let (check_erasable : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.qualifier Prims.list -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.sigelt -> unit) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt -> unit) = fun env -> fun quals -> @@ -333,17 +351,17 @@ let (check_erasable : fun se -> let lids = FStarC_Syntax_Util.lids_of_sigelt se in let val_exists = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun l -> let uu___ = FStarC_TypeChecker_Env.try_lookup_val_decl env l in - FStarC_Compiler_Option.isSome uu___) lids in + FStarC_Option.isSome uu___) lids in let val_has_erasable_attr = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun l -> let attrs_opt = FStarC_TypeChecker_Env.lookup_attrs_of_lid env l in - (FStarC_Compiler_Option.isSome attrs_opt) && - (let uu___ = FStarC_Compiler_Option.get attrs_opt in + (FStarC_Option.isSome attrs_opt) && + (let uu___ = FStarC_Option.get attrs_opt in FStarC_Syntax_Util.has_attribute uu___ FStarC_Parser_Const.erasable_attr)) lids in let se_has_erasable_attr = @@ -393,7 +411,7 @@ let (check_erasable : | FStarC_Syntax_Syntax.Sig_bundle uu___2 -> let uu___3 = let uu___4 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___5 -> match uu___5 with | FStarC_Syntax_Syntax.Noeq -> true @@ -469,8 +487,8 @@ let (check_erasable : -> if Prims.op_Negation - (FStarC_Compiler_List.contains - FStarC_Syntax_Syntax.TotalEffect quals) + (FStarC_List.contains FStarC_Syntax_Syntax.TotalEffect + quals) then let uu___10 = let uu___11 = @@ -523,18 +541,17 @@ let (check_must_erase_attribute : (match uu___2 with | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some iface_decls -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun lb -> let lbname = - FStarC_Compiler_Util.right - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let has_iface_val = let uu___3 = let uu___4 = FStarC_Ident.ident_of_lid (lbname.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in FStarC_Parser_AST.decl_is_val uu___4 in - FStarC_Compiler_Util.for_some uu___3 iface_decls in + FStarC_Util.for_some uu___3 iface_decls in if has_iface_val then let must_erase = @@ -551,7 +568,7 @@ let (check_must_erase_attribute : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv lbname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Values of type `%s` will be erased during extraction, but its interface hides this fact." uu___6 in FStarC_Errors_Msg.text uu___5 in @@ -562,7 +579,7 @@ let (check_must_erase_attribute : FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv lbname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Add the `must_erase_for_extraction` attribute to the `val %s` declaration for this symbol in the interface" uu___8 in FStarC_Errors_Msg.text uu___7 in @@ -584,7 +601,7 @@ let (check_must_erase_attribute : FStarC_Class_Show.show FStarC_Syntax_Print.showable_fv lbname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Values of type `%s` cannot be erased during extraction, but the `must_erase_for_extraction` attribute claims that it can." uu___7 in FStarC_Errors_Msg.text uu___6 in @@ -606,13 +623,13 @@ let (check_must_erase_attribute : | uu___2 -> ()) let (check_typeclass_instance_attribute : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.sigelt -> unit) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt -> unit) = fun env -> fun rng -> fun se -> let is_tc_instance = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun t -> match t.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_fvar fv -> @@ -637,8 +654,10 @@ let (check_typeclass_instance_attribute : let uu___8 = FStarC_Errors_Msg.text "This instance has effect" in let uu___9 = + let uu___10 = + FStarC_Syntax_Util.comp_effect_name res in FStarC_Class_PP.pp FStarC_Ident.pretty_lident - (FStarC_Syntax_Util.comp_effect_name res) in + uu___10 in FStarC_Pprint.op_Hat_Hat uu___8 uu___9 in [uu___7] in uu___5 :: uu___6 in diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Rel.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Rel.ml similarity index 93% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Rel.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Rel.ml index 88c2676c00b..1e680a92259 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Rel.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Rel.ml @@ -45,40 +45,37 @@ let (__proj__Implicit_has_typing_guard__item___0 : (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.typ)) = fun projectee -> match projectee with | Implicit_has_typing_guard _0 -> _0 -let (dbg_Disch : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Disch" -let (dbg_Discharge : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Discharge" -let (dbg_EQ : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "EQ" -let (dbg_ExplainRel : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ExplainRel" -let (dbg_GenUniverses : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "GenUniverses" -let (dbg_ImplicitTrace : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ImplicitTrace" -let (dbg_Imps : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Imps" -let (dbg_LayeredEffectsApp : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LayeredEffectsApp" -let (dbg_LayeredEffectsEqns : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LayeredEffectsEqns" -let (dbg_Rel : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Rel" -let (dbg_RelBench : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "RelBench" -let (dbg_RelDelta : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "RelDelta" -let (dbg_RelTop : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "RelTop" -let (dbg_ResolveImplicitsHook : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ResolveImplicitsHook" -let (dbg_Simplification : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Simplification" -let (dbg_SMTQuery : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SMTQuery" -let (dbg_Tac : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Tac" +let (dbg_Disch : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Disch" +let (dbg_Discharge : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Discharge" +let (dbg_EQ : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "EQ" +let (dbg_ExplainRel : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ExplainRel" +let (dbg_GenUniverses : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "GenUniverses" +let (dbg_ImplicitTrace : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ImplicitTrace" +let (dbg_Imps : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Imps" +let (dbg_LayeredEffectsApp : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LayeredEffectsApp" +let (dbg_LayeredEffectsEqns : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LayeredEffectsEqns" +let (dbg_Rel : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Rel" +let (dbg_RelBench : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "RelBench" +let (dbg_RelDelta : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "RelDelta" +let (dbg_RelTop : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "RelTop" +let (dbg_ResolveImplicitsHook : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ResolveImplicitsHook" +let (dbg_Simplification : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Simplification" +let (dbg_SMTQuery : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SMTQuery" +let (dbg_Tac : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Tac" let (showable_implicit_checking_status : implicit_checking_status FStarC_Class_Show.showable) = { @@ -123,19 +120,16 @@ let (term_is_uvar : uv'.FStarC_Syntax_Syntax.ctx_uvar_head | uu___1 -> false let (binders_as_bv_set : - FStarC_Syntax_Syntax.binders -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t) - = + FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.t) = fun uu___ -> (fun bs -> let uu___ = - FStarC_Compiler_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) - bs in + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) bs in Obj.magic (FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Syntax.ord_bv)) uu___)) uu___ + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) + uu___)) uu___ type lstring = Prims.string FStarC_Thunk.t let (mklstr : (unit -> Prims.string) -> Prims.string FStarC_Thunk.thunk) = fun f -> @@ -184,11 +178,11 @@ type worklist = attempting: FStarC_TypeChecker_Common.probs ; wl_deferred: (Prims.int * FStarC_TypeChecker_Common.deferred_reason * lstring * - FStarC_TypeChecker_Common.prob) FStarC_Compiler_CList.clist + FStarC_TypeChecker_Common.prob) FStarC_CList.clist ; wl_deferred_to_tac: (Prims.int * FStarC_TypeChecker_Common.deferred_reason * lstring * - FStarC_TypeChecker_Common.prob) FStarC_Compiler_CList.clist + FStarC_TypeChecker_Common.prob) FStarC_CList.clist ; ctr: Prims.int ; defer_ok: defer_ok_t ; @@ -197,7 +191,7 @@ type worklist = tcenv: FStarC_TypeChecker_Env.env ; wl_implicits: FStarC_TypeChecker_Common.implicits_t ; repr_subcomp_allowed: Prims.bool ; - typeclass_variables: FStarC_Syntax_Syntax.ctx_uvar FStarC_Compiler_RBSet.t } + typeclass_variables: FStarC_Syntax_Syntax.ctx_uvar FStarC_RBSet.t } let (__proj__Mkworklist__item__attempting : worklist -> FStarC_TypeChecker_Common.probs) = fun projectee -> @@ -208,7 +202,7 @@ let (__proj__Mkworklist__item__attempting : let (__proj__Mkworklist__item__wl_deferred : worklist -> (Prims.int * FStarC_TypeChecker_Common.deferred_reason * lstring * - FStarC_TypeChecker_Common.prob) FStarC_Compiler_CList.clist) + FStarC_TypeChecker_Common.prob) FStarC_CList.clist) = fun projectee -> match projectee with @@ -218,7 +212,7 @@ let (__proj__Mkworklist__item__wl_deferred : let (__proj__Mkworklist__item__wl_deferred_to_tac : worklist -> (Prims.int * FStarC_TypeChecker_Common.deferred_reason * lstring * - FStarC_TypeChecker_Common.prob) FStarC_Compiler_CList.clist) + FStarC_TypeChecker_Common.prob) FStarC_CList.clist) = fun projectee -> match projectee with @@ -271,7 +265,7 @@ let (__proj__Mkworklist__item__repr_subcomp_allowed : worklist -> Prims.bool) umax_heuristic_ok; tcenv; wl_implicits; repr_subcomp_allowed; typeclass_variables;_} -> repr_subcomp_allowed let (__proj__Mkworklist__item__typeclass_variables : - worklist -> FStarC_Syntax_Syntax.ctx_uvar FStarC_Compiler_RBSet.t) = + worklist -> FStarC_Syntax_Syntax.ctx_uvar FStarC_RBSet.t) = fun projectee -> match projectee with | { attempting; wl_deferred; wl_deferred_to_tac; ctr; defer_ok; smt_ok; @@ -279,11 +273,11 @@ let (__proj__Mkworklist__item__typeclass_variables : typeclass_variables;_} -> typeclass_variables let (as_deferred : (Prims.int * FStarC_TypeChecker_Common.deferred_reason * lstring * - FStarC_TypeChecker_Common.prob) FStarC_Compiler_CList.clist -> + FStarC_TypeChecker_Common.prob) FStarC_CList.clist -> FStarC_TypeChecker_Common.deferred) = fun wl_def -> - FStarC_Compiler_CList.map + FStarC_CList.map (fun uu___ -> match uu___ with | (uu___1, reason, m, p) -> @@ -292,11 +286,11 @@ let (as_wl_deferred : worklist -> FStarC_TypeChecker_Common.deferred -> (Prims.int * FStarC_TypeChecker_Common.deferred_reason * lstring * - FStarC_TypeChecker_Common.prob) FStarC_Compiler_CList.clist) + FStarC_TypeChecker_Common.prob) FStarC_CList.clist) = fun wl -> fun d -> - FStarC_Compiler_CList.map + FStarC_CList.map (fun uu___ -> match uu___ with | (reason, m, p) -> @@ -305,7 +299,7 @@ let (as_wl_deferred : let (new_uvar : Prims.string -> worklist -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.binding Prims.list -> FStarC_Syntax_Syntax.binder Prims.list -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> @@ -357,24 +351,22 @@ let (new_uvar : FStarC_TypeChecker_Common.imp_tm = t; FStarC_TypeChecker_Common.imp_range = r } in - (let uu___2 = - FStarC_Compiler_Effect.op_Bang dbg_ImplicitTrace in + (let uu___2 = FStarC_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_uvar ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_head in - FStarC_Compiler_Util.print1 - "Just created uvar (Rel) {%s}\n" uu___3 + FStarC_Util.print1 "Just created uvar (Rel) {%s}\n" + uu___3 else ()); (let uu___2 = let uu___3 = Obj.magic (FStarC_Class_Listlike.cons () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ())) - imp (Obj.magic wl.wl_implicits)) in + (Obj.magic (FStarC_CList.listlike_clist ())) imp + (Obj.magic wl.wl_implicits)) in { attempting = (wl.attempting); wl_deferred = (wl.wl_deferred); @@ -545,16 +537,15 @@ let (extend_wl : fun imps -> let uu___ = let uu___1 = as_wl_deferred wl defers in - FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) wl.wl_deferred uu___1 in + FStarC_Class_Monoid.op_Plus_Plus (FStarC_CList.monoid_clist ()) + wl.wl_deferred uu___1 in let uu___1 = let uu___2 = as_wl_deferred wl defer_to_tac in - FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) wl.wl_deferred_to_tac - uu___2 in + FStarC_Class_Monoid.op_Plus_Plus (FStarC_CList.monoid_clist ()) + wl.wl_deferred_to_tac uu___2 in let uu___2 = - FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) wl.wl_implicits imps in + FStarC_Class_Monoid.op_Plus_Plus (FStarC_CList.monoid_clist ()) + wl.wl_implicits imps in { attempting = (wl.attempting); wl_deferred = uu___; @@ -704,8 +695,7 @@ let (p_reason : FStarC_TypeChecker_Common.prob -> Prims.string Prims.list) = match uu___ with | FStarC_TypeChecker_Common.TProb p -> p.FStarC_TypeChecker_Common.reason | FStarC_TypeChecker_Common.CProb p -> p.FStarC_TypeChecker_Common.reason -let (p_loc : - FStarC_TypeChecker_Common.prob -> FStarC_Compiler_Range_Type.range) = +let (p_loc : FStarC_TypeChecker_Common.prob -> FStarC_Range_Type.range) = fun uu___ -> match uu___ with | FStarC_TypeChecker_Common.TProb p -> p.FStarC_TypeChecker_Common.loc @@ -738,7 +728,7 @@ let (p_scope : | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some x -> let uu___1 = FStarC_Syntax_Syntax.mk_binder x in [uu___1] in - FStarC_Compiler_List.op_At + FStarC_List.op_At (p.FStarC_TypeChecker_Common.logical_guard_uvar).FStarC_Syntax_Syntax.ctx_uvar_binders uu___ | FStarC_TypeChecker_Common.CProb p -> @@ -747,7 +737,7 @@ let (p_scope : | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some x -> let uu___1 = FStarC_Syntax_Syntax.mk_binder x in [uu___1] in - FStarC_Compiler_List.op_At + FStarC_List.op_At (p.FStarC_TypeChecker_Common.logical_guard_uvar).FStarC_Syntax_Syntax.ctx_uvar_binders uu___ in r @@ -873,7 +863,7 @@ let (p_guard_env : FStarC_TypeChecker_Env.curmodule = (uu___.FStarC_TypeChecker_Env.curmodule); FStarC_TypeChecker_Env.gamma = - (FStarC_Compiler_List.op_At + (FStarC_List.op_At (match p_element prob with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some x -> @@ -972,8 +962,7 @@ let (p_guard_env : } let (def_scope_wf : Prims.string -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.binder Prims.list -> unit) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.binder Prims.list -> unit) = fun msg -> fun rng -> @@ -996,7 +985,7 @@ let (def_scope_wf : FStarC_Class_Binders.hasNames_term FStarC_Syntax_Print.pretty_term rng msg prev bv.FStarC_Syntax_Syntax.sort; - aux (FStarC_Compiler_List.op_At prev [bv]) bs) in + aux (FStarC_List.op_At prev [bv]) bs) in aux [] r) let (hasBinders_prob : FStarC_TypeChecker_Common.prob FStarC_Class_Binders.hasBinders) = @@ -1006,12 +995,12 @@ let (hasBinders_prob : (fun prob -> let uu___ = let uu___1 = p_scope prob in - FStarC_Compiler_List.map - (fun b -> b.FStarC_Syntax_Syntax.binder_bv) uu___1 in + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) + uu___1 in Obj.magic (FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) uu___)) uu___) } let (def_check_term_scoped_in_prob : @@ -1046,7 +1035,7 @@ let (def_check_prob : Prims.string -> FStarC_TypeChecker_Common.prob -> unit) (let msgf m = let uu___2 = let uu___3 = - let uu___4 = FStarC_Compiler_Util.string_of_int (p_pid prob) in + let uu___4 = FStarC_Util.string_of_int (p_pid prob) in Prims.strcat uu___4 (Prims.strcat "." m) in Prims.strcat "." uu___3 in Prims.strcat msg uu___2 in @@ -1099,7 +1088,7 @@ let (term_to_string : FStarC_Syntax_Syntax.term -> Prims.string) = (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) args in - FStarC_Compiler_Util.format3 "%s%s %s" uu___1 uu___2 uu___3 + FStarC_Util.format3 "%s%s %s" uu___1 uu___2 uu___3 | uu___1 -> FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t) let (prob_to_string : @@ -1112,8 +1101,7 @@ let (prob_to_string : | FStarC_TypeChecker_Common.TProb p -> let uu___ = let uu___1 = - FStarC_Compiler_Util.string_of_int - p.FStarC_TypeChecker_Common.pid in + FStarC_Util.string_of_int p.FStarC_TypeChecker_Common.pid in let uu___2 = let uu___3 = term_to_string p.FStarC_TypeChecker_Common.lhs in let uu___4 = @@ -1134,21 +1122,19 @@ let (prob_to_string : uu___5 in uu___3 :: uu___4 in uu___1 :: uu___2 in - FStarC_Compiler_Util.format + FStarC_Util.format "\n%s:\t%s \n\t\t%s\n\t%s\n\t(reason:%s) (logical:%s)\n" uu___ | FStarC_TypeChecker_Common.CProb p -> let uu___ = - FStarC_Compiler_Util.string_of_int - p.FStarC_TypeChecker_Common.pid in + FStarC_Util.string_of_int p.FStarC_TypeChecker_Common.pid in let uu___1 = FStarC_TypeChecker_Normalize.comp_to_string env p.FStarC_TypeChecker_Common.lhs in let uu___2 = FStarC_TypeChecker_Normalize.comp_to_string env p.FStarC_TypeChecker_Common.rhs in - FStarC_Compiler_Util.format4 "\n%s:\t%s \n\t\t%s\n\t%s" uu___ - uu___1 (rel_to_string p.FStarC_TypeChecker_Common.relation) - uu___2 + FStarC_Util.format4 "\n%s:\t%s \n\t\t%s\n\t%s" uu___ uu___1 + (rel_to_string p.FStarC_TypeChecker_Common.relation) uu___2 let (prob_to_string' : worklist -> FStarC_TypeChecker_Common.prob -> Prims.string) = fun wl -> fun prob -> let env = p_env wl prob in prob_to_string env prob @@ -1163,10 +1149,10 @@ let (uvi_to_string : FStarC_TypeChecker_Env.env -> uvi -> Prims.string) = then "?" else (let uu___3 = FStarC_Syntax_Unionfind.univ_uvar_id u in - FStarC_Compiler_Util.string_of_int uu___3) in + FStarC_Util.string_of_int uu___3) in let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ t in - FStarC_Compiler_Util.format2 "UNIV %s <- %s" x uu___1 + FStarC_Util.format2 "UNIV %s <- %s" x uu___1 | TERM (u, t) -> let x = let uu___1 = FStarC_Options.hide_uvar_nums () in @@ -1176,9 +1162,9 @@ let (uvi_to_string : FStarC_TypeChecker_Env.env -> uvi -> Prims.string) = (let uu___3 = FStarC_Syntax_Unionfind.uvar_id u.FStarC_Syntax_Syntax.ctx_uvar_head in - FStarC_Compiler_Util.string_of_int uu___3) in + FStarC_Util.string_of_int uu___3) in let uu___1 = FStarC_TypeChecker_Normalize.term_to_string env t in - FStarC_Compiler_Util.format2 "TERM %s <- %s" x uu___1 + FStarC_Util.format2 "TERM %s <- %s" x uu___1 let (uvis_to_string : FStarC_TypeChecker_Env.env -> uvi Prims.list -> Prims.string) = fun env -> @@ -1189,18 +1175,18 @@ let (empty_worklist : FStarC_TypeChecker_Env.env -> worklist) = Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Free.ord_ctx_uvar)) ()) in + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Free.ord_ctx_uvar)) + ()) in { attempting = []; wl_deferred = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); ctr = Prims.int_zero; defer_ok = DeferAny; smt_ok = true; @@ -1209,7 +1195,7 @@ let (empty_worklist : FStarC_TypeChecker_Env.env -> worklist) = wl_implicits = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = false; typeclass_variables = uu___ } @@ -1218,12 +1204,12 @@ let (giveup : fun wl -> fun reason -> fun prob -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = FStarC_Thunk.force reason in let uu___3 = prob_to_string' wl prob in - FStarC_Compiler_Util.print2 "Failed %s:\n%s\n" uu___2 uu___3 + FStarC_Util.print2 "Failed %s:\n%s\n" uu___2 uu___3 else ()); Failed (prob, reason) let (giveup_lit : @@ -1260,7 +1246,7 @@ let wl_of_guard : fun g -> let uu___ = empty_worklist env in let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (uu___3, uu___4, p) -> p) g in { attempting = uu___1; @@ -1286,7 +1272,7 @@ let (defer : let uu___ = Obj.magic (FStarC_Class_Listlike.cons () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())) + (Obj.magic (FStarC_CList.listlike_clist ())) ((wl.ctr), reason, msg, prob) (Obj.magic wl.wl_deferred)) in { attempting = (wl.attempting); @@ -1314,9 +1300,9 @@ let (attempt : FStarC_TypeChecker_Common.prob Prims.list -> worklist -> worklist) = fun probs -> fun wl -> - FStarC_Compiler_List.iter (def_check_prob "attempt") probs; + FStarC_List.iter (def_check_prob "attempt") probs; { - attempting = (FStarC_Compiler_List.op_At probs wl.attempting); + attempting = (FStarC_List.op_At probs wl.attempting); wl_deferred = (wl.wl_deferred); wl_deferred_to_tac = (wl.wl_deferred_to_tac); ctr = (wl.ctr); @@ -1431,11 +1417,10 @@ let (set_logical : FStarC_TypeChecker_Common.logical = b } let (is_top_level_prob : FStarC_TypeChecker_Common.prob -> Prims.bool) = - fun p -> (FStarC_Compiler_List.length (p_reason p)) = Prims.int_one + fun p -> (FStarC_List.length (p_reason p)) = Prims.int_one let (next_pid : unit -> Prims.int) = - let ctr = FStarC_Compiler_Util.mk_ref Prims.int_zero in - fun uu___ -> - FStarC_Compiler_Util.incr ctr; FStarC_Compiler_Effect.op_Bang ctr + let ctr = FStarC_Util.mk_ref Prims.int_zero in + fun uu___ -> FStarC_Util.incr ctr; FStarC_Effect.op_Bang ctr let mk_problem : 'uuuuu . worklist -> @@ -1463,25 +1448,25 @@ let mk_problem : let uu___ = let uu___1 = FStarC_Syntax_Syntax.mk_binder x in [uu___1] in - FStarC_Compiler_List.op_At scope uu___ in + FStarC_List.op_At scope uu___ in let bs = - FStarC_Compiler_List.op_At + FStarC_List.op_At (p_guard_uvar orig).FStarC_Syntax_Syntax.ctx_uvar_binders scope1 in let gamma = let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> FStarC_Syntax_Syntax.Binding_var (b.FStarC_Syntax_Syntax.binder_bv)) scope1 in - FStarC_Compiler_List.rev uu___1 in - FStarC_Compiler_List.op_At uu___ + FStarC_List.rev uu___1 in + FStarC_List.op_At uu___ (p_guard_uvar orig).FStarC_Syntax_Syntax.ctx_uvar_gamma in let uu___ = new_uvar (Prims.strcat "mk_problem: logical guard for " reason) - wl FStarC_Compiler_Range_Type.dummyRange gamma bs + wl FStarC_Range_Type.dummyRange gamma bs FStarC_Syntax_Util.ktype0 (FStarC_Syntax_Syntax.Allow_untyped "logical guard") FStar_Pervasives_Native.None in @@ -1567,7 +1552,7 @@ let new_problem : FStarC_TypeChecker_Common.rel -> 'uuuuu -> FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.string -> ('uuuuu FStarC_TypeChecker_Common.problem * worklist) = @@ -1708,17 +1693,16 @@ let (explain : fun d -> fun s -> let uu___ = - (FStarC_Compiler_Effect.op_Bang dbg_ExplainRel) || - (FStarC_Compiler_Effect.op_Bang dbg_Rel) in + (FStarC_Effect.op_Bang dbg_ExplainRel) || + (FStarC_Effect.op_Bang dbg_Rel) in if uu___ then - let uu___1 = FStarC_Compiler_Range_Ops.string_of_range (p_loc d) in + let uu___1 = FStarC_Range_Ops.string_of_range (p_loc d) in let uu___2 = prob_to_string' wl d in let uu___3 = FStarC_Thunk.force s in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "(%s) Failed to solve the sub-problem\n%s\nWhich arose because:\n\t%s\nFailed because:%s\n" - uu___1 uu___2 - (FStarC_Compiler_String.concat "\n\t>" (p_reason d)) uu___3 + uu___1 uu___2 (FStarC_String.concat "\n\t>" (p_reason d)) uu___3 else (let d1 = maybe_invert_p d in let rel = @@ -1740,8 +1724,8 @@ let (explain : cp.FStarC_TypeChecker_Common.rhs in match uu___2 with | (lhs, rhs) -> - FStarC_Compiler_Util.format3 - "%s is not %s the expected type %s" lhs rel rhs) + FStarC_Util.format3 "%s is not %s the expected type %s" lhs + rel rhs) let (occurs : FStarC_Syntax_Syntax.ctx_uvar -> FStarC_Syntax_Syntax.term -> @@ -1753,10 +1737,10 @@ let (occurs : let uu___ = FStarC_Syntax_Free.uvars t in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___) in let occurs1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uv -> FStarC_Syntax_Unionfind.equiv uv.FStarC_Syntax_Syntax.ctx_uvar_head @@ -1783,8 +1767,8 @@ let (occurs_check : uk.FStarC_Syntax_Syntax.ctx_uvar_head in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 - "occurs-check failed (%s occurs in %s)" uu___3 uu___4 in + FStarC_Util.format2 "occurs-check failed (%s occurs in %s)" + uu___3 uu___4 in FStar_Pervasives_Native.Some uu___2) in (uvars, (Prims.op_Negation occurs1), msg) let (occurs_full : @@ -1795,10 +1779,10 @@ let (occurs_full : let uu___ = FStarC_Syntax_Free.uvars_full t in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___) in + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___) in let occurs1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uv -> FStarC_Syntax_Unionfind.equiv uv.FStarC_Syntax_Syntax.ctx_uvar_head @@ -1846,7 +1830,7 @@ let set_uvar : let (commit : FStarC_TypeChecker_Env.env_t -> uvi Prims.list -> unit) = fun env -> fun uvis -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___ -> match uu___ with | UNIV (u, t) -> @@ -1856,7 +1840,7 @@ let (commit : FStarC_TypeChecker_Env.env_t -> uvi Prims.list -> unit) = | uu___1 -> FStarC_Syntax_Unionfind.univ_change u t) | TERM (u, t) -> ((let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) u.FStarC_Syntax_Syntax.ctx_uvar_binders in FStarC_Defensive.def_check_scoped @@ -1872,7 +1856,7 @@ let (find_term_uvar : = fun uv -> fun s -> - FStarC_Compiler_Util.find_map s + FStarC_Util.find_map s (fun uu___ -> match uu___ with | UNIV uu___1 -> FStar_Pervasives_Native.None @@ -1890,7 +1874,7 @@ let (find_univ_uvar : = fun u -> fun s -> - FStarC_Compiler_Util.find_map s + FStarC_Util.find_map s (fun uu___ -> match uu___ with | UNIV (u', t) -> @@ -1985,7 +1969,7 @@ let (whnf : FStarC_TypeChecker_Env.UnfoldUntil FStarC_Syntax_Syntax.delta_constant] else [FStarC_TypeChecker_Env.Weak; FStarC_TypeChecker_Env.HNF] in - FStarC_Compiler_List.op_At uu___2 + FStarC_List.op_At uu___2 [FStarC_TypeChecker_Env.Beta; FStarC_TypeChecker_Env.Reify; FStarC_TypeChecker_Env.Primops] in @@ -2006,7 +1990,7 @@ let (sn_binders : = fun env -> fun binders -> - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___ = let uu___1 = b.FStarC_Syntax_Syntax.binder_bv in @@ -2040,7 +2024,7 @@ let (norm_univ : | FStarC_Syntax_Syntax.U_succ u3 -> let uu___ = aux u3 in FStarC_Syntax_Syntax.U_succ uu___ | FStarC_Syntax_Syntax.U_max us -> - let uu___ = FStarC_Compiler_List.map aux us in + let uu___ = FStarC_List.map aux us in FStarC_Syntax_Syntax.U_max uu___ | uu___ -> u2 in let uu___ = aux u in @@ -2112,8 +2096,8 @@ let (base_and_refinement_maybe_delta : let uu___4 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term tt in - FStarC_Compiler_Util.format2 - "impossible: Got %s ... %s\n" uu___3 uu___4 in + FStarC_Util.format2 "impossible: Got %s ... %s\n" + uu___3 uu___4 in failwith uu___2) | FStarC_Syntax_Syntax.Tm_lazy i -> let uu___ = FStarC_Syntax_Util.unfold_lazy i in aux norm uu___ @@ -2178,8 +2162,8 @@ let (base_and_refinement_maybe_delta : let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t12 in - FStarC_Compiler_Util.format2 - "impossible (outer): Got %s ... %s\n" uu___2 uu___3 in + FStarC_Util.format2 "impossible (outer): Got %s ... %s\n" + uu___2 uu___3 in failwith uu___1 | FStarC_Syntax_Syntax.Tm_ascribed uu___ -> let uu___1 = @@ -2189,8 +2173,8 @@ let (base_and_refinement_maybe_delta : let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t12 in - FStarC_Compiler_Util.format2 - "impossible (outer): Got %s ... %s\n" uu___2 uu___3 in + FStarC_Util.format2 "impossible (outer): Got %s ... %s\n" + uu___2 uu___3 in failwith uu___1 | FStarC_Syntax_Syntax.Tm_delayed uu___ -> let uu___1 = @@ -2200,8 +2184,8 @@ let (base_and_refinement_maybe_delta : let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t12 in - FStarC_Compiler_Util.format2 - "impossible (outer): Got %s ... %s\n" uu___2 uu___3 in + FStarC_Util.format2 "impossible (outer): Got %s ... %s\n" + uu___2 uu___3 in failwith uu___1 | FStarC_Syntax_Syntax.Tm_unknown -> let uu___ = @@ -2211,8 +2195,8 @@ let (base_and_refinement_maybe_delta : let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t12 in - FStarC_Compiler_Util.format2 - "impossible (outer): Got %s ... %s\n" uu___1 uu___2 in + FStarC_Util.format2 "impossible (outer): Got %s ... %s\n" + uu___1 uu___2 in failwith uu___ in let uu___ = whnf env t1 in aux false uu___ let (base_and_refinement : @@ -2274,23 +2258,22 @@ let (force_refinement : let (wl_to_string : worklist -> Prims.string) = fun wl -> let probs_to_string ps = - let uu___ = FStarC_Compiler_List.map (prob_to_string' wl) ps in - FStarC_Compiler_String.concat "\n\t" uu___ in + let uu___ = FStarC_List.map (prob_to_string' wl) ps in + FStarC_String.concat "\n\t" uu___ in let cprobs_to_string ps = let uu___ = - let uu___1 = FStarC_Compiler_CList.map (prob_to_string' wl) ps in - FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) uu___1 in - FStarC_Compiler_String.concat "\n\t" uu___ in + let uu___1 = FStarC_CList.map (prob_to_string' wl) ps in + FStarC_Class_Listlike.to_list (FStarC_CList.listlike_clist ()) uu___1 in + FStarC_String.concat "\n\t" uu___ in let uu___ = probs_to_string wl.attempting in let uu___1 = let uu___2 = - FStarC_Compiler_CList.map + FStarC_CList.map (fun uu___3 -> match uu___3 with | (uu___4, uu___5, uu___6, x) -> x) wl.wl_deferred in cprobs_to_string uu___2 in - FStarC_Compiler_Util.format2 - "{ attempting = [ %s ];\ndeferred = [ %s ] }\n" uu___ uu___1 + FStarC_Util.format2 "{ attempting = [ %s ];\ndeferred = [ %s ] }\n" uu___ + uu___1 let (showable_wl : worklist FStarC_Class_Show.showable) = { FStarC_Class_Show.show = wl_to_string } type flex_t = @@ -2326,7 +2309,7 @@ let (flex_t_to_string : flex_t -> Prims.string) = (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) args in - FStarC_Compiler_Util.format2 "%s [%s]" uu___2 uu___3 + FStarC_Util.format2 "%s [%s]" uu___2 uu___3 let (is_flex : FStarC_Syntax_Syntax.term -> Prims.bool) = fun t -> let uu___ = FStarC_Syntax_Util.head_and_args t in @@ -2381,8 +2364,7 @@ let ensure_no_uvar_subst : (match uu___1 with | FStarC_Syntax_Syntax.Tm_uvar (uv, ([], uu___2)) -> (t0, wl) | FStarC_Syntax_Syntax.Tm_uvar (uv, uu___2) when - FStarC_Compiler_List.isEmpty - uv.FStarC_Syntax_Syntax.ctx_uvar_binders + FStarC_List.isEmpty uv.FStarC_Syntax_Syntax.ctx_uvar_binders -> (t0, wl) | FStarC_Syntax_Syntax.Tm_uvar (uv, s) -> let uu___2 = @@ -2418,14 +2400,13 @@ let ensure_no_uvar_subst : (match uu___4 with | (v, t_v, wl1) -> let args_sol = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Util.arg_of_non_null_binder dom_binders in let sol = FStarC_Syntax_Syntax.mk_Tm_app t_v args_sol t0.FStarC_Syntax_Syntax.pos in - ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Rel in if uu___6 then let uu___7 = @@ -2434,7 +2415,7 @@ let ensure_no_uvar_subst : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term sol in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "ensure_no_uvar_subst solving %s with %s\n" uu___7 uu___8 else ()); @@ -2443,7 +2424,7 @@ let ensure_no_uvar_subst : FStarC_Syntax_Syntax.Already_checked) sol; (let args_sol_s = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | (a, i) -> @@ -2452,8 +2433,8 @@ let ensure_no_uvar_subst : (uu___8, i)) args_sol in let t = FStarC_Syntax_Syntax.mk_Tm_app t_v - (FStarC_Compiler_List.op_At args_sol_s - args) t0.FStarC_Syntax_Syntax.pos in + (FStarC_List.op_At args_sol_s args) + t0.FStarC_Syntax_Syntax.pos in (t, wl1)))))) | uu___2 -> let uu___3 = @@ -2467,7 +2448,7 @@ let ensure_no_uvar_subst : let uu___7 = FStarC_Syntax_Subst.compress head in FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term uu___7 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "ensure_no_uvar_subst: expected a uvar at the head (%s-%s-%s)" uu___4 uu___5 uu___6 in failwith uu___3) @@ -2476,14 +2457,14 @@ let (no_free_uvars : FStarC_Syntax_Syntax.term -> Prims.bool) = (let uu___ = FStarC_Syntax_Free.uvars t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___)) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___)) && (let uu___ = FStarC_Syntax_Free.univs t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_univ_uvar)) (Obj.magic uu___)) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_univ_uvar)) + (Obj.magic uu___)) let rec (may_relate_with_logical_guard : FStarC_TypeChecker_Env.env -> Prims.bool -> FStarC_Syntax_Syntax.typ -> Prims.bool) @@ -2558,9 +2539,7 @@ let (u_abs : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} -> - if - (FStarC_Compiler_List.length bs) = - (FStarC_Compiler_List.length ys) + if (FStarC_List.length bs) = (FStarC_List.length ys) then let uu___2 = FStarC_Syntax_Subst.open_comp bs c in ((ys, t), uu___2) @@ -2569,22 +2548,22 @@ let (u_abs : match uu___3 with | (ys', t1, uu___4) -> let uu___5 = FStarC_Syntax_Util.arrow_formals_comp k in - (((FStarC_Compiler_List.op_At ys ys'), t1), uu___5)) + (((FStarC_List.op_At ys ys'), t1), uu___5)) | uu___2 -> let uu___3 = let uu___4 = FStarC_Syntax_Syntax.mk_Total k in ([], uu___4) in ((ys, t), uu___3) in match uu___ with | ((ys1, t1), (xs, c)) -> - if - (FStarC_Compiler_List.length xs) <> - (FStarC_Compiler_List.length ys1) + if (FStarC_List.length xs) <> (FStarC_List.length ys1) then - FStarC_Syntax_Util.abs ys1 t1 - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.mk_residual_comp - FStarC_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None [])) + let uu___1 = + let uu___2 = + FStarC_Syntax_Util.mk_residual_comp + FStarC_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None [] in + FStar_Pervasives_Native.Some uu___2 in + FStarC_Syntax_Util.abs ys1 t1 uu___1 else (let c1 = let uu___2 = FStarC_Syntax_Util.rename_binders xs ys1 in @@ -2596,8 +2575,7 @@ let (u_abs : let (solve_prob' : Prims.bool -> FStarC_TypeChecker_Common.prob -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax - FStar_Pervasives_Native.option -> + FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option -> uvi Prims.list -> worklist -> worklist) = fun resolve_ok -> @@ -2611,32 +2589,32 @@ let (solve_prob' : | FStar_Pervasives_Native.None -> FStarC_Syntax_Util.t_true | FStar_Pervasives_Native.Some phi1 -> phi1 in let assign_solution xs uv phi1 = - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___2 = FStarC_Effect.op_Bang dbg_Rel in if uu___2 then - let uu___3 = - FStarC_Compiler_Util.string_of_int (p_pid prob) in + let uu___3 = FStarC_Util.string_of_int (p_pid prob) in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_ctxu uv in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term phi1 in - FStarC_Compiler_Util.print3 - "Solving %s (%s) with formula %s\n" uu___3 uu___4 uu___5 + FStarC_Util.print3 "Solving %s (%s) with formula %s\n" + uu___3 uu___4 uu___5 else ()); (let phi2 = - FStarC_Syntax_Util.abs xs phi1 - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot - FStarC_Syntax_Util.ktype0)) in + let uu___2 = + let uu___3 = + FStarC_Syntax_Util.residual_tot + FStarC_Syntax_Util.ktype0 in + FStar_Pervasives_Native.Some uu___3 in + FStarC_Syntax_Util.abs xs phi1 uu___2 in (let uu___3 = - let uu___4 = - FStarC_Compiler_Util.string_of_int (p_pid prob) in + let uu___4 = FStarC_Util.string_of_int (p_pid prob) in Prims.strcat "solve_prob'.sol." uu___4 in let uu___4 = let uu___5 = p_scope prob in - FStarC_Compiler_List.map + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) uu___5 in FStarC_Defensive.def_check_scoped FStarC_Class_Binders.hasBinders_list_bv @@ -2653,12 +2631,12 @@ let (solve_prob' : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term (p_guard prob) in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: this instance %s has already been assigned a solution\n%s\n" uu___3 uu___4 in failwith uu___2 in let args_as_binders args = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___1 -> match uu___1 with | (a, i) -> @@ -2713,13 +2691,12 @@ let (extend_universe_solution : fun pid -> fun sol -> fun wl -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then - let uu___2 = FStarC_Compiler_Util.string_of_int pid in + let uu___2 = FStarC_Util.string_of_int pid in let uu___3 = uvis_to_string wl.tcenv sol in - FStarC_Compiler_Util.print2 "Solving %s: with [%s]\n" uu___2 - uu___3 + FStarC_Util.print2 "Solving %s: with [%s]\n" uu___2 uu___3 else ()); commit wl.tcenv sol; { @@ -2745,15 +2722,14 @@ let (solve_prob : fun uvis -> fun wl -> def_check_prob "solve_prob.prob" prob; - FStarC_Compiler_Util.iter_opt logical_guard + FStarC_Util.iter_opt logical_guard (def_check_term_scoped_in_prob "solve_prob.guard" prob); - (let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___3 = FStarC_Effect.op_Bang dbg_Rel in if uu___3 then - let uu___4 = FStarC_Compiler_Util.string_of_int (p_pid prob) in + let uu___4 = FStarC_Util.string_of_int (p_pid prob) in let uu___5 = uvis_to_string wl.tcenv uvis in - FStarC_Compiler_Util.print2 "Solving %s: with %s\n" uu___4 - uu___5 + FStarC_Util.print2 "Solving %s: with %s\n" uu___4 uu___5 else ()); solve_prob' false prob logical_guard uvis wl let rec (maximal_prefix : @@ -2786,7 +2762,7 @@ let (extend_gamma : = fun g -> fun bs -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun g1 -> fun uu___ -> match uu___ with @@ -2801,7 +2777,7 @@ let (gamma_until : = fun g -> fun bs -> - let uu___ = FStarC_Compiler_List.last_opt bs in + let uu___ = FStarC_List.last_opt bs in match uu___ with | FStar_Pervasives_Native.None -> [] | FStar_Pervasives_Native.Some @@ -2811,7 +2787,7 @@ let (gamma_until : FStarC_Syntax_Syntax.binder_attrs = uu___3;_} -> let uu___4 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun uu___5 -> match uu___5 with | FStarC_Syntax_Syntax.Binding_var x' -> @@ -2859,14 +2835,14 @@ let restrict_ctx : FStarC_Syntax_Syntax.Already_checked) uu___5); wl1) in let bs1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___2 -> match uu___2 with | { FStarC_Syntax_Syntax.binder_bv = bv1; FStarC_Syntax_Syntax.binder_qual = uu___3; FStarC_Syntax_Syntax.binder_positivity = uu___4; FStarC_Syntax_Syntax.binder_attrs = uu___5;_} -> - (FStarC_Compiler_List.existsb + (FStarC_List.existsb (fun uu___6 -> match uu___6 with | { FStarC_Syntax_Syntax.binder_bv = bv2; @@ -2880,7 +2856,7 @@ let restrict_ctx : src.FStarC_Syntax_Syntax.ctx_uvar_binders) && (let uu___6 = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___7 -> match uu___7 with | { @@ -2895,7 +2871,7 @@ let restrict_ctx : FStarC_Syntax_Syntax.bv_eq bv1 bv2) pfx in Prims.op_Negation uu___6)) bs in - if (FStarC_Compiler_List.length bs1) = Prims.int_zero + if (FStarC_List.length bs1) = Prims.int_zero then let uu___2 = FStarC_Syntax_Util.ctx_uvar_typ src in aux uu___2 (fun src' -> src') @@ -2909,8 +2885,7 @@ let restrict_ctx : let uu___4 = let uu___5 = FStarC_Syntax_Syntax.binders_to_names bs1 in - FStarC_Compiler_List.map - FStarC_Syntax_Syntax.as_arg uu___5 in + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___5 in FStarC_Syntax_Syntax.mk_Tm_app src' uu___4 src.FStarC_Syntax_Syntax.ctx_uvar_range)) let restrict_all_uvars : @@ -2929,7 +2904,7 @@ let restrict_all_uvars : | [] -> let ctx_tgt = binders_as_bv_set tgt.FStarC_Syntax_Syntax.ctx_uvar_binders in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun src -> fun wl1 -> let ctx_src = @@ -2938,14 +2913,13 @@ let restrict_all_uvars : let uu___ = FStarC_Class_Setlike.subset () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic ctx_src) (Obj.magic ctx_tgt) in if uu___ then wl1 else restrict_ctx env tgt [] src wl1) sources wl | uu___ -> - FStarC_Compiler_List.fold_right (restrict_ctx env tgt bs) - sources wl + FStarC_List.fold_right (restrict_ctx env tgt bs) sources wl let (intersect_binders : FStarC_Syntax_Syntax.gamma -> FStarC_Syntax_Syntax.binders -> @@ -2959,9 +2933,9 @@ let (intersect_binders : Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Syntax.ord_bv)) ()) in - FStarC_Compiler_List.fold_left + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) + ()) in + FStarC_List.fold_left (fun uu___2 -> fun uu___1 -> (fun out -> @@ -2969,7 +2943,7 @@ let (intersect_binders : Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) x.FStarC_Syntax_Syntax.binder_bv (Obj.magic out))) uu___2 uu___1) uu___ v in @@ -2979,9 +2953,9 @@ let (intersect_binders : Obj.magic (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) ()) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun uu___1 -> (fun out -> @@ -2992,13 +2966,13 @@ let (intersect_binders : (Obj.repr (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) x (Obj.magic out))) | uu___1 -> Obj.magic (Obj.repr out)) uu___2 uu___1) uu___ g in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun b -> match uu___1 with @@ -3012,7 +2986,7 @@ let (intersect_binders : let uu___4 = FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_bv)) x (Obj.magic v1_set) in Prims.op_Negation uu___4 in @@ -3025,7 +2999,7 @@ let (intersect_binders : let uu___5 = FStarC_Class_Setlike.subset () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic fvs) (Obj.magic isect_set) in if uu___5 @@ -3034,21 +3008,20 @@ let (intersect_binders : Obj.magic (FStarC_Class_Setlike.add () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) x (Obj.magic isect_set)) in ((b :: isect), uu___6) else (isect, isect_set)))) ([], ctx_binders) v2 in - match uu___ with | (isect, uu___1) -> FStarC_Compiler_List.rev isect + match uu___ with | (isect, uu___1) -> FStarC_List.rev isect let (binders_eq : FStarC_Syntax_Syntax.binder Prims.list -> FStarC_Syntax_Syntax.binder Prims.list -> Prims.bool) = fun v1 -> fun v2 -> - ((FStarC_Compiler_List.length v1) = (FStarC_Compiler_List.length v2)) - && - (FStarC_Compiler_List.forall2 + ((FStarC_List.length v1) = (FStarC_List.length v2)) && + (FStarC_List.forall2 (fun uu___ -> fun uu___1 -> match (uu___, uu___1) with @@ -3067,7 +3040,7 @@ let (name_exists_in_binders : = fun x -> fun bs -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___ -> match uu___ with | { FStarC_Syntax_Syntax.binder_bv = y; @@ -3086,8 +3059,7 @@ let (pat_vars : fun args -> let rec aux seen args1 = match args1 with - | [] -> - FStar_Pervasives_Native.Some (FStarC_Compiler_List.rev seen) + | [] -> FStar_Pervasives_Native.Some (FStarC_List.rev seen) | (arg, i)::args2 -> let hd = sn env arg in (match hd.FStarC_Syntax_Syntax.n with @@ -3128,7 +3100,7 @@ let (string_of_match_result : match_result -> Prims.string) = FStarC_Syntax_Syntax.showable_delta_depth)) (d1, d2) in Prims.strcat "MisMatch " uu___1 | HeadMatch u -> - let uu___1 = FStarC_Compiler_Util.string_of_bool u in + let uu___1 = FStarC_Util.string_of_bool u in Prims.strcat "HeadMatch " uu___1 | FullMatch -> "FullMatch" let (showable_match_result : match_result FStarC_Class_Show.showable) = @@ -3157,22 +3129,21 @@ let rec (head_matches : fun t2 -> let t11 = FStarC_Syntax_Util.unmeta t1 in let t21 = FStarC_Syntax_Util.unmeta t2 in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_RelDelta in + (let uu___1 = FStarC_Effect.op_Bang dbg_RelDelta in if uu___1 then ((let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t11 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t21 in - FStarC_Compiler_Util.print2 "head_matches %s %s\n" uu___3 uu___4); + FStarC_Util.print2 "head_matches %s %s\n" uu___3 uu___4); (let uu___4 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t11 in let uu___5 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t21 in - FStarC_Compiler_Util.print2 " %s -- %s\n" uu___4 - uu___5)) + FStarC_Util.print2 " %s -- %s\n" uu___4 uu___5)) else ()); (match ((t11.FStarC_Syntax_Syntax.n), (t21.FStarC_Syntax_Syntax.n)) with @@ -3350,7 +3321,7 @@ let (head_matches_delta : fun t1 -> fun t2 -> let base_steps = - FStarC_Compiler_List.op_At + FStarC_List.op_At (if logical then [FStarC_TypeChecker_Env.DontUnfoldAttr @@ -3363,7 +3334,7 @@ let (head_matches_delta : let head = let uu___ = unrefine env t in FStarC_Syntax_Util.head_of uu___ in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_RelDelta in + (let uu___1 = FStarC_Effect.op_Bang dbg_RelDelta in if uu___1 then let uu___2 = @@ -3371,8 +3342,7 @@ let (head_matches_delta : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term head in - FStarC_Compiler_Util.print2 "Head of %s is %s\n" uu___2 - uu___3 + FStarC_Util.print2 "Head of %s is %s\n" uu___2 uu___3 else ()); (let uu___1 = let uu___2 = FStarC_Syntax_Util.un_uinst head in @@ -3387,20 +3357,19 @@ let (head_matches_delta : (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in (match uu___2 with | FStar_Pervasives_Native.None -> - ((let uu___4 = - FStarC_Compiler_Effect.op_Bang dbg_RelDelta in + ((let uu___4 = FStarC_Effect.op_Bang dbg_RelDelta in if uu___4 then let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term head in - FStarC_Compiler_Util.print1 - "No definition found for %s\n" uu___5 + FStarC_Util.print1 "No definition found for %s\n" + uu___5 else ()); FStar_Pervasives_Native.None) | FStar_Pervasives_Native.Some uu___3 -> let basic_steps = - FStarC_Compiler_List.op_At + FStarC_List.op_At (if logical then [FStarC_TypeChecker_Env.DontUnfoldAttr @@ -3433,8 +3402,7 @@ let (head_matches_delta : if uu___4 then FStar_Pervasives_Native.None else - ((let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg_RelDelta in + ((let uu___7 = FStarC_Effect.op_Bang dbg_RelDelta in if uu___7 then let uu___8 = @@ -3443,8 +3411,8 @@ let (head_matches_delta : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t' in - FStarC_Compiler_Util.print2 - "Inlined %s to %s\n" uu___8 uu___9 + FStarC_Util.print2 "Inlined %s to %s\n" uu___8 + uu___9 else ()); FStar_Pervasives_Native.Some t')) | uu___2 -> FStar_Pervasives_Native.None) in @@ -3469,7 +3437,7 @@ let (head_matches_delta : Prims.op_Negation uu___ in let rec aux retry n_delta t11 t21 = let r = head_matches env t11 t21 in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_RelDelta in + (let uu___1 = FStarC_Effect.op_Bang dbg_RelDelta in if uu___1 then let uu___2 = @@ -3479,8 +3447,8 @@ let (head_matches_delta : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t21 in let uu___4 = string_of_match_result r in - FStarC_Compiler_Util.print3 "head_matches (%s, %s) = %s\n" - uu___2 uu___3 uu___4 + FStarC_Util.print3 "head_matches (%s, %s) = %s\n" uu___2 + uu___3 uu___4 else ()); (let reduce_one_and_try_again d1 d2 = let d1_greater_than_d2 = @@ -3593,7 +3561,7 @@ let (head_matches_delta : | MisMatch uu___1 -> fail n_delta r t11 t21 | uu___1 -> success n_delta r t11 t21) in let r = aux true Prims.int_zero t1 t2 in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_RelDelta in + (let uu___1 = FStarC_Effect.op_Bang dbg_RelDelta in if uu___1 then let uu___2 = @@ -3607,13 +3575,13 @@ let (head_matches_delta : (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_term))) r in - FStarC_Compiler_Util.print3 - "head_matches_delta (%s, %s) = %s\n" uu___2 uu___3 uu___4 + FStarC_Util.print3 "head_matches_delta (%s, %s) = %s\n" uu___2 + uu___3 uu___4 else ()); r let (kind_type : FStarC_Syntax_Syntax.binders -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.typ) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.typ) = fun binders -> fun r -> @@ -3927,17 +3895,14 @@ let (next_prob : (match min with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.Some - (hd1, (FStarC_Compiler_List.op_At out tl), - rank1) + (hd1, (FStarC_List.op_At out tl), rank1) | FStar_Pervasives_Native.Some m -> FStar_Pervasives_Native.Some - (hd1, - (FStarC_Compiler_List.op_At out (m :: tl)), - rank1)) + (hd1, (FStarC_List.op_At out (m :: tl)), rank1)) else (let uu___3 = (min_rank = FStar_Pervasives_Native.None) || - (let uu___4 = FStarC_Compiler_Option.get min_rank in + (let uu___4 = FStarC_Option.get min_rank in rank_less_than rank1 uu___4) in if uu___3 then @@ -3971,14 +3936,14 @@ let (flex_prob_closing : uu___3.FStarC_Syntax_Syntax.n in (match uu___2 with | FStarC_Syntax_Syntax.Tm_uvar (u, uu___3) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___4 -> match uu___4 with | { FStarC_Syntax_Syntax.binder_bv = y; FStarC_Syntax_Syntax.binder_qual = uu___5; FStarC_Syntax_Syntax.binder_positivity = uu___6; FStarC_Syntax_Syntax.binder_attrs = uu___7;_} -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___8 -> match uu___8 with | { FStarC_Syntax_Syntax.binder_bv = x; @@ -4053,7 +4018,7 @@ let rec (really_solve_universe_eq : let rec occurs_univ v1 u = match u with | FStarC_Syntax_Syntax.U_max us -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun u3 -> let uu___ = FStarC_Syntax_Util.univ_kernel u3 in match uu___ with @@ -4065,18 +4030,18 @@ let rec (really_solve_universe_eq : | uu___ -> occurs_univ v1 (FStarC_Syntax_Syntax.U_max [u]) in let rec filter_out_common_univs u12 u22 = let common_elts = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uvs -> fun uv1 -> let uu___ = - FStarC_Compiler_List.existsML + FStarC_List.existsML (fun uv2 -> FStarC_Syntax_Util.eq_univs uv1 uv2) u22 in if uu___ then uv1 :: uvs else uvs) [] u12 in let filter = - FStarC_Compiler_List.filter + FStarC_List.filter (fun u -> let uu___ = - FStarC_Compiler_List.existsML + FStarC_List.existsML (fun u' -> FStarC_Syntax_Util.eq_univs u u') common_elts in Prims.op_Negation uu___) in @@ -4093,8 +4058,8 @@ let rec (really_solve_universe_eq : (match uu___1 with | (us11, us21) -> if - (FStarC_Compiler_List.length us11) = - (FStarC_Compiler_List.length us21) + (FStarC_List.length us11) = + (FStarC_List.length us21) then let rec aux wl1 us12 us22 = match (us12, us22) with @@ -4116,7 +4081,7 @@ let rec (really_solve_universe_eq : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u22 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unable to unify universes: %s and %s" uu___4 uu___5)) | (FStarC_Syntax_Syntax.U_max us, u') -> @@ -4150,7 +4115,7 @@ let rec (really_solve_universe_eq : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u22 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Unable to unify universes: %s and %s (%s)" uu___3 uu___4 msg)) in match (u11, u21) with @@ -4162,7 +4127,7 @@ let rec (really_solve_universe_eq : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u21 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: found an de Bruijn universe variable or unknown universe: %s, %s" uu___3 uu___4 in failwith uu___2 @@ -4174,7 +4139,7 @@ let rec (really_solve_universe_eq : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u21 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: found an de Bruijn universe variable or unknown universe: %s, %s" uu___2 uu___3 in failwith uu___1 @@ -4186,7 +4151,7 @@ let rec (really_solve_universe_eq : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u21 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: found an de Bruijn universe variable or unknown universe: %s, %s" uu___3 uu___4 in failwith uu___2 @@ -4198,7 +4163,7 @@ let rec (really_solve_universe_eq : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u21 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: found an de Bruijn universe variable or unknown universe: %s, %s" uu___2 uu___3 in failwith uu___1 @@ -4234,8 +4199,8 @@ let rec (really_solve_universe_eq : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u3 in - FStarC_Compiler_Util.format2 - "Failed occurs check: %s occurs in %s" uu___2 uu___3 in + FStarC_Util.format2 "Failed occurs check: %s occurs in %s" + uu___2 uu___3 in try_umax_components u11 u21 uu___1 else (let uu___2 = @@ -4253,8 +4218,8 @@ let rec (really_solve_universe_eq : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u3 in - FStarC_Compiler_Util.format2 - "Failed occurs check: %s occurs in %s" uu___2 uu___3 in + FStarC_Util.format2 "Failed occurs check: %s occurs in %s" + uu___2 uu___3 in try_umax_components u11 u21 uu___1 else (let uu___2 = @@ -4383,8 +4348,7 @@ let (should_defer_flex_to_user_tac : worklist -> flex_t -> Prims.bool) = let b = FStarC_TypeChecker_DeferredImplicits.should_defer_uvar_to_user_tac wl.tcenv u in - ((let uu___4 = - FStarC_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in + ((let uu___4 = FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___4 then let uu___5 = @@ -4394,7 +4358,7 @@ let (should_defer_flex_to_user_tac : worklist -> flex_t -> Prims.bool) = let uu___7 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool (wl.tcenv).FStarC_TypeChecker_Env.enable_defer_to_tac in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Rel.should_defer_flex_to_user_tac for %s returning %s (env.enable_defer_to_tac: %s)\n" uu___5 uu___6 uu___7 else ()); @@ -4413,7 +4377,7 @@ let (quasi_pattern : let t_hd = FStarC_Syntax_Util.ctx_uvar_typ ctx_uvar in let ctx = ctx_uvar.FStarC_Syntax_Syntax.ctx_uvar_binders in let name_exists_in x bs = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | { FStarC_Syntax_Syntax.binder_bv = y; @@ -4428,14 +4392,14 @@ let (quasi_pattern : let uu___3 = let uu___4 = FStarC_Syntax_Syntax.mk_Total t_res in FStarC_Syntax_Util.arrow formals uu___4 in - ((FStarC_Compiler_List.rev pat_binders), uu___3) in + ((FStarC_List.rev pat_binders), uu___3) in FStar_Pervasives_Native.Some uu___2 | (uu___2, []) -> let uu___3 = let uu___4 = let uu___5 = FStarC_Syntax_Syntax.mk_Total t_res in FStarC_Syntax_Util.arrow formals uu___5 in - ((FStarC_Compiler_List.rev pat_binders), uu___4) in + ((FStarC_List.rev pat_binders), uu___4) in FStar_Pervasives_Native.Some uu___3 | (fml::formals1, (a, a_imp)::args2) -> let uu___2 = @@ -4629,14 +4593,13 @@ let (run_meta_arg_tac : FStarC_TypeChecker_Env.missing_decl = (env.FStarC_TypeChecker_Env.missing_decl) } in - ((let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Tac in + ((let uu___1 = FStarC_Effect.op_Bang dbg_Tac in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_ctxu ctx_u in - FStarC_Compiler_Util.print1 "Running tactic for meta-arg %s\n" - uu___2 + FStarC_Util.print1 "Running tactic for meta-arg %s\n" uu___2 else ()); FStarC_Errors.with_ctx "Running tactic for meta-arg" (fun uu___1 -> @@ -4653,12 +4616,12 @@ let (simplify_vc : fun full_norm_allowed -> fun env -> fun t -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Simplification in + (let uu___1 = FStarC_Effect.op_Bang dbg_Simplification in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 "Simplifying guard %s\n" uu___2 + FStarC_Util.print1 "Simplifying guard %s\n" uu___2 else ()); (let steps = [FStarC_TypeChecker_Env.Beta; @@ -4672,12 +4635,12 @@ let (simplify_vc : else FStarC_TypeChecker_Env.NoFullNorm :: steps in let t' = norm_with_steps "FStarC.TypeChecker.Rel.simplify_vc" steps1 env t in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Simplification in + (let uu___2 = FStarC_Effect.op_Bang dbg_Simplification in if uu___2 then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t' in - FStarC_Compiler_Util.print1 "Simplified guard to %s\n" uu___3 + FStarC_Util.print1 "Simplified guard to %s\n" uu___3 else ()); t') let (__simplify_guard : @@ -4765,7 +4728,7 @@ let (apply_substitutive_indexed_subcomp : Prims.int -> worklist -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.typ * FStarC_TypeChecker_Common.prob Prims.list * worklist)) @@ -4800,8 +4763,7 @@ let (apply_substitutive_indexed_subcomp : wl) else (let split l = - FStarC_Compiler_List.splitAt - num_effect_params l in + FStarC_List.splitAt num_effect_params l in let uu___3 = split bs1 in match uu___3 with | (eff_params_bs, bs2) -> @@ -4816,7 +4778,7 @@ let (apply_substitutive_indexed_subcomp : (match uu___5 with | (param_args2, args2) -> let uu___6 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___7 -> fun uu___8 -> fun uu___9 -> @@ -4837,7 +4799,7 @@ let (apply_substitutive_indexed_subcomp : (match uu___12 with | (p, wl2) -> - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ps [p]), wl2))) ([], wl) param_args1 @@ -4845,7 +4807,7 @@ let (apply_substitutive_indexed_subcomp : (match uu___6 with | (probs, wl1) -> let param_subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun uu___7 -> match uu___7 @@ -4858,7 +4820,7 @@ let (apply_substitutive_indexed_subcomp : eff_params_bs param_args1 in (bs2, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At subst param_subst), args1, args2, probs, wl1))))) in @@ -4867,13 +4829,12 @@ let (apply_substitutive_indexed_subcomp : eff_params_sub_probs, wl1) -> let uu___2 = let uu___3 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length args1) - bs2 in + FStarC_List.splitAt + (FStarC_List.length args1) bs2 in match uu___3 with | (f_bs, bs3) -> let f_substs = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun f_b -> fun uu___4 -> match uu___4 with @@ -4882,8 +4843,7 @@ let (apply_substitutive_indexed_subcomp : ((f_b.FStarC_Syntax_Syntax.binder_bv), arg)) f_bs args1 in (bs3, - (FStarC_Compiler_List.op_At subst1 - f_substs)) in + (FStarC_List.op_At subst1 f_substs)) in (match uu___2 with | (bs3, subst2) -> let uu___3 = @@ -4892,13 +4852,12 @@ let (apply_substitutive_indexed_subcomp : k then let uu___4 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length - args2) bs3 in + FStarC_List.splitAt + (FStarC_List.length args2) bs3 in match uu___4 with | (g_bs, bs4) -> let g_substs = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun g_b -> fun uu___5 -> match uu___5 with @@ -4908,15 +4867,15 @@ let (apply_substitutive_indexed_subcomp : arg)) g_bs args2 in (bs4, - (FStarC_Compiler_List.op_At - subst2 g_substs), [], wl1) + (FStarC_List.op_At subst2 + g_substs), [], wl1) else if FStarC_Syntax_Syntax.uu___is_Substitutive_invariant_combinator k then (let uu___5 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___6 -> fun uu___7 -> fun uu___8 -> @@ -4935,7 +4894,7 @@ let (apply_substitutive_indexed_subcomp : (match uu___11 with | (p, wl3) -> - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ps [p]), wl3))) @@ -4951,14 +4910,13 @@ let (apply_substitutive_indexed_subcomp : wl2) -> let bs5 = let uu___4 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length - bs4) - - Prims.int_one) bs4 in + FStarC_List.splitAt + ((FStarC_List.length bs4) - + Prims.int_one) bs4 in FStar_Pervasives_Native.fst uu___4 in let uu___4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___5 -> fun b -> match uu___5 with @@ -4968,7 +4926,7 @@ let (apply_substitutive_indexed_subcomp : env [b] ss (fun b1 -> let uu___7 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if uu___7 then @@ -4977,9 +4935,9 @@ let (apply_substitutive_indexed_subcomp : FStarC_Syntax_Print.showable_binder b1 in let uu___9 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range r1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "implicit var for additional binder %s in subcomp %s at %s" uu___8 subcomp_name @@ -4992,7 +4950,7 @@ let (apply_substitutive_indexed_subcomp : let uu___7 = let uu___8 = FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist + (FStarC_CList.monoid_clist ()) g.FStarC_TypeChecker_Common.implicits wl3.wl_implicits in @@ -5025,7 +4983,7 @@ let (apply_substitutive_indexed_subcomp : = (wl3.typeclass_variables) } in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ss [FStarC_Syntax_Syntax.NT ((b.FStarC_Syntax_Syntax.binder_bv), @@ -5043,11 +5001,11 @@ let (apply_substitutive_indexed_subcomp : let fml = let uu___5 = let uu___6 = - FStarC_Compiler_List.hd + FStarC_List.hd subcomp_ct.FStarC_Syntax_Syntax.comp_univs in let uu___7 = let uu___8 = - FStarC_Compiler_List.hd + FStarC_List.hd subcomp_ct.FStarC_Syntax_Syntax.effect_args in FStar_Pervasives_Native.fst uu___8 in @@ -5058,9 +5016,9 @@ let (apply_substitutive_indexed_subcomp : env u subcomp_ct.FStarC_Syntax_Syntax.result_typ wp - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in (fml, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_sub_probs f_g_args_eq_sub_probs), wl3))))) @@ -5079,7 +5037,7 @@ let (apply_ad_hoc_indexed_subcomp : -> worklist -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.typ * FStarC_TypeChecker_Common.prob Prims.list * worklist)) = @@ -5096,25 +5054,23 @@ let (apply_ad_hoc_indexed_subcomp : let uu___ = FStarC_Ident.string_of_lid ct2.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unexpected shape of stronger for %s, reason: %s" uu___ s in let uu___ = - if - (FStarC_Compiler_List.length bs) >= - (Prims.of_int (2)) + if (FStarC_List.length bs) >= (Prims.of_int (2)) then let uu___1 = bs in match uu___1 with | a_b::bs1 -> let uu___2 = let uu___3 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs1) - - Prims.int_one) bs1 in + FStarC_List.splitAt + ((FStarC_List.length bs1) - Prims.int_one) + bs1 in match uu___3 with | (l1, l2) -> - let uu___4 = FStarC_Compiler_List.hd l2 in + let uu___4 = FStarC_List.hd l2 in (l1, uu___4) in (match uu___2 with | (rest_bs, f_b) -> (a_b, rest_bs, f_b)) @@ -5139,17 +5095,15 @@ let (apply_ad_hoc_indexed_subcomp : (ct2.FStarC_Syntax_Syntax.result_typ))] (fun b -> let uu___2 = - FStarC_Compiler_Effect.op_Bang - dbg_LayeredEffectsApp in + FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if uu___2 then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in let uu___4 = - FStarC_Compiler_Range_Ops.string_of_range - r1 in - FStarC_Compiler_Util.format3 + FStarC_Range_Ops.string_of_range r1 in + FStarC_Util.format3 "implicit for binder %s in subcomp %s at %s" uu___3 subcomp_name uu___4 else "apply_ad_hoc_indexed_subcomp") r1 in @@ -5158,7 +5112,7 @@ let (apply_ad_hoc_indexed_subcomp : let wl1 = let uu___2 = FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) + (FStarC_CList.monoid_clist ()) g_uvars.FStarC_TypeChecker_Common.implicits wl.wl_implicits in { @@ -5177,7 +5131,7 @@ let (apply_ad_hoc_indexed_subcomp : (wl.typeclass_variables) } in let substs = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun t -> FStarC_Syntax_Syntax.NT @@ -5198,20 +5152,19 @@ let (apply_ad_hoc_indexed_subcomp : FStarC_Syntax_Util.effect_indices_from_repr (f_b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort uu___4 r1 uu___5 in - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Syntax_Subst.subst substs) uu___3 in let uu___3 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst + FStarC_List.map FStar_Pervasives_Native.fst ct1.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___4 -> fun f_sort_i -> fun c1_i -> match uu___4 with | (ps, wl2) -> ((let uu___6 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if uu___6 then @@ -5223,7 +5176,7 @@ let (apply_ad_hoc_indexed_subcomp : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term c1_i in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Layered Effects (%s) %s = %s\n" subcomp_name uu___7 uu___8 else ()); @@ -5233,9 +5186,9 @@ let (apply_ad_hoc_indexed_subcomp : c1_i "indices of c1" in match uu___6 with | (p, wl3) -> - ((FStarC_Compiler_List.op_At - ps [p]), wl3)))) - ([], wl1) f_sort_is uu___3 in + ((FStarC_List.op_At ps [p]), + wl3)))) ([], wl1) + f_sort_is uu___3 in (match uu___2 with | (f_sub_probs, wl2) -> let subcomp_ct = @@ -5257,17 +5210,17 @@ let (apply_ad_hoc_indexed_subcomp : subcomp_ct.FStarC_Syntax_Syntax.result_typ uu___4 r1 uu___5 in let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst ct2.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___5 -> fun g_sort_i -> fun c2_i -> match uu___5 with | (ps, wl3) -> ((let uu___7 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if uu___7 then @@ -5279,7 +5232,7 @@ let (apply_ad_hoc_indexed_subcomp : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term c2_i in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Layered Effects (%s) %s = %s\n" subcomp_name uu___8 uu___9 @@ -5290,19 +5243,19 @@ let (apply_ad_hoc_indexed_subcomp : c2_i "indices of c2" in match uu___7 with | (p, wl4) -> - ((FStarC_Compiler_List.op_At - ps [p]), wl4)))) + ((FStarC_List.op_At ps + [p]), wl4)))) ([], wl2) g_sort_is uu___4 in (match uu___3 with | (g_sub_probs, wl3) -> let fml = let uu___4 = let uu___5 = - FStarC_Compiler_List.hd + FStarC_List.hd subcomp_ct.FStarC_Syntax_Syntax.comp_univs in let uu___6 = let uu___7 = - FStarC_Compiler_List.hd + FStarC_List.hd subcomp_ct.FStarC_Syntax_Syntax.effect_args in FStar_Pervasives_Native.fst uu___7 in @@ -5313,18 +5266,17 @@ let (apply_ad_hoc_indexed_subcomp : env u subcomp_ct.FStarC_Syntax_Syntax.result_typ wp - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in (fml, - (FStarC_Compiler_List.op_At - f_sub_probs g_sub_probs), wl3)))) + (FStarC_List.op_At f_sub_probs + g_sub_probs), wl3)))) let (has_typeclass_constraint : FStarC_Syntax_Syntax.ctx_uvar -> worklist -> Prims.bool) = fun u -> fun wl -> FStarC_Class_Setlike.for_any () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Syntax_Free.ord_ctx_uvar)) + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Free.ord_ctx_uvar)) (fun v -> FStarC_Syntax_Unionfind.equiv v.FStarC_Syntax_Syntax.ctx_uvar_head u.FStarC_Syntax_Syntax.ctx_uvar_head) @@ -5347,13 +5299,13 @@ let (has_free_uvars : FStarC_Syntax_Syntax.term -> Prims.bool) = let uu___1 = FStarC_Syntax_Free.uvars_uncached t in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___1) in + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) + (Obj.magic uu___1) in Prims.op_Negation uu___ let (env_has_free_uvars : FStarC_TypeChecker_Env.env_t -> Prims.bool) = fun e -> let uu___ = FStarC_TypeChecker_Env.all_binders e in - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun b -> has_free_uvars (b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort) @@ -5361,7 +5313,7 @@ let (env_has_free_uvars : FStarC_TypeChecker_Env.env_t -> Prims.bool) = let (gamma_has_free_uvars : FStarC_Syntax_Syntax.binding Prims.list -> Prims.bool) = fun g -> - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.Binding_var bv -> @@ -5388,20 +5340,20 @@ let (__proj__Reveal__item___0 : = fun projectee -> match projectee with | Reveal _0 -> _0 let rec (solve : worklist -> solution) = fun probs -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = wl_to_string probs in - FStarC_Compiler_Util.print1 "solve:\n\t%s\n" uu___2 + FStarC_Util.print1 "solve:\n\t%s\n" uu___2 else ()); - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_ImplicitTrace in + (let uu___2 = FStarC_Effect.op_Bang dbg_ImplicitTrace in if uu___2 then let uu___3 = FStarC_Class_Show.show - (FStarC_Compiler_CList.showable_clist + (FStarC_CList.showable_clist FStarC_TypeChecker_Common.showable_implicit) probs.wl_implicits in - FStarC_Compiler_Util.print1 "solve: wl_implicits = %s\n" uu___3 + FStarC_Util.print1 "solve: wl_implicits = %s\n" uu___3 else ()); (let uu___2 = next_prob probs in match uu___2 with @@ -5426,7 +5378,7 @@ let rec (solve : worklist -> solution) = solve_c (maybe_invert cp) probs1 | FStarC_TypeChecker_Common.TProb tp -> let uu___4 = - FStarC_Compiler_Util.physical_equality + FStarC_Util.physical_equality tp.FStarC_TypeChecker_Common.lhs tp.FStarC_TypeChecker_Common.rhs in if uu___4 @@ -5448,8 +5400,7 @@ let rec (solve : worklist -> solution) = | uu___7 -> false in let maybe_expand tp1 = let uu___6 = - ((let uu___7 = FStarC_Options_Ext.get "__unrefine" in - uu___7 <> "") && + ((FStarC_Options_Ext.enabled "__unrefine") && (tp1.FStarC_TypeChecker_Common.relation = FStarC_TypeChecker_Common.SUB)) && (is_expand_uvar tp1.FStarC_TypeChecker_Common.rhs) in @@ -5474,8 +5425,7 @@ let rec (solve : worklist -> solution) = [FStarC_Parser_Const.do_not_unrefine_attr]; FStarC_TypeChecker_Env.Unrefine] (p_env probs1 hd) lhs_norm in - ((let uu___9 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___9 = FStarC_Effect.op_Bang dbg_Rel in if uu___9 then let uu___10 = @@ -5488,7 +5438,7 @@ let rec (solve : worklist -> solution) = let uu___12 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lhs' in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "GGG widening uvar %s! RHS %s ~> %s\n" uu___10 uu___11 uu___12 else ()); @@ -5564,7 +5514,7 @@ let rec (solve : worklist -> solution) = let uu___3 = Obj.magic (FStarC_Class_Listlike.view () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())) + (Obj.magic (FStarC_CList.listlike_clist ())) (Obj.magic probs.wl_deferred)) in (match uu___3 with | FStarC_Class_Listlike.VNil -> @@ -5572,12 +5522,12 @@ let rec (solve : worklist -> solution) = let uu___5 = as_deferred probs.wl_deferred_to_tac in ((Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))), + (Obj.magic (FStarC_CList.listlike_clist ())))), uu___5, (probs.wl_implicits)) in Success uu___4 | FStarC_Class_Listlike.VCons (uu___4, uu___5) -> let uu___6 = - FStarC_Compiler_CList.partition + FStarC_CList.partition (fun uu___7 -> match uu___7 with | (c, uu___8, uu___9, uu___10) -> c < probs.ctr) @@ -5587,8 +5537,7 @@ let rec (solve : worklist -> solution) = let uu___7 = Obj.magic (FStarC_Class_Listlike.view () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ())) + (Obj.magic (FStarC_CList.listlike_clist ())) (Obj.magic attempt1)) in (match uu___7 with | FStarC_Class_Listlike.VNil -> @@ -5602,9 +5551,8 @@ let rec (solve : worklist -> solution) = let uu___10 = let uu___11 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) - attempt1 in - FStarC_Compiler_List.map + (FStarC_CList.listlike_clist ()) attempt1 in + FStarC_List.map (fun uu___12 -> match uu___12 with | (uu___13, uu___14, uu___15, y) -> y) @@ -5707,13 +5655,13 @@ and (giveup_or_defer : fun msg -> if wl.defer_ok = DeferAny then - ((let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in let uu___3 = FStarC_Thunk.force msg in - FStarC_Compiler_Util.print2 - "\n\t\tDeferring %s\n\t\tBecause %s\n" uu___2 uu___3 + FStarC_Util.print2 "\n\t\tDeferring %s\n\t\tBecause %s\n" + uu___2 uu___3 else ()); (let uu___1 = defer reason msg orig wl in solve uu___1)) else giveup wl msg orig @@ -5728,13 +5676,13 @@ and (giveup_or_defer_flex_flex : fun msg -> if wl.defer_ok <> NoDefer then - ((let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in let uu___3 = FStarC_Thunk.force msg in - FStarC_Compiler_Util.print2 - "\n\t\tDeferring %s\n\t\tBecause %s\n" uu___2 uu___3 + FStarC_Util.print2 "\n\t\tDeferring %s\n\t\tBecause %s\n" + uu___2 uu___3 else ()); (let uu___1 = defer reason msg orig wl in solve uu___1)) else giveup wl msg orig @@ -5743,12 +5691,11 @@ and (defer_to_user_tac : fun orig -> fun reason -> fun wl -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = prob_to_string wl.tcenv orig in - FStarC_Compiler_Util.print1 "\n\t\tDeferring %s to a tactic\n" - uu___2 + FStarC_Util.print1 "\n\t\tDeferring %s to a tactic\n" uu___2 else ()); (let wl1 = solve_prob orig FStar_Pervasives_Native.None [] wl in let wl2 = @@ -5759,8 +5706,8 @@ and (defer_to_user_tac : uu___3, orig) in Obj.magic (FStarC_Class_Listlike.cons () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())) - uu___2 (Obj.magic wl1.wl_deferred_to_tac)) in + (Obj.magic (FStarC_CList.listlike_clist ())) uu___2 + (Obj.magic wl1.wl_deferred_to_tac)) in { attempting = (wl1.attempting); wl_deferred = (wl1.wl_deferred); @@ -5839,15 +5786,15 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_TypeChecker_Common.TProb p); ((FStarC_TypeChecker_Common.TProb p), wl3)) in let pairwise t1 t2 wl2 = - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___2 = FStarC_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 - "[meet/join]: pairwise: %s and %s\n" uu___3 uu___4 + FStarC_Util.print2 "[meet/join]: pairwise: %s and %s\n" + uu___3 uu___4 else ()); (let uu___2 = head_matches_delta @@ -5890,10 +5837,8 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (match uu___5 with | (t2_hd, t2_args) -> if - (FStarC_Compiler_List.length t1_args) - <> - (FStarC_Compiler_List.length - t2_args) + (FStarC_List.length t1_args) <> + (FStarC_List.length t2_args) then FStar_Pervasives_Native.None else (let uu___7 = @@ -5907,7 +5852,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : FStarC_Syntax_Syntax.as_arg t2_hd in uu___10 :: t2_args in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___10 -> fun uu___11 -> fun uu___12 -> @@ -5934,7 +5879,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = (wl4.wl_deferred_to_tac); @@ -5949,7 +5894,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = (wl4.repr_subcomp_allowed); @@ -5973,7 +5918,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))) defer_to_tac imps in FStar_Pervasives_Native.Some @@ -6125,15 +6070,14 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : let uu___4 = combine t11 t21 wl2 in (match uu___4 with | (t12, ps, wl3) -> - ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Rel in if uu___6 then let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t12 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "pairwise fallback2 succeeded: %s" uu___7 else ()); @@ -6147,13 +6091,10 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : let uu___2 = pairwise out t wl2 in (match uu___2 with | (out1, probs', wl3) -> - aux - (out1, - (FStarC_Compiler_List.op_At probs probs'), - wl3) ts2)) in - let uu___1 = - let uu___2 = FStarC_Compiler_List.hd ts in (uu___2, [], wl1) in - let uu___2 = FStarC_Compiler_List.tl ts in aux uu___1 uu___2 in + aux (out1, (FStarC_List.op_At probs probs'), wl3) + ts2)) in + let uu___1 = let uu___2 = FStarC_List.hd ts in (uu___2, [], wl1) in + let uu___2 = FStarC_List.tl ts in aux uu___1 uu___2 in let uu___1 = if flip then @@ -6186,14 +6127,13 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_TypeChecker_Common.TProb tp) | FStar_Pervasives_Native.Some (flex_bs, flex_t1) -> - ((let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___7 = FStarC_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = - FStarC_Compiler_Util.string_of_int + FStarC_Util.string_of_int tp.FStarC_TypeChecker_Common.pid in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Trying to solve by imitating arrow:%s\n" uu___8 else ()); @@ -6232,13 +6172,13 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : }] wl in solve uu___5) | uu___3 -> - ((let uu___5 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___5 = FStarC_Effect.op_Bang dbg_Rel in if uu___5 then let uu___6 = FStarC_Class_Show.show FStarC_Class_Show.showable_int tp.FStarC_TypeChecker_Common.pid in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Trying to solve by meeting refinements:%s\n" uu___6 else ()); (let uu___5 = FStarC_Syntax_Util.head_and_args this_flex in @@ -6267,7 +6207,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : ctx_uvar'.FStarC_Syntax_Syntax.ctx_uvar_head | uu___10 -> false) in let uu___7 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___8 -> match uu___8 with | FStarC_TypeChecker_Common.TProb tp1 -> @@ -6290,7 +6230,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : let bounds_typs = let uu___8 = whnf env this_rigid in let uu___9 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___10 -> match uu___10 with | FStarC_TypeChecker_Common.TProb @@ -6389,7 +6329,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_TypeChecker_Common.TProb eq_prob); (let uu___13 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___13 then @@ -6422,14 +6362,14 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : } in let uu___14 = wl_to_string wl'1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "After meet/join refinements: %s\n" uu___14 else ()); (let tx = FStarC_Syntax_Unionfind.new_transaction () in - FStarC_Compiler_List.iter + FStarC_List.iter (def_check_prob "meet_or_join3_sub") sub_probs; @@ -6443,7 +6383,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = @@ -6460,7 +6400,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = @@ -6507,11 +6447,11 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))) defer_to_tac imps in let g = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun g1 -> fun p -> FStarC_Syntax_Util.mk_conj @@ -6526,7 +6466,7 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : (FStar_Pervasives_Native.Some g) [] wl3 in let uu___16 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun wl5 -> fun p -> solve_prob' @@ -6539,22 +6479,22 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : solve wl4) | Failed (p, msg) -> ((let uu___16 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___16 then let uu___17 = let uu___18 = - FStarC_Compiler_List.map + FStarC_List.map (prob_to_string env) ((FStarC_TypeChecker_Common.TProb eq_prob) :: sub_probs) in - FStarC_Compiler_String.concat + FStarC_String.concat "\n" uu___18 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "meet/join attempted and failed to solve problems:\n%s\n" uu___17 else ()); @@ -6699,24 +6639,22 @@ and (solve_rigid_flex_or_flex_rigid_subtyping : | uu___7 when flip -> let uu___8 = let uu___9 = - FStarC_Compiler_Util.string_of_int - (rank_t_num rank1) in + FStarC_Util.string_of_int (rank_t_num rank1) in let uu___10 = prob_to_string env (FStarC_TypeChecker_Common.TProb tp) in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: (rank=%s) Not a flex-rigid: %s" uu___9 uu___10 in failwith uu___8 | uu___7 -> let uu___8 = let uu___9 = - FStarC_Compiler_Util.string_of_int - (rank_t_num rank1) in + FStarC_Util.string_of_int (rank_t_num rank1) in let uu___10 = prob_to_string env (FStarC_TypeChecker_Common.TProb tp) in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible: (rank=%s) Not a rigid-flex: %s" uu___9 uu___10 in failwith uu___8))))) @@ -6737,7 +6675,7 @@ and (imitate_arrow : fun rel -> fun arrow -> let bs_lhs_args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | { FStarC_Syntax_Syntax.binder_bv = x; @@ -6755,8 +6693,8 @@ and (imitate_arrow : match uu___3 with | (k, uu___4) -> let uu___5 = - copy_uvar u_lhs - (FStarC_Compiler_List.op_At bs_lhs bs) k wl2 in + copy_uvar u_lhs (FStarC_List.op_At bs_lhs bs) k + wl2 in (match uu___5 with | (uu___6, u, wl3) -> let uu___7 = f u in (uu___7, wl3)) in @@ -6774,7 +6712,7 @@ and (imitate_arrow : FStarC_Syntax_Syntax.as_arg ct.FStarC_Syntax_Syntax.result_typ in uu___5 :: (ct.FStarC_Syntax_Syntax.effect_args) in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___5 -> fun uu___6 -> match (uu___5, uu___6) with @@ -6796,7 +6734,7 @@ and (imitate_arrow : (match uu___3 with | (out_args, wl2) -> let nodec flags = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___4 -> match uu___4 with | FStarC_Syntax_Syntax.DECREASES uu___5 @@ -6804,11 +6742,9 @@ and (imitate_arrow : | uu___5 -> true) flags in let ct' = let uu___4 = - let uu___5 = - FStarC_Compiler_List.hd out_args in + let uu___5 = FStarC_List.hd out_args in FStar_Pervasives_Native.fst uu___5 in - let uu___5 = - FStarC_Compiler_List.tl out_args in + let uu___5 = FStarC_List.tl out_args in let uu___6 = nodec ct.FStarC_Syntax_Syntax.flags in { @@ -6843,10 +6779,14 @@ and (imitate_arrow : let sol = let uu___5 = let uu___6 = + let uu___7 = + let uu___8 = + FStarC_Syntax_Util.residual_tot + t_res_lhs in + FStar_Pervasives_Native.Some + uu___8 in FStarC_Syntax_Util.abs bs_lhs lhs' - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot - t_res_lhs)) in + uu___7 in (u_lhs, uu___6) in TERM uu___5 in let uu___5 = @@ -6872,8 +6812,7 @@ and (imitate_arrow : let uu___6 = FStarC_Syntax_Util.type_u () in FStar_Pervasives_Native.fst uu___6 in copy_uvar u_lhs - (FStarC_Compiler_List.op_At bs_lhs bs) - uu___5 wl1 in + (FStarC_List.op_At bs_lhs bs) uu___5 wl1 in (match uu___4 with | (_ctx_u_x, u_x, wl2) -> let y = @@ -6891,10 +6830,9 @@ and (imitate_arrow : FStarC_Syntax_Util.arg_of_non_null_binder b in [uu___7] in - FStarC_Compiler_List.op_At bs_terms - uu___6 in - aux (FStarC_Compiler_List.op_At bs [b]) - uu___5 formals2 wl2) in + FStarC_List.op_At bs_terms uu___6 in + aux (FStarC_List.op_At bs [b]) uu___5 + formals2 wl2) in let uu___4 = occurs_check u_lhs arrow in (match uu___4 with | (uu___5, occurs_ok, msg) -> @@ -6903,8 +6841,7 @@ and (imitate_arrow : let uu___6 = mklstr (fun uu___7 -> - let uu___8 = - FStarC_Compiler_Option.get msg in + let uu___8 = FStarC_Option.get msg in Prims.strcat "occurs-check failed: " uu___8) in giveup_or_defer orig wl @@ -6927,7 +6864,7 @@ and (solve_binders : fun orig -> fun wl -> fun rhs -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = @@ -6938,14 +6875,19 @@ and (solve_binders : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) bs2 in - FStarC_Compiler_Util.print3 "solve_binders\n\t%s\n%s\n\t%s\n" - uu___2 (rel_to_string (p_rel orig)) uu___3 + FStarC_Util.print3 "solve_binders\n\t%s\n%s\n\t%s\n" uu___2 + (rel_to_string (p_rel orig)) uu___3 else ()); (let eq_bqual a1 a2 = match (a1, a2) with | (FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Implicit b1), FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Implicit b2)) -> true + | (FStar_Pervasives_Native.Some + (FStarC_Syntax_Syntax.Equality), + FStar_Pervasives_Native.None) -> true + | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some + (FStarC_Syntax_Syntax.Equality)) -> true | uu___1 -> FStarC_Syntax_Util.eq_bqual a1 a2 in let compat_positivity_qualifiers p1 p2 = match p_rel orig with @@ -6962,13 +6904,12 @@ and (solve_binders : let uu___1 = rhs wl1 scope subst in (match uu___1 with | (rhs_prob, wl2) -> - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___3 = FStarC_Effect.op_Bang dbg_Rel in if uu___3 then let uu___4 = prob_to_string (p_env wl2 rhs_prob) rhs_prob in - FStarC_Compiler_Util.print1 "rhs_prob = %s\n" - uu___4 + FStarC_Util.print1 "rhs_prob = %s\n" uu___4 else ()); (let formula = p_guard rhs_prob in ((FStar_Pervasives.Inl ([rhs_prob], formula)), wl2)))) @@ -7032,7 +6973,7 @@ and (solve_binders : :: uu___4 in let uu___4 = aux wl2 - (FStarC_Compiler_List.op_At scope + (FStarC_List.op_At scope [{ FStarC_Syntax_Syntax.binder_bv = hd12; @@ -7069,8 +7010,7 @@ and (solve_binders : FStarC_Syntax_Util.mk_conj (p_guard prob) uu___5 in ((let uu___6 = - FStarC_Compiler_Effect.op_Bang - dbg_Rel in + FStarC_Effect.op_Bang dbg_Rel in if uu___6 then let uu___7 = @@ -7081,7 +7021,7 @@ and (solve_binders : FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv hd12 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Formula is %s\n\thd1=%s\n" uu___7 uu___8 else ()); @@ -7114,7 +7054,7 @@ and (try_solve_without_smt_or_else : wl_deferred = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = (wl.wl_deferred_to_tac); ctr = (wl.ctr); defer_ok = NoDefer; @@ -7124,7 +7064,7 @@ and (try_solve_without_smt_or_else : wl_implicits = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = (wl.repr_subcomp_allowed); typeclass_variables = (wl.typeclass_variables) } in @@ -7137,7 +7077,7 @@ and (try_solve_without_smt_or_else : extend_wl wl (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))) + (Obj.magic (FStarC_CList.listlike_clist ())))) defer_to_tac imps in solve wl1)) | Failed (p, s) -> @@ -7157,7 +7097,7 @@ and (try_solve_then_or_else : wl_deferred = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = (wl.wl_deferred_to_tac); ctr = (wl.ctr); defer_ok = NoDefer; @@ -7167,7 +7107,7 @@ and (try_solve_then_or_else : wl_implicits = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = (wl.repr_subcomp_allowed); typeclass_variables = (wl.typeclass_variables) } in @@ -7180,8 +7120,7 @@ and (try_solve_then_or_else : extend_wl wl (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ())))) + (Obj.magic (FStarC_CList.listlike_clist ())))) defer_to_tac imps in then_solve wl1)) | Failed (p, s) -> @@ -7202,7 +7141,7 @@ and (try_solve_probs_without_smt : wl_deferred = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = (wl.wl_deferred_to_tac); ctr = (wl.ctr); defer_ok = NoDefer; @@ -7212,7 +7151,7 @@ and (try_solve_probs_without_smt : wl_implicits = (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))); + (Obj.magic (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = (wl.repr_subcomp_allowed); typeclass_variables = (wl.typeclass_variables) } in @@ -7223,7 +7162,7 @@ and (try_solve_probs_without_smt : extend_wl wl (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))) + (Obj.magic (FStarC_CList.listlike_clist ())))) defer_to_tac imps in FStar_Pervasives.Inl wl1 | Failed (uu___2, ls) -> FStar_Pervasives.Inr ls) @@ -7240,13 +7179,12 @@ and (solve_t_flex_rigid_eq : fun wl -> fun lhs -> fun rhs -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term rhs in - FStarC_Compiler_Util.print1 "solve_t_flex_rigid_eq rhs=%s\n" - uu___2 + FStarC_Util.print1 "solve_t_flex_rigid_eq rhs=%s\n" uu___2 else ()); (let uu___1 = should_defer_flex_to_user_tac wl lhs in if uu___1 @@ -7266,13 +7204,12 @@ and (solve_t_flex_rigid_eq : (FStar_Pervasives_Native.fst arg) in FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) x (Obj.magic uu___7) in Prims.op_Negation uu___6 in let bv_not_free_in_args x args1 = - FStarC_Compiler_Util.for_all (bv_not_free_in_arg x) - args1 in + FStarC_Util.for_all (bv_not_free_in_arg x) args1 in let binder_matches_aqual b aq = match ((b.FStarC_Syntax_Syntax.binder_qual), aq) with | (FStar_Pervasives_Native.None, @@ -7316,12 +7253,12 @@ and (solve_t_flex_rigid_eq : let uu___7 = let uu___8 = remove_matching_prefix - (FStarC_Compiler_List.rev bs_orig) - (FStarC_Compiler_List.rev rhs_args) in + (FStarC_List.rev bs_orig) + (FStarC_List.rev rhs_args) in match uu___8 with | (bs_rev, args_rev) -> - ((FStarC_Compiler_List.rev bs_rev), - (FStarC_Compiler_List.rev args_rev)) in + ((FStarC_List.rev bs_rev), + (FStarC_List.rev args_rev)) in (match uu___7 with | (bs1, rhs_args1) -> let uu___8 = @@ -7340,9 +7277,9 @@ and (solve_t_flex_rigid_eq : u_abs uu___7 uu___8 rhs2 in [TERM (ctx_u, sol)]) in let try_quasi_pattern orig1 env wl1 lhs1 rhs1 = - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___4 = FStarC_Effect.op_Bang dbg_Rel in if uu___4 - then FStarC_Compiler_Util.print_string "try_quasi_pattern\n" + then FStarC_Util.print_string "try_quasi_pattern\n" else ()); (let uu___4 = quasi_pattern env lhs1 in match uu___4 with @@ -7359,8 +7296,7 @@ and (solve_t_flex_rigid_eq : then let uu___8 = let uu___9 = - let uu___10 = - FStarC_Compiler_Option.get msg in + let uu___10 = FStarC_Option.get msg in Prims.strcat "quasi-pattern, occurs-check failed: " uu___10 in @@ -7369,7 +7305,7 @@ and (solve_t_flex_rigid_eq : else (let fvs_lhs = binders_as_bv_set - (FStarC_Compiler_List.op_At + (FStarC_List.op_At ctx_u.FStarC_Syntax_Syntax.ctx_uvar_binders bs) in let fvs_rhs = FStarC_Syntax_Free.names rhs1 in @@ -7377,7 +7313,7 @@ and (solve_t_flex_rigid_eq : let uu___10 = FStarC_Class_Setlike.subset () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic fvs_rhs) (Obj.magic fvs_lhs) in @@ -7400,7 +7336,7 @@ and (solve_t_flex_rigid_eq : let uu___3 = FStarC_Syntax_Util.head_and_args rhs1 in match uu___3 with | (rhs_hd, args) -> - let uu___4 = FStarC_Compiler_Util.prefix args in + let uu___4 = FStarC_Util.prefix args in (match uu___4 with | (args_rhs, last_arg_rhs) -> let rhs' = @@ -7547,8 +7483,8 @@ and (solve_t_flex_rigid_eq : t_res_lhs in FStarC_Syntax_Util.arrow [b] uu___11 in copy_uvar u_lhs - (FStarC_Compiler_List.op_At bs_lhs - [b]) uu___10 wl1 in + (FStarC_List.op_At bs_lhs [b]) + uu___10 wl1 in (match uu___9 with | (uu___10, lhs', wl2) -> let uu___11 = @@ -7570,11 +7506,14 @@ and (solve_t_flex_rigid_eq : (FStar_Pervasives_Native.snd last_arg_rhs))] t_lhs.FStarC_Syntax_Syntax.pos in + let uu___11 = + let uu___12 = + FStarC_Syntax_Util.residual_tot + t_res_lhs in + FStar_Pervasives_Native.Some + uu___12 in FStarC_Syntax_Util.abs bs_lhs - uu___10 - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.residual_tot - t_res_lhs)) in + uu___10 uu___11 in (u_lhs, uu___9) in TERM uu___8 in [uu___7] in @@ -7606,10 +7545,8 @@ and (solve_t_flex_rigid_eq : attempt sub_probs uu___9 in solve uu___8)))) in let imitate orig1 env wl1 lhs1 rhs1 = - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Rel in - if uu___4 - then FStarC_Compiler_Util.print_string "imitate\n" - else ()); + (let uu___4 = FStarC_Effect.op_Bang dbg_Rel in + if uu___4 then FStarC_Util.print_string "imitate\n" else ()); (let is_app rhs2 = let uu___4 = FStarC_Syntax_Util.head_and_args rhs2 in match uu___4 with @@ -7629,7 +7566,7 @@ and (solve_t_flex_rigid_eq : mklstr (fun uu___5 -> let uu___6 = prob_to_string env orig1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "imitate heuristic cannot solve %s; lhs not a quasi-pattern" uu___6) in giveup_or_defer orig1 wl1 @@ -7651,7 +7588,7 @@ and (solve_t_flex_rigid_eq : mklstr (fun uu___9 -> let uu___10 = prob_to_string env orig1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "imitate heuristic cannot solve %s; rhs not an app or arrow" uu___10) in giveup_or_defer orig1 wl1 @@ -7659,7 +7596,7 @@ and (solve_t_flex_rigid_eq : msg))) in let try_first_order orig1 env wl1 lhs1 rhs1 = let inapplicable msg lstring_opt = - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___4 = FStarC_Effect.op_Bang dbg_Rel in if uu___4 then let extra_msg = @@ -7667,38 +7604,36 @@ and (solve_t_flex_rigid_eq : | FStar_Pervasives_Native.None -> "" | FStar_Pervasives_Native.Some l -> FStarC_Thunk.force l in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "try_first_order failed because: %s\n%s\n" msg extra_msg else ()); FStar_Pervasives.Inl "first_order doesn't apply" in - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___4 = FStarC_Effect.op_Bang dbg_Rel in if uu___4 then let uu___5 = flex_t_to_string lhs1 in let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term rhs1 in - FStarC_Compiler_Util.print2 - "try_first_order\n\tlhs=%s\n\trhs=%s\n" uu___5 uu___6 + FStarC_Util.print2 "try_first_order\n\tlhs=%s\n\trhs=%s\n" + uu___5 uu___6 else ()); (let uu___4 = lhs1 in match uu___4 with | Flex (_t1, ctx_uv, args_lhs) -> - let n_args_lhs = FStarC_Compiler_List.length args_lhs in + let n_args_lhs = FStarC_List.length args_lhs in let uu___5 = FStarC_Syntax_Util.head_and_args rhs1 in (match uu___5 with | (head, args_rhs) -> - let n_args_rhs = - FStarC_Compiler_List.length args_rhs in + let n_args_rhs = FStarC_List.length args_rhs in if n_args_lhs > n_args_rhs then inapplicable "not enough args" FStar_Pervasives_Native.None else (let i = n_args_rhs - n_args_lhs in - let uu___7 = - FStarC_Compiler_List.splitAt i args_rhs in + let uu___7 = FStarC_List.splitAt i args_rhs in match uu___7 with | (prefix, args_rhs1) -> let head1 = @@ -7721,7 +7656,7 @@ and (solve_t_flex_rigid_eq : ctx_uv.FStarC_Syntax_Syntax.ctx_uvar_binders in FStarC_Class_Setlike.subset () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___13) (Obj.magic uu___14) in @@ -7911,7 +7846,7 @@ and (solve_t_flex_rigid_eq : FStar_Pervasives_Native.None sol wl3 in let uu___15 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___16 -> fun uu___17 -> fun uu___18 -> @@ -7954,7 +7889,7 @@ and (solve_t_flex_rigid_eq : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = @@ -7970,7 +7905,7 @@ and (solve_t_flex_rigid_eq : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = @@ -7992,7 +7927,7 @@ and (solve_t_flex_rigid_eq : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))) defer_to_tac imps in @@ -8025,7 +7960,7 @@ and (solve_t_flex_rigid_eq : uvars_head wl1 else ((let uu___18 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___18 then @@ -8040,7 +7975,7 @@ and (solve_t_flex_rigid_eq : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t_head in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "first-order: head type mismatch:\n\tlhs=%s\n\trhs=%s\n" uu___19 uu___20 else ()); @@ -8072,7 +8007,7 @@ and (solve_t_flex_rigid_eq : FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___20) in @@ -8112,17 +8047,15 @@ and (solve_t_flex_rigid_eq : args_lhs in (match uu___4 with | FStar_Pervasives_Native.Some lhs_binders -> - ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Rel in if uu___6 then - FStarC_Compiler_Util.print_string - "it's a pattern\n" + FStarC_Util.print_string "it's a pattern\n" else ()); (let rhs1 = sn env rhs in let fvs1 = binders_as_bv_set - (FStarC_Compiler_List.op_At + (FStarC_List.op_At ctx_uv.FStarC_Syntax_Syntax.ctx_uvar_binders lhs_binders) in let fvs2 = FStarC_Syntax_Free.names rhs1 in @@ -8162,8 +8095,7 @@ and (solve_t_flex_rigid_eq : (let uu___10 = let uu___11 = let uu___12 = - FStarC_Compiler_Option.get - msg1 in + FStarC_Option.get msg1 in Prims.strcat "occurs-check failed: " uu___12 in @@ -8175,7 +8107,7 @@ and (solve_t_flex_rigid_eq : (let uu___11 = FStarC_Class_Setlike.subset () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic fvs2) (Obj.magic fvs1) in @@ -8200,13 +8132,13 @@ and (solve_t_flex_rigid_eq : (fun uu___13 -> let uu___14 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set + (FStarC_FlatSet.showable_set FStarC_Syntax_Syntax.ord_bv FStarC_Syntax_Print.showable_bv) fvs2 in let uu___15 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set + (FStarC_FlatSet.showable_set FStarC_Syntax_Syntax.ord_bv FStarC_Syntax_Print.showable_bv) fvs1 in @@ -8214,10 +8146,10 @@ and (solve_t_flex_rigid_eq : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At ctx_uv.FStarC_Syntax_Syntax.ctx_uvar_binders lhs_binders) in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "free names in the RHS {%s} are out of scope for the LHS: {%s}, {%s}" uu___14 uu___15 uu___16) in @@ -8275,7 +8207,7 @@ and (solve_t_flex_flex : let run_meta_arg_tac_and_try_again flex = let uv = flex_uvar flex in let t = run_meta_arg_tac env uv in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___1 = FStarC_Effect.op_Bang dbg_Rel in if uu___1 then let uu___2 = @@ -8283,7 +8215,7 @@ and (solve_t_flex_flex : uv in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "solve_t_flex_flex: solving meta arg uvar %s with %s\n" uu___2 uu___3 else ()); @@ -8402,9 +8334,9 @@ and (solve_t_flex_flex : ctx_w in let zs = intersect_binders gamma_w - (FStarC_Compiler_List.op_At + (FStarC_List.op_At ctx_l binders_lhs) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At ctx_r binders_rhs) in let new_uvar_typ = let uu___21 = @@ -8439,7 +8371,7 @@ and (solve_t_flex_flex : FStarC_Class_Show.show uu___0 wl.defer_ok in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "flex-flex: occurs\n defer_ok=%s\n" uu___24 in FStarC_Thunk.mkv @@ -8507,7 +8439,7 @@ and (solve_t_flex_flex : -> let w_app = let uu___26 = - FStarC_Compiler_List.map + FStarC_List.map ( fun uu___27 @@ -8536,7 +8468,7 @@ and (solve_t_flex_flex : w uu___26 w.FStarC_Syntax_Syntax.pos in ((let uu___27 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___27 then @@ -8565,7 +8497,7 @@ and (solve_t_flex_flex : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At ctx_l binders_lhs) in let uu___36 @@ -8575,7 +8507,7 @@ and (solve_t_flex_flex : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At ctx_r binders_rhs) in let uu___38 @@ -8602,7 +8534,7 @@ and (solve_t_flex_flex : uu___29 :: uu___30 in - FStarC_Compiler_Util.print + FStarC_Util.print "flex-flex quasi:\n\tlhs=%s\n\trhs=%s\n\tsol=%s\n\tctx_l@binders_lhs=%s\n\tctx_r@binders_rhs=%s\n\tzs=%s\n" uu___28 else ()); @@ -8674,7 +8606,7 @@ and (solve_t' : tprob -> worklist -> solution) = let rigid_heads_match need_unif torig wl1 t1 t2 = let orig = FStarC_TypeChecker_Common.TProb torig in let env = p_env wl1 orig in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___2 = FStarC_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -8685,7 +8617,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in let uu___6 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t2 in - FStarC_Compiler_Util.print5 "Heads %s: %s (%s) and %s (%s)\n" + FStarC_Util.print5 "Heads %s: %s (%s) and %s (%s)\n" (if need_unif then "need unification" else "match") uu___3 uu___4 uu___5 uu___6 else ()); @@ -8704,12 +8636,12 @@ and (solve_t' : tprob -> worklist -> solution) = (FStarC_Syntax_Syntax.Tm_uinst (uu___7, us2), uu___8::uu___9)) -> let uu___10 = - (FStarC_Compiler_List.for_all + (FStarC_List.for_all (fun u -> let uu___11 = universe_has_max env u in Prims.op_Negation uu___11) us1) && - (FStarC_Compiler_List.for_all + (FStarC_List.for_all (fun u -> let uu___11 = universe_has_max env u in Prims.op_Negation uu___11) us2) in @@ -8729,8 +8661,8 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_TypeChecker_Common.Deferred_univ_constraint "universe constraints" orig wl3 in k false uu___6) in - let nargs = FStarC_Compiler_List.length args1 in - if nargs <> (FStarC_Compiler_List.length args2) + let nargs = FStarC_List.length args1 in + if nargs <> (FStarC_List.length args2) then let uu___4 = mklstr @@ -8755,7 +8687,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) args2 in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "unequal number of arguments: %s[%s] and %s[%s]" uu___6 uu___7 uu___8 uu___9) in giveup wl1 uu___4 orig @@ -8819,18 +8751,16 @@ and (solve_t' : tprob -> worklist -> solution) = let argp = if need_unif1 then - FStarC_Compiler_List.zip + FStarC_List.zip ((head1, FStar_Pervasives_Native.None) :: args1) ((head2, FStar_Pervasives_Native.None) :: args2) - else - FStarC_Compiler_List.zip args1 - args2 in + else FStarC_List.zip args1 args2 in let uu___9 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___10 -> fun uu___11 -> match (uu___10, uu___11) @@ -8854,18 +8784,18 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___9 with | (subprobs, wl3) -> ((let uu___11 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___11 then let uu___12 = - FStarC_Compiler_Util.string_of_bool + FStarC_Util.string_of_bool wl3.smt_ok in let uu___13 = FStarC_Common.string_of_list (prob_to_string env) subprobs in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Adding subproblems for arguments (smtok=%s): %s" uu___12 uu___13 else ()); @@ -8873,7 +8803,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Options.defensive () in if uu___12 then - FStarC_Compiler_List.iter + FStarC_List.iter (def_check_prob "solve_t' subprobs") subprobs @@ -8892,7 +8822,7 @@ and (solve_t' : tprob -> worklist -> solution) = | (subprobs, wl4) -> let formula = let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun p -> p_guard p) subprobs in @@ -8914,7 +8844,7 @@ and (solve_t' : tprob -> worklist -> solution) = | (subprobs, wl4) -> let formula = let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map (fun p -> p_guard p) subprobs in FStarC_Syntax_Util.mk_conj_l @@ -8930,7 +8860,7 @@ and (solve_t' : tprob -> worklist -> solution) = match uu___9 with | (prob, reason) -> ((let uu___11 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___11 then @@ -8938,7 +8868,7 @@ and (solve_t' : tprob -> worklist -> solution) = prob_to_string env orig in let uu___13 = FStarC_Thunk.force reason in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Failed to solve %s because a sub-problem is not solvable without SMT because %s" uu___12 uu___13 else ()); @@ -8987,7 +8917,7 @@ and (solve_t' : tprob -> worklist -> solution) = -> ((let uu___18 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___18 @@ -9012,7 +8942,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2' in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Unfolding didn't make progress ... got %s ~> %s;\nand %s ~> %s\n" uu___19 uu___20 @@ -9059,7 +8989,7 @@ and (solve_t' : tprob -> worklist -> solution) = } in ((let uu___19 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___19 @@ -9070,7 +9000,7 @@ and (solve_t' : tprob -> worklist -> solution) = env1 (FStarC_TypeChecker_Common.TProb torig') in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Unfolded and now trying %s\n" uu___20 else ()); @@ -9156,7 +9086,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___2 with | (xs, pat_term, g_pat_as_exp, uu___3) -> let uu___4 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___5 -> fun x -> match uu___5 with @@ -9188,14 +9118,13 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_TypeChecker_Normalize.whnf_steps env uu___7 in FStarC_Syntax_Util.unrefine uu___6 in - (let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___7 = FStarC_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term pat_term1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Match heuristic, typechecking the pattern term: %s {\n\n" uu___8 else ()); @@ -9207,8 +9136,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___8 pat_term1 must_tot in match uu___7 with | (pat_term2, pat_term_t, g_pat_term) -> - ((let uu___9 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___9 = FStarC_Effect.op_Bang dbg_Rel in if uu___9 then let uu___10 = @@ -9219,7 +9147,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term pat_term_t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "} Match heuristic, typechecked pattern term to %s and type %s\n" uu___10 uu___11 else ()); @@ -9251,7 +9179,7 @@ and (solve_t' : tprob -> worklist -> solution) = (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = (wl4.wl_deferred_to_tac); @@ -9266,7 +9194,7 @@ and (solve_t' : tprob -> worklist -> solution) = (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = (wl4.repr_subcomp_allowed); @@ -9278,7 +9206,7 @@ and (solve_t' : tprob -> worklist -> solution) = (Obj.magic (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))) in let tx = FStarC_Syntax_Unionfind.new_transaction @@ -9317,21 +9245,21 @@ and (solve_t' : tprob -> worklist -> solution) = (let uu___13 = let uu___14 = FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist + (FStarC_CList.monoid_clist ()) defer_to_tac defer_to_tac' in let uu___15 = let uu___16 = let uu___17 = FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist + (FStarC_CList.monoid_clist ()) imps imps' in FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist + (FStarC_CList.monoid_clist ()) uu___17 g_pat_as_exp.FStarC_TypeChecker_Common.implicits in FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist + (FStarC_CList.monoid_clist ()) uu___16 g_pat_term.FStarC_TypeChecker_Common.implicits in extend_wl wl4 @@ -9339,7 +9267,7 @@ and (solve_t' : tprob -> worklist -> solution) = (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))) uu___14 uu___15 in FStar_Pervasives_Native.Some @@ -9357,7 +9285,7 @@ and (solve_t' : tprob -> worklist -> solution) = | FStar_Pervasives_Native.None -> FStar_Pervasives.Inr FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some (t1, t2) -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___2 = FStarC_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -9366,8 +9294,8 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 - "Trying match heuristic for %s vs. %s\n" uu___3 uu___4 + FStarC_Util.print2 "Trying match heuristic for %s vs. %s\n" + uu___3 uu___4 else ()); (let uu___2 = let uu___3 = @@ -9392,28 +9320,26 @@ and (solve_t' : tprob -> worklist -> solution) = Prims.op_Negation uu___10 in if uu___9 then - ((let uu___11 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___11 = FStarC_Effect.op_Bang dbg_Rel in if uu___11 then let uu___12 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term scrutinee in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "match head %s is not a flex term\n" uu___12 else ()); FStar_Pervasives.Inr FStar_Pervasives_Native.None) else if wl1.defer_ok = DeferAny then - ((let uu___12 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___12 = FStarC_Effect.op_Bang dbg_Rel in if uu___12 - then - FStarC_Compiler_Util.print_string - "Deferring ... \n" + then FStarC_Util.print_string "Deferring ... \n" else ()); FStar_Pervasives.Inl "defer") else - ((let uu___13 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___13 = FStarC_Effect.op_Bang dbg_Rel in if uu___13 then let uu___14 = @@ -9422,7 +9348,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___15 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Heuristic applicable with scrutinee %s and other side = %s\n" uu___14 uu___15 else ()); @@ -9440,7 +9366,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Pervasives_Native.None, uu___16) -> true | uu___14 -> false in let head_matching_branch = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun b -> if pat_discriminates b then @@ -9458,16 +9384,15 @@ and (solve_t' : tprob -> worklist -> solution) = else false) branches in match head_matching_branch with | FStar_Pervasives_Native.None -> - ((let uu___14 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___14 = FStarC_Effect.op_Bang dbg_Rel in if uu___14 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "No head_matching branch\n" else ()); (let try_branches = let uu___14 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun b -> Prims.op_Negation (pat_discriminates b)) branches in @@ -9477,7 +9402,7 @@ and (solve_t' : tprob -> worklist -> solution) = branches1 | uu___15 -> branches in let uu___14 = - FStarC_Compiler_Util.find_map try_branches + FStarC_Util.find_map try_branches (fun b -> let uu___15 = FStarC_Syntax_Subst.open_branch b in @@ -9490,7 +9415,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___13 with | (p, uu___14, e) -> ((let uu___16 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + FStarC_Effect.op_Bang dbg_Rel in if uu___16 then let uu___17 = @@ -9499,7 +9424,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___18 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Found head matching branch %s -> %s\n" uu___17 uu___18 else ()); @@ -9523,28 +9448,26 @@ and (solve_t' : tprob -> worklist -> solution) = Prims.op_Negation uu___10 in if uu___9 then - ((let uu___11 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___11 = FStarC_Effect.op_Bang dbg_Rel in if uu___11 then let uu___12 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term scrutinee in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "match head %s is not a flex term\n" uu___12 else ()); FStar_Pervasives.Inr FStar_Pervasives_Native.None) else if wl1.defer_ok = DeferAny then - ((let uu___12 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___12 = FStarC_Effect.op_Bang dbg_Rel in if uu___12 - then - FStarC_Compiler_Util.print_string - "Deferring ... \n" + then FStarC_Util.print_string "Deferring ... \n" else ()); FStar_Pervasives.Inl "defer") else - ((let uu___13 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___13 = FStarC_Effect.op_Bang dbg_Rel in if uu___13 then let uu___14 = @@ -9553,7 +9476,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___15 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Heuristic applicable with scrutinee %s and other side = %s\n" uu___14 uu___15 else ()); @@ -9571,7 +9494,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Pervasives_Native.None, uu___16) -> true | uu___14 -> false in let head_matching_branch = - FStarC_Compiler_Util.try_find + FStarC_Util.try_find (fun b -> if pat_discriminates b then @@ -9589,16 +9512,15 @@ and (solve_t' : tprob -> worklist -> solution) = else false) branches in match head_matching_branch with | FStar_Pervasives_Native.None -> - ((let uu___14 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___14 = FStarC_Effect.op_Bang dbg_Rel in if uu___14 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "No head_matching branch\n" else ()); (let try_branches = let uu___14 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun b -> Prims.op_Negation (pat_discriminates b)) branches in @@ -9608,7 +9530,7 @@ and (solve_t' : tprob -> worklist -> solution) = branches1 | uu___15 -> branches in let uu___14 = - FStarC_Compiler_Util.find_map try_branches + FStarC_Util.find_map try_branches (fun b -> let uu___15 = FStarC_Syntax_Subst.open_branch b in @@ -9621,7 +9543,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___13 with | (p, uu___14, e) -> ((let uu___16 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + FStarC_Effect.op_Bang dbg_Rel in if uu___16 then let uu___17 = @@ -9630,7 +9552,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___18 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Found head matching branch %s -> %s\n" uu___17 uu___18 else ()); @@ -9638,7 +9560,7 @@ and (solve_t' : tprob -> worklist -> solution) = try_solve_branch scrutinee p in FStar_Pervasives.Inr uu___16))))) | uu___3 -> - ((let uu___5 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___5 = FStarC_Effect.op_Bang dbg_Rel in if uu___5 then let uu___6 = @@ -9647,14 +9569,14 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___7 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Heuristic not applicable: tag lhs=%s, rhs=%s\n" uu___6 uu___7 else ()); FStar_Pervasives.Inr FStar_Pervasives_Native.None))) in let rigid_rigid_delta torig wl1 head1 head2 t1 t2 = let orig = FStarC_TypeChecker_Common.TProb torig in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_RelDelta in + (let uu___2 = FStarC_Effect.op_Bang dbg_RelDelta in if uu___2 then let uu___3 = @@ -9665,9 +9587,8 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print4 - "rigid_rigid_delta of %s-%s (%s, %s)\n" uu___3 uu___4 uu___5 - uu___6 + FStarC_Util.print4 "rigid_rigid_delta of %s-%s (%s, %s)\n" uu___3 + uu___4 uu___5 uu___6 else ()); (let uu___2 = head_matches_delta (p_env wl1 orig) (p_logical orig) wl1.smt_ok @@ -9858,7 +9779,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_delta_depth uu___15 in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "head mismatch (%s (%s) vs %s (%s))" uu___11 uu___12 uu___13 uu___14) in giveup wl1 uu___9 orig))) @@ -9885,7 +9806,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "head mismatch for subtyping (%s vs %s)" uu___7 uu___8) in giveup wl1 uu___5 orig) @@ -9920,8 +9841,7 @@ and (solve_t' : tprob -> worklist -> solution) = let orig = FStarC_TypeChecker_Common.TProb problem in def_check_prob "solve_t'.2" orig; (let uu___2 = - FStarC_Compiler_Util.physical_equality - problem.FStarC_TypeChecker_Common.lhs + FStarC_Util.physical_equality problem.FStarC_TypeChecker_Common.lhs problem.FStarC_TypeChecker_Common.rhs in if uu___2 then @@ -9932,25 +9852,25 @@ and (solve_t' : tprob -> worklist -> solution) = let t2 = problem.FStarC_TypeChecker_Common.rhs in (let uu___5 = let uu___6 = p_scope orig in - FStarC_Compiler_List.map - (fun b -> b.FStarC_Syntax_Syntax.binder_bv) uu___6 in + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) + uu___6 in FStarC_Defensive.def_check_scoped FStarC_Class_Binders.hasBinders_list_bv FStarC_Class_Binders.hasNames_term FStarC_Syntax_Print.pretty_term (p_loc orig) "ref.t1" uu___5 t1); (let uu___6 = let uu___7 = p_scope orig in - FStarC_Compiler_List.map - (fun b -> b.FStarC_Syntax_Syntax.binder_bv) uu___7 in + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) + uu___7 in FStarC_Defensive.def_check_scoped FStarC_Class_Binders.hasBinders_list_bv FStarC_Class_Binders.hasNames_term FStarC_Syntax_Print.pretty_term (p_loc orig) "ref.t2" uu___6 t2); - (let uu___7 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___7 = FStarC_Effect.op_Bang dbg_Rel in if uu___7 then let uu___8 = - FStarC_Compiler_Util.string_of_int + FStarC_Util.string_of_int problem.FStarC_TypeChecker_Common.pid in let uu___9 = let uu___10 = @@ -9974,8 +9894,8 @@ and (solve_t' : tprob -> worklist -> solution) = Prims.strcat uu___11 uu___12 in let uu___11 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length wl.attempting) in - FStarC_Compiler_Util.print5 + (FStarC_List.length wl.attempting) in + FStarC_Util.print5 "Attempting %s (%s vs %s); rel = (%s); number of problems in wl = %s\n" uu___8 uu___9 uu___10 (rel_to_string problem.FStarC_TypeChecker_Common.relation) @@ -10254,8 +10174,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___9 = as_refinement false env t21 in (match uu___9 with | (x22, phi21) -> - ((let uu___11 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___11 = FStarC_Effect.op_Bang dbg_Rel in if uu___11 then ((let uu___13 = @@ -10269,7 +10188,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term phi11 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "ref1 = (%s):(%s){%s}\n" uu___13 uu___14 uu___15); (let uu___13 = @@ -10283,7 +10202,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term phi21 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "ref2 = (%s):(%s){%s}\n" uu___13 uu___14 uu___15)) else ()); @@ -10325,7 +10244,7 @@ and (solve_t' : tprob -> worklist -> solution) = (p_guard base_prob) impl in (let uu___14 = let uu___15 = p_scope orig in - FStarC_Compiler_List.map + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) uu___15 in @@ -10337,7 +10256,7 @@ and (solve_t' : tprob -> worklist -> solution) = (p_guard base_prob)); (let uu___15 = let uu___16 = p_scope orig in - FStarC_Compiler_List.map + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) uu___16 in @@ -10358,7 +10277,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Syntax_Free.uvars phi12 in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___13) in Prims.op_Negation uu___12) || @@ -10367,7 +10286,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStarC_Syntax_Free.uvars phi22 in FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uu___13) in Prims.op_Negation uu___12) in @@ -10405,7 +10324,7 @@ and (solve_t' : tprob -> worklist -> solution) = (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); wl_deferred_to_tac = (wl2.wl_deferred_to_tac); @@ -10420,7 +10339,7 @@ and (solve_t' : tprob -> worklist -> solution) = (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))); repr_subcomp_allowed = (wl2.repr_subcomp_allowed); @@ -10491,7 +10410,7 @@ and (solve_t' : tprob -> worklist -> solution) = (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))) defer_to_tac imps in let uu___16 = @@ -11110,8 +11029,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___18 with | (p21, w21, e2) -> let w22 = - FStarC_Compiler_Util.map_opt - w21 + FStarC_Util.map_opt w21 (FStarC_Syntax_Subst.subst s) in let e21 = FStarC_Syntax_Subst.subst s e2 in @@ -11119,7 +11037,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___19 = FStarC_Syntax_Syntax.pat_bvs p11 in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder uu___19 in let uu___19 = @@ -11153,8 +11071,7 @@ and (solve_t' : tprob -> worklist -> solution) = | (p, wl2) -> FStar_Pervasives_Native.Some ([(scope, p)], wl2)) in - FStarC_Compiler_Util.bind_opt - uu___19 + FStarC_Util.bind_opt uu___19 (fun uu___20 -> match uu___20 with | (wprobs, wl2) -> @@ -11168,7 +11085,7 @@ and (solve_t' : tprob -> worklist -> solution) = (match uu___21 with | (prob, wl3) -> ((let uu___23 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Rel in if uu___23 then @@ -11180,7 +11097,7 @@ and (solve_t' : tprob -> worklist -> solution) = (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) scope in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Created problem for branches %s with scope %s\n" uu___24 uu___25 @@ -11188,7 +11105,7 @@ and (solve_t' : tprob -> worklist -> solution) = (let uu___23 = solve_branches wl3 rs1 rs2 in - FStarC_Compiler_Util.bind_opt + FStarC_Util.bind_opt uu___23 (fun uu___24 -> match uu___24 @@ -11198,7 +11115,7 @@ and (solve_t' : tprob -> worklist -> solution) = FStar_Pervasives_Native.Some (((scope, prob) :: - (FStarC_Compiler_List.op_At + (FStarC_List.op_At wprobs r)), wl4)))))))))) | ([], []) -> FStar_Pervasives_Native.Some ([], wl1) @@ -11222,7 +11139,7 @@ and (solve_t' : tprob -> worklist -> solution) = let sub_probs1 = ([], sc_prob) :: sub_probs in let formula = let uu___13 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___14 -> match uu___14 with | (scope, p) -> @@ -11237,8 +11154,8 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___13 = let uu___14 = let uu___15 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.snd sub_probs1 in + FStarC_List.map FStar_Pervasives_Native.snd + sub_probs1 in attempt uu___15 { attempting = (wl3.attempting); @@ -11277,7 +11194,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11329,7 +11246,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -11421,7 +11338,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11473,7 +11390,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -11565,7 +11482,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11617,7 +11534,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -11709,7 +11626,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11761,7 +11678,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -11853,7 +11770,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -11905,7 +11822,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -11997,7 +11914,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12049,7 +11966,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -12141,7 +12058,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12193,7 +12110,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -12285,7 +12202,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12337,7 +12254,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -12429,7 +12346,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12481,7 +12398,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -12573,7 +12490,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12625,7 +12542,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -12717,7 +12634,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12769,7 +12686,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -12861,7 +12778,7 @@ and (solve_t' : tprob -> worklist -> solution) = let head2 = let uu___9 = FStarC_Syntax_Util.head_and_args t2 in FStar_Pervasives_Native.fst uu___9 in - ((let uu___10 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -12913,7 +12830,7 @@ and (solve_t' : tprob -> worklist -> solution) = uu___16 :: uu___17 in uu___14 :: uu___15 in uu___12 :: uu___13 in - FStarC_Compiler_Util.print + FStarC_Util.print ">> (%s) (smtok=%s)\n>>> head1 = %s [interpreted=%s; no_free_uvars=%s]\n>>> head2 = %s [interpreted=%s; no_free_uvars=%s]\n" uu___11 else ()); @@ -13023,7 +12940,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___13 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Internal error: unexpected flex-flex of %s and %s\n>>> (%s) -- (%s)" uu___10 uu___11 uu___12 uu___13 in FStarC_Errors.raise_error @@ -13045,7 +12962,7 @@ and (solve_t' : tprob -> worklist -> solution) = let uu___13 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Internal error: unexpected flex-flex of %s and %s\n>>> (%s) -- (%s)" uu___10 uu___11 uu___12 uu___13 in FStarC_Errors.raise_error @@ -13117,7 +13034,7 @@ and (solve_c : mk_t_problem wl1 [] orig t1 rel t2 FStar_Pervasives_Native.None reason in let solve_eq c1_comp c2_comp g_lift = - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_EQ in + (let uu___1 = FStarC_Effect.op_Bang dbg_EQ in if uu___1 then let uu___2 = @@ -13126,7 +13043,7 @@ and (solve_c : let uu___3 = let uu___4 = FStarC_Syntax_Syntax.mk_Comp c2_comp in FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp uu___4 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "solve_c is using an equality constraint (%s vs %s)\n" uu___2 uu___3 else ()); @@ -13146,16 +13063,13 @@ and (solve_c : let uu___5 = FStarC_Class_Show.show FStarC_Ident.showable_lident c2_comp.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 - "incompatible effects: %s <> %s" uu___4 uu___5) in + FStarC_Util.format2 "incompatible effects: %s <> %s" uu___4 + uu___5) in giveup wl uu___2 orig else if - (FStarC_Compiler_List.length - c1_comp.FStarC_Syntax_Syntax.effect_args) - <> - (FStarC_Compiler_List.length - c2_comp.FStarC_Syntax_Syntax.effect_args) + (FStarC_List.length c1_comp.FStarC_Syntax_Syntax.effect_args) <> + (FStarC_List.length c2_comp.FStarC_Syntax_Syntax.effect_args) then (let uu___3 = mklstr @@ -13174,13 +13088,13 @@ and (solve_c : FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) c2_comp.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "incompatible effect arguments: %s <> %s" uu___5 uu___6) in giveup wl uu___3 orig) else (let uu___4 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___5 -> fun u1 -> fun u2 -> @@ -13190,11 +13104,11 @@ and (solve_c : let uu___7 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u1) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___8 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u2) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in sub_prob wl1 uu___7 FStarC_TypeChecker_Common.EQ uu___8 "effect universes" in @@ -13205,20 +13119,20 @@ and (solve_c : Obj.magic (FStarC_Class_Listlike.cons () (Obj.magic - (FStarC_Compiler_CList.listlike_clist - ())) p + (FStarC_CList.listlike_clist ())) + p (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))) in FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) + (FStarC_CList.monoid_clist ()) univ_sub_probs uu___8 in (uu___7, wl2))) ((Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))), - wl) c1_comp.FStarC_Syntax_Syntax.comp_univs + (Obj.magic (FStarC_CList.listlike_clist ())))), wl) + c1_comp.FStarC_Syntax_Syntax.comp_univs c2_comp.FStarC_Syntax_Syntax.comp_univs in match uu___4 with | (univ_sub_probs, wl1) -> @@ -13230,7 +13144,7 @@ and (solve_c : (match uu___5 with | (ret_sub_prob, wl2) -> let uu___6 = - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun uu___7 -> fun uu___8 -> fun uu___9 -> @@ -13247,7 +13161,7 @@ and (solve_c : Obj.magic (FStarC_Class_Listlike.cons () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())) p (Obj.magic arg_sub_probs)) in (uu___13, wl4))) @@ -13255,8 +13169,7 @@ and (solve_c : c2_comp.FStarC_Syntax_Syntax.effect_args ((Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ())))), + (Obj.magic (FStarC_CList.listlike_clist ())))), wl2) in (match uu___6 with | (arg_sub_probs, wl3) -> @@ -13264,31 +13177,29 @@ and (solve_c : let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_CList.map + FStarC_CList.map (fun uu___10 -> match uu___10 with | (uu___11, uu___12, p) -> p) g_lift.FStarC_TypeChecker_Common.deferred in FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) + (FStarC_CList.monoid_clist ()) arg_sub_probs uu___9 in Obj.magic (FStarC_Class_Listlike.cons () (Obj.magic - (FStarC_Compiler_CList.listlike_clist - ())) ret_sub_prob - (Obj.magic uu___8)) in + (FStarC_CList.listlike_clist ())) + ret_sub_prob (Obj.magic uu___8)) in FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) - univ_sub_probs uu___7 in + (FStarC_CList.monoid_clist ()) univ_sub_probs + uu___7 in let sub_probs1 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) - sub_probs in + (FStarC_CList.listlike_clist ()) sub_probs in let guard = let guard1 = let uu___7 = - FStarC_Compiler_List.map p_guard sub_probs1 in + FStarC_List.map p_guard sub_probs1 in FStarC_Syntax_Util.mk_conj_l uu___7 in match g_lift.FStarC_TypeChecker_Common.guard_f with @@ -13298,7 +13209,7 @@ and (solve_c : let wl4 = let uu___7 = FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) + (FStarC_CList.monoid_clist ()) g_lift.FStarC_TypeChecker_Common.implicits wl3.wl_implicits in { @@ -13334,7 +13245,7 @@ and (solve_c : Prims.op_Negation uu___1)) && (FStarC_TypeChecker_Env.is_reifiable_effect wl.tcenv c22) in let solve_layered_sub c11 c21 = - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + (let uu___1 = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if uu___1 then let uu___2 = @@ -13343,8 +13254,8 @@ and (solve_c : let uu___3 = let uu___4 = FStarC_Syntax_Syntax.mk_Comp c21 in FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp uu___4 in - FStarC_Compiler_Util.print2 - "solve_layered_sub c1: %s and c2: %s {\n" uu___2 uu___3 + FStarC_Util.print2 "solve_layered_sub c1: %s and c2: %s {\n" + uu___2 uu___3 else ()); if problem.FStarC_TypeChecker_Common.relation = @@ -13367,7 +13278,7 @@ and (solve_c : let uu___6 = FStarC_Ident.string_of_lid c21.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Cannot lift from %s to %s, it needs a lift\n" uu___5 uu___6) in giveup wl uu___3 orig @@ -13383,7 +13294,7 @@ and (solve_c : FStarC_Ident.ident_of_lid c21.FStarC_Syntax_Syntax.effect_name in FStarC_Ident.string_of_id uu___6 in - FStarC_Compiler_Util.format2 "%s <: %s" uu___4 uu___5 in + FStarC_Util.format2 "%s <: %s" uu___4 uu___5 in let lift_c1 edge = let uu___4 = let uu___5 = FStarC_Syntax_Syntax.mk_Comp c11 in @@ -13432,8 +13343,7 @@ and (solve_c : c21.FStarC_Syntax_Syntax.comp_univs in FStar_Pervasives_Native.snd uu___12 in FStar_Pervasives_Native.Some uu___11 in - let uu___11 = - FStarC_Compiler_Util.must kopt in + let uu___11 = FStarC_Util.must kopt in (uu___10, uu___11) in (match uu___8 with | (tsopt, k) -> @@ -13460,7 +13370,7 @@ and (solve_c : match uu___4 with | (c12, g_lift, stronger_t_opt, kind, num_eff_params, is_polymonadic) -> - if FStarC_Compiler_Util.is_none stronger_t_opt + if FStarC_Util.is_none stronger_t_opt then let uu___5 = mklstr @@ -13473,13 +13383,12 @@ and (solve_c : FStarC_Class_Show.show FStarC_Ident.showable_lident c21.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "incompatible monad ordering: %s %s since its type %s is informative" uu___9 uu___10 uu___11 in FStarC_Errors.raise_error @@ -13542,7 +13451,7 @@ and (solve_c : FStarC_Syntax_Syntax.args = uu___10;_} -> is_uvar t1 | uu___10 -> false in - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun uu___9 -> fun uu___10 -> fun uu___11 -> @@ -13553,7 +13462,7 @@ and (solve_c : if uu___14 then ((let uu___16 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsEqns in if uu___16 then @@ -13565,7 +13474,7 @@ and (solve_c : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term a2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Layered Effects teq (rel c1 index uvar) %s = %s\n" uu___17 uu___18 else ()); @@ -13609,13 +13518,13 @@ and (solve_c : (match uu___10 with | (fml, sub_probs, wl4) -> let sub_probs1 = ret_sub_prob :: - (FStarC_Compiler_List.op_At - is_sub_probs sub_probs) in + (FStarC_List.op_At is_sub_probs + sub_probs) in let guard = let guard1 = let uu___11 = - FStarC_Compiler_List.map - p_guard sub_probs1 in + FStarC_List.map p_guard + sub_probs1 in FStarC_Syntax_Util.mk_conj_l uu___11 in let guard2 = @@ -13634,12 +13543,11 @@ and (solve_c : (FStar_Pervasives_Native.Some guard) [] wl4 in ((let uu___12 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if uu___12 then - FStarC_Compiler_Util.print_string - "}\n" + FStarC_Util.print_string "}\n" else ()); (let uu___12 = attempt sub_probs1 wl5 in @@ -13701,7 +13609,7 @@ and (solve_c : let uu___6 = FStarC_Class_Show.show FStarC_Ident.showable_lident c21.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Lift between wp-effects (%s~>%s) should not have returned a non-trivial guard" uu___5 uu___6 in FStarC_Errors.raise_error @@ -13725,13 +13633,13 @@ and (solve_c : let uu___5 = FStarC_Ident.string_of_lid c21.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Cannot lift from %s to %s, it needs a lift\n" uu___4 uu___5) in giveup wl uu___2 orig else (let is_null_wp_2 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.TOTAL -> true @@ -13751,7 +13659,7 @@ and (solve_c : let uu___7 = FStarC_Class_Show.show FStarC_Ident.showable_lident c21.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Got effects %s and %s, expected normalized effects" uu___6 uu___7 in FStarC_Errors.raise_error @@ -13761,7 +13669,7 @@ and (solve_c : (Obj.magic uu___5) in match uu___3 with | (wpc1, wpc2) -> - let uu___4 = FStarC_Compiler_Util.physical_equality wpc1 wpc2 in + let uu___4 = FStarC_Util.physical_equality wpc1 wpc2 in if uu___4 then let uu___5 = @@ -13776,12 +13684,12 @@ and (solve_c : let uu___7 = FStarC_TypeChecker_Env.effect_decl_opt env c21.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.must uu___7 in + FStarC_Util.must uu___7 in match uu___6 with | (c2_decl, qualifiers) -> if - FStarC_Compiler_List.contains - FStarC_Syntax_Syntax.Reifiable qualifiers + FStarC_List.contains FStarC_Syntax_Syntax.Reifiable + qualifiers then let c1_repr = let uu___7 = @@ -13821,8 +13729,8 @@ and (solve_c : let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term c2_repr in - FStarC_Compiler_Util.format2 - "sub effect repr: %s <: %s" uu___9 uu___10 in + FStarC_Util.format2 "sub effect repr: %s <: %s" + uu___9 uu___10 in sub_prob wl c1_repr problem.FStarC_TypeChecker_Common.relation c2_repr uu___8 in @@ -13841,15 +13749,15 @@ and (solve_c : else (let wpc1_2 = let uu___10 = lift_c1 () in - FStarC_Compiler_List.hd + FStarC_List.hd uu___10.FStarC_Syntax_Syntax.effect_args in if is_null_wp_2 then ((let uu___11 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + FStarC_Effect.op_Bang dbg_Rel in if uu___11 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "Using trivial wp ... \n" else ()); (let c1_univ = @@ -13910,8 +13818,7 @@ and (solve_c : } in FStarC_Syntax_Syntax.Tm_app uu___12 in FStarC_Syntax_Syntax.mk uu___11 r)) in - (let uu___9 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___9 = FStarC_Effect.op_Bang dbg_Rel in if uu___9 then let uu___10 = @@ -13923,7 +13830,7 @@ and (solve_c : FStarC_TypeChecker_Env.Simplify] env g in FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uu___11 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "WP guard (simplifed) is (%s)\n" uu___10 else ()); (let uu___9 = @@ -13942,31 +13849,31 @@ and (solve_c : solve_prob orig uu___10 [] wl1 in let uu___10 = attempt [base_prob] wl2 in solve uu___10))))) in - let uu___ = FStarC_Compiler_Util.physical_equality c1 c2 in + let uu___ = FStarC_Util.physical_equality c1 c2 in if uu___ then let uu___1 = solve_prob orig FStar_Pervasives_Native.None [] wl in solve uu___1 else - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___3 = FStarC_Effect.op_Bang dbg_Rel in if uu___3 then let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c1 in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c2 in - FStarC_Compiler_Util.print3 "solve_c %s %s %s\n" uu___4 + FStarC_Util.print3 "solve_c %s %s %s\n" uu___4 (rel_to_string problem.FStarC_TypeChecker_Common.relation) uu___5 else ()); (let uu___3 = let uu___4 = let uu___5 = - FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c1) in + let uu___6 = FStarC_Syntax_Util.comp_effect_name c1 in + FStarC_TypeChecker_Env.norm_eff_name env uu___6 in let uu___6 = - FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c2) in + let uu___7 = FStarC_Syntax_Util.comp_effect_name c2 in + FStarC_TypeChecker_Env.norm_eff_name env uu___7 in (uu___5, uu___6) in match uu___4 with | (eff1, eff2) -> @@ -14161,10 +14068,10 @@ and (solve_c : if uu___6 then let uu___7 = - problem_using_guard orig - (FStarC_Syntax_Util.comp_result c11) - problem.FStarC_TypeChecker_Common.relation - (FStarC_Syntax_Util.comp_result c21) + let uu___8 = FStarC_Syntax_Util.comp_result c11 in + let uu___9 = FStarC_Syntax_Util.comp_result c21 in + problem_using_guard orig uu___8 + problem.FStarC_TypeChecker_Common.relation uu___9 FStar_Pervasives_Native.None "result type" in solve_t uu___7 wl else @@ -14202,8 +14109,7 @@ and (solve_c : let c22 = FStarC_TypeChecker_Env.unfold_effect_abbrev env c21 in - (let uu___10 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___10 = FStarC_Effect.op_Bang dbg_Rel in if uu___10 then let uu___11 = @@ -14212,8 +14118,8 @@ and (solve_c : let uu___12 = FStarC_Ident.string_of_lid c22.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.print2 - "solve_c for %s and %s\n" uu___11 uu___12 + FStarC_Util.print2 "solve_c for %s and %s\n" + uu___11 uu___12 else ()); (let uu___10 = FStarC_TypeChecker_Env.is_layered_effect env @@ -14238,7 +14144,7 @@ and (solve_c : FStarC_Class_Show.show FStarC_Ident.showable_lident c22.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "incompatible monad ordering: %s Prims.string) = fun g -> let uu___ = - FStarC_Compiler_CList.map + FStarC_CList.map (fun i -> FStarC_Class_Show.show FStarC_Syntax_Print.showable_ctxu i.FStarC_TypeChecker_Common.imp_uvar) g.FStarC_TypeChecker_Common.implicits in FStarC_Class_Show.show - (FStarC_Compiler_CList.showable_clist FStarC_Class_Show.showable_string) - uu___ + (FStarC_CList.showable_clist FStarC_Class_Show.showable_string) uu___ let (ineqs_to_string : - (FStarC_Syntax_Syntax.universe FStarC_Compiler_CList.clist * + (FStarC_Syntax_Syntax.universe FStarC_CList.clist * (FStarC_Syntax_Syntax.universe * FStarC_Syntax_Syntax.universe) - FStarC_Compiler_CList.clist) -> Prims.string) + FStarC_CList.clist) -> Prims.string) = fun ineqs -> let uu___ = ineqs in match uu___ with | (vars, ineqs1) -> let ineqs2 = - FStarC_Compiler_CList.map + FStarC_CList.map (fun uu___1 -> match uu___1 with | (u1, u2) -> @@ -14276,18 +14181,17 @@ let (ineqs_to_string : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u2 in - FStarC_Compiler_Util.format2 "%s < %s" uu___2 uu___3) - ineqs1 in + FStarC_Util.format2 "%s < %s" uu___2 uu___3) ineqs1 in let uu___1 = FStarC_Class_Show.show - (FStarC_Compiler_CList.showable_clist - FStarC_Syntax_Print.showable_univ) vars in + (FStarC_CList.showable_clist FStarC_Syntax_Print.showable_univ) + vars in let uu___2 = FStarC_Class_Show.show - (FStarC_Compiler_CList.showable_clist - FStarC_Class_Show.showable_string) ineqs2 in - FStarC_Compiler_Util.format2 "Solving for %s; inequalities are %s" - uu___1 uu___2 + (FStarC_CList.showable_clist FStarC_Class_Show.showable_string) + ineqs2 in + FStarC_Util.format2 "Solving for %s; inequalities are %s" uu___1 + uu___2 let (guard_to_string : FStarC_TypeChecker_Env.env -> FStarC_TypeChecker_Common.guard_t -> Prims.string) @@ -14298,15 +14202,14 @@ let (guard_to_string : let uu___1 = Obj.magic (FStarC_Class_Listlike.view () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())) + (Obj.magic (FStarC_CList.listlike_clist ())) (Obj.magic g.FStarC_TypeChecker_Common.deferred)) in ((g.FStarC_TypeChecker_Common.guard_f), uu___1) in match uu___ with | (FStarC_TypeChecker_Common.Trivial, FStarC_Class_Listlike.VNil) when (let uu___1 = FStarC_Options.print_implicits () in Prims.op_Negation uu___1) && - (FStarC_Class_Listlike.is_empty - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_Class_Listlike.is_empty (FStarC_CList.listlike_clist ()) (FStar_Pervasives_Native.snd g.FStarC_TypeChecker_Common.univ_ineqs)) -> "{}" @@ -14316,8 +14219,8 @@ let (guard_to_string : | FStarC_TypeChecker_Common.Trivial -> "trivial" | FStarC_TypeChecker_Common.NonTrivial f -> let uu___2 = - ((FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Debug.extreme ())) + ((FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Debug.extreme ())) || (FStarC_Options.print_implicits ()) in if uu___2 then FStarC_TypeChecker_Normalize.term_to_string env f @@ -14325,7 +14228,7 @@ let (guard_to_string : let carry defs = let uu___2 = let uu___3 = - FStarC_Compiler_CList.map + FStarC_CList.map (fun uu___4 -> match uu___4 with | (uu___5, msg, x) -> @@ -14333,14 +14236,14 @@ let (guard_to_string : let uu___7 = prob_to_string env x in Prims.strcat ": " uu___7 in Prims.strcat msg uu___6) defs in - FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) uu___3 in - FStarC_Compiler_String.concat ",\n" uu___2 in + FStarC_Class_Listlike.to_list (FStarC_CList.listlike_clist ()) + uu___3 in + FStarC_String.concat ",\n" uu___2 in let imps = print_pending_implicits g in let uu___2 = carry g.FStarC_TypeChecker_Common.deferred in let uu___3 = carry g.FStarC_TypeChecker_Common.deferred_to_tac in let uu___4 = ineqs_to_string g.FStarC_TypeChecker_Common.univ_ineqs in - FStarC_Compiler_Util.format5 + FStarC_Util.format5 "\n\t{guard_f=%s;\n\t deferred={\n%s};\n\t deferred_to_tac={\n%s};\n\t univ_ineqs={%s};\n\t implicits=%s}\n" form uu___2 uu___3 uu___4 imps let (new_t_problem : @@ -14350,7 +14253,7 @@ let (new_t_problem : FStarC_TypeChecker_Common.rel -> FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_TypeChecker_Common.prob * worklist)) = fun wl -> @@ -14362,16 +14265,16 @@ let (new_t_problem : fun loc -> let reason = let uu___ = - (FStarC_Compiler_Effect.op_Bang dbg_ExplainRel) || - (FStarC_Compiler_Effect.op_Bang dbg_Rel) in + (FStarC_Effect.op_Bang dbg_ExplainRel) || + (FStarC_Effect.op_Bang dbg_Rel) in if uu___ then let uu___1 = FStarC_TypeChecker_Normalize.term_to_string env lhs in let uu___2 = FStarC_TypeChecker_Normalize.term_to_string env rhs in - FStarC_Compiler_Util.format3 "Top-level:\n%s\n\t%s\n%s" - uu___1 (rel_to_string rel) uu___2 + FStarC_Util.format3 "Top-level:\n%s\n\t%s\n%s" uu___1 + (rel_to_string rel) uu___2 else "TOP" in let uu___ = new_problem wl env lhs rel rhs elt loc reason in match uu___ with @@ -14418,50 +14321,46 @@ let (solve_and_commit : fun wl -> fun err -> let tx = FStarC_Syntax_Unionfind.new_transaction () in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_RelBench in + (let uu___1 = FStarC_Effect.op_Bang dbg_RelBench in if uu___1 then let uu___2 = FStarC_Common.string_of_list - (fun p -> FStarC_Compiler_Util.string_of_int (p_pid p)) - wl.attempting in - FStarC_Compiler_Util.print1 "solving problems %s {\n" uu___2 + (fun p -> FStarC_Util.string_of_int (p_pid p)) wl.attempting in + FStarC_Util.print1 "solving problems %s {\n" uu___2 else ()); - (let uu___1 = - FStarC_Compiler_Util.record_time_ms (fun uu___2 -> solve wl) in + (let uu___1 = FStarC_Util.record_time_ms (fun uu___2 -> solve wl) in match uu___1 with | (sol, ms) -> - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_RelBench in + ((let uu___3 = FStarC_Effect.op_Bang dbg_RelBench in if uu___3 then - let uu___4 = FStarC_Compiler_Util.string_of_int ms in - FStarC_Compiler_Util.print1 "} solved in %s ms\n" uu___4 + let uu___4 = FStarC_Util.string_of_int ms in + FStarC_Util.print1 "} solved in %s ms\n" uu___4 else ()); (match sol with | Success (deferred, defer_to_tac, implicits) -> let uu___3 = - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___4 -> FStarC_Syntax_Unionfind.commit tx) in (match uu___3 with | ((), ms1) -> - ((let uu___5 = - FStarC_Compiler_Effect.op_Bang dbg_RelBench in + ((let uu___5 = FStarC_Effect.op_Bang dbg_RelBench in if uu___5 then - let uu___6 = FStarC_Compiler_Util.string_of_int ms1 in - FStarC_Compiler_Util.print1 "committed in %s ms\n" - uu___6 + let uu___6 = FStarC_Util.string_of_int ms1 in + FStarC_Util.print1 "committed in %s ms\n" uu___6 else ()); FStar_Pervasives_Native.Some (deferred, defer_to_tac, implicits))) | Failed (d, s) -> ((let uu___4 = - (FStarC_Compiler_Effect.op_Bang dbg_ExplainRel) || - (FStarC_Compiler_Effect.op_Bang dbg_Rel) in + (FStarC_Effect.op_Bang dbg_ExplainRel) || + (FStarC_Effect.op_Bang dbg_Rel) in if uu___4 then let uu___5 = explain wl d s in - FStarC_Compiler_Util.print_string uu___5 + FStarC_Util.print_string uu___5 else ()); (let result = err (d, s) in FStarC_Syntax_Unionfind.rollback tx; result))))) @@ -14494,12 +14393,10 @@ let (with_guard : FStarC_TypeChecker_Common.univ_ineqs = ((Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ())))), + (Obj.magic (FStarC_CList.listlike_clist ())))), (Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ()))))); + (Obj.magic (FStarC_CList.listlike_clist ()))))); FStarC_TypeChecker_Common.implicits = implicits } in FStar_Pervasives_Native.Some uu___1)) @@ -14535,7 +14432,7 @@ let (try_teq : FStar_Pervasives_Native.Some uu___3 in FStarC_Profiling.profile (fun uu___3 -> - (let uu___5 = FStarC_Compiler_Effect.op_Bang dbg_RelTop in + (let uu___5 = FStarC_Effect.op_Bang dbg_RelTop in if uu___5 then let uu___6 = @@ -14549,8 +14446,8 @@ let (try_teq : (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binding) env.FStarC_TypeChecker_Env.gamma in - FStarC_Compiler_Util.print3 - "try_teq of %s and %s in %s {\n" uu___6 uu___7 uu___8 + FStarC_Util.print3 "try_teq of %s and %s in %s {\n" uu___6 + uu___7 uu___8 else ()); (let uu___5 = let uu___6 = empty_worklist env in @@ -14564,13 +14461,13 @@ let (try_teq : solve_and_commit (singleton wl prob smt_ok1) (fun uu___7 -> FStar_Pervasives_Native.None) in with_guard env prob uu___6 in - ((let uu___7 = FStarC_Compiler_Effect.op_Bang dbg_RelTop in + ((let uu___7 = FStarC_Effect.op_Bang dbg_RelTop in if uu___7 then let uu___8 = FStarC_Common.string_of_option (guard_to_string env) g in - FStarC_Compiler_Util.print1 "} res = %s\n" uu___8 + FStarC_Util.print1 "} res = %s\n" uu___8 else ()); g))) uu___2 "FStarC.TypeChecker.Rel.try_teq") let (teq : @@ -14590,8 +14487,8 @@ let (teq : FStarC_TypeChecker_Common.trivial_guard) | FStar_Pervasives_Native.Some g -> ((let uu___2 = - (FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop) in + (FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop) in if uu___2 then let uu___3 = @@ -14599,7 +14496,7 @@ let (teq : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in let uu___5 = guard_to_string env g in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "teq of %s and %s succeeded with guard %s\n" uu___3 uu___4 uu___5 else ()); @@ -14614,16 +14511,16 @@ let (get_teq_predicate : fun t1 -> fun t2 -> (let uu___1 = - (FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop) in + (FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop) in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 "get_teq_predicate of %s and %s {\n" - uu___2 uu___3 + FStarC_Util.print2 "get_teq_predicate of %s and %s {\n" uu___2 + uu___3 else ()); (let uu___1 = let uu___2 = empty_worklist env in @@ -14636,14 +14533,13 @@ let (get_teq_predicate : (fun uu___3 -> FStar_Pervasives_Native.None) in with_guard env prob uu___2 in ((let uu___3 = - (FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop) in + (FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = FStarC_Common.string_of_option (guard_to_string env) g in - FStarC_Compiler_Util.print1 "} res teq predicate = %s\n" - uu___4 + FStarC_Util.print1 "} res teq predicate = %s\n" uu___4 else ()); (match g with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None @@ -14687,8 +14583,8 @@ let (sub_or_eq_comp : then FStarC_TypeChecker_Common.EQ else FStarC_TypeChecker_Common.SUB in (let uu___3 = - (FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop) in + (FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = @@ -14697,7 +14593,7 @@ let (sub_or_eq_comp : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c2 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "sub_comp of %s --and-- %s --with-- %s\n" uu___4 uu___5 (if rel = FStarC_TypeChecker_Common.EQ then "EQ" @@ -14727,7 +14623,7 @@ let (sub_or_eq_comp : let prob1 = FStarC_TypeChecker_Common.CProb prob in (def_check_prob "sub_comp" prob1; (let uu___5 = - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___6 -> let uu___7 = solve_and_commit (singleton wl1 prob1 true) @@ -14736,10 +14632,9 @@ let (sub_or_eq_comp : match uu___5 with | (r, ms) -> ((let uu___7 = - ((FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop)) - || - (FStarC_Compiler_Effect.op_Bang dbg_RelBench) in + ((FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop)) + || (FStarC_Effect.op_Bang dbg_RelBench) in if uu___7 then let uu___8 = @@ -14748,9 +14643,8 @@ let (sub_or_eq_comp : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c2 in - let uu___10 = - FStarC_Compiler_Util.string_of_int ms in - FStarC_Compiler_Util.print4 + let uu___10 = FStarC_Util.string_of_int ms in + FStarC_Util.print4 "sub_comp of %s --and-- %s --with-- %s --- solved in %s ms\n" uu___8 uu___9 (if rel = FStarC_TypeChecker_Common.EQ @@ -14805,9 +14699,9 @@ let (eq_comp : let (solve_universe_inequalities' : FStarC_Syntax_Unionfind.tx -> FStarC_TypeChecker_Env.env_t -> - (FStarC_Syntax_Syntax.universe FStarC_Compiler_CList.clist * + (FStarC_Syntax_Syntax.universe FStarC_CList.clist * (FStarC_Syntax_Syntax.universe * FStarC_Syntax_Syntax.universe) - FStarC_Compiler_CList.clist) -> unit) + FStarC_CList.clist) -> unit) = fun tx -> fun env -> @@ -14823,8 +14717,8 @@ let (solve_universe_inequalities' : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ u2 in - FStarC_Compiler_Util.format2 - "Universe %s and %s are incompatible" uu___3 uu___4 in + FStarC_Util.format2 "Universe %s and %s are incompatible" + uu___3 uu___4 in FStarC_Errors.raise_error FStarC_TypeChecker_Env.hasRange_env env FStarC_Errors_Codes.Fatal_IncompatibleUniverse () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -14839,7 +14733,7 @@ let (solve_universe_inequalities' : v0') -> FStarC_Syntax_Unionfind.univ_equiv v0 v0' | uu___2 -> false in let sols = - FStarC_Compiler_CList.collect + FStarC_CList.collect (fun uu___1 -> (fun v -> let uu___1 = FStarC_Syntax_Subst.compress_univ v in @@ -14848,7 +14742,7 @@ let (solve_universe_inequalities' : Obj.magic (Obj.repr (let lower_bounds_of_v = - FStarC_Compiler_CList.collect + FStarC_CList.collect (fun uu___3 -> (fun uu___3 -> match uu___3 with @@ -14857,7 +14751,7 @@ let (solve_universe_inequalities' : if uu___4 then let uu___5 = - FStarC_Compiler_CList.existsb + FStarC_CList.existsb (equiv u) variables in (if uu___5 then @@ -14865,46 +14759,44 @@ let (solve_universe_inequalities' : (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ()))) else Obj.magic (FStarC_Class_Listlike.cons () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())) u (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ()))))) else Obj.magic (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())))) uu___3) ineqs in let lb = let uu___3 = let uu___4 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist - ()) lower_bounds_of_v in + (FStarC_CList.listlike_clist ()) + lower_bounds_of_v in FStarC_Syntax_Syntax.U_max uu___4 in FStarC_TypeChecker_Normalize.normalize_universe env uu___3 in FStarC_Class_Listlike.singleton - (FStarC_Compiler_CList.listlike_clist ()) - (lb, v))) + (FStarC_CList.listlike_clist ()) (lb, v))) | uu___2 -> Obj.magic (Obj.repr (FStarC_Class_Listlike.empty () - (Obj.magic - (FStarC_Compiler_CList.listlike_clist ()))))) + (Obj.magic (FStarC_CList.listlike_clist ()))))) uu___1) variables in let uu___1 = let wl = @@ -14922,7 +14814,7 @@ let (solve_universe_inequalities' : repr_subcomp_allowed = (uu___2.repr_subcomp_allowed); typeclass_variables = (uu___2.typeclass_variables) } in - FStarC_Compiler_CList.map + FStarC_CList.map (fun uu___2 -> match uu___2 with | (lb, v) -> @@ -14953,14 +14845,13 @@ let (solve_universe_inequalities' : | (FStarC_Syntax_Syntax.U_unif uu___3, FStarC_Syntax_Syntax.U_succ v0) -> check_ineq (u1, v0) | (FStarC_Syntax_Syntax.U_max us, uu___3) -> - FStarC_Compiler_Util.for_all - (fun u2 -> check_ineq (u2, v1)) us + FStarC_Util.for_all (fun u2 -> check_ineq (u2, v1)) us | (uu___3, FStarC_Syntax_Syntax.U_max vs) -> - FStarC_Compiler_Util.for_some - (fun v2 -> check_ineq (u1, v2)) vs + FStarC_Util.for_some (fun v2 -> check_ineq (u1, v2)) + vs | uu___3 -> false) in let uu___2 = - FStarC_Compiler_CList.for_all + FStarC_CList.for_all (fun uu___3 -> match uu___3 with | (u, v) -> @@ -14969,7 +14860,7 @@ let (solve_universe_inequalities' : then true else ((let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg_GenUniverses in + FStarC_Effect.op_Bang dbg_GenUniverses in if uu___7 then let uu___8 = @@ -14978,23 +14869,22 @@ let (solve_universe_inequalities' : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ v in - FStarC_Compiler_Util.print2 "%s - (FStarC_Syntax_Syntax.universe FStarC_Compiler_CList.clist * + (FStarC_Syntax_Syntax.universe FStarC_CList.clist * (FStarC_Syntax_Syntax.universe * FStarC_Syntax_Syntax.universe) - FStarC_Compiler_CList.clist) -> unit) + FStarC_CList.clist) -> unit) = fun env -> fun ineqs -> @@ -15042,11 +14932,11 @@ let (try_solve_deferred_constraints : (fun uu___2 -> let imps_l = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in let typeclass_variables = let uu___3 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun i -> match (i.FStarC_TypeChecker_Common.imp_uvar).FStarC_Syntax_Syntax.ctx_uvar_meta with @@ -15072,7 +14962,7 @@ let (try_solve_deferred_constraints : goal_type in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs) else []) @@ -15080,13 +14970,13 @@ let (try_solve_deferred_constraints : Obj.magic (FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Free.ord_ctx_uvar)) uu___3) in let wl = let uu___3 = let uu___4 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.deferred in wl_of_guard env uu___4 in { @@ -15114,7 +15004,7 @@ let (try_solve_deferred_constraints : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic msg) in - (let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + (let uu___4 = FStarC_Effect.op_Bang dbg_Rel in if uu___4 then let uu___5 = FStarC_Class_Show.show uu___0 defer_ok in @@ -15126,8 +15016,8 @@ let (try_solve_deferred_constraints : let uu___8 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length imps_l) in - FStarC_Compiler_Util.print4 + (FStarC_List.length imps_l) in + FStarC_Util.print4 "Trying to solve carried problems (defer_ok=%s) (deferred_to_tac_ok=%s): begin\n\t%s\nend\n and %s implicits\n" uu___5 uu___6 uu___7 uu___8 else ()); @@ -15140,8 +15030,8 @@ let (try_solve_deferred_constraints : Obj.magic (FStarC_Class_Listlike.view () (Obj.magic - (FStarC_Compiler_CList.listlike_clist - ())) (Obj.magic deferred)) in + (FStarC_CList.listlike_clist ())) + (Obj.magic deferred)) in FStarC_Class_Listlike.uu___is_VCons uu___7) && (defer_ok = NoDefer) -> @@ -15151,12 +15041,12 @@ let (try_solve_deferred_constraints : (deferred, defer_to_tac, imps) -> let uu___5 = FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) + (FStarC_CList.monoid_clist ()) g.FStarC_TypeChecker_Common.deferred_to_tac defer_to_tac in let uu___6 = FStarC_Class_Monoid.op_Plus_Plus - (FStarC_Compiler_CList.monoid_clist ()) + (FStarC_CList.monoid_clist ()) g.FStarC_TypeChecker_Common.implicits imps in { FStarC_TypeChecker_Common.guard_f = @@ -15189,8 +15079,7 @@ let (try_solve_deferred_constraints : "FStarC.TypeChecker.Rel.solve_deferred_to_tactic_goals" else g1 in (let uu___6 = - FStarC_Compiler_Effect.op_Bang - dbg_ResolveImplicitsHook in + FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___6 then let uu___7 = guard_to_string env g2 in @@ -15198,12 +15087,12 @@ let (try_solve_deferred_constraints : let uu___9 = let uu___10 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) g2.FStarC_TypeChecker_Common.implicits in - FStarC_Compiler_List.length uu___10 in + FStarC_List.length uu___10 in FStarC_Class_Show.show FStarC_Class_Show.showable_nat uu___9 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "ResolveImplicitsHook: Solved deferred to tactic goals, remaining guard is\n%s (and %s implicits)\n" uu___7 uu___8 else ()); @@ -15218,13 +15107,11 @@ let (try_solve_deferred_constraints : ((Obj.magic (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist - ())))), + (FStarC_CList.listlike_clist ())))), (Obj.magic (FStarC_Class_Listlike.empty () (Obj.magic - (FStarC_Compiler_CList.listlike_clist - ()))))); + (FStarC_CList.listlike_clist ()))))); FStarC_TypeChecker_Common.implicits = (g2.FStarC_TypeChecker_Common.implicits) }))) uu___1 @@ -15254,7 +15141,7 @@ let (solve_non_tactic_deferred_constraints : FStarC_TypeChecker_Env.hasBinders_env FStarC_TypeChecker_Env.hasNames_guard FStarC_TypeChecker_Env.pretty_guard - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange "solve_non_tactic_deferred_constraints.g" env g; (let defer_ok = if maybe_defer_flex_flex then DeferFlexFlexOnly else NoDefer in @@ -15272,9 +15159,9 @@ let (do_discharge_vc : fun env -> fun vc -> let debug = - ((FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_SMTQuery)) - || (FStarC_Compiler_Effect.op_Bang dbg_Discharge) in + ((FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_SMTQuery)) + || (FStarC_Effect.op_Bang dbg_Discharge) in let diag uu___1 uu___ = (let uu___ = FStarC_TypeChecker_Env.get_range env in Obj.magic @@ -15314,7 +15201,7 @@ let (do_discharge_vc : let uu___9 = let uu___10 = FStarC_Class_PP.pp FStarC_Class_PP.pp_int - (FStarC_Compiler_List.length vcs1) in + (FStarC_List.length vcs1) in let uu___11 = FStarC_Errors_Msg.text "goals" in FStarC_Pprint.op_Hat_Slash_Hat uu___10 uu___11 in @@ -15324,7 +15211,7 @@ let (do_discharge_vc : uu___6) else (); (let vcs2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> match uu___6 with | (env1, goal, opts) -> @@ -15338,21 +15225,21 @@ let (do_discharge_vc : goal in (env1, uu___7, opts)) vcs1 in let vcs3 = - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun uu___6 -> match uu___6 with | (env1, goal, opts) -> let uu___7 = (env1.FStarC_TypeChecker_Env.solver).FStarC_TypeChecker_Env.handle_smt_goal env1 goal in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | (env2, goal1) -> (env2, goal1, opts)) uu___7) vcs2 in let vcs4 = - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun uu___6 -> match uu___6 with | (env1, goal, opts) -> @@ -15387,7 +15274,7 @@ let (do_discharge_vc : uu___2 = FStarC_Options.Always in if uu___1 then - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___2 -> match uu___2 with | (env1, goal, opts) -> @@ -15396,13 +15283,13 @@ let (do_discharge_vc : (match uu___3 with | FStar_Pervasives_Native.None -> [(env1, goal, opts)] | FStar_Pervasives_Native.Some goals -> - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (env2, goal1) -> (env2, goal1, opts)) goals)) vcs else vcs in - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___1 -> match uu___1 with | (env1, goal, opts) -> @@ -15437,12 +15324,11 @@ let (discharge_guard' : fun env -> fun g -> fun use_smt -> - (let uu___1 = - FStarC_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in + (let uu___1 = FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "///////////////////ResolveImplicitsHook: discharge_guard'\nguard = %s\n" uu___2 else ()); @@ -15455,9 +15341,9 @@ let (discharge_guard' : try_solve_deferred_constraints defer_ok smt_ok deferred_to_tac_ok env g in let debug = - ((FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_SMTQuery)) - || (FStarC_Compiler_Effect.op_Bang dbg_Discharge) in + ((FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_SMTQuery)) + || (FStarC_Effect.op_Bang dbg_Discharge) in let diag uu___2 uu___1 = (let uu___1 = FStarC_TypeChecker_Env.get_range env in Obj.magic @@ -15580,14 +15466,14 @@ let (subtype_nosmt : fun t1 -> fun t2 -> (let uu___1 = - (FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop) in + (FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop) in if uu___1 then let uu___2 = FStarC_TypeChecker_Normalize.term_to_string env t1 in let uu___3 = FStarC_TypeChecker_Normalize.term_to_string env t2 in - FStarC_Compiler_Util.print2 "try_subtype_no_smt of %s and %s\n" - uu___2 uu___3 + FStarC_Util.print2 "try_subtype_no_smt of %s and %s\n" uu___2 + uu___3 else ()); (let uu___1 = let uu___2 = empty_worklist env in @@ -15626,16 +15512,16 @@ let (check_subtyping : FStarC_Profiling.profile (fun uu___1 -> (let uu___3 = - (FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop) in + (FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop) in if uu___3 then let uu___4 = FStarC_TypeChecker_Normalize.term_to_string env t1 in let uu___5 = FStarC_TypeChecker_Normalize.term_to_string env t2 in - FStarC_Compiler_Util.print2 "check_subtyping of %s and %s\n" - uu___4 uu___5 + FStarC_Util.print2 "check_subtyping of %s and %s\n" uu___4 + uu___5 else ()); (let uu___3 = let uu___4 = empty_worklist env in @@ -15654,8 +15540,8 @@ let (check_subtyping : (match g with | FStar_Pervasives_Native.None -> ((let uu___5 = - (FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop) in + (FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop) in if uu___5 then let uu___6 = @@ -15664,15 +15550,15 @@ let (check_subtyping : let uu___7 = FStarC_TypeChecker_Normalize.term_to_string env_x t2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "check_subtyping FAILED: %s <: %s\n" uu___6 uu___7 else ()); FStar_Pervasives_Native.None) | FStar_Pervasives_Native.Some g1 -> ((let uu___5 = - (FStarC_Compiler_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang dbg_RelTop) in + (FStarC_Effect.op_Bang dbg_Rel) || + (FStarC_Effect.op_Bang dbg_RelTop) in if uu___5 then let uu___6 = @@ -15682,7 +15568,7 @@ let (check_subtyping : FStarC_TypeChecker_Normalize.term_to_string env_x t2 in let uu___8 = guard_to_string env_x g1 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "check_subtyping succeeded: %s <: %s\n\tguard is %s\n" uu___6 uu___7 uu___8 else ()); @@ -15792,14 +15678,14 @@ let (try_solve_single_valued_implicits : FStar_Pervasives_Native.Some uu___4 | uu___3 -> FStar_Pervasives_Native.None) in let b = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun b1 -> fun imp -> let uu___1 = (let uu___2 = FStarC_Syntax_Unionfind.find (imp.FStarC_TypeChecker_Common.imp_uvar).FStarC_Syntax_Syntax.ctx_uvar_head in - FStarC_Compiler_Util.is_none uu___2) && + FStarC_Util.is_none uu___2) && (let uu___2 = FStarC_Syntax_Util.ctx_uvar_should_check imp.FStarC_TypeChecker_Common.imp_uvar in @@ -15838,7 +15724,7 @@ let (check_implicit_solution_and_discharge_guard : let uvar_ty = FStarC_Syntax_Util.ctx_uvar_typ imp_uvar in let uvar_should_check = FStarC_Syntax_Util.ctx_uvar_should_check imp_uvar in - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___2 = FStarC_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = @@ -15850,9 +15736,8 @@ let (check_implicit_solution_and_discharge_guard : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uvar_ty in - let uu___6 = - FStarC_Compiler_Range_Ops.string_of_range imp_range in - FStarC_Compiler_Util.print5 + let uu___6 = FStarC_Range_Ops.string_of_range imp_range in + FStarC_Util.print5 "Checking uvar %s resolved to %s at type %s, introduce for %s at %s\n" uu___3 uu___4 uu___5 imp_reason uu___6 else ()); @@ -16101,7 +15986,7 @@ let (check_implicit_solution_and_discharge_guard : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term uvar_ty in - FStarC_Compiler_Util.format5 + FStarC_Util.format5 "Core checking failed for implicit %s (is_tac: %s) (reason: %s) (%s <: %s)" uu___6 uu___7 imp_reason uu___8 uu___9 in FStarC_Errors.raise_error @@ -16114,7 +15999,7 @@ let (check_implicit_solution_and_discharge_guard : (Obj.magic uu___5))) in let uu___2 = (Prims.op_Negation force_univ_constraints) && - (FStarC_Compiler_CList.existsb + (FStarC_CList.existsb (fun uu___3 -> match uu___3 with | (reason, uu___4, uu___5) -> @@ -16134,13 +16019,12 @@ let (check_implicit_solution_and_discharge_guard : FStarC_Syntax_Print.showable_term imp_tm in let uu___7 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range - imp_range in + FStarC_Range_Ops.showable_range imp_range in let uu___8 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range imp_tm.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "%s (Introduced at %s for %s resolved at %s)" uu___6 uu___7 imp_reason uu___8)) env1 g true in @@ -16175,7 +16059,7 @@ let (pick_a_univ_deffered_implicit : = fun out -> let uu___ = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___1 -> match uu___1 with | (uu___2, status) -> @@ -16186,7 +16070,7 @@ let (pick_a_univ_deffered_implicit : | [] -> (FStar_Pervasives_Native.None, out) | hd::tl -> ((FStar_Pervasives_Native.Some (FStar_Pervasives_Native.fst hd)), - (FStarC_Compiler_List.op_At tl rest))) + (FStarC_List.op_At tl rest))) let (is_tac_implicit_resolved : FStarC_TypeChecker_Env.env -> FStarC_TypeChecker_Common.implicit -> Prims.bool) @@ -16196,8 +16080,7 @@ let (is_tac_implicit_resolved : let uu___ = FStarC_Syntax_Free.uvars i.FStarC_TypeChecker_Common.imp_tm in FStarC_Class_Setlike.for_all () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Syntax_Free.ord_ctx_uvar)) + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (fun uv -> let uu___1 = FStarC_Syntax_Util.ctx_uvar_should_check uv in FStarC_Syntax_Syntax.uu___is_Allow_unresolved uu___1) @@ -16231,16 +16114,15 @@ let (resolve_implicits' : | (hd, args) -> (FStarC_Syntax_Util.is_fvar FStarC_Parser_Const.tcresolve_lid hd) - && - ((FStarC_Compiler_List.length args) = Prims.int_one)) + && ((FStarC_List.length args) = Prims.int_one)) | uu___1 -> false) in let meta_tac_allowed_for_open_problem tac = cacheable tac in - let __meta_arg_cache = FStarC_Compiler_Util.mk_ref [] in + let __meta_arg_cache = FStarC_Util.mk_ref [] in let meta_arg_cache_result tac e ty res = let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang __meta_arg_cache in + let uu___1 = FStarC_Effect.op_Bang __meta_arg_cache in (tac, e, ty, res) :: uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals __meta_arg_cache uu___ in + FStarC_Effect.op_Colon_Equals __meta_arg_cache uu___ in let meta_arg_cache_lookup tac e ty = let rec aux l = match l with @@ -16253,8 +16135,7 @@ let (resolve_implicits' : e'.FStarC_TypeChecker_Env.gamma)) && (FStarC_Syntax_Util.term_eq ty ty') in if uu___ then FStar_Pervasives_Native.Some res' else aux l' in - let uu___ = FStarC_Compiler_Effect.op_Bang __meta_arg_cache in - aux uu___ in + let uu___ = FStarC_Effect.op_Bang __meta_arg_cache in aux uu___ in let rec until_fixpoint acc implicits1 = let uu___ = acc in match uu___ with @@ -16264,21 +16145,18 @@ let (resolve_implicits' : if changed then let uu___1 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - out in + FStarC_List.map FStar_Pervasives_Native.fst out in until_fixpoint ([], false, true) uu___1 else if defer_open_metas then (let uu___2 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst out in + FStarC_List.map FStar_Pervasives_Native.fst out in until_fixpoint ([], false, false) uu___2) else (let uu___3 = let uu___4 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst out in + FStarC_List.map FStar_Pervasives_Native.fst out in try_solve_single_valued_implicits env is_tac uu___4 in match uu___3 with @@ -16299,14 +16177,14 @@ let (resolve_implicits' : check_implicit_solution_and_discharge_guard env imp is_tac force_univ_constraints in - FStarC_Compiler_Util.must uu___6 in + FStarC_Util.must uu___6 in let uu___6 = let uu___7 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ()) imps1 in let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst rest in FStarC_Class_Monoid.op_Plus_Plus @@ -16335,8 +16213,7 @@ let (resolve_implicits' : FStarC_Syntax_Syntax.uvar_decoration_should_unrefine = uu___4;_} -> - ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Rel in if uu___6 then let uu___7 = @@ -16353,7 +16230,7 @@ let (resolve_implicits' : FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_should_check_uvar uvar_decoration_should_check in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "resolve_implicits' loop, imp_tm=%s and ctx_u=%s, is_tac=%s, should_check=%s\n" uu___7 uu___8 uu___9 uu___10 else ()); @@ -16529,10 +16406,9 @@ let (resolve_implicits' : if defer_open_metas && is_open then ((let uu___8 = - (FStarC_Compiler_Effect.op_Bang - dbg_Rel) + (FStarC_Effect.op_Bang dbg_Rel) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Effect.op_Bang dbg_Imps) in if uu___8 then @@ -16540,7 +16416,7 @@ let (resolve_implicits' : FStarC_Class_Show.show FStarC_Syntax_Print.showable_ctxu ctx_u in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Deferring implicit due to open ctx/typ %s\n" uu___9 else ()); @@ -16557,9 +16433,9 @@ let (resolve_implicits' : Prims.op_Negation uu___9)) && (let uu___9 = - FStarC_Options_Ext.get + FStarC_Options_Ext.enabled "compat:open_metas" in - uu___9 = "") in + Prims.op_Negation uu___9) in if uu___8 then until_fixpoint @@ -16579,14 +16455,14 @@ let (resolve_implicits' : | FStar_Pervasives_Native.Some g -> FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in until_fixpoint (out, true, defer_open_metas) - (FStarC_Compiler_List.op_At - extra tl) in + (FStarC_List.op_At extra + tl) in let uu___10 = cacheable tac in if uu___10 then @@ -16805,10 +16681,9 @@ let (resolve_implicits' : env1 hd1 is_tac force_univ_constraints in let res1 = - FStarC_Compiler_Util.map_opt - res + FStarC_Util.map_opt res (FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ())) in (if res1 <> @@ -16843,15 +16718,15 @@ let (resolve_implicits' : let uu___9 = let uu___10 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist + (FStarC_CList.listlike_clist ()) imps in - FStarC_Compiler_List.map + FStarC_List.map (fun i -> (i, Implicit_unresolved)) uu___10 in - FStarC_Compiler_List.op_At - uu___9 out in + FStarC_List.op_At uu___9 + out in (uu___8, true, defer_open_metas) in until_fixpoint uu___7 tl)))))) in @@ -16862,32 +16737,30 @@ let (resolve_implicits : = fun env -> fun g -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in + (let uu___1 = FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "//////////////////////////ResolveImplicitsHook: resolve_implicits begin////////////\nguard = %s {\n" uu___2 else ()); (let tagged_implicits1 = let uu___1 = - FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + FStarC_Class_Listlike.to_list (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in resolve_implicits' env false false uu___1 in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in + (let uu___2 = FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___2 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "//////////////////////////ResolveImplicitsHook: resolve_implicits end////////////\n}\n" else ()); (let uu___2 = let uu___3 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - tagged_implicits1 in - FStarC_Class_Listlike.from_list - (FStarC_Compiler_CList.listlike_clist ()) uu___3 in + FStarC_List.map FStar_Pervasives_Native.fst tagged_implicits1 in + FStarC_Class_Listlike.from_list (FStarC_CList.listlike_clist ()) + uu___3 in { FStarC_TypeChecker_Common.guard_f = (g.FStarC_TypeChecker_Common.guard_f); @@ -16907,16 +16780,14 @@ let (resolve_generalization_implicits : fun g -> let tagged_implicits1 = let uu___ = - FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + FStarC_Class_Listlike.to_list (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in resolve_implicits' env false true uu___ in let uu___ = let uu___1 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - tagged_implicits1 in - FStarC_Class_Listlike.from_list - (FStarC_Compiler_CList.listlike_clist ()) uu___1 in + FStarC_List.map FStar_Pervasives_Native.fst tagged_implicits1 in + FStarC_Class_Listlike.from_list (FStarC_CList.listlike_clist ()) + uu___1 in { FStarC_TypeChecker_Common.guard_f = (g.FStarC_TypeChecker_Common.guard_f); @@ -16935,27 +16806,25 @@ let (resolve_implicits_tac : fun env -> fun g -> let uu___ = - FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + FStarC_Class_Listlike.to_list (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.implicits in resolve_implicits' env true false uu___ let (force_trivial_guard : FStarC_TypeChecker_Env.env -> FStarC_TypeChecker_Common.guard_t -> unit) = fun env -> fun g -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_ResolveImplicitsHook in + (let uu___1 = FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___1 then let uu___2 = guard_to_string env g in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "//////////////////////////ResolveImplicitsHook: force_trivial_guard////////////\nguard = %s\n" uu___2 else ()); (let g1 = solve_deferred_constraints env g in let g2 = resolve_implicits env g1 in let uu___1 = - FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + FStarC_Class_Listlike.to_list (FStarC_CList.listlike_clist ()) g2.FStarC_TypeChecker_Common.implicits in match uu___1 with | [] -> let uu___2 = discharge_guard env g2 in () @@ -17038,19 +16907,19 @@ let (layered_effect_teq : fun t1 -> fun t2 -> fun reason -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsEqns in + (let uu___1 = FStarC_Effect.op_Bang dbg_LayeredEffectsEqns in if uu___1 then let uu___2 = - if FStarC_Compiler_Util.is_none reason + if FStarC_Util.is_none reason then "_" - else FStarC_Compiler_Util.must reason in + else FStarC_Util.must reason in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print3 "Layered Effect (%s) %s = %s\n" - uu___2 uu___3 uu___4 + FStarC_Util.print3 "Layered Effect (%s) %s = %s\n" uu___2 uu___3 + uu___4 else ()); teq env t1 t2 let (universe_inequality : @@ -17063,14 +16932,12 @@ let (universe_inequality : let uu___1 = Obj.magic (FStarC_Class_Listlike.cons () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())) - (u1, u2) + (Obj.magic (FStarC_CList.listlike_clist ())) (u1, u2) (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))) in + (Obj.magic (FStarC_CList.listlike_clist ())))) in ((Obj.magic (FStarC_Class_Listlike.empty () - (Obj.magic (FStarC_Compiler_CList.listlike_clist ())))), - uu___1) in + (Obj.magic (FStarC_CList.listlike_clist ())))), uu___1) in { FStarC_TypeChecker_Common.guard_f = (FStarC_TypeChecker_Common.trivial_guard.FStarC_TypeChecker_Common.guard_f); diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Tc.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Tc.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Tc.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Tc.ml index 06202fc9609..10d6045f026 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Tc.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Tc.ml @@ -1,14 +1,13 @@ open Prims -let (dbg_TwoPhases : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "TwoPhases" -let (dbg_IdInfoOn : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "IdInfoOn" -let (dbg_Normalize : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Normalize" -let (dbg_UF : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "UF" -let (dbg_LogTypes : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LogTypes" +let (dbg_TwoPhases : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "TwoPhases" +let (dbg_IdInfoOn : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "IdInfoOn" +let (dbg_Normalize : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Normalize" +let (dbg_UF : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "UF" +let (dbg_LogTypes : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LogTypes" let (sigelt_typ : FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option) @@ -52,9 +51,9 @@ let (set_hint_correlator : let get_n lid = let n_opt = let uu___ = FStarC_Class_Show.show FStarC_Ident.showable_lident lid in - FStarC_Compiler_Util.smap_try_find tbl uu___ in - if FStarC_Compiler_Util.is_some n_opt - then FStarC_Compiler_Util.must n_opt + FStarC_Util.smap_try_find tbl uu___ in + if FStarC_Util.is_some n_opt + then FStarC_Util.must n_opt else Prims.int_zero in let typ = let uu___ = sigelt_typ se in @@ -180,7 +179,7 @@ let (set_hint_correlator : let uu___1 = FStarC_TypeChecker_Env.current_module env in let uu___2 = let uu___3 = FStarC_GenSym.next_id () in - FStarC_Compiler_Util.string_of_int uu___3 in + FStarC_Util.string_of_int uu___3 in FStarC_Ident.lid_add_suffix uu___1 uu___2 | l::uu___1 -> l in let uu___1 = @@ -299,7 +298,7 @@ let (tc_type_common : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.tscheme -> FStarC_Syntax_Syntax.typ -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.tscheme) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.tscheme) = fun env -> fun uu___ -> @@ -333,7 +332,7 @@ let (tc_type_common : let (tc_declare_typ : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.tscheme -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.tscheme) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.tscheme) = fun env -> fun ts -> @@ -345,7 +344,7 @@ let (tc_declare_typ : let (tc_assume : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.tscheme -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.tscheme) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.tscheme) = fun env -> fun ts -> @@ -367,8 +366,7 @@ let (tc_decl_attributes : if uu___1 then ([], (se.FStarC_Syntax_Syntax.sigattrs)) else - FStarC_Compiler_List.partition - ((=) FStarC_Syntax_Util.attr_substitute) + FStarC_List.partition ((=) FStarC_Syntax_Util.attr_substitute) se.FStarC_Syntax_Syntax.sigattrs in match uu___ with | (blacklisted_attrs, other_attrs) -> @@ -387,8 +385,7 @@ let (tc_decl_attributes : FStarC_Syntax_Syntax.sigmeta = (se.FStarC_Syntax_Syntax.sigmeta); FStarC_Syntax_Syntax.sigattrs = - (FStarC_Compiler_List.op_At blacklisted_attrs - other_attrs1); + (FStarC_List.op_At blacklisted_attrs other_attrs1); FStarC_Syntax_Syntax.sigopens_and_abbrevs = (se.FStarC_Syntax_Syntax.sigopens_and_abbrevs); FStarC_Syntax_Syntax.sigopts = @@ -408,17 +405,16 @@ let (tc_inductive' : fun quals -> fun attrs -> fun lids -> - (let uu___1 = FStarC_Compiler_Debug.low () in + (let uu___1 = FStarC_Debug.low () in if uu___1 then let uu___2 = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_sigelt) ses in - FStarC_Compiler_Util.print1 ">>>>>>>>>>>>>>tc_inductive %s\n" - uu___2 + FStarC_Util.print1 ">>>>>>>>>>>>>>tc_inductive %s\n" uu___2 else ()); - (let ses1 = FStarC_Compiler_List.map (tc_decl_attributes env) ses in + (let ses1 = FStarC_List.map (tc_decl_attributes env) ses in let uu___1 = FStarC_TypeChecker_TcInductive.check_inductive_well_typedness env ses1 quals lids in @@ -432,10 +428,10 @@ let (tc_inductive' : FStarC_Parser_Const.erasable_attr attrs in let data_ops_ses = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_TypeChecker_TcInductive.mk_data_operations quals attrs' env tcs) datas in - FStarC_Compiler_List.flatten uu___2 in + FStarC_List.flatten uu___2 in ((let uu___3 = (FStarC_Options.no_positivity ()) || (let uu___4 = FStarC_TypeChecker_Env.should_verify env in @@ -445,7 +441,7 @@ let (tc_inductive' : else (let env2 = FStarC_TypeChecker_Env.push_sigelt env sig_bndle1 in - FStarC_Compiler_List.iter + FStarC_List.iter (fun ty -> let b = FStarC_TypeChecker_Positivity.check_strict_positivity @@ -484,7 +480,7 @@ let (tc_inductive' : FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___7) else ()) tcs; - FStarC_Compiler_List.iter + FStarC_List.iter (fun d -> let uu___6 = match d.FStarC_Syntax_Syntax.sigel with @@ -530,7 +526,7 @@ let (tc_inductive' : (let skip_haseq = let skip_prims_type uu___3 = let lid = - let ty = FStarC_Compiler_List.hd tcs in + let ty = FStarC_List.hd tcs in match ty.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ { FStarC_Syntax_Syntax.lid = lid1; @@ -545,7 +541,7 @@ let (tc_inductive' : uu___10;_} -> lid1 | uu___4 -> failwith "Impossible" in - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun s -> let uu___4 = let uu___5 = FStarC_Ident.ident_of_lid lid in @@ -553,16 +549,15 @@ let (tc_inductive' : s = uu___4) FStarC_TypeChecker_TcInductive.early_prims_inductives in let is_noeq = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun q -> q = FStarC_Syntax_Syntax.Noeq) quals in let is_erasable uu___3 = let uu___4 = - let uu___5 = FStarC_Compiler_List.hd tcs in + let uu___5 = FStarC_List.hd tcs in uu___5.FStarC_Syntax_Syntax.sigattrs in FStarC_Syntax_Util.has_attribute uu___4 FStarC_Parser_Const.erasable_attr in - ((((FStarC_Compiler_List.length tcs) = Prims.int_zero) - || + ((((FStarC_List.length tcs) = Prims.int_zero) || ((FStarC_Ident.lid_equals env.FStarC_TypeChecker_Env.curmodule FStarC_Parser_Const.prims_lid) @@ -574,7 +569,7 @@ let (tc_inductive' : then (sig_bndle1, data_ops_ses) else (let is_unopteq = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun q -> q = FStarC_Syntax_Syntax.Unopteq) quals in let ses2 = if is_unopteq @@ -584,8 +579,7 @@ let (tc_inductive' : else FStarC_TypeChecker_TcInductive.optimized_haseq_scheme sig_bndle1 tcs datas env in - (sig_bndle1, - (FStarC_Compiler_List.op_At ses2 data_ops_ses))) in + (sig_bndle1, (FStarC_List.op_At ses2 data_ops_ses))) in res))) let (tc_inductive : FStarC_TypeChecker_Env.env -> @@ -616,7 +610,7 @@ let (tc_inductive : | () -> let uu___3 = tc_inductive' env1 ses quals attrs lids in (pop (); uu___3)) () - with | uu___2 -> (pop (); FStarC_Compiler_Effect.raise uu___2)) + with | uu___2 -> (pop (); FStarC_Effect.raise uu___2)) let proc_check_with : 'a . FStarC_Syntax_Syntax.attribute Prims.list -> (unit -> 'a) -> 'a = fun attrs -> @@ -659,8 +653,7 @@ let (handle_postprocess_with_attr : let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident FStarC_Parser_Const.postprocess_with in - FStarC_Compiler_Util.format1 "Ill-formed application of `%s`" - uu___3 in + FStarC_Util.format1 "Ill-formed application of `%s`" uu___3 in FStarC_Errors.log_issue FStarC_TypeChecker_Env.hasRange_env env FStarC_Errors_Codes.Warning_UnrecognizedAttribute () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -686,8 +679,8 @@ let (tc_decls_knot : (FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.sigelt Prims.list -> (FStarC_Syntax_Syntax.sigelt Prims.list * FStarC_TypeChecker_Env.env)) - FStar_Pervasives_Native.option FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None + FStar_Pervasives_Native.option FStarC_Effect.ref) + = FStarC_Util.mk_ref FStar_Pervasives_Native.None let do_two_phases : 'uuuuu . 'uuuuu -> Prims.bool = fun env -> let uu___ = FStarC_Options.lax () in Prims.op_Negation uu___ let run_phase1 : 'a . (unit -> 'a) -> 'a = @@ -696,7 +689,7 @@ let run_phase1 : 'a . (unit -> 'a) -> 'a = (let r = f () in FStarC_TypeChecker_Core.clear_memo_table (); r) let (tc_sig_let : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sigelt -> (Prims.bool * FStarC_Syntax_Syntax.letbinding Prims.list) -> FStarC_Ident.lident Prims.list -> @@ -717,7 +710,7 @@ let (tc_sig_let : FStar_Pervasives_Native.Some val_q | FStar_Pervasives_Native.Some q' -> let drop_logic_and_irreducible = - FStarC_Compiler_List.filter + FStarC_List.filter (fun x -> Prims.op_Negation ((FStarC_Syntax_Syntax.uu___is_Logic x) || @@ -846,7 +839,7 @@ let (tc_sig_let : let uu___2 = FStarC_Ident.string_of_id bv.FStarC_Syntax_Syntax.ppname in - FStarC_Compiler_Util.starts_with uu___2 + FStarC_Util.starts_with uu___2 FStarC_Ident.reserved_prefix in let rec rename_binders def_bs1 val_bs1 = match (def_bs1, val_bs1) with @@ -925,14 +918,13 @@ let (tc_sig_let : FStarC_Syntax_Syntax.lbpos = (lb.FStarC_Syntax_Syntax.lbpos) } in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun lb -> match uu___1 with | (gen, lbs1, quals_opt) -> let lbname = - FStarC_Compiler_Util.right - lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in let uu___2 = let uu___3 = FStarC_TypeChecker_Env.try_lookup_val_decl env1 @@ -968,9 +960,9 @@ let (tc_sig_let : (lb.FStarC_Syntax_Syntax.lbdef).FStarC_Syntax_Syntax.pos in (if (lb.FStarC_Syntax_Syntax.lbunivs <> []) && - ((FStarC_Compiler_List.length + ((FStarC_List.length lb.FStarC_Syntax_Syntax.lbunivs) - <> (FStarC_Compiler_List.length uvs)) + <> (FStarC_List.length uvs)) then FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r @@ -1008,7 +1000,7 @@ let (tc_sig_let : [FStarC_Syntax_Syntax.Visible_default] | FStar_Pervasives_Native.Some q -> let uu___2 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.Irreducible -> true @@ -1019,7 +1011,7 @@ let (tc_sig_let : if uu___2 then q else FStarC_Syntax_Syntax.Visible_default :: q in - let lbs'1 = FStarC_Compiler_List.rev lbs' in + let lbs'1 = FStarC_List.rev lbs' in let uu___2 = let uu___3 = FStarC_Syntax_Util.extract_attr' @@ -1066,15 +1058,15 @@ let (tc_sig_let : FStarC_TypeChecker_Env.preprocess env1 tau lb.FStarC_Syntax_Syntax.lbdef in (let uu___4 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___4 then let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lbdef in - FStarC_Compiler_Util.print1 - "lb preprocessed into: %s\n" uu___5 + FStarC_Util.print1 "lb preprocessed into: %s\n" + uu___5 else ()); { FStarC_Syntax_Syntax.lbname = @@ -1094,8 +1086,7 @@ let (tc_sig_let : let lbs'2 = match pre_tau with | FStar_Pervasives_Native.Some tau -> - FStarC_Compiler_List.map (preprocess_lb tau) - lbs'1 + FStarC_List.map (preprocess_lb tau) lbs'1 | FStar_Pervasives_Native.None -> lbs'1 in let e = let uu___3 = @@ -1467,15 +1458,14 @@ let (tc_sig_let : | (e3, uu___8, uu___9) -> e3) uu___5 "FStarC.TypeChecker.Tc.tc_sig_let-tc-phase1" in (let uu___6 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang - dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___6 then let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Let binding after phase 1, before removing uvars: %s\n" uu___7 else ()); @@ -1485,15 +1475,14 @@ let (tc_sig_let : env' e2 in drop_lbtyp uu___6 in (let uu___7 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang - dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___7 then let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e3 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Let binding after phase 1, uvars removed: %s\n" uu___8 else ()); @@ -1745,8 +1734,7 @@ let (tc_sig_let : (FStar_Pervasives_Native.snd lbs1); (let lbs2 = let uu___11 = - FStarC_Compiler_List.map - rename_parameters + FStarC_List.map rename_parameters (FStar_Pervasives_Native.snd lbs1) in ((FStar_Pervasives_Native.fst lbs1), uu___11) in @@ -1755,7 +1743,7 @@ let (tc_sig_let : match post_tau with | FStar_Pervasives_Native.Some tau -> - FStarC_Compiler_List.map + FStarC_List.map (postprocess_lb tau) (FStar_Pervasives_Native.snd lbs2) @@ -1945,7 +1933,7 @@ let (tc_sig_let : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic s) in - FStarC_Compiler_List.iter + FStarC_List.iter (fun lb -> let uu___8 = let uu___9 = @@ -1966,17 +1954,17 @@ let (tc_sig_let : FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset + (FStarC_RBSet.setlike_rbset FStarC_Syntax_Syntax.ord_fv)) (Obj.magic uu___11) in - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun lid -> let uu___11 = (let uu___12 = let uu___13 = FStarC_Ident.path_of_lid lid in - FStarC_Compiler_List.hd + FStarC_List.hd uu___13 in uu___12 = "Prims") || (FStarC_Ident.lid_equals @@ -1984,18 +1972,15 @@ let (tc_sig_let : FStarC_Parser_Const.pattern_lid) in Prims.op_Negation uu___11) uu___10 in - if - FStarC_Compiler_Util.is_some - lid_opt + if FStarC_Util.is_some lid_opt then let uu___10 = let uu___11 = let uu___12 = - FStarC_Compiler_Util.must - lid_opt in + FStarC_Util.must lid_opt in FStarC_Ident.string_of_lid uu___12 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "%s is not allowed in no_subtyping lemmas (only prims symbols)" uu___11 in err uu___10 @@ -2027,10 +2012,10 @@ let (tc_sig_let : env'2 g))))) (FStar_Pervasives_Native.snd lbs1) else ()); - FStarC_Compiler_List.iter + FStarC_List.iter (fun lb -> let fv = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in FStarC_TypeChecker_Env.insert_fv_info env1 fv @@ -2041,14 +2026,14 @@ let (tc_sig_let : then let uu___10 = let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let should_log = let uu___12 = let uu___13 = let uu___14 = let uu___15 = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in uu___15.FStarC_Syntax_Syntax.fv_name in uu___14.FStarC_Syntax_Syntax.v in @@ -2070,15 +2055,13 @@ let (tc_sig_let : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lb.FStarC_Syntax_Syntax.lbtyp in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "let %s : %s" uu___12 uu___13 else "") (FStar_Pervasives_Native.snd lbs1) in - FStarC_Compiler_String.concat "\n" - uu___11 in - FStarC_Compiler_Util.print1 "%s\n" - uu___10 + FStarC_String.concat "\n" uu___11 in + FStarC_Util.print1 "%s\n" uu___10 else ()); ([se3], [], env0))))))) let (tc_decl' : @@ -2112,12 +2095,12 @@ let (tc_decl' : FStarC_Syntax_Syntax.fail_in_lax = false; FStarC_Syntax_Syntax.ses1 = uu___4;_} when env.FStarC_TypeChecker_Env.admit -> - ((let uu___6 = FStarC_Compiler_Debug.any () in + ((let uu___6 = FStarC_Debug.any () in if uu___6 then let uu___7 = FStarC_Syntax_Print.sigelt_to_string_short se2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Skipping %s since env.admit=true and this is not an expect_lax_failure\n" uu___7 else ()); @@ -2239,16 +2222,15 @@ let (tc_decl' : } else env in let env'1 = FStarC_TypeChecker_Env.push env' "expect_failure" in - ((let uu___3 = FStarC_Compiler_Debug.low () in + ((let uu___3 = FStarC_Debug.low () in if uu___3 then let uu___4 = let uu___5 = - FStarC_Compiler_List.map - FStarC_Compiler_Util.string_of_int expected_errors in - FStarC_Compiler_String.concat "; " uu___5 in - FStarC_Compiler_Util.print1 ">> Expecting errors: [%s]\n" - uu___4 + FStarC_List.map FStarC_Util.string_of_int + expected_errors in + FStarC_String.concat "; " uu___5 in + FStarC_Util.print1 ">> Expecting errors: [%s]\n" uu___4 else ()); (let uu___3 = FStarC_Errors.catch_errors @@ -2257,33 +2239,30 @@ let (tc_decl' : (fun uu___5 -> let uu___6 = let uu___7 = - FStarC_Compiler_Effect.op_Bang tc_decls_knot in - FStarC_Compiler_Util.must uu___7 in + FStarC_Effect.op_Bang tc_decls_knot in + FStarC_Util.must uu___7 in uu___6 env'1 ses)) in match uu___3 with | (errs, uu___4) -> ((let uu___6 = (FStarC_Options.print_expected_failures ()) || - (FStarC_Compiler_Debug.low ()) in + (FStarC_Debug.low ()) in if uu___6 then - (FStarC_Compiler_Util.print_string - ">> Got issues: [\n"; - FStarC_Compiler_List.iter FStarC_Errors.print_issue - errs; - FStarC_Compiler_Util.print_string ">>]\n") + (FStarC_Util.print_string ">> Got issues: [\n"; + FStarC_List.iter FStarC_Errors.print_issue errs; + FStarC_Util.print_string ">>]\n") else ()); (let uu___6 = FStarC_TypeChecker_Env.pop env'1 "expect_failure" in let actual_errors = - FStarC_Compiler_List.concatMap + FStarC_List.concatMap (fun i -> FStarC_Common.list_of_option i.FStarC_Errors.issue_number) errs in (match errs with | [] -> - (FStarC_Compiler_List.iter - FStarC_Errors.print_issue errs; + (FStarC_List.iter FStarC_Errors.print_issue errs; (let uu___9 = let uu___10 = FStarC_Errors_Msg.text @@ -2304,7 +2283,7 @@ let (tc_decl' : (match uu___9 with | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some (e, n1, n2) -> - (FStarC_Compiler_List.iter + (FStarC_List.iter FStarC_Errors.print_issue errs; (let uu___11 = let uu___12 = @@ -2352,7 +2331,7 @@ let (tc_decl' : FStarC_Class_Show.show FStarC_Class_Show.showable_int n1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Error #%s was raised %s times, instead of %s." uu___16 uu___17 uu___18 in FStarC_Errors_Msg.text uu___15 in @@ -2504,8 +2483,8 @@ let (tc_decl' : uu___5 in FStarC_Syntax_Util.ses_of_sigbundle uu___4 in (let uu___5 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___5 then let uu___6 = @@ -2531,8 +2510,8 @@ let (tc_decl' : FStarC_Syntax_Syntax.sigopts = (se2.FStarC_Syntax_Syntax.sigopts) } in - FStarC_Compiler_Util.print1 - "Inductive after phase 1: %s\n" uu___6 + FStarC_Util.print1 "Inductive after phase 1: %s\n" + uu___6 else ()); ses2) else ses in @@ -2623,7 +2602,7 @@ let (tc_decl' : (se2.FStarC_Syntax_Syntax.sigopts) }] in let effect_and_lift_ses1 = - FStarC_Compiler_List.map + FStarC_List.map (fun sigelt -> { FStarC_Syntax_Syntax.sigel = @@ -2658,8 +2637,7 @@ let (tc_decl' : FStarC_Syntax_Syntax.sigopts = (sigelt.FStarC_Syntax_Syntax.sigopts) }) effect_and_lift_ses in - ([], - (FStarC_Compiler_List.op_At ses effect_and_lift_ses1), + ([], (FStarC_List.op_At ses effect_and_lift_ses1), env0)) else (let ne1 = @@ -2816,8 +2794,8 @@ let (tc_decl' : uu___6 in FStarC_Syntax_Util.eff_decl_of_new_effect uu___5 in (let uu___6 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___6 then let uu___7 = @@ -2841,7 +2819,7 @@ let (tc_decl' : FStarC_Syntax_Syntax.sigopts = (se2.FStarC_Syntax_Syntax.sigopts) } in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Effect decl after phase 1: %s\n" uu___7 else ()); ne2) @@ -3089,14 +3067,14 @@ let (tc_decl' : } in ([se3], [], env0))) | FStarC_Syntax_Syntax.Sig_declare_typ uu___2 when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.OnlyName -> true | uu___4 -> false) se2.FStarC_Syntax_Syntax.sigquals -> ([], [], env0) | FStarC_Syntax_Syntax.Sig_let uu___2 when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | FStarC_Syntax_Syntax.OnlyName -> true @@ -3116,7 +3094,7 @@ let (tc_decl' : let uu___7 = FStarC_Class_Show.show FStarC_Ident.showable_lident lid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Top-level declaration %s for a name that is already used in this module." uu___7 in FStarC_Errors_Msg.text uu___6 in @@ -3253,9 +3231,8 @@ let (tc_decl' : match uu___6 with | (uvs1, t1) -> ((let uu___8 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang - dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___8 then let uu___9 = @@ -3265,7 +3242,7 @@ let (tc_decl' : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Ident.showable_ident) uvs1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Val declaration after phase 1: %s and uvs: %s\n" uu___9 uu___10 else ()); @@ -3306,7 +3283,7 @@ let (tc_decl' : -> (if Prims.op_Negation - (FStarC_Compiler_List.contains + (FStarC_List.contains FStarC_Syntax_Syntax.InternalAssumption se2.FStarC_Syntax_Syntax.sigquals) then @@ -3314,7 +3291,7 @@ let (tc_decl' : let uu___4 = FStarC_Class_Show.show FStarC_Ident.showable_lident lid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Admitting a top-level assumption %s" uu___4 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range r @@ -3442,9 +3419,8 @@ let (tc_decl' : match uu___6 with | (uvs1, t1) -> ((let uu___8 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang - dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___8 then let uu___9 = @@ -3454,7 +3430,7 @@ let (tc_decl' : FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Ident.showable_ident) uvs1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Assume after phase 1: %s and uvs: %s\n" uu___9 uu___10 else ()); @@ -3493,7 +3469,7 @@ let (tc_decl' : FStarC_Syntax_Syntax.lids2 = lids; FStarC_Syntax_Syntax.tac = t;_} -> - ((let uu___3 = FStarC_Compiler_Debug.any () in + ((let uu___3 = FStarC_Debug.any () in if uu___3 then let uu___4 = @@ -3502,8 +3478,8 @@ let (tc_decl' : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - let uu___6 = FStarC_Compiler_Util.string_of_bool is_typed in - FStarC_Compiler_Util.print3 + let uu___6 = FStarC_Util.string_of_bool is_typed in + FStarC_Util.print3 "%s: Found splice of (%s) with is_typed: %s\n" uu___4 uu___5 uu___6 else ()); @@ -3517,7 +3493,7 @@ let (tc_decl' : match se2.FStarC_Syntax_Syntax.sigquals with | [] -> [FStarC_Syntax_Syntax.Visible_default] | qs -> qs in - FStarC_Compiler_List.map + FStarC_List.map (fun sp -> { FStarC_Syntax_Syntax.sigel = @@ -3525,12 +3501,12 @@ let (tc_decl' : FStarC_Syntax_Syntax.sigrng = (sp.FStarC_Syntax_Syntax.sigrng); FStarC_Syntax_Syntax.sigquals = - (FStarC_Compiler_List.op_At sigquals + (FStarC_List.op_At sigquals sp.FStarC_Syntax_Syntax.sigquals); FStarC_Syntax_Syntax.sigmeta = (sp.FStarC_Syntax_Syntax.sigmeta); FStarC_Syntax_Syntax.sigattrs = - (FStarC_Compiler_List.op_At + (FStarC_List.op_At se2.FStarC_Syntax_Syntax.sigattrs sp.FStarC_Syntax_Syntax.sigattrs); FStarC_Syntax_Syntax.sigopens_and_abbrevs = @@ -3540,7 +3516,7 @@ let (tc_decl' : }) ses else ses in let ses2 = - FStarC_Compiler_List.map + FStarC_List.map (fun se3 -> if env.FStarC_TypeChecker_Env.is_iface && @@ -3549,7 +3525,7 @@ let (tc_decl' : then let uu___3 = let uu___4 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun q -> q <> FStarC_Syntax_Syntax.Irreducible) se3.FStarC_Syntax_Syntax.sigquals in @@ -3571,7 +3547,7 @@ let (tc_decl' : } else se3) ses1 in let ses3 = - FStarC_Compiler_List.map + FStarC_List.map (fun se3 -> { FStarC_Syntax_Syntax.sigel = @@ -3603,7 +3579,7 @@ let (tc_decl' : (se3.FStarC_Syntax_Syntax.sigopts) }) ses2 in let dsenv = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left FStarC_Syntax_DsEnv.push_sigelt_force env.FStarC_TypeChecker_Env.dsenv ses3 in let env1 = @@ -3713,17 +3689,17 @@ let (tc_decl' : FStarC_TypeChecker_Env.missing_decl = (env.FStarC_TypeChecker_Env.missing_decl) } in - (let uu___4 = FStarC_Compiler_Debug.low () in + (let uu___4 = FStarC_Debug.low () in if uu___4 then let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt) ses3 in - FStarC_Compiler_String.concat "\n" uu___6 in - FStarC_Compiler_Util.print1 - "Splice returned sigelts {\n%s\n}\n" uu___5 + FStarC_String.concat "\n" uu___6 in + FStarC_Util.print1 "Splice returned sigelts {\n%s\n}\n" + uu___5 else ()); ([], ses3, env1))) | FStarC_Syntax_Syntax.Sig_let @@ -3916,9 +3892,8 @@ let (tc_decl' : match uu___6 with | (t2, ty) -> ((let uu___8 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang - dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___8 then let uu___9 = @@ -3950,7 +3925,7 @@ let (tc_decl' : FStarC_Syntax_Syntax.sigopts = (se2.FStarC_Syntax_Syntax.sigopts) } in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Polymonadic bind after phase 1: %s\n" uu___9 else ()); @@ -4162,9 +4137,8 @@ let (tc_decl' : match uu___6 with | (t2, ty) -> ((let uu___8 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang - dbg_TwoPhases) in + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_TwoPhases) in if uu___8 then let uu___9 = @@ -4195,7 +4169,7 @@ let (tc_decl' : FStarC_Syntax_Syntax.sigopts = (se2.FStarC_Syntax_Syntax.sigopts) } in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Polymonadic subcomp after phase 1: %s\n" uu___9 else ()); @@ -4352,13 +4326,13 @@ let (tc_decl : (env1.FStarC_TypeChecker_Env.missing_decl) } else env1 in - (let uu___2 = FStarC_Compiler_Debug.any () in + (let uu___2 = FStarC_Debug.any () in if uu___2 then let uu___3 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.print1 "Processing %s\n" uu___3 + FStarC_Util.print1 "Processing %s\n" uu___3 else ()); - (let uu___3 = FStarC_Compiler_Debug.medium () in + (let uu___3 = FStarC_Debug.medium () in if uu___3 then let uu___4 = @@ -4366,8 +4340,8 @@ let (tc_decl : env2.FStarC_TypeChecker_Env.admit in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt se in - FStarC_Compiler_Util.print2 ">>>>>>>>>>>>>>tc_decl admit=%s %s\n" - uu___4 uu___5 + FStarC_Util.print2 ">>>>>>>>>>>>>>tc_decl admit=%s %s\n" uu___4 + uu___5 else ()); (let result = if @@ -4490,7 +4464,7 @@ let (tc_decl : (let uu___4 = result in match uu___4 with | (ses, uu___5, uu___6) -> - FStarC_Compiler_List.iter + FStarC_List.iter (FStarC_TypeChecker_Quals.check_sigelt_quals_post env2) ses); (match () with | () -> @@ -4614,14 +4588,14 @@ let (add_sigelt_to_env : fun env -> fun se -> fun from_cache -> - (let uu___1 = FStarC_Compiler_Debug.low () in + (let uu___1 = FStarC_Debug.low () in if uu___1 then let uu___2 = FStarC_Syntax_Print.sigelt_to_string_short se in let uu___3 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool from_cache in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 ">>>>>>>>>>>>>>Adding top-level decl to environment: %s (from_cache:%s)\n" uu___2 uu___3 else ()); @@ -4631,7 +4605,7 @@ let (add_sigelt_to_env : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt se in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "add_sigelt_to_env: unexpected bare type/data constructor: %s" uu___3 in FStarC_Errors.raise_error FStarC_Syntax_Syntax.has_range_sigelt @@ -4643,7 +4617,7 @@ let (add_sigelt_to_env : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt se in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "add_sigelt_to_env: unexpected bare type/data constructor: %s" uu___3 in FStarC_Errors.raise_error FStarC_Syntax_Syntax.has_range_sigelt @@ -4651,14 +4625,14 @@ let (add_sigelt_to_env : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___2) | FStarC_Syntax_Syntax.Sig_declare_typ uu___1 when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.OnlyName -> true | uu___3 -> false) se.FStarC_Syntax_Syntax.sigquals -> env | FStarC_Syntax_Syntax.Sig_let uu___1 when - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.OnlyName -> true @@ -5143,13 +5117,13 @@ let (add_sigelt_to_env : (FStarC_Syntax_Syntax.PrintEffectsGraph) -> ((let uu___3 = FStarC_TypeChecker_Env.print_effects_graph env1 in - FStarC_Compiler_Util.write_file "effects.graph" uu___3); + FStarC_Util.write_file "effects.graph" uu___3); env1) | FStarC_Syntax_Syntax.Sig_new_effect ne -> let env2 = FStarC_TypeChecker_Env.push_new_effect env1 (ne, (se.FStarC_Syntax_Syntax.sigquals)) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env3 -> fun a -> let uu___2 = @@ -5169,7 +5143,7 @@ let (add_sigelt_to_env : FStarC_Syntax_Syntax.typ = ty; FStarC_Syntax_Syntax.kind1 = k;_} -> - let uu___3 = FStarC_Compiler_Util.must k in + let uu___3 = FStarC_Util.must k in FStarC_TypeChecker_Util.update_env_polymonadic_bind env1 m n p ty uu___3 | FStarC_Syntax_Syntax.Sig_polymonadic_subcomp @@ -5180,7 +5154,7 @@ let (add_sigelt_to_env : FStarC_Syntax_Syntax.kind2 = k;_} -> let uu___3 = - let uu___4 = FStarC_Compiler_Util.must k in (ty, uu___4) in + let uu___4 = FStarC_Util.must k in (ty, uu___4) in FStarC_TypeChecker_Env.add_polymonadic_subcomp env1 m n uu___3 | uu___2 -> env1)) @@ -5216,16 +5190,15 @@ let (tc_decls : let rec process_one_decl uu___ se = match uu___ with | (ses1, env1) -> - (FStarC_Compiler_Effect.op_Colon_Equals - FStarC_Errors.fallback_range + (FStarC_Effect.op_Colon_Equals FStarC_Errors.fallback_range (FStar_Pervasives_Native.Some (se.FStarC_Syntax_Syntax.sigrng)); (let uu___2 = env1.FStarC_TypeChecker_Env.flychecking && - (FStarC_Compiler_Debug.any ()) in + (FStarC_Debug.any ()) in if uu___2 then ((ses1, env1), []) else - ((let uu___5 = FStarC_Compiler_Debug.low () in + ((let uu___5 = FStarC_Debug.low () in if uu___5 then let uu___6 = @@ -5233,7 +5206,7 @@ let (tc_decls : FStarC_Syntax_Syntax.tagged_sigelt se in let uu___7 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 ">>>>>>>>>>>>>>Checking top-level %s decl %s\n" uu___6 uu___7 else ()); @@ -5241,7 +5214,7 @@ let (tc_decls : if uu___6 then FStarC_TypeChecker_Env.toggle_id_info env1 false else ()); - (let uu___7 = FStarC_Compiler_Effect.op_Bang dbg_IdInfoOn in + (let uu___7 = FStarC_Effect.op_Bang dbg_IdInfoOn in if uu___7 then FStarC_TypeChecker_Env.toggle_id_info env1 true else ()); @@ -5249,7 +5222,7 @@ let (tc_decls : let uu___8 = let uu___9 = FStarC_Syntax_Print.sigelt_to_string_short se in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "While typechecking the %stop-level declaration `%s`" (if (se.FStarC_Syntax_Syntax.sigmeta).FStarC_Syntax_Syntax.sigmeta_spliced @@ -5260,31 +5233,29 @@ let (tc_decls : match uu___7 with | (ses', ses_elaborated, env2) -> let ses'1 = - FStarC_Compiler_List.map + FStarC_List.map (fun se1 -> - (let uu___9 = - FStarC_Compiler_Effect.op_Bang dbg_UF in + (let uu___9 = FStarC_Effect.op_Bang dbg_UF in if uu___9 then let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt se1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "About to elim vars from %s\n" uu___10 else ()); FStarC_TypeChecker_Normalize.elim_uvars env2 se1) ses' in let ses_elaborated1 = - FStarC_Compiler_List.map + FStarC_List.map (fun se1 -> - (let uu___9 = - FStarC_Compiler_Effect.op_Bang dbg_UF in + (let uu___9 = FStarC_Effect.op_Bang dbg_UF in if uu___9 then let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt se1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "About to elim vars from (elaborated) %s\n" uu___10 else ()); @@ -5293,27 +5264,26 @@ let (tc_decls : (FStarC_TypeChecker_Env.promote_id_info env2 (compress_and_norm env2); (let ses'2 = - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Syntax_Compress.deep_compress_se false false) ses'1 in let env3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env4 -> fun se1 -> add_sigelt_to_env env4 se1 false) env2 ses'2 in FStarC_Syntax_Unionfind.reset (); (let uu___11 = ((FStarC_Options.log_types ()) || - (FStarC_Compiler_Debug.medium ())) - || (FStarC_Compiler_Effect.op_Bang dbg_LogTypes) in + (FStarC_Debug.medium ())) + || (FStarC_Effect.op_Bang dbg_LogTypes) in if uu___11 then let uu___12 = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_sigelt) ses'2 in - FStarC_Compiler_Util.print1 "Checked: %s\n" - uu___12 + FStarC_Util.print1 "Checked: %s\n" uu___12 else ()); (let uu___12 = let uu___13 = @@ -5323,12 +5293,16 @@ let (tc_decls : FStar_Pervasives_Native.Some uu___13 in FStarC_Profiling.profile (fun uu___13 -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun se1 -> (env3.FStarC_TypeChecker_Env.solver).FStarC_TypeChecker_Env.encode_sig env3 se1) ses'2) uu___12 "FStarC.TypeChecker.Tc.encode_sig"); - (((FStarC_Compiler_List.rev_append ses'2 ses1), env3), + (let uu___13 = FStarC_Options.interactive () in + if uu___13 + then FStarC_SMTEncoding_Solver.flush_hints () + else ()); + (((FStarC_List.rev_append ses'2 ses1), env3), ses_elaborated1))))))) in let process_one_decl_timed acc se = FStarC_TypeChecker_Core.clear_memo_table (); @@ -5350,23 +5324,23 @@ let (tc_decls : if uu___4 then let tag = - match FStarC_Syntax_Util.lids_of_sigelt se with - | hd::uu___5 -> FStarC_Ident.string_of_lid hd - | uu___5 -> - FStarC_Compiler_Range_Ops.string_of_range - (FStarC_Syntax_Util.range_of_sigelt se) in + let uu___5 = FStarC_Syntax_Util.lids_of_sigelt se in + match uu___5 with + | hd::uu___6 -> FStarC_Ident.string_of_lid hd + | uu___6 -> + let uu___7 = FStarC_Syntax_Util.range_of_sigelt se in + FStarC_Range_Ops.string_of_range uu___7 in FStarC_Profiling.report_and_clear tag else ()); r)) in let uu___ = FStarC_Syntax_Unionfind.with_uf_enabled (fun uu___1 -> - FStarC_Compiler_Util.fold_flatten process_one_decl_timed - ([], env) ses) in + FStarC_Util.fold_flatten process_one_decl_timed ([], env) ses) in match uu___ with - | (ses1, env1) -> ((FStarC_Compiler_List.rev_append ses1 []), env1) + | (ses1, env1) -> ((FStarC_List.rev_append ses1 []), env1) let (uu___0 : unit) = - FStarC_Compiler_Effect.op_Colon_Equals tc_decls_knot + FStarC_Effect.op_Colon_Equals tc_decls_knot (FStar_Pervasives_Native.Some tc_decls) let (snapshot_context : FStarC_TypeChecker_Env.env -> @@ -5376,7 +5350,7 @@ let (snapshot_context : = fun env -> fun msg -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> FStarC_TypeChecker_Env.snapshot env msg) let (rollback_context : FStarC_TypeChecker_Env.solver_t -> @@ -5388,7 +5362,7 @@ let (rollback_context : fun solver -> fun msg -> fun depth -> - FStarC_Compiler_Util.atomically + FStarC_Util.atomically (fun uu___ -> let env = FStarC_TypeChecker_Env.rollback solver msg depth in env) @@ -5420,161 +5394,162 @@ let (tc_partial_modul : if modul.FStarC_Syntax_Syntax.is_interface then "interface" else "implementation" in - (let uu___1 = FStarC_Compiler_Debug.any () in + (let uu___1 = FStarC_Debug.any () in if uu___1 then let uu___2 = FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.print3 "Now %s %s of %s\n" action label uu___2 - else ()); - FStarC_Compiler_Debug.disable_all (); - (let uu___3 = - let uu___4 = - FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in - FStarC_Options.should_check uu___4 in - if uu___3 - then - let uu___4 = FStarC_Options.debug_keys () in - FStarC_Compiler_Debug.enable_toggles uu___4 + FStarC_Util.print3 "Now %s %s of %s\n" action label uu___2 else ()); - (let name = - let uu___3 = - FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.format2 "%s %s" - (if modul.FStarC_Syntax_Syntax.is_interface - then "interface" - else "module") uu___3 in - let env1 = - { - FStarC_TypeChecker_Env.solver = - (env.FStarC_TypeChecker_Env.solver); - FStarC_TypeChecker_Env.range = (env.FStarC_TypeChecker_Env.range); - FStarC_TypeChecker_Env.curmodule = - (env.FStarC_TypeChecker_Env.curmodule); - FStarC_TypeChecker_Env.gamma = (env.FStarC_TypeChecker_Env.gamma); - FStarC_TypeChecker_Env.gamma_sig = - (env.FStarC_TypeChecker_Env.gamma_sig); - FStarC_TypeChecker_Env.gamma_cache = - (env.FStarC_TypeChecker_Env.gamma_cache); - FStarC_TypeChecker_Env.modules = - (env.FStarC_TypeChecker_Env.modules); - FStarC_TypeChecker_Env.expected_typ = - (env.FStarC_TypeChecker_Env.expected_typ); - FStarC_TypeChecker_Env.sigtab = - (env.FStarC_TypeChecker_Env.sigtab); - FStarC_TypeChecker_Env.attrtab = - (env.FStarC_TypeChecker_Env.attrtab); - FStarC_TypeChecker_Env.instantiate_imp = - (env.FStarC_TypeChecker_Env.instantiate_imp); - FStarC_TypeChecker_Env.effects = - (env.FStarC_TypeChecker_Env.effects); - FStarC_TypeChecker_Env.generalize = - (env.FStarC_TypeChecker_Env.generalize); - FStarC_TypeChecker_Env.letrecs = - (env.FStarC_TypeChecker_Env.letrecs); - FStarC_TypeChecker_Env.top_level = - (env.FStarC_TypeChecker_Env.top_level); - FStarC_TypeChecker_Env.check_uvars = - (env.FStarC_TypeChecker_Env.check_uvars); - FStarC_TypeChecker_Env.use_eq_strict = - (env.FStarC_TypeChecker_Env.use_eq_strict); - FStarC_TypeChecker_Env.is_iface = - (modul.FStarC_Syntax_Syntax.is_interface); - FStarC_TypeChecker_Env.admit = (Prims.op_Negation verify); - FStarC_TypeChecker_Env.lax_universes = - (env.FStarC_TypeChecker_Env.lax_universes); - FStarC_TypeChecker_Env.phase1 = - (env.FStarC_TypeChecker_Env.phase1); - FStarC_TypeChecker_Env.failhard = - (env.FStarC_TypeChecker_Env.failhard); - FStarC_TypeChecker_Env.flychecking = - (env.FStarC_TypeChecker_Env.flychecking); - FStarC_TypeChecker_Env.uvar_subtyping = - (env.FStarC_TypeChecker_Env.uvar_subtyping); - FStarC_TypeChecker_Env.intactics = - (env.FStarC_TypeChecker_Env.intactics); - FStarC_TypeChecker_Env.nocoerce = - (env.FStarC_TypeChecker_Env.nocoerce); - FStarC_TypeChecker_Env.tc_term = - (env.FStarC_TypeChecker_Env.tc_term); - FStarC_TypeChecker_Env.typeof_tot_or_gtot_term = - (env.FStarC_TypeChecker_Env.typeof_tot_or_gtot_term); - FStarC_TypeChecker_Env.universe_of = - (env.FStarC_TypeChecker_Env.universe_of); - FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term = - (env.FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); - FStarC_TypeChecker_Env.teq_nosmt_force = - (env.FStarC_TypeChecker_Env.teq_nosmt_force); - FStarC_TypeChecker_Env.subtype_nosmt_force = - (env.FStarC_TypeChecker_Env.subtype_nosmt_force); - FStarC_TypeChecker_Env.qtbl_name_and_index = - (env.FStarC_TypeChecker_Env.qtbl_name_and_index); - FStarC_TypeChecker_Env.normalized_eff_names = - (env.FStarC_TypeChecker_Env.normalized_eff_names); - FStarC_TypeChecker_Env.fv_delta_depths = - (env.FStarC_TypeChecker_Env.fv_delta_depths); - FStarC_TypeChecker_Env.proof_ns = - (env.FStarC_TypeChecker_Env.proof_ns); - FStarC_TypeChecker_Env.synth_hook = - (env.FStarC_TypeChecker_Env.synth_hook); - FStarC_TypeChecker_Env.try_solve_implicits_hook = - (env.FStarC_TypeChecker_Env.try_solve_implicits_hook); - FStarC_TypeChecker_Env.splice = - (env.FStarC_TypeChecker_Env.splice); - FStarC_TypeChecker_Env.mpreprocess = - (env.FStarC_TypeChecker_Env.mpreprocess); - FStarC_TypeChecker_Env.postprocess = - (env.FStarC_TypeChecker_Env.postprocess); - FStarC_TypeChecker_Env.identifier_info = - (env.FStarC_TypeChecker_Env.identifier_info); - FStarC_TypeChecker_Env.tc_hooks = - (env.FStarC_TypeChecker_Env.tc_hooks); - FStarC_TypeChecker_Env.dsenv = (env.FStarC_TypeChecker_Env.dsenv); - FStarC_TypeChecker_Env.nbe = (env.FStarC_TypeChecker_Env.nbe); - FStarC_TypeChecker_Env.strict_args_tab = - (env.FStarC_TypeChecker_Env.strict_args_tab); - FStarC_TypeChecker_Env.erasable_types_tab = - (env.FStarC_TypeChecker_Env.erasable_types_tab); - FStarC_TypeChecker_Env.enable_defer_to_tac = - (env.FStarC_TypeChecker_Env.enable_defer_to_tac); - FStarC_TypeChecker_Env.unif_allow_ref_guards = - (env.FStarC_TypeChecker_Env.unif_allow_ref_guards); - FStarC_TypeChecker_Env.erase_erasable_args = - (env.FStarC_TypeChecker_Env.erase_erasable_args); - FStarC_TypeChecker_Env.core_check = - (env.FStarC_TypeChecker_Env.core_check); - FStarC_TypeChecker_Env.missing_decl = - (env.FStarC_TypeChecker_Env.missing_decl) - } in - let env2 = - FStarC_TypeChecker_Env.set_current_module env1 - modul.FStarC_Syntax_Syntax.name in - let uu___3 = - let uu___4 = - let uu___5 = - FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in - FStarC_Options.should_check uu___5 in - Prims.op_Negation uu___4 in - let uu___4 = - let uu___5 = - FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.format2 "While loading dependency %s%s" uu___5 - (if modul.FStarC_Syntax_Syntax.is_interface - then " (interface)" - else "") in - FStarC_Errors.with_ctx_if uu___3 uu___4 - (fun uu___5 -> - let uu___6 = - tc_decls env2 modul.FStarC_Syntax_Syntax.declarations in - match uu___6 with - | (ses, env3) -> - ({ - FStarC_Syntax_Syntax.name = - (modul.FStarC_Syntax_Syntax.name); - FStarC_Syntax_Syntax.declarations = ses; - FStarC_Syntax_Syntax.is_interface = - (modul.FStarC_Syntax_Syntax.is_interface) - }, env3))) + (let dsnap = FStarC_Debug.snapshot () in + (let uu___2 = + (let uu___3 = + let uu___4 = + FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in + FStarC_Options.should_check uu___4 in + Prims.op_Negation uu___3) && + (let uu___3 = FStarC_Options.debug_all_modules () in + Prims.op_Negation uu___3) in + if uu___2 then FStarC_Debug.disable_all () else ()); + (let name = + let uu___2 = + FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in + FStarC_Util.format2 "%s %s" + (if modul.FStarC_Syntax_Syntax.is_interface + then "interface" + else "module") uu___2 in + let env1 = + { + FStarC_TypeChecker_Env.solver = + (env.FStarC_TypeChecker_Env.solver); + FStarC_TypeChecker_Env.range = (env.FStarC_TypeChecker_Env.range); + FStarC_TypeChecker_Env.curmodule = + (env.FStarC_TypeChecker_Env.curmodule); + FStarC_TypeChecker_Env.gamma = (env.FStarC_TypeChecker_Env.gamma); + FStarC_TypeChecker_Env.gamma_sig = + (env.FStarC_TypeChecker_Env.gamma_sig); + FStarC_TypeChecker_Env.gamma_cache = + (env.FStarC_TypeChecker_Env.gamma_cache); + FStarC_TypeChecker_Env.modules = + (env.FStarC_TypeChecker_Env.modules); + FStarC_TypeChecker_Env.expected_typ = + (env.FStarC_TypeChecker_Env.expected_typ); + FStarC_TypeChecker_Env.sigtab = + (env.FStarC_TypeChecker_Env.sigtab); + FStarC_TypeChecker_Env.attrtab = + (env.FStarC_TypeChecker_Env.attrtab); + FStarC_TypeChecker_Env.instantiate_imp = + (env.FStarC_TypeChecker_Env.instantiate_imp); + FStarC_TypeChecker_Env.effects = + (env.FStarC_TypeChecker_Env.effects); + FStarC_TypeChecker_Env.generalize = + (env.FStarC_TypeChecker_Env.generalize); + FStarC_TypeChecker_Env.letrecs = + (env.FStarC_TypeChecker_Env.letrecs); + FStarC_TypeChecker_Env.top_level = + (env.FStarC_TypeChecker_Env.top_level); + FStarC_TypeChecker_Env.check_uvars = + (env.FStarC_TypeChecker_Env.check_uvars); + FStarC_TypeChecker_Env.use_eq_strict = + (env.FStarC_TypeChecker_Env.use_eq_strict); + FStarC_TypeChecker_Env.is_iface = + (modul.FStarC_Syntax_Syntax.is_interface); + FStarC_TypeChecker_Env.admit = (Prims.op_Negation verify); + FStarC_TypeChecker_Env.lax_universes = + (env.FStarC_TypeChecker_Env.lax_universes); + FStarC_TypeChecker_Env.phase1 = + (env.FStarC_TypeChecker_Env.phase1); + FStarC_TypeChecker_Env.failhard = + (env.FStarC_TypeChecker_Env.failhard); + FStarC_TypeChecker_Env.flychecking = + (env.FStarC_TypeChecker_Env.flychecking); + FStarC_TypeChecker_Env.uvar_subtyping = + (env.FStarC_TypeChecker_Env.uvar_subtyping); + FStarC_TypeChecker_Env.intactics = + (env.FStarC_TypeChecker_Env.intactics); + FStarC_TypeChecker_Env.nocoerce = + (env.FStarC_TypeChecker_Env.nocoerce); + FStarC_TypeChecker_Env.tc_term = + (env.FStarC_TypeChecker_Env.tc_term); + FStarC_TypeChecker_Env.typeof_tot_or_gtot_term = + (env.FStarC_TypeChecker_Env.typeof_tot_or_gtot_term); + FStarC_TypeChecker_Env.universe_of = + (env.FStarC_TypeChecker_Env.universe_of); + FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term = + (env.FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); + FStarC_TypeChecker_Env.teq_nosmt_force = + (env.FStarC_TypeChecker_Env.teq_nosmt_force); + FStarC_TypeChecker_Env.subtype_nosmt_force = + (env.FStarC_TypeChecker_Env.subtype_nosmt_force); + FStarC_TypeChecker_Env.qtbl_name_and_index = + (env.FStarC_TypeChecker_Env.qtbl_name_and_index); + FStarC_TypeChecker_Env.normalized_eff_names = + (env.FStarC_TypeChecker_Env.normalized_eff_names); + FStarC_TypeChecker_Env.fv_delta_depths = + (env.FStarC_TypeChecker_Env.fv_delta_depths); + FStarC_TypeChecker_Env.proof_ns = + (env.FStarC_TypeChecker_Env.proof_ns); + FStarC_TypeChecker_Env.synth_hook = + (env.FStarC_TypeChecker_Env.synth_hook); + FStarC_TypeChecker_Env.try_solve_implicits_hook = + (env.FStarC_TypeChecker_Env.try_solve_implicits_hook); + FStarC_TypeChecker_Env.splice = + (env.FStarC_TypeChecker_Env.splice); + FStarC_TypeChecker_Env.mpreprocess = + (env.FStarC_TypeChecker_Env.mpreprocess); + FStarC_TypeChecker_Env.postprocess = + (env.FStarC_TypeChecker_Env.postprocess); + FStarC_TypeChecker_Env.identifier_info = + (env.FStarC_TypeChecker_Env.identifier_info); + FStarC_TypeChecker_Env.tc_hooks = + (env.FStarC_TypeChecker_Env.tc_hooks); + FStarC_TypeChecker_Env.dsenv = (env.FStarC_TypeChecker_Env.dsenv); + FStarC_TypeChecker_Env.nbe = (env.FStarC_TypeChecker_Env.nbe); + FStarC_TypeChecker_Env.strict_args_tab = + (env.FStarC_TypeChecker_Env.strict_args_tab); + FStarC_TypeChecker_Env.erasable_types_tab = + (env.FStarC_TypeChecker_Env.erasable_types_tab); + FStarC_TypeChecker_Env.enable_defer_to_tac = + (env.FStarC_TypeChecker_Env.enable_defer_to_tac); + FStarC_TypeChecker_Env.unif_allow_ref_guards = + (env.FStarC_TypeChecker_Env.unif_allow_ref_guards); + FStarC_TypeChecker_Env.erase_erasable_args = + (env.FStarC_TypeChecker_Env.erase_erasable_args); + FStarC_TypeChecker_Env.core_check = + (env.FStarC_TypeChecker_Env.core_check); + FStarC_TypeChecker_Env.missing_decl = + (env.FStarC_TypeChecker_Env.missing_decl) + } in + let env2 = + FStarC_TypeChecker_Env.set_current_module env1 + modul.FStarC_Syntax_Syntax.name in + let uu___2 = + let uu___3 = + let uu___4 = + FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in + FStarC_Options.should_check uu___4 in + Prims.op_Negation uu___3 in + let uu___3 = + let uu___4 = + FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in + FStarC_Util.format2 "While loading dependency %s%s" uu___4 + (if modul.FStarC_Syntax_Syntax.is_interface + then " (interface)" + else "") in + FStarC_Errors.with_ctx_if uu___2 uu___3 + (fun uu___4 -> + let uu___5 = + tc_decls env2 modul.FStarC_Syntax_Syntax.declarations in + match uu___5 with + | (ses, env3) -> + (FStarC_Debug.restore dsnap; + ({ + FStarC_Syntax_Syntax.name = + (modul.FStarC_Syntax_Syntax.name); + FStarC_Syntax_Syntax.declarations = ses; + FStarC_Syntax_Syntax.is_interface = + (modul.FStarC_Syntax_Syntax.is_interface) + }, env3))))) let (tc_more_partial_modul : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.modul -> @@ -5592,8 +5567,8 @@ let (tc_more_partial_modul : { FStarC_Syntax_Syntax.name = (modul.FStarC_Syntax_Syntax.name); FStarC_Syntax_Syntax.declarations = - (FStarC_Compiler_List.op_At - modul.FStarC_Syntax_Syntax.declarations ses); + (FStarC_List.op_At modul.FStarC_Syntax_Syntax.declarations + ses); FStarC_Syntax_Syntax.is_interface = (modul.FStarC_Syntax_Syntax.is_interface) } in @@ -5622,7 +5597,7 @@ let (finish_partial_modul : let uu___5 = FStarC_Ident.string_of_lid m.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Missing definitions in module %s:" uu___5 in FStarC_Errors_Msg.text uu___4 in let uu___4 = @@ -5640,7 +5615,7 @@ let (finish_partial_modul : (Obj.magic uu___1) else ()) else (); - FStarC_Compiler_Util.smap_clear + FStarC_Util.smap_clear (FStar_Pervasives_Native.snd env.FStarC_TypeChecker_Env.qtbl_name_and_index); (let uu___3 = @@ -5674,8 +5649,7 @@ let (deep_compress_modul : FStarC_Syntax_Syntax.modul -> FStarC_Syntax_Syntax.modul) = fun m -> let uu___ = - FStarC_Compiler_List.map - (FStarC_Syntax_Compress.deep_compress_se false false) + FStarC_List.map (FStarC_Syntax_Compress.deep_compress_se false false) m.FStarC_Syntax_Syntax.declarations in { FStarC_Syntax_Syntax.name = (m.FStarC_Syntax_Syntax.name); @@ -5713,12 +5687,12 @@ let (load_checked_module_sigelts : Prims.strcat "Internals for " uu___1 in push_context env uu___ in let env2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env3 -> fun se -> let env4 = add_sigelt_to_env env3 se true in let lids = FStarC_Syntax_Util.lids_of_sigelt se in - FStarC_Compiler_List.iter + FStarC_List.iter (fun lid -> let uu___1 = FStarC_TypeChecker_Env.lookup_sigelt env4 lid in @@ -5731,19 +5705,21 @@ let (load_checked_module : = fun en -> fun m -> + let dsnap = FStarC_Debug.snapshot () in (let uu___1 = - (let uu___2 = FStarC_Ident.string_of_lid m.FStarC_Syntax_Syntax.name in - FStarC_Options.should_check uu___2) || - (FStarC_Options.debug_all_modules ()) in - if uu___1 - then - let uu___2 = FStarC_Options.debug_keys () in - FStarC_Compiler_Debug.enable_toggles uu___2 - else FStarC_Compiler_Debug.disable_all ()); + (let uu___2 = + let uu___3 = + FStarC_Ident.string_of_lid m.FStarC_Syntax_Syntax.name in + FStarC_Options.should_check uu___3 in + Prims.op_Negation uu___2) && + (let uu___2 = FStarC_Options.debug_all_modules () in + Prims.op_Negation uu___2) in + if uu___1 then FStarC_Debug.disable_all () else ()); (let m1 = deep_compress_modul m in let env = load_checked_module_sigelts en m1 in let uu___1 = finish_partial_modul true true env m1 in - match uu___1 with | (uu___2, env1) -> env1) + match uu___1 with + | (uu___2, env1) -> (FStarC_Debug.restore dsnap; env1)) let (load_partial_checked_module : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.modul -> FStarC_TypeChecker_Env.env) @@ -5759,13 +5735,13 @@ let (check_module : fun env0 -> fun m -> fun b -> - (let uu___1 = FStarC_Compiler_Debug.any () in + (let uu___1 = FStarC_Debug.any () in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Ident.showable_lident m.FStarC_Syntax_Syntax.name in - FStarC_Compiler_Util.print2 "Checking %s: %s\n" + FStarC_Util.print2 "Checking %s: %s\n" (if m.FStarC_Syntax_Syntax.is_interface then "i'face" else "module") uu___2 @@ -5778,8 +5754,7 @@ let (check_module : then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_modul m in - FStarC_Compiler_Util.print1 "Module before type checking:\n%s\n" - uu___3 + FStarC_Util.print1 "Module before type checking:\n%s\n" uu___3 else ()); (let env = let uu___2 = @@ -6011,14 +5986,14 @@ let (check_module : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_modul m1 in - FStarC_Compiler_Util.print1 - "Module after type checking:\n%s\n" uu___5 + FStarC_Util.print1 "Module after type checking:\n%s\n" + uu___5 else ()); (let uu___5 = (let uu___6 = FStarC_Ident.string_of_lid m1.FStarC_Syntax_Syntax.name in FStarC_Options.dump_module uu___6) && - (FStarC_Compiler_Effect.op_Bang dbg_Normalize) in + (FStarC_Effect.op_Bang dbg_Normalize) in if uu___5 then let normalize_toplevel_lets se = @@ -6067,7 +6042,7 @@ let (check_module : let uu___6 = let uu___7 = let uu___8 = - let uu___9 = FStarC_Compiler_List.map update lbs in + let uu___9 = FStarC_List.map update lbs in (b1, uu___9) in { FStarC_Syntax_Syntax.lbs1 = uu___8; @@ -6092,7 +6067,7 @@ let (check_module : | uu___6 -> se in let normalized_module = let uu___6 = - FStarC_Compiler_List.map normalize_toplevel_lets + FStarC_List.map normalize_toplevel_lets m1.FStarC_Syntax_Syntax.declarations in { FStarC_Syntax_Syntax.name = @@ -6104,6 +6079,6 @@ let (check_module : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_modul normalized_module in - FStarC_Compiler_Util.print1 "%s\n" uu___6 + FStarC_Util.print1 "%s\n" uu___6 else ()); (m1, env2))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_TcEffect.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcEffect.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_TcEffect.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcEffect.ml index c5b548e2735..efada68bcec 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_TcEffect.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcEffect.ml @@ -1,8 +1,7 @@ open Prims -let (dbg : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ED" -let (dbg_LayeredEffectsTc : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LayeredEffectsTc" +let (dbg : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "ED" +let (dbg_LayeredEffectsTc : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LayeredEffectsTc" let (dmff_cps_and_elaborate : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.eff_decl -> @@ -63,21 +62,18 @@ let (check_and_gen : let ty1 = FStarC_Syntax_Subst.close_univ_vars g_us ty in - (if - (FStarC_Compiler_List.length g_us) <> n + (if (FStarC_List.length g_us) <> n then (let error = let uu___6 = - FStarC_Compiler_Util.string_of_int - n in + FStarC_Util.string_of_int n in let uu___7 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length - g_us) in + FStarC_Util.string_of_int + (FStarC_List.length g_us) in let uu___8 = FStarC_Syntax_Print.tscheme_to_string (g_us, t3) in - FStarC_Compiler_Util.format5 + FStarC_Util.format5 "Expected %s:%s to be universe-polymorphic in %s universes, but found %s (tscheme: %s)" eff_name comb uu___6 uu___7 uu___8 in FStarC_Errors.raise_error @@ -92,13 +88,10 @@ let (check_and_gen : | [] -> () | uu___7 -> let uu___8 = - ((FStarC_Compiler_List.length - us1) - = - (FStarC_Compiler_List.length - g_us)) + ((FStarC_List.length us1) = + (FStarC_List.length g_us)) && - (FStarC_Compiler_List.forall2 + (FStarC_List.forall2 (fun u1 -> fun u2 -> let uu___9 = @@ -121,7 +114,7 @@ let (check_and_gen : (FStarC_Class_Show.show_list FStarC_Ident.showable_ident) g_us in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Expected and generalized universes in the declaration for %s:%s are different, input: %s, but after gen: %s" eff_name comb uu___11 uu___12 in @@ -139,7 +132,7 @@ let (pure_wp_uvar : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.typ -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.term * FStarC_TypeChecker_Common.guard_t)) = fun env -> @@ -152,7 +145,7 @@ let (pure_wp_uvar : FStarC_TypeChecker_Env.lookup_definition [FStarC_TypeChecker_Env.NoDelta] env FStarC_Parser_Const.pure_wp_lid in - FStarC_Compiler_Util.must uu___ in + FStarC_Util.must uu___ in let uu___ = FStarC_TypeChecker_Env.inst_tscheme pure_wp_ts in match uu___ with | (uu___1, pure_wp_t1) -> @@ -200,7 +193,7 @@ let (eq_binders : fun bs2 -> let uu___ = let uu___1 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___2 -> fun b1 -> fun b2 -> @@ -224,24 +217,24 @@ let (eq_binders : uu___8) in FStarC_Syntax_Syntax.NT uu___7 in [uu___6] in - FStarC_Compiler_List.op_At ss uu___5 in + FStarC_List.op_At ss uu___5 in (uu___3, uu___4)) (true, []) bs1 bs2 in FStar_Pervasives_Native.fst uu___1 in if uu___ then let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> FStarC_Syntax_Syntax.Substitutive_binder) bs1 in FStar_Pervasives_Native.Some uu___1 else FStar_Pervasives_Native.None let (log_ad_hoc_combinator_warning : - Prims.string -> FStarC_Compiler_Range_Type.range -> unit) = + Prims.string -> FStarC_Range_Type.range -> unit) = fun comb_name -> fun r -> let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Combinator %s is not a substitutive indexed effect combinator, it is better to make it one if possible for better performance and ease of use" comb_name in FStarC_Errors_Msg.text uu___2 in @@ -287,17 +280,17 @@ let (bind_combinator_kind : fun has_range_binders -> let debug s = let uu___ = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___ - then FStarC_Compiler_Util.print1 "%s\n" s + then FStarC_Util.print1 "%s\n" s else () in (let uu___1 = let uu___2 = - FStarC_Compiler_Util.string_of_int + FStarC_Util.string_of_int num_effect_params in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Checking bind combinator kind with %s effect parameters" uu___2 in debug uu___1); @@ -332,11 +325,10 @@ let (bind_combinator_kind : sig1 in FStar_Pervasives_Native.fst uu___8 in - FStarC_Compiler_List.tl - uu___7 in + FStarC_List.tl uu___7 in let uu___7 = if - (FStarC_Compiler_List.length + (FStarC_List.length sig_bs) < num_effect_params then @@ -344,7 +336,7 @@ let (bind_combinator_kind : else (let uu___9 = let uu___10 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params sig_bs in FStar_Pervasives_Native.fst @@ -355,7 +347,7 @@ let (bind_combinator_kind : (fun sig_eff_params_bs -> let uu___8 = if - (FStarC_Compiler_List.length + (FStarC_List.length rest_bs) < num_effect_params @@ -363,7 +355,7 @@ let (bind_combinator_kind : FStar_Pervasives_Native.None else (let uu___10 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params rest_bs in FStar_Pervasives_Native.Some @@ -411,7 +403,7 @@ let (bind_combinator_kind : (match uu___8 with | a::bs -> let uu___9 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params bs in (match uu___9 @@ -434,7 +426,7 @@ let (bind_combinator_kind : FStarC_Syntax_Syntax.NT uu___12 in [uu___11] in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun ss1 -> fun sig_b @@ -455,7 +447,7 @@ let (bind_combinator_kind : FStarC_Syntax_Syntax.NT uu___13 in [uu___12] in - FStarC_Compiler_List.op_At + FStarC_List.op_At ss1 uu___11) uu___10 @@ -465,17 +457,17 @@ let (bind_combinator_kind : ss bs1)) in let uu___6 = if - (FStarC_Compiler_List.length + (FStarC_List.length rest_bs1) < - (FStarC_Compiler_List.length + (FStarC_List.length f_sig_bs) then FStar_Pervasives_Native.None else (let uu___8 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length + FStarC_List.splitAt + (FStarC_List.length f_sig_bs) rest_bs1 in FStar_Pervasives_Native.Some @@ -525,7 +517,7 @@ let (bind_combinator_kind : b::bs -> let uu___11 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params bs in (match uu___11 @@ -549,7 +541,7 @@ let (bind_combinator_kind : FStarC_Syntax_Syntax.NT uu___14 in [uu___13] in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun ss1 -> fun sig_b @@ -570,7 +562,7 @@ let (bind_combinator_kind : FStarC_Syntax_Syntax.NT uu___15 in [uu___14] in - FStarC_Compiler_List.op_At + FStarC_List.op_At ss1 uu___13) uu___12 @@ -580,18 +572,18 @@ let (bind_combinator_kind : ss bs1)) in let uu___8 = if - (FStarC_Compiler_List.length + (FStarC_List.length rest_bs2) < - (FStarC_Compiler_List.length + (FStarC_List.length g_sig_bs) then FStar_Pervasives_Native.None else (let uu___10 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length + FStarC_List.splitAt + (FStarC_List.length g_sig_bs) rest_bs2 in FStar_Pervasives_Native.Some @@ -608,7 +600,7 @@ let (bind_combinator_kind : = let uu___11 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___12 -> @@ -642,7 +634,7 @@ let (bind_combinator_kind : let ss1 = let uu___13 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___14 -> @@ -679,7 +671,7 @@ let (bind_combinator_kind : FStarC_Syntax_Syntax.mk_Tm_app uu___18 uu___19 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in (bv, uu___17) in FStarC_Syntax_Syntax.NT @@ -687,7 +679,7 @@ let (bind_combinator_kind : [uu___15] else []) l in - FStarC_Compiler_List.flatten + FStarC_List.flatten uu___13 in let g_sig_b_sort1 = @@ -757,10 +749,10 @@ let (bind_combinator_kind : FStarC_Syntax_Syntax.NT uu___15 in [uu___14] in - FStarC_Compiler_List.op_At + FStarC_List.op_At ss uu___13 in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At l [ ((g_b.FStarC_Syntax_Syntax.binder_bv), @@ -777,11 +769,11 @@ let (bind_combinator_kind : -> let g_bs_kinds1 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.snd g_bs_kinds in if - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Syntax_Syntax.Ad_hoc_binder g_bs_kinds1 then @@ -812,7 +804,7 @@ let (bind_combinator_kind : if has_range_binders then - FStarC_Compiler_List.splitAt + FStarC_List.splitAt (Prims.of_int (2)) rest_bs3 else @@ -829,15 +821,15 @@ let (bind_combinator_kind : let uu___11 = if - (FStarC_Compiler_List.length + (FStarC_List.length rest_bs4) >= (Prims.of_int (2)) then let uu___12 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length + FStarC_List.splitAt + ((FStarC_List.length rest_bs4) - (Prims.of_int (2))) @@ -868,7 +860,7 @@ let (bind_combinator_kind : = let repr_app_bs = - FStarC_Compiler_List.op_At + FStarC_List.op_At eff_params_bs f_bs in let expected_f_b_sort @@ -903,7 +895,7 @@ let (bind_combinator_kind : uu___18 in let uu___18 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___19 -> @@ -932,7 +924,7 @@ let (bind_combinator_kind : uu___18 in FStarC_Syntax_Syntax.mk_Tm_app t uu___16 - FStarC_Compiler_Range_Type.dummyRange) + FStarC_Range_Type.dummyRange) | FStar_Pervasives_Native.None -> @@ -953,7 +945,7 @@ let (bind_combinator_kind : a_b.FStarC_Syntax_Syntax.binder_bv in let uu___18 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___19 = @@ -1021,7 +1013,7 @@ let (bind_combinator_kind : uu___15 in let eff_params_args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___15 -> @@ -1049,7 +1041,7 @@ let (bind_combinator_kind : = let uu___15 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___16 -> @@ -1090,17 +1082,17 @@ let (bind_combinator_kind : FStarC_Syntax_Syntax.mk_Tm_app uu___20 uu___21 - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange else FStarC_Syntax_Syntax.bv_to_name b) g_bs g_bs_kinds in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___15 in let repr_args = - FStarC_Compiler_List.op_At + FStarC_List.op_At eff_params_args g_bs_args in match n_repr_ts @@ -1140,7 +1132,7 @@ let (bind_combinator_kind : FStarC_Syntax_Syntax.mk_Tm_app repr_hd uu___17 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___17 = let uu___18 @@ -1235,7 +1227,7 @@ let (bind_combinator_kind : -> let range_kinds = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___15 -> @@ -1243,25 +1235,25 @@ let (bind_combinator_kind : range_bs in let rest_kinds = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___15 -> FStarC_Syntax_Syntax.Ad_hoc_binder) rest_bs5 in FStar_Pervasives_Native.Some - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [FStarC_Syntax_Syntax.Type_binder; FStarC_Syntax_Syntax.Type_binder] - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At f_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At g_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At range_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At rest_kinds [FStarC_Syntax_Syntax.Repr_binder; FStarC_Syntax_Syntax.Repr_binder]))))))))))))))) @@ -1281,7 +1273,7 @@ let (validate_indexed_effect_bind_shape : FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.univ_names -> FStarC_Syntax_Syntax.typ -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.int -> Prims.bool -> (FStarC_Syntax_Syntax.typ * @@ -1309,8 +1301,8 @@ let (validate_indexed_effect_bind_shape : FStarC_Ident.string_of_lid n_eff_name in let uu___2 = FStarC_Ident.string_of_lid p_eff_name in - FStarC_Compiler_Util.format3 - "(%s , %s) |> %s" uu___ uu___1 uu___2 in + FStarC_Util.format3 "(%s , %s) |> %s" uu___ + uu___1 uu___2 in let uu___ = bind_us in match uu___ with | u_a::u_b::[] -> @@ -1341,7 +1333,7 @@ let (validate_indexed_effect_bind_shape : FStarC_Syntax_Syntax.comp = uu___2;_} when - (FStarC_Compiler_List.length bs) >= + (FStarC_List.length bs) >= (Prims.of_int (4)) -> let uu___3 = @@ -1388,9 +1380,8 @@ let (validate_indexed_effect_bind_shape : uu___11 :: uu___12 in let uu___11 = let uu___12 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length - bs1) + FStarC_List.splitAt + ((FStarC_List.length bs1) - (Prims.of_int (2))) bs1 in FStar_Pervasives_Native.fst @@ -1403,7 +1394,7 @@ let (validate_indexed_effect_bind_shape : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term bind_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Type of %s is not an arrow with >= 4 binders (%s)" bind_name uu___4 in FStarC_Errors.raise_error @@ -1418,21 +1409,19 @@ let (validate_indexed_effect_bind_shape : if has_range_binders then (if - (FStarC_Compiler_List.length - rest_bs) - >= (Prims.of_int (2)) + (FStarC_List.length rest_bs) >= + (Prims.of_int (2)) then - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length - rest_bs) - - (Prims.of_int (2))) rest_bs + FStarC_List.splitAt + ((FStarC_List.length rest_bs) - + (Prims.of_int (2))) rest_bs else (let uu___3 = let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term bind_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Type of %s is not an arrow with >= 6 binders (%s)" bind_name uu___4 in FStarC_Errors.raise_error @@ -1488,9 +1477,9 @@ let (validate_indexed_effect_bind_shape : let uu___5 = FStarC_TypeChecker_Env.push_binders env - (FStarC_Compiler_List.op_At - (a_b :: b_b :: - rest_bs1) [x_a]) in + (FStarC_List.op_At (a_b + :: b_b :: rest_bs1) + [x_a]) in let uu___6 = FStarC_Syntax_Syntax.bv_to_name b_b.FStarC_Syntax_Syntax.binder_bv in @@ -1540,7 +1529,7 @@ let (validate_indexed_effect_bind_shape : env (a_b :: b_b :: rest_bs1) in let uu___7 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "implicit for pure_wp in checking bind %s" bind_name in pure_wp_uvar uu___6 @@ -1586,10 +1575,10 @@ let (validate_indexed_effect_bind_shape : FStarC_Syntax_Util.arrow (a_b :: b_b :: - (FStarC_Compiler_List.op_At + (FStarC_List.op_At rest_bs1 ( - FStarC_Compiler_List.op_At + FStarC_List.op_At range_bs [f; g]))) uu___6 in @@ -1609,7 +1598,7 @@ let (validate_indexed_effect_bind_shape : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term bind_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unexpected type of %s (%s)\n" bind_name uu___8 in @@ -1668,10 +1657,10 @@ let (validate_indexed_effect_bind_shape : FStarC_Syntax_Syntax.Substitutive_combinator l in (let uu___8 = - (FStarC_Compiler_Debug.medium + (FStarC_Debug.medium ()) || ( - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___8 then @@ -1680,7 +1669,7 @@ let (validate_indexed_effect_bind_shape : FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_indexed_effect_combinator_kind kind in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Bind %s has %s kind\n" bind_name uu___9 @@ -1729,11 +1718,11 @@ let (subcomp_combinator_kind : | (uu___6::sig_bs, uu___7) -> let sig_effect_params_bs = let uu___8 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params sig_bs in FStar_Pervasives_Native.fst uu___8 in let uu___8 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params rest_bs in (match uu___8 with | (eff_params_bs, rest_bs1) -> @@ -1769,7 +1758,7 @@ let (subcomp_combinator_kind : (match uu___6 with | a::bs -> let uu___7 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params bs in (match uu___7 with | (sig_bs, bs1) -> @@ -1785,7 +1774,7 @@ let (subcomp_combinator_kind : FStarC_Syntax_Syntax.NT uu___10 in [uu___9] in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun ss1 -> fun sig_b -> fun b -> @@ -1803,7 +1792,7 @@ let (subcomp_combinator_kind : FStarC_Syntax_Syntax.NT uu___11 in [uu___10] in - FStarC_Compiler_List.op_At + FStarC_List.op_At ss1 uu___9) uu___8 sig_bs eff_params_bs in @@ -1811,17 +1800,14 @@ let (subcomp_combinator_kind : ss bs1)) in let uu___4 = if - (FStarC_Compiler_List.length - rest_bs1) - < - (FStarC_Compiler_List.length - f_sig_bs) + (FStarC_List.length rest_bs1) < + (FStarC_List.length f_sig_bs) then FStar_Pervasives_Native.None else (let uu___6 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length - f_sig_bs) rest_bs1 in + FStarC_List.splitAt + (FStarC_List.length f_sig_bs) + rest_bs1 in FStar_Pervasives_Native.Some uu___6) in op_let_Question uu___4 (fun uu___5 -> @@ -1840,13 +1826,12 @@ let (subcomp_combinator_kind : | (f_bs, f_bs_kinds, rest_bs2) -> let uu___5 = if - (FStarC_Compiler_List.length - rest_bs2) + (FStarC_List.length rest_bs2) >= Prims.int_one then let uu___6 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length + FStarC_List.splitAt + ((FStarC_List.length rest_bs2) - Prims.int_one) rest_bs2 in @@ -1887,7 +1872,7 @@ let (subcomp_combinator_kind : uu___12 in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> @@ -1910,7 +1895,7 @@ let (subcomp_combinator_kind : b in FStarC_Syntax_Syntax.as_arg uu___17) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs f_bs) in uu___11 @@ -1918,7 +1903,7 @@ let (subcomp_combinator_kind : uu___12 in FStarC_Syntax_Syntax.mk_Tm_app t uu___10 - FStarC_Compiler_Range_Type.dummyRange) + FStarC_Range_Type.dummyRange) | FStar_Pervasives_Native.None -> let uu___8 = @@ -1934,7 +1919,7 @@ let (subcomp_combinator_kind : a_b.FStarC_Syntax_Syntax.binder_bv in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___13 = @@ -1942,7 +1927,7 @@ let (subcomp_combinator_kind : b.FStarC_Syntax_Syntax.binder_bv in FStarC_Syntax_Syntax.as_arg uu___13) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs f_bs) in { @@ -2012,7 +1997,7 @@ let (subcomp_combinator_kind : uu___12 in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> @@ -2035,7 +2020,7 @@ let (subcomp_combinator_kind : b in FStarC_Syntax_Syntax.as_arg uu___17) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs f_or_g_bs) in uu___11 @@ -2043,7 +2028,7 @@ let (subcomp_combinator_kind : uu___12 in FStarC_Syntax_Syntax.mk_Tm_app t uu___10 - FStarC_Compiler_Range_Type.dummyRange) + FStarC_Range_Type.dummyRange) | FStar_Pervasives_Native.None -> let uu___8 @@ -2063,7 +2048,7 @@ let (subcomp_combinator_kind : a_b.FStarC_Syntax_Syntax.binder_bv in let uu___12 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___13 = @@ -2071,7 +2056,7 @@ let (subcomp_combinator_kind : b.FStarC_Syntax_Syntax.binder_bv in FStarC_Syntax_Syntax.as_arg uu___13) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs f_or_g_bs) in { @@ -2097,10 +2082,11 @@ let (subcomp_combinator_kind : uu___9 in let uu___8 = let uu___9 = + let uu___10 = + FStarC_Syntax_Util.comp_result + k_c in FStarC_TypeChecker_TermEqAndSimplify.eq_tm - env - (FStarC_Syntax_Util.comp_result - k_c) + env uu___10 expected_t in uu___9 = FStarC_TypeChecker_TermEqAndSimplify.Equal in @@ -2148,7 +2134,7 @@ let (subcomp_combinator_kind : a::bs -> let uu___14 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params bs in (match uu___14 @@ -2172,7 +2158,7 @@ let (subcomp_combinator_kind : FStarC_Syntax_Syntax.NT uu___17 in [uu___16] in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun ss1 -> fun sig_b @@ -2193,7 +2179,7 @@ let (subcomp_combinator_kind : FStarC_Syntax_Syntax.NT uu___18 in [uu___17] in - FStarC_Compiler_List.op_At + FStarC_List.op_At ss1 uu___16) uu___15 @@ -2203,18 +2189,18 @@ let (subcomp_combinator_kind : ss bs1)) in let uu___11 = if - (FStarC_Compiler_List.length + (FStarC_List.length rest_bs3) < - (FStarC_Compiler_List.length + (FStarC_List.length g_sig_bs) then FStar_Pervasives_Native.None else (let uu___13 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length + FStarC_List.splitAt + (FStarC_List.length g_sig_bs) rest_bs3 in FStar_Pervasives_Native.Some @@ -2265,7 +2251,7 @@ let (subcomp_combinator_kind : -> let rest_kinds = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___13 -> @@ -2273,15 +2259,15 @@ let (subcomp_combinator_kind : rest_bs4 in FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Substitutive_combinator - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [FStarC_Syntax_Syntax.Type_binder] - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At f_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At g_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At rest_kinds [FStarC_Syntax_Syntax.Repr_binder]))))))))))))) let (validate_indexed_effect_subcomp_shape : @@ -2295,7 +2281,7 @@ let (validate_indexed_effect_subcomp_shape : FStarC_Syntax_Syntax.univ_name -> FStarC_Syntax_Syntax.typ -> Prims.int -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.typ * FStarC_Syntax_Syntax.indexed_effect_combinator_kind)) = @@ -2313,8 +2299,7 @@ let (validate_indexed_effect_subcomp_shape : let subcomp_name = let uu___ = FStarC_Ident.string_of_lid m_eff_name in let uu___1 = FStarC_Ident.string_of_lid n_eff_name in - FStarC_Compiler_Util.format2 "%s <: %s" uu___ - uu___1 in + FStarC_Util.format2 "%s <: %s" uu___ uu___1 in let a_b = let uu___ = let uu___1 = @@ -2333,8 +2318,7 @@ let (validate_indexed_effect_subcomp_shape : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = uu___1;_} when - (FStarC_Compiler_List.length bs) >= - (Prims.of_int (2)) + (FStarC_List.length bs) >= (Prims.of_int (2)) -> let uu___2 = FStarC_Syntax_Subst.open_binders bs in @@ -2356,8 +2340,8 @@ let (validate_indexed_effect_subcomp_shape : [uu___7] in let uu___7 = let uu___8 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs1) - + FStarC_List.splitAt + ((FStarC_List.length bs1) - Prims.int_one) bs1 in FStar_Pervasives_Native.fst uu___8 in FStarC_Syntax_Subst.subst_binders uu___6 @@ -2368,7 +2352,7 @@ let (validate_indexed_effect_subcomp_shape : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term subcomp_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Type of %s is not an arrow with >= 2 binders (%s)" subcomp_name uu___3 in FStarC_Errors.raise_error @@ -2415,7 +2399,7 @@ let (validate_indexed_effect_subcomp_shape : FStarC_TypeChecker_Env.push_binders env (a_b :: rest_bs) in let uu___4 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "implicit for pure_wp in checking %s" subcomp_name in pure_wp_uvar uu___3 ret_t uu___4 r in @@ -2448,12 +2432,11 @@ let (validate_indexed_effect_subcomp_shape : FStarC_Syntax_Syntax.mk_Comp uu___3 in let k = FStarC_Syntax_Util.arrow - (FStarC_Compiler_List.op_At (a_b :: - rest_bs) [f]) c in + (FStarC_List.op_At (a_b :: rest_bs) + [f]) c in ((let uu___4 = - (FStarC_Compiler_Debug.medium ()) - || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___4 then @@ -2461,7 +2444,7 @@ let (validate_indexed_effect_subcomp_shape : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term k in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Expected type of subcomp before unification: %s\n" uu___5 else ()); @@ -2476,7 +2459,7 @@ let (validate_indexed_effect_subcomp_shape : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term subcomp_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unexpected type of %s (%s)\n" subcomp_name uu___6 in FStarC_Errors.raise_error @@ -2517,9 +2500,8 @@ let (validate_indexed_effect_subcomp_shape : | FStar_Pervasives_Native.Some k2 -> k2 in (let uu___6 = - (FStarC_Compiler_Debug.medium ()) - || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___6 then @@ -2527,7 +2509,7 @@ let (validate_indexed_effect_subcomp_shape : FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_indexed_effect_combinator_kind kind in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Subcomp %s has %s kind\n" subcomp_name uu___7 else ()); @@ -2568,12 +2550,12 @@ let (ite_combinator_kind : | (uu___8::sig_bs, uu___9) -> let sig_effect_params_bs = let uu___10 = - FStarC_Compiler_List.splitAt - num_effect_params sig_bs in + FStarC_List.splitAt num_effect_params + sig_bs in FStar_Pervasives_Native.fst uu___10 in let uu___10 = - FStarC_Compiler_List.splitAt - num_effect_params rest_bs in + FStarC_List.splitAt num_effect_params + rest_bs in (match uu___10 with | (eff_params_bs, rest_bs1) -> let uu___11 = @@ -2604,7 +2586,7 @@ let (ite_combinator_kind : (match uu___8 with | a::bs -> let uu___9 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params bs in (match uu___9 with | (sig_bs, bs1) -> @@ -2620,7 +2602,7 @@ let (ite_combinator_kind : FStarC_Syntax_Syntax.NT uu___12 in [uu___11] in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun ss1 -> fun sig_b -> fun b -> @@ -2635,7 +2617,7 @@ let (ite_combinator_kind : FStarC_Syntax_Syntax.NT uu___13 in [uu___12] in - FStarC_Compiler_List.op_At + FStarC_List.op_At ss1 uu___11) uu___10 sig_bs eff_params_bs in @@ -2643,13 +2625,13 @@ let (ite_combinator_kind : ss bs1)) in let uu___6 = if - (FStarC_Compiler_List.length rest_bs1) < - (FStarC_Compiler_List.length f_sig_bs) + (FStarC_List.length rest_bs1) < + (FStarC_List.length f_sig_bs) then FStar_Pervasives_Native.None else (let uu___8 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length f_sig_bs) + FStarC_List.splitAt + (FStarC_List.length f_sig_bs) rest_bs1 in FStar_Pervasives_Native.Some uu___8) in op_let_Question uu___6 @@ -2668,14 +2650,12 @@ let (ite_combinator_kind : | (f_bs, f_bs_kinds, rest_bs2) -> let uu___7 = if - (FStarC_Compiler_List.length - rest_bs2) - >= (Prims.of_int (3)) + (FStarC_List.length rest_bs2) >= + (Prims.of_int (3)) then let uu___8 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length - rest_bs2) + FStarC_List.splitAt + ((FStarC_List.length rest_bs2) - (Prims.of_int (3))) rest_bs2 in FStar_Pervasives_Native.Some uu___8 @@ -2701,7 +2681,7 @@ let (ite_combinator_kind : FStarC_Syntax_Syntax.as_arg uu___14 in let uu___14 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___15 -> match uu___15 with @@ -2721,13 +2701,13 @@ let (ite_combinator_kind : b in FStarC_Syntax_Syntax.as_arg uu___19) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs f_bs) in uu___13 :: uu___14 in FStarC_Syntax_Syntax.mk_Tm_app t uu___12 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___10 = let uu___11 = FStarC_TypeChecker_TermEqAndSimplify.eq_tm @@ -2761,7 +2741,7 @@ let (ite_combinator_kind : FStarC_Syntax_Syntax.as_arg uu___14 in let uu___14 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___15 -> @@ -2784,14 +2764,14 @@ let (ite_combinator_kind : b in FStarC_Syntax_Syntax.as_arg uu___19) - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs f_or_g_bs) in uu___13 :: uu___14 in FStarC_Syntax_Syntax.mk_Tm_app t uu___12 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___10 = let uu___11 = FStarC_TypeChecker_TermEqAndSimplify.eq_tm @@ -2838,7 +2818,7 @@ let (ite_combinator_kind : | a::bs -> let uu___16 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt num_effect_params bs in (match uu___16 @@ -2862,7 +2842,7 @@ let (ite_combinator_kind : FStarC_Syntax_Syntax.NT uu___19 in [uu___18] in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun ss1 -> fun sig_b @@ -2883,7 +2863,7 @@ let (ite_combinator_kind : FStarC_Syntax_Syntax.NT uu___20 in [uu___19] in - FStarC_Compiler_List.op_At + FStarC_List.op_At ss1 uu___18) uu___17 @@ -2893,17 +2873,17 @@ let (ite_combinator_kind : ss bs1)) in let uu___13 = if - (FStarC_Compiler_List.length + (FStarC_List.length rest_bs3) < - (FStarC_Compiler_List.length + (FStarC_List.length g_sig_bs) then FStar_Pervasives_Native.None else (let uu___15 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length + FStarC_List.splitAt + (FStarC_List.length g_sig_bs) rest_bs3 in FStar_Pervasives_Native.Some @@ -2949,7 +2929,7 @@ let (ite_combinator_kind : -> let rest_kinds = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___15 -> @@ -2957,15 +2937,15 @@ let (ite_combinator_kind : rest_bs4 in FStar_Pervasives_Native.Some (FStarC_Syntax_Syntax.Substitutive_combinator - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [FStarC_Syntax_Syntax.Type_binder] - (FStarC_Compiler_List.op_At + (FStarC_List.op_At eff_params_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At f_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At g_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At rest_kinds [FStarC_Syntax_Syntax.Repr_binder; FStarC_Syntax_Syntax.Repr_binder; @@ -2979,7 +2959,7 @@ let (validate_indexed_effect_ite_shape : FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.term -> Prims.int -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.indexed_effect_combinator_kind)) = @@ -2994,7 +2974,7 @@ let (validate_indexed_effect_ite_shape : fun r -> let ite_name = let uu___ = FStarC_Ident.string_of_lid eff_name in - FStarC_Compiler_Util.format1 "ite_%s" uu___ in + FStarC_Util.format1 "ite_%s" uu___ in let a_b = let uu___ = let uu___1 = @@ -3011,9 +2991,7 @@ let (validate_indexed_effect_ite_shape : | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = uu___1;_} - when - (FStarC_Compiler_List.length bs) >= - (Prims.of_int (4)) + when (FStarC_List.length bs) >= (Prims.of_int (4)) -> let uu___2 = FStarC_Syntax_Subst.open_binders bs in (match uu___2 with @@ -3034,8 +3012,8 @@ let (validate_indexed_effect_ite_shape : [uu___7] in let uu___7 = let uu___8 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs1) - + FStarC_List.splitAt + ((FStarC_List.length bs1) - (Prims.of_int (3))) bs1 in FStar_Pervasives_Native.fst uu___8 in FStarC_Syntax_Subst.subst_binders uu___6 @@ -3045,7 +3023,7 @@ let (validate_indexed_effect_ite_shape : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ite_ty in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Type of %s is not an arrow with >= 4 binders (%s)" ite_name uu___3 in FStarC_Errors.raise_error @@ -3107,8 +3085,7 @@ let (validate_indexed_effect_ite_shape : let uu___2 = let uu___3 = FStarC_TypeChecker_Env.push_binders env - (FStarC_Compiler_List.op_At (a_b :: - rest_bs) [p]) in + (FStarC_List.op_At (a_b :: rest_bs) [p]) in let uu___4 = FStarC_Syntax_Syntax.bv_to_name a_b.FStarC_Syntax_Syntax.binder_bv in @@ -3120,8 +3097,8 @@ let (validate_indexed_effect_ite_shape : | (body_tm, guard_body) -> let k = FStarC_Syntax_Util.abs - (FStarC_Compiler_List.op_At (a_b :: - rest_bs) [f; g; p]) body_tm + (FStarC_List.op_At (a_b :: rest_bs) + [f; g; p]) body_tm FStar_Pervasives_Native.None in let guard_eq = let uu___3 = @@ -3134,7 +3111,7 @@ let (validate_indexed_effect_ite_shape : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ite_tm in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unexpected term for %s (%s)\n" ite_name uu___5 in FStarC_Errors.raise_error @@ -3170,8 +3147,8 @@ let (validate_indexed_effect_ite_shape : FStarC_Syntax_Syntax.Ad_hoc_combinator) | FStar_Pervasives_Native.Some k2 -> k2 in (let uu___5 = - (FStarC_Compiler_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___5 then @@ -3179,7 +3156,7 @@ let (validate_indexed_effect_ite_shape : FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_indexed_effect_combinator_kind kind in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Ite %s has %s kind\n" ite_name uu___6 else ()); @@ -3193,8 +3170,7 @@ let (validate_indexed_effect_close_shape : FStarC_Syntax_Syntax.univ_name -> FStarC_Syntax_Syntax.term -> Prims.int -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.term) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term) = fun env -> fun eff_name -> @@ -3207,7 +3183,7 @@ let (validate_indexed_effect_close_shape : fun r -> let close_name = let uu___ = FStarC_Ident.string_of_lid eff_name in - FStarC_Compiler_Util.format1 "close_%s" uu___ in + FStarC_Util.format1 "close_%s" uu___ in let b_b = let uu___ = let uu___1 = @@ -3228,12 +3204,11 @@ let (validate_indexed_effect_close_shape : match uu___ with | a_b::sig_bs -> let uu___1 = - FStarC_Compiler_List.splitAt num_effect_params - sig_bs in + FStarC_List.splitAt num_effect_params sig_bs in (match uu___1 with | (eff_params_bs, sig_bs1) -> let bs = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let x_b = let uu___2 = @@ -3283,7 +3258,7 @@ let (validate_indexed_effect_close_shape : FStar_Pervasives_Native.None uu___5 in FStarC_Syntax_Syntax.mk_binder uu___4 in let is_args = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | { @@ -3310,7 +3285,7 @@ let (validate_indexed_effect_close_shape : [uu___11] in FStarC_Syntax_Syntax.mk_Tm_app uu___9 uu___10 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Syntax_Syntax.as_arg uu___8) bs in let repr_app = @@ -3322,8 +3297,7 @@ let (validate_indexed_effect_close_shape : FStarC_Syntax_Syntax.as_arg uu___6 in uu___5 :: is_args in FStarC_Syntax_Syntax.mk_Tm_app repr_t - uu___4 - FStarC_Compiler_Range_Type.dummyRange in + uu___4 FStarC_Range_Type.dummyRange in let f_sort = let uu___4 = FStarC_Syntax_Syntax.mk_Total repr_app in @@ -3335,7 +3309,7 @@ let (validate_indexed_effect_close_shape : let env1 = FStarC_TypeChecker_Env.push_binders env (a_b :: b_b :: - (FStarC_Compiler_List.op_At eff_params_bs bs)) in + (FStarC_List.op_At eff_params_bs bs)) in let uu___2 = let uu___3 = FStarC_Syntax_Syntax.bv_to_name @@ -3348,9 +3322,8 @@ let (validate_indexed_effect_close_shape : | (body_tm, g_body) -> let k = FStarC_Syntax_Util.abs (a_b :: b_b :: - (FStarC_Compiler_List.op_At - eff_params_bs - (FStarC_Compiler_List.op_At bs [f_b]))) + (FStarC_List.op_At eff_params_bs + (FStarC_List.op_At bs [f_b]))) body_tm FStar_Pervasives_Native.None in let g_eq = let uu___3 = @@ -3363,7 +3336,7 @@ let (validate_indexed_effect_close_shape : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term close_tm in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unexpected term for %s (%s)\n" close_name uu___5 in FStarC_Errors.raise_error @@ -3429,13 +3402,13 @@ let (lift_combinator_kind : FStarC_Syntax_Subst.subst_binders uu___6 bs) in let uu___3 = if - (FStarC_Compiler_List.length rest_bs) < - (FStarC_Compiler_List.length f_sig_bs) + (FStarC_List.length rest_bs) < + (FStarC_List.length f_sig_bs) then FStar_Pervasives_Native.None else (let uu___5 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length f_sig_bs) rest_bs in + FStarC_List.splitAt (FStarC_List.length f_sig_bs) + rest_bs in FStar_Pervasives_Native.Some uu___5) in op_let_Question uu___3 (fun uu___4 -> @@ -3452,12 +3425,11 @@ let (lift_combinator_kind : | (f_bs, f_bs_kinds, rest_bs1) -> let uu___4 = if - (FStarC_Compiler_List.length rest_bs1) >= - Prims.int_one + (FStarC_List.length rest_bs1) >= Prims.int_one then let uu___5 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length rest_bs1) - + FStarC_List.splitAt + ((FStarC_List.length rest_bs1) - Prims.int_one) rest_bs1 in match uu___5 with | (rest_bs2, f_b::[]) -> @@ -3488,7 +3460,7 @@ let (lift_combinator_kind : FStarC_Syntax_Syntax.as_arg uu___11 in let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___12 -> match uu___12 with | { @@ -3509,7 +3481,7 @@ let (lift_combinator_kind : uu___10 :: uu___11 in FStarC_Syntax_Syntax.mk_Tm_app t uu___9 - FStarC_Compiler_Range_Type.dummyRange) + FStarC_Range_Type.dummyRange) | FStar_Pervasives_Native.None -> let uu___7 = let uu___8 = @@ -3522,7 +3494,7 @@ let (lift_combinator_kind : FStarC_Syntax_Syntax.bv_to_name a_b.FStarC_Syntax_Syntax.binder_bv in let uu___11 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___12 = FStarC_Syntax_Syntax.bv_to_name @@ -3561,16 +3533,15 @@ let (lift_combinator_kind : op_let_Question uu___6 (fun _f_b_ok_ -> let rest_kinds = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> FStarC_Syntax_Syntax.Ad_hoc_binder) rest_bs2 in FStar_Pervasives_Native.Some - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [FStarC_Syntax_Syntax.Type_binder] - (FStarC_Compiler_List.op_At - f_bs_kinds - (FStarC_Compiler_List.op_At + (FStarC_List.op_At f_bs_kinds + (FStarC_List.op_At rest_kinds [FStarC_Syntax_Syntax.Repr_binder])))))) let (validate_indexed_effect_lift_shape : @@ -3579,7 +3550,7 @@ let (validate_indexed_effect_lift_shape : FStarC_Ident.lident -> FStarC_Syntax_Syntax.univ_name -> FStarC_Syntax_Syntax.typ -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.typ * FStarC_Syntax_Syntax.indexed_effect_combinator_kind)) = @@ -3592,10 +3563,10 @@ let (validate_indexed_effect_lift_shape : let lift_name = let uu___ = FStarC_Ident.string_of_lid m_eff_name in let uu___1 = FStarC_Ident.string_of_lid n_eff_name in - FStarC_Compiler_Util.format2 "%s ~> %s" uu___ uu___1 in + FStarC_Util.format2 "%s ~> %s" uu___ uu___1 in let lift_t_shape_error s = - FStarC_Compiler_Util.format2 - "Unexpected shape of lift %s, reason:%s" lift_name s in + FStarC_Util.format2 "Unexpected shape of lift %s, reason:%s" + lift_name s in let uu___ = let uu___1 = FStarC_TypeChecker_Env.get_effect_decl env m_eff_name in @@ -3620,10 +3591,7 @@ let (validate_indexed_effect_lift_shape : | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} - when - (FStarC_Compiler_List.length bs) >= - (Prims.of_int (2)) - -> + when (FStarC_List.length bs) >= (Prims.of_int (2)) -> let uu___3 = FStarC_Syntax_Subst.open_binders bs in (match uu___3 with | { FStarC_Syntax_Syntax.binder_bv = a; @@ -3643,15 +3611,17 @@ let (validate_indexed_effect_lift_shape : [uu___9] in let uu___9 = let uu___10 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs1) - + FStarC_List.splitAt + ((FStarC_List.length bs1) - Prims.int_one) bs1 in FStar_Pervasives_Native.fst uu___10 in FStarC_Syntax_Subst.subst_binders uu___8 uu___9 in let uu___8 = + let uu___9 = + FStarC_Syntax_Util.comp_effect_name c in FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + uu___9 in (uu___7, uu___8)) | uu___3 -> let uu___4 = @@ -3738,7 +3708,7 @@ let (validate_indexed_effect_lift_shape : FStarC_TypeChecker_Env.push_binders env (a_b :: rest_bs) in let uu___7 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "implicit for pure_wp in typechecking lift %s" lift_name in pure_wp_uvar uu___6 ret_t uu___7 r in @@ -3770,8 +3740,8 @@ let (validate_indexed_effect_lift_shape : FStarC_Syntax_Syntax.mk_Comp uu___6 in let k = FStarC_Syntax_Util.arrow - (FStarC_Compiler_List.op_At (a_b - :: rest_bs) [f]) c in + (FStarC_List.op_At (a_b :: + rest_bs) [f]) c in let guard_eq = let uu___6 = FStarC_TypeChecker_Rel.teq_nosmt @@ -3783,7 +3753,7 @@ let (validate_indexed_effect_lift_shape : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lift_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unexpected type of %s (%s)\n" lift_name uu___8 in FStarC_Errors.raise_error @@ -3830,9 +3800,8 @@ let (validate_indexed_effect_lift_shape : FStarC_Syntax_Syntax.Substitutive_combinator l in (let uu___8 = - (FStarC_Compiler_Debug.medium ()) - || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Debug.medium ()) || + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___8 then @@ -3840,7 +3809,7 @@ let (validate_indexed_effect_lift_shape : FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_indexed_effect_combinator_kind kind in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Lift %s has %s kind\n" lift_name uu___9 else ()); @@ -3859,27 +3828,25 @@ let (tc_layered_eff_decl : let uu___ = let uu___1 = FStarC_Ident.string_of_lid ed.FStarC_Syntax_Syntax.mname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "While checking layered effect definition `%s`" uu___1 in FStarC_Errors.with_ctx uu___ (fun uu___1 -> - (let uu___3 = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in + (let uu___3 = FStarC_Effect.op_Bang dbg_LayeredEffectsTc in if uu___3 then let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_eff_decl ed in - FStarC_Compiler_Util.print1 - "Typechecking layered effect: \n\t%s\n" uu___4 + FStarC_Util.print1 "Typechecking layered effect: \n\t%s\n" + uu___4 else ()); if - ((FStarC_Compiler_List.length ed.FStarC_Syntax_Syntax.univs) - <> Prims.int_zero) + ((FStarC_List.length ed.FStarC_Syntax_Syntax.univs) <> + Prims.int_zero) || - ((FStarC_Compiler_List.length - ed.FStarC_Syntax_Syntax.binders) - <> Prims.int_zero) + ((FStarC_List.length ed.FStarC_Syntax_Syntax.binders) <> + Prims.int_zero) then (let uu___4 = let uu___5 = @@ -3899,8 +3866,7 @@ let (tc_layered_eff_decl : (let log_combinator s uu___4 = match uu___4 with | (us, t, ty) -> - let uu___5 = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in + let uu___5 = FStarC_Effect.op_Bang dbg_LayeredEffectsTc in if uu___5 then let uu___6 = @@ -3910,9 +3876,8 @@ let (tc_layered_eff_decl : FStarC_Syntax_Print.tscheme_to_string (us, t) in let uu___8 = FStarC_Syntax_Print.tscheme_to_string (us, ty) in - FStarC_Compiler_Util.print4 - "Typechecked %s:%s = %s:%s\n" uu___6 s uu___7 - uu___8 + FStarC_Util.print4 "Typechecked %s:%s = %s:%s\n" + uu___6 s uu___7 uu___8 else () in let fresh_a_and_u_a a = let uu___4 = FStarC_Syntax_Util.type_u () in @@ -4003,7 +3968,7 @@ let (tc_layered_eff_decl : let repr_ts = let uu___7 = FStarC_Syntax_Util.get_eff_repr ed in - FStarC_Compiler_Util.must uu___7 in + FStarC_Util.must uu___7 in let r = (FStar_Pervasives_Native.snd repr_ts).FStarC_Syntax_Syntax.pos in let uu___7 = @@ -4082,7 +4047,7 @@ let (tc_layered_eff_decl : let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format5 + FStarC_Util.format5 "Type of %s:%s is not an arrow with >= %s binders (%s::%s)" uu___8 comb uu___9 uu___10 uu___11 in FStarC_Errors.raise_error @@ -4098,7 +4063,7 @@ let (tc_layered_eff_decl : let return_repr_ts = let uu___8 = FStarC_Syntax_Util.get_return_repr ed in - FStarC_Compiler_Util.must uu___8 in + FStarC_Util.must uu___8 in let r = (FStar_Pervasives_Native.snd return_repr_ts).FStarC_Syntax_Syntax.pos in let uu___8 = @@ -4132,9 +4097,8 @@ let (tc_layered_eff_decl : FStarC_Syntax_Syntax.comp = uu___12;_} when - (FStarC_Compiler_List.length - bs) - >= (Prims.of_int (2)) + (FStarC_List.length bs) >= + (Prims.of_int (2)) -> let uu___13 = FStarC_Syntax_Subst.open_binders @@ -4228,7 +4192,7 @@ let (tc_layered_eff_decl : let bind_repr_ts = let uu___10 = FStarC_Syntax_Util.get_bind_repr ed in - FStarC_Compiler_Util.must uu___10 in + FStarC_Util.must uu___10 in let r = (FStar_Pervasives_Native.snd bind_repr_ts).FStarC_Syntax_Syntax.pos in let uu___10 = @@ -4289,7 +4253,7 @@ let (tc_layered_eff_decl : let uu___12 = FStarC_Syntax_Util.get_stronger_repr ed in - FStarC_Compiler_Util.must uu___12 in + FStarC_Util.must uu___12 in let uu___12 = let uu___13 = FStarC_Syntax_Subst.compress @@ -4341,14 +4305,14 @@ let (tc_layered_eff_decl : let uu___19 = let uu___20 = let uu___21 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) bs1 in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.bv_to_name uu___21 in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___20 in { @@ -4373,7 +4337,7 @@ let (tc_layered_eff_decl : FStarC_Syntax_Syntax.bv_to_name f_b.FStarC_Syntax_Syntax.binder_bv in FStarC_Syntax_Util.abs - (FStarC_Compiler_List.op_At + (FStarC_List.op_At bs1 [f_b]) uu___19 FStar_Pervasives_Native.None in @@ -4407,7 +4371,7 @@ let (tc_layered_eff_decl : | (stronger_us, stronger_t, stronger_ty) -> ((let uu___14 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsTc in if uu___14 then @@ -4417,7 +4381,7 @@ let (tc_layered_eff_decl : let uu___16 = FStarC_Syntax_Print.tscheme_to_string (stronger_us, stronger_ty) in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "stronger combinator typechecked with term: %s and type: %s\n" uu___15 uu___16 else ()); @@ -4441,7 +4405,7 @@ let (tc_layered_eff_decl : | (us1, t, uu___17) -> (us1, t) in let uu___16 = - FStarC_Compiler_List.hd us in + FStarC_List.hd us in validate_indexed_effect_subcomp_shape env ed.FStarC_Syntax_Syntax.mname @@ -4475,8 +4439,7 @@ let (tc_layered_eff_decl : let uu___15 = FStarC_Syntax_Util.get_layered_if_then_else_combinator ed in - FStarC_Compiler_Util.must - uu___15 in + FStarC_Util.must uu___15 in FStar_Pervasives_Native.fst uu___14 in let uu___14 = @@ -4540,14 +4503,14 @@ let (tc_layered_eff_decl : = let uu___23 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) bs1 in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.bv_to_name uu___23 in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___22 in { @@ -4576,7 +4539,7 @@ let (tc_layered_eff_decl : let uu___19 = let uu___20 = FStarC_Syntax_Util.abs - (FStarC_Compiler_List.op_At + (FStarC_List.op_At bs1 [f_b; g_b; @@ -4647,7 +4610,7 @@ let (tc_layered_eff_decl : uu___20) -> (us1, t1) in let uu___19 = - FStarC_Compiler_List.hd + FStarC_List.hd us in validate_indexed_effect_ite_shape env @@ -4681,7 +4644,7 @@ let (tc_layered_eff_decl : let uu___18 = FStarC_Syntax_Util.get_layered_if_then_else_combinator ed in - FStarC_Compiler_Util.must + FStarC_Util.must uu___18 in FStar_Pervasives_Native.fst uu___17 in @@ -4719,8 +4682,8 @@ let (tc_layered_eff_decl : let uu___23 = let uu___24 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length + FStarC_List.splitAt + ((FStarC_List.length bs1) - (Prims.of_int (3))) bs1 in @@ -4751,7 +4714,7 @@ let (tc_layered_eff_decl : = let uu___25 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___26 = @@ -4773,7 +4736,7 @@ let (tc_layered_eff_decl : uu___24 in let uu___24 = - FStarC_Compiler_List.hd + FStarC_List.hd bs1 in let uu___25 = @@ -4841,11 +4804,11 @@ let (tc_layered_eff_decl : = let uu___28 = - FStarC_Compiler_List.hd + FStarC_List.hd bs1 in let uu___29 = - FStarC_Compiler_List.tl + FStarC_List.tl bs1 in (uu___28, uu___29) in @@ -4859,8 +4822,8 @@ let (tc_layered_eff_decl : = let uu___29 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length + FStarC_List.splitAt + ((FStarC_List.length rest_bs) - Prims.int_one) @@ -4872,7 +4835,7 @@ let (tc_layered_eff_decl : -> let uu___30 = - FStarC_Compiler_List.hd + FStarC_List.hd l2 in (l1, uu___30) in @@ -4921,7 +4884,7 @@ let (tc_layered_eff_decl : (uu___22, [], FStarC_TypeChecker_Env.trivial_guard) in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___22 -> @@ -4941,7 +4904,7 @@ let (tc_layered_eff_decl : = let ctx_uvar_meta = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun uu___24 -> @@ -4955,7 +4918,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "uvar for subcomp %s binder when checking ite soundness" uu___25 in FStarC_TypeChecker_Env.new_implicit_var_aux @@ -4974,13 +4937,13 @@ let (tc_layered_eff_decl : = FStarC_TypeChecker_Common.conj_guard g g_t in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At subst [ FStarC_Syntax_Syntax.NT ((b.FStarC_Syntax_Syntax.binder_bv), t)]), - (FStarC_Compiler_List.op_At + (FStarC_List.op_At uvars [t]), uu___25))) @@ -5023,13 +4986,13 @@ let (tc_layered_eff_decl : let fml = let uu___21 = - FStarC_Compiler_List.hd + FStarC_List.hd c.FStarC_Syntax_Syntax.comp_univs in let uu___22 = let uu___23 = - FStarC_Compiler_List.hd + FStarC_List.hd c.FStarC_Syntax_Syntax.effect_args in FStar_Pervasives_Native.fst uu___23 in @@ -5263,7 +5226,7 @@ let (tc_layered_eff_decl : | FStarC_Syntax_Syntax.Substitutive_combinator l -> Prims.op_Negation - (FStarC_Compiler_List.contains + (FStarC_List.contains FStarC_Syntax_Syntax.Ad_hoc_binder l) | uu___18 -> @@ -5306,8 +5269,8 @@ let (tc_layered_eff_decl : -> let uu___22 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length + FStarC_List.splitAt + ((FStarC_List.length close_bs1) - Prims.int_one) @@ -5330,7 +5293,7 @@ let (tc_layered_eff_decl : uu___24 in let args1 = - FStarC_Compiler_List.map + FStarC_List.map (fun i_b -> let uu___24 @@ -5371,7 +5334,7 @@ let (tc_layered_eff_decl : FStarC_Syntax_Syntax.args = a::args;_} -> - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst args | @@ -5396,7 +5359,7 @@ let (tc_layered_eff_decl : FStarC_Syntax_Syntax.mk_binder x_bv in [uu___26] in - FStarC_Compiler_List.op_At + FStarC_List.op_At (a_b :: b_b :: is_bs) @@ -5424,7 +5387,7 @@ let (tc_layered_eff_decl : = let uu___27 = - FStarC_Compiler_List.hd + FStarC_List.hd us1 in FStarC_Syntax_Syntax.U_name uu___27 in @@ -5465,8 +5428,8 @@ let (tc_layered_eff_decl : [uu___27] in let uu___27 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length + FStarC_List.splitAt + (FStarC_List.length args1) subcomp_bs in (match uu___27 @@ -5479,7 +5442,7 @@ let (tc_layered_eff_decl : = let uu___28 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun arg1 -> @@ -5488,13 +5451,13 @@ let (tc_layered_eff_decl : arg1)) subcomp_f_bs args1 in - FStarC_Compiler_List.op_At + FStarC_List.op_At subcomp_substs uu___28 in let uu___28 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length + FStarC_List.splitAt + (FStarC_List.length args2) subcomp_bs1 in (match uu___28 @@ -5507,7 +5470,7 @@ let (tc_layered_eff_decl : = let uu___30 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun arg2 -> @@ -5516,7 +5479,7 @@ let (tc_layered_eff_decl : arg2)) subcomp_g_bs args2 in - FStarC_Compiler_List.op_At + FStarC_List.op_At subcomp_substs1 uu___30 in let subcomp_c1 @@ -5532,13 +5495,13 @@ let (tc_layered_eff_decl : let fml = let uu___30 = - FStarC_Compiler_List.hd + FStarC_List.hd subcomp_c1.FStarC_Syntax_Syntax.comp_univs in let uu___31 = let uu___32 = - FStarC_Compiler_List.hd + FStarC_List.hd subcomp_c1.FStarC_Syntax_Syntax.effect_args in FStar_Pervasives_Native.fst uu___32 in @@ -5560,7 +5523,7 @@ let (tc_layered_eff_decl : let r = (act.FStarC_Syntax_Syntax.action_defn).FStarC_Syntax_Syntax.pos in if - (FStarC_Compiler_List.length + (FStarC_List.length act.FStarC_Syntax_Syntax.action_params) <> Prims.int_zero then @@ -5576,7 +5539,7 @@ let (tc_layered_eff_decl : (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) act.FStarC_Syntax_Syntax.action_params in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Action %s:%s has non-empty action params (%s)" uu___16 uu___17 uu___18 in FStarC_Errors.raise_error @@ -5857,10 +5820,10 @@ let (tc_layered_eff_decl : | (act_defn, uu___19, g_d) -> ((let uu___21 = - (FStarC_Compiler_Debug.medium + (FStarC_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___21 then @@ -5872,7 +5835,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term act_typ1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Typechecked action definition: %s and action type: %s\n" uu___22 uu___23 @@ -5924,7 +5887,7 @@ let (tc_layered_eff_decl : = FStarC_Ident.string_of_lid act1.FStarC_Syntax_Syntax.action_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "implicit for return type of action %s:%s" uu___25 uu___26 in @@ -5983,7 +5946,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term act_typ2 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Unexpected non-function type for action %s:%s (%s)" uu___25 uu___26 @@ -6002,9 +5965,9 @@ let (tc_layered_eff_decl : | (k, g_k) -> ((let uu___23 = - (FStarC_Compiler_Debug.medium + (FStarC_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___23 @@ -6014,7 +5977,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term k in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Expected action type: %s\n" uu___24 else ()); @@ -6023,7 +5986,7 @@ let (tc_layered_eff_decl : env1 act_typ1 k in - FStarC_Compiler_List.iter + FStarC_List.iter (FStarC_TypeChecker_Rel.force_trivial_guard env1) [g_t; @@ -6033,9 +5996,9 @@ let (tc_layered_eff_decl : ( let uu___25 = - (FStarC_Compiler_Debug.medium + (FStarC_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___25 @@ -6045,7 +6008,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term k in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Expected action type after unification: %s\n" uu___26 else ()); @@ -6067,7 +6030,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Unexpected (k-)type of action %s:%s, expected bs -> repr i_1 ... i_n, found: %s" uu___25 uu___26 @@ -6168,9 +6131,12 @@ let (tc_layered_eff_decl : -> let uu___27 = + let uu___28 + = + FStarC_Syntax_Util.comp_result + c1 in repr_args - (FStarC_Syntax_Util.comp_result - c1) in + uu___28 in (match uu___27 with | @@ -6216,9 +6182,9 @@ let (tc_layered_eff_decl : ( let uu___26 = - (FStarC_Compiler_Debug.medium + (FStarC_Debug.medium ()) || - (FStarC_Compiler_Effect.op_Bang + (FStarC_Effect.op_Bang dbg_LayeredEffectsTc) in if uu___26 @@ -6228,7 +6194,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term act_typ2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Action type after injecting it into the monad: %s\n" uu___27 else ()); @@ -6276,12 +6242,12 @@ let (tc_layered_eff_decl : else (let uu___28 = - ((FStarC_Compiler_List.length + ((FStarC_List.length us) = - (FStarC_Compiler_List.length + (FStarC_List.length act1.FStarC_Syntax_Syntax.action_univs)) && - (FStarC_Compiler_List.forall2 + (FStarC_List.forall2 (fun u1 -> fun u2 -> @@ -6343,7 +6309,7 @@ let (tc_layered_eff_decl : (FStarC_Class_Show.show_list FStarC_Ident.showable_ident) act1.FStarC_Syntax_Syntax.action_univs in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Expected and generalized universes in the declaration for %s:%s are different, input: %s, but after gen: %s" uu___31 uu___32 @@ -6364,7 +6330,7 @@ let (tc_layered_eff_decl : let uu___15 = FStarC_Ident.string_of_lid act.FStarC_Syntax_Syntax.action_name in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "While checking the action %s" uu___15 in FStarC_Errors.with_ctx uu___14 @@ -6376,7 +6342,7 @@ let (tc_layered_eff_decl : ed.FStarC_Syntax_Syntax.eff_attrs FStarC_Parser_Const.primitive_extraction_attr in let is_reifiable = - FStarC_Compiler_List.contains + FStarC_List.contains FStarC_Syntax_Syntax.Reifiable quals in if @@ -6388,7 +6354,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Ident.showable_lident ed.FStarC_Syntax_Syntax.mname in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect %s is declared to be both primitive extraction and reifiable" uu___15 in FStarC_Errors.raise_error @@ -6446,7 +6412,7 @@ let (tc_layered_eff_decl : FStarC_TypeChecker_Env.push_binders env [a_b] in let uu___17 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___18 -> fun b -> match uu___18 @@ -6500,7 +6466,7 @@ let (tc_layered_eff_decl : FStarC_Syntax_Syntax.Extract_none m))) in (let uu___15 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsTc in if uu___15 then @@ -6512,7 +6478,7 @@ let (tc_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Syntax.showable_eff_extraction_mode extraction_mode in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Effect %s has extraction mode %s\n" uu___16 uu___17 else ()); @@ -6561,7 +6527,7 @@ let (tc_layered_eff_decl : (us, ty))) } in let uu___15 = - FStarC_Compiler_List.map + FStarC_List.map (tc_action_with_ctx env0) ed.FStarC_Syntax_Syntax.actions in { @@ -6606,18 +6572,17 @@ let (tc_non_layered_eff_decl : let uu___ = let uu___1 = FStarC_Ident.string_of_lid ed.FStarC_Syntax_Syntax.mname in - FStarC_Compiler_Util.format1 - "While checking effect definition `%s`" uu___1 in + FStarC_Util.format1 "While checking effect definition `%s`" + uu___1 in FStarC_Errors.with_ctx uu___ (fun uu___1 -> - (let uu___3 = FStarC_Compiler_Effect.op_Bang dbg in + (let uu___3 = FStarC_Effect.op_Bang dbg in if uu___3 then let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_eff_decl ed in - FStarC_Compiler_Util.print1 - "Typechecking eff_decl: \n\t%s\n" uu___4 + FStarC_Util.print1 "Typechecking eff_decl: \n\t%s\n" uu___4 else ()); (let uu___3 = let uu___4 = @@ -6661,10 +6626,10 @@ let (tc_non_layered_eff_decl : | [] -> (us, bs2) | uu___9 -> let uu___10 = - ((FStarC_Compiler_List.length ed_univs) - = (FStarC_Compiler_List.length us)) + ((FStarC_List.length ed_univs) = + (FStarC_List.length us)) && - (FStarC_Compiler_List.forall2 + (FStarC_List.forall2 (fun u1 -> fun u2 -> let uu___11 = @@ -6703,7 +6668,7 @@ let (tc_non_layered_eff_decl : let uu___18 = FStarC_Class_PP.pp FStarC_Class_PP.pp_int - (FStarC_Compiler_List.length + (FStarC_List.length ed_univs) in let uu___19 = let uu___20 = @@ -6712,8 +6677,7 @@ let (tc_non_layered_eff_decl : let uu___21 = FStarC_Class_PP.pp FStarC_Class_PP.pp_int - (FStarC_Compiler_List.length - us) in + (FStarC_List.length us) in FStarC_Pprint.op_Hat_Slash_Hat uu___20 uu___21 in FStarC_Pprint.op_Hat_Slash_Hat @@ -6768,16 +6732,14 @@ let (tc_non_layered_eff_decl : let t1 = let uu___7 = FStarC_Syntax_Subst.shift_subst - ((FStarC_Compiler_List.length - ed_bs) - + - (FStarC_Compiler_List.length - us1)) ed_univs_subst in + ((FStarC_List.length ed_bs) + + (FStarC_List.length us1)) + ed_univs_subst in FStarC_Syntax_Subst.subst uu___7 t in let uu___7 = let uu___8 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length us1) + (FStarC_List.length us1) ed_bs_subst in FStarC_Syntax_Subst.subst uu___8 t1 in (us1, uu___7) in @@ -6788,7 +6750,7 @@ let (tc_non_layered_eff_decl : FStarC_Syntax_Util.apply_eff_combinators op ed1.FStarC_Syntax_Syntax.combinators in let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map (fun a -> let uu___9 = let uu___10 = @@ -6834,15 +6796,14 @@ let (tc_non_layered_eff_decl : FStarC_Syntax_Syntax.extraction_mode = (ed1.FStarC_Syntax_Syntax.extraction_mode) } in - ((let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___7 = FStarC_Effect.op_Bang dbg in if uu___7 then let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_eff_decl ed2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "After typechecking binders eff_decl: \n\t%s\n" uu___8 else ()); @@ -6856,11 +6817,8 @@ let (tc_non_layered_eff_decl : match uu___7 with | (us1, t) -> let env1 = - if - FStarC_Compiler_Util.is_some - env_opt - then - FStarC_Compiler_Util.must env_opt + if FStarC_Util.is_some env_opt + then FStarC_Util.must env_opt else env in let uu___8 = FStarC_Syntax_Subst.open_univ_vars @@ -6895,8 +6853,7 @@ let (tc_non_layered_eff_decl : (match uu___9 with | (g_us, t3) -> (if - (FStarC_Compiler_List.length - g_us) + (FStarC_List.length g_us) <> n then (let error = @@ -6904,13 +6861,13 @@ let (tc_non_layered_eff_decl : FStarC_Ident.string_of_lid ed2.FStarC_Syntax_Syntax.mname in let uu___12 = - FStarC_Compiler_Util.string_of_int + FStarC_Util.string_of_int n in let uu___13 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length + FStarC_Util.string_of_int + (FStarC_List.length g_us) in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Expected %s:%s to be universe-polymorphic in %s universes, found %s" uu___11 comb uu___12 uu___13 in @@ -6927,13 +6884,13 @@ let (tc_non_layered_eff_decl : | [] -> (g_us, t3) | uu___11 -> let uu___12 = - ((FStarC_Compiler_List.length + ((FStarC_List.length us2) = - (FStarC_Compiler_List.length + (FStarC_List.length g_us)) && - (FStarC_Compiler_List.forall2 + (FStarC_List.forall2 (fun u1 -> fun u2 -> let uu___13 @@ -6951,14 +6908,14 @@ let (tc_non_layered_eff_decl : FStarC_Ident.string_of_lid ed2.FStarC_Syntax_Syntax.mname in let uu___16 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length + FStarC_Util.string_of_int + (FStarC_List.length us2) in let uu___17 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length + FStarC_Util.string_of_int + (FStarC_List.length g_us) in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Expected and generalized universes in the declaration for %s:%s are different, expected: %s, but found %s" uu___15 comb uu___16 uu___17 in @@ -6977,14 +6934,13 @@ let (tc_non_layered_eff_decl : check_and_gen' "signature" Prims.int_one FStar_Pervasives_Native.None uu___7 FStar_Pervasives_Native.None in - (let uu___8 = - FStarC_Compiler_Effect.op_Bang dbg in + (let uu___8 = FStarC_Effect.op_Bang dbg in if uu___8 then let uu___9 = FStarC_Syntax_Print.tscheme_to_string signature in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Typechecked signature: %s\n" uu___9 else ()); (let fresh_a_and_wp uu___8 = @@ -7042,8 +6998,7 @@ let (tc_non_layered_eff_decl : | uu___13 -> fail signature1) | uu___12 -> fail signature1) in let log_combinator s ts = - let uu___8 = - FStarC_Compiler_Effect.op_Bang dbg in + let uu___8 = FStarC_Effect.op_Bang dbg in if uu___8 then let uu___9 = @@ -7052,7 +7007,7 @@ let (tc_non_layered_eff_decl : let uu___10 = FStarC_Syntax_Print.tscheme_to_string ts in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Typechecked %s:%s = %s\n" uu___9 s uu___10 else () in @@ -7235,7 +7190,7 @@ let (tc_non_layered_eff_decl : let uu___13 = FStarC_Syntax_Util.get_wp_if_then_else_combinator ed2 in - FStarC_Compiler_Util.must uu___13 in + FStarC_Util.must uu___13 in check_and_gen' "if_then_else" Prims.int_one FStar_Pervasives_Native.None @@ -7267,8 +7222,7 @@ let (tc_non_layered_eff_decl : let uu___14 = FStarC_Syntax_Util.get_wp_ite_combinator ed2 in - FStarC_Compiler_Util.must - uu___14 in + FStarC_Util.must uu___14 in check_and_gen' "ite_wp" Prims.int_one FStar_Pervasives_Native.None @@ -7333,8 +7287,7 @@ let (tc_non_layered_eff_decl : let uu___15 = FStarC_Syntax_Util.get_wp_close_combinator ed2 in - FStarC_Compiler_Util.must - uu___15 in + FStarC_Util.must uu___15 in check_and_gen' "close_wp" (Prims.of_int (2)) FStar_Pervasives_Native.None @@ -7370,7 +7323,7 @@ let (tc_non_layered_eff_decl : let uu___18 = FStarC_Syntax_Util.get_wp_trivial_combinator ed2 in - FStarC_Compiler_Util.must + FStarC_Util.must uu___18 in check_and_gen' "trivial" Prims.int_one @@ -7423,7 +7376,7 @@ let (tc_non_layered_eff_decl : let uu___21 = FStarC_Syntax_Util.get_eff_repr ed2 in - FStarC_Compiler_Util.must + FStarC_Util.must uu___21 in check_and_gen' "repr" Prims.int_one @@ -7465,7 +7418,7 @@ let (tc_non_layered_eff_decl : uu___21 in FStarC_Syntax_Syntax.mk uu___20 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let mk_repr a wp = let uu___18 = FStarC_Syntax_Syntax.bv_to_name @@ -7495,8 +7448,7 @@ let (tc_non_layered_eff_decl : let uu___18 = FStarC_Syntax_Util.get_return_repr ed2 in - FStarC_Compiler_Util.must - uu___18 in + FStarC_Util.must uu___18 in let uu___18 = fresh_a_and_wp () in match uu___18 with @@ -7535,7 +7487,7 @@ let (tc_non_layered_eff_decl : uu___22 :: uu___23 in FStarC_Syntax_Syntax.mk_Tm_app uu___20 uu___21 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in mk_repr a wp in let k = let uu___20 = @@ -7581,8 +7533,7 @@ let (tc_non_layered_eff_decl : let uu___19 = FStarC_Syntax_Util.get_bind_repr ed2 in - FStarC_Compiler_Util.must - uu___19 in + FStarC_Util.must uu___19 in let uu___19 = fresh_a_and_wp () in match uu___19 with @@ -7641,7 +7592,7 @@ let (tc_non_layered_eff_decl : FStarC_Syntax_Syntax.mk_Tm_app uu___21 uu___22 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let res = let wp = let uu___21 = @@ -7685,18 +7636,18 @@ let (tc_non_layered_eff_decl : uu___27 in uu___24 :: uu___25 in - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg uu___23 in FStarC_Syntax_Syntax.mk_Tm_app uu___21 uu___22 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in mk_repr b wp in let maybe_range_arg = let uu___21 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_TypeChecker_TermEqAndSimplify.eq_tm_bool env FStarC_Syntax_Util.dm4f_bind_range_attr) @@ -7793,10 +7744,10 @@ let (tc_non_layered_eff_decl : uu___28 in uu___25 :: uu___26 in - FStarC_Compiler_List.op_At + FStarC_List.op_At maybe_range_arg uu___24 in - FStarC_Compiler_List.op_At + FStarC_List.op_At uu___22 uu___23 in let uu___22 = @@ -7988,7 +7939,7 @@ let (tc_non_layered_eff_decl : (let actions = let check_action act = if - (FStarC_Compiler_List.length + (FStarC_List.length act.FStarC_Syntax_Syntax.action_params) <> Prims.int_zero then @@ -8073,7 +8024,7 @@ let (tc_non_layered_eff_decl : = let uu___27 = - FStarC_Compiler_List.hd + FStarC_List.hd c1.FStarC_Syntax_Syntax.effect_args in FStar_Pervasives_Native.fst uu___27 in @@ -8261,7 +8212,7 @@ let (tc_non_layered_eff_decl : } in ((let uu___25 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg in if uu___25 then @@ -8279,7 +8230,7 @@ let (tc_non_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term act_typ1 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Checking action %s:\n[definition]: %s\n[cps'd type]: %s\n" uu___26 uu___27 @@ -8386,7 +8337,7 @@ let (tc_non_layered_eff_decl : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term act_typ3 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Actions must have function types (not: %s, a.k.a. %s)" uu___31 uu___32 in @@ -8428,7 +8379,7 @@ let (tc_non_layered_eff_decl : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term act_typ2 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unexpected non trivial guard formula when checking action type shape (%s)" uu___32 in FStarC_Errors.raise_error @@ -8635,9 +8586,12 @@ let (tc_non_layered_eff_decl : -> let uu___32 = + let uu___33 + = + FStarC_Syntax_Util.comp_result + c1 in destruct_repr - (FStarC_Syntax_Util.comp_result - c1) in + uu___33 in (match uu___32 with | @@ -8740,7 +8694,7 @@ let (tc_non_layered_eff_decl : = act_typ5 })))))))) in - FStarC_Compiler_List.map + FStarC_List.map check_action ed2.FStarC_Syntax_Syntax.actions in ((FStar_Pervasives_Native.Some @@ -8761,8 +8715,8 @@ let (tc_non_layered_eff_decl : ed_univs in let uu___15 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length - ed_bs) ed_univs_closing in + (FStarC_List.length ed_bs) + ed_univs_closing in FStarC_Syntax_Subst.subst_tscheme uu___15 ts1 in let combinators = @@ -8811,7 +8765,7 @@ let (tc_non_layered_eff_decl : FStarC_Syntax_Syntax.WP_eff_sig uu___16 in let uu___16 = - FStarC_Compiler_List.map + FStarC_List.map (fun a -> let uu___17 = let uu___18 = @@ -8869,15 +8823,14 @@ let (tc_non_layered_eff_decl : (ed2.FStarC_Syntax_Syntax.extraction_mode) } in ((let uu___16 = - FStarC_Compiler_Effect.op_Bang - dbg in + FStarC_Effect.op_Bang dbg in if uu___16 then let uu___17 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_eff_decl ed3 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Typechecked effect declaration:\n\t%s\n" uu___17 else ()); @@ -8939,33 +8892,33 @@ let (tc_layered_lift : = fun env0 -> fun sub -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in + (let uu___1 = FStarC_Effect.op_Bang dbg_LayeredEffectsTc in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sub_eff sub in - FStarC_Compiler_Util.print1 "Typechecking sub_effect: %s\n" uu___2 + FStarC_Util.print1 "Typechecking sub_effect: %s\n" uu___2 else ()); - (let lift_ts = FStarC_Compiler_Util.must sub.FStarC_Syntax_Syntax.lift in + (let lift_ts = FStarC_Util.must sub.FStarC_Syntax_Syntax.lift in let r = (FStar_Pervasives_Native.snd lift_ts).FStarC_Syntax_Syntax.pos in let uu___1 = check_and_gen env0 "" "lift" Prims.int_one lift_ts in match uu___1 with | (us, lift, lift_ty) -> - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in + ((let uu___3 = FStarC_Effect.op_Bang dbg_LayeredEffectsTc in if uu___3 then let uu___4 = FStarC_Syntax_Print.tscheme_to_string (us, lift) in let uu___5 = FStarC_Syntax_Print.tscheme_to_string (us, lift_ty) in - FStarC_Compiler_Util.print2 - "Typechecked lift: %s and lift_ty: %s\n" uu___4 uu___5 + FStarC_Util.print2 "Typechecked lift: %s and lift_ty: %s\n" + uu___4 uu___5 else ()); (let uu___3 = FStarC_Syntax_Subst.open_univ_vars us lift_ty in match uu___3 with | (us1, lift_ty1) -> let env = FStarC_TypeChecker_Env.push_univ_vars env0 us1 in let uu___4 = - let uu___5 = FStarC_Compiler_List.hd us1 in + let uu___5 = FStarC_List.hd us1 in validate_indexed_effect_lift_shape env sub.FStarC_Syntax_Syntax.source sub.FStarC_Syntax_Syntax.target uu___5 lift_ty1 r in @@ -8990,20 +8943,19 @@ let (tc_layered_lift : (FStar_Pervasives_Native.Some kind) } in ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsTc in + FStarC_Effect.op_Bang dbg_LayeredEffectsTc in if uu___6 then let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sub_eff sub1 in - FStarC_Compiler_Util.print1 - "Final sub_effect: %s\n" uu___7 + FStarC_Util.print1 "Final sub_effect: %s\n" uu___7 else ()); sub1))))) let (check_lift_for_erasable_effects : FStarC_TypeChecker_Env.env -> FStarC_Ident.lident -> - FStarC_Ident.lident -> FStarC_Compiler_Range_Type.range -> unit) + FStarC_Ident.lident -> FStarC_Range_Type.range -> unit) = fun env -> fun m1 -> @@ -9013,7 +8965,7 @@ let (check_lift_for_erasable_effects : let uu___ = let uu___1 = FStarC_Ident.string_of_lid m1 in let uu___2 = FStarC_Ident.string_of_lid m2 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Error defining a lift/subcomp %s ~> %s: %s" uu___1 uu___2 reason in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r @@ -9044,7 +8996,7 @@ let (check_lift_for_erasable_effects : let (tc_lift : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.sub_eff -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.sub_eff) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.sub_eff) = fun env -> fun sub -> @@ -9058,7 +9010,7 @@ let (tc_lift : let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident sub.FStarC_Syntax_Syntax.source in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Cannot define a lift with same source and target (%s)" uu___3 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_UnexpectedEffect () @@ -9128,7 +9080,7 @@ let (tc_lift : then let uu___8 = let uu___9 = FStarC_Ident.string_of_lid eff_name in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect %s cannot be reified" uu___9 in FStarC_Errors.raise_error FStarC_TypeChecker_Env.hasRange_env env @@ -9150,7 +9102,7 @@ let (tc_lift : let uu___8 = let uu___9 = FStarC_Syntax_Util.get_eff_repr ed in - FStarC_Compiler_Util.must uu___9 in + FStarC_Util.must uu___9 in FStarC_TypeChecker_Env.inst_effect_fun_with [FStarC_Syntax_Syntax.U_unknown] env ed uu___8 in @@ -9182,9 +9134,7 @@ let (tc_lift : | (lift, FStar_Pervasives_Native.Some (uvs, lift_wp)) -> let uu___7 = - if - (FStarC_Compiler_List.length uvs) > - Prims.int_zero + if (FStarC_List.length uvs) > Prims.int_zero then let uu___8 = FStarC_Syntax_Subst.univ_var_opening uvs in @@ -9202,7 +9152,7 @@ let (tc_lift : | (env1, lift_wp1) -> let lift_wp2 = if - (FStarC_Compiler_List.length uvs) = + (FStarC_List.length uvs) = Prims.int_zero then check_and_gen1 env1 lift_wp1 expected_k @@ -9218,9 +9168,7 @@ let (tc_lift : | (FStar_Pervasives_Native.Some (what, lift), FStar_Pervasives_Native.None) -> let uu___7 = - if - (FStarC_Compiler_List.length what) > - Prims.int_zero + if (FStarC_List.length what) > Prims.int_zero then let uu___8 = FStarC_Syntax_Subst.univ_var_opening what in @@ -9232,22 +9180,20 @@ let (tc_lift : else ([], lift) in (match uu___7 with | (uvs, lift1) -> - ((let uu___9 = - FStarC_Compiler_Effect.op_Bang dbg in + ((let uu___9 = FStarC_Effect.op_Bang dbg in if uu___9 then let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lift1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Lift for free : %s\n" uu___10 else ()); (let dmff_env = FStarC_TypeChecker_DMFF.empty env (FStarC_TypeChecker_TcTerm.tc_constant - env - FStarC_Compiler_Range_Type.dummyRange) in + env FStarC_Range_Type.dummyRange) in let uu___9 = let uu___10 = FStarC_TypeChecker_Env.push_univ_vars @@ -9268,9 +9214,8 @@ let (tc_lift : FStarC_TypeChecker_DMFF.recheck_debug "lift-elab" env lift_elab in if - (FStarC_Compiler_List.length - uvs) - = Prims.int_zero + (FStarC_List.length uvs) = + Prims.int_zero then let uu___13 = let uu___14 = @@ -9517,8 +9462,7 @@ let (tc_lift : -> let lift4 = if - (FStarC_Compiler_List.length - uvs) + (FStarC_List.length uvs) = Prims.int_zero then check_and_gen1 env2 lift3 @@ -9535,7 +9479,7 @@ let (tc_lift : FStar_Pervasives_Native.Some lift4))) in (if - (FStarC_Compiler_List.length + (FStarC_List.length (FStar_Pervasives_Native.fst lift_wp)) <> Prims.int_one then @@ -9549,10 +9493,10 @@ let (tc_lift : FStarC_Ident.showable_lident sub.FStarC_Syntax_Syntax.target in let uu___11 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length + FStarC_Util.string_of_int + (FStarC_List.length (FStar_Pervasives_Native.fst lift_wp)) in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Sub effect wp must be polymorphic in exactly 1 universe; %s ~> %s has %s universes" uu___9 uu___10 uu___11 in FStarC_Errors.raise_error @@ -9563,13 +9507,12 @@ let (tc_lift : (Obj.magic uu___8)) else (); (let uu___9 = - (FStarC_Compiler_Util.is_some lift1) && + (FStarC_Util.is_some lift1) && (let uu___10 = let uu___11 = - let uu___12 = - FStarC_Compiler_Util.must lift1 in + let uu___12 = FStarC_Util.must lift1 in FStar_Pervasives_Native.fst uu___12 in - FStarC_Compiler_List.length uu___11 in + FStarC_List.length uu___11 in uu___10 <> Prims.int_one) in if uu___9 then @@ -9585,12 +9528,11 @@ let (tc_lift : let uu___13 = let uu___14 = let uu___15 = - let uu___16 = - FStarC_Compiler_Util.must lift1 in + let uu___16 = FStarC_Util.must lift1 in FStar_Pervasives_Native.fst uu___16 in - FStarC_Compiler_List.length uu___15 in - FStarC_Compiler_Util.string_of_int uu___14 in - FStarC_Compiler_Util.format3 + FStarC_List.length uu___15 in + FStarC_Util.string_of_int uu___14 in + FStarC_Util.format3 "Sub effect lift must be polymorphic in exactly 1 universe; %s ~> %s has %s universes" uu___11 uu___12 uu___13 in FStarC_Errors.raise_error @@ -9615,7 +9557,7 @@ let (tc_effect_abbrev : FStarC_TypeChecker_Env.env -> (FStarC_Ident.lident * FStarC_Syntax_Syntax.univ_names * FStarC_Syntax_Syntax.binders * FStarC_Syntax_Syntax.comp) -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Ident.lident * FStarC_Syntax_Syntax.univ_names * FStarC_Syntax_Syntax.binders * FStarC_Syntax_Syntax.comp)) = @@ -9626,7 +9568,7 @@ let (tc_effect_abbrev : | (lid, uvs, tps, c) -> let env0 = env in let uu___1 = - if (FStarC_Compiler_List.length uvs) = Prims.int_zero + if (FStarC_List.length uvs) = Prims.int_zero then (env, uvs, tps, c) else (let uu___3 = FStarC_Syntax_Subst.univ_var_opening uvs in @@ -9636,7 +9578,7 @@ let (tc_effect_abbrev : let c1 = let uu___4 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length tps1) usubst in + (FStarC_List.length tps1) usubst in FStarC_Syntax_Subst.subst_comp uu___4 c in let uu___4 = FStarC_TypeChecker_Env.push_univ_vars env uvs1 in @@ -9657,9 +9599,10 @@ let (tc_effect_abbrev : | (c3, u, g) -> let is_default_effect = let uu___5 = + let uu___6 = + FStarC_Syntax_Util.comp_effect_name c3 in FStarC_TypeChecker_Env.get_default_effect - env3 - (FStarC_Syntax_Util.comp_effect_name c3) in + env3 uu___6 in match uu___5 with | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some l -> @@ -9685,10 +9628,12 @@ let (tc_effect_abbrev : FStarC_Ident.string_of_lid lid in let uu___13 = + let uu___14 = + FStarC_Syntax_Util.comp_effect_name + c3 in FStarC_Ident.string_of_lid - (FStarC_Syntax_Util.comp_effect_name - c3) in - FStarC_Compiler_Util.format2 + uu___14 in + FStarC_Util.format2 "Effect %s is marked as a default effect for %s, but it has more than one arguments" uu___12 uu___13 in FStarC_Errors.raise_error @@ -9730,7 +9675,7 @@ let (tc_effect_abbrev : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term def_result_typ in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Result type of effect abbreviation `%s` does not match the result type of its definition `%s`" uu___9 uu___10 in FStarC_Errors.raise_error @@ -9782,9 +9727,8 @@ let (tc_effect_abbrev : (match uu___8 with | (tps5, c5) -> (if - (FStarC_Compiler_List.length - uvs2) - <> Prims.int_one + (FStarC_List.length uvs2) <> + Prims.int_one then (let uu___10 = FStarC_Syntax_Subst.open_univ_vars @@ -9799,13 +9743,13 @@ let (tc_effect_abbrev : let uu___14 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length + (FStarC_List.length uvs2) in let uu___15 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Effect abbreviations must be polymorphic in exactly 1 universe; %s has %s universes (%s)" uu___13 uu___14 uu___15 in @@ -9823,7 +9767,7 @@ let (check_polymonadic_bind_for_erasable_effects : FStarC_TypeChecker_Env.env -> FStarC_Ident.lident -> FStarC_Ident.lident -> - FStarC_Ident.lident -> FStarC_Compiler_Range_Type.range -> unit) + FStarC_Ident.lident -> FStarC_Range_Type.range -> unit) = fun env -> fun m -> @@ -9838,7 +9782,7 @@ let (check_polymonadic_bind_for_erasable_effects : FStarC_Class_Show.show FStarC_Ident.showable_lident n in let uu___3 = FStarC_Class_Show.show FStarC_Ident.showable_lident p in - FStarC_Compiler_Util.format4 + FStarC_Util.format4 "Error definition polymonadic bind (%s, %s) |> %s: %s" uu___1 uu___2 uu___3 reason in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range @@ -9876,7 +9820,7 @@ let (check_polymonadic_bind_for_erasable_effects : then let uu___3 = let uu___4 = FStarC_Ident.string_of_lid m1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "target effect is erasable but %s is neither erasable nor PURE" uu___4 in err uu___3 @@ -9891,7 +9835,7 @@ let (check_polymonadic_bind_for_erasable_effects : then let uu___5 = let uu___6 = FStarC_Ident.string_of_lid n1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "target effect is erasable but %s is neither erasable nor PURE" uu___6 in err uu___5 @@ -9921,8 +9865,7 @@ let (tc_polymonadic_bind : let uu___2 = let uu___3 = FStarC_Ident.ident_of_lid p in FStarC_Ident.string_of_id uu___3 in - FStarC_Compiler_Util.format3 "(%s, %s) |> %s)" uu___ uu___1 - uu___2 in + FStarC_Util.format3 "(%s, %s) |> %s)" uu___ uu___1 uu___2 in let r = (FStar_Pervasives_Native.snd ts).FStarC_Syntax_Syntax.pos in check_polymonadic_bind_for_erasable_effects env m n p r; (let uu___1 = @@ -9968,8 +9911,7 @@ let (tc_polymonadic_bind : ty1 uu___11 Prims.int_zero false in (match uu___4 with | (k, kind) -> - ((let uu___6 = - FStarC_Compiler_Debug.extreme () in + ((let uu___6 = FStarC_Debug.extreme () in if uu___6 then let uu___7 = @@ -9978,14 +9920,14 @@ let (tc_polymonadic_bind : let uu___8 = FStarC_Syntax_Print.tscheme_to_string (us1, k) in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Polymonadic bind %s after typechecking (%s::%s)\n" eff_name uu___7 uu___8 else ()); (let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Polymonadic binds (%s in this case) is an experimental feature;it is subject to some redesign in the future. Please keep us informed (on github etc.) about how you are using it" eff_name in FStarC_Errors_Msg.text uu___9 in @@ -10053,14 +9995,14 @@ let (tc_polymonadic_subcomp : n_ed.FStarC_Syntax_Syntax.signature in let uu___7 = FStarC_Syntax_Util.get_eff_repr m_ed in let uu___8 = FStarC_Syntax_Util.get_eff_repr n_ed in - let uu___9 = FStarC_Compiler_List.hd us1 in + let uu___9 = FStarC_List.hd us1 in let uu___10 = FStarC_TypeChecker_Env.get_range env in validate_indexed_effect_subcomp_shape env m n uu___5 uu___6 uu___7 uu___8 uu___9 ty1 Prims.int_zero uu___10 in (match uu___4 with | (k, kind) -> - ((let uu___6 = FStarC_Compiler_Debug.extreme () in + ((let uu___6 = FStarC_Debug.extreme () in if uu___6 then let uu___7 = @@ -10069,14 +10011,14 @@ let (tc_polymonadic_subcomp : let uu___8 = FStarC_Syntax_Print.tscheme_to_string (us1, k) in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Polymonadic subcomp %s after typechecking (%s::%s)\n" combinator_name uu___7 uu___8 else ()); (let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Polymonadic subcomp (%s in this case) is an experimental feature;it is subject to some redesign in the future. Please keep us informed (on github etc.) about how you are using it" combinator_name in FStarC_Errors_Msg.text uu___9 in diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_TcInductive.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcInductive.ml similarity index 91% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_TcInductive.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcInductive.ml index 8eb336acdb3..fd2e9a20397 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_TcInductive.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcInductive.ml @@ -1,10 +1,10 @@ open Prims -let (dbg_GenUniverses : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "GenUniverses" -let (dbg_LogTypes : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LogTypes" -let (dbg_Injectivity : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Injectivity" +let (dbg_GenUniverses : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "GenUniverses" +let (dbg_LogTypes : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LogTypes" +let (dbg_Injectivity : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Injectivity" let (unfold_whnf : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) @@ -46,7 +46,7 @@ let (check_sig_inductive_injectivity_on_params : let uu___11 = let uu___12 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length tps) usubst in + (FStarC_List.length tps) usubst in FStarC_Syntax_Subst.subst uu___12 k in (uu___9, uu___10, uu___11) in (match uu___8 with @@ -101,13 +101,13 @@ let (check_sig_inductive_injectivity_on_params : v0) -> universe_leq u v0 | (FStarC_Syntax_Syntax.U_max us1, uu___14) -> - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun u1 -> universe_leq u1 v) us1 | (uu___14, FStarC_Syntax_Syntax.U_max vs) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (universe_leq u) vs | (FStarC_Syntax_Syntax.U_unknown, uu___14) -> @@ -124,7 +124,7 @@ let (check_sig_inductive_injectivity_on_params : FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ v in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" uu___16 uu___17 uu___18 in failwith uu___15 @@ -144,7 +144,7 @@ let (check_sig_inductive_injectivity_on_params : FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ v in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" uu___16 uu___17 uu___18 in failwith uu___15 @@ -163,7 +163,7 @@ let (check_sig_inductive_injectivity_on_params : FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ v in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" uu___17 uu___18 uu___19 in failwith uu___16 @@ -183,7 +183,7 @@ let (check_sig_inductive_injectivity_on_params : FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ v in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Impossible: Unresolved or unknown universe in inductive type %s (%s, %s)" uu___17 uu___18 uu___19 in failwith uu___16 @@ -224,7 +224,7 @@ let (check_sig_inductive_injectivity_on_params : uu___20, u_formals) -> let inj = - FStarC_Compiler_Util.for_all + FStarC_Util.for_all (fun u_formal -> u_leq_u_k u_formal) @@ -245,16 +245,16 @@ let (check_sig_inductive_injectivity_on_params : false) else false)) in let injective_type_params = - FStarC_Compiler_List.forall2 - tp_ok tps3 us in + FStarC_List.forall2 tp_ok tps3 + us in ((let uu___15 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_Injectivity in if uu___15 then let uu___16 = FStarC_Ident.string_of_lid t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "%s injectivity for %s\n" (if injective_type_params then "YES" @@ -329,8 +329,8 @@ let (tc_tycon : let uu___4 = FStarC_Syntax_Subst.subst_binders usubst tps in let uu___5 = let uu___6 = - FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length tps) usubst in + FStarC_Syntax_Subst.shift_subst (FStarC_List.length tps) + usubst in FStarC_Syntax_Subst.subst uu___6 k in (uu___3, uu___4, uu___5) in (match uu___2 with @@ -382,12 +382,12 @@ let (tc_tycon : t) && (Prims.op_Negation - (FStarC_Compiler_List.contains + (FStarC_List.contains FStarC_Syntax_Syntax.Noeq s.FStarC_Syntax_Syntax.sigquals))) && (Prims.op_Negation - (FStarC_Compiler_List.contains + (FStarC_List.contains FStarC_Syntax_Syntax.Unopteq s.FStarC_Syntax_Syntax.sigquals))) || @@ -406,7 +406,7 @@ let (tc_tycon : FStarC_Class_Show.show FStarC_Ident.showable_lident tc in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Type annotation %s for inductive %s is not Type or eqtype, or it is eqtype but contains noeq/unopteq qualifiers" uu___11 uu___12 in FStarC_Errors_Msg.text @@ -435,20 +435,19 @@ let (tc_tycon : let uu___10 = let uu___11 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length - tps3) usubst1 in + (FStarC_List.length tps3) + usubst1 in FStarC_Syntax_Subst.subst_binders uu___11 indices in - FStarC_Compiler_List.op_At - uu___9 uu___10 in + FStarC_List.op_At uu___9 + uu___10 in let uu___9 = let uu___10 = let uu___11 = FStarC_Syntax_Subst.shift_subst - ((FStarC_Compiler_List.length - tps3) + ((FStarC_List.length tps3) + - (FStarC_Compiler_List.length + (FStarC_List.length indices)) usubst1 in FStarC_Syntax_Subst.subst uu___11 t in @@ -468,8 +467,8 @@ let (tc_tycon : let uu___10 = let uu___11 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length - tps4) usubst1 in + (FStarC_List.length tps4) + usubst1 in FStarC_Syntax_Subst.subst uu___11 k4 in (uu___9, uu___10) in @@ -572,7 +571,7 @@ let (tc_data : | (env1, t1) -> let uu___3 = let tps_u_opt = - FStarC_Compiler_Util.find_map tcs + FStarC_Util.find_map tcs (fun uu___4 -> match uu___4 with | (se1, u_tc) -> @@ -580,7 +579,7 @@ let (tc_data : let uu___6 = let uu___7 = FStarC_Syntax_Util.lid_of_sigelt se1 in - FStarC_Compiler_Util.must uu___7 in + FStarC_Util.must uu___7 in FStarC_Ident.lid_equals tc_lid uu___6 in if uu___5 then @@ -604,7 +603,7 @@ let (tc_data : let uu___13 = FStarC_Syntax_Subst.subst_binders usubst tps in - FStarC_Compiler_List.map + FStarC_List.map (fun x -> { FStarC_Syntax_Syntax.binder_bv @@ -654,7 +653,7 @@ let (tc_data : let uu___4 = let t2 = FStarC_TypeChecker_Normalize.normalize - (FStarC_Compiler_List.op_At + (FStarC_List.op_At FStarC_TypeChecker_Normalize.whnf_steps [FStarC_TypeChecker_Env.AllowUnboundUniverses]) env2 t1 in @@ -667,8 +666,7 @@ let (tc_data : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = res;_} -> - let uu___6 = - FStarC_Compiler_Util.first_N ntps bs in + let uu___6 = FStarC_Util.first_N ntps bs in (match uu___6 with | (uu___7, bs') -> let t4 = @@ -680,7 +678,7 @@ let (tc_data : res }) t3.FStarC_Syntax_Syntax.pos in let subst = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___8 -> match uu___8 with @@ -711,24 +709,27 @@ let (tc_data : c1) in if uu___9 then - (bs1, - (FStarC_Syntax_Util.comp_result - c1)) + let uu___10 = + FStarC_Syntax_Util.comp_result + c1 in + (bs1, uu___10) else - FStarC_Errors.raise_error - FStarC_Ident.hasrange_lident - (FStarC_Syntax_Util.comp_effect_name - c1) - FStarC_Errors_Codes.Fatal_UnexpectedConstructorType - () - (Obj.magic - FStarC_Errors_Msg.is_error_message_string) - (Obj.magic - "Constructors cannot have effects"))) + (let uu___11 = + FStarC_Syntax_Util.comp_effect_name + c1 in + FStarC_Errors.raise_error + FStarC_Ident.hasrange_lident + uu___11 + FStarC_Errors_Codes.Fatal_UnexpectedConstructorType + () + (Obj.magic + FStarC_Errors_Msg.is_error_message_string) + (Obj.magic + "Constructors cannot have effects")))) | uu___6 -> ([], t3) in (match uu___4 with | (arguments, result) -> - ((let uu___6 = FStarC_Compiler_Debug.low () in + ((let uu___6 = FStarC_Debug.low () in if uu___6 then let uu___7 = @@ -743,7 +744,7 @@ let (tc_data : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term result in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Checking datacon %s : %s -> %s \n" uu___7 uu___8 uu___9 else ()); @@ -794,13 +795,13 @@ let (tc_data : fv tc_lid -> if - (FStarC_Compiler_List.length + (FStarC_List.length _uvs1) = - (FStarC_Compiler_List.length + (FStarC_List.length tuvs) then - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g -> fun u1 -> fun u2 -> @@ -811,14 +812,14 @@ let (tc_data : FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type u1) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let uu___15 = FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_type (FStarC_Syntax_Syntax.U_name u2)) - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_TypeChecker_Rel.teq env'1 uu___14 @@ -853,7 +854,7 @@ let (tc_data : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term head in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Expected a constructor of type %s; got %s" uu___12 uu___13 in FStarC_Errors.raise_error @@ -865,7 +866,7 @@ let (tc_data : FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___11) in let g = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g1 -> fun uu___9 -> fun u_x -> @@ -889,12 +890,12 @@ let (tc_data : (FStarC_Errors.stop_if_err (); (let p_args = let uu___10 = - FStarC_Compiler_Util.first_N - (FStarC_Compiler_List.length + FStarC_Util.first_N + (FStarC_List.length tps) args in FStar_Pervasives_Native.fst uu___10 in - FStarC_Compiler_List.iter2 + FStarC_List.iter2 (fun uu___11 -> fun uu___12 -> match (uu___11, @@ -935,7 +936,7 @@ let (tc_data : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "This parameter is not constant: expected %s, got %s" uu___20 uu___21 in @@ -976,7 +977,7 @@ let (tc_data : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term ty in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "The type of %s is %s, but since this is the result type of a constructor its type should be Type" uu___15 uu___16 in FStarC_Errors.raise_error @@ -990,7 +991,7 @@ let (tc_data : (let t2 = let uu___12 = let uu___13 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> { FStarC_Syntax_Syntax.binder_bv @@ -1008,7 +1009,7 @@ let (tc_data : = (b.FStarC_Syntax_Syntax.binder_attrs) }) tps in - FStarC_Compiler_List.op_At + FStarC_List.op_At uu___13 arguments1 in let uu___13 = FStarC_Syntax_Syntax.mk_Total @@ -1070,7 +1071,7 @@ let (generalize_and_inst_within : fun tcs -> fun datas -> let binders = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___ -> match uu___ with | (se, uu___1) -> @@ -1091,7 +1092,7 @@ let (generalize_and_inst_within : FStarC_Syntax_Syntax.null_binder uu___8 | uu___2 -> failwith "Impossible")) tcs in let binders' = - FStarC_Compiler_List.map + FStarC_List.map (fun se -> match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -1107,32 +1108,31 @@ let (generalize_and_inst_within : let t = let uu___ = FStarC_Syntax_Syntax.mk_Total FStarC_Syntax_Syntax.t_unit in - FStarC_Syntax_Util.arrow - (FStarC_Compiler_List.op_At binders binders') uu___ in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_GenUniverses in + FStarC_Syntax_Util.arrow (FStarC_List.op_At binders binders') uu___ in + (let uu___1 = FStarC_Effect.op_Bang dbg_GenUniverses in if uu___1 then let uu___2 = FStarC_TypeChecker_Normalize.term_to_string env t in - FStarC_Compiler_Util.print1 - "@@@@@@Trying to generalize universes in %s\n" uu___2 + FStarC_Util.print1 "@@@@@@Trying to generalize universes in %s\n" + uu___2 else ()); (let uu___1 = FStarC_TypeChecker_Generalize.generalize_universes env t in match uu___1 with | (uvs, t1) -> - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_GenUniverses in + ((let uu___3 = FStarC_Effect.op_Bang dbg_GenUniverses in if uu___3 then let uu___4 = let uu___5 = - FStarC_Compiler_List.map - (fun u -> FStarC_Ident.string_of_id u) uvs in - FStarC_Compiler_String.concat ", " uu___5 in + FStarC_List.map (fun u -> FStarC_Ident.string_of_id u) + uvs in + FStarC_String.concat ", " uu___5 in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print2 - "@@@@@@Generalized to (%s, %s)\n" uu___4 uu___5 + FStarC_Util.print2 "@@@@@@Generalized to (%s, %s)\n" uu___4 + uu___5 else ()); (let uu___3 = FStarC_Syntax_Subst.open_univ_vars uvs t1 in match uu___3 with @@ -1141,12 +1141,12 @@ let (generalize_and_inst_within : (match uu___4 with | (args, uu___5) -> let uu___6 = - FStarC_Compiler_Util.first_N - (FStarC_Compiler_List.length binders) args in + FStarC_Util.first_N (FStarC_List.length binders) + args in (match uu___6 with | (tc_types, data_types) -> let tcs1 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___7 -> fun uu___8 -> match (uu___7, uu___8) with @@ -1199,8 +1199,8 @@ let (generalize_and_inst_within : = c;_} -> let uu___18 = - FStarC_Compiler_Util.first_N - (FStarC_Compiler_List.length + FStarC_Util.first_N + (FStarC_List.length tps) binders1 in (match uu___18 with | (tps1, rest) -> @@ -1271,12 +1271,12 @@ let (generalize_and_inst_within : | [] -> datas | uu___7 -> let uvs_universes = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> FStarC_Syntax_Syntax.U_name uu___8) uvs1 in let tc_insts = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | { @@ -1314,7 +1314,7 @@ let (generalize_and_inst_within : -> (tc, uvs_universes) | uu___9 -> failwith "Impossible") tcs1 in - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___8 -> fun d -> match uu___8 with @@ -1414,14 +1414,14 @@ let (haseq_suffix : Prims.string) = "__uu___haseq" let (is_haseq_lid : FStarC_Ident.lid -> Prims.bool) = fun lid -> let str = FStarC_Ident.string_of_lid lid in - let len = FStarC_Compiler_String.length str in - let haseq_suffix_len = FStarC_Compiler_String.length haseq_suffix in + let len = FStarC_String.length str in + let haseq_suffix_len = FStarC_String.length haseq_suffix in (len > haseq_suffix_len) && (let uu___ = let uu___1 = - FStarC_Compiler_String.substring str (len - haseq_suffix_len) + FStarC_String.substring str (len - haseq_suffix_len) haseq_suffix_len in - FStarC_Compiler_String.compare uu___1 haseq_suffix in + FStarC_String.compare uu___1 haseq_suffix in uu___ = Prims.int_zero) let (get_haseq_axiom_lid : FStarC_Ident.lid -> FStarC_Ident.lid) = fun lid -> @@ -1436,7 +1436,7 @@ let (get_haseq_axiom_lid : FStarC_Ident.lid -> FStarC_Ident.lid) = Prims.strcat uu___5 haseq_suffix in FStarC_Ident.id_of_text uu___4 in [uu___3] in - FStarC_Compiler_List.op_At uu___1 uu___2 in + FStarC_List.op_At uu___1 uu___2 in FStarC_Ident.lid_of_ids uu___ let (get_optimized_haseq_axiom : FStarC_TypeChecker_Env.env -> @@ -1469,8 +1469,8 @@ let (get_optimized_haseq_axiom : let bs1 = FStarC_Syntax_Subst.subst_binders usubst bs in let t1 = let uu___1 = - FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length bs1) usubst in + FStarC_Syntax_Subst.shift_subst (FStarC_List.length bs1) + usubst in FStarC_Syntax_Subst.subst uu___1 t in let uu___1 = FStarC_Syntax_Subst.open_term bs1 t1 in (match uu___1 with @@ -1491,30 +1491,30 @@ let (get_optimized_haseq_axiom : FStarC_Syntax_Syntax.fvar lid FStar_Pervasives_Native.None in let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun u -> FStarC_Syntax_Syntax.U_name u) us in FStarC_Syntax_Syntax.mk_Tm_uinst uu___2 uu___3 in let ind1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Util.arg_of_non_null_binder bs2 in FStarC_Syntax_Syntax.mk_Tm_app ind uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let ind2 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Util.arg_of_non_null_binder ibs1 in FStarC_Syntax_Syntax.mk_Tm_app ind1 uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let haseq_ind = let uu___2 = let uu___3 = FStarC_Syntax_Syntax.as_arg ind2 in [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.t_haseq uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let bs' = - FStarC_Compiler_List.filter + FStarC_List.filter (fun b -> let uu___2 = let uu___3 = FStarC_Syntax_Util.type_u () in @@ -1523,7 +1523,7 @@ let (get_optimized_haseq_axiom : (b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort uu___2) bs2 in let haseq_bs = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun t3 -> fun b -> let uu___2 = @@ -1536,7 +1536,7 @@ let (get_optimized_haseq_axiom : [uu___4] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.t_haseq uu___3 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Syntax_Util.mk_conj t3 uu___2) FStarC_Syntax_Util.t_true bs' in let fml = FStarC_Syntax_Util.mk_imp haseq_bs haseq_ind in @@ -1570,7 +1570,7 @@ let (get_optimized_haseq_axiom : (fml.FStarC_Syntax_Syntax.hash_code) } in let fml2 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun t3 -> let uu___2 = @@ -1589,10 +1589,9 @@ let (get_optimized_haseq_axiom : [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.tforall uu___2 - FStarC_Compiler_Range_Type.dummyRange) ibs1 - fml1 in + FStarC_Range_Type.dummyRange) ibs1 fml1 in let fml3 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun t3 -> let uu___2 = @@ -1611,7 +1610,7 @@ let (get_optimized_haseq_axiom : [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.tforall uu___2 - FStarC_Compiler_Range_Type.dummyRange) bs2 fml2 in + FStarC_Range_Type.dummyRange) bs2 fml2 in let axiom_lid = get_haseq_axiom_lid lid in (axiom_lid, fml3, bs2, ibs1, haseq_bs)) let (optimized_haseq_soundness_for_data : @@ -1635,16 +1634,14 @@ let (optimized_haseq_soundness_for_data : FStarC_Syntax_Syntax.comp = uu___1;_} -> let dbs1 = - let uu___2 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length bs) dbs in + let uu___2 = FStarC_List.splitAt (FStarC_List.length bs) dbs in FStar_Pervasives_Native.snd uu___2 in let dbs2 = let uu___2 = FStarC_Syntax_Subst.opening_of_binders bs in FStarC_Syntax_Subst.subst_binders uu___2 dbs1 in let dbs3 = FStarC_Syntax_Subst.open_binders dbs2 in let cond = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun t -> fun b -> let haseq_b = @@ -1655,7 +1652,7 @@ let (optimized_haseq_soundness_for_data : [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.t_haseq uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let sort_range = ((b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort).FStarC_Syntax_Syntax.pos in let haseq_b1 = @@ -1685,7 +1682,7 @@ let (optimized_haseq_soundness_for_data : haseq_b in FStarC_Syntax_Util.mk_conj t haseq_b1) FStarC_Syntax_Util.t_true dbs3 in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun t -> let uu___2 = @@ -1708,21 +1705,19 @@ let (optimized_haseq_soundness_for_data : uu___3 :: uu___4 in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.tforall uu___2 - FStarC_Compiler_Range_Type.dummyRange) dbs3 cond + FStarC_Range_Type.dummyRange) dbs3 cond | uu___1 -> FStarC_Syntax_Util.t_true let (optimized_haseq_ty : FStarC_Syntax_Syntax.sigelts -> FStarC_Syntax_Syntax.subst_elt Prims.list -> FStarC_Syntax_Syntax.univ_name Prims.list -> ((FStarC_Ident.lident * FStarC_Syntax_Syntax.term) Prims.list * - FStarC_TypeChecker_Env.env * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax) -> + FStarC_TypeChecker_Env.env * FStarC_Syntax_Syntax.term * + FStarC_Syntax_Syntax.term) -> FStarC_Syntax_Syntax.sigelt -> ((FStarC_Ident.lident * FStarC_Syntax_Syntax.term) Prims.list * - FStarC_TypeChecker_Env.env * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax * FStarC_Syntax_Syntax.term' - FStarC_Syntax_Syntax.syntax)) + FStarC_TypeChecker_Env.env * FStarC_Syntax_Syntax.term * + FStarC_Syntax_Syntax.term)) = fun all_datas_in_the_bundle -> fun usubst -> @@ -1757,7 +1752,7 @@ let (optimized_haseq_ty : let env2 = FStarC_TypeChecker_Env.push_binders env1 ibs in let t_datas = - FStarC_Compiler_List.filter + FStarC_List.filter (fun s -> match s.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -1775,7 +1770,7 @@ let (optimized_haseq_ty : | uu___6 -> failwith "Impossible") all_datas_in_the_bundle in let cond = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc1 -> fun d -> let uu___6 = @@ -1786,8 +1781,8 @@ let (optimized_haseq_ty : let uu___6 = FStarC_Syntax_Util.mk_conj guard' guard in let uu___7 = FStarC_Syntax_Util.mk_conj cond' cond in - ((FStarC_Compiler_List.op_At l_axioms - [(axiom_lid, fml)]), env2, uu___6, uu___7))) + ((FStarC_List.op_At l_axioms [(axiom_lid, fml)]), + env2, uu___6, uu___7))) let (optimized_haseq_scheme : FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.sigelt Prims.list -> @@ -1800,7 +1795,7 @@ let (optimized_haseq_scheme : fun datas -> fun env0 -> let uu___ = - let ty = FStarC_Compiler_List.hd tcs in + let ty = FStarC_List.hd tcs in match ty.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ { FStarC_Syntax_Syntax.lid = uu___1; @@ -1826,7 +1821,7 @@ let (optimized_haseq_scheme : (let env2 = FStarC_TypeChecker_Env.push_univ_vars env1 us1 in let uu___3 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (optimized_haseq_ty datas usubst us1) ([], env2, FStarC_Syntax_Util.t_true, FStarC_Syntax_Util.t_true) tcs in @@ -1858,7 +1853,7 @@ let (optimized_haseq_scheme : env3 uu___8 else ()); (let ses = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun l -> fun uu___7 -> match uu___7 with @@ -1866,7 +1861,7 @@ let (optimized_haseq_scheme : let fml1 = FStarC_Syntax_Subst.close_univ_vars us1 fml in - FStarC_Compiler_List.op_At l + FStarC_List.op_At l [{ FStarC_Syntax_Syntax.sigel = @@ -1881,7 +1876,7 @@ let (optimized_haseq_scheme : }); FStarC_Syntax_Syntax.sigrng = - FStarC_Compiler_Range_Type.dummyRange; + FStarC_Range_Type.dummyRange; FStarC_Syntax_Syntax.sigquals = [FStarC_Syntax_Syntax.InternalAssumption]; @@ -1906,8 +1901,7 @@ let (unoptimized_haseq_data : FStarC_Syntax_Syntax.term -> FStarC_Ident.lident Prims.list -> FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.sigelt -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.term) = fun usubst -> fun bs -> @@ -1921,7 +1915,7 @@ let (unoptimized_haseq_data : uu___1.FStarC_Syntax_Syntax.n in match uu___ with | FStarC_Syntax_Syntax.Tm_fvar fv -> - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun lid -> FStarC_Ident.lid_equals lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v) @@ -1940,8 +1934,7 @@ let (unoptimized_haseq_data : then true else (let uu___3 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - args in + FStarC_List.map FStar_Pervasives_Native.fst args in exists_mutual uu___3) | FStarC_Syntax_Syntax.Tm_meta { FStarC_Syntax_Syntax.tm2 = t'; @@ -1964,15 +1957,14 @@ let (unoptimized_haseq_data : -> let dbs1 = let uu___2 = - FStarC_Compiler_List.splitAt - (FStarC_Compiler_List.length bs) dbs in + FStarC_List.splitAt (FStarC_List.length bs) dbs in FStar_Pervasives_Native.snd uu___2 in let dbs2 = let uu___2 = FStarC_Syntax_Subst.opening_of_binders bs in FStarC_Syntax_Subst.subst_binders uu___2 dbs1 in let dbs3 = FStarC_Syntax_Subst.open_binders dbs2 in let cond = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun t -> fun b -> let sort = @@ -1985,7 +1977,7 @@ let (unoptimized_haseq_data : [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.t_haseq uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let haseq_sort1 = let uu___2 = is_mutual sort in if uu___2 @@ -1995,7 +1987,7 @@ let (unoptimized_haseq_data : FStarC_Syntax_Util.mk_conj t haseq_sort1) FStarC_Syntax_Util.t_true dbs3 in let cond1 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun t -> let uu___2 = @@ -2013,7 +2005,7 @@ let (unoptimized_haseq_data : [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.tforall uu___2 - FStarC_Compiler_Range_Type.dummyRange) dbs3 cond in + FStarC_Range_Type.dummyRange) dbs3 cond in FStarC_Syntax_Util.mk_conj acc cond1 | uu___1 -> acc let (unoptimized_haseq_ty : @@ -2022,8 +2014,7 @@ let (unoptimized_haseq_ty : FStarC_Syntax_Syntax.subst_elt Prims.list -> FStarC_Syntax_Syntax.univ_name Prims.list -> FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.sigelt -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) + FStarC_Syntax_Syntax.sigelt -> FStarC_Syntax_Syntax.term) = fun all_datas_in_the_bundle -> fun mutuals -> @@ -2050,7 +2041,7 @@ let (unoptimized_haseq_ty : let t1 = let uu___1 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length bs1) usubst in + (FStarC_List.length bs1) usubst in FStarC_Syntax_Subst.subst uu___1 t in let uu___1 = FStarC_Syntax_Subst.open_term bs1 t1 in (match uu___1 with @@ -2071,30 +2062,30 @@ let (unoptimized_haseq_ty : FStarC_Syntax_Syntax.fvar lid FStar_Pervasives_Native.None in let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun u -> FStarC_Syntax_Syntax.U_name u) us in FStarC_Syntax_Syntax.mk_Tm_uinst uu___2 uu___3 in let ind1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Util.arg_of_non_null_binder bs2 in FStarC_Syntax_Syntax.mk_Tm_app ind uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let ind2 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Util.arg_of_non_null_binder ibs1 in FStarC_Syntax_Syntax.mk_Tm_app ind1 uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let haseq_ind = let uu___2 = let uu___3 = FStarC_Syntax_Syntax.as_arg ind2 in [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.t_haseq uu___2 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let t_datas = - FStarC_Compiler_List.filter + FStarC_List.filter (fun s -> match s.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_datacon @@ -2111,7 +2102,7 @@ let (unoptimized_haseq_ty : | uu___2 -> failwith "Impossible") all_datas_in_the_bundle in let data_cond = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (unoptimized_haseq_data usubst bs2 haseq_ind mutuals) FStarC_Syntax_Util.t_true t_datas in let fml = @@ -2146,7 +2137,7 @@ let (unoptimized_haseq_ty : (fml.FStarC_Syntax_Syntax.hash_code) } in let fml2 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun t3 -> let uu___2 = @@ -2165,10 +2156,9 @@ let (unoptimized_haseq_ty : [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.tforall uu___2 - FStarC_Compiler_Range_Type.dummyRange) ibs1 - fml1 in + FStarC_Range_Type.dummyRange) ibs1 fml1 in let fml3 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun b -> fun t3 -> let uu___2 = @@ -2187,8 +2177,7 @@ let (unoptimized_haseq_ty : [uu___3] in FStarC_Syntax_Syntax.mk_Tm_app FStarC_Syntax_Util.tforall uu___2 - FStarC_Compiler_Range_Type.dummyRange) bs2 - fml2 in + FStarC_Range_Type.dummyRange) bs2 fml2 in FStarC_Syntax_Util.mk_conj acc fml3) let (unoptimized_haseq_scheme : FStarC_Syntax_Syntax.sigelt -> @@ -2202,7 +2191,7 @@ let (unoptimized_haseq_scheme : fun datas -> fun env0 -> let mutuals = - FStarC_Compiler_List.map + FStarC_List.map (fun ty -> match ty.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ @@ -2217,7 +2206,7 @@ let (unoptimized_haseq_scheme : -> lid | uu___ -> failwith "Impossible!") tcs in let uu___ = - let ty = FStarC_Compiler_List.hd tcs in + let ty = FStarC_List.hd tcs in match ty.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ { FStarC_Syntax_Syntax.lid = lid; @@ -2236,7 +2225,7 @@ let (unoptimized_haseq_scheme : (match uu___1 with | (usubst, us1) -> let fml = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (unoptimized_haseq_ty datas mutuals usubst us1) FStarC_Syntax_Util.t_true tcs in let se = @@ -2252,7 +2241,7 @@ let (unoptimized_haseq_scheme : { FStarC_Syntax_Syntax.sigel = uu___2; FStarC_Syntax_Syntax.sigrng = - FStarC_Compiler_Range_Type.dummyRange; + FStarC_Range_Type.dummyRange; FStarC_Syntax_Syntax.sigquals = [FStarC_Syntax_Syntax.InternalAssumption]; FStarC_Syntax_Syntax.sigmeta = @@ -2276,7 +2265,7 @@ let (check_inductive_well_typedness : fun quals -> fun lids -> let uu___ = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___1 -> match uu___1 with | { @@ -2292,7 +2281,7 @@ let (check_inductive_well_typedness : match uu___ with | (tys, datas) -> ((let uu___2 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___3 -> match uu___3 with | { @@ -2315,11 +2304,11 @@ let (check_inductive_well_typedness : "Mutually defined type contains a non-inductive element") else ()); (let univs = - if (FStarC_Compiler_List.length tys) = Prims.int_zero + if (FStarC_List.length tys) = Prims.int_zero then [] else (let uu___3 = - let uu___4 = FStarC_Compiler_List.hd tys in + let uu___4 = FStarC_List.hd tys in uu___4.FStarC_Syntax_Syntax.sigel in match uu___3 with | FStarC_Syntax_Syntax.Sig_inductive_typ @@ -2336,7 +2325,7 @@ let (check_inductive_well_typedness : | uu___4 -> failwith "Impossible, can't happen!") in let env0 = env in let uu___2 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun tc -> fun uu___3 -> match uu___3 with @@ -2347,14 +2336,14 @@ let (check_inductive_well_typedness : let g' = FStarC_TypeChecker_Rel.universe_inequality FStarC_Syntax_Syntax.U_zero tc_u in - ((let uu___6 = FStarC_Compiler_Debug.low () in + ((let uu___6 = FStarC_Debug.low () in if uu___6 then let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt tc1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Checked inductive: %s\n" uu___7 else ()); (let uu___6 = @@ -2369,7 +2358,7 @@ let (check_inductive_well_typedness : | (env1, tcs, g) -> let g1 = FStarC_TypeChecker_Rel.resolve_implicits env1 g in let uu___3 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun se -> fun uu___4 -> match uu___4 with @@ -2387,13 +2376,12 @@ let (check_inductive_well_typedness : | (datas1, g2) -> let uu___4 = let tc_universe_vars = - FStarC_Compiler_List.map - FStar_Pervasives_Native.snd tcs in + FStarC_List.map FStar_Pervasives_Native.snd tcs in let g3 = let uu___5 = let uu___6 = FStarC_Class_Listlike.from_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) tc_universe_vars in (uu___6, (FStar_Pervasives_Native.snd @@ -2410,30 +2398,28 @@ let (check_inductive_well_typedness : (g2.FStarC_TypeChecker_Common.implicits) } in (let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_GenUniverses in + FStarC_Effect.op_Bang dbg_GenUniverses in if uu___6 then let uu___7 = FStarC_TypeChecker_Rel.guard_to_string env1 g3 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "@@@@@@Guard before (possible) generalization: %s\n" uu___7 else ()); FStarC_TypeChecker_Rel.force_trivial_guard env0 g3; - if - (FStarC_Compiler_List.length univs) = - Prims.int_zero + if (FStarC_List.length univs) = Prims.int_zero then generalize_and_inst_within env0 tcs datas1 else (let uu___8 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst tcs in + FStarC_List.map FStar_Pervasives_Native.fst + tcs in (uu___8, datas1)) in (match uu___4 with | (tcs1, datas2) -> let tcs2 = - FStarC_Compiler_List.map + FStarC_List.map (fun se -> match se.FStarC_Syntax_Syntax.sigel with | FStarC_Syntax_Syntax.Sig_inductive_typ @@ -2452,21 +2438,33 @@ let (check_inductive_well_typedness : let fail expected inferred = let uu___6 = let uu___7 = - FStarC_Syntax_Print.tscheme_to_string - expected in + let uu___8 = + FStarC_Errors_Msg.text + "Expected an inductive with type" in + let uu___9 = + FStarC_Syntax_Print.tscheme_to_doc + expected in + FStarC_Pprint.op_Hat_Slash_Hat + uu___8 uu___9 in let uu___8 = - FStarC_Syntax_Print.tscheme_to_string - inferred in - FStarC_Compiler_Util.format2 - "Expected an inductive with type %s; got %s" - uu___7 uu___8 in + let uu___9 = + let uu___10 = + FStarC_Errors_Msg.text + "Got" in + let uu___11 = + FStarC_Syntax_Print.tscheme_to_doc + inferred in + FStarC_Pprint.op_Hat_Slash_Hat + uu___10 uu___11 in + [uu___9] in + uu___7 :: uu___8 in FStarC_Errors.raise_error FStarC_Syntax_Syntax.has_range_sigelt se FStarC_Errors_Codes.Fatal_UnexpectedInductivetype () (Obj.magic - FStarC_Errors_Msg.is_error_message_string) + FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___6) in let copy_binder_attrs_from_val binders1 expected = @@ -2475,11 +2473,11 @@ let (check_inductive_well_typedness : let uu___7 = FStarC_TypeChecker_Normalize.get_n_binders env1 - (FStarC_Compiler_List.length + (FStarC_List.length binders1) expected in FStar_Pervasives_Native.fst uu___7 in - FStarC_Compiler_List.map + FStarC_List.map (fun uu___7 -> match uu___7 with | { @@ -2494,22 +2492,21 @@ let (check_inductive_well_typedness : -> (attrs, pqual)) uu___6 in if - (FStarC_Compiler_List.length + (FStarC_List.length expected_attrs) <> - (FStarC_Compiler_List.length - binders1) + (FStarC_List.length binders1) then let uu___6 = let uu___7 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length + FStarC_Util.string_of_int + (FStarC_List.length binders1) in let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term expected in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Could not get %s type parameters from val type %s" uu___7 uu___8 in FStarC_Errors.raise_error @@ -2521,7 +2518,7 @@ let (check_inductive_well_typedness : FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___6) else - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___7 -> fun b -> match uu___7 with @@ -2556,7 +2553,7 @@ let (check_inductive_well_typedness : = pqual; FStarC_Syntax_Syntax.binder_attrs = - (FStarC_Compiler_List.op_At + (FStarC_List.op_At b.FStarC_Syntax_Syntax.binder_attrs ex_attrs) })) expected_attrs @@ -2593,10 +2590,8 @@ let (check_inductive_well_typedness : | FStar_Pervasives_Native.Some (expected_typ, uu___7) -> if - (FStarC_Compiler_List.length - univs1) - = - (FStarC_Compiler_List.length + (FStarC_List.length univs1) = + (FStarC_List.length (FStar_Pervasives_Native.fst expected_typ)) then @@ -2680,12 +2675,12 @@ let (check_inductive_well_typedness : fail expected_typ uu___9)) | uu___5 -> se) tcs1 in let tcs3 = - FStarC_Compiler_List.map + FStarC_List.map (check_sig_inductive_injectivity_on_params env0) tcs2 in let is_injective l = let uu___5 = - FStarC_Compiler_List.tryPick + FStarC_List.tryPick (fun se -> let uu___6 = se.FStarC_Syntax_Syntax.sigel in @@ -2717,7 +2712,7 @@ let (check_inductive_well_typedness : | FStar_Pervasives_Native.None -> false | FStar_Pervasives_Native.Some i -> i in let datas3 = - FStarC_Compiler_List.map + FStarC_List.map (fun se -> let uu___5 = se.FStarC_Syntax_Syntax.sigel in @@ -2769,7 +2764,7 @@ let (check_inductive_well_typedness : let uu___5 = FStarC_TypeChecker_Env.get_range env0 in let uu___6 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun s -> s.FStarC_Syntax_Syntax.sigattrs) ses in { @@ -2777,8 +2772,7 @@ let (check_inductive_well_typedness : (FStarC_Syntax_Syntax.Sig_bundle { FStarC_Syntax_Syntax.ses = - (FStarC_Compiler_List.op_At tcs3 - datas3); + (FStarC_List.op_At tcs3 datas3); FStarC_Syntax_Syntax.lids = lids }); FStarC_Syntax_Syntax.sigrng = uu___5; @@ -2826,7 +2820,7 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.gen_bv "projectee" (FStar_Pervasives_Native.Some p) ptyp in let inst_univs = - FStarC_Compiler_List.map + FStarC_List.map (fun u -> FStarC_Syntax_Syntax.U_name u) uvs in let tps = inductive_tps in let arg_typ = @@ -2842,9 +2836,9 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.Tm_uinst uu___1 in FStarC_Syntax_Syntax.mk uu___ p in let args = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Util.arg_of_non_null_binder - (FStarC_Compiler_List.op_At tps indices) in + (FStarC_List.op_At tps indices) in FStarC_Syntax_Syntax.mk_Tm_app inst_tc args p in let unrefined_arg_binder = let uu___ = projectee arg_typ in @@ -2889,10 +2883,10 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.sort = sort } in FStarC_Syntax_Syntax.mk_binder uu___1) in - let ntps = FStarC_Compiler_List.length tps in + let ntps = FStarC_List.length tps in let all_params = let uu___ = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> { FStarC_Syntax_Syntax.binder_bv = @@ -2905,9 +2899,9 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.binder_attrs = (b.FStarC_Syntax_Syntax.binder_attrs) }) tps in - FStarC_Compiler_List.op_At uu___ fields in + FStarC_List.op_At uu___ fields in let imp_binders = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___ = mk_implicit @@ -2920,14 +2914,14 @@ let (mk_discriminator_and_indexed_projectors : (b.FStarC_Syntax_Syntax.binder_positivity); FStarC_Syntax_Syntax.binder_attrs = (b.FStarC_Syntax_Syntax.binder_attrs) - }) (FStarC_Compiler_List.op_At tps indices) in + }) (FStarC_List.op_At tps indices) in let early_prims_inductive = (let uu___ = FStarC_TypeChecker_Env.current_module env in FStarC_Ident.lid_equals FStarC_Parser_Const.prims_lid uu___) && - (FStarC_Compiler_List.existsb + (FStarC_List.existsb (fun s -> let uu___ = let uu___1 = @@ -2935,7 +2929,11 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Ident.string_of_id uu___1 in s = uu___) early_prims_inductives) in let discriminator_ses = - if fvq <> FStarC_Syntax_Syntax.Data_ctor + let uu___ = + (fvq <> FStarC_Syntax_Syntax.Data_ctor) || + (FStarC_Syntax_Util.has_attribute attrs + FStarC_Parser_Const.no_auto_projectors_decls_attr) in + if uu___ then [] else (let discriminator_name = @@ -2946,27 +2944,27 @@ let (mk_discriminator_and_indexed_projectors : (FStarC_Syntax_Util.has_attribute attrs FStarC_Parser_Const.no_auto_projectors_attr) in let quals = - let uu___1 = - FStarC_Compiler_List.filter - (fun uu___2 -> - match uu___2 with + let uu___2 = + FStarC_List.filter + (fun uu___3 -> + match uu___3 with | FStarC_Syntax_Syntax.Inline_for_extraction -> true | FStarC_Syntax_Syntax.NoExtract -> true | FStarC_Syntax_Syntax.Private -> true - | uu___3 -> false) iquals in - FStarC_Compiler_List.op_At + | uu___4 -> false) iquals in + FStarC_List.op_At ((FStarC_Syntax_Syntax.Discriminator lid) :: (if only_decl then [FStarC_Syntax_Syntax.Logic; FStarC_Syntax_Syntax.Assumption] - else [])) uu___1 in + else [])) uu___2 in let binders = - FStarC_Compiler_List.op_At imp_binders + FStarC_List.op_At imp_binders [unrefined_arg_binder] in let t = let bool_typ = @@ -2977,12 +2975,12 @@ let (mk_discriminator_and_indexed_projectors : else FStarC_Syntax_Syntax.mk_Total FStarC_Syntax_Util.t_bool in - let uu___1 = + let uu___2 = FStarC_Syntax_Util.arrow binders bool_typ in FStarC_Syntax_Subst.close_univ_vars uvs - uu___1 in + uu___2 in let decl = - let uu___1 = + let uu___2 = FStarC_Ident.range_of_lid discriminator_name in { @@ -2994,7 +2992,7 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.us2 = uvs; FStarC_Syntax_Syntax.t2 = t }); - FStarC_Syntax_Syntax.sigrng = uu___1; + FStarC_Syntax_Syntax.sigrng = uu___2; FStarC_Syntax_Syntax.sigquals = quals; FStarC_Syntax_Syntax.sigmeta = FStarC_Syntax_Syntax.default_sigmeta; @@ -3004,17 +3002,17 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } in - (let uu___2 = - FStarC_Compiler_Effect.op_Bang dbg_LogTypes in - if uu___2 + (let uu___3 = + FStarC_Effect.op_Bang dbg_LogTypes in + if uu___3 then - let uu___3 = + let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt decl in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Declaration of a discriminator %s\n" - uu___3 + uu___4 else ()); if only_decl then [decl] @@ -3024,104 +3022,104 @@ let (mk_discriminator_and_indexed_projectors : then FStarC_Syntax_Util.exp_true_bool else (let arg_pats = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun j -> - fun uu___4 -> - match uu___4 with + fun uu___5 -> + match uu___5 with | { FStarC_Syntax_Syntax.binder_bv = x; FStarC_Syntax_Syntax.binder_qual = imp; FStarC_Syntax_Syntax.binder_positivity - = uu___5; + = uu___6; FStarC_Syntax_Syntax.binder_attrs - = uu___6;_} + = uu___7;_} -> let b = FStarC_Syntax_Syntax.is_bqual_implicit imp in if b && (j < ntps) then - let uu___7 = + let uu___8 = pos (FStarC_Syntax_Syntax.Pat_dot_term FStar_Pervasives_Native.None) in - (uu___7, b) + (uu___8, b) else - (let uu___8 = - let uu___9 = - let uu___10 = - let uu___11 = + (let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = FStarC_Ident.string_of_id x.FStarC_Syntax_Syntax.ppname in FStarC_Syntax_Syntax.gen_bv - uu___11 + uu___12 FStar_Pervasives_Native.None FStarC_Syntax_Syntax.tun in FStarC_Syntax_Syntax.Pat_var - uu___10 in - pos uu___9 in - (uu___8, b))) + uu___11 in + pos uu___10 in + (uu___9, b))) all_params in let pat_true = - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = FStarC_Syntax_Syntax.lid_as_fv lid (FStar_Pervasives_Native.Some fvq) in - (uu___7, + (uu___8, FStar_Pervasives_Native.None, arg_pats) in FStarC_Syntax_Syntax.Pat_cons - uu___6 in - pos uu___5 in - (uu___4, + uu___7 in + pos uu___6 in + (uu___5, FStar_Pervasives_Native.None, FStarC_Syntax_Util.exp_true_bool) in let pat_false = - let uu___4 = - let uu___5 = - let uu___6 = + let uu___5 = + let uu___6 = + let uu___7 = FStarC_Syntax_Syntax.new_bv FStar_Pervasives_Native.None FStarC_Syntax_Syntax.tun in FStarC_Syntax_Syntax.Pat_var - uu___6 in - pos uu___5 in - (uu___4, + uu___7 in + pos uu___6 in + (uu___5, FStar_Pervasives_Native.None, FStarC_Syntax_Util.exp_false_bool) in let arg_exp = FStarC_Syntax_Syntax.bv_to_name unrefined_arg_binder.FStarC_Syntax_Syntax.binder_bv in - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = FStarC_Syntax_Util.branch pat_true in - let uu___8 = - let uu___9 = + let uu___9 = + let uu___10 = FStarC_Syntax_Util.branch pat_false in - [uu___9] in - uu___7 :: uu___8 in + [uu___10] in + uu___8 :: uu___9 in { FStarC_Syntax_Syntax.scrutinee = arg_exp; FStarC_Syntax_Syntax.ret_opt = FStar_Pervasives_Native.None; FStarC_Syntax_Syntax.brs = - uu___6; + uu___7; FStarC_Syntax_Syntax.rc_opt1 = FStar_Pervasives_Native.None } in - FStarC_Syntax_Syntax.Tm_match uu___5 in - FStarC_Syntax_Syntax.mk uu___4 p) in + FStarC_Syntax_Syntax.Tm_match uu___6 in + FStarC_Syntax_Syntax.mk uu___5 p) in let imp = FStarC_Syntax_Util.abs binders body FStar_Pervasives_Native.None in @@ -3130,38 +3128,37 @@ let (mk_discriminator_and_indexed_projectors : then t else FStarC_Syntax_Syntax.tun in let lb = - let uu___3 = - let uu___4 = + let uu___4 = + let uu___5 = FStarC_Syntax_Syntax.lid_and_dd_as_fv discriminator_name FStar_Pervasives_Native.None in - FStar_Pervasives.Inr uu___4 in - let uu___4 = + FStar_Pervasives.Inr uu___5 in + let uu___5 = FStarC_Syntax_Subst.close_univ_vars uvs imp in - FStarC_Syntax_Util.mk_letbinding uu___3 + FStarC_Syntax_Util.mk_letbinding uu___4 uvs lbtyp FStarC_Parser_Const.effect_Tot_lid - uu___4 [] - FStarC_Compiler_Range_Type.dummyRange in + uu___5 [] FStarC_Range_Type.dummyRange in let impl = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - FStarC_Compiler_Util.right + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in - (uu___7.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - [uu___6] in + (uu___8.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in + [uu___7] in { FStarC_Syntax_Syntax.lbs1 = (false, [lb]); - FStarC_Syntax_Syntax.lids1 = uu___5 + FStarC_Syntax_Syntax.lids1 = uu___6 } in - FStarC_Syntax_Syntax.Sig_let uu___4 in + FStarC_Syntax_Syntax.Sig_let uu___5 in { - FStarC_Syntax_Syntax.sigel = uu___3; + FStarC_Syntax_Syntax.sigel = uu___4; FStarC_Syntax_Syntax.sigrng = p; FStarC_Syntax_Syntax.sigquals = quals; FStarC_Syntax_Syntax.sigmeta = @@ -3172,31 +3169,29 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.sigopts = FStar_Pervasives_Native.None } in - (let uu___4 = - FStarC_Compiler_Effect.op_Bang - dbg_LogTypes in - if uu___4 + (let uu___5 = + FStarC_Effect.op_Bang dbg_LogTypes in + if uu___5 then - let uu___5 = + let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt impl in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Implementation of a discriminator %s\n" - uu___5 + uu___6 else ()); [decl; impl])) in let arg_exp = FStarC_Syntax_Syntax.bv_to_name arg_binder.FStarC_Syntax_Syntax.binder_bv in let binders = - FStarC_Compiler_List.op_At imp_binders - [arg_binder] in + FStarC_List.op_At imp_binders [arg_binder] in let arg = FStarC_Syntax_Util.arg_of_non_null_binder arg_binder in let subst = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___ -> match uu___ with @@ -3237,7 +3232,7 @@ let (mk_discriminator_and_indexed_projectors : then [] else (let uu___2 = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___3 -> match uu___3 with @@ -3289,7 +3284,7 @@ let (mk_discriminator_and_indexed_projectors : else q in let quals1 = let iquals1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___7 -> match uu___7 with | FStarC_Syntax_Syntax.Inline_for_extraction @@ -3306,7 +3301,7 @@ let (mk_discriminator_and_indexed_projectors : (x.FStarC_Syntax_Syntax.ppname))) :: iquals1) in let attrs1 = - FStarC_Compiler_List.op_At + FStarC_List.op_At (if only_decl then [] else @@ -3343,7 +3338,7 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in ((let uu___8 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LogTypes in if uu___8 then @@ -3351,7 +3346,7 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt decl in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Declaration of a projector %s\n" uu___9 else ()); @@ -3367,7 +3362,7 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None FStarC_Syntax_Syntax.tun in let arg_pats = - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun j -> fun uu___9 -> match uu___9 with @@ -3472,10 +3467,11 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.NT uu___13 in [uu___12] in + let uu___12 = + FStarC_Syntax_Util.comp_result + result_comp in FStarC_Syntax_Subst.subst - uu___11 - (FStarC_Syntax_Util.comp_result - result_comp) in + uu___11 uu___12 in FStarC_Syntax_Subst.close uu___9 uu___10 in let return_binder = @@ -3487,8 +3483,7 @@ let (mk_discriminator_and_indexed_projectors : [uu___11] in FStarC_Syntax_Subst.close_binders uu___10 in - FStarC_Compiler_List.hd - uu___9 in + FStarC_List.hd uu___9 in let returns_annotation = let use_eq = true in FStar_Pervasives_Native.Some @@ -3559,7 +3554,7 @@ let (mk_discriminator_and_indexed_projectors : = []; FStarC_Syntax_Syntax.lbpos = - FStarC_Compiler_Range_Type.dummyRange + FStarC_Range_Type.dummyRange } in let impl = let uu___9 = @@ -3567,7 +3562,7 @@ let (mk_discriminator_and_indexed_projectors : let uu___11 = let uu___12 = let uu___13 = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in (uu___13.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in [uu___12] in @@ -3598,7 +3593,7 @@ let (mk_discriminator_and_indexed_projectors : FStar_Pervasives_Native.None } in (let uu___10 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LogTypes in if uu___10 then @@ -3606,14 +3601,14 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Class_Show.show FStarC_Syntax_Print.showable_sigelt impl in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Implementation of a projector %s\n" uu___11 else ()); if no_decl then [impl] else [decl; impl]))) fields in - FStarC_Compiler_List.flatten uu___2) in + FStarC_List.flatten uu___2) in let no_plugin se = let not_plugin_attr t = let h = FStarC_Syntax_Util.head_of t in @@ -3622,7 +3617,7 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Parser_Const.plugin_attr h in Prims.op_Negation uu___ in let uu___ = - FStarC_Compiler_List.filter not_plugin_attr + FStarC_List.filter not_plugin_attr se.FStarC_Syntax_Syntax.sigattrs in { FStarC_Syntax_Syntax.sigel = @@ -3639,8 +3634,8 @@ let (mk_discriminator_and_indexed_projectors : FStarC_Syntax_Syntax.sigopts = (se.FStarC_Syntax_Syntax.sigopts) } in - FStarC_Compiler_List.map no_plugin - (FStarC_Compiler_List.op_At discriminator_ses + FStarC_List.map no_plugin + (FStarC_List.op_At discriminator_ses projectors_ses) let (mk_data_operations : FStarC_Syntax_Syntax.qualifier Prims.list -> @@ -3674,13 +3669,13 @@ let (mk_data_operations : | (formals, uu___4) -> let uu___5 = let tps_opt = - FStarC_Compiler_Util.find_map tcs + FStarC_Util.find_map tcs (fun se1 -> let uu___6 = let uu___7 = let uu___8 = FStarC_Syntax_Util.lid_of_sigelt se1 in - FStarC_Compiler_Util.must uu___8 in + FStarC_Util.must uu___8 in FStarC_Ident.lid_equals typ_lid uu___7 in if uu___6 then @@ -3701,9 +3696,8 @@ let (mk_data_operations : -> FStar_Pervasives_Native.Some (tps, typ0, - ((FStarC_Compiler_List.length - constrs) - > Prims.int_one)) + ((FStarC_List.length constrs) > + Prims.int_one)) | uu___7 -> failwith "Impossible" else FStar_Pervasives_Native.None) in match tps_opt with @@ -3730,8 +3724,8 @@ let (mk_data_operations : let typ01 = let uu___6 = FStarC_Syntax_Subst.shift_subst - (FStarC_Compiler_List.length - inductive_tps1) univ_opening in + (FStarC_List.length inductive_tps1) + univ_opening in FStarC_Syntax_Subst.subst uu___6 typ0 in let uu___6 = FStarC_Syntax_Util.arrow_formals typ01 in @@ -3739,7 +3733,7 @@ let (mk_data_operations : | (indices, uu___7) -> let refine_domain = let uu___8 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___9 -> match uu___9 with | FStarC_Syntax_Syntax.RecordConstructor @@ -3758,7 +3752,7 @@ let (mk_data_operations : | uu___9 -> FStar_Pervasives_Native.None in let uu___8 = - FStarC_Compiler_Util.find_map + FStarC_Util.find_map se.FStarC_Syntax_Syntax.sigquals filter_records in match uu___8 with @@ -3767,12 +3761,11 @@ let (mk_data_operations : | FStar_Pervasives_Native.Some q -> q in let fields = let uu___8 = - FStarC_Compiler_Util.first_N n_typars - formals in + FStarC_Util.first_N n_typars formals in match uu___8 with | (imp_tps, fields1) -> let rename = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___9 -> fun uu___10 -> match (uu___9, uu___10) diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_TcTerm.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcTerm.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_TcTerm.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcTerm.ml index 3bf3577a273..eb8355a56e6 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_TcTerm.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TcTerm.ml @@ -1,22 +1,19 @@ open Prims -let (dbg_Exports : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Exports" -let (dbg_LayeredEffects : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LayeredEffects" -let (dbg_NYC : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "NYC" -let (dbg_Patterns : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Patterns" -let (dbg_Range : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Range" -let (dbg_RelCheck : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "RelCheck" -let (dbg_RFD : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "RFD" -let (dbg_Tac : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Tac" -let (dbg_UniverseOf : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "UniverseOf" +let (dbg_Exports : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Exports" +let (dbg_LayeredEffects : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LayeredEffects" +let (dbg_NYC : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "NYC" +let (dbg_Patterns : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Patterns" +let (dbg_Range : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Range" +let (dbg_RelCheck : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "RelCheck" +let (dbg_RFD : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "RFD" +let (dbg_Tac : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Tac" +let (dbg_UniverseOf : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "UniverseOf" let (instantiate_both : FStarC_TypeChecker_Env.env -> FStarC_TypeChecker_Env.env) = fun env -> @@ -298,11 +295,11 @@ let (check_no_escape : let t1 = if try_norm then norm env t else t in let fvs' = FStarC_Syntax_Free.names t1 in let uu___2 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun x -> FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) x (Obj.magic fvs')) fvs in match uu___2 with @@ -352,7 +349,7 @@ let (check_no_escape : let (check_expected_aqual_for_binder : FStarC_Syntax_Syntax.aqual -> FStarC_Syntax_Syntax.binder -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.aqual) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.aqual) = fun aq -> fun b -> @@ -400,7 +397,7 @@ let (check_erasable_binder_attributes : fun env -> fun attrs -> fun binder_ty -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun attr -> let uu___ = (FStarC_Syntax_Util.is_fvar FStarC_Parser_Const.erasable_attr @@ -442,8 +439,7 @@ let (maybe_extend_subst : :: s let (set_lcomp_result : FStarC_TypeChecker_Common.lcomp -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_TypeChecker_Common.lcomp) + FStarC_Syntax_Syntax.typ -> FStarC_TypeChecker_Common.lcomp) = fun lc -> fun t -> @@ -472,7 +468,7 @@ let (maybe_warn_on_use : match uu___ with | FStar_Pervasives_Native.None -> () | FStar_Pervasives_Native.Some attrs -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun a -> let uu___1 = FStarC_Syntax_Util.head_and_args a in match uu___1 with @@ -489,7 +485,7 @@ let (maybe_warn_on_use : uu___6)::[] -> let uu___7 = let uu___8 = FStarC_Errors_Msg.text s in [uu___8] in - FStarC_Compiler_List.op_At m uu___7 + FStarC_List.op_At m uu___7 | uu___2 -> m in (match head.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_fvar attr_fv when @@ -502,7 +498,7 @@ let (maybe_warn_on_use : let uu___3 = FStarC_Ident.string_of_lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Every use of %s triggers a warning" uu___3 in FStarC_Errors_Msg.text uu___2 in let uu___2 = msg_arg [m] in @@ -522,8 +518,7 @@ let (maybe_warn_on_use : let uu___3 = FStarC_Ident.string_of_lid (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 "%s is deprecated" - uu___3 in + FStarC_Util.format1 "%s is deprecated" uu___3 in FStarC_Errors_Msg.text uu___2 in let uu___2 = msg_arg [m] in FStarC_Errors.log_issue FStarC_Ident.hasrange_lident @@ -568,7 +563,7 @@ let (value_check_expected_typ : lc t' use_eq in (match uu___3 with | (e1, lc1, g) -> - ((let uu___5 = FStarC_Compiler_Debug.medium () in + ((let uu___5 = FStarC_Debug.medium () in if uu___5 then let uu___6 = @@ -580,7 +575,7 @@ let (value_check_expected_typ : FStarC_TypeChecker_Rel.guard_to_string env g in let uu___9 = FStarC_TypeChecker_Rel.guard_to_string env guard in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "value_check_expected_typ: type is %s<:%s \tguard is %s, %s\n" uu___6 uu___7 uu___8 uu___9 else ()); @@ -654,14 +649,14 @@ let (check_expected_effect : let uu___1 = FStarC_Syntax_Util.is_pure_comp c1 in if uu___1 then - FStarC_Syntax_Syntax.mk_Total - (FStarC_Syntax_Util.comp_result c1) + let uu___2 = FStarC_Syntax_Util.comp_result c1 in + FStarC_Syntax_Syntax.mk_Total uu___2 else (let uu___3 = FStarC_Syntax_Util.is_pure_or_ghost_comp c1 in if uu___3 then - FStarC_Syntax_Syntax.mk_GTotal - (FStarC_Syntax_Util.comp_result c1) + let uu___4 = FStarC_Syntax_Util.comp_result c1 in + FStarC_Syntax_Syntax.mk_GTotal uu___4 else failwith "Impossible: Expected pure_or_ghost comp") in let uu___1 = let ct = FStarC_Syntax_Util.comp_result c in @@ -672,8 +667,8 @@ let (check_expected_effect : let uu___2 = ((FStarC_Options.ml_ish ()) && (let uu___3 = FStarC_Parser_Const.effect_ALL_lid () in - FStarC_Ident.lid_equals uu___3 - (FStarC_Syntax_Util.comp_effect_name c))) + let uu___4 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_Ident.lid_equals uu___3 uu___4)) || (((FStarC_Options.ml_ish ()) && (FStarC_Options.lax ())) @@ -707,8 +702,10 @@ let (check_expected_effect : (uu___7, c, FStar_Pervasives_Native.None) else (let norm_eff_name = + let uu___8 = + FStarC_Syntax_Util.comp_effect_name c in FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + uu___8 in let uu___8 = FStarC_TypeChecker_Env.is_layered_effect env norm_eff_name in @@ -721,15 +718,16 @@ let (check_expected_effect : | FStar_Pervasives_Native.None -> let uu___9 = let uu___10 = + let uu___11 = + FStarC_Syntax_Util.comp_effect_name + c in FStarC_Class_Show.show - FStarC_Ident.showable_lident - (FStarC_Syntax_Util.comp_effect_name - c) in + FStarC_Ident.showable_lident uu___11 in let uu___11 = FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Range_Ops.showable_range e.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Missing annotation for a layered effect (%s) computation at %s" uu___10 uu___11 in FStarC_Errors.raise_error @@ -844,8 +842,7 @@ let (check_expected_effect : c4.FStarC_Syntax_Syntax.pos "check_expected_effect.c.after_assume" env c4; - (let uu___8 = - FStarC_Compiler_Debug.medium () in + (let uu___8 = FStarC_Debug.medium () in if uu___8 then let uu___9 = @@ -862,7 +859,7 @@ let (check_expected_effect : FStarC_Class_Show.show FStarC_Class_Show.showable_bool use_eq in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "In check_expected_effect, asking rel to solve the problem on e=(%s) and c=(%s), expected_c=(%s), and use_eq=%s\n" uu___9 uu___10 uu___11 uu___12 else ()); @@ -880,29 +877,30 @@ let (check_expected_effect : "Could not prove post-condition" in FStarC_TypeChecker_Util.label_guard uu___10 uu___11 g in - ((let uu___11 = - FStarC_Compiler_Debug.medium () in + ((let uu___11 = FStarC_Debug.medium () in if uu___11 then let uu___12 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range e1.FStarC_Syntax_Syntax.pos in let uu___13 = FStarC_TypeChecker_Rel.guard_to_string env g1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "(%s) DONE check_expected_effect;\n\tguard is: %s\n" uu___12 uu___13 else ()); (let e2 = + let uu___11 = + FStarC_Syntax_Util.comp_effect_name + c4 in + let uu___12 = + FStarC_Syntax_Util.comp_effect_name + expected_c in + let uu___13 = + FStarC_Syntax_Util.comp_result c4 in FStarC_TypeChecker_Util.maybe_lift - env e1 - (FStarC_Syntax_Util.comp_effect_name - c4) - (FStarC_Syntax_Util.comp_effect_name - expected_c) - (FStarC_Syntax_Util.comp_result - c4) in + env e1 uu___11 uu___12 uu___13 in let uu___11 = FStarC_Class_Monoid.op_Plus_Plus FStarC_TypeChecker_Common.monoid_guard_t @@ -932,18 +930,16 @@ let (print_expected_ty_str : FStarC_TypeChecker_Env.env -> Prims.string) = | FStar_Pervasives_Native.Some (t, use_eq) -> let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - let uu___2 = FStarC_Compiler_Util.string_of_bool use_eq in - FStarC_Compiler_Util.format2 "Expected type is (%s, use_eq = %s)" - uu___1 uu___2 + let uu___2 = FStarC_Util.string_of_bool use_eq in + FStarC_Util.format2 "Expected type is (%s, use_eq = %s)" uu___1 + uu___2 let (print_expected_ty : FStarC_TypeChecker_Env.env -> unit) = fun env -> - let uu___ = print_expected_ty_str env in - FStarC_Compiler_Util.print1 "%s\n" uu___ + let uu___ = print_expected_ty_str env in FStarC_Util.print1 "%s\n" uu___ let rec (get_pat_vars' : FStarC_Syntax_Syntax.bv Prims.list -> Prims.bool -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.t) = fun uu___2 -> fun uu___1 -> @@ -971,12 +967,12 @@ let rec (get_pat_vars' : then FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) all else FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) ())) | (FStarC_Syntax_Syntax.Tm_fvar fv, (uu___2, FStar_Pervasives_Native.Some @@ -996,13 +992,13 @@ let rec (get_pat_vars' : then FStarC_Class_Setlike.inter () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic hdvs) (Obj.magic tlvs) else FStarC_Class_Setlike.union () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic hdvs) (Obj.magic tlvs))) | (FStarC_Syntax_Syntax.Tm_fvar fv, @@ -1025,16 +1021,15 @@ let rec (get_pat_vars' : (Obj.repr (FStarC_Class_Setlike.empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) ())))) uu___2 uu___1 uu___ let (get_pat_vars : FStarC_Syntax_Syntax.bv Prims.list -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.bv FStarC_Compiler_FlatSet.t) + FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.bv FStarC_FlatSet.t) = fun all -> fun pats -> get_pat_vars' all false pats let (check_pat_fvs : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.binder Prims.list -> unit) @@ -1045,14 +1040,13 @@ let (check_pat_fvs : fun bs -> let pat_vars = let uu___ = - FStarC_Compiler_List.map - (fun b -> b.FStarC_Syntax_Syntax.binder_bv) bs in + FStarC_List.map (fun b -> b.FStarC_Syntax_Syntax.binder_bv) bs in let uu___1 = FStarC_TypeChecker_Normalize.normalize [FStarC_TypeChecker_Env.Beta] env pats in get_pat_vars uu___ uu___1 in let uu___ = - FStarC_Compiler_Util.find_opt + FStarC_Util.find_opt (fun uu___1 -> match uu___1 with | { FStarC_Syntax_Syntax.binder_bv = b; @@ -1062,7 +1056,7 @@ let (check_pat_fvs : let uu___5 = FStarC_Class_Setlike.mem () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) b (Obj.magic pat_vars) in Prims.op_Negation uu___5) bs in @@ -1077,7 +1071,7 @@ let (check_pat_fvs : let uu___4 = let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Pattern misses at least one bound variable: %s" uu___5 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range rng FStarC_Errors_Codes.Warning_SMTPatternIllFormed () @@ -1108,8 +1102,7 @@ let (check_no_smt_theory_symbols : FStarC_Parser_Const.cons_lid -> let uu___5 = pat_terms hd in - let uu___6 = pat_terms tl in - FStarC_Compiler_List.op_At uu___5 uu___6 + let uu___6 = pat_terms tl in FStarC_List.op_At uu___5 uu___6 | (FStarC_Syntax_Syntax.Tm_fvar fv, uu___2::(pat, uu___3)::[]) when FStarC_Syntax_Syntax.fv_eq_lid fv @@ -1150,13 +1143,13 @@ let (check_no_smt_theory_symbols : FStarC_Syntax_Syntax.args = args;_} -> let uu___1 = aux t2 in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun uu___2 -> match uu___2 with | (t3, uu___3) -> - let uu___4 = aux t3 in - FStarC_Compiler_List.op_At acc uu___4) uu___1 args + let uu___4 = aux t3 in FStarC_List.op_At acc uu___4) + uu___1 args | FStarC_Syntax_Syntax.Tm_ascribed { FStarC_Syntax_Syntax.tm = t2; FStarC_Syntax_Syntax.asc = uu___1; @@ -1167,9 +1160,8 @@ let (check_no_smt_theory_symbols : { FStarC_Syntax_Syntax.tm2 = t2; FStarC_Syntax_Syntax.meta = uu___1;_} -> aux t2 in - let tlist = - let uu___ = pat_terms t in FStarC_Compiler_List.collect aux uu___ in - if (FStarC_Compiler_List.length tlist) = Prims.int_zero + let tlist = let uu___ = pat_terms t in FStarC_List.collect aux uu___ in + if (FStarC_List.length tlist) = Prims.int_zero then () else (let uu___1 = @@ -1221,7 +1213,7 @@ let (check_smt_pat : let (guard_letrecs : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.binders -> - FStarC_Syntax_Syntax.comp' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.comp -> (FStarC_Syntax_Syntax.lbname * FStarC_Syntax_Syntax.typ * FStarC_Syntax_Syntax.univ_names) Prims.list) = @@ -1338,7 +1330,7 @@ let (guard_letrecs : (env.FStarC_TypeChecker_Env.missing_decl) } in let decreases_clause bs c = - (let uu___1 = FStarC_Compiler_Debug.low () in + (let uu___1 = FStarC_Debug.low () in if uu___1 then let uu___2 = @@ -1347,13 +1339,13 @@ let (guard_letrecs : FStarC_Syntax_Print.showable_binder) bs in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Building a decreases clause over (%s) and %s\n" uu___2 uu___3 else ()); (let filter_types_and_functions bs1 = let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun binder -> match uu___2 with @@ -1387,10 +1379,10 @@ let (guard_letrecs : | uu___5 -> arg in ((arg1 :: out), env3))) ([], env1) bs1 in match uu___1 with - | (out_rev, env2) -> FStarC_Compiler_List.rev out_rev in + | (out_rev, env2) -> FStarC_List.rev out_rev in let cflags = FStarC_Syntax_Util.comp_flags c in let uu___1 = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.DECREASES uu___3 -> true @@ -1452,12 +1444,11 @@ let (guard_letrecs : FStarC_Syntax_Syntax.args = args2;_}) -> ((warn h1 h2) || - ((FStarC_Compiler_List.length args1) <> - (FStarC_Compiler_List.length args2))) + ((FStarC_List.length args1) <> + (FStarC_List.length args2))) || - (let uu___3 = - FStarC_Compiler_List.zip args1 args2 in - FStarC_Compiler_List.existsML + (let uu___3 = FStarC_List.zip args1 args2 in + FStarC_List.existsML (fun uu___4 -> match uu___4 with | ((a1, uu___5), (a2, uu___6)) -> @@ -1512,7 +1503,7 @@ let (guard_letrecs : FStarC_Errors_Msg.text "bound in" in let uu___15 = FStarC_Class_PP.pp - FStarC_Compiler_Range_Ops.pretty_range + FStarC_Range_Ops.pretty_range e1.FStarC_Syntax_Syntax.pos in FStarC_Pprint.op_Hat_Slash_Hat uu___14 uu___15 in @@ -1536,7 +1527,7 @@ let (guard_letrecs : FStarC_Errors_Msg.text "bound in" in let uu___17 = FStarC_Class_PP.pp - FStarC_Compiler_Range_Ops.pretty_range + FStarC_Range_Ops.pretty_range e2.FStarC_Syntax_Syntax.pos in FStarC_Pprint.op_Hat_Slash_Hat uu___16 uu___17 in @@ -1646,8 +1637,7 @@ let (guard_letrecs : FStarC_Syntax_Util.mk_disj tm_precedes uu___1) in let uu___ = let uu___1 = - ((FStarC_Compiler_List.length l), - (FStarC_Compiler_List.length l_prev)) in + ((FStarC_List.length l), (FStarC_List.length l_prev)) in match uu___1 with | (n, n_prev) -> if n = n_prev @@ -1656,12 +1646,12 @@ let (guard_letrecs : if n < n_prev then (let uu___3 = - let uu___4 = FStarC_Compiler_List.splitAt n l_prev in + let uu___4 = FStarC_List.splitAt n l_prev in FStar_Pervasives_Native.fst uu___4 in (l, uu___3)) else (let uu___4 = - let uu___5 = FStarC_Compiler_List.splitAt n_prev l in + let uu___5 = FStarC_List.splitAt n_prev l in FStar_Pervasives_Native.fst uu___5 in (uu___4, l_prev)) in match uu___ with | (l1, l_prev1) -> aux l1 l_prev1 in @@ -1723,13 +1713,13 @@ let (guard_letrecs : FStarC_TypeChecker_Normalize.get_n_binders env1 arity t in (match uu___1 with | (formals, c) -> - (if arity > (FStarC_Compiler_List.length formals) + (if arity > (FStarC_List.length formals) then failwith "impossible: bad formals arity, guard_one_letrec" else (); (let formals1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___3 = FStarC_Syntax_Syntax.is_null_bv @@ -1765,7 +1755,7 @@ let (guard_letrecs : FStarC_Errors_Msg.mkmsg "Could not prove termination of this recursive call" in FStarC_TypeChecker_Util.label uu___3 r precedes in - let uu___3 = FStarC_Compiler_Util.prefix formals1 in + let uu___3 = FStarC_Util.prefix formals1 in match uu___3 with | (bs, { FStarC_Syntax_Syntax.binder_bv = last; @@ -1789,10 +1779,10 @@ let (guard_letrecs : FStarC_Syntax_Syntax.mk_binder_with_attrs last1 imp pqual attrs in [uu___5] in - FStarC_Compiler_List.op_At bs uu___4 in + FStarC_List.op_At bs uu___4 in let t' = FStarC_Syntax_Util.arrow refined_formals c in - ((let uu___5 = FStarC_Compiler_Debug.medium () in + ((let uu___5 = FStarC_Debug.medium () in if uu___5 then let uu___6 = @@ -1806,12 +1796,12 @@ let (guard_letrecs : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t' in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Refined let rec %s\n\tfrom type %s\n\tto type %s\n" uu___6 uu___7 uu___8 else ()); (l, t', u_names))))) in - FStarC_Compiler_List.map guard_one_letrec letrecs + FStarC_List.map guard_one_letrec letrecs let (wrap_guard_with_tactic_opt : FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option -> FStarC_TypeChecker_Env.guard_t -> FStarC_TypeChecker_Env.guard_t) @@ -1849,7 +1839,7 @@ let (is_comp_ascribed_reflect : | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = head; FStarC_Syntax_Syntax.args = args;_} - when (FStarC_Compiler_List.length args) = Prims.int_one -> + when (FStarC_List.length args) = Prims.int_one -> let uu___6 = let uu___7 = FStarC_Syntax_Subst.compress head in uu___7.FStarC_Syntax_Syntax.n in @@ -1857,7 +1847,7 @@ let (is_comp_ascribed_reflect : | FStarC_Syntax_Syntax.Tm_constant (FStarC_Const.Const_reflect l) -> let uu___7 = - let uu___8 = FStarC_Compiler_List.hd args in + let uu___8 = FStarC_List.hd args in match uu___8 with | (e2, aqual) -> (l, e2, aqual) in FStar_Pervasives_Native.Some uu___7 | uu___7 -> FStar_Pervasives_Native.None) @@ -1874,27 +1864,26 @@ let rec (tc_term : FStarC_Defensive.def_check_scoped FStarC_TypeChecker_Env.hasBinders_env FStarC_Class_Binders.hasNames_term FStarC_Syntax_Print.pretty_term e.FStarC_Syntax_Syntax.pos "tc_term.entry" env e; - (let uu___2 = FStarC_Compiler_Debug.medium () in + (let uu___2 = FStarC_Debug.medium () in if uu___2 then let uu___3 = let uu___4 = FStarC_TypeChecker_Env.get_range env in - FStarC_Compiler_Range_Ops.string_of_range uu___4 in + FStarC_Range_Ops.string_of_range uu___4 in let uu___4 = - FStarC_Compiler_Util.string_of_bool - env.FStarC_TypeChecker_Env.phase1 in + FStarC_Util.string_of_bool env.FStarC_TypeChecker_Env.phase1 in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in let uu___6 = let uu___7 = FStarC_Syntax_Subst.compress e in FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term uu___7 in let uu___7 = print_expected_ty_str env in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "(%s) Starting tc_term (phase1=%s) of %s (%s), %s {\n" uu___3 uu___4 uu___5 uu___6 uu___7 else ()); (let uu___2 = - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___3 -> tc_maybe_toplevel_term { @@ -2004,28 +1993,27 @@ let rec (tc_term : } e) in match uu___2 with | (r, ms) -> - ((let uu___4 = FStarC_Compiler_Debug.medium () in + ((let uu___4 = FStarC_Debug.medium () in if uu___4 then ((let uu___6 = let uu___7 = FStarC_TypeChecker_Env.get_range env in - FStarC_Compiler_Range_Ops.string_of_range uu___7 in + FStarC_Range_Ops.string_of_range uu___7 in let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in let uu___8 = let uu___9 = FStarC_Syntax_Subst.compress e in FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term uu___9 in - let uu___9 = FStarC_Compiler_Util.string_of_int ms in - FStarC_Compiler_Util.print4 - "(%s) } tc_term of %s (%s) took %sms\n" uu___6 uu___7 - uu___8 uu___9); + let uu___9 = FStarC_Util.string_of_int ms in + FStarC_Util.print4 "(%s) } tc_term of %s (%s) took %sms\n" + uu___6 uu___7 uu___8 uu___9); (let uu___6 = r in match uu___6 with | (e1, lc, uu___7) -> let uu___8 = let uu___9 = FStarC_TypeChecker_Env.get_range env in - FStarC_Compiler_Range_Ops.string_of_range uu___9 in + FStarC_Range_Ops.string_of_range uu___9 in let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e1 in @@ -2035,9 +2023,8 @@ let rec (tc_term : let uu___12 = FStarC_Syntax_Subst.compress e1 in FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term uu___12 in - FStarC_Compiler_Util.print4 - "(%s) Result is: (%s:%s) (%s)\n" uu___8 uu___9 uu___10 - uu___11)) + FStarC_Util.print4 "(%s) Result is: (%s:%s) (%s)\n" + uu___8 uu___9 uu___10 uu___11)) else ()); r)) and (tc_maybe_toplevel_term : @@ -2049,26 +2036,25 @@ and (tc_maybe_toplevel_term : fun env -> fun e -> let env1 = - if e.FStarC_Syntax_Syntax.pos = FStarC_Compiler_Range_Type.dummyRange + if e.FStarC_Syntax_Syntax.pos = FStarC_Range_Type.dummyRange then env else FStarC_TypeChecker_Env.set_range env e.FStarC_Syntax_Syntax.pos in FStarC_Defensive.def_check_scoped FStarC_TypeChecker_Env.hasBinders_env FStarC_Class_Binders.hasNames_term FStarC_Syntax_Print.pretty_term e.FStarC_Syntax_Syntax.pos "tc_maybe_toplevel_term.entry" env1 e; (let top = FStarC_Syntax_Subst.compress e in - (let uu___2 = FStarC_Compiler_Debug.medium () in + (let uu___2 = FStarC_Debug.medium () in if uu___2 then let uu___3 = let uu___4 = FStarC_TypeChecker_Env.get_range env1 in - FStarC_Class_Show.show FStarC_Compiler_Range_Ops.showable_range - uu___4 in + FStarC_Class_Show.show FStarC_Range_Ops.showable_range uu___4 in let uu___4 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term top in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top in - FStarC_Compiler_Util.print3 "Typechecking %s (%s): %s\n" uu___3 - uu___4 uu___5 + FStarC_Util.print3 "Typechecking %s (%s): %s\n" uu___3 uu___4 + uu___5 else ()); (match top.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_delayed uu___2 -> failwith "Impossible" @@ -2097,7 +2083,7 @@ and (tc_maybe_toplevel_term : match uu___2 with | FStarC_Syntax_Syntax.Tm_name uu___3 -> false | uu___3 -> true in - FStarC_Compiler_Util.for_some is_not_name + FStarC_Util.for_some is_not_name (FStar_Pervasives_Native.snd qi1.FStarC_Syntax_Syntax.antiquotations) in (match qi.FStarC_Syntax_Syntax.qkind with @@ -2105,7 +2091,7 @@ and (tc_maybe_toplevel_term : non_trivial_antiquotations qi -> let e0 = e in let newbvs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> FStarC_Syntax_Syntax.new_bv FStar_Pervasives_Native.None @@ -2113,11 +2099,11 @@ and (tc_maybe_toplevel_term : (FStar_Pervasives_Native.snd qi.FStarC_Syntax_Syntax.antiquotations) in let z = - FStarC_Compiler_List.zip + FStarC_List.zip (FStar_Pervasives_Native.snd qi.FStarC_Syntax_Syntax.antiquotations) newbvs in let lbs = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | (t, bv') -> @@ -2130,7 +2116,7 @@ and (tc_maybe_toplevel_term : let qi1 = let uu___2 = let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___4 -> match uu___4 with | (t, bv') -> FStarC_Syntax_Syntax.bv_to_name bv') @@ -2146,7 +2132,7 @@ and (tc_maybe_toplevel_term : (FStarC_Syntax_Syntax.Tm_quoted (qt, qi1)) top.FStarC_Syntax_Syntax.pos in let e1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun t -> fun lb -> let uu___2 = @@ -2175,7 +2161,7 @@ and (tc_maybe_toplevel_term : FStarC_TypeChecker_Env.set_expected_typ env1 FStarC_Syntax_Syntax.t_term in let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun aq_tm -> match uu___3 with @@ -2206,8 +2192,7 @@ and (tc_maybe_toplevel_term : FStarC_Syntax_Syntax.qkind = (qi.FStarC_Syntax_Syntax.qkind); FStarC_Syntax_Syntax.antiquotations = - (Prims.int_zero, - (FStarC_Compiler_List.rev aqs_rev)) + (Prims.int_zero, (FStarC_List.rev aqs_rev)) } in let tm = FStarC_Syntax_Syntax.mk @@ -2570,10 +2555,10 @@ and (tc_maybe_toplevel_term : FStarC_Syntax_Syntax.eff_opt = uu___3;_} when let uu___4 = is_comp_ascribed_reflect top in - FStarC_Compiler_Util.is_some uu___4 -> + FStarC_Util.is_some uu___4 -> let uu___4 = let uu___5 = is_comp_ascribed_reflect top in - FStarC_Compiler_Util.must uu___5 in + FStarC_Util.must uu___5 in (match uu___4 with | (effect_lid, e1, aqual) -> let uu___5 = FStarC_TypeChecker_Env.clear_expected_typ env1 in @@ -2600,7 +2585,7 @@ and (tc_maybe_toplevel_term : FStarC_Class_Show.show FStarC_Ident.showable_lident expected_ct.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "The effect on reflect %s does not match with the annotation %s\n" uu___12 uu___13 in FStarC_Errors.raise_error @@ -2623,7 +2608,7 @@ and (tc_maybe_toplevel_term : let uu___13 = FStarC_Class_Show.show FStarC_Ident.showable_lident effect_lid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect %s cannot be reflected" uu___13 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) @@ -2635,7 +2620,7 @@ and (tc_maybe_toplevel_term : (Obj.magic uu___12) else ()); (let u_c = - FStarC_Compiler_List.hd + FStarC_List.hd expected_ct.FStarC_Syntax_Syntax.comp_univs in let repr = let uu___11 = @@ -2643,7 +2628,7 @@ and (tc_maybe_toplevel_term : FStarC_Syntax_Syntax.mk_Comp expected_ct in FStarC_TypeChecker_Env.effect_repr env0 uu___12 u_c in - FStarC_Compiler_Util.must uu___11 in + FStarC_Util.must uu___11 in let e2 = let uu___11 = let uu___12 = @@ -2663,13 +2648,13 @@ and (tc_maybe_toplevel_term : FStarC_Syntax_Syntax.Tm_ascribed uu___12 in FStarC_Syntax_Syntax.mk uu___11 e1.FStarC_Syntax_Syntax.pos in - (let uu___12 = FStarC_Compiler_Debug.extreme () in + (let uu___12 = FStarC_Debug.extreme () in if uu___12 then let uu___13 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Typechecking ascribed reflect, inner ascribed term: %s\n" uu___13 else ()); @@ -2677,8 +2662,7 @@ and (tc_maybe_toplevel_term : match uu___12 with | (e3, uu___13, g_e) -> let e4 = FStarC_Syntax_Util.unascribe e3 in - ((let uu___15 = - FStarC_Compiler_Debug.extreme () in + ((let uu___15 = FStarC_Debug.extreme () in if uu___15 then let uu___16 = @@ -2688,7 +2672,7 @@ and (tc_maybe_toplevel_term : let uu___17 = FStarC_TypeChecker_Rel.guard_to_string env0 g_e in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Typechecking ascribed reflect, after typechecking inner ascribed term: %s and guard: %s\n" uu___16 uu___17 else ()); @@ -2707,20 +2691,27 @@ and (tc_maybe_toplevel_term : FStarC_Syntax_Syntax.args = [(e4, aqual)] }) r in - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_ascribed - { - FStarC_Syntax_Syntax.tm = tm1; - FStarC_Syntax_Syntax.asc = - ((FStar_Pervasives.Inr - expected_c1), - FStar_Pervasives_Native.None, - use_eq); - FStarC_Syntax_Syntax.eff_opt = - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.comp_effect_name - expected_c1)) - }) r in + let uu___15 = + let uu___16 = + let uu___17 = + let uu___18 = + FStarC_Syntax_Util.comp_effect_name + expected_c1 in + FStar_Pervasives_Native.Some + uu___18 in + { + FStarC_Syntax_Syntax.tm = tm1; + FStarC_Syntax_Syntax.asc = + ((FStar_Pervasives.Inr + expected_c1), + FStar_Pervasives_Native.None, + use_eq); + FStarC_Syntax_Syntax.eff_opt = + uu___17 + } in + FStarC_Syntax_Syntax.Tm_ascribed + uu___16 in + FStarC_Syntax_Syntax.mk uu___15 r in let uu___15 = let uu___16 = FStarC_TypeChecker_Common.lcomp_of_comp @@ -2753,9 +2744,10 @@ and (tc_maybe_toplevel_term : | (expected_c1, uu___6, g) -> let uu___7 = let uu___8 = + let uu___9 = + FStarC_Syntax_Util.comp_result expected_c1 in FStarC_TypeChecker_Env.set_expected_typ_maybe_eq - env0 (FStarC_Syntax_Util.comp_result expected_c1) - use_eq in + env0 uu___9 use_eq in tc_term uu___8 e1 in (match uu___7 with | (e2, c', g') -> @@ -2778,19 +2770,25 @@ and (tc_maybe_toplevel_term : (match uu___8 with | (e3, expected_c2, g'') -> let e4 = - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_ascribed - { - FStarC_Syntax_Syntax.tm = e3; - FStarC_Syntax_Syntax.asc = - ((FStar_Pervasives.Inr expected_c2), - FStar_Pervasives_Native.None, - use_eq); - FStarC_Syntax_Syntax.eff_opt = - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.comp_effect_name - expected_c2)) - }) top.FStarC_Syntax_Syntax.pos in + let uu___9 = + let uu___10 = + let uu___11 = + let uu___12 = + FStarC_Syntax_Util.comp_effect_name + expected_c2 in + FStar_Pervasives_Native.Some uu___12 in + { + FStarC_Syntax_Syntax.tm = e3; + FStarC_Syntax_Syntax.asc = + ((FStar_Pervasives.Inr expected_c2), + FStar_Pervasives_Native.None, + use_eq); + FStarC_Syntax_Syntax.eff_opt = + uu___11 + } in + FStarC_Syntax_Syntax.Tm_ascribed uu___10 in + FStarC_Syntax_Syntax.mk uu___9 + top.FStarC_Syntax_Syntax.pos in let lc = FStarC_TypeChecker_Common.lcomp_of_comp expected_c2 in @@ -2887,7 +2885,7 @@ and (tc_maybe_toplevel_term : | (unary_op, uu___6) -> let head = let uu___7 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges unary_op.FStarC_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a).FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk @@ -2921,7 +2919,7 @@ and (tc_maybe_toplevel_term : | (unary_op, uu___7) -> let head = let uu___8 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges unary_op.FStarC_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a).FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk @@ -2955,7 +2953,7 @@ and (tc_maybe_toplevel_term : | (unary_op, uu___7) -> let head = let uu___8 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges unary_op.FStarC_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a).FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk @@ -2989,7 +2987,7 @@ and (tc_maybe_toplevel_term : | (unary_op, uu___6) -> let head = let uu___7 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges unary_op.FStarC_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a1).FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk @@ -3098,7 +3096,7 @@ and (tc_maybe_toplevel_term : let uu___6 = let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top in - FStarC_Compiler_Util.format1 "Ill-applied constant %s" uu___7 in + FStarC_Util.format1 "Ill-applied constant %s" uu___7 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e FStarC_Errors_Codes.Fatal_IllAppliedConstant () @@ -3118,7 +3116,7 @@ and (tc_maybe_toplevel_term : let uu___6 = let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top in - FStarC_Compiler_Util.format1 "Ill-applied constant %s" uu___7 in + FStarC_Util.format1 "Ill-applied constant %s" uu___7 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e FStarC_Errors_Codes.Fatal_IllAppliedConstant () @@ -3135,7 +3133,7 @@ and (tc_maybe_toplevel_term : FStarC_Syntax_Syntax.hash_code = uu___5;_}; FStarC_Syntax_Syntax.args = (e1, aqual)::[];_} -> - (if FStarC_Compiler_Option.isSome aqual + (if FStarC_Option.isSome aqual then FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) e1 @@ -3171,7 +3169,7 @@ and (tc_maybe_toplevel_term : let uu___14 = FStarC_Ident.string_of_lid c1.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect %s cannot be reified" uu___14 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) @@ -3183,7 +3181,7 @@ and (tc_maybe_toplevel_term : (Obj.magic uu___13) else ()); (let u_c = - FStarC_Compiler_List.hd + FStarC_List.hd c1.FStarC_Syntax_Syntax.comp_univs in let e3 = FStarC_Syntax_Util.mk_reify e2 @@ -3242,7 +3240,7 @@ and (tc_maybe_toplevel_term : FStarC_Syntax_Syntax.hash_code = uu___4;_}; FStarC_Syntax_Syntax.args = (e1, aqual)::[];_} -> - (if FStarC_Compiler_Option.isSome aqual + (if FStarC_Option.isSome aqual then FStarC_Errors.log_issue (FStarC_Syntax_Syntax.has_range_syntax ()) e1 @@ -3259,8 +3257,7 @@ and (tc_maybe_toplevel_term : then let uu___8 = let uu___9 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 - "Effect %s cannot be reflected" uu___9 in + FStarC_Util.format1 "Effect %s cannot be reflected" uu___9 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e1 FStarC_Errors_Codes.Fatal_EffectCannotBeReified () @@ -3275,7 +3272,7 @@ and (tc_maybe_toplevel_term : | FStar_Pervasives_Native.None -> let uu___10 = let uu___11 = FStarC_Ident.string_of_lid l in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect %s not found (for reflect)" uu___11 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) e1 @@ -3363,7 +3360,7 @@ and (tc_maybe_toplevel_term : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term expected_repr_typ in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Expected repr type for %s is not an application node (%s:%s)" uu___17 uu___18 uu___19 in FStarC_Errors.raise_error @@ -3448,19 +3445,18 @@ and (tc_maybe_toplevel_term : match uu___7 with | (base_term, fields) -> if - (FStarC_Compiler_List.length - uc.FStarC_Syntax_Syntax.uc_fields) - <> (FStarC_Compiler_List.length fields) + (FStarC_List.length uc.FStarC_Syntax_Syntax.uc_fields) <> + (FStarC_List.length fields) then let uu___8 = let uu___9 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length + (FStarC_List.length uc.FStarC_Syntax_Syntax.uc_fields) in let uu___10 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length fields) in - FStarC_Compiler_Util.format2 + (FStarC_List.length fields) in + FStarC_Util.format2 "Could not resolve constructor; expected %s fields but only found %s" uu___9 uu___10 in FStarC_Errors.raise_error @@ -3471,10 +3467,9 @@ and (tc_maybe_toplevel_term : else (let uu___9 = let uu___10 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - fields in - FStarC_Compiler_List.zip - uc.FStarC_Syntax_Syntax.uc_fields uu___10 in + FStarC_List.map FStar_Pervasives_Native.fst fields in + FStarC_List.zip uc.FStarC_Syntax_Syntax.uc_fields + uu___10 in (base_term, uu___9)) in (match uu___6 with | (base_term, uc_fields) -> @@ -3546,7 +3541,7 @@ and (tc_maybe_toplevel_term : | uu___8 -> FStar_Pervasives_Native.None) top.FStarC_Syntax_Syntax.pos in let args1 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> (x, FStar_Pervasives_Native.None)) fields in let term = FStarC_Syntax_Syntax.mk_Tm_app constructor1 args1 @@ -3577,7 +3572,7 @@ and (tc_maybe_toplevel_term : let uu___7 = let uu___8 = let uu___9 = FStarC_Ident.string_of_lid field_name in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Field name %s could not be resolved" uu___9 in FStarC_Errors_Msg.text uu___8 in [uu___7] in @@ -3607,7 +3602,7 @@ and (tc_maybe_toplevel_term : let uu___9 = FStarC_Syntax_Util.head_and_args t0 in (match uu___9 with | (thead, uu___10) -> - ((let uu___12 = FStarC_Compiler_Effect.op_Bang dbg_RFD in + ((let uu___12 = FStarC_Effect.op_Bang dbg_RFD in if uu___12 then let uu___13 = @@ -3620,7 +3615,7 @@ and (tc_maybe_toplevel_term : let uu___15 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term thead in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Got lc.res_typ=%s; t0 = %s; thead = %s\n" uu___13 uu___14 uu___15 else ()); @@ -3640,7 +3635,7 @@ and (tc_maybe_toplevel_term : proceed_with candidate | FStar_Pervasives_Native.Some rdc -> let i = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun uu___14 -> match uu___14 with | (i1, uu___15) -> @@ -3657,7 +3652,7 @@ and (tc_maybe_toplevel_term : let uu___16 = FStarC_Ident.ns_of_lid rdc.FStarC_Syntax_DsEnv.typename in - FStarC_Compiler_List.op_At uu___16 + FStarC_List.op_At uu___16 [rdc.FStarC_Syntax_DsEnv.constrname] in FStarC_Ident.lid_of_ids uu___15 in let projname = @@ -3746,18 +3741,18 @@ and (tc_maybe_toplevel_term : let uu___3 = FStarC_TypeChecker_Env.clear_expected_typ env1 in FStar_Pervasives_Native.fst uu___3 in instantiate_both uu___2 in - ((let uu___3 = FStarC_Compiler_Debug.high () in + ((let uu___3 = FStarC_Debug.high () in if uu___3 then let uu___4 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range top.FStarC_Syntax_Syntax.pos in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top in let uu___6 = print_expected_ty_str env0 in - FStarC_Compiler_Util.print3 "(%s) Checking app %s, %s\n" - uu___4 uu___5 uu___6 + FStarC_Util.print3 "(%s) Checking app %s, %s\n" uu___4 uu___5 + uu___6 else ()); (let uu___3 = tc_term (no_inst env2) head in match uu___3 with @@ -3822,14 +3817,13 @@ and (tc_maybe_toplevel_term : FStarC_TypeChecker_Common.monoid_guard_t)) in (match uu___6 with | (e2, c1, implicits) -> - ((let uu___8 = - FStarC_Compiler_Debug.extreme () in + ((let uu___8 = FStarC_Debug.extreme () in if uu___8 then let uu___9 = FStarC_TypeChecker_Rel.print_pending_implicits g in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Introduced {%s} implicits in application\n" uu___9 else ()); @@ -3846,7 +3840,7 @@ and (tc_maybe_toplevel_term : FStarC_TypeChecker_Common.monoid_guard_t uu___9 implicits in ((let uu___10 = - FStarC_Compiler_Debug.extreme () in + FStarC_Debug.extreme () in if uu___10 then let uu___11 = @@ -3856,7 +3850,7 @@ and (tc_maybe_toplevel_term : let uu___12 = FStarC_TypeChecker_Rel.guard_to_string env2 gres in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Guard from application node %s is %s\n" uu___11 uu___12 else ()); @@ -3948,9 +3942,10 @@ and (tc_match : let env' = FStarC_TypeChecker_Env.push_binders env bs in + let uu___10 = + FStarC_Syntax_Util.comp_result c in FStarC_TypeChecker_Util.maybe_coerce_lc - env' e11 c1 - (FStarC_Syntax_Util.comp_result c)) + env' e11 c1 uu___10) | FStar_Pervasives_Native.None -> (e11, c1, (FStarC_Class_Monoid.mzero @@ -4009,7 +4004,7 @@ and (tc_match : let uu___9 = FStarC_Ident.string_of_lid c11.FStarC_TypeChecker_Common.eff_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "For a match with returns annotation, the scrutinee should be pure/ghost, found %s with effect %s" uu___8 uu___9 in FStarC_Errors.raise_error @@ -4030,7 +4025,7 @@ and (tc_match : [b] asc in match uu___9 with | (bs, asc1) -> - let b1 = FStarC_Compiler_List.hd bs in + let b1 = FStarC_List.hd bs in ({ FStarC_Syntax_Syntax.binder_bv = (let uu___10 = @@ -4114,7 +4109,7 @@ and (tc_match : (e12.FStarC_Syntax_Syntax.pos)) c11.FStarC_TypeChecker_Common.res_typ in let t_eqns = - FStarC_Compiler_List.map + FStarC_List.map (tc_eqn guard_x env_branches ret_opt1) eqns in let uu___5 = match ret_opt1 with @@ -4128,13 +4123,13 @@ and (tc_match : e12)] c in let uu___8 = let uu___9 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___10 -> match uu___10 with | (uu___11, f, uu___12, uu___13, uu___14, g, b1) -> (f, g, b1)) t_eqns in - FStarC_Compiler_List.unzip3 uu___9 in + FStarC_List.unzip3 uu___9 in (match uu___8 with | (fmls, gs, erasables) -> let uu___9 = @@ -4144,7 +4139,7 @@ and (tc_match : | (neg_conds, exhaustiveness_cond) -> let g = let uu___10 = - FStarC_Compiler_List.map2 + FStarC_List.map2 FStarC_TypeChecker_Common.weaken_guard_formula gs neg_conds in FStarC_Class_Monoid.msum @@ -4198,13 +4193,13 @@ and (tc_match : FStarC_TypeChecker_Common.lcomp_of_comp c2 in let uu___11 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun b1 -> acc || b1) false erasables in (uu___10, g4, uu___11))) | uu___6 -> let uu___7 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___8 -> fun uu___9 -> match (uu___8, uu___9) with @@ -4214,10 +4209,9 @@ and (tc_match : let uu___10 = let uu___11 = let uu___12 = - FStarC_Compiler_Util.must - cflags in + FStarC_Util.must cflags in let uu___13 = - FStarC_Compiler_Util.must c in + FStarC_Util.must c in (f, eff_label, uu___12, uu___13) in uu___11 :: caccum in @@ -4241,7 +4235,7 @@ and (tc_match : let uu___9 = FStarC_TypeChecker_Env.expected_typ env_branches in - FStarC_Compiler_Util.must uu___9 in + FStarC_Util.must uu___9 in FStar_Pervasives_Native.fst uu___8 in let uu___8 = FStarC_TypeChecker_Util.bind_cases @@ -4258,7 +4252,7 @@ and (tc_match : ((b.FStarC_Syntax_Syntax.binder_bv), e12)] t in let cases1 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___10 -> match uu___10 with | (f, eff_label, cflags, c) @@ -4308,7 +4302,7 @@ and (tc_match : let uu___6 = FStarC_Syntax_Subst.close_binders [b] in - FStarC_Compiler_List.hd uu___6 in + FStarC_List.hd uu___6 in let b2 = { FStarC_Syntax_Syntax.binder_bv = @@ -4333,7 +4327,7 @@ and (tc_match : FStar_Pervasives_Native.Some (b2, asc1) in let mk_match scrutinee = let branches = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> match uu___6 with | ((pat, wopt, br), uu___7, @@ -4446,17 +4440,16 @@ and (tc_match : comp_check_expected_typ env e cres1 in (match uu___6 with | (e2, cres2, g_expected_type) -> - ((let uu___8 = - FStarC_Compiler_Debug.extreme () in + ((let uu___8 = FStarC_Debug.extreme () in if uu___8 then let uu___9 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range top.FStarC_Syntax_Syntax.pos in let uu___10 = FStarC_TypeChecker_Common.lcomp_to_string cres2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "(%s) Typechecked Tm_match, comp type = %s\n" uu___9 uu___10 else ()); @@ -4477,15 +4470,13 @@ and (tc_match : let uu___2 = let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term top in - FStarC_Compiler_Util.format1 "tc_match called on %s\n" uu___3 in + FStarC_Util.format1 "tc_match called on %s\n" uu___3 in failwith uu___2 and (tc_synth : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> + FStarC_Syntax_Syntax.term -> FStarC_TypeChecker_Env.env -> - (FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax * - FStarC_Syntax_Syntax.arg_qualifier FStar_Pervasives_Native.option) - Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Syntax_Syntax.args -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.term * FStarC_TypeChecker_Common.lcomp * FStarC_TypeChecker_Env.guard_t)) = @@ -4510,7 +4501,7 @@ and (tc_synth : (Obj.magic "synth_by_tactic: bad application") in match uu___ with | (tau, atyp) -> - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Tac in + ((let uu___2 = FStarC_Effect.op_Bang dbg_Tac in if uu___2 then let uu___3 = @@ -4520,8 +4511,8 @@ and (tc_synth : FStarC_Class_Show.show (FStarC_Class_Show.show_option FStarC_Syntax_Print.showable_term) atyp in - FStarC_Compiler_Util.print2 - "Processing synth of %s at type %s\n" uu___3 uu___4 + FStarC_Util.print2 "Processing synth of %s at type %s\n" + uu___3 uu___4 else ()); (let typ = match atyp with @@ -4536,7 +4527,7 @@ and (tc_synth : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Equality ascription in synth (%s) is not yet supported, please use subtyping" uu___5 in FStarC_Errors.raise_error @@ -4582,14 +4573,13 @@ and (tc_synth : FStarC_Syntax_Syntax.hash_code = (tau1.FStarC_Syntax_Syntax.hash_code) } in - (let uu___9 = - FStarC_Compiler_Effect.op_Bang dbg_Tac in + (let uu___9 = FStarC_Effect.op_Bang dbg_Tac in if uu___9 then let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 "Got %s\n" uu___10 + FStarC_Util.print1 "Got %s\n" uu___10 else ()); FStarC_TypeChecker_Util.check_uvars tau1.FStarC_Syntax_Syntax.pos t; @@ -4753,8 +4743,8 @@ and (check_instantiated_fvar : let uu___2 = let uu___3 = FStarC_Ident.string_of_lid v.FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 - "Expected a data constructor; got %s" uu___3 in + FStarC_Util.format1 "Expected a data constructor; got %s" + uu___3 in FStarC_Errors.raise_error FStarC_TypeChecker_Env.hasRange_env env FStarC_Errors_Codes.Fatal_MissingDataConstructor () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -4790,7 +4780,7 @@ and (tc_value : let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Violation of locally nameless convention: %s" uu___1 in FStarC_Errors.raise_error (FStarC_Syntax_Syntax.has_range_syntax ()) top @@ -4826,7 +4816,7 @@ and (tc_value : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Equality ascription as an expected type for unk (:%s) is not yet supported." uu___5 in FStarC_Errors_Msg.text uu___4 in @@ -4849,8 +4839,7 @@ and (tc_value : let uu___1 = let uu___2 = let uu___3 = - FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range r in + FStarC_Class_Show.show FStarC_Range_Ops.showable_range r in Prims.strcat "user-provided implicit term at " uu___3 in FStarC_TypeChecker_Util.new_implicit_var uu___2 r env1 t false in @@ -4921,7 +4910,7 @@ and (tc_value : FStarC_Syntax_Syntax.hash_code = uu___2;_}, us) -> - let us1 = FStarC_Compiler_List.map (tc_universe env1) us in + let us1 = FStarC_List.map (tc_universe env1) us in let uu___3 = FStarC_TypeChecker_Env.lookup_lid env1 (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in @@ -4929,9 +4918,7 @@ and (tc_value : | ((us', t), range) -> let fv1 = FStarC_Syntax_Syntax.set_range_of_fv fv range in (maybe_warn_on_use env1 fv1; - if - (FStarC_Compiler_List.length us1) <> - (FStarC_Compiler_List.length us') + if (FStarC_List.length us1) <> (FStarC_List.length us') then (let uu___6 = let uu___7 = @@ -4939,11 +4926,11 @@ and (tc_value : fv1 in let uu___8 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length us1) in + (FStarC_List.length us1) in let uu___9 = FStarC_Class_Show.show FStarC_Class_Show.showable_nat - (FStarC_Compiler_List.length us') in - FStarC_Compiler_Util.format3 + (FStarC_List.length us') in + FStarC_Util.format3 "Unexpected number of universe instantiations for \"%s\" (%s vs %s)" uu___7 uu___8 uu___9 in FStarC_Errors.raise_error @@ -4952,7 +4939,7 @@ and (tc_value : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___6)) else (); - FStarC_Compiler_List.iter2 + FStarC_List.iter2 (fun ul -> fun ur -> match (ul, ur) with @@ -4972,7 +4959,7 @@ and (tc_value : let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ ur in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Incompatible universe application for %s, expected %s got %s\n" uu___9 uu___10 uu___11 in FStarC_Errors.raise_error @@ -5006,7 +4993,7 @@ and (tc_value : | ((us, t), range) -> let fv1 = FStarC_Syntax_Syntax.set_range_of_fv fv range in (maybe_warn_on_use env1 fv1; - (let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Range in + (let uu___3 = FStarC_Effect.op_Bang dbg_Range in if uu___3 then let uu___4 = @@ -5014,16 +5001,14 @@ and (tc_value : FStarC_Class_Show.show FStarC_Ident.showable_lident uu___5 in let uu___5 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range e.FStarC_Syntax_Syntax.pos in - let uu___6 = - FStarC_Compiler_Range_Ops.string_of_range range in - let uu___7 = - FStarC_Compiler_Range_Ops.string_of_use_range range in + let uu___6 = FStarC_Range_Ops.string_of_range range in + let uu___7 = FStarC_Range_Ops.string_of_use_range range in let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "Lookup up fvar %s at location %s (lid range = defined at %s, used at %s); got universes type %s\n" uu___4 uu___5 uu___6 uu___7 uu___8 else ()); @@ -5120,15 +5105,14 @@ and (tc_value : (match uu___1 with | (env2, uu___2) -> let uu___3 = - let uu___4 = FStarC_Compiler_List.hd x1 in - tc_binder env2 uu___4 in + let uu___4 = FStarC_List.hd x1 in tc_binder env2 uu___4 in (match uu___3 with | (x2, env3, f1, u) -> - ((let uu___5 = FStarC_Compiler_Debug.high () in + ((let uu___5 = FStarC_Debug.high () in if uu___5 then let uu___6 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range top.FStarC_Syntax_Syntax.pos in let uu___7 = FStarC_Class_Show.show @@ -5137,7 +5121,7 @@ and (tc_value : FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x2.FStarC_Syntax_Syntax.binder_bv in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "(%s) Checking refinement formula %s; binder is %s\n" uu___6 uu___7 uu___8 else ()); @@ -5187,7 +5171,7 @@ and (tc_value : -> let bs1 = FStarC_TypeChecker_Util.maybe_add_implicit_binders env1 bs in - ((let uu___2 = FStarC_Compiler_Debug.medium () in + ((let uu___2 = FStarC_Debug.medium () in if uu___2 then let uu___3 = @@ -5207,7 +5191,7 @@ and (tc_value : FStarC_Syntax_Syntax.hash_code = (top.FStarC_Syntax_Syntax.hash_code) } in - FStarC_Compiler_Util.print1 "Abstraction is: %s\n" uu___3 + FStarC_Util.print1 "Abstraction is: %s\n" uu___3 else ()); (let uu___2 = FStarC_Syntax_Subst.open_term bs1 body in match uu___2 with | (bs2, body1) -> tc_abs env1 top bs2 body1)) @@ -5217,12 +5201,11 @@ and (tc_value : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term top in let uu___3 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term top in - FStarC_Compiler_Util.format2 "Unexpected value: %s (%s)" uu___2 - uu___3 in + FStarC_Util.format2 "Unexpected value: %s (%s)" uu___2 uu___3 in failwith uu___1 and (tc_constant : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Const.sconst -> FStarC_Syntax_Syntax.typ) = fun env -> @@ -5263,14 +5246,14 @@ and (tc_constant : FStarC_Syntax_DsEnv.try_lookup_lid env.FStarC_TypeChecker_Env.dsenv FStarC_Parser_Const.char_lid in - FStarC_Compiler_Util.must uu___1 + FStarC_Util.must uu___1 | FStarC_Const.Const_effect -> FStarC_Syntax_Util.ktype0 | FStarC_Const.Const_range uu___ -> FStarC_Syntax_Syntax.t_range | FStarC_Const.Const_range_of -> let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Ill-typed %s: this constant must be fully applied" uu___1 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_IllTyped () @@ -5280,7 +5263,7 @@ and (tc_constant : let uu___ = let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Ill-typed %s: this constant must be fully applied" uu___1 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_IllTyped () @@ -5290,7 +5273,7 @@ and (tc_constant : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Ill-typed %s: this constant must be fully applied" uu___2 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_IllTyped () @@ -5300,7 +5283,7 @@ and (tc_constant : let uu___1 = let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Ill-typed %s: this constant must be fully applied" uu___2 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range r FStarC_Errors_Codes.Fatal_IllTyped () @@ -5489,14 +5472,14 @@ and (tc_comp : (match uu___3 with | (uu___4, args1) -> let uu___5 = - let uu___6 = FStarC_Compiler_List.hd args1 in - let uu___7 = FStarC_Compiler_List.tl args1 in + let uu___6 = FStarC_List.hd args1 in + let uu___7 = FStarC_List.tl args1 in (uu___6, uu___7) in (match uu___5 with | (res, args2) -> let uu___6 = let uu___7 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | FStarC_Syntax_Syntax.DECREASES @@ -5508,7 +5491,7 @@ and (tc_comp : (match uu___9 with | (env1, uu___10) -> let uu___11 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___12 -> fun e -> match uu___12 with @@ -5525,7 +5508,7 @@ and (tc_comp : FStarC_Class_Monoid.op_Plus_Plus FStarC_TypeChecker_Common.monoid_guard_t g g_e in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At l1 [e1]), uu___15))) @@ -5620,7 +5603,7 @@ and (tc_comp : (FStarC_Class_Monoid.mzero FStarC_TypeChecker_Common.monoid_guard_t))) c1.FStarC_Syntax_Syntax.flags in - FStarC_Compiler_List.unzip uu___7 in + FStarC_List.unzip uu___7 in (match uu___6 with | (flags, guards) -> let u = @@ -5668,7 +5651,7 @@ and (tc_universe : | FStarC_Syntax_Syntax.U_succ u3 -> let uu___ = aux u3 in FStarC_Syntax_Syntax.U_succ uu___ | FStarC_Syntax_Syntax.U_max us -> - let uu___ = FStarC_Compiler_List.map aux us in + let uu___ = FStarC_List.map aux us in FStarC_Syntax_Syntax.U_max uu___ | FStarC_Syntax_Syntax.U_name x -> let uu___ = FStarC_TypeChecker_Env.lookup_univ env x in @@ -5820,9 +5803,10 @@ and (tc_abs_expected_function_typ : if uu___3 then let t3 = + let uu___4 = + FStarC_Syntax_Util.comp_result c in FStarC_TypeChecker_Normalize.unfold_whnf - env_bs - (FStarC_Syntax_Util.comp_result c) in + env_bs uu___4 in (match t3.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_arrow { @@ -5856,7 +5840,7 @@ and (tc_abs_expected_function_typ : guard_env guard'_env in (env_bs_bs', - (FStarC_Compiler_List.op_At + (FStarC_List.op_At bs2 bs'), more1, uu___7, subst1) in @@ -5991,7 +5975,7 @@ and (tc_abs_expected_function_typ : (envbody.FStarC_TypeChecker_Env.missing_decl) } in let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun uu___4 -> match (uu___3, uu___4) with @@ -6275,10 +6259,10 @@ and (tc_abs_expected_function_typ : (match uu___3 with | (envbody3, letrecs, g_annots) -> let envbody4 = + let uu___4 = + FStarC_Syntax_Util.comp_result c in FStarC_TypeChecker_Env.set_expected_typ_maybe_eq - envbody3 - (FStarC_Syntax_Util.comp_result c) - use_eq in + envbody3 uu___4 use_eq in let uu___4 = FStarC_Class_Monoid.op_Plus_Plus FStarC_TypeChecker_Common.monoid_guard_t @@ -6388,7 +6372,7 @@ and (tc_abs_check_binders : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv hd in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Inconsistent implicit argument annotation on argument %s" uu___6 in FStarC_Errors_Msg.text uu___5 in @@ -6446,7 +6430,7 @@ and (tc_abs_check_binders : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv hd in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Inconsistent positivity qualifier on argument %s; Expected qualifier %s, found qualifier %s" uu___5 (positivity_qual_to_string pqual_expected) @@ -6474,14 +6458,14 @@ and (tc_abs_check_binders : (FStarC_Class_Monoid.mzero FStarC_TypeChecker_Common.monoid_guard_t)) | uu___5 -> - ((let uu___7 = FStarC_Compiler_Debug.high () in + ((let uu___7 = FStarC_Debug.high () in if uu___7 then let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv hd in - FStarC_Compiler_Util.print1 - "Checking binder %s\n" uu___8 + FStarC_Util.print1 "Checking binder %s\n" + uu___8 else ()); (let uu___7 = tc_tot_or_gtot_term env1 @@ -6543,10 +6527,10 @@ and (tc_abs_check_binders : } in let combine_attrs attrs1 attrs'1 = let diff = - FStarC_Compiler_List.filter + FStarC_List.filter (fun attr' -> let uu___4 = - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun attr -> let uu___5 = FStarC_TypeChecker_TermEqAndSimplify.eq_tm @@ -6555,7 +6539,7 @@ and (tc_abs_check_binders : FStarC_TypeChecker_TermEqAndSimplify.Equal) attrs1 in Prims.op_Negation uu___4) attrs'1 in - FStarC_Compiler_List.op_At attrs1 diff in + FStarC_List.op_At attrs1 diff in let b = let uu___4 = combine_attrs attrs attrs' in { @@ -6625,7 +6609,7 @@ and (tc_abs : let uu___ = FStarC_TypeChecker_Env.clear_expected_typ env in match uu___ with | (env1, topt) -> - ((let uu___2 = FStarC_Compiler_Debug.high () in + ((let uu___2 = FStarC_Debug.high () in if uu___2 then let uu___3 = @@ -6637,7 +6621,7 @@ and (tc_abs : let uu___4 = FStarC_Class_Show.show FStarC_Class_Show.showable_bool env1.FStarC_TypeChecker_Env.top_level in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "!!!!!!!!!!!!!!!Expected type is (%s), top_level=%s\n" uu___3 uu___4 else ()); @@ -6645,7 +6629,7 @@ and (tc_abs : match uu___2 with | (tfun_opt, bs1, letrec_binders, c_opt, envbody, body1, g_env) -> - ((let uu___4 = FStarC_Compiler_Debug.extreme () in + ((let uu___4 = FStarC_Debug.extreme () in if uu___4 then let uu___5 = @@ -6664,11 +6648,11 @@ and (tc_abs : (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Class_Show.showable_bool)) uu___8 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "After expected_function_typ, tfun_opt: %s, c_opt: %s, and expected type in envbody: %s\n" uu___5 uu___6 uu___7 else ()); - (let uu___5 = FStarC_Compiler_Effect.op_Bang dbg_NYC in + (let uu___5 = FStarC_Effect.op_Bang dbg_NYC in if uu___5 then let uu___6 = @@ -6677,7 +6661,7 @@ and (tc_abs : FStarC_Syntax_Print.showable_binder) bs1 in let uu___7 = FStarC_TypeChecker_Rel.guard_to_string env1 g_env in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "!!!!!!!!!!!!!!!Guard for function with binders %s is %s\n" uu___6 uu___7 else ()); @@ -6692,7 +6676,7 @@ and (tc_abs : -> FStar_Pervasives_Native.Some use_eq | uu___7 -> FStar_Pervasives_Native.None in let uu___7 = - (FStarC_Compiler_Util.is_some c_opt) && + (FStarC_Util.is_some c_opt) && (let uu___8 = let uu___9 = FStarC_Syntax_Subst.compress body1 in @@ -6702,8 +6686,7 @@ and (tc_abs : { FStarC_Syntax_Syntax.hd = head; FStarC_Syntax_Syntax.args = args;_} when - (FStarC_Compiler_List.length args) = - Prims.int_one + (FStarC_List.length args) = Prims.int_one -> let uu___9 = let uu___10 = @@ -6727,11 +6710,9 @@ and (tc_abs : let uu___11 = let uu___12 = let uu___13 = - let uu___14 = - FStarC_Compiler_Util.must c_opt in + let uu___14 = FStarC_Util.must c_opt in FStar_Pervasives.Inr uu___14 in - let uu___14 = - FStarC_Compiler_Util.must use_eq_opt in + let uu___14 = FStarC_Util.must use_eq_opt in (uu___13, FStar_Pervasives_Native.None, uu___14) in { @@ -6742,7 +6723,7 @@ and (tc_abs : } in FStarC_Syntax_Syntax.Tm_ascribed uu___11 in FStarC_Syntax_Syntax.mk uu___10 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in (uu___8, uu___9, (FStar_Pervasives.Inr ())) else (let uu___9 = @@ -6763,8 +6744,7 @@ and (tc_abs : -> FStar_Pervasives.Inr () | uu___11 -> FStar_Pervasives.Inl - (FStarC_Compiler_Util.dflt false - use_eq_opt) in + (FStarC_Util.dflt false use_eq_opt) in (envbody1, body1, uu___9)) in match uu___6 with | (envbody2, body2, should_check_expected_effect) -> @@ -6927,26 +6907,25 @@ and (tc_abs : (body3, cbody1, uu___10)))) in match uu___5 with | (body2, cbody, guard_body) -> - ((let uu___7 = FStarC_Compiler_Debug.extreme () in + ((let uu___7 = FStarC_Debug.extreme () in if uu___7 then let uu___8 = FStarC_TypeChecker_Rel.guard_to_string env1 guard_body in - FStarC_Compiler_Util.print1 - "tc_abs: guard_body: %s\n" uu___8 + FStarC_Util.print1 "tc_abs: guard_body: %s\n" + uu___8 else ()); (let guard_body1 = if env1.FStarC_TypeChecker_Env.top_level then - ((let uu___8 = - FStarC_Compiler_Debug.medium () in + ((let uu___8 = FStarC_Debug.medium () in if uu___8 then let uu___9 = FStarC_TypeChecker_Rel.guard_to_string env1 guard_body in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "tc_abs: FORCING guard_body: %s\n" uu___9 else ()); @@ -6956,8 +6935,8 @@ and (tc_abs : let guard = let guard_body2 = FStarC_TypeChecker_Env.close_guard envbody1 - (FStarC_Compiler_List.op_At bs1 - letrec_binders) guard_body1 in + (FStarC_List.op_At bs1 letrec_binders) + guard_body1 in FStarC_Class_Monoid.op_Plus_Plus FStarC_TypeChecker_Common.monoid_guard_t g_env guard_body2 in @@ -6970,10 +6949,10 @@ and (tc_abs : let uu___7 = let uu___8 = FStarC_Syntax_Util.residual_comp_of_comp - (FStarC_Compiler_Util.dflt cbody c_opt) in + (FStarC_Util.dflt cbody c_opt) in FStar_Pervasives_Native.Some uu___8 in FStarC_Syntax_Util.abs bs1 body2 uu___7 in - FStarC_Compiler_List.iter + FStarC_List.iter (fun b -> let uu___8 = FStarC_Options.no_positivity () in if uu___8 @@ -6995,7 +6974,7 @@ and (tc_abs : FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Binder %s is marked unused, but its use in the definition is not" uu___13 in FStarC_Errors.raise_error @@ -7024,7 +7003,7 @@ and (tc_abs : FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Binder %s is marked strictly positive, but its use in the definition is not" uu___13 in FStarC_Errors.raise_error @@ -7110,15 +7089,14 @@ and (check_application_args : fun ghead -> fun args -> fun expected_topt -> - let n_args = FStarC_Compiler_List.length args in + let n_args = FStarC_List.length args in let r = FStarC_TypeChecker_Env.get_range env in let thead = FStarC_Syntax_Util.comp_result chead in - (let uu___1 = FStarC_Compiler_Debug.high () in + (let uu___1 = FStarC_Debug.high () in if uu___1 then let uu___2 = - FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Class_Show.show FStarC_Range_Ops.showable_range head.FStarC_Syntax_Syntax.pos in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term @@ -7129,9 +7107,8 @@ and (check_application_args : (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_aqual)) args in - FStarC_Compiler_Util.print3 - "(%s) Type of head is %s\nArgs = %s\n" uu___2 uu___3 - uu___4 + FStarC_Util.print3 "(%s) Type of head is %s\nArgs = %s\n" + uu___2 uu___3 uu___4 else ()); (let monadic_application uu___1 subst arg_comps_rev arg_rets_rev guard fvs bs = @@ -7160,9 +7137,10 @@ and (check_application_args : (match uu___2 with | (cres1, guard1) -> let uu___3 = + let uu___4 = FStarC_Syntax_Util.comp_result cres1 in check_no_escape (FStar_Pervasives_Native.Some head1) env fvs - (FStarC_Syntax_Util.comp_result cres1) in + uu___4 in (match uu___3 with | (rt, g0) -> let uu___4 = @@ -7175,15 +7153,14 @@ and (check_application_args : (uu___5, uu___6) in (match uu___4 with | (cres2, guard2) -> - ((let uu___6 = - FStarC_Compiler_Debug.medium () in + ((let uu___6 = FStarC_Debug.medium () in if uu___6 then let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp cres2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "\t Type of result cres is %s\n" uu___7 else ()); @@ -7209,7 +7186,7 @@ and (check_application_args : (FStarC_TypeChecker_Common.is_pure_or_ghost_lcomp chead2) && - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___8 -> match uu___8 with | (uu___9, uu___10, lc) @@ -7226,8 +7203,7 @@ and (check_application_args : let term = FStarC_Syntax_Syntax.mk_Tm_app head1 - (FStarC_Compiler_List.rev - arg_rets_rev) + (FStarC_List.rev arg_rets_rev) head1.FStarC_Syntax_Syntax.pos in let uu___8 = (FStarC_TypeChecker_Common.is_pure_or_ghost_lcomp @@ -7237,15 +7213,14 @@ and (check_application_args : if uu___8 then ((let uu___10 = - FStarC_Compiler_Debug.extreme - () in + FStarC_Debug.extreme () in if uu___10 then let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term term in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(a) Monadic app: Return inserted in monadic application: %s\n" uu___11 else ()); @@ -7255,15 +7230,14 @@ and (check_application_args : (uu___10, true))) else ((let uu___11 = - FStarC_Compiler_Debug.extreme - () in + FStarC_Debug.extreme () in if uu___11 then let uu___12 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term term in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(a) Monadic app: No return inserted in monadic application: %s\n" uu___12 else ()); @@ -7273,7 +7247,7 @@ and (check_application_args : -> let comp = let arg_rets_names_opt = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___8 -> match uu___8 with | (t, uu___9) -> @@ -7290,22 +7264,22 @@ and (check_application_args : bv | uu___11 -> FStar_Pervasives_Native.None)) - (FStarC_Compiler_List.rev + (FStarC_List.rev arg_rets_rev) in let push_option_names_to_env = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun env1 -> fun name_opt -> let uu___8 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (FStarC_TypeChecker_Env.push_bv env1) name_opt in - FStarC_Compiler_Util.dflt + FStarC_Util.dflt env1 uu___8) in let uu___8 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___9 -> fun uu___10 -> match (uu___9, @@ -7315,7 +7289,7 @@ and (check_application_args : ((e, q), x, c)) -> ((let uu___12 = - FStarC_Compiler_Debug.extreme + FStarC_Debug.extreme () in if uu___12 then @@ -7341,7 +7315,7 @@ and (check_application_args : = FStarC_TypeChecker_Common.lcomp_to_string c in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "(b) Monadic app: Binding argument %s : %s of type (%s)\n" uu___13 uu___14 @@ -7355,8 +7329,8 @@ and (check_application_args : = let uu___13 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length + FStarC_List.splitAt + ((FStarC_List.length arg_rets_names_opt) - i) arg_rets_names_opt in @@ -7405,7 +7379,7 @@ and (check_application_args : env arg_rets_names_opt in ((let uu___11 = - FStarC_Compiler_Debug.extreme + FStarC_Debug.extreme () in if uu___11 then @@ -7416,7 +7390,7 @@ and (check_application_args : let uu___13 = FStarC_TypeChecker_Common.lcomp_to_string chead2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "(c) Monadic app: Binding head %s, chead: %s\n" uu___12 uu___13 else ()); @@ -7463,7 +7437,7 @@ and (check_application_args : shortcuts_evaluation_order then let args1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun args2 -> fun uu___8 -> match uu___8 with @@ -7491,7 +7465,7 @@ and (check_application_args : | ((e, q), uu___11, c) -> ((let uu___13 = - FStarC_Compiler_Debug.extreme + FStarC_Debug.extreme () in if uu___13 then @@ -7502,7 +7476,7 @@ and (check_application_args : let uu___15 = FStarC_TypeChecker_Common.lcomp_to_string c in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "For arg e=(%s) c=(%s)... " uu___14 uu___15 @@ -7514,11 +7488,11 @@ and (check_application_args : then ((let uu___15 = - FStarC_Compiler_Debug.extreme + FStarC_Debug.extreme () in if uu___15 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "... not lifting\n" else ()); (FStar_Pervasives_Native.None, @@ -7576,7 +7550,7 @@ and (check_application_args : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term head1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Effectful argument %s (%s) to erased function %s, consider let binding it" uu___17 uu___18 @@ -7593,11 +7567,11 @@ and (check_application_args : else (); (let uu___17 = - FStarC_Compiler_Debug.extreme + FStarC_Debug.extreme () in if uu___17 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "... lifting!\n" else ()); (let x = @@ -7636,24 +7610,24 @@ and (check_application_args : chead2) in uu___13 :: arg_comps_rev in - FStarC_Compiler_List.map + FStarC_List.map map_fun uu___12 in - FStarC_Compiler_List.split + FStarC_List.split uu___11 in match uu___10 with | (lifted_args, reverse_args) -> let uu___11 = let uu___12 = - FStarC_Compiler_List.hd + FStarC_List.hd reverse_args in FStar_Pervasives_Native.fst uu___12 in let uu___12 = let uu___13 = - FStarC_Compiler_List.tl + FStarC_List.tl reverse_args in - FStarC_Compiler_List.rev + FStarC_List.rev uu___13 in (lifted_args, uu___11, uu___12) in @@ -7730,7 +7704,7 @@ and (check_application_args : (comp.FStarC_TypeChecker_Common.res_typ))) }) e.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left bind_lifted_args app3 lifted_args) in let uu___8 = @@ -7740,7 +7714,7 @@ and (check_application_args : (match uu___8 with | (comp1, g) -> ((let uu___10 = - FStarC_Compiler_Debug.extreme + FStarC_Debug.extreme () in if uu___10 then @@ -7751,7 +7725,7 @@ and (check_application_args : let uu___12 = FStarC_TypeChecker_Common.lcomp_to_string comp1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "(d) Monadic app: type of app\n\t(%s)\n\t: %s\n" uu___11 uu___12 else ()); @@ -7765,19 +7739,17 @@ and (check_application_args : | [] -> head.FStarC_Syntax_Syntax.pos | ((t, uu___2), uu___3, uu___4)::uu___5 -> let uu___6 = - FStarC_Compiler_Range_Type.def_range + FStarC_Range_Type.def_range head.FStarC_Syntax_Syntax.pos in let uu___7 = let uu___8 = - FStarC_Compiler_Range_Type.use_range + FStarC_Range_Type.use_range head.FStarC_Syntax_Syntax.pos in let uu___9 = - FStarC_Compiler_Range_Type.use_range + FStarC_Range_Type.use_range t.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_Range_Ops.union_rng uu___8 - uu___9 in - FStarC_Compiler_Range_Type.range_of_rng uu___6 - uu___7 in + FStarC_Range_Ops.union_rng uu___8 uu___9 in + FStarC_Range_Type.range_of_rng uu___6 uu___7 in let b1 = FStarC_Syntax_Subst.subst_binder subst b in let uu___2 = FStarC_TypeChecker_Util.instantiate_one_binder env @@ -7825,7 +7797,7 @@ and (check_application_args : FStarC_Syntax_Syntax.binder_positivity = uu___3; FStarC_Syntax_Syntax.binder_attrs = uu___4;_}::rest, (uu___5, FStar_Pervasives_Native.None)::uu___6) -> - let uu___7 = FStarC_Compiler_List.hd bs in + let uu___7 = FStarC_List.hd bs in instantiate_one_and_go uu___7 rest args1 | ({ FStarC_Syntax_Syntax.binder_bv = x; FStarC_Syntax_Syntax.binder_qual = @@ -7834,7 +7806,7 @@ and (check_application_args : FStarC_Syntax_Syntax.binder_positivity = uu___3; FStarC_Syntax_Syntax.binder_attrs = uu___4;_}::rest, (uu___5, FStar_Pervasives_Native.None)::uu___6) -> - let uu___7 = FStarC_Compiler_List.hd bs in + let uu___7 = FStarC_List.hd bs in instantiate_one_and_go uu___7 rest args1 | ({ FStarC_Syntax_Syntax.binder_bv = x; FStarC_Syntax_Syntax.binder_qual = @@ -7852,7 +7824,7 @@ and (check_application_args : { FStarC_Syntax_Syntax.aqual_implicit = true; FStarC_Syntax_Syntax.aqual_attributes = uu___6;_})::rest') -> - let uu___7 = FStarC_Compiler_List.hd bs in + let uu___7 = FStarC_List.hd bs in instantiate_one_and_go uu___7 rest rest' | ({ FStarC_Syntax_Syntax.binder_bv = x; FStarC_Syntax_Syntax.binder_qual = bqual; @@ -7860,7 +7832,7 @@ and (check_application_args : FStarC_Syntax_Syntax.binder_attrs = b_attrs;_}::rest, (e, aq)::rest') -> let aq1 = - let uu___3 = FStarC_Compiler_List.hd bs in + let uu___3 = FStarC_List.hd bs in check_expected_aqual_for_binder aq uu___3 e.FStarC_Syntax_Syntax.pos in let targ = @@ -7876,7 +7848,7 @@ and (check_application_args : (x.FStarC_Syntax_Syntax.index); FStarC_Syntax_Syntax.sort = targ } in - ((let uu___4 = FStarC_Compiler_Debug.extreme () in + ((let uu___4 = FStarC_Debug.extreme () in if uu___4 then let uu___5 = @@ -7897,7 +7869,7 @@ and (check_application_args : let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term targ in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "\tFormal is %s : %s\tType of arg %s (after subst %s) = %s\n" uu___5 uu___6 uu___7 uu___8 uu___9 else ()); @@ -7910,7 +7882,7 @@ and (check_application_args : let env1 = FStarC_TypeChecker_Env.set_expected_typ_maybe_eq env targ1 (is_eq bqual1) in - ((let uu___6 = FStarC_Compiler_Debug.high () in + ((let uu___6 = FStarC_Debug.high () in if uu___6 then let uu___7 = @@ -7924,9 +7896,9 @@ and (check_application_args : FStarC_Syntax_Print.showable_term targ1 in let uu___10 = - FStarC_Compiler_Util.string_of_bool + FStarC_Util.string_of_bool (is_eq bqual1) in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Checking arg (%s) %s at type %s with use_eq:%s\n" uu___7 uu___8 uu___9 uu___10 else ()); @@ -7956,8 +7928,7 @@ and (check_application_args : if uu___7 then let subst1 = - let uu___8 = - FStarC_Compiler_List.hd bs in + let uu___8 = FStarC_List.hd bs in maybe_extend_subst subst uu___8 e1 in tc_args head_info (subst1, @@ -8016,8 +7987,7 @@ and (check_application_args : (head1, chead2, ghead3, cres'1) in ((let uu___7 = - FStarC_Compiler_Debug.low - () in + FStarC_Debug.low () in if uu___7 then FStarC_Errors.log_issue @@ -8128,8 +8098,9 @@ and (check_application_args : (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___7) in - aux false false ghead2 - (FStarC_Syntax_Util.comp_result chead2)))) in + let uu___5 = + FStarC_Syntax_Util.comp_result chead2 in + aux false false ghead2 uu___5))) in let rec check_function_app tf guard = let tf1 = FStarC_TypeChecker_Normalize.unfold_whnf env tf in let uu___1 = @@ -8138,7 +8109,7 @@ and (check_application_args : match uu___1 with | FStarC_Syntax_Syntax.Tm_uvar uu___2 -> let uu___3 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___4 -> fun uu___5 -> match uu___5 with @@ -8195,8 +8166,7 @@ and (check_application_args : (match uu___4 with | (cres, guard2) -> let bs_cres = FStarC_Syntax_Util.arrow bs cres in - ((let uu___6 = - FStarC_Compiler_Debug.extreme () in + ((let uu___6 = FStarC_Debug.extreme () in if uu___6 then let uu___7 = @@ -8209,7 +8179,7 @@ and (check_application_args : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term bs_cres in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Forcing the type of %s from %s to %s\n" uu___7 uu___8 uu___9 else ()); @@ -8236,7 +8206,7 @@ and (check_application_args : FStarC_Syntax_Syntax.args = uu___6;_} -> let uu___7 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___8 -> fun uu___9 -> match uu___9 with @@ -8294,8 +8264,7 @@ and (check_application_args : (match uu___8 with | (cres, guard2) -> let bs_cres = FStarC_Syntax_Util.arrow bs cres in - ((let uu___10 = - FStarC_Compiler_Debug.extreme () in + ((let uu___10 = FStarC_Debug.extreme () in if uu___10 then let uu___11 = @@ -8308,7 +8277,7 @@ and (check_application_args : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term bs_cres in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "Forcing the type of %s from %s to %s\n" uu___11 uu___12 uu___13 else ()); @@ -8331,7 +8300,7 @@ and (check_application_args : (match uu___2 with | (bs1, c1) -> let head_info = (head, chead, ghead, c1) in - ((let uu___4 = FStarC_Compiler_Debug.extreme () in + ((let uu___4 = FStarC_Debug.extreme () in if uu___4 then let uu___5 = @@ -8347,7 +8316,7 @@ and (check_application_args : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c1 in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "######tc_args of head %s @ %s with formals=%s and result type=%s\n" uu___5 uu___6 uu___7 uu___8 else ()); @@ -8388,20 +8357,19 @@ and (check_short_circuit_args : fun expected_topt -> let r = FStarC_TypeChecker_Env.get_range env in let tf = - FStarC_Syntax_Subst.compress - (FStarC_Syntax_Util.comp_result chead) in + let uu___ = FStarC_Syntax_Util.comp_result chead in + FStarC_Syntax_Subst.compress uu___ in match tf.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} when (FStarC_Syntax_Util.is_total_comp c) && - ((FStarC_Compiler_List.length bs) = - (FStarC_Compiler_List.length args)) + ((FStarC_List.length bs) = (FStarC_List.length args)) -> let res_t = FStarC_Syntax_Util.comp_result c in let uu___ = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___1 -> fun uu___2 -> fun b -> @@ -8441,9 +8409,9 @@ and (check_short_circuit_args : FStarC_Class_Monoid.op_Plus_Plus FStarC_TypeChecker_Common.monoid_guard_t guard g1 in - ((FStarC_Compiler_List.op_At seen - [(e1, aq1)]), uu___4, ghost1))) - ([], g_head, false) args bs in + ((FStarC_List.op_At seen [(e1, aq1)]), + uu___4, ghost1))) ([], g_head, false) + args bs in (match uu___ with | (args1, guard, ghost) -> let e = FStarC_Syntax_Syntax.mk_Tm_app head args1 r in @@ -8543,7 +8511,7 @@ and (tc_pat : scrutinee_t in aux false uu___ in let pat_typ_ok env1 pat_t1 scrutinee_t = - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Patterns in + (let uu___1 = FStarC_Effect.op_Bang dbg_Patterns in if uu___1 then let uu___2 = @@ -8552,8 +8520,8 @@ and (tc_pat : let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term scrutinee_t in - FStarC_Compiler_Util.print2 - "$$$$$$$$$$$$pat_typ_ok? %s vs. %s\n" uu___2 uu___3 + FStarC_Util.print2 "$$$$$$$$$$$$pat_typ_ok? %s vs. %s\n" uu___2 + uu___3 else ()); FStarC_Defensive.def_check_scoped FStarC_TypeChecker_Env.hasBinders_env @@ -8630,8 +8598,8 @@ and (tc_pat : "Pattern matching a non-inductive type" else ()); if - (FStarC_Compiler_List.length args_p) <> - (FStarC_Compiler_List.length args_s) + (FStarC_List.length args_p) <> + (FStarC_List.length args_s) then fail1 "" else (); (let uu___13 = @@ -8645,19 +8613,17 @@ and (tc_pat : (args_p, args_s) | FStar_Pervasives_Native.Some n -> let uu___15 = - FStarC_Compiler_Util.first_N n - args_p in + FStarC_Util.first_N n args_p in (match uu___15 with | (params_p, uu___16) -> let uu___17 = - FStarC_Compiler_Util.first_N n - args_s in + FStarC_Util.first_N n args_s in (match uu___17 with | (params_s, uu___18) -> (params_p, params_s))) in match uu___13 with | (params_p, params_s) -> - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun out -> fun uu___14 -> fun uu___15 -> @@ -8679,7 +8645,7 @@ and (tc_pat : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term s in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Parameter %s <> Parameter %s" uu___20 uu___21 in fail1 uu___19 @@ -8704,8 +8670,8 @@ and (tc_pat : let uu___13 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term head_s in - FStarC_Compiler_Util.format2 - "Head mismatch %s vs %s" uu___12 uu___13 in + FStarC_Util.format2 "Head mismatch %s vs %s" + uu___12 uu___13 in fail1 uu___11)) | uu___4 -> let uu___5 = @@ -8753,7 +8719,7 @@ and (tc_pat : let uu___10 = FStarC_Ident.string_of_lid (f.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Could not find constructor: %s" uu___10 in fail uu___9)) @@ -8770,8 +8736,8 @@ and (tc_pat : let erasable = FStarC_TypeChecker_Env.non_informative env1 t in (if - (FStarC_Compiler_List.length formals) <> - (FStarC_Compiler_List.length args) + (FStarC_List.length formals) <> + (FStarC_List.length args) then fail "Pattern is not a fully-applied data constructor" @@ -8832,8 +8798,7 @@ and (tc_pat : (f, a1)) :: subst in ((a1, imp_a), subst1, - (FStarC_Compiler_List.op_At - bvs [x1]), + (FStarC_List.op_At bvs [x1]), (FStarC_Class_Monoid.mzero FStarC_TypeChecker_Common.monoid_guard_t)) | FStarC_Syntax_Syntax.Tm_uvar @@ -8880,7 +8845,7 @@ and (tc_pat : FStarC_TypeChecker_Common.monoid_guard_t g guard in (subst1, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At args_out [a1]), bvs1, uu___15) in aux uu___14 formals2 args2) @@ -8913,7 +8878,7 @@ and (tc_pat : let uu___6 = FStarC_Ident.string_of_lid (f.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Could not find constructor: %s" uu___6 in fail uu___5)) @@ -8930,8 +8895,8 @@ and (tc_pat : let erasable = FStarC_TypeChecker_Env.non_informative env1 t in (if - (FStarC_Compiler_List.length formals) <> - (FStarC_Compiler_List.length args) + (FStarC_List.length formals) <> + (FStarC_List.length args) then fail "Pattern is not a fully-applied data constructor" @@ -8992,8 +8957,7 @@ and (tc_pat : (f, a1)) :: subst in ((a1, imp_a), subst1, - (FStarC_Compiler_List.op_At - bvs [x1]), + (FStarC_List.op_At bvs [x1]), (FStarC_Class_Monoid.mzero FStarC_TypeChecker_Common.monoid_guard_t)) | FStarC_Syntax_Syntax.Tm_uvar @@ -9040,7 +9004,7 @@ and (tc_pat : FStarC_TypeChecker_Common.monoid_guard_t g guard in (subst1, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At args_out [a1]), bvs1, uu___11) in aux uu___10 formals2 args2) @@ -9053,15 +9017,15 @@ and (tc_pat : formals args)))) | uu___1 -> fail "Not a simple pattern") in let rec check_nested_pattern env1 p t = - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Patterns in + (let uu___1 = FStarC_Effect.op_Bang dbg_Patterns in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 - "Checking nested pattern %s at type %s\n" uu___2 uu___3 + FStarC_Util.print2 "Checking nested pattern %s at type %s\n" + uu___2 uu___3 else ()); (let id t1 = let uu___1 = @@ -9094,16 +9058,15 @@ and (tc_pat : FStarC_TypeChecker_Env.num_inductive_ty_params env1 uu___5 in let uu___5 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (fun n -> - if (FStarC_Compiler_List.length args) >= n + if (FStarC_List.length args) >= n then - let uu___6 = - FStarC_Compiler_List.splitAt n args in + let uu___6 = FStarC_List.splitAt n args in FStar_Pervasives_Native.fst uu___6 else []) uu___4 in - FStarC_Compiler_Util.dflt [] uu___5 in - FStarC_Compiler_List.map + FStarC_Util.dflt [] uu___5 in + FStarC_List.map (fun uu___4 -> match uu___4 with | (t1, uu___5) -> FStarC_Syntax_Syntax.iarg t1) @@ -9118,21 +9081,21 @@ and (tc_pat : x_b.FStarC_Syntax_Syntax.binder_bv in FStarC_Syntax_Syntax.as_arg uu___4 in [uu___3] in - FStarC_Compiler_List.op_At ty_args uu___2 in + FStarC_List.op_At ty_args uu___2 in FStarC_Syntax_Syntax.mk_Tm_app disc uu___1 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let tm1 = let uu___1 = let uu___2 = FStarC_Syntax_Syntax.as_arg tm in [uu___2] in FStarC_Syntax_Syntax.mk_Tm_app inner_t uu___1 - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in FStarC_Syntax_Util.abs [x_b] tm1 FStar_Pervasives_Native.None in match p.FStarC_Syntax_Syntax.v with | FStarC_Syntax_Syntax.Pat_dot_term uu___1 -> let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Impossible: Expected an undecorated pattern, got %s" uu___3 in failwith uu___2 @@ -9166,7 +9129,7 @@ and (tc_pat : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_const c in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Pattern matching a constant that does not have decidable equality: %s" uu___4 in fail uu___3); @@ -9199,7 +9162,7 @@ and (tc_pat : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term expected_t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Type of pattern (%s) does not match type of scrutinee (%s)" uu___11 uu___12 in fail uu___10 @@ -9221,8 +9184,8 @@ and (tc_pat : (match uu___2 with | (rdc, uu___3, constructor_fv) -> let f_sub_pats = - FStarC_Compiler_List.zip - uc.FStarC_Syntax_Syntax.uc_fields sub_pats in + FStarC_List.zip uc.FStarC_Syntax_Syntax.uc_fields + sub_pats in let sub_pats1 = FStarC_TypeChecker_Util.make_record_fields_in_order env1 uc @@ -9254,7 +9217,7 @@ and (tc_pat : | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, sub_pats) -> let simple_pat = let simple_sub_pats = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___1 -> match uu___1 with | (p1, b) -> @@ -9280,7 +9243,7 @@ and (tc_pat : FStarC_Syntax_Syntax.p = (p.FStarC_Syntax_Syntax.p) } in let sub_pats1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___1 -> match uu___1 with | (x, uu___2) -> @@ -9294,23 +9257,23 @@ and (tc_pat : (match uu___1 with | (simple_bvs_pat, simple_pat_e, g0, simple_pat_elab) -> (if - (FStarC_Compiler_List.length simple_bvs_pat) <> - (FStarC_Compiler_List.length sub_pats1) + (FStarC_List.length simple_bvs_pat) <> + (FStarC_List.length sub_pats1) then (let uu___3 = let uu___4 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range p.FStarC_Syntax_Syntax.p in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat simple_pat in let uu___6 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length sub_pats1) in + FStarC_Util.string_of_int + (FStarC_List.length sub_pats1) in let uu___7 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length simple_bvs_pat) in - FStarC_Compiler_Util.format4 + FStarC_Util.string_of_int + (FStarC_List.length simple_bvs_pat) in + FStarC_Util.format4 "(%s) Impossible: pattern bvar mismatch: %s; expected %s sub pats; got %s" uu___4 uu___5 uu___6 uu___7 in failwith uu___3) @@ -9322,10 +9285,10 @@ and (tc_pat : erasable) -> let simple_bvs1 = let uu___5 = - FStarC_Compiler_Util.first_N - ((FStarC_Compiler_List.length simple_bvs) - - (FStarC_Compiler_List.length - simple_bvs_pat)) simple_bvs in + FStarC_Util.first_N + ((FStarC_List.length simple_bvs) - + (FStarC_List.length simple_bvs_pat)) + simple_bvs in FStar_Pervasives_Native.snd uu___5 in let g' = let uu___5 = @@ -9369,8 +9332,7 @@ and (tc_pat : FStarC_Class_Monoid.op_Plus_Plus FStarC_TypeChecker_Common.monoid_guard_t guard1 g' in - ((let uu___6 = - FStarC_Compiler_Effect.op_Bang dbg_Patterns in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Patterns in if uu___6 then let uu___7 = @@ -9383,7 +9345,7 @@ and (tc_pat : simple_pat_t in let uu___9 = let uu___10 = - FStarC_Compiler_List.map + FStarC_List.map (fun x -> let uu___11 = let uu___12 = @@ -9401,8 +9363,8 @@ and (tc_pat : Prims.strcat uu___12 uu___13 in Prims.strcat "(" uu___11) simple_bvs1 in - FStarC_Compiler_String.concat " " uu___10 in - FStarC_Compiler_Util.print3 + FStarC_String.concat " " uu___10 in + FStarC_Util.print3 "$$$$$$$$$$$$Checked simple pattern %s at type %s with bvs=%s\n" uu___7 uu___8 uu___9 else ()); @@ -9417,7 +9379,7 @@ and (tc_pat : g1 in ([], [], [], [], uu___6, erasable, Prims.int_zero) in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___6 -> fun uu___7 -> fun x -> @@ -9439,7 +9401,7 @@ and (tc_pat : erasable_p) -> let g'1 = let uu___9 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs in FStarC_TypeChecker_Env.close_guard @@ -9457,18 +9419,15 @@ and (tc_pat : disc_tm FStar_Pervasives_Native.None in mk_disc_t uu___10 in - FStarC_Compiler_List.map - uu___9 tms_p in + FStarC_List.map uu___9 tms_p in let uu___9 = FStarC_Class_Monoid.op_Plus_Plus FStarC_TypeChecker_Common.monoid_guard_t g g'1 in - ((FStarC_Compiler_List.op_At - bvs bvs_p), - (FStarC_Compiler_List.op_At - tms tms_p1), - (FStarC_Compiler_List.op_At - pats [(p2, b)]), + ((FStarC_List.op_At bvs bvs_p), + (FStarC_List.op_At tms tms_p1), + (FStarC_List.op_At pats + [(p2, b)]), ((FStarC_Syntax_Syntax.NT (x, e_p)) :: subst), uu___9, @@ -9490,7 +9449,7 @@ and (tc_pat : | FStarC_Syntax_Syntax.Pat_dot_term eopt -> let eopt1 = - FStarC_Compiler_Util.map_option + FStarC_Util.map_option (FStarC_Syntax_Subst.subst subst) eopt in let hd1 = @@ -9561,12 +9520,12 @@ and (tc_pat : let uu___6 = reconstruct_nested_pat simple_pat_elab in (bvs, tms, pat_e, uu___6, g, erasable1)))))) in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Patterns in + (let uu___1 = FStarC_Effect.op_Bang dbg_Patterns in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat p0 in - FStarC_Compiler_Util.print1 "Checking pattern: %s\n" uu___2 + FStarC_Util.print1 "Checking pattern: %s\n" uu___2 else ()); (let uu___1 = let uu___2 = @@ -9581,7 +9540,7 @@ and (tc_pat : let pat_e_norm = FStarC_TypeChecker_Normalize.normalize [FStarC_TypeChecker_Env.Beta] extended_env pat_e in - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Patterns in + ((let uu___3 = FStarC_Effect.op_Bang dbg_Patterns in if uu___3 then let uu___4 = @@ -9590,7 +9549,7 @@ and (tc_pat : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term pat_e in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Done checking pattern %s as expression %s\n" uu___4 uu___5 else ()); @@ -9636,7 +9595,7 @@ and (tc_eqn : (match uu___5 with | (pattern1, pat_bvs, pat_bv_tms, pat_env, pat_exp, norm_pat_exp, guard_pat, erasable) -> - ((let uu___7 = FStarC_Compiler_Debug.extreme () in + ((let uu___7 = FStarC_Debug.extreme () in if uu___7 then let uu___8 = @@ -9653,7 +9612,7 @@ and (tc_eqn : (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_term) pat_bv_tms in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "tc_eqn: typechecked pattern %s with bvs %s and pat_bv_tms=%s\n" uu___8 uu___9 uu___10 else ()); @@ -9782,7 +9741,7 @@ and (tc_eqn : (Prims.op_Negation is_induc) || - ((FStarC_Compiler_List.length + ((FStarC_List.length datacons) > Prims.int_one) then @@ -9817,7 +9776,7 @@ and (tc_eqn : let fail uu___12 = let uu___13 = let uu___14 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range pat_exp1.FStarC_Syntax_Syntax.pos in let uu___15 = FStarC_Class_Show.show @@ -9827,7 +9786,7 @@ and (tc_eqn : FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term pat_exp1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "tc_eqn: Impossible (%s) %s (%s)" uu___14 uu___15 uu___16 in @@ -9849,13 +9808,13 @@ and (tc_eqn : -> let uu___13 = let uu___14 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range pattern2.FStarC_Syntax_Syntax.p in let uu___15 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_pat pattern2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Impossible (%s): scrutinee of match is not defined %s" uu___14 uu___15 in failwith uu___13 @@ -9990,10 +9949,10 @@ and (tc_eqn : Prims.op_Negation uu___15) || - ((FStarC_Compiler_List.length + ((FStarC_List.length pat_args) <> - (FStarC_Compiler_List.length + (FStarC_List.length args)) in if uu___14 then @@ -10003,9 +9962,9 @@ and (tc_eqn : (let sub_term_guards = let uu___16 = let uu___17 = - FStarC_Compiler_List.zip + FStarC_List.zip pat_args args in - FStarC_Compiler_List.mapi + FStarC_List.mapi (fun i -> fun uu___18 -> @@ -10072,7 +10031,7 @@ and (tc_eqn : scrutinee_tm2 pi ei) uu___17 in - FStarC_Compiler_List.flatten + FStarC_List.flatten uu___16 in let uu___16 = let uu___17 = @@ -10080,7 +10039,7 @@ and (tc_eqn : () in discriminate uu___17 f in - FStarC_Compiler_List.op_At + FStarC_List.op_At uu___16 sub_term_guards) | (FStarC_Syntax_Syntax.Pat_dot_term @@ -10095,7 +10054,7 @@ and (tc_eqn : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term pat_exp2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Internal error: unexpected elaborated pattern: %s and pattern expression %s" uu___14 uu___15 in failwith uu___13 in @@ -10118,15 +10077,14 @@ and (tc_eqn : FStarC_Syntax_Util.mk_and_l uu___14 in (let uu___15 = - FStarC_Compiler_Debug.high - () in + FStarC_Debug.high () in if uu___15 then let uu___16 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "tc_eqn: branch guard before typechecking: %s\n" uu___16 else ()); @@ -10139,7 +10097,7 @@ and (tc_eqn : | (t1, uu___16, uu___17) -> ((let uu___19 = - FStarC_Compiler_Debug.high + FStarC_Debug.high () in if uu___19 then @@ -10147,7 +10105,7 @@ and (tc_eqn : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "tc_eqn: branch guard after typechecking: %s\n" uu___20 else ()); @@ -10167,14 +10125,14 @@ and (tc_eqn : branch_guard1 w in branch_guard2) in (let uu___11 = - FStarC_Compiler_Debug.extreme () in + FStarC_Debug.extreme () in if uu___11 then let uu___12 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term branch_guard in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "tc_eqn: branch guard : %s\n" uu___12 else ()); @@ -10209,18 +10167,18 @@ and (tc_eqn : uu___13, uu___14)) -> let pat_bs = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder pat_bvs in let g_branch1 = let uu___15 = let uu___16 = if - FStarC_Compiler_Util.is_some + FStarC_Util.is_some eqs then let uu___17 = - FStarC_Compiler_Util.must + FStarC_Util.must eqs in FStarC_TypeChecker_Common.weaken_guard_formula g_branch uu___17 @@ -10229,8 +10187,10 @@ and (tc_eqn : env pat_bs uu___16 in FStarC_TypeChecker_Util.close_guard_implicits env true pat_bs uu___15 in - ((FStarC_Syntax_Util.comp_effect_name - c1), + let uu___15 = + FStarC_Syntax_Util.comp_effect_name + c1 in + (uu___15, FStar_Pervasives_Native.None, FStar_Pervasives_Native.None, g_when, g_branch1) @@ -10363,7 +10323,7 @@ and (tc_eqn : | (c_weak, g_when_weak) -> let binders = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder pat_bvs in let maybe_return_c_weak @@ -10391,16 +10351,16 @@ and (tc_eqn : then ((let uu___16 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffects in if uu___16 then - FStarC_Compiler_Util.print_string + FStarC_Util.print_string "Typechecking pat_bv_tms ...\n" else ()); (let pat_bv_tms1 = - FStarC_Compiler_List.map + FStarC_List.map (fun pat_bv_tm -> @@ -10414,7 +10374,7 @@ and (tc_eqn : FStarC_Syntax_Syntax.mk_Tm_app pat_bv_tm uu___16 - FStarC_Compiler_Range_Type.dummyRange) + FStarC_Range_Type.dummyRange) pat_bv_tms in let pat_bv_tms2 = @@ -10585,7 +10545,7 @@ and (tc_eqn : = let uu___17 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun uu___18 -> @@ -10622,13 +10582,13 @@ and (tc_eqn : uu___21 in FStar_Pervasives_Native.fst uu___19 in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At substs [ FStarC_Syntax_Syntax.NT (bv, pat_bv_tm1)]), - (FStarC_Compiler_List.op_At + (FStarC_List.op_At acc [pat_bv_tm1]))) ([], []) @@ -10636,14 +10596,14 @@ and (tc_eqn : pat_bvs in FStar_Pervasives_Native.snd uu___17 in - FStarC_Compiler_List.map + FStarC_List.map (FStarC_TypeChecker_Normalize.normalize [FStarC_TypeChecker_Env.Beta] env1) uu___16 in (let uu___17 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffects in if uu___17 then @@ -10659,7 +10619,7 @@ and (tc_eqn : (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_bv) pat_bvs in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "tc_eqn: typechecked pat_bv_tms=%s (pat_bvs=%s)\n" uu___18 uu___19 @@ -10747,14 +10707,13 @@ and (tc_eqn : FStarC_TypeChecker_Common.monoid_guard_t g_when1 g_branch1 in ((let uu___13 = - FStarC_Compiler_Debug.high - () in + FStarC_Debug.high () in if uu___13 then let uu___14 = FStarC_TypeChecker_Rel.guard_to_string env guard in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Carrying guard from match: %s\n" uu___14 else ()); @@ -10764,7 +10723,7 @@ and (tc_eqn : branch_exp1) in let uu___14 = let uu___15 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder pat_bvs in FStarC_TypeChecker_Util.close_guard_implicits @@ -10818,7 +10777,7 @@ and (check_top_level_let : FStarC_TypeChecker_Generalize.generalize env1 false [((lb.FStarC_Syntax_Syntax.lbname), e1, comp1)] in - FStarC_Compiler_List.hd uu___5 in + FStarC_List.hd uu___5 in (match uu___4 with | (uu___5, univs, e11, c11, gvs) -> let g13 = @@ -10871,13 +10830,13 @@ and (check_top_level_let : (uu___6, c12))) in (match uu___2 with | (e21, c12) -> - ((let uu___4 = FStarC_Compiler_Debug.medium () in + ((let uu___4 = FStarC_Debug.medium () in if uu___4 then let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e11 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Let binding BEFORE tcnorm: %s\n" uu___5 else ()); (let e12 = @@ -10895,24 +10854,26 @@ and (check_top_level_let : FStarC_TypeChecker_Env.DoNotUnfoldPureLets] env1 e11 else e11 in - (let uu___5 = FStarC_Compiler_Debug.medium () in + (let uu___5 = FStarC_Debug.medium () in if uu___5 then let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e12 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Let binding AFTER tcnorm: %s\n" uu___6 else ()); (let cres = FStarC_Syntax_Syntax.mk_Total FStarC_Syntax_Syntax.t_unit in let lb1 = + let uu___5 = FStarC_Syntax_Util.comp_result c12 in + let uu___6 = + FStarC_Syntax_Util.comp_effect_name c12 in FStarC_Syntax_Util.close_univs_and_mk_letbinding FStar_Pervasives_Native.None lb.FStarC_Syntax_Syntax.lbname univ_vars1 - (FStarC_Syntax_Util.comp_result c12) - (FStarC_Syntax_Util.comp_effect_name c12) e12 + uu___5 uu___6 e12 lb.FStarC_Syntax_Syntax.lbattrs lb.FStarC_Syntax_Syntax.lbpos in let uu___5 = @@ -10942,7 +10903,7 @@ and (maybe_intro_smt_lemma : then let universe_of_binders bs = let uu___1 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun b -> match uu___2 with @@ -10953,7 +10914,7 @@ and (maybe_intro_smt_lemma : let env2 = FStarC_TypeChecker_Env.push_binders env1 [b] in (env2, (u :: us))) (env, []) bs in - match uu___1 with | (uu___2, us) -> FStarC_Compiler_List.rev us in + match uu___1 with | (uu___2, us) -> FStarC_List.rev us in let quant = FStarC_Syntax_Util.smt_lemma_as_forall lem_typ universe_of_binders in @@ -11089,7 +11050,7 @@ and (check_inner_let : let pure_or_ghost = FStarC_TypeChecker_Common.is_pure_or_ghost_lcomp c1 in let is_inline_let = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (FStarC_Syntax_Util.is_fvar FStarC_Parser_Const.inline_let_attr) lb.FStarC_Syntax_Syntax.lbattrs in @@ -11109,7 +11070,7 @@ and (check_inner_let : let uu___6 = FStarC_Class_Show.show FStarC_Ident.showable_lident c1.FStarC_TypeChecker_Common.eff_name in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Definitions marked @inline_let are expected to be pure or ghost; got an expression \"%s\" with effect \"%s\"" uu___5 uu___6 in FStarC_Errors.raise_error @@ -11120,7 +11081,7 @@ and (check_inner_let : else ()); (let x = let uu___3 = - FStarC_Compiler_Util.left lb.FStarC_Syntax_Syntax.lbname in + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in { FStarC_Syntax_Syntax.ppname = (uu___3.FStarC_Syntax_Syntax.ppname); @@ -11136,7 +11097,7 @@ and (check_inner_let : FStarC_Syntax_Subst.open_term uu___4 e2 in match uu___3 with | (xb, e21) -> - let xbinder = FStarC_Compiler_List.hd xb in + let xbinder = FStarC_List.hd xb in let x1 = xbinder.FStarC_Syntax_Syntax.binder_bv in let env_x = FStarC_TypeChecker_Env.push_bv env2 x1 in let uu___4 = @@ -11227,17 +11188,16 @@ and (check_inner_let : let uu___5 = let uu___6 = FStarC_TypeChecker_Env.expected_typ env2 in - FStarC_Compiler_Option.isSome uu___6 in + FStarC_Option.isSome uu___6 in if uu___5 then let tt = let uu___6 = let uu___7 = FStarC_TypeChecker_Env.expected_typ env2 in - FStarC_Compiler_Option.get uu___7 in + FStarC_Option.get uu___7 in FStar_Pervasives_Native.fst uu___6 in - ((let uu___7 = - FStarC_Compiler_Effect.op_Bang dbg_Exports in + ((let uu___7 = FStarC_Effect.op_Bang dbg_Exports in if uu___7 then let uu___8 = @@ -11247,7 +11207,7 @@ and (check_inner_let : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term cres.FStarC_TypeChecker_Common.res_typ in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Got expected type from env %s\ncres.res_typ=%s\n" uu___8 uu___9 else ()); @@ -11260,8 +11220,7 @@ and (check_inner_let : match uu___7 with | (t, g_ex) -> ((let uu___9 = - FStarC_Compiler_Effect.op_Bang - dbg_Exports in + FStarC_Effect.op_Bang dbg_Exports in if uu___9 then let uu___10 = @@ -11271,7 +11230,7 @@ and (check_inner_let : let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Checked %s has no escaping types; normalized to %s\n" uu___10 uu___11 else ()); @@ -11328,9 +11287,9 @@ and (check_top_level_let_rec : uu___4 in let all_lb_names = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname) lbs3 in FStar_Pervasives_Native.Some uu___4 in let uu___4 = @@ -11339,7 +11298,7 @@ and (check_top_level_let_rec : env1.FStarC_TypeChecker_Env.generalize then let lbs4 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let lbdef = FStarC_TypeChecker_Normalize.reduce_uvar_solutions @@ -11364,7 +11323,7 @@ and (check_top_level_let_rec : else (let ecs = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___7 = FStarC_Syntax_Syntax.mk_Total @@ -11375,17 +11334,20 @@ and (check_top_level_let_rec : FStarC_TypeChecker_Generalize.generalize env1 true uu___6 in let lbs4 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun uu___6 -> fun lb -> match uu___6 with | (x, uvs, e, c, gvs) -> + let uu___7 = + FStarC_Syntax_Util.comp_result + c in + let uu___8 = + FStarC_Syntax_Util.comp_effect_name + c in FStarC_Syntax_Util.close_univs_and_mk_letbinding - all_lb_names x uvs - (FStarC_Syntax_Util.comp_result - c) - (FStarC_Syntax_Util.comp_effect_name - c) e + all_lb_names x uvs uu___7 + uu___8 e lb.FStarC_Syntax_Syntax.lbattrs lb.FStarC_Syntax_Syntax.lbpos) ecs lbs3 in @@ -11461,12 +11423,12 @@ and (check_inner_let_rec : (match uu___3 with | (lbs3, g_lbs) -> let uu___4 = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun env2 -> fun lb -> let x = let uu___5 = - FStarC_Compiler_Util.left + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in { FStarC_Syntax_Syntax.ppname = @@ -11503,16 +11465,16 @@ and (check_inner_let_rec : (match uu___4 with | (env2, lbs4) -> let bvs = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> - FStarC_Compiler_Util.left + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname) lbs4 in let uu___5 = tc_term env2 e21 in (match uu___5 with | (e22, cres, g2) -> let cres1 = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun lb -> fun cres2 -> maybe_intro_smt_lemma env2 @@ -11528,7 +11490,7 @@ and (check_inner_let_rec : let guard = let uu___6 = let uu___7 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs in FStarC_TypeChecker_Env.close_guard @@ -11551,7 +11513,7 @@ and (check_inner_let_rec : (FStarC_Class_Setlike.from_list () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) bvs) in FStarC_TypeChecker_Common.apply_lcomp @@ -11560,7 +11522,7 @@ and (check_inner_let_rec : let uu___8 = FStarC_Syntax_Util.comp_effect_args c in - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun uu___9 -> match uu___9 with | (t, uu___10) -> @@ -11573,7 +11535,7 @@ and (check_inner_let_rec : (FStarC_Class_Setlike.inter () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic bvss) @@ -11582,7 +11544,7 @@ and (check_inner_let_rec : FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___12) in @@ -11622,10 +11584,10 @@ and (check_inner_let_rec : } in let guard1 = let bs = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___6 = - FStarC_Compiler_Util.left + FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.mk_binder uu___6) lbs4 in @@ -11703,15 +11665,15 @@ and (build_let_rec_env : FStarC_TypeChecker_Env.set_expected_typ env lbtyp in FStarC_TypeChecker_Util.maybe_add_implicit_binders uu___3 actuals in - let nactuals = FStarC_Compiler_List.length actuals1 in + let nactuals = FStarC_List.length actuals1 in let uu___3 = FStarC_TypeChecker_Normalize.get_n_binders env nactuals lbtyp in (match uu___3 with | (formals, c) -> (if - (FStarC_Compiler_List.isEmpty formals) || - (FStarC_Compiler_List.isEmpty actuals1) + (FStarC_List.isEmpty formals) || + (FStarC_List.isEmpty actuals1) then (let uu___5 = let uu___6 = @@ -11729,9 +11691,8 @@ and (build_let_rec_env : let uu___12 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lbtyp in - FStarC_Compiler_Util.format3 - "Got (%s) %s : %s" uu___10 uu___11 - uu___12 in + FStarC_Util.format3 "Got (%s) %s : %s" + uu___10 uu___11 uu___12 in FStarC_Errors_Msg.text uu___9 in [uu___8] in uu___6 :: uu___7 in @@ -11743,7 +11704,7 @@ and (build_let_rec_env : FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___5)) else (); - (let nformals = FStarC_Compiler_List.length formals in + (let nformals = FStarC_List.length formals in let uu___5 = FStarC_Syntax_Util.has_attribute attrs FStarC_Parser_Const.admit_termination_lid in @@ -11766,9 +11727,11 @@ and (build_let_rec_env : else (let uu___7 = let uu___8 = + let uu___9 = + FStarC_Syntax_Util.comp_effect_name c in FStarC_TypeChecker_Env.lookup_effect_quals env - (FStarC_Syntax_Util.comp_effect_name c) in - FStarC_Compiler_List.contains + uu___9 in + FStarC_List.contains FStarC_Syntax_Syntax.TotalEffect uu___8 in if uu___7 then @@ -11897,7 +11860,7 @@ and (build_let_rec_env : FStarC_TypeChecker_Rel.discharge_guard env01 uu___3 in (env01, uu___2, t1) in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun lb -> match uu___1 with @@ -11933,18 +11896,16 @@ and (build_let_rec_env : match uu___5 with | FStar_Pervasives_Native.Some (arity, lbdef1) -> - ((let uu___7 = - FStarC_Compiler_Debug.extreme () in + ((let uu___7 = FStarC_Debug.extreme () in if uu___7 then let uu___8 = - FStarC_Compiler_Util.string_of_int - arity in + FStarC_Util.string_of_int arity in let uu___9 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lbdef1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "termination_check_enabled returned arity: %s and lbdef: %s\n" uu___8 uu___9 else ()); @@ -12131,7 +12092,7 @@ and (build_let_rec_env : (FStarC_Class_Monoid.mzero FStarC_TypeChecker_Common.monoid_guard_t)) lbs in match uu___ with - | (lbs1, env1, g) -> ((FStarC_Compiler_List.rev lbs1), env1, g) + | (lbs1, env1, g) -> ((FStarC_List.rev lbs1), env1, g) and (check_let_recs : FStarC_TypeChecker_Env.env_t -> FStarC_Syntax_Syntax.letbinding Prims.list -> @@ -12142,7 +12103,7 @@ and (check_let_recs : fun lbts -> let uu___ = let uu___1 = - FStarC_Compiler_List.map + FStarC_List.map (fun lb -> let uu___2 = FStarC_Syntax_Util.abs_formals lb.FStarC_Syntax_Syntax.lbdef in @@ -12170,8 +12131,8 @@ and (check_let_recs : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term lb.FStarC_Syntax_Syntax.lbdef in - FStarC_Compiler_Util.format2 - "%s is defined to be %s" uu___9 uu___10 in + FStarC_Util.format2 "%s is defined to be %s" + uu___9 uu___10 in FStarC_Errors_Msg.text uu___8 in [uu___7] in uu___5 :: uu___6 in @@ -12190,12 +12151,12 @@ and (check_let_recs : match uu___4 with | FStar_Pervasives_Native.Some n -> n | FStar_Pervasives_Native.None -> - FStarC_Compiler_List.length bs in - let uu___4 = FStarC_Compiler_List.splitAt arity bs in + FStarC_List.length bs in + let uu___4 = FStarC_List.splitAt arity bs in (match uu___4 with | (bs0, bs1) -> let def = - if FStarC_Compiler_List.isEmpty bs1 + if FStarC_List.isEmpty bs1 then FStarC_Syntax_Util.abs bs0 t lcomp else (let inner = @@ -12262,7 +12223,7 @@ and (check_let_recs : lb1.FStarC_Syntax_Syntax.lbattrs lb1.FStarC_Syntax_Syntax.lbpos in (lb2, g))))))) lbts in - FStarC_Compiler_List.unzip uu___1 in + FStarC_List.unzip uu___1 in match uu___ with | (lbs, gs) -> let uu___1 = @@ -12415,7 +12376,7 @@ and (check_let_bound_def : FStarC_TypeChecker_Util.strengthen_precondition (FStar_Pervasives_Native.Some (fun uu___7 -> - FStarC_Compiler_Util.return_all + FStarC_Util.return_all FStarC_TypeChecker_Err.ill_kinded_type)) uu___6 e12 c1 wf_annot in (match uu___5 with @@ -12424,7 +12385,7 @@ and (check_let_bound_def : FStarC_Class_Monoid.op_Plus_Plus FStarC_TypeChecker_Common.monoid_guard_t g1 guard_f in - ((let uu___7 = FStarC_Compiler_Debug.extreme () in + ((let uu___7 = FStarC_Debug.extreme () in if uu___7 then let uu___8 = @@ -12439,12 +12400,12 @@ and (check_let_bound_def : let uu___10 = FStarC_TypeChecker_Rel.guard_to_string env g11 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "checked let-bound def %s : %s guard is %s\n" uu___8 uu___9 uu___10 else ()); (e12, univ_vars, c11, g11, - (FStarC_Compiler_Option.isSome topt))))))) + (FStarC_Option.isSome topt))))))) and (check_lbtyp : Prims.bool -> FStarC_TypeChecker_Env.env -> @@ -12504,21 +12465,20 @@ and (check_lbtyp : FStar_Pervasives_Native.None in (match uu___6 with | (t2, uu___7, g) -> - ((let uu___9 = - FStarC_Compiler_Debug.medium () in + ((let uu___9 = FStarC_Debug.medium () in if uu___9 then let uu___10 = let uu___11 = FStarC_Syntax_Syntax.range_of_lbname lb.FStarC_Syntax_Syntax.lbname in - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range uu___11 in let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "(%s) Checked type annotation %s\n" uu___10 uu___11 else ()); @@ -12544,7 +12504,7 @@ and (tc_binder : let uu___1 = FStarC_Syntax_Util.type_u () in (match uu___1 with | (tu, u) -> - ((let uu___3 = FStarC_Compiler_Debug.extreme () in + ((let uu___3 = FStarC_Debug.extreme () in if uu___3 then let uu___4 = @@ -12555,9 +12515,8 @@ and (tc_binder : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term tu in - FStarC_Compiler_Util.print3 - "Checking binder %s:%s at type %s\n" uu___4 uu___5 - uu___6 + FStarC_Util.print3 "Checking binder %s:%s at type %s\n" + uu___4 uu___5 uu___6 else ()); (let uu___3 = tc_check_tot_or_gtot_term env x.FStarC_Syntax_Syntax.sort @@ -12598,7 +12557,7 @@ and (tc_binder : (x.FStarC_Syntax_Syntax.index); FStarC_Syntax_Syntax.sort = t } imp1 pqual attrs1 in - (let uu___9 = FStarC_Compiler_Debug.high () in + (let uu___9 = FStarC_Debug.high () in if uu___9 then let uu___10 = @@ -12608,7 +12567,7 @@ and (tc_binder : let uu___11 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Pushing binder %s at type %s\n" uu___10 uu___11 else ()); @@ -12622,14 +12581,14 @@ and (tc_binders : = fun env -> fun bs -> - (let uu___1 = FStarC_Compiler_Debug.extreme () in + (let uu___1 = FStarC_Debug.extreme () in if uu___1 then let uu___2 = FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Syntax_Print.showable_binder) bs in - FStarC_Compiler_Util.print1 "Checking binders %s\n" uu___2 + FStarC_Util.print1 "Checking binders %s\n" uu___2 else ()); (let rec aux env1 bs1 = match bs1 with @@ -12664,7 +12623,7 @@ and (tc_smt_pats : fun en -> fun pats -> let tc_args en1 args = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___ -> fun uu___1 -> match (uu___, uu___1) with @@ -12680,7 +12639,7 @@ and (tc_smt_pats : ([], (FStarC_Class_Monoid.mzero FStarC_TypeChecker_Common.monoid_guard_t)) in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun p -> fun uu___ -> match uu___ with @@ -12724,18 +12683,18 @@ and (tc_tot_or_gtot_term_maybe_solve_deferred : let c2 = norm_c env c1 in let uu___4 = let uu___5 = - FStarC_TypeChecker_Util.is_pure_effect env - (FStarC_Syntax_Util.comp_effect_name c2) in + let uu___6 = FStarC_Syntax_Util.comp_effect_name c2 in + FStarC_TypeChecker_Util.is_pure_effect env uu___6 in if uu___5 then let uu___6 = - FStarC_Syntax_Syntax.mk_Total - (FStarC_Syntax_Util.comp_result c2) in + let uu___7 = FStarC_Syntax_Util.comp_result c2 in + FStarC_Syntax_Syntax.mk_Total uu___7 in (uu___6, false) else (let uu___7 = - FStarC_Syntax_Syntax.mk_GTotal - (FStarC_Syntax_Util.comp_result c2) in + let uu___8 = FStarC_Syntax_Util.comp_result c2 in + FStarC_Syntax_Syntax.mk_GTotal uu___8 in (uu___7, true)) in (match uu___4 with | (target_comp, allow_ghost) -> @@ -12813,7 +12772,7 @@ and (tc_attributes : = fun env -> fun attrs -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___ -> fun attr -> match uu___ with @@ -12826,7 +12785,7 @@ and (tc_attributes : FStarC_TypeChecker_Common.monoid_guard_t g g' in (uu___3, (attr' :: attrs1)))) ((FStarC_Class_Monoid.mzero FStarC_TypeChecker_Common.monoid_guard_t), - []) (FStarC_Compiler_List.rev attrs) + []) (FStarC_List.rev attrs) let (tc_check_trivial_guard : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> @@ -12850,12 +12809,12 @@ let (typeof_tot_or_gtot_term : fun env -> fun e -> fun must_tot -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_RelCheck in + (let uu___1 = FStarC_Effect.op_Bang dbg_RelCheck in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print1 "Checking term %s\n" uu___2 + FStarC_Util.print1 "Checking term %s\n" uu___2 else ()); (let env1 = { @@ -12967,13 +12926,13 @@ let (typeof_tot_or_gtot_term : () with | FStarC_Errors.Error (e1, msg, r, ctx) when - r = FStarC_Compiler_Range_Type.dummyRange -> + r = FStarC_Range_Type.dummyRange -> let uu___3 = let uu___4 = let uu___5 = FStarC_TypeChecker_Env.get_range env1 in (e1, msg, uu___5, ctx) in FStarC_Errors.Error uu___4 in - FStarC_Compiler_Effect.raise uu___3 in + FStarC_Effect.raise uu___3 in match uu___1 with | (t, c, g) -> if must_tot @@ -12989,7 +12948,7 @@ let (typeof_tot_or_gtot_term : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Implicit argument: Expected a total term; got a ghost term: %s" uu___5 in FStarC_Errors.raise_error @@ -13011,8 +12970,8 @@ let level_of_type_fail : let uu___2 = let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.format2 - "Expected a type; got %s of type %s" uu___3 t in + FStarC_Util.format2 "Expected a type; got %s of type %s" uu___3 + t in FStarC_Errors_Msg.text uu___2 in [uu___1] in FStarC_Errors.raise_error FStarC_TypeChecker_Env.hasRange_env env @@ -13172,7 +13131,7 @@ let rec (apply_well_typed : fun env -> fun t_hd -> fun args -> - if (FStarC_Compiler_List.length args) = Prims.int_zero + if (FStarC_List.length args) = Prims.int_zero then FStar_Pervasives_Native.Some t_hd else (let uu___1 = @@ -13183,12 +13142,12 @@ let rec (apply_well_typed : { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} -> - let n_args = FStarC_Compiler_List.length args in - let n_bs = FStarC_Compiler_List.length bs in + let n_args = FStarC_List.length args in + let n_bs = FStarC_List.length bs in let uu___2 = if n_args < n_bs then - let uu___3 = FStarC_Compiler_Util.first_N n_args bs in + let uu___3 = FStarC_Util.first_N n_args bs in match uu___3 with | (bs1, rest) -> let t = @@ -13203,22 +13162,21 @@ let rec (apply_well_typed : FStarC_Syntax_Subst.open_comp bs1 uu___5 in (match uu___4 with | (bs2, c1) -> - (bs2, args, (FStarC_Syntax_Util.comp_result c1), - [])) + let uu___5 = FStarC_Syntax_Util.comp_result c1 in + (bs2, args, uu___5, [])) else (let uu___4 = FStarC_Syntax_Subst.open_comp bs c in match uu___4 with | (bs1, c1) -> - let uu___5 = FStarC_Compiler_List.splitAt n_bs args in + let uu___5 = FStarC_List.splitAt n_bs args in (match uu___5 with | (args1, remaining_args) -> - (bs1, args1, - (FStarC_Syntax_Util.comp_result c1), - remaining_args))) in + let uu___6 = FStarC_Syntax_Util.comp_result c1 in + (bs1, args1, uu___6, remaining_args))) in (match uu___2 with | (bs1, args1, t, remaining_args) -> let subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun a -> FStarC_Syntax_Syntax.NT @@ -13324,9 +13282,7 @@ let rec (universe_of_aux : (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in (match uu___4 with | ((us', t), uu___5) -> - (if - (FStarC_Compiler_List.length us) <> - (FStarC_Compiler_List.length us') + (if (FStarC_List.length us) <> (FStarC_List.length us') then FStarC_Errors.raise_error FStarC_TypeChecker_Env.hasRange_env env @@ -13334,7 +13290,7 @@ let rec (universe_of_aux : (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic "Unexpected number of universe instantiations") else (); - FStarC_Compiler_List.iter2 + FStarC_List.iter2 (fun ul -> fun ur -> match (ul, ur) with @@ -13354,7 +13310,7 @@ let rec (universe_of_aux : let uu___12 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_univ ur in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Incompatible universe application for %s, expected %s got %s\n" uu___10 uu___11 uu___12 in FStarC_Errors.raise_error @@ -13378,7 +13334,7 @@ let rec (universe_of_aux : | (bs1, c1) -> let env1 = FStarC_TypeChecker_Env.push_binders env bs1 in let us = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___2 -> match uu___2 with | { FStarC_Syntax_Syntax.binder_bv = b; @@ -13451,7 +13407,7 @@ let rec (universe_of_aux : let uu___8 = FStarC_TypeChecker_Env.push_bvs env1 bvs in type_of_head retry uu___8 hd3 - (FStarC_Compiler_List.op_At args' args1))) + (FStarC_List.op_At args' args1))) | uu___1 when retry -> let e1 = FStarC_TypeChecker_Normalize.normalize @@ -13570,18 +13526,17 @@ let rec (universe_of_aux : FStarC_TypeChecker_Env.missing_decl = (env2.FStarC_TypeChecker_Env.missing_decl) } in - ((let uu___5 = - FStarC_Compiler_Effect.op_Bang dbg_UniverseOf in + ((let uu___5 = FStarC_Effect.op_Bang dbg_UniverseOf in if uu___5 then let uu___6 = let uu___7 = FStarC_TypeChecker_Env.get_range env3 in - FStarC_Compiler_Range_Ops.string_of_range uu___7 in + FStarC_Range_Ops.string_of_range uu___7 in let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term hd2 in - FStarC_Compiler_Util.print2 - "%s: About to type-check %s\n" uu___6 uu___7 + FStarC_Util.print2 "%s: About to type-check %s\n" + uu___6 uu___7 else ()); (let uu___5 = tc_term env3 hd2 in match uu___5 with @@ -13633,13 +13588,12 @@ let (universe_of : fun e -> FStarC_Errors.with_ctx "While attempting to compute a universe level" (fun uu___ -> - (let uu___2 = FStarC_Compiler_Debug.high () in + (let uu___2 = FStarC_Debug.high () in if uu___2 then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print1 - "Calling universe_of_aux with %s {\n" uu___3 + FStarC_Util.print1 "Calling universe_of_aux with %s {\n" uu___3 else ()); FStarC_Defensive.def_check_scoped FStarC_TypeChecker_Env.hasBinders_env @@ -13647,13 +13601,13 @@ let (universe_of : FStarC_Syntax_Print.pretty_term e.FStarC_Syntax_Syntax.pos "universe_of entry" env e; (let r = universe_of_aux env e in - (let uu___4 = FStarC_Compiler_Debug.high () in + (let uu___4 = FStarC_Debug.high () in if uu___4 then let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term r in - FStarC_Compiler_Util.print1 - "Got result from universe_of_aux = %s }\n" uu___5 + FStarC_Util.print1 "Got result from universe_of_aux = %s }\n" + uu___5 else ()); level_of_type env e r)) let (tc_tparams : @@ -13743,7 +13697,7 @@ let rec (__typeof_tot_or_gtot_term_fastpath : FStar_Pervasives_Native.Some FStarC_Syntax_Syntax.mk_GTotal else FStar_Pervasives_Native.None) in - FStarC_Compiler_Util.bind_opt mk_comp + FStarC_Util.bind_opt mk_comp (fun f -> let tbody1 = match tbody with @@ -13757,9 +13711,9 @@ let rec (__typeof_tot_or_gtot_term_fastpath : FStarC_TypeChecker_Env.push_binders env bs1 in __typeof_tot_or_gtot_term_fastpath uu___3 body1 false in - FStarC_Compiler_Util.map_opt uu___2 + FStarC_Util.map_opt uu___2 (FStarC_Syntax_Subst.close bs1)) in - FStarC_Compiler_Util.bind_opt tbody1 + FStarC_Util.bind_opt tbody1 (fun tbody2 -> let uu___1 = FStarC_Syntax_Subst.open_term bs tbody2 in match uu___1 with @@ -13795,7 +13749,7 @@ let rec (__typeof_tot_or_gtot_term_fastpath : | (unary_op, uu___4) -> let head = let uu___5 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges unary_op.FStarC_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a).FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk @@ -13829,7 +13783,7 @@ let rec (__typeof_tot_or_gtot_term_fastpath : | (unary_op, uu___4) -> let head = let uu___5 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges unary_op.FStarC_Syntax_Syntax.pos (FStar_Pervasives_Native.fst a1).FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk @@ -13873,21 +13827,21 @@ let rec (__typeof_tot_or_gtot_term_fastpath : FStarC_Syntax_Syntax.args = args;_} -> let t_hd = __typeof_tot_or_gtot_term_fastpath env hd must_tot in - FStarC_Compiler_Util.bind_opt t_hd + FStarC_Util.bind_opt t_hd (fun t_hd1 -> let uu___ = apply_well_typed env t_hd1 args in - FStarC_Compiler_Util.bind_opt uu___ + FStarC_Util.bind_opt uu___ (fun t2 -> let uu___1 = (effect_ok t2) || - (FStarC_Compiler_List.for_all + (FStarC_List.for_all (fun uu___2 -> match uu___2 with | (a, uu___3) -> let uu___4 = __typeof_tot_or_gtot_term_fastpath env a must_tot in - FStarC_Compiler_Util.is_some uu___4) args) in + FStarC_Util.is_some uu___4) args) in if uu___1 then FStar_Pervasives_Native.Some t2 else FStar_Pervasives_Native.None)) @@ -13911,8 +13865,8 @@ let rec (__typeof_tot_or_gtot_term_fastpath : let uu___4 = ((Prims.op_Negation must_tot) || (let uu___5 = - FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + let uu___6 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Env.norm_eff_name env uu___6 in FStarC_Ident.lid_equals FStarC_Parser_Const.effect_PURE_lid uu___5)) || (FStarC_TypeChecker_Normalize.non_info_norm env k) in @@ -13945,19 +13899,19 @@ let rec (__typeof_tot_or_gtot_term_fastpath : { FStarC_Syntax_Syntax.lbs = (false, lb::[]); FStarC_Syntax_Syntax.body1 = body;_} -> - let x = FStarC_Compiler_Util.left lb.FStarC_Syntax_Syntax.lbname in + let x = FStarC_Util.left lb.FStarC_Syntax_Syntax.lbname in let uu___ = let uu___1 = let uu___2 = FStarC_Syntax_Syntax.mk_binder x in [uu___2] in FStarC_Syntax_Subst.open_term uu___1 body in (match uu___ with | (xb, body1) -> - let xbinder = FStarC_Compiler_List.hd xb in + let xbinder = FStarC_List.hd xb in let x1 = xbinder.FStarC_Syntax_Syntax.binder_bv in let env_x = FStarC_TypeChecker_Env.push_bv env x1 in let t2 = __typeof_tot_or_gtot_term_fastpath env_x body1 must_tot in - FStarC_Compiler_Util.bind_opt t2 + FStarC_Util.bind_opt t2 (fun t3 -> let t4 = FStarC_Syntax_Subst.close xb t3 in FStar_Pervasives_Native.Some t4)) @@ -14059,24 +14013,23 @@ let rec (effectof_tot_or_gtot_term_fastpath : then FStar_Pervasives_Native.Some ghost else FStar_Pervasives_Native.None)) in let uu___1 = effectof_tot_or_gtot_term_fastpath env hd in - FStarC_Compiler_Util.bind_opt uu___1 + FStarC_Util.bind_opt uu___1 (fun eff_hd -> let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun eff_opt -> fun arg -> - FStarC_Compiler_Util.bind_opt eff_opt + FStarC_Util.bind_opt eff_opt (fun eff -> let uu___3 = effectof_tot_or_gtot_term_fastpath env (FStar_Pervasives_Native.fst arg) in - FStarC_Compiler_Util.bind_opt uu___3 - (join_effects eff))) + FStarC_Util.bind_opt uu___3 (join_effects eff))) (FStar_Pervasives_Native.Some eff_hd) args in - FStarC_Compiler_Util.bind_opt uu___2 + FStarC_Util.bind_opt uu___2 (fun eff_hd_and_args -> let uu___3 = typeof_tot_or_gtot_term_fastpath env hd true in - FStarC_Compiler_Util.bind_opt uu___3 + FStarC_Util.bind_opt uu___3 (fun t_hd -> let rec maybe_arrow t1 = let t2 = @@ -14103,8 +14056,8 @@ let rec (effectof_tot_or_gtot_term_fastpath : -> let eff_app = if - (FStarC_Compiler_List.length args) < - (FStarC_Compiler_List.length bs) + (FStarC_List.length args) < + (FStarC_List.length bs) then FStarC_Parser_Const.effect_PURE_lid else FStarC_Syntax_Util.comp_effect_name c in join_effects eff_hd_and_args eff_app @@ -14122,8 +14075,8 @@ let rec (effectof_tot_or_gtot_term_fastpath : FStarC_Syntax_Syntax.eff_opt = uu___4;_} -> let c_eff = - FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + let uu___5 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Env.norm_eff_name env uu___5 in let uu___5 = (FStarC_Ident.lid_equals c_eff FStarC_Parser_Const.effect_PURE_lid) diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_TermEqAndSimplify.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TermEqAndSimplify.ml similarity index 96% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_TermEqAndSimplify.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TermEqAndSimplify.ml index 4043bea458a..4b17daaebae 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_TermEqAndSimplify.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_TermEqAndSimplify.ml @@ -62,18 +62,18 @@ let rec (eq_tm : let uu___ = FStarC_Syntax_Syntax.fv_eq f1 f2 in if uu___ then - let n1 = FStarC_Compiler_List.length args1 in - let n2 = FStarC_Compiler_List.length args2 in + let n1 = FStarC_List.length args1 in + let n2 = FStarC_List.length args2 in (if (n1 = n2) && (n_parms <= n1) then - let uu___1 = FStarC_Compiler_List.splitAt n_parms args1 in + let uu___1 = FStarC_List.splitAt n_parms args1 in match uu___1 with | (parms1, args11) -> - let uu___2 = FStarC_Compiler_List.splitAt n_parms args2 in + let uu___2 = FStarC_List.splitAt n_parms args2 in (match uu___2 with | (parms2, args21) -> let eq_arg_list as1 as2 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun acc -> fun uu___3 -> fun uu___4 -> @@ -147,8 +147,7 @@ let rec (eq_tm : FStar_Pervasives_Native.uu___is_Some heads_and_args_in_case_both_data -> - let uu___1 = - FStarC_Compiler_Util.must heads_and_args_in_case_both_data in + let uu___1 = FStarC_Util.must heads_and_args_in_case_both_data in (match uu___1 with | (f, args1, g, args2, n) -> equal_data f args1 g args2 n) | (FStarC_Syntax_Syntax.Tm_fvar f, FStarC_Syntax_Syntax.Tm_fvar g) -> @@ -198,7 +197,7 @@ let rec (eq_tm : (let uu___1 = let uu___2 = FStarC_Syntax_Syntax.lid_of_fv f1 in FStarC_Ident.string_of_lid uu___2 in - FStarC_Compiler_List.mem uu___1 injectives) + FStarC_List.mem uu___1 injectives) -> equal_data f1 args1 f2 args2 Prims.int_zero | uu___1 -> let uu___2 = eq_tm env h1 h2 in @@ -214,13 +213,11 @@ let rec (eq_tm : FStarC_Syntax_Syntax.brs = bs2; FStarC_Syntax_Syntax.rc_opt1 = uu___3;_}) -> - if - (FStarC_Compiler_List.length bs1) = - (FStarC_Compiler_List.length bs2) + if (FStarC_List.length bs1) = (FStarC_List.length bs2) then - let uu___4 = FStarC_Compiler_List.zip bs1 bs2 in + let uu___4 = FStarC_List.zip bs1 bs2 in let uu___5 = eq_tm env t13 t23 in - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun uu___6 -> fun a -> match uu___6 with @@ -249,12 +246,9 @@ let rec (eq_tm : { FStarC_Syntax_Syntax.bs = bs2; FStarC_Syntax_Syntax.body = body2; FStarC_Syntax_Syntax.rc_opt = uu___1;_}) - when - (FStarC_Compiler_List.length bs1) = - (FStarC_Compiler_List.length bs2) - -> + when (FStarC_List.length bs1) = (FStarC_List.length bs2) -> let uu___2 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun r -> fun b1 -> fun b2 -> @@ -271,12 +265,9 @@ let rec (eq_tm : FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = bs2; FStarC_Syntax_Syntax.comp = c2;_}) - when - (FStarC_Compiler_List.length bs1) = - (FStarC_Compiler_List.length bs2) - -> + when (FStarC_List.length bs1) = (FStarC_List.length bs2) -> let uu___ = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun r -> fun b1 -> fun b2 -> @@ -454,8 +445,7 @@ let (simplify : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 - uu___2) + FStarC_Util.print2 "WPE> is_applied %s -- %s\n" uu___1 uu___2) else (); (let uu___1 = FStarC_Syntax_Util.head_and_args_full t in match uu___1 with @@ -477,7 +467,7 @@ let (simplify : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term hd in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "WPE> got it\n>>>>top = %s\n>>>>b = %s\n>>>>hd = %s\n" uu___4 uu___5 uu___6) else (); @@ -490,8 +480,8 @@ let (simplify : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___2 = FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t in - FStarC_Compiler_Util.print2 - "WPE> is_applied_maybe_squashed %s -- %s\n" uu___1 uu___2) + FStarC_Util.print2 "WPE> is_applied_maybe_squashed %s -- %s\n" + uu___1 uu___2) else (); (let uu___1 = FStarC_Syntax_Util.is_squash t in match uu___1 with @@ -523,7 +513,7 @@ let (simplify : FStar_Pervasives_Native.None | FStar_Pervasives_Native.Some b -> let uu___8 = - FStarC_Compiler_List.for_all + FStarC_List.for_all (fun uu___9 -> match uu___9 with | (uu___10, uu___11, e') -> @@ -553,8 +543,7 @@ let (simplify : let uu___ = FStarC_Syntax_Util.head_and_args t in match uu___ with | (head, args) -> - let args1 = - FStarC_Compiler_List.map maybe_un_auto_squash_arg args in + let args1 = FStarC_List.map maybe_un_auto_squash_arg args in FStarC_Syntax_Syntax.mk_Tm_app head args1 t.FStarC_Syntax_Syntax.pos in let rec clearly_inhabited ty = @@ -566,7 +555,9 @@ let (simplify : | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = uu___1; FStarC_Syntax_Syntax.comp = c;_} - -> clearly_inhabited (FStarC_Syntax_Util.comp_result c) + -> + let uu___2 = FStarC_Syntax_Util.comp_result c in + clearly_inhabited uu___2 | FStarC_Syntax_Syntax.Tm_fvar fv -> let l = FStarC_Syntax_Syntax.lid_of_fv fv in (((FStarC_Ident.lid_equals l FStarC_Parser_Const.int_lid) || @@ -610,7 +601,7 @@ let (simplify : FStarC_Parser_Const.and_lid in if uu___10 then - let uu___11 = FStarC_Compiler_List.map simplify1 args in + let uu___11 = FStarC_List.map simplify1 args in match uu___11 with | (FStar_Pervasives_Native.Some (true), uu___12)::(uu___13, (arg, @@ -630,7 +621,7 @@ let (simplify : FStarC_Parser_Const.or_lid in if uu___12 then - let uu___13 = FStarC_Compiler_List.map simplify1 args in + let uu___13 = FStarC_List.map simplify1 args in match uu___13 with | (FStar_Pervasives_Native.Some (true), uu___14)::uu___15::[] -> w FStarC_Syntax_Util.t_true @@ -649,7 +640,7 @@ let (simplify : FStarC_Parser_Const.imp_lid in if uu___14 then - let uu___15 = FStarC_Compiler_List.map simplify1 args in + let uu___15 = FStarC_List.map simplify1 args in match uu___15 with | uu___16::(FStar_Pervasives_Native.Some (true), uu___17)::[] @@ -672,8 +663,7 @@ let (simplify : FStarC_Parser_Const.iff_lid in if uu___16 then - let uu___17 = - FStarC_Compiler_List.map simplify1 args in + let uu___17 = FStarC_List.map simplify1 args in match uu___17 with | (FStar_Pervasives_Native.Some (true), uu___18):: (FStar_Pervasives_Native.Some (true), uu___19)::[] @@ -715,8 +705,7 @@ let (simplify : FStarC_Parser_Const.not_lid in if uu___18 then - let uu___19 = - FStarC_Compiler_List.map simplify1 args in + let uu___19 = FStarC_List.map simplify1 args in match uu___19 with | (FStar_Pervasives_Native.Some (true), uu___20)::[] -> w FStarC_Syntax_Util.t_false @@ -896,19 +885,19 @@ let (simplify : match uu___27 with | FStarC_Syntax_Syntax.Tm_fvar fv1 when - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun l -> FStarC_Syntax_Syntax.fv_eq_lid fv1 l) haseq_lids -> true | uu___28 -> false in (if - (FStarC_Compiler_List.length args) - = Prims.int_one + (FStarC_List.length args) = + Prims.int_one then let t = let uu___27 = - FStarC_Compiler_List.hd args in + FStarC_List.hd args in FStar_Pervasives_Native.fst uu___27 in let uu___27 = t_has_eq_for_sure t in @@ -1011,7 +1000,7 @@ let (simplify : FStarC_Parser_Const.and_lid in if uu___6 then - let uu___7 = FStarC_Compiler_List.map simplify1 args in + let uu___7 = FStarC_List.map simplify1 args in match uu___7 with | (FStar_Pervasives_Native.Some (true), uu___8)::(uu___9, (arg, @@ -1031,7 +1020,7 @@ let (simplify : FStarC_Parser_Const.or_lid in if uu___8 then - let uu___9 = FStarC_Compiler_List.map simplify1 args in + let uu___9 = FStarC_List.map simplify1 args in match uu___9 with | (FStar_Pervasives_Native.Some (true), uu___10)::uu___11::[] -> w FStarC_Syntax_Util.t_true @@ -1050,7 +1039,7 @@ let (simplify : FStarC_Parser_Const.imp_lid in if uu___10 then - let uu___11 = FStarC_Compiler_List.map simplify1 args in + let uu___11 = FStarC_List.map simplify1 args in match uu___11 with | uu___12::(FStar_Pervasives_Native.Some (true), uu___13)::[] @@ -1073,8 +1062,7 @@ let (simplify : FStarC_Parser_Const.iff_lid in if uu___12 then - let uu___13 = - FStarC_Compiler_List.map simplify1 args in + let uu___13 = FStarC_List.map simplify1 args in match uu___13 with | (FStar_Pervasives_Native.Some (true), uu___14):: (FStar_Pervasives_Native.Some (true), uu___15)::[] @@ -1116,8 +1104,7 @@ let (simplify : FStarC_Parser_Const.not_lid in if uu___14 then - let uu___15 = - FStarC_Compiler_List.map simplify1 args in + let uu___15 = FStarC_List.map simplify1 args in match uu___15 with | (FStar_Pervasives_Native.Some (true), uu___16)::[] -> w FStarC_Syntax_Util.t_false @@ -1297,19 +1284,19 @@ let (simplify : match uu___23 with | FStarC_Syntax_Syntax.Tm_fvar fv1 when - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun l -> FStarC_Syntax_Syntax.fv_eq_lid fv1 l) haseq_lids -> true | uu___24 -> false in (if - (FStarC_Compiler_List.length args) - = Prims.int_one + (FStarC_List.length args) = + Prims.int_one then let t = let uu___23 = - FStarC_Compiler_List.hd args in + FStarC_List.hd args in FStar_Pervasives_Native.fst uu___23 in let uu___23 = t_has_eq_for_sure t in diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Util.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Util.ml similarity index 92% rename from stage0/fstar-lib/generated/FStarC_TypeChecker_Util.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Util.ml index 54999681fbf..4345b9dc56c 100644 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Util.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_TypeChecker_Util.ml @@ -2,39 +2,35 @@ open Prims type lcomp_with_binder = (FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option * FStarC_TypeChecker_Common.lcomp) -let (dbg_bind : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Bind" -let (dbg_Coercions : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Coercions" -let (dbg_Dec : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Dec" -let (dbg_Extraction : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Extraction" -let (dbg_LayeredEffects : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LayeredEffects" -let (dbg_LayeredEffectsApp : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "LayeredEffectsApp" -let (dbg_Pat : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Pat" -let (dbg_Rel : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Rel" -let (dbg_ResolveImplicitsHook : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "ResolveImplicitsHook" -let (dbg_Return : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Return" -let (dbg_Simplification : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Simplification" -let (dbg_SMTEncodingReify : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "SMTEncodingReify" +let (dbg_bind : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Bind" +let (dbg_Coercions : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Coercions" +let (dbg_Dec : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Dec" +let (dbg_Extraction : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Extraction" +let (dbg_LayeredEffects : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LayeredEffects" +let (dbg_LayeredEffectsApp : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "LayeredEffectsApp" +let (dbg_Pat : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Pat" +let (dbg_Rel : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Rel" +let (dbg_ResolveImplicitsHook : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "ResolveImplicitsHook" +let (dbg_Return : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Return" +let (dbg_Simplification : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "Simplification" +let (dbg_SMTEncodingReify : Prims.bool FStarC_Effect.ref) = + FStarC_Debug.get_toggle "SMTEncodingReify" let (new_implicit_var : Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.typ -> Prims.bool -> (FStarC_Syntax_Syntax.term * (FStarC_Syntax_Syntax.ctx_uvar * - FStarC_Compiler_Range_Type.range) * - FStarC_TypeChecker_Env.guard_t)) + FStarC_Range_Type.range) * FStarC_TypeChecker_Env.guard_t)) = fun reason -> fun r -> @@ -60,9 +56,9 @@ let (close_guard_implicits : let uu___1 = let uu___2 = FStarC_Class_Listlike.to_list - (FStarC_Compiler_CList.listlike_clist ()) + (FStarC_CList.listlike_clist ()) g.FStarC_TypeChecker_Common.deferred in - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___3 -> match uu___3 with | (uu___4, uu___5, p) -> @@ -70,36 +66,33 @@ let (close_guard_implicits : uu___2 in match uu___1 with | (solve_now, defer) -> - ((let uu___3 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___3 = FStarC_Effect.op_Bang dbg_Rel in if uu___3 then - (FStarC_Compiler_Util.print_string - "SOLVE BEFORE CLOSING:\n"; - FStarC_Compiler_List.iter + (FStarC_Util.print_string "SOLVE BEFORE CLOSING:\n"; + FStarC_List.iter (fun uu___6 -> match uu___6 with | (uu___7, s, p) -> let uu___8 = FStarC_TypeChecker_Rel.prob_to_string env p in - FStarC_Compiler_Util.print2 "%s: %s\n" s uu___8) + FStarC_Util.print2 "%s: %s\n" s uu___8) solve_now; - FStarC_Compiler_Util.print_string - " ...DEFERRED THE REST:\n"; - FStarC_Compiler_List.iter + FStarC_Util.print_string " ...DEFERRED THE REST:\n"; + FStarC_List.iter (fun uu___8 -> match uu___8 with | (uu___9, s, p) -> let uu___10 = FStarC_TypeChecker_Rel.prob_to_string env p in - FStarC_Compiler_Util.print2 "%s: %s\n" s - uu___10) defer; - FStarC_Compiler_Util.print_string "END\n") + FStarC_Util.print2 "%s: %s\n" s uu___10) defer; + FStarC_Util.print_string "END\n") else ()); (let g1 = let uu___3 = let uu___4 = FStarC_Class_Listlike.from_list - (FStarC_Compiler_CList.listlike_clist ()) solve_now in + (FStarC_CList.listlike_clist ()) solve_now in { FStarC_TypeChecker_Common.guard_f = (g.FStarC_TypeChecker_Common.guard_f); @@ -116,7 +109,7 @@ let (close_guard_implicits : let g2 = let uu___3 = FStarC_Class_Listlike.from_list - (FStarC_Compiler_CList.listlike_clist ()) defer in + (FStarC_CList.listlike_clist ()) defer in { FStarC_TypeChecker_Common.guard_f = (g1.FStarC_TypeChecker_Common.guard_f); @@ -131,7 +124,7 @@ let (close_guard_implicits : g2)) else g let (check_uvars : - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.typ -> unit) = + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.typ -> unit) = fun r -> fun t -> let uvs = FStarC_Syntax_Free.uvars t in @@ -139,7 +132,7 @@ let (check_uvars : let uu___1 = FStarC_Class_Setlike.is_empty () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Free.ord_ctx_uvar)) (Obj.magic uvs) in Prims.op_Negation uu___1 in if uu___ @@ -152,12 +145,11 @@ let (check_uvars : (let uu___5 = let uu___6 = FStarC_Class_Show.show - (FStarC_Compiler_FlatSet.showable_set - FStarC_Syntax_Free.ord_ctx_uvar + (FStarC_FlatSet.showable_set FStarC_Syntax_Free.ord_ctx_uvar FStarC_Syntax_Print.showable_ctxu) uvs in let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Unconstrained unification variables %s in type signature %s; please add an annotation" uu___6 uu___7 in FStarC_Errors.log_issue FStarC_Class_HasRange.hasRange_range r @@ -189,7 +181,7 @@ let (extract_let_rec_annotation : | (u_subst, univ_vars1) -> let e1 = FStarC_Syntax_Subst.subst u_subst e in let t2 = FStarC_Syntax_Subst.subst u_subst t1 in - ((let uu___6 = FStarC_Compiler_Effect.op_Bang dbg_Dec in + ((let uu___6 = FStarC_Effect.op_Bang dbg_Dec in if uu___6 then let uu___7 = @@ -198,7 +190,7 @@ let (extract_let_rec_annotation : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "extract_let_rec_annotation lbdef=%s; lbtyp=%s\n" uu___7 uu___8 else ()); @@ -228,12 +220,12 @@ let (extract_let_rec_annotation : let reconcile_let_rec_ascription_and_body_type tarr lbtyp_opt = let get_decreases c = - FStarC_Compiler_Util.prefix_until - (fun uu___6 -> - match uu___6 with - | FStarC_Syntax_Syntax.DECREASES uu___7 -> true - | uu___7 -> false) - (FStarC_Syntax_Util.comp_flags c) in + let uu___6 = FStarC_Syntax_Util.comp_flags c in + FStarC_Util.prefix_until + (fun uu___7 -> + match uu___7 with + | FStarC_Syntax_Syntax.DECREASES uu___8 -> true + | uu___8 -> false) uu___6 in let fallback uu___6 = let uu___7 = FStarC_Syntax_Util.arrow_formals_comp tarr in match uu___7 with @@ -244,7 +236,7 @@ let (extract_let_rec_annotation : (pfx, FStarC_Syntax_Syntax.DECREASES d, sfx) -> let c1 = FStarC_TypeChecker_Env.comp_set_flags env1 c - (FStarC_Compiler_List.op_At pfx sfx) in + (FStarC_List.op_At pfx sfx) in let uu___9 = FStarC_Syntax_Util.arrow bs c1 in (uu___9, tarr, true) | uu___9 -> (tarr, tarr, true)) in @@ -254,14 +246,13 @@ let (extract_let_rec_annotation : let uu___6 = un_arrow tarr in (match uu___6 with | (bs, c) -> - let n_bs = FStarC_Compiler_List.length bs in + let n_bs = FStarC_List.length bs in let uu___7 = FStarC_TypeChecker_Normalize.get_n_binders env1 n_bs annot in (match uu___7 with | (bs', c') -> - (if - (FStarC_Compiler_List.length bs') <> n_bs + (if (FStarC_List.length bs') <> n_bs then (let uu___9 = let uu___10 = @@ -339,16 +330,16 @@ let (extract_let_rec_annotation : FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___11)); move_decreases d - (FStarC_Compiler_List.op_At pfx sfx) - (FStarC_Compiler_List.op_At pfx' - sfx')) + (FStarC_List.op_At pfx sfx) + (FStarC_List.op_At pfx' sfx')) | (FStar_Pervasives_Native.Some (pfx, FStarC_Syntax_Syntax.DECREASES d, sfx), FStar_Pervasives_Native.None) -> + let uu___10 = + FStarC_Syntax_Util.comp_flags c' in move_decreases d - (FStarC_Compiler_List.op_At pfx sfx) - (FStarC_Syntax_Util.comp_flags c') + (FStarC_List.op_At pfx sfx) uu___10 | uu___10 -> failwith "Impossible")))) in let extract_annot_from_body lbtyp_opt = let rec aux_lbdef e2 = @@ -386,8 +377,9 @@ let (extract_let_rec_annotation : if uu___6 then let uu___7 = + let uu___8 = FStarC_Syntax_Util.comp_result c in reconcile_let_rec_ascription_and_body_type - (FStarC_Syntax_Util.comp_result c) lbtyp_opt in + uu___8 lbtyp_opt in (match uu___7 with | (t3, lbtyp, recheck) -> let e4 = @@ -581,17 +573,15 @@ let (extract_let_rec_annotation : tarr lbtyp_opt in (match uu___8 with | (tarr1, lbtyp, recheck) -> - let n_bs = - FStarC_Compiler_List.length bs in + let n_bs = FStarC_List.length bs in let uu___9 = FStarC_TypeChecker_Normalize.get_n_binders env1 n_bs tarr1 in (match uu___9 with | (bs', c1) -> if - (FStarC_Compiler_List.length - bs') - <> n_bs + (FStarC_List.length bs') <> + n_bs then failwith "Impossible" else (let subst = @@ -683,10 +673,11 @@ let (extract_let_rec_annotation : let uu___9 = let uu___10 = let uu___11 = + let uu___12 = + FStarC_Syntax_Util.comp_effect_name c in FStarC_TypeChecker_Env.lookup_effect_quals - env1 - (FStarC_Syntax_Util.comp_effect_name c) in - FStarC_Compiler_List.contains + env1 uu___12 in + FStarC_List.contains FStarC_Syntax_Syntax.TotalEffect uu___11 in Prims.op_Negation uu___10 in if uu___9 @@ -721,11 +712,11 @@ let rec (decorated_pattern_as_term : let uu___ = mk (FStarC_Syntax_Syntax.Tm_name x) in ([x], uu___) | FStarC_Syntax_Syntax.Pat_cons (fv, us_opt, pats) -> let uu___ = - let uu___1 = FStarC_Compiler_List.map pat_as_arg pats in - FStarC_Compiler_List.unzip uu___1 in + let uu___1 = FStarC_List.map pat_as_arg pats in + FStarC_List.unzip uu___1 in (match uu___ with | (vars, args) -> - let vars1 = FStarC_Compiler_List.flatten vars in + let vars1 = FStarC_List.flatten vars in let head = FStarC_Syntax_Syntax.fv_to_tm fv in let head1 = match us_opt with @@ -804,8 +795,7 @@ let (mk_comp : let (effect_args_from_repr : FStarC_Syntax_Syntax.term -> Prims.bool -> - FStarC_Compiler_Range_Type.range -> - FStarC_Syntax_Syntax.term Prims.list) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.term Prims.list) = fun repr -> fun is_layered -> @@ -837,7 +827,7 @@ let (effect_args_from_repr : | FStarC_Syntax_Syntax.Tm_app { FStarC_Syntax_Syntax.hd = uu___; FStarC_Syntax_Syntax.args = uu___1::is;_} - -> FStarC_Compiler_List.map FStar_Pervasives_Native.fst is + -> FStarC_List.map FStar_Pervasives_Native.fst is | uu___ -> err () else (match repr1.FStarC_Syntax_Syntax.n with @@ -848,7 +838,7 @@ let (effect_args_from_repr : let uu___2 = FStarC_Syntax_Util.comp_eff_name_res_and_args c in (match uu___2 with | (uu___3, uu___4, args) -> - FStarC_Compiler_List.map FStar_Pervasives_Native.fst args) + FStarC_List.map FStar_Pervasives_Native.fst args) | uu___1 -> err ()) let (mk_wp_return : FStarC_TypeChecker_Env.env -> @@ -856,7 +846,7 @@ let (mk_wp_return : FStarC_Syntax_Syntax.universe -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.comp) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.comp) = fun env -> fun ed -> @@ -898,23 +888,23 @@ let (mk_wp_return : FStarC_Syntax_Syntax.mk_Tm_app uu___6 uu___7 e.FStarC_Syntax_Syntax.pos) in mk_comp ed u_a a wp [FStarC_Syntax_Syntax.RETURN])) in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Return in + (let uu___1 = FStarC_Effect.op_Bang dbg_Return in if uu___1 then let uu___2 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range e.FStarC_Syntax_Syntax.pos in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in let uu___4 = FStarC_TypeChecker_Normalize.comp_to_string env c in - FStarC_Compiler_Util.print3 - "(%s) returning %s at comp type %s\n" uu___2 uu___3 uu___4 + FStarC_Util.print3 "(%s) returning %s at comp type %s\n" + uu___2 uu___3 uu___4 else ()); c let (label : FStarC_Pprint.document Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ) = fun reason -> @@ -931,7 +921,7 @@ let (label_opt : FStarC_TypeChecker_Env.env -> (unit -> FStarC_Pprint.document Prims.list) FStar_Pervasives_Native.option -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ) = fun env -> @@ -948,7 +938,7 @@ let (label_opt : then f else (let uu___2 = reason1 () in label uu___2 r f) let (label_guard : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Pprint.document Prims.list -> FStarC_TypeChecker_Env.guard_t -> FStarC_TypeChecker_Env.guard_t) = @@ -1105,8 +1095,9 @@ let (lift_comps_sep_guards : (let x_a = match b with | FStar_Pervasives_Native.None -> - FStarC_Syntax_Syntax.null_binder - (FStarC_Syntax_Util.comp_result c12) + let uu___4 = + FStarC_Syntax_Util.comp_result c12 in + FStarC_Syntax_Syntax.null_binder uu___4 | FStar_Pervasives_Native.Some x -> FStarC_Syntax_Syntax.mk_binder x in let env_x = @@ -1231,8 +1222,8 @@ let (close_wp_comp : let close_wp u_res md res_t bvs1 wp0 = let close = let uu___5 = FStarC_Syntax_Util.get_wp_close_combinator md in - FStarC_Compiler_Util.must uu___5 in - FStarC_Compiler_List.fold_right + FStarC_Util.must uu___5 in + FStarC_List.fold_right (fun x -> fun wp -> let bs = @@ -1246,12 +1237,14 @@ let (close_wp_comp : [uu___6] in u_res :: uu___5 in let wp1 = - FStarC_Syntax_Util.abs bs wp - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.mk_residual_comp - FStarC_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None - [FStarC_Syntax_Syntax.TOTAL])) in + let uu___5 = + let uu___6 = + FStarC_Syntax_Util.mk_residual_comp + FStarC_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None + [FStarC_Syntax_Syntax.TOTAL] in + FStar_Pervasives_Native.Some uu___6 in + FStarC_Syntax_Util.abs bs wp uu___5 in let uu___5 = FStarC_TypeChecker_Env.inst_effect_fun_with us env md close in @@ -1277,7 +1270,7 @@ let (close_wp_comp : c1.FStarC_Syntax_Syntax.effect_name in let wp1 = close_wp u_res_t md res_t bvs wp in let uu___6 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___7 -> match uu___7 with | FStarC_Syntax_Syntax.MLEFFECT -> true @@ -1293,7 +1286,7 @@ let (close_wp_lcomp : fun env -> fun bvs -> fun lc -> - let bs = FStarC_Compiler_List.map FStarC_Syntax_Syntax.mk_binder bvs in + let bs = FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs in FStarC_TypeChecker_Common.apply_lcomp (close_wp_comp env bvs) (fun g -> let uu___ = FStarC_TypeChecker_Env.close_guard env bs g in @@ -1305,7 +1298,7 @@ let (substitutive_indexed_close_substs : FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.args -> Prims.int -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.subst_elt Prims.list) = fun env -> @@ -1315,8 +1308,7 @@ let (substitutive_indexed_close_substs : fun ct_args -> fun num_effect_params -> fun r -> - let debug = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = close_bs in match uu___1 with @@ -1331,18 +1323,16 @@ let (substitutive_indexed_close_substs : | (close_bs1, subst) -> let uu___1 = let uu___2 = - FStarC_Compiler_List.splitAt num_effect_params - close_bs1 in + FStarC_List.splitAt num_effect_params close_bs1 in match uu___2 with | (eff_params_bs, close_bs2) -> let uu___3 = - FStarC_Compiler_List.splitAt num_effect_params - ct_args in + FStarC_List.splitAt num_effect_params ct_args in (match uu___3 with | (ct_eff_params_args, ct_args1) -> let uu___4 = let uu___5 = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun uu___6 -> match uu___6 with @@ -1351,17 +1341,17 @@ let (substitutive_indexed_close_substs : ((b.FStarC_Syntax_Syntax.binder_bv), arg)) eff_params_bs ct_eff_params_args in - FStarC_Compiler_List.op_At subst uu___5 in + FStarC_List.op_At subst uu___5 in (close_bs2, uu___4, ct_args1)) in (match uu___1 with | (close_bs2, subst1, ct_args1) -> let uu___2 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length close_bs2) - - Prims.int_one) close_bs2 in + FStarC_List.splitAt + ((FStarC_List.length close_bs2) - Prims.int_one) + close_bs2 in (match uu___2 with | (close_bs3, uu___3) -> - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun ss -> fun b -> fun uu___4 -> @@ -1383,9 +1373,8 @@ let (substitutive_indexed_close_substs : uu___9) in FStarC_Syntax_Syntax.NT uu___8 in [uu___7] in - FStarC_Compiler_List.op_At ss - uu___6) subst1 close_bs3 - ct_args1)) + FStarC_List.op_At ss uu___6) + subst1 close_bs3 ct_args1)) let (close_layered_comp_with_combinator : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.bv Prims.list -> @@ -1411,13 +1400,12 @@ let (close_layered_comp_with_combinator : "mk_indexed_close called with a non-indexed effect") in let close_ts = let uu___ = FStarC_Syntax_Util.get_layered_close_combinator ed in - FStarC_Compiler_Util.must uu___ in + FStarC_Util.must uu___ in let effect_args = - FStarC_Compiler_List.fold_right + FStarC_List.fold_right (fun x -> fun args -> - let u_a = - FStarC_Compiler_List.hd ct.FStarC_Syntax_Syntax.comp_univs in + let u_a = FStarC_List.hd ct.FStarC_Syntax_Syntax.comp_univs in let u_b = env.FStarC_TypeChecker_Env.universe_of env_bvs x.FStarC_Syntax_Syntax.sort in @@ -1473,7 +1461,7 @@ let (close_layered_lcomp_with_combinator : fun env -> fun bvs -> fun lc -> - let bs = FStarC_Compiler_List.map FStarC_Syntax_Syntax.mk_binder bvs in + let bs = FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs in FStarC_TypeChecker_Common.apply_lcomp (close_layered_comp_with_combinator env bvs) (fun g -> @@ -1489,10 +1477,9 @@ let (close_layered_lcomp_with_substitutions : fun bvs -> fun tms -> fun lc -> - let bs = - FStarC_Compiler_List.map FStarC_Syntax_Syntax.mk_binder bvs in + let bs = FStarC_List.map FStarC_Syntax_Syntax.mk_binder bvs in let substs = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun bv -> fun tm -> FStarC_Syntax_Syntax.NT (bv, tm)) bvs tms in FStarC_TypeChecker_Common.apply_lcomp (FStarC_Syntax_Subst.subst_comp substs) @@ -1501,7 +1488,7 @@ let (close_layered_lcomp_with_substitutions : close_guard_implicits env false bs uu___) lc let (should_not_inline_lc : FStarC_TypeChecker_Common.lcomp -> Prims.bool) = fun lc -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.SHOULD_NOT_INLINE -> true @@ -1524,8 +1511,8 @@ let (should_return : if uu___ then let c_eff_name = - FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + let uu___1 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Env.norm_eff_name env uu___1 in let uu___1 = (FStarC_TypeChecker_Common.is_pure_or_ghost_lcomp lc) && (FStarC_Ident.lid_equals c_eff_name @@ -1538,8 +1525,8 @@ let (should_return : if uu___2 then let uu___3 = - FStarC_TypeChecker_Normalize.unfold_whnf env - (FStarC_Syntax_Util.comp_result c) in + let uu___4 = FStarC_Syntax_Util.comp_result c in + FStarC_TypeChecker_Normalize.unfold_whnf env uu___4 in FStarC_Syntax_Util.is_unit uu___3 else true) in match eopt with @@ -1573,7 +1560,7 @@ let (substitutive_indexed_bind_substs : FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.comp_typ -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.int -> Prims.bool -> (FStarC_Syntax_Syntax.subst_elt Prims.list * @@ -1592,8 +1579,7 @@ let (substitutive_indexed_bind_substs : fun num_effect_params -> fun has_range_binders -> let debug = - FStarC_Compiler_Effect.op_Bang - dbg_LayeredEffectsApp in + FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let bind_name uu___ = if debug then @@ -1612,8 +1598,8 @@ let (substitutive_indexed_bind_substs : FStarC_Ident.ident_of_lid p_ed.FStarC_Syntax_Syntax.mname in FStarC_Ident.string_of_id uu___4 in - FStarC_Compiler_Util.format3 "(%s, %s) |> %s" - uu___1 uu___2 uu___3 + FStarC_Util.format3 "(%s, %s) |> %s" uu___1 + uu___2 uu___3 else "" in let uu___ = let uu___1 = bs in @@ -1621,8 +1607,8 @@ let (substitutive_indexed_bind_substs : | a_b::b_b::bs1 -> let uu___2 = let uu___3 = - FStarC_Compiler_List.splitAt - (Prims.of_int (2)) binder_kinds in + FStarC_List.splitAt (Prims.of_int (2)) + binder_kinds in FStar_Pervasives_Native.snd uu___3 in (bs1, uu___2, [FStarC_Syntax_Syntax.NT @@ -1642,8 +1628,7 @@ let (substitutive_indexed_bind_substs : (ct2.FStarC_Syntax_Syntax.effect_args)) else (let split l = - FStarC_Compiler_List.splitAt - num_effect_params l in + FStarC_List.splitAt num_effect_params l in let uu___3 = split bs1 in match uu___3 with | (eff_params_bs, bs2) -> @@ -1661,7 +1646,7 @@ let (substitutive_indexed_bind_substs : (match uu___7 with | (param_args2, args2) -> let g = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g1 -> fun uu___8 -> fun uu___9 -> @@ -1688,7 +1673,7 @@ let (substitutive_indexed_bind_substs : param_args1 param_args2 in let param_subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b1 -> fun uu___8 -> match uu___8 @@ -1701,7 +1686,7 @@ let (substitutive_indexed_bind_substs : eff_params_bs param_args1 in (bs2, binder_kinds2, - (FStarC_Compiler_List.op_At + (FStarC_List.op_At subst param_subst), g, args1, args2))))) in (match uu___1 with @@ -1709,14 +1694,14 @@ let (substitutive_indexed_bind_substs : args2) -> let uu___2 = let m_num_effect_args = - FStarC_Compiler_List.length args1 in + FStarC_List.length args1 in let uu___3 = - FStarC_Compiler_List.splitAt - m_num_effect_args bs2 in + FStarC_List.splitAt m_num_effect_args + bs2 in match uu___3 with | (f_bs, bs3) -> let f_subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun f_b -> fun arg -> FStarC_Syntax_Syntax.NT @@ -1725,26 +1710,25 @@ let (substitutive_indexed_bind_substs : arg))) f_bs args1 in let uu___4 = let uu___5 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt m_num_effect_args binder_kinds2 in FStar_Pervasives_Native.snd uu___5 in (bs3, uu___4, - (FStarC_Compiler_List.op_At subst1 - f_subst)) in + (FStarC_List.op_At subst1 f_subst)) in (match uu___2 with | (bs3, binder_kinds3, subst2) -> let uu___3 = let n_num_effect_args = - FStarC_Compiler_List.length args2 in + FStarC_List.length args2 in let uu___4 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt n_num_effect_args bs3 in match uu___4 with | (g_bs, bs4) -> let g_bs_kinds = let uu___5 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt n_num_effect_args binder_kinds3 in FStar_Pervasives_Native.fst @@ -1759,9 +1743,9 @@ let (substitutive_indexed_bind_substs : x -> x in let uu___5 = let uu___6 = - FStarC_Compiler_List.zip - g_bs g_bs_kinds in - FStarC_Compiler_List.fold_left2 + FStarC_List.zip g_bs + g_bs_kinds in + FStarC_List.fold_left2 (fun uu___7 -> fun uu___8 -> fun arg -> @@ -1787,7 +1771,7 @@ let (substitutive_indexed_bind_substs : (FStar_Pervasives_Native.fst arg) FStar_Pervasives_Native.None in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ss [FStarC_Syntax_Syntax.NT ((g_b.FStarC_Syntax_Syntax.binder_bv), @@ -1818,9 +1802,9 @@ let (substitutive_indexed_bind_substs : () in let uu___13 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range r1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "implicit var for no abs g binder %s of %s at %s" uu___11 uu___12 @@ -1859,7 +1843,7 @@ let (substitutive_indexed_bind_substs : [g; g_uv; g_unif] in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ss [ FStarC_Syntax_Syntax.NT @@ -1880,21 +1864,20 @@ let (substitutive_indexed_bind_substs : if has_range_binders then let uu___4 = - FStarC_Compiler_List.splitAt + FStarC_List.splitAt (Prims.of_int (2)) bs4 in FStar_Pervasives_Native.snd uu___4 else bs4 in let bs6 = let uu___4 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length - bs5) + FStarC_List.splitAt + ((FStarC_List.length bs5) - (Prims.of_int (2))) bs5 in FStar_Pervasives_Native.fst uu___4 in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___4 -> fun b1 -> match uu___4 with @@ -1913,9 +1896,9 @@ let (substitutive_indexed_bind_substs : bind_name () in let uu___8 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range r1 in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "implicit var for additional g binder %s of %s at %s" uu___6 uu___7 @@ -1929,7 +1912,7 @@ let (substitutive_indexed_bind_substs : let uu___6 = FStarC_TypeChecker_Env.conj_guard g g_uv in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At ss [FStarC_Syntax_Syntax.NT ((b1.FStarC_Syntax_Syntax.binder_bv), @@ -1945,7 +1928,7 @@ let (ad_hoc_indexed_bind_substs : FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.comp_typ -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.bool -> (FStarC_Syntax_Syntax.subst_elt Prims.list * FStarC_TypeChecker_Env.guard_t)) @@ -1960,8 +1943,7 @@ let (ad_hoc_indexed_bind_substs : fun ct2 -> fun r1 -> fun has_range_binders -> - let debug = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let bind_name uu___ = if debug then @@ -1980,13 +1962,13 @@ let (ad_hoc_indexed_bind_substs : FStarC_Ident.ident_of_lid p_ed.FStarC_Syntax_Syntax.mname in FStarC_Ident.string_of_id uu___4 in - FStarC_Compiler_Util.format3 "(%s, %s) |> %s" - uu___1 uu___2 uu___3 + FStarC_Util.format3 "(%s, %s) |> %s" uu___1 uu___2 + uu___3 else "" in let bind_t_shape_error r s = let uu___ = let uu___1 = bind_name () in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "bind %s does not have proper shape (reason:%s)" uu___1 s in FStarC_Errors.raise_error @@ -2001,7 +1983,7 @@ let (ad_hoc_indexed_bind_substs : else Prims.int_zero in let uu___ = if - (FStarC_Compiler_List.length bs) >= + (FStarC_List.length bs) >= (num_range_binders + (Prims.of_int (4))) then let uu___1 = bs in @@ -2009,23 +1991,21 @@ let (ad_hoc_indexed_bind_substs : | a_b::b_b::bs1 -> let uu___2 = let uu___3 = - FStarC_Compiler_List.splitAt - (((FStarC_Compiler_List.length bs1) - + FStarC_List.splitAt + (((FStarC_List.length bs1) - (Prims.of_int (2))) - num_range_binders) bs1 in match uu___3 with | (l1, l2) -> let uu___4 = - FStarC_Compiler_List.splitAt - num_range_binders l2 in + FStarC_List.splitAt num_range_binders + l2 in (match uu___4 with | (uu___5, l21) -> - let uu___6 = - FStarC_Compiler_List.hd l21 in + let uu___6 = FStarC_List.hd l21 in let uu___7 = - let uu___8 = - FStarC_Compiler_List.tl l21 in - FStarC_Compiler_List.hd uu___8 in + let uu___8 = FStarC_List.tl l21 in + FStarC_List.hd uu___8 in (l1, uu___6, uu___7)) in (match uu___2 with | (rest_bs, f_b, g_b) -> @@ -2052,20 +2032,19 @@ let (ad_hoc_indexed_bind_substs : FStarC_Syntax_Print.showable_binder b1 in let uu___3 = bind_name () in let uu___4 = - FStarC_Compiler_Range_Ops.string_of_range - r1 in - FStarC_Compiler_Util.format3 + FStarC_Range_Ops.string_of_range r1 in + FStarC_Util.format3 "implicit var for binder %s of %s at %s" uu___2 uu___3 uu___4 else "ad_hoc_indexed_bind_substs") r1 in (match uu___1 with | (rest_bs_uvars, g_uvars) -> ((let uu___3 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___3 then - FStarC_Compiler_List.iter + FStarC_List.iter (fun t -> let uu___4 = let uu___5 = @@ -2083,7 +2062,7 @@ let (ad_hoc_indexed_bind_substs : (FStarC_Class_Show.show_option FStarC_Syntax_Print.showable_ctx_uvar_meta) u.FStarC_Syntax_Syntax.ctx_uvar_meta in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Generated uvar %s with attribute %s\n" uu___6 uu___7 | uu___5 -> @@ -2098,7 +2077,7 @@ let (ad_hoc_indexed_bind_substs : failwith uu___6) rest_bs_uvars else ()); (let subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b1 -> fun t -> FStarC_Syntax_Syntax.NT @@ -2116,19 +2095,19 @@ let (ad_hoc_indexed_bind_substs : let uu___5 = FStarC_Syntax_Util.is_layered m_ed in effect_args_from_repr uu___4 uu___5 r1 in - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Syntax_Subst.subst subst) uu___3 in let uu___3 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst ct1.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g -> fun i1 -> fun f_i1 -> (let uu___5 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___5 then @@ -2140,7 +2119,7 @@ let (ad_hoc_indexed_bind_substs : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term f_i1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Generating constraint %s = %s\n" uu___6 uu___7 else ()); @@ -2191,8 +2170,7 @@ let (ad_hoc_indexed_bind_substs : let uu___5 = let uu___6 = let uu___7 = - FStarC_Compiler_List.hd - bs2 in + FStarC_List.hd bs2 in uu___7.FStarC_Syntax_Syntax.binder_bv in let uu___7 = FStarC_Syntax_Syntax.bv_to_name @@ -2205,15 +2183,17 @@ let (ad_hoc_indexed_bind_substs : [bs_subst] c1 in let uu___5 = let uu___6 = + let uu___7 = + FStarC_Syntax_Util.comp_result + c2 in FStarC_Syntax_Subst.compress - (FStarC_Syntax_Util.comp_result - c2) in + uu___7 in let uu___7 = FStarC_Syntax_Util.is_layered n_ed in effect_args_from_repr uu___6 uu___7 r1 in - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Syntax_Subst.subst subst) uu___5) | uu___4 -> @@ -2224,15 +2204,15 @@ let (ad_hoc_indexed_bind_substs : [x_a] in let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst ct2.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g -> fun i1 -> fun g_i1 -> (let uu___6 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___6 then @@ -2244,7 +2224,7 @@ let (ad_hoc_indexed_bind_substs : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term g_i1 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Generating constraint %s = %s\n" uu___7 uu___8 else ()); @@ -2271,7 +2251,7 @@ let (mk_indexed_return : FStarC_Syntax_Syntax.universe -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.comp * FStarC_TypeChecker_Env.guard_t)) = fun env -> @@ -2280,8 +2260,7 @@ let (mk_indexed_return : fun a -> fun e -> fun r -> - let debug = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if debug then (let uu___1 = @@ -2293,7 +2272,7 @@ let (mk_indexed_return : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term a in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Computing %s.return for u_a:%s, a:%s, and e:%s{\n" uu___1 uu___2 uu___3 uu___4) else (); @@ -2335,15 +2314,13 @@ let (mk_indexed_return : | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = bs; FStarC_Syntax_Syntax.comp = c;_} - when - (FStarC_Compiler_List.length bs) >= - (Prims.of_int (2)) + when (FStarC_List.length bs) >= (Prims.of_int (2)) -> let uu___5 = FStarC_Syntax_Subst.open_comp bs c in (match uu___5 with | (a_b::x_b::bs1, c1) -> - (a_b, x_b, bs1, - (FStarC_Syntax_Util.comp_result c1))) + let uu___6 = FStarC_Syntax_Util.comp_result c1 in + (a_b, x_b, bs1, uu___6)) | uu___5 -> return_t_shape_error r "Either not an arrow or not enough binders" in @@ -2366,19 +2343,17 @@ let (mk_indexed_return : let uu___7 = FStarC_Ident.string_of_lid ed.FStarC_Syntax_Syntax.mname in - FStarC_Compiler_Util.format1 "%s.return" - uu___7 in + FStarC_Util.format1 "%s.return" uu___7 in let uu___7 = - FStarC_Compiler_Range_Ops.string_of_range - r in - FStarC_Compiler_Util.format3 + FStarC_Range_Ops.string_of_range r in + FStarC_Util.format3 "implicit var for binder %s of %s at %s" uu___5 uu___6 uu___7 else "mk_indexed_return_env") r in (match uu___4 with | (rest_bs_uvars, g_uvars) -> let subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun t -> FStarC_Syntax_Syntax.NT @@ -2392,12 +2367,12 @@ let (mk_indexed_return : let uu___7 = FStarC_Syntax_Util.is_layered ed in effect_args_from_repr uu___6 uu___7 r in - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Syntax_Subst.subst subst) uu___5 in let c = let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg is in { FStarC_Syntax_Syntax.comp_univs = [u_a]; @@ -2413,8 +2388,8 @@ let (mk_indexed_return : (let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.print1 - "} c after return %s\n" uu___6) + FStarC_Util.print1 "} c after return %s\n" + uu___6) else (); (c, g_uvars))))) let (mk_indexed_bind : @@ -2428,7 +2403,7 @@ let (mk_indexed_bind : FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.cflag Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> Prims.int -> Prims.bool -> (FStarC_Syntax_Syntax.comp * @@ -2448,8 +2423,7 @@ let (mk_indexed_bind : fun num_effect_params -> fun has_range_binders -> let debug = - FStarC_Compiler_Effect.op_Bang - dbg_LayeredEffectsApp in + FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if debug then (let uu___1 = @@ -2462,23 +2436,21 @@ let (mk_indexed_bind : FStarC_Syntax_Syntax.mk_Comp ct2 in FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp uu___3 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "Binding indexed effects: c1:%s and c2:%s {\n" uu___1 uu___2) else (); (let uu___2 = - FStarC_Compiler_Effect.op_Bang - dbg_ResolveImplicitsHook in + FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___2 then let uu___3 = let uu___4 = FStarC_TypeChecker_Env.get_range env in - FStarC_Compiler_Range_Ops.string_of_range - uu___4 in + FStarC_Range_Ops.string_of_range uu___4 in let uu___4 = FStarC_Syntax_Print.tscheme_to_string bind_t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "///////////////////////////////Bind at %s/////////////////////\nwith bind_t = %s\n" uu___3 uu___4 else ()); @@ -2508,8 +2480,8 @@ let (mk_indexed_bind : FStarC_Ident.ident_of_lid p_ed.FStarC_Syntax_Syntax.mname in FStarC_Ident.string_of_id uu___7 in - FStarC_Compiler_Util.format3 - "(%s, %s) |> %s" uu___4 uu___5 uu___6 in + FStarC_Util.format3 "(%s, %s) |> %s" + uu___4 uu___5 uu___6 in ((let uu___4 = (((FStarC_TypeChecker_Env.is_erasable_effect env m) @@ -2582,11 +2554,11 @@ let (mk_indexed_bind : (let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_List.hd + FStarC_List.hd ct1.FStarC_Syntax_Syntax.comp_univs in let uu___7 = let uu___8 = - FStarC_Compiler_List.hd + FStarC_List.hd ct2.FStarC_Syntax_Syntax.comp_univs in [uu___8] in uu___6 :: uu___7 in @@ -2631,11 +2603,11 @@ let (mk_indexed_bind : let fml = let uu___8 = let uu___9 = - FStarC_Compiler_List.hd + FStarC_List.hd bind_ct.FStarC_Syntax_Syntax.comp_univs in let uu___10 = let uu___11 = - FStarC_Compiler_List.hd + FStarC_List.hd bind_ct.FStarC_Syntax_Syntax.effect_args in FStar_Pervasives_Native.fst uu___11 in @@ -2646,7 +2618,7 @@ let (mk_indexed_bind : env u bind_ct.FStarC_Syntax_Syntax.result_typ wp - FStarC_Compiler_Range_Type.dummyRange in + FStarC_Range_Type.dummyRange in let is = let uu___8 = FStarC_Syntax_Subst.compress @@ -2659,7 +2631,7 @@ let (mk_indexed_bind : let c = let uu___8 = let uu___9 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg is in { @@ -2685,7 +2657,7 @@ let (mk_indexed_bind : FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "} c after bind: %s\n" uu___9) else (); @@ -2701,7 +2673,7 @@ let (mk_indexed_bind : FStarC_TypeChecker_Env.conj_guards uu___9 in (let uu___10 = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_ResolveImplicitsHook in if uu___10 then @@ -2709,12 +2681,12 @@ let (mk_indexed_bind : let uu___12 = FStarC_TypeChecker_Env.get_range env in - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range uu___12 in let uu___12 = FStarC_TypeChecker_Rel.guard_to_string env guard in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "///////////////////////////////EndBind at %s/////////////////////\nguard = %s\n" uu___11 uu___12 else ()); @@ -2726,7 +2698,7 @@ let (mk_wp_bind : FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.cflag Prims.list -> - FStarC_Compiler_Range_Type.range -> FStarC_Syntax_Syntax.comp) + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.comp) = fun env -> fun m -> @@ -2754,12 +2726,14 @@ let (mk_wp_bind : let uu___1 = FStarC_Syntax_Syntax.mk_binder x in [uu___1] in let mk_lam wp = - FStarC_Syntax_Util.abs bs wp - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.mk_residual_comp - FStarC_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None - [FStarC_Syntax_Syntax.TOTAL])) in + let uu___1 = + let uu___2 = + FStarC_Syntax_Util.mk_residual_comp + FStarC_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None + [FStarC_Syntax_Syntax.TOTAL] in + FStar_Pervasives_Native.Some uu___2 in + FStarC_Syntax_Util.abs bs wp uu___1 in let wp_args = let uu___1 = FStarC_Syntax_Syntax.as_arg t1 in let uu___2 = @@ -2790,7 +2764,7 @@ let (mk_bind : FStarC_Syntax_Syntax.bv FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.comp -> FStarC_Syntax_Syntax.cflag Prims.list -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.comp * FStarC_TypeChecker_Env.guard_t)) = fun env -> @@ -2856,8 +2830,7 @@ let (mk_bind : m_ed.FStarC_Syntax_Syntax.eff_attrs FStarC_Parser_Const.bind_has_range_args_attr in let uu___7 = - FStarC_Compiler_Util.must - bind_kind in + FStarC_Util.must bind_kind in mk_indexed_bind env m m m bind_t uu___7 ct11 b ct21 flags r1 num_effect_params has_range_args @@ -2930,7 +2903,7 @@ let (mk_return : FStarC_Syntax_Syntax.universe -> FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.term -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.comp * FStarC_TypeChecker_Env.guard_t)) = fun env -> @@ -2971,7 +2944,7 @@ let (weaken_flags : = fun flags -> let uu___ = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___1 -> match uu___1 with | FStarC_Syntax_Syntax.SHOULD_NOT_INLINE -> true @@ -2979,7 +2952,7 @@ let (weaken_flags : if uu___ then [FStarC_Syntax_Syntax.SHOULD_NOT_INLINE] else - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.TOTAL -> @@ -3092,7 +3065,7 @@ let (strengthen_precondition : match uu___2 with | (maybe_trivial_post, flags1) -> let uu___3 = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___4 -> match uu___4 with | FStarC_Syntax_Syntax.RETURN -> @@ -3109,7 +3082,7 @@ let (strengthen_precondition : [FStarC_Syntax_Syntax.SHOULD_NOT_INLINE] | uu___5 -> []) lc.FStarC_TypeChecker_Common.cflags in - FStarC_Compiler_List.op_At flags1 uu___3 in + FStarC_List.op_At flags1 uu___3 in let strengthen uu___2 = let uu___3 = FStarC_TypeChecker_Common.lcomp_comp lc in match uu___3 with @@ -3124,7 +3097,7 @@ let (strengthen_precondition : match uu___6 with | FStarC_TypeChecker_Common.Trivial -> (c, g_c) | FStarC_TypeChecker_Common.NonTrivial f -> - ((let uu___8 = FStarC_Compiler_Debug.extreme () in + ((let uu___8 = FStarC_Debug.extreme () in if uu___8 then let uu___9 = @@ -3133,7 +3106,7 @@ let (strengthen_precondition : let uu___10 = FStarC_TypeChecker_Normalize.term_to_string env f in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "-------------Strengthening pre-condition of term %s with guard %s\n" uu___9 uu___10 else ()); @@ -3167,7 +3140,7 @@ let (lcomp_has_trivial_postcondition : FStarC_TypeChecker_Common.lcomp -> Prims.bool) = fun lc -> (FStarC_TypeChecker_Common.is_tot_or_gtot_lcomp lc) || - (FStarC_Compiler_Util.for_some + (FStarC_Util.for_some (fun uu___ -> match uu___ with | FStarC_Syntax_Syntax.SOMETRIVIAL -> true @@ -3202,8 +3175,8 @@ let (maybe_capture_unit_refinement : then let uu___ = let uu___1 = - FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + let uu___2 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Env.norm_eff_name env uu___2 in FStarC_TypeChecker_Env.is_layered_effect env uu___1 in (if uu___ then @@ -3221,7 +3194,7 @@ let (maybe_capture_unit_refinement : else (c, FStarC_TypeChecker_Env.trivial_guard) | uu___ -> (c, FStarC_TypeChecker_Env.trivial_guard) let (bind : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option -> FStarC_TypeChecker_Common.lcomp -> @@ -3236,8 +3209,8 @@ let (bind : | (b, lc2) -> let debug f = let uu___1 = - (FStarC_Compiler_Debug.extreme ()) || - (FStarC_Compiler_Effect.op_Bang dbg_bind) in + (FStarC_Debug.extreme ()) || + (FStarC_Effect.op_Bang dbg_bind) in if uu___1 then f () else () in let uu___1 = FStarC_TypeChecker_Normalize.ghost_to_pure_lcomp2 env @@ -3350,7 +3323,7 @@ let (bind : FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e1 in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "(1) bind: \n\tc1=%s\n\tx=%s\n\tc2=%s\n\te1=%s\n(1. end bind)\n" uu___9 uu___10 uu___11 uu___12); (let aux uu___8 = @@ -3413,6 +3386,9 @@ let (bind : then let close_with_type_of_x x c = let x1 = + let uu___12 = + FStarC_Syntax_Util.comp_result + c1 in { FStarC_Syntax_Syntax.ppname = @@ -3421,8 +3397,7 @@ let (bind : = (x.FStarC_Syntax_Syntax.index); FStarC_Syntax_Syntax.sort = - (FStarC_Syntax_Util.comp_result - c1) + uu___12 } in maybe_capture_unit_refinement env @@ -3505,9 +3480,11 @@ let (bind : then let uu___14 = let uu___15 = + let uu___16 = + FStarC_Syntax_Util.comp_result + c2 in FStarC_Syntax_Syntax.mk_GTotal - (FStarC_Syntax_Util.comp_result - c2) in + uu___16 in (uu___15, trivial_guard, "both GTot") in FStar_Pervasives.Inl uu___14 @@ -3521,14 +3498,14 @@ let (bind : FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "(2) bind: Simplified (because %s) to\n\t%s\n" reason uu___11); (c, g)) | FStar_Pervasives.Inr reason -> (debug (fun uu___10 -> - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "(2) bind: Not simplified because %s\n" reason); (let mk_bind1 c11 b1 c21 g = @@ -3557,19 +3534,14 @@ let (bind : match uu___10 with | (u_res_t1, res_t1) -> let uu___11 = - (FStarC_Compiler_Option.isSome - b) - && + (FStarC_Option.isSome b) && (should_return env e1opt lc11) in if uu___11 then let e1 = - FStarC_Compiler_Option.get - e1opt in - let x = - FStarC_Compiler_Option.get - b in + FStarC_Option.get e1opt in + let x = FStarC_Option.get b in let uu___12 = FStarC_Syntax_Util.is_partial_return c1 in @@ -3584,7 +3556,7 @@ let (bind : FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "(3) bind (case a): Substituting %s for %s\n" uu___15 uu___16); (let c21 = @@ -3611,7 +3583,7 @@ let (bind : FStarC_Class_Show.show FStarC_Syntax_Print.showable_bv x in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "(3) bind (case b): Adding equality %s = %s\n" uu___16 uu___17); (let c21 = @@ -3710,11 +3682,11 @@ let (assume_result_eq_pure_term_in_m : fun lc -> let m = let uu___ = - (FStarC_Compiler_Util.is_none m_opt) || + (FStarC_Util.is_none m_opt) || (is_ghost_effect env lc.FStarC_TypeChecker_Common.eff_name) in if uu___ then FStarC_Parser_Const.effect_PURE_lid - else FStarC_Compiler_Util.must m_opt in + else FStarC_Util.must m_opt in let flags = let uu___ = FStarC_TypeChecker_Common.is_total_lcomp lc in if uu___ @@ -3730,14 +3702,15 @@ let (assume_result_eq_pure_term_in_m : match comp_univ_opt c with | FStar_Pervasives_Native.Some u_t1 -> u_t1 | FStar_Pervasives_Native.None -> - env.FStarC_TypeChecker_Env.universe_of env - (FStarC_Syntax_Util.comp_result c) in + let uu___2 = FStarC_Syntax_Util.comp_result c in + env.FStarC_TypeChecker_Env.universe_of env uu___2 in let uu___2 = FStarC_Syntax_Util.is_tot_or_gtot_comp c in if uu___2 then let uu___3 = + let uu___4 = FStarC_Syntax_Util.comp_result c in return_value env m (FStar_Pervasives_Native.Some u_t) - (FStarC_Syntax_Util.comp_result c) e in + uu___4 e in (match uu___3 with | (retc, g_retc) -> let g_c1 = @@ -3863,7 +3836,7 @@ let (maybe_assume_result_eq_pure_term : maybe_assume_result_eq_pure_term_in_m env FStar_Pervasives_Native.None e lc let (maybe_return_e2_and_bind : - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term FStar_Pervasives_Native.option -> FStarC_TypeChecker_Common.lcomp -> @@ -3902,12 +3875,12 @@ let (maybe_return_e2_and_bind : (let uu___3 = FStarC_TypeChecker_Env.join_opt env eff1 eff2 in - FStarC_Compiler_Util.is_none uu___3)) + FStarC_Util.is_none uu___3)) && (let uu___3 = FStarC_TypeChecker_Env.exists_polymonadic_bind env eff1 eff2 in - FStarC_Compiler_Util.is_none uu___3) in + FStarC_Util.is_none uu___3) in if uu___2 then assume_result_eq_pure_term_in_m env_x @@ -3943,7 +3916,7 @@ let (substitutive_indexed_ite_substs : FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.comp_typ -> Prims.int -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.subst_elt Prims.list * FStarC_TypeChecker_Env.guard_t)) = @@ -3956,8 +3929,7 @@ let (substitutive_indexed_ite_substs : fun ct_else -> fun num_effect_params -> fun r -> - let debug = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = bs in match uu___1 with @@ -3976,8 +3948,7 @@ let (substitutive_indexed_ite_substs : (ct_else.FStarC_Syntax_Syntax.effect_args)) else (let split l = - FStarC_Compiler_List.splitAt num_effect_params - l in + FStarC_List.splitAt num_effect_params l in let uu___3 = split bs1 in match uu___3 with | (eff_params_bs, bs2) -> @@ -3992,7 +3963,7 @@ let (substitutive_indexed_ite_substs : (match uu___5 with | (param_args2, args2) -> let g = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g1 -> fun uu___6 -> fun uu___7 -> @@ -4010,7 +3981,7 @@ let (substitutive_indexed_ite_substs : FStarC_TypeChecker_Env.trivial_guard param_args1 param_args2 in let param_subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun uu___6 -> match uu___6 with @@ -4020,21 +3991,20 @@ let (substitutive_indexed_ite_substs : arg)) eff_params_bs param_args1 in (bs2, - (FStarC_Compiler_List.op_At - subst param_subst), g, args1, + (FStarC_List.op_At subst + param_subst), g, args1, args2)))) in (match uu___1 with | (bs2, subst1, guard, args1, args2) -> let uu___2 = let m_num_effect_args = - FStarC_Compiler_List.length args1 in + FStarC_List.length args1 in let uu___3 = - FStarC_Compiler_List.splitAt - m_num_effect_args bs2 in + FStarC_List.splitAt m_num_effect_args bs2 in match uu___3 with | (f_bs, bs3) -> let f_subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun f_b -> fun uu___4 -> match uu___4 with @@ -4042,9 +4012,7 @@ let (substitutive_indexed_ite_substs : FStarC_Syntax_Syntax.NT ((f_b.FStarC_Syntax_Syntax.binder_bv), arg)) f_bs args1 in - (bs3, - (FStarC_Compiler_List.op_At subst1 - f_subst)) in + (bs3, (FStarC_List.op_At subst1 f_subst)) in (match uu___2 with | (bs3, subst2) -> let uu___3 = @@ -4053,14 +4021,14 @@ let (substitutive_indexed_ite_substs : k then let n_num_effect_args = - FStarC_Compiler_List.length args2 in + FStarC_List.length args2 in let uu___4 = - FStarC_Compiler_List.splitAt - n_num_effect_args bs3 in + FStarC_List.splitAt n_num_effect_args + bs3 in match uu___4 with | (g_bs, bs4) -> let g_subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun g_b -> fun uu___5 -> match uu___5 with @@ -4069,15 +4037,15 @@ let (substitutive_indexed_ite_substs : ((g_b.FStarC_Syntax_Syntax.binder_bv), arg)) g_bs args2 in (bs4, - (FStarC_Compiler_List.op_At - subst2 g_subst), guard) + (FStarC_List.op_At subst2 g_subst), + guard) else if FStarC_Syntax_Syntax.uu___is_Substitutive_invariant_combinator k then (let uu___5 = - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun guard1 -> fun uu___6 -> fun uu___7 -> @@ -4100,13 +4068,13 @@ let (substitutive_indexed_ite_substs : (match uu___3 with | (bs4, subst3, guard1) -> let uu___4 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs4) - - (Prims.of_int (3))) bs4 in + FStarC_List.splitAt + ((FStarC_List.length bs4) - + (Prims.of_int (3))) bs4 in (match uu___4 with | (bs5, uu___5::uu___6::p_b::[]) -> let uu___7 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___8 -> fun b -> match uu___8 with @@ -4128,9 +4096,9 @@ let (substitutive_indexed_ite_substs : ct_then.FStarC_Syntax_Syntax.effect_name in let uu___12 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range r in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "implicit var for additional ite binder %s of %s at %s)" uu___10 uu___11 @@ -4144,7 +4112,7 @@ let (substitutive_indexed_ite_substs : let uu___10 = FStarC_TypeChecker_Env.conj_guard g g_uv in - ((FStarC_Compiler_List.op_At + ((FStarC_List.op_At subst4 [FStarC_Syntax_Syntax.NT ((b.FStarC_Syntax_Syntax.binder_bv), @@ -4153,8 +4121,7 @@ let (substitutive_indexed_ite_substs : (subst3, guard1) bs5 in (match uu___7 with | (subst4, g) -> - ((FStarC_Compiler_List.op_At - subst4 + ((FStarC_List.op_At subst4 [FStarC_Syntax_Syntax.NT ((p_b.FStarC_Syntax_Syntax.binder_bv), p)]), g)))))) @@ -4165,7 +4132,7 @@ let (ad_hoc_indexed_ite_substs : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.comp_typ -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.subst_elt Prims.list * FStarC_TypeChecker_Env.guard_t)) = @@ -4176,15 +4143,14 @@ let (ad_hoc_indexed_ite_substs : fun ct_then -> fun ct_else -> fun r -> - let debug = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let conjunction_name uu___ = if debug then let uu___1 = FStarC_Ident.string_of_lid ct_then.FStarC_Syntax_Syntax.effect_name in - FStarC_Compiler_Util.format1 "%s.conjunction" uu___1 + FStarC_Util.format1 "%s.conjunction" uu___1 else "" in let conjunction_t_error r1 s = let uu___ = @@ -4212,15 +4178,15 @@ let (ad_hoc_indexed_ite_substs : (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___) in let uu___ = - if (FStarC_Compiler_List.length bs) >= (Prims.of_int (4)) + if (FStarC_List.length bs) >= (Prims.of_int (4)) then let uu___1 = bs in match uu___1 with | a_b::bs1 -> let uu___2 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs1) - - (Prims.of_int (3))) bs1 in + FStarC_List.splitAt + ((FStarC_List.length bs1) - (Prims.of_int (3))) + bs1 in (match uu___2 with | (rest_bs, f_b::g_b::p_b::[]) -> (a_b, rest_bs, f_b, g_b, p_b)) @@ -4242,24 +4208,21 @@ let (ad_hoc_indexed_ite_substs : let uu___3 = FStarC_Ident.string_of_lid ct_then.FStarC_Syntax_Syntax.effect_name in - let uu___4 = - FStarC_Compiler_Range_Ops.string_of_range r in - FStarC_Compiler_Util.format3 + let uu___4 = FStarC_Range_Ops.string_of_range r in + FStarC_Util.format3 "implicit var for binder %s of %s:conjunction at %s" uu___2 uu___3 uu___4 else "ad_hoc_indexed_ite_substs") r in (match uu___1 with | (rest_bs_uvars, g_uvars) -> let substs = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun t -> FStarC_Syntax_Syntax.NT ((b.FStarC_Syntax_Syntax.binder_bv), t)) - (a_b :: - (FStarC_Compiler_List.op_At rest_bs [p_b])) (a - :: - (FStarC_Compiler_List.op_At rest_bs_uvars [p])) in + (a_b :: (FStarC_List.op_At rest_bs [p_b])) (a :: + (FStarC_List.op_At rest_bs_uvars [p])) in let f_guard = let f_sort_is = let uu___2 = @@ -4273,18 +4236,17 @@ let (ad_hoc_indexed_ite_substs : FStarC_Syntax_Syntax.args = uu___4::is;_} -> let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst is in - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Syntax_Subst.subst substs) uu___5 | uu___3 -> conjunction_t_error r "f's type is not a repr type" in let uu___2 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst + FStarC_List.map FStar_Pervasives_Native.fst ct_then.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g -> fun i1 -> fun f_i -> @@ -4311,18 +4273,17 @@ let (ad_hoc_indexed_ite_substs : FStarC_Syntax_Syntax.args = uu___4::is;_} -> let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst is in - FStarC_Compiler_List.map + FStarC_List.map (FStarC_Syntax_Subst.subst substs) uu___5 | uu___3 -> conjunction_t_error r "g's type is not a repr type" in let uu___2 = - FStarC_Compiler_List.map - FStar_Pervasives_Native.fst + FStarC_List.map FStar_Pervasives_Native.fst ct_else.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g -> fun i2 -> fun g_i -> @@ -4348,7 +4309,7 @@ let (mk_layered_conjunction : FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.comp_typ -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.comp * FStarC_TypeChecker_Env.guard_t)) = @@ -4360,8 +4321,7 @@ let (mk_layered_conjunction : fun ct1 -> fun ct2 -> fun r -> - let debug = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let conjunction_t_error r1 s = let uu___ = let uu___1 = @@ -4392,14 +4352,14 @@ let (mk_layered_conjunction : let uu___2 = FStarC_Syntax_Util.get_layered_if_then_else_combinator ed in - FStarC_Compiler_Util.must uu___2 in + FStarC_Util.must uu___2 in match uu___1 with | (ts, kopt) -> let uu___2 = FStarC_TypeChecker_Env.inst_tscheme_with ts [u_a] in (match uu___2 with | (uu___3, conjunction) -> - let uu___4 = FStarC_Compiler_Util.must kopt in + let uu___4 = FStarC_Util.must kopt in (conjunction, uu___4)) in match uu___ with | (conjunction, kind) -> @@ -4418,7 +4378,7 @@ let (mk_layered_conjunction : FStarC_Syntax_Syntax.mk_Comp ct2 in FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp uu___6 in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "layered_ite c1: %s and c2: %s {\n" uu___4 uu___5) else (); @@ -4452,7 +4412,7 @@ let (mk_layered_conjunction : { FStarC_Syntax_Syntax.hd = uu___6; FStarC_Syntax_Syntax.args = a1::args;_} -> - FStarC_Compiler_List.map + FStarC_List.map FStar_Pervasives_Native.fst args | uu___6 -> conjunction_t_error r @@ -4460,7 +4420,7 @@ let (mk_layered_conjunction : let c = let uu___5 = let uu___6 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg is in { FStarC_Syntax_Syntax.comp_univs = @@ -4474,8 +4434,7 @@ let (mk_layered_conjunction : } in FStarC_Syntax_Syntax.mk_Comp uu___5 in (if debug - then - FStarC_Compiler_Util.print_string "\n}\n" + then FStarC_Util.print_string "\n}\n" else (); (c, g))))) let (mk_non_layered_conjunction : @@ -4486,7 +4445,7 @@ let (mk_non_layered_conjunction : FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.comp_typ -> FStarC_Syntax_Syntax.comp_typ -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.comp * FStarC_TypeChecker_Env.guard_t)) = @@ -4502,7 +4461,7 @@ let (mk_non_layered_conjunction : let if_then_else = let uu___1 = FStarC_Syntax_Util.get_wp_if_then_else_combinator ed in - FStarC_Compiler_Util.must uu___1 in + FStarC_Util.must uu___1 in let uu___1 = destruct_wp_comp ct1 in match uu___1 with | (uu___2, uu___3, wp_t) -> @@ -4528,7 +4487,7 @@ let (mk_non_layered_conjunction : uu___11 :: uu___12 in uu___9 :: uu___10 in let uu___9 = - FStarC_Compiler_Range_Ops.union_ranges + FStarC_Range_Ops.union_ranges wp_t.FStarC_Syntax_Syntax.pos wp_e.FStarC_Syntax_Syntax.pos in FStarC_Syntax_Syntax.mk_Tm_app uu___7 uu___8 @@ -4561,11 +4520,13 @@ let (comp_pure_wp_false : let uu___ = let uu___1 = FStarC_Syntax_Syntax.mk_binder post in [uu___1] in let uu___1 = fvar_env env FStarC_Parser_Const.false_lid in - FStarC_Syntax_Util.abs uu___ uu___1 - (FStar_Pervasives_Native.Some - (FStarC_Syntax_Util.mk_residual_comp - FStarC_Parser_Const.effect_Tot_lid - FStar_Pervasives_Native.None [FStarC_Syntax_Syntax.TOTAL])) in + let uu___2 = + let uu___3 = + FStarC_Syntax_Util.mk_residual_comp + FStarC_Parser_Const.effect_Tot_lid + FStar_Pervasives_Native.None [FStarC_Syntax_Syntax.TOTAL] in + FStar_Pervasives_Native.Some uu___3 in + FStarC_Syntax_Util.abs uu___ uu___1 uu___2 in let md = FStarC_TypeChecker_Env.get_effect_decl env FStarC_Parser_Const.effect_PURE_lid in @@ -4578,7 +4539,7 @@ let (get_neg_branch_conds : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___3 -> fun g -> match uu___3 with @@ -4588,14 +4549,14 @@ let (get_neg_branch_conds : let uu___5 = FStarC_Syntax_Util.b2t g in FStarC_Syntax_Util.mk_neg uu___5 in FStarC_Syntax_Util.mk_conj acc uu___4 in - ((FStarC_Compiler_List.op_At conds [cond]), cond)) + ((FStarC_List.op_At conds [cond]), cond)) ([FStarC_Syntax_Util.t_true], FStarC_Syntax_Util.t_true) branch_conds in FStar_Pervasives_Native.fst uu___2 in - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length uu___1) - Prims.int_one) uu___1 in + FStarC_List.splitAt ((FStarC_List.length uu___1) - Prims.int_one) + uu___1 in match uu___ with - | (l1, l2) -> let uu___1 = FStarC_Compiler_List.hd l2 in (l1, uu___1) + | (l1, l2) -> let uu___1 = FStarC_List.hd l2 in (l1, uu___1) let (bind_cases : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.typ -> @@ -4614,7 +4575,7 @@ let (bind_cases : [uu___1] in FStarC_TypeChecker_Env.push_binders env0 uu___ in let eff = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun eff1 -> fun uu___ -> match uu___ with @@ -4623,11 +4584,11 @@ let (bind_cases : FStarC_Parser_Const.effect_PURE_lid lcases in let uu___ = let uu___1 = - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___2 -> match uu___2 with | (uu___3, uu___4, flags, uu___5) -> - FStarC_Compiler_Util.for_some + FStarC_Util.for_some (fun uu___6 -> match uu___6 with | FStarC_Syntax_Syntax.SHOULD_NOT_INLINE -> true @@ -4655,7 +4616,7 @@ let (bind_cases : if uu___4 then cthen true else cthen false in let uu___4 = let uu___5 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___6 -> match uu___6 with | (g, uu___7, uu___8, uu___9) -> g) lcases in @@ -4673,24 +4634,23 @@ let (bind_cases : let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length lcases) - + FStarC_List.splitAt + ((FStarC_List.length lcases) - Prims.int_one) neg_branch_conds in match uu___9 with | (l1, l2) -> - let uu___10 = FStarC_Compiler_List.hd l2 in + let uu___10 = FStarC_List.hd l2 in (l1, uu___10) in match uu___8 with | (neg_branch_conds1, neg_last) -> let uu___9 = let uu___10 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length lcases) - - Prims.int_one) lcases in + FStarC_List.splitAt + ((FStarC_List.length lcases) - + Prims.int_one) lcases in match uu___10 with | (l1, l2) -> - let uu___11 = - FStarC_Compiler_List.hd l2 in + let uu___11 = FStarC_List.hd l2 in (l1, uu___11) in (match uu___9 with | (lcases1, @@ -4727,7 +4687,7 @@ let (bind_cases : (match uu___7 with | (lcases1, neg_branch_conds1, md, comp, g_comp) -> - FStarC_Compiler_List.fold_right2 + FStarC_List.fold_right2 (fun uu___8 -> fun neg_cond -> fun uu___9 -> @@ -4869,8 +4829,7 @@ let (bind_cases : | uu___7::[] -> (comp1, g_comp1) | uu___7 -> let uu___8 = - let uu___9 = - FStarC_Compiler_Util.must md in + let uu___9 = FStarC_Util.must md in FStarC_Syntax_Util.is_layered uu___9 in if uu___8 then (comp1, g_comp1) @@ -4889,8 +4848,7 @@ let (bind_cases : let uu___13 = FStarC_Syntax_Util.get_wp_ite_combinator md1 in - FStarC_Compiler_Util.must - uu___13 in + FStarC_Util.must uu___13 in let wp1 = let uu___13 = FStarC_TypeChecker_Env.inst_effect_fun_with @@ -4938,7 +4896,7 @@ let (check_comp : FStarC_Class_Binders.hasNames_comp FStarC_Syntax_Print.pretty_comp c'.FStarC_Syntax_Syntax.pos "check_comp.c'" env c'; - (let uu___3 = FStarC_Compiler_Debug.extreme () in + (let uu___3 = FStarC_Debug.extreme () in if uu___3 then let uu___4 = @@ -4947,7 +4905,7 @@ let (check_comp : FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c' in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Checking comp relation:\n%s has type %s\n\t %s \n%s\n" uu___4 uu___5 (if use_eq then "$:" else "<:") uu___6 else ()); @@ -4977,8 +4935,8 @@ let (universe_of_comp : fun u_res -> fun c -> let c_lid = - FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + let uu___ = FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Env.norm_eff_name env uu___ in let uu___ = FStarC_Syntax_Util.is_pure_or_ghost_effect c_lid in if uu___ then u_res @@ -4986,7 +4944,7 @@ let (universe_of_comp : (let is_total = let uu___2 = FStarC_TypeChecker_Env.lookup_effect_quals env c_lid in - FStarC_Compiler_List.existsb + FStarC_List.existsb (fun q -> q = FStarC_Syntax_Syntax.TotalEffect) uu___2 in if Prims.op_Negation is_total then FStarC_Syntax_Syntax.U_zero @@ -4998,7 +4956,7 @@ let (universe_of_comp : let uu___5 = FStarC_Class_Show.show FStarC_Ident.showable_lident c_lid in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect %s is marked total but does not have a repr" uu___5 in FStarC_Errors.raise_error @@ -5027,7 +4985,7 @@ let (check_trivial_precondition_wp : let uu___1 = let uu___2 = let uu___3 = FStarC_Syntax_Util.get_wp_trivial_combinator md in - FStarC_Compiler_Util.must uu___3 in + FStarC_Util.must uu___3 in FStarC_TypeChecker_Env.inst_effect_fun_with [u_t] env md uu___2 in let uu___2 = let uu___3 = FStarC_Syntax_Syntax.as_arg t in @@ -5117,13 +5075,11 @@ let (coerce_with : let uu___ = FStarC_TypeChecker_Env.try_lookup_lid env f in match uu___ with | FStar_Pervasives_Native.Some uu___1 -> - ((let uu___3 = - FStarC_Compiler_Effect.op_Bang dbg_Coercions in + ((let uu___3 = FStarC_Effect.op_Bang dbg_Coercions in if uu___3 then let uu___4 = FStarC_Ident.string_of_lid f in - FStarC_Compiler_Util.print1 "Coercing with %s!\n" - uu___4 + FStarC_Util.print1 "Coercing with %s!\n" uu___4 else ()); (let lc2 = FStarC_TypeChecker_Common.lcomp_of_comp comp2 in let lc_res = @@ -5147,7 +5103,7 @@ let (coerce_with : let uu___5 = let uu___6 = FStarC_Syntax_Syntax.as_arg e in [uu___6] in - FStarC_Compiler_List.op_At eargs uu___5 in + FStarC_List.op_At eargs uu___5 in FStarC_Syntax_Syntax.mk_Tm_app coercion1 uu___4 e.FStarC_Syntax_Syntax.pos else @@ -5164,7 +5120,7 @@ let (coerce_with : FStarC_Syntax_Syntax.bv_to_name x in FStarC_Syntax_Syntax.as_arg uu___8 in [uu___7] in - FStarC_Compiler_List.op_At eargs uu___6 in + FStarC_List.op_At eargs uu___6 in FStarC_Syntax_Syntax.mk_Tm_app coercion1 uu___5 e.FStarC_Syntax_Syntax.pos in let e3 = @@ -5208,7 +5164,7 @@ let (coerce_with : | FStar_Pervasives_Native.None -> ((let uu___2 = let uu___3 = FStarC_Ident.string_of_lid f in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Coercion %s was not found in the environment, not coercing." uu___3 in FStarC_Errors.log_issue @@ -5271,7 +5227,7 @@ let rec (check_erased : FStarC_Syntax_Syntax.brs = branches; FStarC_Syntax_Syntax.rc_opt1 = uu___4;_}, uu___5) -> - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun acc -> fun br -> match acc with @@ -5288,7 +5244,7 @@ let rec (check_erased : FStarC_Syntax_Free.names br_body in FStarC_Class_Setlike.elems () (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set + (FStarC_FlatSet.setlike_flat_set FStarC_Syntax_Syntax.ord_bv)) (Obj.magic uu___12) in FStarC_TypeChecker_Env.push_bvs env @@ -5310,15 +5266,14 @@ let rec first_opt : | [] -> FStar_Pervasives_Native.None | x::xs1 -> let uu___ = f x in - FStarC_Compiler_Util.catch_opt uu___ - (fun uu___1 -> first_opt f xs1) + FStarC_Util.catch_opt uu___ (fun uu___1 -> first_opt f xs1) let op_let_Question : 'uuuuu 'uuuuu1 . unit -> 'uuuuu FStar_Pervasives_Native.option -> ('uuuuu -> 'uuuuu1 FStar_Pervasives_Native.option) -> 'uuuuu1 FStar_Pervasives_Native.option - = fun uu___ -> FStarC_Compiler_Util.bind_opt + = fun uu___ -> FStarC_Util.bind_opt let (bool_guard : Prims.bool -> unit FStar_Pervasives_Native.option) = fun b -> if b @@ -5494,7 +5449,7 @@ let (find_coercion : let uu___11 = let uu___12 = let uu___13 = - FStarC_Compiler_Util.right + FStarC_Util.right lb.FStarC_Syntax_Syntax.lbname in FStarC_Syntax_Syntax.lid_of_fv uu___13 in @@ -5577,7 +5532,7 @@ let (find_coercion : uu___17 -> let b = - FStarC_Compiler_List.last + FStarC_List.last f_bs in let b_ty = @@ -5588,7 +5543,7 @@ let (find_coercion : = let uu___19 = - FStarC_Compiler_List.init + FStarC_List.init f_bs in FStarC_TypeChecker_Env.push_binders env @@ -5818,12 +5773,11 @@ let (maybe_coerce_lc : (Prims.op_Negation env.FStarC_TypeChecker_Env.nocoerce) in if Prims.op_Negation should_coerce then - ((let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Coercions in + ((let uu___1 = FStarC_Effect.op_Bang dbg_Coercions in if uu___1 then let uu___2 = - FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Class_Show.show FStarC_Range_Ops.showable_range e.FStarC_Syntax_Syntax.pos in let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in @@ -5833,18 +5787,17 @@ let (maybe_coerce_lc : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term exp_t in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "(%s) NOT Trying to coerce %s from type (%s) to type (%s)\n" uu___2 uu___3 uu___4 uu___5 else ()); (e, lc, FStarC_TypeChecker_Env.trivial_guard)) else - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Coercions in + ((let uu___2 = FStarC_Effect.op_Bang dbg_Coercions in if uu___2 then let uu___3 = - FStarC_Class_Show.show - FStarC_Compiler_Range_Ops.showable_range + FStarC_Class_Show.show FStarC_Range_Ops.showable_range e.FStarC_Syntax_Syntax.pos in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term e in @@ -5854,18 +5807,18 @@ let (maybe_coerce_lc : let uu___6 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term exp_t in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "(%s) Trying to coerce %s from type (%s) to type (%s)\n" uu___3 uu___4 uu___5 uu___6 else ()); (let uu___2 = find_coercion env lc exp_t e in match uu___2 with | FStar_Pervasives_Native.Some (coerced, lc1, g) -> - ((let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Coercions in + ((let uu___4 = FStarC_Effect.op_Bang dbg_Coercions in if uu___4 then let uu___5 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range e.FStarC_Syntax_Syntax.pos in let uu___6 = FStarC_Class_Show.show @@ -5873,19 +5826,19 @@ let (maybe_coerce_lc : let uu___7 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term coerced in - FStarC_Compiler_Util.print3 "(%s) COERCING %s to %s\n" - uu___5 uu___6 uu___7 + FStarC_Util.print3 "(%s) COERCING %s to %s\n" uu___5 + uu___6 uu___7 else ()); (coerced, lc1, g)) | FStar_Pervasives_Native.None -> - ((let uu___4 = FStarC_Compiler_Effect.op_Bang dbg_Coercions in + ((let uu___4 = FStarC_Effect.op_Bang dbg_Coercions in if uu___4 then let uu___5 = - FStarC_Compiler_Range_Ops.string_of_range + FStarC_Range_Ops.string_of_range e.FStarC_Syntax_Syntax.pos in - FStarC_Compiler_Util.print1 - "(%s) No user coercion found\n" uu___5 + FStarC_Util.print1 "(%s) No user coercion found\n" + uu___5 else ()); (let strip_hide_or_reveal e1 hide_or_reveal = let uu___4 = @@ -5943,7 +5896,7 @@ let (maybe_coerce_lc : let uu___7 = strip_hide_or_reveal e FStarC_Parser_Const.reveal in - FStarC_Compiler_Util.dflt e_hide uu___7 in + FStarC_Util.dflt e_hide uu___7 in (e_hide1, lc1, g1))) | (Yes ty, No) -> let u = env.FStarC_TypeChecker_Env.universe_of env ty in @@ -5960,7 +5913,7 @@ let (maybe_coerce_lc : let uu___6 = strip_hide_or_reveal e FStarC_Parser_Const.hide in - FStarC_Compiler_Util.dflt e_reveal uu___6 in + FStarC_Util.dflt e_reveal uu___6 in (e_reveal1, lc1, FStarC_TypeChecker_Env.trivial_guard)) | uu___5 -> (e, lc, FStarC_TypeChecker_Env.trivial_guard))))) @@ -5978,7 +5931,7 @@ let (weaken_result_typ : fun lc -> fun t -> fun use_eq -> - (let uu___1 = FStarC_Compiler_Debug.high () in + (let uu___1 = FStarC_Debug.high () in if uu___1 then let uu___2 = @@ -5989,7 +5942,7 @@ let (weaken_result_typ : let uu___4 = FStarC_TypeChecker_Common.lcomp_to_string lc in let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "weaken_result_typ use_eq=%s e=(%s) lc=(%s) t=(%s)\n" uu___2 uu___3 uu___4 uu___5 else ()); @@ -6000,8 +5953,8 @@ let (weaken_result_typ : lc.FStarC_TypeChecker_Common.eff_name in match uu___1 with | FStar_Pervasives_Native.Some (ed, qualifiers) -> - FStarC_Compiler_List.contains - FStarC_Syntax_Syntax.Reifiable qualifiers + FStarC_List.contains FStarC_Syntax_Syntax.Reifiable + qualifiers | uu___2 -> false) in let gopt = if use_eq1 @@ -6055,7 +6008,7 @@ let (weaken_result_typ : FStarC_TypeChecker_TermEqAndSimplify.Equal in if uu___4 then - ((let uu___6 = FStarC_Compiler_Debug.extreme () in + ((let uu___6 = FStarC_Debug.extreme () in if uu___6 then let uu___7 = @@ -6064,7 +6017,7 @@ let (weaken_result_typ : let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "weaken_result_type::strengthen_trivial: res_t:%s is same as t:%s\n" uu___7 uu___8 else ()); @@ -6089,8 +6042,10 @@ let (weaken_result_typ : res_t in let uu___6 = let uu___7 = + let uu___8 = + FStarC_Syntax_Util.comp_effect_name c in FStarC_TypeChecker_Env.norm_eff_name env - (FStarC_Syntax_Util.comp_effect_name c) in + uu___8 in let uu___8 = FStarC_Syntax_Syntax.bv_to_name x in return_value env uu___7 (comp_univ_opt c) @@ -6110,8 +6065,7 @@ let (weaken_result_typ : bind e.FStarC_Syntax_Syntax.pos env (FStar_Pervasives_Native.Some e) uu___7 uu___8 in - ((let uu___8 = - FStarC_Compiler_Debug.extreme () in + ((let uu___8 = FStarC_Debug.extreme () in if uu___8 then let uu___9 = @@ -6129,7 +6083,7 @@ let (weaken_result_typ : let uu___12 = FStarC_TypeChecker_Common.lcomp_to_string lc1 in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "weaken_result_type::strengthen_trivial: inserting a return for e: %s, c: %s, t: %s, and then post return lc: %s\n" uu___9 uu___10 uu___11 uu___12 else ()); @@ -6144,8 +6098,7 @@ let (weaken_result_typ : [g_c; gret; g_lc] in (uu___9, uu___10))) else - ((let uu___8 = - FStarC_Compiler_Debug.extreme () in + ((let uu___8 = FStarC_Debug.extreme () in if uu___8 then let uu___9 = @@ -6155,7 +6108,7 @@ let (weaken_result_typ : let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in - FStarC_Compiler_Util.print2 + FStarC_Util.print2 "weaken_result_type::strengthen_trivial: res_t:%s is not a refinement, leaving c:%s as is\n" uu___9 uu___10 else ()); @@ -6228,8 +6181,7 @@ let (weaken_result_typ : FStarC_TypeChecker_Common.lcomp_comp lc in (match uu___7 with | (c, g_c) -> - ((let uu___9 = - FStarC_Compiler_Debug.extreme () in + ((let uu___9 = FStarC_Debug.extreme () in if uu___9 then let uu___10 = @@ -6245,7 +6197,7 @@ let (weaken_result_typ : let uu___13 = FStarC_TypeChecker_Normalize.term_to_string env f1 in - FStarC_Compiler_Util.print4 + FStarC_Util.print4 "Weakened from %s to %s\nStrengthening %s with guard %s\n" uu___10 uu___11 uu___12 uu___13 else ()); @@ -6258,10 +6210,11 @@ let (weaken_result_typ : FStarC_Syntax_Syntax.bv_to_name x in let uu___9 = let uu___10 = + let uu___11 = + FStarC_Syntax_Util.comp_effect_name + c in FStarC_TypeChecker_Env.norm_eff_name - env - (FStarC_Syntax_Util.comp_effect_name - c) in + env uu___11 in return_value env uu___10 u_t_opt t xexp in match uu___9 with @@ -6332,14 +6285,14 @@ let (weaken_result_typ : (match uu___11 with | (c2, g_lc) -> ((let uu___13 = - FStarC_Compiler_Debug.extreme + FStarC_Debug.extreme () in if uu___13 then let uu___14 = FStarC_TypeChecker_Normalize.comp_to_string env c2 in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "Strengthened to %s\n" uu___14 else ()); @@ -6348,7 +6301,7 @@ let (weaken_result_typ : [g_c; gret; g_lc] in (c2, uu___13))))))))) in let flags = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___2 -> match uu___2 with | FStarC_Syntax_Syntax.RETURN -> @@ -6407,7 +6360,8 @@ let (pure_or_ghost_pre_and_post : let uu___ = FStarC_Syntax_Util.is_tot_or_gtot_comp comp in if uu___ then - (FStar_Pervasives_Native.None, (FStarC_Syntax_Util.comp_result comp)) + let uu___1 = FStarC_Syntax_Util.comp_result comp in + (FStar_Pervasives_Native.None, uu___1) else (match comp.FStarC_Syntax_Syntax.n with | FStarC_Syntax_Syntax.GTotal uu___2 -> failwith "Impossible" @@ -6436,7 +6390,7 @@ let (pure_or_ghost_pre_and_post : let uu___5 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp comp in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Effect constructor is not fully applied; got %s" uu___5 in FStarC_Errors.raise_error @@ -6536,7 +6490,7 @@ let (norm_reify : t.FStarC_Syntax_Syntax.pos "norm_reify" env t; (let t' = FStarC_TypeChecker_Normalize.normalize - (FStarC_Compiler_List.op_At + (FStarC_List.op_At [FStarC_TypeChecker_Env.Beta; FStarC_TypeChecker_Env.Reify; FStarC_TypeChecker_Env.Eager_unfolding; @@ -6544,15 +6498,14 @@ let (norm_reify : FStarC_TypeChecker_Env.AllowUnboundUniverses; FStarC_TypeChecker_Env.Exclude FStarC_TypeChecker_Env.Zeta] steps) env t in - (let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_SMTEncodingReify in + (let uu___2 = FStarC_Effect.op_Bang dbg_SMTEncodingReify in if uu___2 then let uu___3 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t' in - FStarC_Compiler_Util.print2 "Reified body %s \nto %s\n" uu___3 - uu___4 + FStarC_Util.print2 "Reified body %s \nto %s\n" uu___3 uu___4 else ()); t') let (remove_reify : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = @@ -6600,7 +6553,7 @@ let (maybe_implicit_with_meta_or_attr : | uu___ -> false let (instantiate_one_binder : FStarC_TypeChecker_Env.env_t -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Syntax_Syntax.binder -> (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.typ * FStarC_Syntax_Syntax.aqual * FStarC_TypeChecker_Env.guard_t)) @@ -6608,12 +6561,12 @@ let (instantiate_one_binder : fun env -> fun r -> fun b -> - (let uu___1 = FStarC_Compiler_Debug.high () in + (let uu___1 = FStarC_Debug.high () in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "instantiate_one_binder: Instantiating implicit binder %s\n" uu___2 else ()); @@ -6651,7 +6604,7 @@ let (instantiate_one_binder : let aq = FStarC_Syntax_Util.aqual_of_binder b in let arg = (varg, aq) in let r1 = (varg, t, aq, implicits) in - ((let uu___9 = FStarC_Compiler_Debug.high () in + ((let uu___9 = FStarC_Debug.high () in if uu___9 then let uu___10 = @@ -6663,7 +6616,7 @@ let (instantiate_one_binder : r1), (FStar_Pervasives_Native.__proj__Mktuple4__item___2 r1)) in - FStarC_Compiler_Util.print1 + FStarC_Util.print1 "instantiate_one_binder: result = %s\n" uu___10 else ()); r1)))) @@ -6684,7 +6637,7 @@ let (maybe_instantiate : (FStarC_Class_Monoid.mzero FStarC_TypeChecker_Common.monoid_guard_t)) else - ((let uu___2 = FStarC_Compiler_Debug.high () in + ((let uu___2 = FStarC_Debug.high () in if uu___2 then let uu___3 = @@ -6698,7 +6651,7 @@ let (maybe_instantiate : (FStarC_Class_Show.show_tuple2 FStarC_Syntax_Print.showable_term FStarC_Class_Show.showable_bool)) uu___6 in - FStarC_Compiler_Util.print3 + FStarC_Util.print3 "maybe_instantiate: starting check for (%s) of type (%s), expected type is %s\n" uu___3 uu___4 uu___5 else ()); @@ -6713,29 +6666,28 @@ let (maybe_instantiate : | bs'1 -> let uu___3 = FStarC_TypeChecker_Env.push_binders env2 bs'1 in - aux uu___3 (FStarC_Compiler_List.op_At bs bs'1) t4) in + aux uu___3 (FStarC_List.op_At bs bs'1) t4) in aux env1 [] t1 in let number_of_implicits t1 = let formals = unfolded_arrow_formals env t1 in let n_implicits = let uu___2 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun uu___3 -> match uu___3 with | { FStarC_Syntax_Syntax.binder_bv = uu___4; FStarC_Syntax_Syntax.binder_qual = imp; FStarC_Syntax_Syntax.binder_positivity = uu___5; FStarC_Syntax_Syntax.binder_attrs = uu___6;_} -> - (FStarC_Compiler_Option.isNone imp) || + (FStarC_Option.isNone imp) || (FStarC_Syntax_Util.eq_bqual imp (FStar_Pervasives_Native.Some FStarC_Syntax_Syntax.Equality))) formals in match uu___2 with - | FStar_Pervasives_Native.None -> - FStarC_Compiler_List.length formals + | FStar_Pervasives_Native.None -> FStarC_List.length formals | FStar_Pervasives_Native.Some (implicits, _first_explicit, _rest) -> - FStarC_Compiler_List.length implicits in + FStarC_List.length implicits in n_implicits in let inst_n_binders t1 = let uu___2 = FStarC_TypeChecker_Env.expected_typ env in @@ -6813,7 +6765,7 @@ let (maybe_instantiate : FStarC_Syntax_Syntax.binder_positivity = uu___6; FStarC_Syntax_Syntax.binder_attrs = uu___7;_}::rest) -> - let b = FStarC_Compiler_List.hd bs2 in + let b = FStarC_List.hd bs2 in let b1 = FStarC_Syntax_Subst.subst_binder subst b in let uu___8 = instantiate_one_binder env @@ -6843,7 +6795,7 @@ let (maybe_instantiate : FStarC_Syntax_Syntax.binder_positivity = uu___6; FStarC_Syntax_Syntax.binder_attrs = uu___7;_}::rest) -> - let b = FStarC_Compiler_List.hd bs2 in + let b = FStarC_List.hd bs2 in let b1 = FStarC_Syntax_Subst.subst_binder subst b in let uu___8 = instantiate_one_binder env @@ -6872,7 +6824,7 @@ let (maybe_instantiate : FStarC_Syntax_Syntax.binder_attrs = uu___7::uu___8;_}::rest) -> - let b = FStarC_Compiler_List.hd bs2 in + let b = FStarC_List.hd bs2 in let b1 = FStarC_Syntax_Subst.subst_binder subst b in let uu___9 = instantiate_one_binder env @@ -6985,13 +6937,12 @@ let (check_has_type_maybe_coerce : let g = check_has_type env1 e1 lc1.FStarC_TypeChecker_Common.res_typ t2 use_eq in - ((let uu___2 = FStarC_Compiler_Effect.op_Bang dbg_Rel in + ((let uu___2 = FStarC_Effect.op_Bang dbg_Rel in if uu___2 then let uu___3 = FStarC_TypeChecker_Rel.guard_to_string env1 g in - FStarC_Compiler_Util.print1 "Applied guard is %s\n" - uu___3 + FStarC_Util.print1 "Applied guard is %s\n" uu___3 else ()); (let uu___2 = FStarC_TypeChecker_Env.conj_guard g g_c in (e1, lc1, uu___2))) @@ -7006,12 +6957,11 @@ let (check_top_level : fun lc -> FStarC_Errors.with_ctx "While checking for top-level effects" (fun uu___ -> - (let uu___2 = FStarC_Compiler_Debug.medium () in + (let uu___2 = FStarC_Debug.medium () in if uu___2 then let uu___3 = FStarC_TypeChecker_Common.lcomp_to_string lc in - FStarC_Compiler_Util.print1 "check_top_level, lc = %s\n" - uu___3 + FStarC_Util.print1 "check_top_level, lc = %s\n" uu___3 else ()); (let discharge g1 = FStarC_TypeChecker_Rel.force_trivial_guard env g1; @@ -7056,7 +7006,7 @@ let (check_top_level : let uu___6 = FStarC_TypeChecker_Env.get_range env in let uu___7 = let uu___8 = FStarC_Ident.string_of_lid c_eff in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Indexed effect %s cannot be used as a top-level effect" uu___8 in FStarC_Errors.raise_error @@ -7084,7 +7034,7 @@ let (check_top_level : top_level_eff in let uu___10 = FStarC_Ident.string_of_lid c_eff in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Could not find top-level effect abbreviation %s for %s" uu___9 uu___10 in FStarC_Errors.raise_error @@ -7096,7 +7046,7 @@ let (check_top_level : (Obj.magic uu___8) | FStar_Pervasives_Native.Some (bs, uu___8) -> let debug = - FStarC_Compiler_Effect.op_Bang + FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let uu___9 = FStarC_Syntax_Subst.open_binders bs in @@ -7104,35 +7054,44 @@ let (check_top_level : | a::bs1 -> let uu___10 = let uu___11 = + let uu___12 = + let uu___13 = + let uu___14 = + FStarC_Syntax_Util.comp_result + c2 in + ((a.FStarC_Syntax_Syntax.binder_bv), + uu___14) in + FStarC_Syntax_Syntax.NT uu___13 in + [uu___12] in + let uu___12 = FStarC_TypeChecker_Env.get_range env in FStarC_TypeChecker_Env.uvars_for_binders - env bs1 - [FStarC_Syntax_Syntax.NT - ((a.FStarC_Syntax_Syntax.binder_bv), - (FStarC_Syntax_Util.comp_result - c2))] + env bs1 uu___11 (fun b -> if debug then - let uu___12 = + let uu___13 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - let uu___13 = + let uu___14 = FStarC_Ident.string_of_lid top_level_eff in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "implicit for binder %s in effect abbreviation %s while checking top-level effect" - uu___12 uu___13 + uu___13 uu___14 else "check_top_level") - uu___11 in + uu___12 in (match uu___10 with | (uvs, g_uvs) -> let top_level_comp = let uu___11 = let uu___12 = - FStarC_Compiler_List.map + FStarC_Syntax_Util.comp_result + c2 in + let uu___13 = + FStarC_List.map FStarC_Syntax_Syntax.as_arg uvs in { @@ -7141,11 +7100,9 @@ let (check_top_level : FStarC_Syntax_Syntax.effect_name = top_level_eff; FStarC_Syntax_Syntax.result_typ - = - (FStarC_Syntax_Util.comp_result - c2); - FStarC_Syntax_Syntax.effect_args = uu___12; + FStarC_Syntax_Syntax.effect_args + = uu___13; FStarC_Syntax_Syntax.flags = [] } in @@ -7166,7 +7123,7 @@ let (check_top_level : FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c2 in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Could not unify %s and %s when checking top-level effect" uu___12 uu___13 in FStarC_Errors.raise_error @@ -7198,15 +7155,14 @@ let (check_top_level : match uu___7 with | (ct, vc, g_pre) -> ((let uu___9 = - FStarC_Compiler_Effect.op_Bang - dbg_Simplification in + FStarC_Effect.op_Bang dbg_Simplification in if uu___9 then let uu___10 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term vc in - FStarC_Compiler_Util.print1 - "top-level VC: %s\n" uu___10 + FStarC_Util.print1 "top-level VC: %s\n" + uu___10 else ()); (let uu___9 = let uu___10 = @@ -7279,7 +7235,7 @@ let (short_circuit : | FStarC_Syntax_Syntax.Tm_fvar fv -> let lid = (fv.FStarC_Syntax_Syntax.fv_name).FStarC_Syntax_Syntax.v in let uu___ = - FStarC_Compiler_Util.find_map table + FStarC_Util.find_map table (fun uu___1 -> match uu___1 with | (x, mk) -> @@ -7301,7 +7257,7 @@ let (short_circuit_head : FStarC_Syntax_Syntax.term -> Prims.bool) = uu___1.FStarC_Syntax_Syntax.n in match uu___ with | FStarC_Syntax_Syntax.Tm_fvar fv -> - FStarC_Compiler_Util.for_some (FStarC_Syntax_Syntax.fv_eq_lid fv) + FStarC_Util.for_some (FStarC_Syntax_Syntax.fv_eq_lid fv) [FStarC_Parser_Const.op_And; FStarC_Parser_Const.op_Or; FStarC_Parser_Const.and_lid; @@ -7351,7 +7307,7 @@ let (maybe_add_implicit_binders : FStarC_Syntax_Syntax.comp = uu___4;_} -> let uu___5 = - FStarC_Compiler_Util.prefix_until + FStarC_Util.prefix_until (fun b -> let uu___6 = is_implicit_binder b in Prims.op_Negation uu___6) bs' in @@ -7362,7 +7318,7 @@ let (maybe_add_implicit_binders : | FStar_Pervasives_Native.Some (imps, uu___6, uu___7) -> let r = pos bs in let imps1 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> let uu___8 = FStarC_Syntax_Syntax.set_range_of_bv @@ -7376,7 +7332,7 @@ let (maybe_add_implicit_binders : FStarC_Syntax_Syntax.binder_attrs = (b.FStarC_Syntax_Syntax.binder_attrs) }) imps in - FStarC_Compiler_List.op_At imps1 bs) + FStarC_List.op_At imps1 bs) | uu___4 -> bs)) let (must_erase_for_extraction : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.term -> Prims.bool) = @@ -7392,11 +7348,11 @@ let (must_erase_for_extraction : (match uu___2 with | (bs, c) -> let env1 = FStarC_TypeChecker_Env.push_binders env bs in - (FStarC_TypeChecker_Env.is_erasable_effect env1 - (FStarC_Syntax_Util.comp_effect_name c)) - || + (let uu___3 = FStarC_Syntax_Util.comp_effect_name c in + FStarC_TypeChecker_Env.is_erasable_effect env1 uu___3) || ((FStarC_Syntax_Util.is_pure_or_ghost_comp c) && - (aux env1 (FStarC_Syntax_Util.comp_result c)))) + (let uu___3 = FStarC_Syntax_Util.comp_result c in + aux env1 uu___3))) | FStarC_Syntax_Syntax.Tm_refine { FStarC_Syntax_Syntax.b = @@ -7429,12 +7385,12 @@ let (must_erase_for_extraction : FStarC_TypeChecker_Env.Unascribe] env t1 in let res = (FStarC_TypeChecker_Env.non_informative env t2) || (descend env t2) in - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_Extraction in + (let uu___1 = FStarC_Effect.op_Bang dbg_Extraction in if uu___1 then let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 "must_erase=%s: %s\n" + FStarC_Util.print2 "must_erase=%s: %s\n" (if res then "true" else "false") uu___2 else ()); res in @@ -7451,7 +7407,7 @@ let (effect_extraction_mode : uu___.FStarC_Syntax_Syntax.extraction_mode let (fresh_effect_repr : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Ident.lident -> FStarC_Syntax_Syntax.tscheme -> FStarC_Syntax_Syntax.tscheme FStar_Pervasives_Native.option -> @@ -7472,8 +7428,7 @@ let (fresh_effect_repr : let uu___ = FStarC_TypeChecker_Env.inst_tscheme signature_ts in match uu___ with | (uu___1, signature) -> - let debug = - FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let uu___2 = let uu___3 = FStarC_Syntax_Subst.compress signature in uu___3.FStarC_Syntax_Syntax.n in @@ -7501,9 +7456,8 @@ let (fresh_effect_repr : let uu___6 = FStarC_Ident.string_of_lid eff_name in let uu___7 = - FStarC_Compiler_Range_Ops.string_of_range - r in - FStarC_Compiler_Util.format3 + FStarC_Range_Ops.string_of_range r in + FStarC_Util.format3 "uvar for binder %s when creating a fresh repr for %s at %s" uu___5 uu___6 uu___7 else "fresh_effect_repr") r in @@ -7515,7 +7469,7 @@ let (fresh_effect_repr : let eff_c = let uu___6 = let uu___7 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg is in { @@ -7556,7 +7510,7 @@ let (fresh_effect_repr : repr_ts [u] in FStar_Pervasives_Native.snd uu___6 in let is_args = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun i -> fun b -> let uu___6 = @@ -7574,7 +7528,7 @@ let (fresh_effect_repr : | uu___3 -> fail signature) let (fresh_effect_repr_en : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Ident.lident -> FStarC_Syntax_Syntax.universe -> FStarC_Syntax_Syntax.term -> @@ -7593,7 +7547,7 @@ let (fresh_effect_repr_en : fresh_effect_repr env r eff_name uu___1 uu___2 u a_tm let (layered_effect_indices_as_binders : FStarC_TypeChecker_Env.env -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> FStarC_Ident.lident -> FStarC_Syntax_Syntax.tscheme -> FStarC_Syntax_Syntax.universe -> @@ -7634,7 +7588,7 @@ let (check_non_informative_type_for_lift : FStarC_TypeChecker_Env.env -> FStarC_Ident.lident -> FStarC_Ident.lident -> - FStarC_Syntax_Syntax.term -> FStarC_Compiler_Range_Type.range -> unit) + FStarC_Syntax_Syntax.term -> FStarC_Range_Type.range -> unit) = fun env -> fun m1 -> @@ -7657,7 +7611,7 @@ let (check_non_informative_type_for_lift : let uu___3 = FStarC_Ident.string_of_lid m2 in let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Cannot lift erasable expression from %s ~> %s since its type %s is informative" uu___2 uu___3 uu___4 in FStarC_Errors.raise_error FStarC_Class_HasRange.hasRange_range @@ -7670,7 +7624,7 @@ let (substitutive_indexed_lift_substs : FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.comp_typ -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.subst_elt Prims.list * FStarC_TypeChecker_Env.guard_t)) = @@ -7679,7 +7633,7 @@ let (substitutive_indexed_lift_substs : fun ct -> fun lift_name -> fun r -> - let debug = FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let uu___ = let uu___1 = bs in match uu___1 with @@ -7692,14 +7646,12 @@ let (substitutive_indexed_lift_substs : | (bs1, subst) -> let uu___1 = let m_num_effect_args = - FStarC_Compiler_List.length - ct.FStarC_Syntax_Syntax.effect_args in - let uu___2 = - FStarC_Compiler_List.splitAt m_num_effect_args bs1 in + FStarC_List.length ct.FStarC_Syntax_Syntax.effect_args in + let uu___2 = FStarC_List.splitAt m_num_effect_args bs1 in match uu___2 with | (f_bs, bs2) -> let f_subst = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun f_b -> fun uu___3 -> match uu___3 with @@ -7708,16 +7660,15 @@ let (substitutive_indexed_lift_substs : ((f_b.FStarC_Syntax_Syntax.binder_bv), arg)) f_bs ct.FStarC_Syntax_Syntax.effect_args in - (bs2, (FStarC_Compiler_List.op_At subst f_subst)) in + (bs2, (FStarC_List.op_At subst f_subst)) in (match uu___1 with | (bs2, subst1) -> let bs3 = let uu___2 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs2) - Prims.int_one) - bs2 in + FStarC_List.splitAt + ((FStarC_List.length bs2) - Prims.int_one) bs2 in FStar_Pervasives_Native.fst uu___2 in - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___2 -> fun b -> match uu___2 with @@ -7733,9 +7684,8 @@ let (substitutive_indexed_lift_substs : FStarC_Syntax_Print.showable_binder b1 in let uu___5 = - FStarC_Compiler_Range_Ops.string_of_range - r in - FStarC_Compiler_Util.format3 + FStarC_Range_Ops.string_of_range r in + FStarC_Util.format3 "implicit var for additional lift binder %s of %s at %s)" uu___4 lift_name uu___5 else @@ -7746,7 +7696,7 @@ let (substitutive_indexed_lift_substs : let uu___4 = FStarC_TypeChecker_Env.conj_guard g g_uv in - ((FStarC_Compiler_List.op_At subst2 + ((FStarC_List.op_At subst2 [FStarC_Syntax_Syntax.NT ((b.FStarC_Syntax_Syntax.binder_bv), uv_t)]), uu___4))) @@ -7756,7 +7706,7 @@ let (ad_hoc_indexed_lift_substs : FStarC_Syntax_Syntax.binders -> FStarC_Syntax_Syntax.comp_typ -> Prims.string -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_Syntax.subst_elt Prims.list * FStarC_TypeChecker_Env.guard_t)) = @@ -7765,20 +7715,19 @@ let (ad_hoc_indexed_lift_substs : fun ct -> fun lift_name -> fun r -> - let debug = FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in let lift_t_shape_error s = - FStarC_Compiler_Util.format2 - "Lift %s has unexpected shape, reason: %s" lift_name s in + FStarC_Util.format2 "Lift %s has unexpected shape, reason: %s" + lift_name s in let uu___ = - if (FStarC_Compiler_List.length bs) >= (Prims.of_int (2)) + if (FStarC_List.length bs) >= (Prims.of_int (2)) then let uu___1 = bs in match uu___1 with | a_b::bs1 -> let uu___2 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs1) - Prims.int_one) - bs1 in + FStarC_List.splitAt + ((FStarC_List.length bs1) - Prims.int_one) bs1 in (a_b, uu___2) else (let uu___2 = @@ -7802,16 +7751,15 @@ let (ad_hoc_indexed_lift_substs : let uu___2 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_binder b in - let uu___3 = - FStarC_Compiler_Range_Ops.string_of_range r in - FStarC_Compiler_Util.format3 + let uu___3 = FStarC_Range_Ops.string_of_range r in + FStarC_Util.format3 "implicit var for binder %s of %s at %s" uu___2 lift_name uu___3 else "ad_hoc_indexed_lift_substs") r in (match uu___1 with | (rest_bs_uvars, g) -> let substs = - FStarC_Compiler_List.map2 + FStarC_List.map2 (fun b -> fun t -> FStarC_Syntax_Syntax.NT @@ -7830,9 +7778,9 @@ let (ad_hoc_indexed_lift_substs : ct.FStarC_Syntax_Syntax.effect_name in effect_args_from_repr f_sort uu___2 r in let uu___2 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst + FStarC_List.map FStar_Pervasives_Native.fst ct.FStarC_Syntax_Syntax.effect_args in - FStarC_Compiler_List.fold_left2 + FStarC_List.fold_left2 (fun g1 -> fun i1 -> fun i2 -> @@ -7858,15 +7806,15 @@ let (lift_tf_layered_effect : fun kind -> fun env -> fun c -> - let debug = FStarC_Compiler_Effect.op_Bang dbg_LayeredEffectsApp in + let debug = FStarC_Effect.op_Bang dbg_LayeredEffectsApp in if debug then (let uu___1 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c in let uu___2 = FStarC_Class_Show.show FStarC_Ident.showable_lident tgt in - FStarC_Compiler_Util.print2 - "Lifting indexed comp %s to %s {\n" uu___1 uu___2) + FStarC_Util.print2 "Lifting indexed comp %s to %s {\n" uu___1 + uu___2) else (); (let r = FStarC_TypeChecker_Env.get_range env in let ct = FStarC_TypeChecker_Env.comp_to_comp_typ env c in @@ -7880,13 +7828,12 @@ let (lift_tf_layered_effect : FStarC_Ident.string_of_lid ct.FStarC_Syntax_Syntax.effect_name in let uu___4 = FStarC_Ident.string_of_lid tgt in - FStarC_Compiler_Util.format2 "%s ~> %s" uu___3 uu___4 + FStarC_Util.format2 "%s ~> %s" uu___3 uu___4 else "" in let uu___2 = let uu___3 = let uu___4 = - FStarC_Compiler_List.hd - ct.FStarC_Syntax_Syntax.comp_univs in + FStarC_List.hd ct.FStarC_Syntax_Syntax.comp_univs in [uu___4] in FStarC_TypeChecker_Env.inst_tscheme_with lift_ts uu___3 in match uu___2 with @@ -7920,11 +7867,11 @@ let (lift_tf_layered_effect : let fml = let uu___6 = let uu___7 = - FStarC_Compiler_List.hd + FStarC_List.hd lift_ct.FStarC_Syntax_Syntax.comp_univs in let uu___8 = let uu___9 = - FStarC_Compiler_List.hd + FStarC_List.hd lift_ct.FStarC_Syntax_Syntax.effect_args in FStar_Pervasives_Native.fst uu___9 in (uu___7, uu___8) in @@ -7933,23 +7880,22 @@ let (lift_tf_layered_effect : FStarC_TypeChecker_Env.pure_precondition_for_trivial_post env u lift_ct.FStarC_Syntax_Syntax.result_typ - wp FStarC_Compiler_Range_Type.dummyRange in + wp FStarC_Range_Type.dummyRange in ((let uu___7 = - (FStarC_Compiler_Effect.op_Bang - dbg_LayeredEffects) - && (FStarC_Compiler_Debug.extreme ()) in + (FStarC_Effect.op_Bang dbg_LayeredEffects) && + (FStarC_Debug.extreme ()) in if uu___7 then let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term fml in - FStarC_Compiler_Util.print1 - "Guard for lift is: %s" uu___8 + FStarC_Util.print1 "Guard for lift is: %s" + uu___8 else ()); (let c1 = let uu___7 = let uu___8 = - FStarC_Compiler_List.map + FStarC_List.map FStarC_Syntax_Syntax.as_arg is in { FStarC_Syntax_Syntax.comp_univs = @@ -7966,8 +7912,8 @@ let (lift_tf_layered_effect : (let uu___8 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_comp c1 in - FStarC_Compiler_Util.print1 - "} Lifted comp: %s\n" uu___8) + FStarC_Util.print1 "} Lifted comp: %s\n" + uu___8) else (); (let g1 = let uu___8 = @@ -7995,13 +7941,11 @@ let lift_tf_layered_effect_term : fun e -> let lift = let uu___ = - let uu___1 = - FStarC_Compiler_Util.must sub.FStarC_Syntax_Syntax.lift in + let uu___1 = FStarC_Util.must sub.FStarC_Syntax_Syntax.lift in FStarC_TypeChecker_Env.inst_tscheme_with uu___1 [u] in FStar_Pervasives_Native.snd uu___ in let rest_bs = - let lift_t = - FStarC_Compiler_Util.must sub.FStarC_Syntax_Syntax.lift_wp in + let lift_t = FStarC_Util.must sub.FStarC_Syntax_Syntax.lift_wp in let uu___ = let uu___1 = FStarC_Syntax_Subst.compress @@ -8011,15 +7955,15 @@ let lift_tf_layered_effect_term : | FStarC_Syntax_Syntax.Tm_arrow { FStarC_Syntax_Syntax.bs1 = uu___1::bs; FStarC_Syntax_Syntax.comp = uu___2;_} - when (FStarC_Compiler_List.length bs) >= Prims.int_one -> + when (FStarC_List.length bs) >= Prims.int_one -> let uu___3 = - FStarC_Compiler_List.splitAt - ((FStarC_Compiler_List.length bs) - Prims.int_one) bs in + FStarC_List.splitAt + ((FStarC_List.length bs) - Prims.int_one) bs in FStar_Pervasives_Native.fst uu___3 | uu___1 -> let uu___2 = let uu___3 = FStarC_Syntax_Print.tscheme_to_string lift_t in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "lift_t tscheme %s is not an arrow with enough binders" uu___3 in FStarC_Errors.raise_error @@ -8032,13 +7976,13 @@ let lift_tf_layered_effect_term : let uu___ = FStarC_Syntax_Syntax.as_arg a in let uu___1 = let uu___2 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___3 -> FStarC_Syntax_Syntax.as_arg FStarC_Syntax_Syntax.unit_const) rest_bs in let uu___3 = let uu___4 = FStarC_Syntax_Syntax.as_arg e in [uu___4] in - FStarC_Compiler_List.op_At uu___2 uu___3 in + FStarC_List.op_At uu___2 uu___3 in uu___ :: uu___1 in FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_app @@ -8064,7 +8008,7 @@ let (get_field_projector_name : FStarC_Class_Show.show FStarC_Class_Show.showable_int n in let uu___5 = FStarC_Class_Show.show FStarC_Class_Show.showable_int index in - FStarC_Compiler_Util.format3 + FStarC_Util.format3 "Data constructor %s does not have enough binders (has %s, tried %s)" uu___3 uu___4 uu___5 in FStarC_Errors.raise_error FStarC_TypeChecker_Env.hasRange_env @@ -8080,7 +8024,7 @@ let (get_field_projector_name : FStarC_Syntax_Syntax.comp = uu___3;_} -> let bs1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun uu___4 -> match uu___4 with | { FStarC_Syntax_Syntax.binder_bv = uu___5; @@ -8092,10 +8036,10 @@ let (get_field_projector_name : (FStarC_Syntax_Syntax.Implicit (true)) -> false | uu___8 -> true)) bs in - if (FStarC_Compiler_List.length bs1) <= index - then err (FStarC_Compiler_List.length bs1) + if (FStarC_List.length bs1) <= index + then err (FStarC_List.length bs1) else - (let b = FStarC_Compiler_List.nth bs1 index in + (let b = FStarC_List.nth bs1 index in FStarC_Syntax_Util.mk_field_projector_name datacon b.FStarC_Syntax_Syntax.binder_bv index) | uu___3 -> err Prims.int_zero) @@ -8114,10 +8058,8 @@ let (get_mlift_for_subeff : if uu___ then let uu___1 = - let uu___2 = - FStarC_Compiler_Util.must sub.FStarC_Syntax_Syntax.lift_wp in - let uu___3 = - FStarC_Compiler_Util.must sub.FStarC_Syntax_Syntax.kind in + let uu___2 = FStarC_Util.must sub.FStarC_Syntax_Syntax.lift_wp in + let uu___3 = FStarC_Util.must sub.FStarC_Syntax_Syntax.kind in lift_tf_layered_effect sub.FStarC_Syntax_Syntax.target uu___2 uu___3 in { @@ -8139,8 +8081,7 @@ let (get_mlift_for_subeff : ct.FStarC_Syntax_Syntax.comp_univs in match uu___3 with | (uu___4, lift_t) -> - let wp = - FStarC_Compiler_List.hd ct.FStarC_Syntax_Syntax.effect_args in + let wp = FStarC_List.hd ct.FStarC_Syntax_Syntax.effect_args in let uu___5 = let uu___6 = let uu___7 = @@ -8198,8 +8139,7 @@ let (get_mlift_for_subeff : FStarC_Syntax_Syntax.Tm_app uu___5 in FStarC_Syntax_Syntax.mk uu___4 e.FStarC_Syntax_Syntax.pos in let uu___2 = - let uu___3 = - FStarC_Compiler_Util.must sub.FStarC_Syntax_Syntax.lift_wp in + let uu___3 = FStarC_Util.must sub.FStarC_Syntax_Syntax.lift_wp in mk_mlift_wp uu___3 in { FStarC_TypeChecker_Env.mlift_wp = uu___2; @@ -8208,15 +8148,14 @@ let (get_mlift_for_subeff : | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.Some ((fun uu___3 -> - fun uu___4 -> - fun e -> FStarC_Compiler_Util.return_all e)) + fun uu___4 -> fun e -> FStarC_Util.return_all e)) | FStar_Pervasives_Native.Some ts -> FStar_Pervasives_Native.Some (mk_mlift_term ts)) }) let (update_env_sub_eff : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.sub_eff -> - FStarC_Compiler_Range_Type.range -> FStarC_TypeChecker_Env.env) + FStarC_Range_Type.range -> FStarC_TypeChecker_Env.env) = fun env -> fun sub -> @@ -8495,16 +8434,14 @@ let (try_lookup_record_type : let uu___14 = FStarC_Syntax_Util.arrow_formals t in (match uu___14 with | (formals, c) -> - if - nparms < - (FStarC_Compiler_List.length formals) + if nparms < (FStarC_List.length formals) then let uu___15 = - FStarC_Compiler_List.splitAt nparms formals in + FStarC_List.splitAt nparms formals in (match uu___15 with | (uu___16, fields) -> let fields1 = - FStarC_Compiler_List.filter + FStarC_List.filter (fun b -> match b.FStarC_Syntax_Syntax.binder_qual with @@ -8513,7 +8450,7 @@ let (try_lookup_record_type : uu___17) -> false | uu___17 -> true) fields in let fields2 = - FStarC_Compiler_List.map + FStarC_List.map (fun b -> (((b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.ppname), ((b.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort))) @@ -8545,7 +8482,7 @@ let (find_record_or_dc_from_typ : FStarC_TypeChecker_Env.env -> FStarC_Syntax_Syntax.typ FStar_Pervasives_Native.option -> FStarC_Syntax_Syntax.unresolved_constructor -> - FStarC_Compiler_Range_Type.range -> + FStarC_Range_Type.range -> (FStarC_Syntax_DsEnv.record_or_dc * FStarC_Ident.lident * FStarC_Syntax_Syntax.fv)) = @@ -8569,13 +8506,12 @@ let (find_record_or_dc_from_typ : (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___1) | (FStar_Pervasives_Native.None, f::uu___1) -> - let f1 = - FStarC_Compiler_List.hd uc.FStarC_Syntax_Syntax.uc_fields in + let f1 = FStarC_List.hd uc.FStarC_Syntax_Syntax.uc_fields in let uu___2 = let uu___3 = let uu___4 = let uu___5 = FStarC_Ident.string_of_lid f1 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Field name %s could not be resolved." uu___5 in FStarC_Errors_Msg.text uu___4 in [uu___3] in @@ -8590,8 +8526,7 @@ let (find_record_or_dc_from_typ : | FStar_Pervasives_Native.None -> let uu___3 = let uu___4 = FStarC_Ident.string_of_lid tn in - FStarC_Compiler_Util.format1 - "Record name %s not found." uu___4 in + FStarC_Util.format1 "Record name %s not found." uu___4 in FStarC_Errors.raise_error FStarC_Ident.hasrange_lident tn FStarC_Errors_Codes.Fatal_NameNotFound () (Obj.magic FStarC_Errors_Msg.is_error_message_string) @@ -8628,8 +8563,7 @@ let (find_record_or_dc_from_typ : let uu___ = let uu___1 = FStarC_Ident.ns_of_lid rdc.FStarC_Syntax_DsEnv.typename in - FStarC_Compiler_List.op_At uu___1 - [rdc.FStarC_Syntax_DsEnv.constrname] in + FStarC_List.op_At uu___1 [rdc.FStarC_Syntax_DsEnv.constrname] in FStarC_Ident.lid_of_ids uu___ in FStarC_Ident.set_lid_range name rng in let constructor = @@ -8639,7 +8573,7 @@ let (find_record_or_dc_from_typ : let uu___ = let uu___1 = let uu___2 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst + FStarC_List.map FStar_Pervasives_Native.fst rdc.FStarC_Syntax_DsEnv.fields in ((rdc.FStarC_Syntax_DsEnv.typename), uu___2) in FStarC_Syntax_Syntax.Record_ctor uu___1 in @@ -8673,7 +8607,7 @@ let make_record_fields_in_order : FStarC_Syntax_DsEnv.record_or_dc -> (FStarC_Ident.lident * 'a) Prims.list -> (FStarC_Ident.ident -> 'a FStar_Pervasives_Native.option) -> - FStarC_Compiler_Range_Type.range -> 'a Prims.list + FStarC_Range_Type.range -> 'a Prims.list = fun env -> fun uc -> @@ -8692,13 +8626,13 @@ let make_record_fields_in_order : rdc1.FStarC_Syntax_DsEnv.constrname in let uu___3 = let uu___4 = - FStarC_Compiler_List.map + FStarC_List.map (fun uu___5 -> match uu___5 with | (i, uu___6) -> FStarC_Ident.string_of_id i) rdc1.FStarC_Syntax_DsEnv.fields in - FStarC_Compiler_String.concat "; " uu___4 in - FStarC_Compiler_Util.format3 + FStarC_String.concat "; " uu___4 in + FStarC_Util.format3 "{typename=%s; constrname=%s; fields=[%s]}" uu___1 uu___2 uu___3 in let print_topt topt1 = @@ -8709,8 +8643,7 @@ let make_record_fields_in_order : FStarC_Syntax_Print.showable_term FStarC_Syntax_Print.showable_term)) topt1 in let uu___2 = print_rdc rdc in - FStarC_Compiler_Util.format2 "topt=%s; rdc=%s" uu___1 - uu___2 in + FStarC_Util.format2 "topt=%s; rdc=%s" uu___1 uu___2 in let uu___1 = FStarC_Class_Show.show (FStarC_Class_Show.show_option @@ -8725,23 +8658,22 @@ let make_record_fields_in_order : let uu___4 = print_rdc rdc in let uu___5 = let uu___6 = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst - fas in + FStarC_List.map FStar_Pervasives_Native.fst fas in FStarC_Class_Show.show (FStarC_Class_Show.show_list FStarC_Ident.showable_lident) uu___6 in - FStarC_Compiler_Util.print5 + FStarC_Util.print5 "Resolved uc={typename=%s;fields=%s}\n\ttopt=%s\n\t{rdc = %s\n\tfield assignments=[%s]}\n" uu___1 uu___2 uu___3 uu___4 uu___5 in let uu___ = - FStarC_Compiler_List.fold_left + FStarC_List.fold_left (fun uu___1 -> fun uu___2 -> match (uu___1, uu___2) with | ((fields, as_rev, missing), (field_name, uu___3)) -> let uu___4 = - FStarC_Compiler_List.partition + FStarC_List.partition (fun uu___5 -> match uu___5 with | (fn, uu___6) -> @@ -8768,7 +8700,7 @@ let make_record_fields_in_order : let uu___8 = FStarC_Ident.string_of_lid rdc.FStarC_Syntax_DsEnv.typename in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Field %s of record type %s is given multiple assignments" uu___7 uu___8 in FStarC_Errors.raise_error @@ -8807,7 +8739,7 @@ let make_record_fields_in_order : FStarC_Class_Show.show FStarC_Ident.showable_lident rdc.FStarC_Syntax_DsEnv.typename in - FStarC_Compiler_Util.format2 + FStarC_Util.format2 "Field '%s' is redundant for type %s" uu___8 uu___9 in FStarC_Errors_Msg.text uu___7 in @@ -8838,7 +8770,7 @@ let make_record_fields_in_order : FStarC_Class_Show.show FStarC_Ident.showable_lident rdc.FStarC_Syntax_DsEnv.typename in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Missing fields for record type '%s':" uu___7 in FStarC_Errors_Msg.text uu___6 in @@ -8852,4 +8784,4 @@ let make_record_fields_in_order : (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) (Obj.magic uu___3)); - FStarC_Compiler_List.rev as_rev) \ No newline at end of file + FStarC_List.rev as_rev) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Universal.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Universal.ml similarity index 94% rename from stage0/fstar-lib/generated/FStarC_Universal.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Universal.ml index 92bb74b422c..a4deae87fd9 100644 --- a/stage0/fstar-lib/generated/FStarC_Universal.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Universal.ml @@ -797,10 +797,10 @@ let (tc_one_fragment : if uu___ then let uu___1 = FStarC_TypeChecker_Env.get_range env1 in - FStarC_Compiler_Range_Ops.file_of_range uu___1 + FStarC_Range_Ops.file_of_range uu___1 else (let uu___2 = FStarC_Options.file_list () in - FStarC_Compiler_List.hd uu___2) in + FStarC_List.hd uu___2) in let acceptable_mod_name modul = let uu___ = let uu___1 = fname env in @@ -808,7 +808,7 @@ let (tc_one_fragment : let uu___1 = let uu___2 = FStarC_Ident.string_of_lid modul.FStarC_Syntax_Syntax.name in - FStarC_Compiler_String.lowercase uu___2 in + FStarC_String.lowercase uu___2 in uu___ = uu___1 in let range_of_first_mod_decl modul = match modul with @@ -827,13 +827,13 @@ let (tc_one_fragment : FStarC_Parser_AST.interleaved = uu___4;_}::uu___5, uu___6) -> d - | uu___ -> FStarC_Compiler_Range_Type.dummyRange in + | uu___ -> FStarC_Range_Type.dummyRange in let filter_lang_decls d = match d.FStarC_Parser_AST.d with | FStarC_Parser_AST.UseLangDecls uu___ -> true | uu___ -> false in let use_lang_decl ds = - FStarC_Compiler_List.tryFind + FStarC_List.tryFind (fun d -> FStarC_Parser_AST.uu___is_UseLangDecls d.FStarC_Parser_AST.d) ds in @@ -860,7 +860,7 @@ let (tc_one_fragment : let uu___4 = let uu___5 = fname env2 in FStarC_Parser_Dep.module_name_of_file uu___5 in - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Interactive mode only supports a single module at the top-level. Expected module %s" uu___4 in FStarC_Errors.raise_error @@ -887,14 +887,13 @@ let (tc_one_fragment : decls1 | FStarC_Parser_AST.Interface (uu___4, decls1, uu___5) -> decls1 in - FStarC_Compiler_List.filter filter_lang_decls - decls in + FStarC_List.filter filter_lang_decls decls in ((FStar_Pervasives_Native.Some modul1), env3, lang_decls)))) in let check_decls ast_decls = match curmod with | FStar_Pervasives_Native.None -> - let uu___ = FStarC_Compiler_List.hd ast_decls in + let uu___ = FStarC_List.hd ast_decls in (match uu___ with | { FStarC_Parser_AST.d = uu___1; FStarC_Parser_AST.drange = rng; @@ -909,7 +908,7 @@ let (tc_one_fragment : "First statement must be a module declaration")) | FStar_Pervasives_Native.Some modul -> let uu___ = - FStarC_Compiler_Util.fold_map + FStarC_Util.fold_map (fun env1 -> fun a_decl -> let uu___1 = @@ -924,7 +923,7 @@ let (tc_one_fragment : let uu___1 = let uu___2 = FStarC_ToSyntax_ToSyntax.decls_to_sigelts - (FStarC_Compiler_List.flatten ast_decls_l) in + (FStarC_List.flatten ast_decls_l) in with_dsenv_of_tcenv env1 uu___2 in (match uu___1 with | (sigelts, env2) -> @@ -940,8 +939,7 @@ let (tc_one_fragment : (match uu___2 with | (modul1, uu___3, env3) -> let uu___4 = - FStarC_Compiler_List.filter filter_lang_decls - ast_decls in + FStarC_List.filter filter_lang_decls ast_decls in ((FStar_Pervasives_Native.Some modul1), env3, uu___4)))) in match frag with @@ -995,15 +993,14 @@ let (load_interface_decls : FStar_Pervasives_Native.snd uu___2 | FStarC_Parser_ParseIt.ASTFragment uu___ -> let uu___1 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Unexpected result from parsing %s; expected a single interface" interface_file_name in FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_ParseErrors () (Obj.magic FStarC_Errors_Msg.is_error_message_string) (Obj.magic uu___1) | FStarC_Parser_ParseIt.ParseError (err, msg, rng) -> - FStarC_Compiler_Effect.raise - (FStarC_Errors.Error (err, msg, rng, [])) + FStarC_Effect.raise (FStarC_Errors.Error (err, msg, rng, [])) | FStarC_Parser_ParseIt.Term uu___ -> failwith "Impossible: parsing a Toplevel always results in an ASTFragment" @@ -1029,44 +1026,48 @@ let (emit : | FStar_Pervasives_Native.Some (FStarC_Options.FSharp) -> ".fs" | FStar_Pervasives_Native.Some (FStarC_Options.OCaml) -> ".ml" | FStar_Pervasives_Native.Some (FStarC_Options.Plugin) -> ".ml" + | FStar_Pervasives_Native.Some (FStarC_Options.PluginNoLib) -> + ".ml" | FStar_Pervasives_Native.Some (FStarC_Options.Krml) -> ".krml" | FStar_Pervasives_Native.Some (FStarC_Options.Extension) -> ".ast" | uu___ -> fail () in match opt with | FStar_Pervasives_Native.Some (FStarC_Options.FSharp) -> let outdir = FStarC_Options.output_dir () in - let uu___ = - FStarC_Compiler_List.map FStar_Pervasives_Native.snd mllibs in - FStarC_Compiler_List.iter - (FStarC_Extraction_ML_PrintML.print outdir ext) uu___ + let uu___ = FStarC_List.map FStar_Pervasives_Native.snd mllibs in + FStarC_List.iter (FStarC_Extraction_ML_PrintML.print outdir ext) + uu___ | FStar_Pervasives_Native.Some (FStarC_Options.OCaml) -> let outdir = FStarC_Options.output_dir () in - let uu___ = - FStarC_Compiler_List.map FStar_Pervasives_Native.snd mllibs in - FStarC_Compiler_List.iter - (FStarC_Extraction_ML_PrintML.print outdir ext) uu___ + let uu___ = FStarC_List.map FStar_Pervasives_Native.snd mllibs in + FStarC_List.iter (FStarC_Extraction_ML_PrintML.print outdir ext) + uu___ | FStar_Pervasives_Native.Some (FStarC_Options.Plugin) -> let outdir = FStarC_Options.output_dir () in - let uu___ = - FStarC_Compiler_List.map FStar_Pervasives_Native.snd mllibs in - FStarC_Compiler_List.iter - (FStarC_Extraction_ML_PrintML.print outdir ext) uu___ + let uu___ = FStarC_List.map FStar_Pervasives_Native.snd mllibs in + FStarC_List.iter (FStarC_Extraction_ML_PrintML.print outdir ext) + uu___ + | FStar_Pervasives_Native.Some (FStarC_Options.PluginNoLib) -> + let outdir = FStarC_Options.output_dir () in + let uu___ = FStarC_List.map FStar_Pervasives_Native.snd mllibs in + FStarC_List.iter (FStarC_Extraction_ML_PrintML.print outdir ext) + uu___ | FStar_Pervasives_Native.Some (FStarC_Options.Extension) -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun uu___ -> match uu___ with | (env, m) -> let uu___1 = m in (match uu___1 with | FStarC_Extraction_ML_Syntax.MLLib ms -> - FStarC_Compiler_List.iter + FStarC_List.iter (fun m1 -> let uu___2 = m1 in match uu___2 with | (mname, modul, uu___3) -> let filename = - FStarC_Compiler_String.concat "_" - (FStarC_Compiler_List.op_At + FStarC_String.concat "_" + (FStarC_List.op_At (FStar_Pervasives_Native.fst mname) [FStar_Pervasives_Native.snd mname]) in (match modul with @@ -1084,15 +1085,15 @@ let (emit : let uu___5 = FStarC_Find.prepend_output_dir (Prims.strcat filename ext) in - FStarC_Compiler_Util.save_value_to_file - uu___5 (deps, bindings, decls) + FStarC_Util.save_value_to_file uu___5 + (deps, bindings, decls) | FStar_Pervasives_Native.None -> failwith "Unexpected ml modul in Extension extraction mode")) ms)) mllibs | FStar_Pervasives_Native.Some (FStarC_Options.Krml) -> let programs = - FStarC_Compiler_List.collect + FStarC_List.collect (fun uu___ -> match uu___ with | (ue, mllibs1) -> @@ -1109,7 +1110,7 @@ let (emit : | uu___2 -> FStarC_Find.prepend_output_dir (Prims.strcat "out" ext)) in - FStarC_Compiler_Util.save_value_to_file oname bin + FStarC_Util.save_value_to_file oname bin | uu___ -> fail () else () let (tc_one_file : @@ -1150,7 +1151,7 @@ let (tc_one_file : if uu___2 then (FStar_Pervasives_Native.None, Prims.int_zero) else - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___4 -> with_env env1 (fun env2 -> @@ -1164,7 +1165,7 @@ let (tc_one_file : if uu___1 then (env1, Prims.int_zero) else - FStarC_Compiler_Util.record_time_ms + FStarC_Util.record_time_ms (fun uu___3 -> let uu___4 = with_env env1 @@ -1207,7 +1208,7 @@ let (tc_one_file : "Impossible: gamma contains leaked names"); (let uu___6 = FStarC_TypeChecker_Tc.check_module tcenv fmod - (FStarC_Compiler_Util.is_some pre_fn) in + (FStarC_Util.is_some pre_fn) in match uu___6 with | (modul, env3) -> (maybe_restore_opts (); @@ -1247,18 +1248,8 @@ let (tc_one_file : FStarC_CheckedFiles.extraction_time = (extract_time + iface_extraction_time) }, extracted_defs, env3))) in - let uu___3 = - (let uu___4 = - FStarC_Ident.string_of_lid - fmod.FStarC_Syntax_Syntax.name in - FStarC_Options.should_verify uu___4) && - ((FStarC_Options.record_hints ()) || - (FStarC_Options.use_hints ())) in - if uu___3 - then - let uu___4 = FStarC_Parser_ParseIt.find_file fn in - FStarC_SMTEncoding_Solver.with_hints_db uu___4 check_mod - else check_mod () in + let uu___3 = FStarC_Parser_ParseIt.find_file fn in + FStarC_SMTEncoding_Solver.with_hints_db uu___3 check_mod in let uu___1 = let uu___2 = FStarC_Options.cache_off () in Prims.op_Negation uu___2 in @@ -1284,7 +1275,7 @@ let (tc_one_file : let uu___4 = let uu___5 = let uu___6 = - FStarC_Compiler_Util.format1 + FStarC_Util.format1 "Expected %s to already be checked." fn in FStarC_Errors_Msg.text uu___6 in [uu___5] in @@ -1296,7 +1287,7 @@ let (tc_one_file : else ()); (let uu___4 = ((let uu___5 = FStarC_Options.codegen () in - FStarC_Compiler_Option.isSome uu___5) && + FStarC_Option.isSome uu___5) && (FStarC_Options.cmi ())) && (let uu___5 = FStarC_Options.force () in @@ -1310,8 +1301,8 @@ let (tc_one_file : let uu___7 = let uu___8 = let uu___9 = - FStarC_Compiler_Util.format1 - "Module %s was not checked." fn in + FStarC_Util.format1 "Module %s was not checked." + fn in FStarC_Errors_Msg.text uu___9 in [uu___8] in uu___6 :: uu___7 in @@ -1353,8 +1344,8 @@ let (tc_one_file : let uu___4 = FStarC_Class_Show.show FStarC_Syntax_Print.showable_modul tcmod in - FStarC_Compiler_Util.print1 - "Module after type checking:\n%s\n" uu___4 + FStarC_Util.print1 "Module after type checking:\n%s\n" + uu___4 else ()); (let extend_tcenv tcmod1 tcenv = FStarC_SMTEncoding_Z3.refresh @@ -1440,11 +1431,11 @@ let (needs_interleaving : Prims.string -> Prims.string -> Prims.bool) = let m1 = FStarC_Parser_Dep.lowercase_module_name intf in let m2 = FStarC_Parser_Dep.lowercase_module_name impl in ((m1 = m2) && - (let uu___ = FStarC_Compiler_Util.get_file_extension intf in - FStarC_Compiler_List.mem uu___ ["fsti"; "fsi"])) + (let uu___ = FStarC_Util.get_file_extension intf in + FStarC_List.mem uu___ ["fsti"; "fsi"])) && - (let uu___ = FStarC_Compiler_Util.get_file_extension impl in - FStarC_Compiler_List.mem uu___ ["fst"; "fs"]) + (let uu___ = FStarC_Util.get_file_extension impl in + FStarC_List.mem uu___ ["fst"; "fs"]) let (tc_one_file_from_remaining : Prims.string Prims.list -> uenv -> @@ -1514,11 +1505,10 @@ let rec (tc_fold_interleave : FStarC_Profiling.report_and_clear uu___5 else ()); tc_fold_interleave deps - ((FStarC_Compiler_List.op_At mods [nmod]), - (FStarC_Compiler_List.op_At mllibs - (as_list env mllib)), env) remaining1))) -let (dbg_dep : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Debug.get_toggle "Dep" + ((FStarC_List.op_At mods [nmod]), + (FStarC_List.op_At mllibs (as_list env mllib)), + env) remaining1))) +let (dbg_dep : Prims.bool FStarC_Effect.ref) = FStarC_Debug.get_toggle "Dep" let (batch_mode_tc : Prims.string Prims.list -> FStarC_Parser_Dep.deps -> @@ -1526,20 +1516,18 @@ let (batch_mode_tc : = fun filenames -> fun dep_graph -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_dep in + (let uu___1 = FStarC_Effect.op_Bang dbg_dep in if uu___1 then - (FStarC_Compiler_Util.print_endline - "Auto-deps kicked in; here's some info."; - FStarC_Compiler_Util.print1 + (FStarC_Util.print_endline "Auto-deps kicked in; here's some info."; + FStarC_Util.print1 "Here's the list of filenames we will process: %s\n" - (FStarC_Compiler_String.concat " " filenames); + (FStarC_String.concat " " filenames); (let uu___4 = let uu___5 = - FStarC_Compiler_List.filter FStarC_Options.should_verify_file - filenames in - FStarC_Compiler_String.concat " " uu___5 in - FStarC_Compiler_Util.print1 + FStarC_List.filter FStarC_Options.should_verify_file filenames in + FStarC_String.concat " " uu___5 in + FStarC_Util.print1 "Here's the list of modules we will verify: %s\n" uu___4)) else ()); (let env = diff --git a/stage0/fstar-lib/generated/FStarC_VConfig.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_VConfig.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_VConfig.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_VConfig.ml diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Writer.ml b/stage0/dune/fstar-guts/fstarc.ml/FStarC_Writer.ml similarity index 100% rename from stage0/fstar-lib/generated/FStarC_Compiler_Writer.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStarC_Writer.ml diff --git a/stage0/fstar-lib/generated/FStar_Pervasives.ml b/stage0/dune/fstar-guts/fstarc.ml/FStar_Pervasives.ml similarity index 97% rename from stage0/fstar-lib/generated/FStar_Pervasives.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStar_Pervasives.ml index eec9ac907b2..c874e07692c 100644 --- a/stage0/fstar-lib/generated/FStar_Pervasives.ml +++ b/stage0/dune/fstar-guts/fstarc.ml/FStar_Pervasives.ml @@ -22,6 +22,7 @@ type norm_step = | Reify | NormDebug | UnfoldOnly of Prims.string Prims.list + | UnfoldOnce of Prims.string Prims.list | UnfoldFully of Prims.string Prims.list | UnfoldAttr of Prims.string Prims.list | UnfoldQual of Prims.string Prims.list @@ -55,6 +56,11 @@ let (uu___is_UnfoldOnly : norm_step -> Prims.bool) = match projectee with | UnfoldOnly _0 -> true | uu___ -> false let (__proj__UnfoldOnly__item___0 : norm_step -> Prims.string Prims.list) = fun projectee -> match projectee with | UnfoldOnly _0 -> _0 +let (uu___is_UnfoldOnce : norm_step -> Prims.bool) = + fun projectee -> + match projectee with | UnfoldOnce _0 -> true | uu___ -> false +let (__proj__UnfoldOnce__item___0 : norm_step -> Prims.string Prims.list) = + fun projectee -> match projectee with | UnfoldOnce _0 -> _0 let (uu___is_UnfoldFully : norm_step -> Prims.bool) = fun projectee -> match projectee with | UnfoldFully _0 -> true | uu___ -> false @@ -93,6 +99,8 @@ let (nbe : norm_step) = NBE let (reify_ : norm_step) = Reify let (delta_only : Prims.string Prims.list -> norm_step) = fun s -> UnfoldOnly s +let (delta_once : Prims.string Prims.list -> norm_step) = + fun s -> UnfoldOnce s let (delta_fully : Prims.string Prims.list -> norm_step) = fun s -> UnfoldFully s let (delta_attr : Prims.string Prims.list -> norm_step) = diff --git a/stage0/fstar-lib/generated/FStar_Seq_Base.ml b/stage0/dune/fstar-guts/fstarc.ml/FStar_Seq_Base.ml similarity index 100% rename from stage0/fstar-lib/generated/FStar_Seq_Base.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStar_Seq_Base.ml diff --git a/stage0/fstar-lib/generated/FStar_Seq_Properties.ml b/stage0/dune/fstar-guts/fstarc.ml/FStar_Seq_Properties.ml similarity index 100% rename from stage0/fstar-lib/generated/FStar_Seq_Properties.ml rename to stage0/dune/fstar-guts/fstarc.ml/FStar_Seq_Properties.ml diff --git a/stage0/fstar-lib/make_fstar_version.sh b/stage0/dune/fstar-guts/make_fstar_version.sh similarity index 59% rename from stage0/fstar-lib/make_fstar_version.sh rename to stage0/dune/fstar-guts/make_fstar_version.sh index 37bf71d8e54..df75bdb6851 100755 --- a/stage0/fstar-lib/make_fstar_version.sh +++ b/stage0/dune/fstar-guts/make_fstar_version.sh @@ -1,8 +1,14 @@ #!/usr/bin/env bash -VERSION=$(head -n 1 version.txt) -if [ "$OS" = "Windows_NT" ] -then +windows () { + [[ "${OS:-}" = "Windows_NT" ]] +} + +if [[ -z "$FSTAR_VERSION" ]]; then + FSTAR_VERSION=$(head -n 1 version.txt)~dev +fi + +if windows; then if [ "$PROCESSOR_ARCHITECTURE" = "AMD64" ] then PLATFORM="Windows_x64" @@ -16,13 +22,17 @@ COMPILER="OCaml $(ocamlc -version)" # If a system does not have git, or we are not in a git repo, fallback with "unset" if [[ -z "$FSTAR_COMMIT" ]] ; then FSTAR_COMMIT=$(git describe --match="" --always --abbrev=40 --dirty 2>/dev/null || echo unset) + # NB: ^ has to be in-sync with src-install.sh +fi +if [[ -z "$FSTAR_COMMITDATE" ]] ; then + FSTAR_COMMITDATE=$(git log --pretty=format:%ci -n 1 2>/dev/null || echo unset) + # NB: ^ has to be in-sync with src-install.sh fi -COMMITDATE=$(git log --pretty=format:%ci -n 1 2>/dev/null || echo unset) echo "let dummy () = ();;" -echo "FStarC_Options._version := \"$VERSION\";" +echo "FStarC_Options._version := \"$FSTAR_VERSION\";;" echo "FStarC_Options._platform := \"$PLATFORM\";;" echo "FStarC_Options._compiler := \"$COMPILER\";;" # We deliberately use commitdate instead of date, so that rebuilds are no-ops -echo "FStarC_Options._date := \"$COMMITDATE\";;" +echo "FStarC_Options._date := \"$FSTAR_COMMITDATE\";;" echo "FStarC_Options._commit:= \"$FSTAR_COMMIT\";;" diff --git a/stage0/fstar-lib/FStarC_BaseTypes.ml b/stage0/dune/fstar-guts/ml/FStarC_BaseTypes.ml similarity index 100% rename from stage0/fstar-lib/FStarC_BaseTypes.ml rename to stage0/dune/fstar-guts/ml/FStarC_BaseTypes.ml diff --git a/stage0/fstar-lib/FStarC_BigInt.ml b/stage0/dune/fstar-guts/ml/FStarC_BigInt.ml similarity index 100% rename from stage0/fstar-lib/FStarC_BigInt.ml rename to stage0/dune/fstar-guts/ml/FStarC_BigInt.ml diff --git a/stage0/fstar-lib/FStarC_Compiler_Bytes.ml b/stage0/dune/fstar-guts/ml/FStarC_Bytes.ml similarity index 91% rename from stage0/fstar-lib/FStarC_Compiler_Bytes.ml rename to stage0/dune/fstar-guts/ml/FStarC_Bytes.ml index c9ed427771d..7815e7b6e3d 100644 --- a/stage0/fstar-lib/FStarC_Compiler_Bytes.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Bytes.ml @@ -17,15 +17,15 @@ let zero_create n : bytes = BatArray.make n 0 let sub ( b:bytes) s l = BatArray.sub b s l let set = BatArray.set let blit (a:bytes) b c d e = BatArray.blit a b c d e -let string_as_unicode_bytes (s:string) = FStarC_Compiler_Util.unicode_of_string s -let utf8_bytes_as_string (b:bytes) = FStarC_Compiler_Util.string_of_unicode b -let unicode_bytes_as_string (b:bytes) = FStarC_Compiler_Util.string_of_unicode b +let string_as_unicode_bytes (s:string) = FStarC_Util.unicode_of_string s +let utf8_bytes_as_string (b:bytes) = FStarC_Util.string_of_unicode b +let unicode_bytes_as_string (b:bytes) = FStarC_Util.string_of_unicode b let compare (b1:bytes) (b2:bytes) = compare b1 b2 let to_intarray (b:bytes) = b let of_intarray (arr:int array) = arr -let string_as_utf8_bytes (s:string) = FStarC_Compiler_Util.unicode_of_string s +let string_as_utf8_bytes (s:string) = FStarC_Util.unicode_of_string s let append (b1: bytes) (b2:bytes) = BatArray.append b1 b2 diff --git a/stage0/fstar-lib/FStarC_Dyn.ml b/stage0/dune/fstar-guts/ml/FStarC_Dyn.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Dyn.ml rename to stage0/dune/fstar-guts/ml/FStarC_Dyn.ml diff --git a/stage0/fstar-lib/FStarC_Compiler_Effect.ml b/stage0/dune/fstar-guts/ml/FStarC_Effect.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Compiler_Effect.ml rename to stage0/dune/fstar-guts/ml/FStarC_Effect.ml diff --git a/stage0/fstar-lib/FStarC_Extraction_ML_PrintML.ml b/stage0/dune/fstar-guts/ml/FStarC_Extraction_ML_PrintML.ml similarity index 93% rename from stage0/fstar-lib/FStarC_Extraction_ML_PrintML.ml rename to stage0/dune/fstar-guts/ml/FStarC_Extraction_ML_PrintML.ml index 0001a2db940..74b57826fd9 100644 --- a/stage0/fstar-lib/FStarC_Extraction_ML_PrintML.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Extraction_ML_PrintML.ml @@ -93,8 +93,8 @@ let mk_top_mllb (e: mlexpr): mllb = print_typ=false } (* Find the try_with in the default effect module. For instance this can be -FStar.All.try_with (for most users) or FStarC.Compiler.Effect.try_with (during -bootstrapping with "--MLish --MLish_effect FStarC.Compiler.Effect"). *) +FStar.All.try_with (for most users) or FStarC.Effect.try_with (during +bootstrapping with "--MLish --MLish_effect FStarC.Effect"). *) let try_with_ident () = let lid = FStarC_Parser_Const.try_with_lid () in let ns = FStarC_Ident.ns_of_lid lid in @@ -110,6 +110,11 @@ let try_with_ident () = let max_of_int_const = Z.of_int 65535 let min_of_int_const = Z.of_int (-65536) +let maybe_guts (s:string) : string = + if FStarC_Options.codegen () = Some FStarC_Options.Plugin + then "Fstarcompiler." ^ s + else s + (* mapping functions from F* ML AST to Parsetree *) let build_constant (c: mlconstant): Parsetree.constant = let stdint_module (s:FStarC_Const.signedness) (w:FStarC_Const.width) : string = @@ -126,8 +131,10 @@ let build_constant (c: mlconstant): Parsetree.constant = match c with | MLC_Int (v, None) -> let s = match Z.of_string v with - | x when x = Z.zero -> "Prims.int_zero" - | x when x = Z.one -> "Prims.int_one" + | x when x = Z.zero -> + maybe_guts "Prims.int_zero" + | x when x = Z.one -> + maybe_guts "Prims.int_one" | x when (min_of_int_const < x) && (x < max_of_int_const) -> BatString.concat v ["(Prims.of_int ("; "))"] | x -> @@ -189,7 +196,8 @@ and build_constructor_pat ((path, sym), p) = let (path', name) = (* resugaring the Cons and Nil from Prims *) (match path with - | ["Prims"] -> + | ["Prims"] + | ["Fstarcompiler.Prims"] -> (match sym with | "Cons" -> ([], "::") | "Nil" -> ([], "[]") @@ -218,9 +226,10 @@ let rec build_core_type ?(annots = []) (ty: mlty): core_type = let p = path_to_ident (path, sym) in let ty = Typ.mk (Ptyp_constr (p, c_tys)) in (match path with + | ["Fstarcompiler.FStar"; "Pervasives"; "Native"] | ["FStar"; "Pervasives"; "Native"] -> (* A special case for tuples, so they are displayed as - * ('a * 'b) instead of ('a,'b) FStarC_Pervasives_Native.tuple2 + * ('a * 'b) instead of ('a,'b) FStar_Pervasives_Native.tuple2 * VD: Should other types named "tupleXX" where XX does not represent * the arity of the tuple be added to FStar.Pervasives.Native, * the condition below might need to be more specific. *) @@ -366,6 +375,8 @@ and build_constructor_expr ((path, sym), exp): expression = (match path, sym with | ["Prims"], "Cons" -> ([], "::") | ["Prims"], "Nil" -> ([], "[]") + | ["Fstarcompiler.Prims"], "Cons" -> ([], "::") + | ["Fstarcompiler.Prims"], "Nil" -> ([], "[]") | path, x -> (path, x)) in match exp with | [] -> Exp.construct (path_to_ident(path', name)) None @@ -503,9 +514,20 @@ let build_module1 path (m1: mlmodule1): structure_item option = let build_m path (md: (mlsig * mlmodule) option) : structure = match md with | Some(s, m) -> - let open_prims = - Str.open_ (Opn.mk ?override:(Some Fresh) (Mod.ident (mk_lident "Prims"))) in - open_prims::(map (build_module1 path) m |> flatmap opt_to_list) + let open_plugin_lib = + if FStarC_Options.codegen () = Some FStarC_Options.Plugin (* NB: PluginNoLib does not open the library *) + then [Str.open_ (Opn.mk ?override:(Some Fresh) (Mod.ident (mk_lident "Fstar_pluginlib")))] + else [] + in + let open_guts = + if FStarC_Options.codegen () = Some FStarC_Options.PluginNoLib + then [Str.open_ (Opn.mk ?override:(Some Fresh) (Mod.ident (mk_lident "Fstarcompiler")))] + else [] + in + let open_prims = + [Str.open_ (Opn.mk ?override:(Some Fresh) (Mod.ident (mk_lident "Prims")))] + in + open_plugin_lib @ open_guts @ open_prims @ (map (build_module1 path) m |> flatmap opt_to_list) | None -> [] let build_ast (out_dir: string option) (ext: string) (ml: mllib) = @@ -537,7 +559,7 @@ let print (out_dir: string option) (ext: string) (ml: mllib) = (* Use the old printer for F# extraction *) let new_doc = FStarC_Extraction_ML_Code.doc_of_mllib ml in iter (fun (n, d) -> - FStarC_Compiler_Util.write_file + FStarC_Util.write_file (FStarC_Find.prepend_output_dir (BatString.concat "" [n;ext])) (FStarC_Extraction_ML_Code.pretty (Prims.parse_int "120") d) ) new_doc diff --git a/stage0/fstar-lib/FStarC_Getopt.ml b/stage0/dune/fstar-guts/ml/FStarC_Getopt.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Getopt.ml rename to stage0/dune/fstar-guts/ml/FStarC_Getopt.ml diff --git a/stage0/fstar-lib/FStarC_Hash.ml b/stage0/dune/fstar-guts/ml/FStarC_Hash.ml similarity index 98% rename from stage0/fstar-lib/FStarC_Hash.ml rename to stage0/dune/fstar-guts/ml/FStarC_Hash.ml index 4ece1088b4a..34756a1a0e1 100644 --- a/stage0/fstar-lib/FStarC_Hash.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Hash.ml @@ -1,4 +1,4 @@ -module BU = FStarC_Compiler_Util +module BU = FStarC_Util module Z = FStarC_BigInt type hash_code = int diff --git a/stage0/fstar-lib/FStarC_Compiler_Hints.ml b/stage0/dune/fstar-guts/ml/FStarC_Hints.ml similarity index 99% rename from stage0/fstar-lib/FStarC_Compiler_Hints.ml rename to stage0/dune/fstar-guts/ml/FStarC_Hints.ml index 85f40c7f926..de1c9b8fa31 100644 --- a/stage0/fstar-lib/FStarC_Compiler_Hints.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Hints.ml @@ -111,6 +111,7 @@ let read_hints (filename: string) : hints_read_result = raise Exit ) with + | Yojson.Json_error _ | Exit -> MalformedJson | Sys_error _ -> diff --git a/stage0/fstar-lib/FStarC_Json.ml b/stage0/dune/fstar-guts/ml/FStarC_Json.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Json.ml rename to stage0/dune/fstar-guts/ml/FStarC_Json.ml diff --git a/stage0/fstar-lib/FStarC_Compiler_List.ml b/stage0/dune/fstar-guts/ml/FStarC_List.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Compiler_List.ml rename to stage0/dune/fstar-guts/ml/FStarC_List.ml diff --git a/stage0/fstar-lib/FStarC_Parser_LexFStar.ml b/stage0/dune/fstar-guts/ml/FStarC_Parser_LexFStar.ml similarity index 99% rename from stage0/fstar-lib/FStarC_Parser_LexFStar.ml rename to stage0/dune/fstar-guts/ml/FStarC_Parser_LexFStar.ml index 25be6188616..20b5ca750d4 100644 --- a/stage0/fstar-lib/FStarC_Parser_LexFStar.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Parser_LexFStar.ml @@ -8,7 +8,7 @@ module Sedlexing = FStarC_Sedlexing module L = Sedlexing module E = FStarC_Errors module Codes = FStarC_Errors_Codes -module BU = FStarC_Compiler_Util +module BU = FStarC_Util let ba_of_string s = Array.init (String.length s) (fun i -> Char.code (String.get s i)) let array_trim_both a n m = Array.sub a n (Array.length a - n - m) diff --git a/stage0/dune/fstar-guts/ml/FStarC_Parser_Parse.mly b/stage0/dune/fstar-guts/ml/FStarC_Parser_Parse.mly new file mode 100644 index 00000000000..46ef5124ff0 --- /dev/null +++ b/stage0/dune/fstar-guts/ml/FStarC_Parser_Parse.mly @@ -0,0 +1,1730 @@ +%{ +(* + Menhir reports the following warnings: + + Warning: 5 states have shift/reduce conflicts. + Warning: 6 shift/reduce conflicts were arbitrarily resolved. + Warning: 221 end-of-stream conflicts were arbitrarily resolved. + + If you're editing this file, be sure to not increase the warnings, + except if you have a really good reason. + + The shift-reduce conflicts are natural in an ML-style language. E.g., + there are S-R conflicts with dangling elses, with a non-delimited match where + the BAR is dangling etc. + + Note: Some symbols are marked public, so that we can reuse this parser from + the parser for the Pulse DSL in FStarLang/steel. + +*) +(* (c) Microsoft Corporation. All rights reserved *) +open Prims +open FStar_Pervasives +open FStarC_Errors +open FStarC_List +open FStarC_Util +open FStarC_Range + +(* TODO : these files should be deprecated and removed *) +open FStarC_Parser_Const +open FStarC_Parser_AST +open FStarC_Const +open FStarC_Ident + +(* Shorthands *) +let rr = FStarC_Parser_Util.translate_range +let rr2 = FStarC_Parser_Util.translate_range2 + +let logic_qualifier_deprecation_warning = + "logic qualifier is deprecated, please remove it from the source program. In case your program verifies with the qualifier annotated but not without it, please try to minimize the example and file a github issue." + +let mk_meta_tac m = Meta m + +let old_attribute_syntax_warning = + "The `[@ ...]` syntax of attributes is deprecated. \ + Use `[@@ a1; a2; ...; an]`, a semi-colon separated list of attributes, instead" + +let do_notation_deprecation_warning = + "The lightweight do notation [x <-- y; z] or [x ;; z] is deprecated, use let operators (i.e. [let* x = y in z] or [y ;* z], [*] being any sequence of operator characters) instead." + +let none_to_empty_list x = + match x with + | None -> [] + | Some l -> l + +let parse_extension_blob (extension_name:string) + (s:string) + (blob_range:range) + (extension_syntax_start:range) : FStarC_Parser_AST.decl' = + DeclSyntaxExtension (extension_name, s, blob_range, extension_syntax_start) + +let parse_use_lang_blob (extension_name:string) + (s:string) + (blob_range:range) + (extension_syntax_start:range) +: FStarC_Parser_AST.decl list += FStarC_Parser_AST_Util.parse_extension_lang extension_name s extension_syntax_start + +%} + +%token STRING +%token IDENT +%token NAME +%token TVAR +%token TILDE + +/* bool indicates if INT8 was 'bad' max_int+1, e.g. '128' */ +%token INT8 +%token INT16 +%token INT32 +%token INT64 +%token INT +%token RANGE + +%token UINT8 +%token UINT16 +%token UINT32 +%token UINT64 +%token SIZET +%token REAL +%token CHAR +%token LET +%token LET_OP +%token AND_OP +%token MATCH_OP +%token IF_OP +%token EXISTS +%token EXISTS_OP +%token FORALL +%token FORALL_OP + + +/* [SEMICOLON_OP] encodes either: +- [;;], which used to be SEMICOLON_SEMICOLON, or +- [;], with a sequence of [op_char] (see FStarC_Parser_LexFStar). +*/ +%token SEMICOLON_OP + +%token ASSUME NEW LOGIC ATTRIBUTES +%token IRREDUCIBLE UNFOLDABLE INLINE OPAQUE UNFOLD INLINE_FOR_EXTRACTION +%token NOEXTRACT +%token NOEQUALITY UNOPTEQUALITY +%token PRAGMA_SHOW_OPTIONS PRAGMA_SET_OPTIONS PRAGMA_RESET_OPTIONS PRAGMA_PUSH_OPTIONS PRAGMA_POP_OPTIONS PRAGMA_RESTART_SOLVER PRAGMA_PRINT_EFFECTS_GRAPH +%token TYP_APP_LESS TYP_APP_GREATER SUBTYPE EQUALTYPE SUBKIND BY +%token AND ASSERT SYNTH BEGIN ELSE END +%token EXCEPTION FALSE FUN FUNCTION IF IN MODULE DEFAULT +%token MATCH OF +%token FRIEND OPEN REC THEN TRUE TRY TYPE CALC CLASS INSTANCE EFFECT VAL +%token INTRO ELIM +%token INCLUDE +%token WHEN AS RETURNS RETURNS_EQ WITH HASH AMP LPAREN RPAREN LPAREN_RPAREN COMMA LONG_LEFT_ARROW LARROW RARROW +%token IFF IMPLIES CONJUNCTION DISJUNCTION +%token DOT COLON COLON_COLON SEMICOLON +%token QMARK_DOT +%token QMARK +%token EQUALS PERCENT_LBRACK LBRACK_AT LBRACK_AT_AT LBRACK_AT_AT_AT DOT_LBRACK +%token DOT_LENS_PAREN_LEFT DOT_LPAREN DOT_LBRACK_BAR LBRACK LBRACK_BAR LBRACE_BAR LBRACE BANG_LBRACE +%token BAR_RBRACK BAR_RBRACE UNDERSCORE LENS_PAREN_LEFT LENS_PAREN_RIGHT +%token SEQ_BANG_LBRACK +%token BAR RBRACK RBRACE DOLLAR +%token PRIVATE REIFIABLE REFLECTABLE REIFY RANGE_OF SET_RANGE_OF LBRACE_COLON_PATTERN +%token PIPE_LEFT PIPE_RIGHT +%token NEW_EFFECT SUB_EFFECT LAYERED_EFFECT POLYMONADIC_BIND POLYMONADIC_SUBCOMP SPLICE SPLICET SQUIGGLY_RARROW TOTAL +%token REQUIRES ENSURES DECREASES LBRACE_COLON_WELL_FOUNDED +%token MINUS COLON_EQUALS QUOTE BACKTICK_AT BACKTICK_HASH +%token BACKTICK UNIV_HASH +%token BACKTICK_PERC + +%token OPPREFIX OPINFIX0a OPINFIX0b OPINFIX0c OPINFIX0d OPINFIX1 OPINFIX2 OPINFIX3 OPINFIX4 +%token OP_MIXFIX_ASSIGNMENT OP_MIXFIX_ACCESS +%token BLOB +%token USE_LANG_BLOB + +/* These are artificial */ +%token EOF + +%nonassoc THEN +%nonassoc ELSE + +%nonassoc ASSERT +%nonassoc EQUALTYPE +%nonassoc SUBTYPE +%nonassoc BY + +%right COLON_COLON +%right AMP + +%nonassoc COLON_EQUALS +%left OPINFIX0a +%left OPINFIX0b +%left OPINFIX0c EQUALS +%left OPINFIX0d +%left PIPE_RIGHT +%right PIPE_LEFT +%right OPINFIX1 +%left OPINFIX2 MINUS QUOTE +%left OPINFIX3 +%left BACKTICK +%right OPINFIX4 + +%start inputFragment +%start term +%start warn_error_list +%start oneDeclOrEOF +%type inputFragment +%type <(FStarC_Parser_AST.decl list * FStarC_Sedlexing.snap option) option> oneDeclOrEOF +%type term +%type lident +%type <(FStarC_Errors_Codes.error_flag * string) list> warn_error_list +%% + +(* inputFragment is used at the same time for whole files and fragment of codes (for interactive mode) *) +inputFragment: + | decls=list(decl) EOF + { + as_frag (List.flatten decls) + } + +oneDeclOrEOF: + | EOF { None } + | ds=idecl { Some ds } + +idecl: + | d=decl snap=startOfNextDeclToken + { d, snap } + +%public +startOfNextDeclToken: + | EOF { None } + | pragmaStartToken { None } + | LBRACK_AT { None } (* Attribute start *) + | LBRACK_AT_AT { None } (* Attribute start *) + | qualifier { None } + | CLASS { None } + | INSTANCE { None } + | OPEN { None } + | FRIEND { None } + | INCLUDE { None } + | MODULE { None } + | TYPE { None } + | EFFECT { None } + | LET { None } + | VAL { None } + | SPLICE { None } + | SPLICET { None } + | EXCEPTION { None } + | NEW_EFFECT { None } + | LAYERED_EFFECT { None } + | SUB_EFFECT { None } + | POLYMONADIC_BIND { None } + | POLYMONADIC_SUBCOMP { None } + | b=BLOB { let _, _, _, snap = b in Some snap } + | b=USE_LANG_BLOB { let _, _, _, snap = b in Some snap } + +pragmaStartToken: + | PRAGMA_SHOW_OPTIONS + { () } + | PRAGMA_SET_OPTIONS + { () } + | PRAGMA_RESET_OPTIONS + { () } + | PRAGMA_PUSH_OPTIONS + { () } + | PRAGMA_POP_OPTIONS + { () } + | PRAGMA_RESTART_SOLVER + { () } + | PRAGMA_PRINT_EFFECTS_GRAPH + { () } + +/******************************************************************************/ +/* Top level declarations */ +/******************************************************************************/ + +pragma: + | PRAGMA_SHOW_OPTIONS + { ShowOptions } + | PRAGMA_SET_OPTIONS s=string + { SetOptions s } + | PRAGMA_RESET_OPTIONS s_opt=string? + { ResetOptions s_opt } + | PRAGMA_PUSH_OPTIONS s_opt=string? + { PushOptions s_opt } + | PRAGMA_POP_OPTIONS + { PopOptions } + | PRAGMA_RESTART_SOLVER + { RestartSolver } + | PRAGMA_PRINT_EFFECTS_GRAPH + { PrintEffectsGraph } + +attribute: + | LBRACK_AT x = list(atomicTerm) RBRACK + { + let _ = + match x with + | _::_::_ -> + log_issue_text (rr $loc) Warning_DeprecatedAttributeSyntax old_attribute_syntax_warning + | _ -> () in + x + } + | LBRACK_AT_AT x = semiColonTermList RBRACK + { x } + +%public +decoration: + | x=attribute + { DeclAttributes x } + | x=qualifier + { Qualifier x } + +%public +decl: + | ASSUME lid=uident COLON phi=formula + { [mk_decl (Assume(lid, phi)) (rr $loc) [ Qualifier Assumption ]] } + + | blob=USE_LANG_BLOB + { + let ext_name, contents, pos, snap = blob in + (* blob_range is the full range of the blob, starting from the #lang pragma *) + let blob_range = rr (snd snap, snd $loc) in + (* extension_syntax_start_range is where the extension syntax starts not including + the "#lang ident" prefix *) + let extension_syntax_start_range = (rr (pos, pos)) in + let ds = parse_use_lang_blob ext_name contents blob_range extension_syntax_start_range in + mk_decl (UseLangDecls ext_name) extension_syntax_start_range [] :: ds + } + + | ds=list(decoration) decl=rawDecl + { [mk_decl decl (rr $loc(decl)) ds] } + + | ds=list(decoration) decl=typeclassDecl + { let (decl, extra_attrs) = decl in + let d = mk_decl decl (rr $loc(decl)) ds in + [{ d with attrs = extra_attrs @ d.attrs }] + } + +%public +noDecorationDecl: + | ASSUME lid=uident COLON phi=formula + { [mk_decl (Assume(lid, phi)) (rr $loc) [ Qualifier Assumption ]] } + + | blob=USE_LANG_BLOB + { + let ext_name, contents, pos, snap = blob in + (* blob_range is the full range of the blob, starting from the #lang pragma *) + let blob_range = rr (snd snap, snd $loc) in + (* extension_syntax_start_range is where the extension syntax starts not including + the "#lang ident" prefix *) + let extension_syntax_start_range = (rr (pos, pos)) in + let ds = parse_use_lang_blob ext_name contents blob_range extension_syntax_start_range in + mk_decl (UseLangDecls ext_name) extension_syntax_start_range [] :: ds + } + +%public +decoratableDecl: + | decl=rawDecl + { [mk_decl decl (rr $loc(decl)) []] } + + | decl=typeclassDecl + { let (decl, extra_attrs) = decl in + let d = mk_decl decl (rr $loc(decl)) [] in + [{ d with attrs = extra_attrs }] + } + + +typeclassDecl: + | CLASS tcdef=typeDecl + { + (* Only a single type decl allowed, but construct it the same as for multiple ones. + * Only difference is the `true` below marking that this a class so desugaring + * adds the needed %splice. *) + let d = Tycon (false, true, [tcdef]) in + + (* No attrs yet, but perhaps we want a `class` attribute *) + (d, []) + } + + | INSTANCE q=letqualifier lb=letbinding + { + (* Making a single letbinding *) + let r = rr $loc in + let lbs = focusLetBindings [lb] r in (* lbs is a singleton really *) + let d = TopLevelLet(q, lbs) in + + (* Slapping a `tcinstance` attribute to it *) + let at = mk_term (Var tcinstance_lid) r Type_level in + + (d, [at]) + } + + | INSTANCE VAL lid=lidentOrOperator bs=binders COLON t=typ + { + (* Some duplication from rawDecl... *) + let r = rr $loc in + let t = match bs with + | [] -> t + | bs -> mk_term (Product(bs, t)) (rr2 $loc(bs) $loc(t)) Type_level + in + let d = Val(lid, t) in + (* Slapping a `tcinstance` attribute to it *) + let at = mk_term (Var tcinstance_lid) r Type_level in + + (d, [at]) + } + +restriction: + | LBRACE ids=separated_list(COMMA, id=ident renamed=option(AS id=ident {id} ) {(id, renamed)}) RBRACE + { FStarC_Syntax_Syntax.AllowList ids } + | { FStarC_Syntax_Syntax.Unrestricted } + +rawDecl: + | p=pragma + { Pragma p } + | OPEN uid=quident r=restriction + { Open (uid, r) } + | FRIEND uid=quident + { Friend uid } + | INCLUDE uid=quident r=restriction + { Include (uid, r) } + | MODULE UNDERSCORE EQUALS uid=quident + { Open (uid, FStarC_Syntax_Syntax.AllowList []) } + | MODULE uid1=uident EQUALS uid2=quident + { ModuleAbbrev(uid1, uid2) } + | MODULE q=qlident + { raise_error_text (rr $loc(q)) Fatal_SyntaxError "Syntax error: expected a module name" } + | MODULE uid=quident + { TopLevelModule uid } + | TYPE tcdefs=separated_nonempty_list(AND,typeDecl) + { Tycon (false, false, tcdefs) } + | EFFECT uid=uident tparams=typars EQUALS t=typ + { Tycon(true, false, [(TyconAbbrev(uid, tparams, None, t))]) } + | LET q=letqualifier lbs=separated_nonempty_list(AND, letbinding) + { + let r = rr $loc in + let lbs = focusLetBindings lbs r in + if q <> Rec && List.length lbs <> 1 + then raise_error_text r Fatal_MultipleLetBinding "Unexpected multiple let-binding (Did you forget some rec qualifier ?)"; + TopLevelLet(q, lbs) + } + | VAL c=constant + { + (* This is just to provide a better error than "syntax error" *) + raise_error_text (rr $loc) Fatal_SyntaxError "Syntax error: constants are not allowed in val declarations" + } + | VAL lid=lidentOrOperator bs=binders COLON t=typ + { + let t = match bs with + | [] -> t + | bs -> mk_term (Product(bs, t)) (rr2 $loc(bs) $loc(t)) Type_level + in Val(lid, t) + } + | SPLICE LBRACK ids=separated_list(SEMICOLON, ident) RBRACK t=thunk(atomicTerm) + { Splice (false, ids, t) } + | SPLICET LBRACK ids=separated_list(SEMICOLON, ident) RBRACK t=atomicTerm + { Splice (true, ids, t) } + | EXCEPTION lid=uident t_opt=option(OF t=typ {t}) + { Exception(lid, t_opt) } + | NEW_EFFECT ne=newEffect + { NewEffect ne } + | LAYERED_EFFECT ne=effectDefinition + { LayeredEffect ne } + | EFFECT ne=layeredEffectDefinition + { LayeredEffect ne } + | SUB_EFFECT se=subEffect + { SubEffect se } + | POLYMONADIC_BIND b=polymonadic_bind + { Polymonadic_bind b } + | POLYMONADIC_SUBCOMP c=polymonadic_subcomp + { Polymonadic_subcomp c } + | blob=BLOB + { + let ext_name, contents, pos, snap = blob in + (* blob_range is the full range of the blob, including the enclosing ``` *) + let blob_range = rr (snd snap, snd $loc) in + (* extension_syntax_start_range is where the extension syntax starts not including + the "```ident" prefix *) + let extension_syntax_start_range = (rr (pos, pos)) in + parse_extension_blob ext_name contents blob_range extension_syntax_start_range + } + + +typeDecl: + (* TODO : change to lident with stratify *) + | lid=ident tparams=typars ascr_opt=ascribeKind? tcdef=typeDefinition + { tcdef lid tparams ascr_opt } + +typars: + | x=tvarinsts { x } + | x=binders { x } + +tvarinsts: + | TYP_APP_LESS tvs=separated_nonempty_list(COMMA, tvar) TYP_APP_GREATER + { map (fun tv -> mk_binder (TVariable(tv)) (range_of_id tv) Kind None) tvs } + +%inline recordDefinition: + | LBRACE record_field_decls=right_flexible_nonempty_list(SEMICOLON, recordFieldDecl) RBRACE + { record_field_decls } + +typeDefinition: + | { (fun id binders kopt -> check_id id; TyconAbstract(id, binders, kopt)) } + | EQUALS t=typ + { (fun id binders kopt -> check_id id; TyconAbbrev(id, binders, kopt, t)) } + /* A documentation on the first branch creates a conflict with { x with a = ... }/{ a = ... } */ + | EQUALS attrs_opt=ioption(binderAttributes) record_field_decls=recordDefinition + { (fun id binders kopt -> check_id id; TyconRecord(id, binders, kopt, none_to_empty_list attrs_opt, record_field_decls)) } + (* having the first BAR optional using left-flexible list creates a s/r on FSDOC since any decl can be preceded by a FSDOC *) + | EQUALS ct_decls=list(constructorDecl) + { (fun id binders kopt -> check_id id; TyconVariant(id, binders, kopt, ct_decls)) } + +recordFieldDecl: + | qualified_lid=aqualifiedWithAttrs(lidentOrOperator) COLON t=typ + { + let (qual, attrs), lid = qualified_lid in + (lid, qual, attrs, t) + } + +constructorPayload: + | COLON t=typ {VpArbitrary t} + | OF t=typ {VpOfNotation t} + | fields=recordDefinition opt=option(COLON t=typ {t}) {VpRecord(fields, opt)} + +constructorDecl: + | BAR attrs_opt=ioption(binderAttributes) + uid=uident + payload=option(constructorPayload) + { uid, payload, none_to_empty_list attrs_opt } + +attr_letbinding: + | attr=ioption(attribute) AND lb=letbinding + { attr, lb } + +letoperatorbinding: + | pat=tuplePattern ascr_opt=ascribeTyp? tm=option(EQUALS tm=term {tm}) + { + let h tm + = ( ( match ascr_opt with + | None -> pat + | Some t -> mk_pattern (PatAscribed(pat, t)) (rr2 $loc(pat) $loc(ascr_opt)) ) + , tm) + in + match pat.pat, tm with + | _ , Some tm -> h tm + | PatVar (v, _, _), None -> + let v = lid_of_ns_and_id [] v in + h (mk_term (Var v) (rr $loc(pat)) Expr) + | _ -> raise_error_text (rr $loc(ascr_opt)) Fatal_SyntaxError "Syntax error: let-punning expects a name, not a pattern" + } + +letbinding: + | focus_opt=maybeFocus lid=lidentOrOperator lbp=nonempty_list(patternOrMultibinder) ascr_opt=ascribeTyp? EQUALS tm=term + { + let pat = mk_pattern (PatVar(lid, None, [])) (rr $loc(lid)) in + let pat = mk_pattern (PatApp (pat, flatten lbp)) (rr2 $loc(focus_opt) $loc(lbp)) in + let pos = rr2 $loc(focus_opt) $loc(tm) in + match ascr_opt with + | None -> (focus_opt, (pat, tm)) + | Some t -> (focus_opt, (mk_pattern (PatAscribed(pat, t)) pos, tm)) + } + | focus_opt=maybeFocus pat=tuplePattern ascr=ascribeTyp eq=EQUALS tm=term + { focus_opt, (mk_pattern (PatAscribed(pat, ascr)) (rr2 $loc(focus_opt) $loc(eq)), tm) } + | focus_opt=maybeFocus pat=tuplePattern EQUALS tm=term + { focus_opt, (pat, tm) } + +/******************************************************************************/ +/* Effects */ +/******************************************************************************/ + +newEffect: + | ed=effectRedefinition + | ed=effectDefinition + { ed } + +effectRedefinition: + | lid=uident EQUALS t=simpleTerm + { RedefineEffect(lid, [], t) } + +effectDefinition: + | LBRACE lid=uident bs=binders COLON typ=tmArrow(tmNoEq) + WITH eds=separated_nonempty_list(SEMICOLON, effectDecl) + RBRACE + { DefineEffect(lid, bs, typ, eds) } + +layeredEffectDefinition: + | LBRACE lid=uident bs=binders WITH r=tmNoEq RBRACE + { + let typ = (* bs -> Effect *) + let first_b, last_b = + match bs with + | [] -> + raise_error_text (range_of_id lid) Fatal_SyntaxError + "Syntax error: unexpected empty binders list in the layered effect definition" + | _ -> hd bs, last bs in + let r = union_ranges first_b.brange last_b.brange in + mk_term (Product (bs, mk_term (Name (lid_of_str "Effect")) r Type_level)) r Type_level in + let rec decls (r:term) = + match r.tm with + | Paren r -> decls r + | Record (None, flds) -> + flds |> List.map (fun (lid, t) -> + mk_decl (Tycon (false, + false, + [TyconAbbrev (ident_of_lid lid, [], None, t)])) + t.range []) + | _ -> + raise_error_text r.range Fatal_SyntaxError + "Syntax error: layered effect combinators should be declared as a record" + in + DefineEffect (lid, [], typ, decls r) } + +effectDecl: + | lid=lident action_params=binders EQUALS t=simpleTerm + { mk_decl (Tycon (false, false, [TyconAbbrev(lid, action_params, None, t)])) (rr $loc) [] } + +subEffect: + | src_eff=quident SQUIGGLY_RARROW tgt_eff=quident EQUALS lift=simpleTerm + { { msource = src_eff; mdest = tgt_eff; lift_op = NonReifiableLift lift; braced=false } } + | src_eff=quident SQUIGGLY_RARROW tgt_eff=quident + LBRACE + lift1=separated_pair(IDENT, EQUALS, simpleTerm) + lift2_opt=ioption(separated_pair(SEMICOLON id=IDENT {id}, EQUALS, simpleTerm)) + /* might be nice for homogeneity if possible : ioption(SEMICOLON) */ + RBRACE + { + match lift2_opt with + | None -> + begin match lift1 with + | ("lift", lift) -> + { msource = src_eff; mdest = tgt_eff; lift_op = LiftForFree lift; braced=true } + | ("lift_wp", lift_wp) -> + { msource = src_eff; mdest = tgt_eff; lift_op = NonReifiableLift lift_wp; braced=true } + | _ -> + raise_error_text (rr $loc) Fatal_UnexpectedIdentifier "Unexpected identifier; expected {'lift', and possibly 'lift_wp'}" + end + | Some (id2, tm2) -> + let (id1, tm1) = lift1 in + let lift, lift_wp = match (id1, id2) with + | "lift_wp", "lift" -> tm1, tm2 + | "lift", "lift_wp" -> tm2, tm1 + | _ -> raise_error_text (rr $loc) Fatal_UnexpectedIdentifier "Unexpected identifier; expected {'lift', 'lift_wp'}" + in + { msource = src_eff; mdest = tgt_eff; lift_op = ReifiableLift (lift, lift_wp); braced=true } + } + +polymonadic_bind: + | LPAREN m_eff=quident COMMA n_eff=quident RPAREN PIPE_RIGHT p_eff=quident EQUALS bind=simpleTerm + { (m_eff, n_eff, p_eff, bind) } + +polymonadic_subcomp: + | m_eff=quident SUBTYPE n_eff=quident EQUALS subcomp=simpleTerm + { (m_eff, n_eff, subcomp) } + + +/******************************************************************************/ +/* Qualifiers, tags, ... */ +/******************************************************************************/ + +qualifier: + | ASSUME { Assumption } + | INLINE { + raise_error_text (rr $loc) Fatal_InlineRenamedAsUnfold + "The 'inline' qualifier has been renamed to 'unfold'" + } + | UNFOLDABLE { + raise_error_text (rr $loc) Fatal_UnfoldableDeprecated + "The 'unfoldable' qualifier is no longer denotable; it is the default qualifier so just omit it" + } + | INLINE_FOR_EXTRACTION { + Inline_for_extraction + } + | UNFOLD { + Unfold_for_unification_and_vcgen + } + | IRREDUCIBLE { Irreducible } + | NOEXTRACT { NoExtract } + | DEFAULT { DefaultEffect } + | TOTAL { TotalEffect } + | PRIVATE { Private } + + | NOEQUALITY { Noeq } + | UNOPTEQUALITY { Unopteq } + | NEW { New } + | LOGIC { log_issue_text (rr $loc) Warning_logicqualifier logic_qualifier_deprecation_warning; + Logic } + | OPAQUE { Opaque } + | REIFIABLE { Reifiable } + | REFLECTABLE { Reflectable } + +maybeFocus: + | b=boption(SQUIGGLY_RARROW) { b } + +letqualifier: + | REC { Rec } + | { NoLetQualifier } + +(* + * AR: this should be generalized to: + * (a) allow attributes on non-implicit binders + * note that in the [@@ case, we choose the Implicit aqual + *) +aqual: + | HASH LBRACK t=thunk(term) RBRACK { mk_meta_tac t } + | HASH { Implicit } + | DOLLAR { Equality } + +binderAttributes: + | LBRACK_AT_AT_AT t=semiColonTermList RBRACK { t } + +/******************************************************************************/ +/* Patterns, binders */ +/******************************************************************************/ + +(* disjunction should be allowed in nested patterns *) +disjunctivePattern: + | pats=separated_nonempty_list(BAR, tuplePattern) { pats } + +%public +tuplePattern: + | pats=separated_nonempty_list(COMMA, constructorPattern) + { match pats with | [x] -> x | l -> mk_pattern (PatTuple (l, false)) (rr $loc) } + +constructorPattern: + | pat=constructorPattern COLON_COLON pats=constructorPattern + { mk_pattern (consPat (rr $loc(pats)) pat pats) (rr $loc) } + | uid=quident args=nonempty_list(atomicPattern) + { + let head_pat = mk_pattern (PatName uid) (rr $loc(uid)) in + mk_pattern (PatApp (head_pat, args)) (rr $loc) + } + | pat=atomicPattern + { pat } + +atomicPattern: + | LPAREN pat=tuplePattern COLON t=simpleArrow phi_opt=refineOpt RPAREN + { + let pos_t = rr2 $loc(pat) $loc(t) in + let pos = rr $loc in + mkRefinedPattern pat t true phi_opt pos_t pos + } + | LBRACK pats=separated_list(SEMICOLON, tuplePattern) RBRACK + { mk_pattern (PatList pats) (rr2 $loc($1) $loc($3)) } + | LBRACE record_pat=right_flexible_list(SEMICOLON, fieldPattern) RBRACE + { mk_pattern (PatRecord record_pat) (rr $loc) } + | LENS_PAREN_LEFT pat0=constructorPattern COMMA pats=separated_nonempty_list(COMMA, constructorPattern) LENS_PAREN_RIGHT + { mk_pattern (PatTuple(pat0::pats, true)) (rr $loc) } + | LPAREN pat=tuplePattern RPAREN { pat } + | tv=tvar { mk_pattern (PatTvar (tv, None, [])) (rr $loc(tv)) } + | LPAREN op=operator RPAREN + { mk_pattern (PatOp op) (rr $loc) } + | UNDERSCORE + { mk_pattern (PatWild (None, [])) (rr $loc) } + | HASH UNDERSCORE + { mk_pattern (PatWild (Some Implicit, [])) (rr $loc) } + | c=constant + { mk_pattern (PatConst c) (rr $loc(c)) } + | tok=MINUS c=constant + { let r = rr2 $loc(tok) $loc(c) in + let c = + match c with + | Const_int (s, swopt) -> + (match swopt with + | None + | Some (Signed, _) -> Const_int ("-" ^ s, swopt) + | _ -> raise_error_text r Fatal_SyntaxError "Syntax_error: negative integer constant with unsigned width") + | _ -> raise_error_text r Fatal_SyntaxError "Syntax_error: negative constant that is not an integer" + in + mk_pattern (PatConst c) r } + | BACKTICK_PERC q=atomicTerm + { mk_pattern (PatVQuote q) (rr $loc) } + | qual_id=aqualifiedWithAttrs(lident) + { + let (aqual, attrs), lid = qual_id in + mk_pattern (PatVar (lid, aqual, attrs)) (rr $loc(qual_id)) } + | uid=quident + { mk_pattern (PatName uid) (rr $loc(uid)) } + +fieldPattern: + | p = separated_pair(qlident, EQUALS, tuplePattern) + { p } + | lid=qlident + { lid, mk_pattern (PatVar (ident_of_lid lid, None, [])) (rr $loc(lid)) } + + (* (x : t) is already covered by atomicPattern *) + (* we do *NOT* allow _ in multibinder () since it creates reduce/reduce conflicts when*) + (* preprocessing to ocamlyacc/fsyacc (which is expected since the macro are expanded) *) +patternOrMultibinder: + | LBRACE_BAR id=lidentOrUnderscore COLON t=simpleArrow BAR_RBRACE + { let r = rr $loc in + let w = mk_pattern (PatVar (id, Some TypeClassArg, [])) r in + let asc = (t, None) in + [mk_pattern (PatAscribed(w, asc)) r] + } + + | LBRACE_BAR t=simpleArrow BAR_RBRACE + { let r = rr $loc in + let id = gen r in + let w = mk_pattern (PatVar (id, Some TypeClassArg, [])) r in + let asc = (t, None) in + [mk_pattern (PatAscribed(w, asc)) r] + } + | pat=atomicPattern { [pat] } + | LPAREN qual_id0=aqualifiedWithAttrs(lident) qual_ids=nonempty_list(aqualifiedWithAttrs(lident)) COLON t=simpleArrow r=refineOpt RPAREN + { + let pos = rr $loc in + let t_pos = rr $loc(t) in + let qual_ids = qual_id0 :: qual_ids in + List.map (fun ((aq, attrs), x) -> mkRefinedPattern (mk_pattern (PatVar (x, aq, attrs)) pos) t false r t_pos pos) qual_ids + } + +binder: + | aqualifiedWithAttrs_lid=aqualifiedWithAttrs(lidentOrUnderscore) + { + let (q, attrs), lid = aqualifiedWithAttrs_lid in + mk_binder_with_attrs (Variable lid) (rr $loc(aqualifiedWithAttrs_lid)) Type_level q attrs + } + + | tv=tvar { mk_binder (TVariable tv) (rr $loc) Kind None } + (* small regression here : fun (=x : t) ... is not accepted anymore *) + +%public +multiBinder: + | LBRACE_BAR id=lidentOrUnderscore COLON t=simpleArrow BAR_RBRACE + { let r = rr $loc in + [mk_binder (Annotated (id, t)) r Type_level (Some TypeClassArg)] + } + + | LBRACE_BAR t=simpleArrow BAR_RBRACE + { let r = rr $loc in + let id = gen r in + [mk_binder (Annotated (id, t)) r Type_level (Some TypeClassArg)] + } + + | LPAREN qual_ids=nonempty_list(aqualifiedWithAttrs(lidentOrUnderscore)) COLON t=simpleArrow r=refineOpt RPAREN + { + let should_bind_var = match qual_ids with | [ _ ] -> true | _ -> false in + List.map (fun ((q, attrs), x) -> + mkRefinedBinder x t should_bind_var r (rr $loc) q attrs) qual_ids + } + + | LPAREN_RPAREN + { + let r = rr $loc in + let unit_t = mk_term (Var (lid_of_ids [(mk_ident("unit", r))])) r Un in + [mk_binder (Annotated (gen r, unit_t)) r Un None] + } + + | b=binder { [b] } + +%public +binders: bss=list(bs=multiBinder {bs}) { flatten bss } + +aqualifiedWithAttrs(X): + | aq=aqual attrs=binderAttributes x=X { (Some aq, attrs), x } + | aq=aqual x=X { (Some aq, []), x } + | attrs=binderAttributes x=X { (None, attrs), x } + | x=X { (None, []), x } + +/******************************************************************************/ +/* Identifiers, module paths */ +/******************************************************************************/ + +%public +qlident: + | ids=path(lident) { lid_of_ids ids } + +%public +quident: + | ids=path(uident) { lid_of_ids ids } + +path(Id): + | id=Id { [id] } + | uid=uident DOT p=path(Id) { uid::p } + +ident: + | x=lident { x } + | x=uident { x } + +qlidentOrOperator: + | qid=qlident { qid } + | LPAREN id=operator RPAREN + { lid_of_ns_and_id [] (id_of_text (compile_op' (string_of_id id) (range_of_id id))) } + +%inline lidentOrOperator: + | id=lident { id } + | LPAREN id=operator RPAREN + { mk_ident (compile_op' (string_of_id id) (range_of_id id), range_of_id id) } + +matchMaybeOp: + | MATCH {None} + | op=MATCH_OP { Some (mk_ident ("let" ^ op, rr $loc(op))) } + +ifMaybeOp: + | IF {None} + | op=IF_OP { Some (mk_ident ("let" ^ op, rr $loc(op))) } + +%public +lidentOrUnderscore: + | id=IDENT { mk_ident(id, rr $loc(id))} + | UNDERSCORE { gen (rr $loc) } + +%public +lident: + | id=IDENT { mk_ident(id, rr $loc(id))} + +uident: + | id=NAME { mk_ident(id, rr $loc(id)) } + +tvar: + | tv=TVAR { mk_ident(tv, rr $loc(tv)) } + + +/******************************************************************************/ +/* Types and terms */ +/******************************************************************************/ + +thunk(X): | t=X { mk_term (Abs ([mk_pattern (PatWild (None, [])) (rr $loc)], t)) (rr $loc) Expr } + +thunk2(X): + | t=X + { let u = mk_term (Const Const_unit) (rr $loc) Expr in + let t = mk_term (Seq (u, t)) (rr $loc) Expr in + mk_term (Abs ([mk_pattern (PatWild (None, [])) (rr $loc)], t)) (rr $loc) Expr } + +ascribeTyp: + | COLON t=tmArrow(tmNoEq) tacopt=option(BY tactic=thunk(trailingTerm) {tactic}) { t, tacopt } + +(* Remove for stratify *) +ascribeKind: + | COLON k=kind { k } + +(* Remove for stratify *) +kind: + | t=tmArrow(tmNoEq) { {t with level=Kind} } + + +term: + | e=noSeqTerm + { e } + | e1=noSeqTerm SEMICOLON e2=term + { mk_term (Seq(e1, e2)) (rr2 $loc(e1) $loc(e2)) Expr } +(* Added this form for sequencing; *) +(* but it results in an additional shift/reduce conflict *) +(* ... which is actually be benign, since the same conflict already *) +(* exists for the previous production *) + | e1=noSeqTerm op=SEMICOLON_OP e2=term + { let t = match op with + | Some op -> + let op = mk_ident ("let" ^ op, rr $loc(op)) in + let pat = mk_pattern (PatWild(None, [])) (rr $loc(op)) in + LetOperator ([(op, pat, e1)], e2) + | None -> + log_issue_text (rr $loc) Warning_DeprecatedLightDoNotation do_notation_deprecation_warning; + Bind(gen (rr $loc(op)), e1, e2) + in mk_term t (rr2 $loc(e1) $loc(e2)) Expr + } + | x=lidentOrUnderscore LONG_LEFT_ARROW e1=noSeqTerm SEMICOLON e2=term + { log_issue_text (rr $loc) Warning_DeprecatedLightDoNotation do_notation_deprecation_warning; + mk_term (Bind(x, e1, e2)) (rr2 $loc(x) $loc(e2)) Expr } + +match_returning: + | as_opt=option(AS i=lident {i}) RETURNS t=tmIff {as_opt,t,false} + | as_opt=option(AS i=lident {i}) RETURNS_EQ t=tmIff {as_opt,t,true} + +%public +noSeqTerm: + | t=typ { t } + | e=tmIff SUBTYPE t=tmIff + { mk_term (Ascribed(e,{t with level=Expr},None,false)) (rr $loc(e)) Expr } + | e=tmIff SUBTYPE t=tmIff BY tactic=thunk(typ) + { mk_term (Ascribed(e,{t with level=Expr},Some tactic,false)) (rr2 $loc(e) $loc(tactic)) Expr } + | e=tmIff EQUALTYPE t=tmIff + { + log_issue_text (rr $loc) Warning_BleedingEdge_Feature + "Equality type ascriptions is an experimental feature subject to redesign in the future"; + mk_term (Ascribed(e,{t with level=Expr},None,true)) (rr $loc(e)) Expr + } + | e=tmIff EQUALTYPE t=tmIff BY tactic=thunk(typ) + { + log_issue_text (rr $loc) Warning_BleedingEdge_Feature + "Equality type ascriptions is an experimental feature subject to redesign in the future"; + mk_term (Ascribed(e,{t with level=Expr},Some tactic,true)) (rr2 $loc(e) $loc(tactic)) Expr + } + | e1=atomicTermNotQUident op_expr=dotOperator LARROW e3=noSeqTerm + { + let (op, e2, _) = op_expr in + let opid = mk_ident (string_of_id op ^ "<-", range_of_id op) in + mk_term (Op(opid, [ e1; e2; e3 ])) (rr2 $loc(e1) $loc(e3)) Expr + } + | REQUIRES t=typ + { mk_term (Requires(t, None)) (rr2 $loc($1) $loc(t)) Type_level } + | ENSURES t=typ + { mk_term (Ensures(t, None)) (rr2 $loc($1) $loc(t)) Type_level } + | DECREASES t=typ + { mk_term (Decreases (t, None)) (rr2 $loc($1) $loc(t)) Type_level } + | DECREASES LBRACE_COLON_WELL_FOUNDED t=noSeqTerm RBRACE + (* + * decreases clause with relation is written as e1 e2, + * where e1 is a relation and e2 is a term + * + * this is parsed as an app node, so we destruct the app node + *) + { match t.tm with + | App (t1, t2, _) -> + let ot = mk_term (WFOrder (t1, t2)) (rr2 $loc(t) $loc(t)) Type_level in + mk_term (Decreases (ot, None)) (rr2 $loc($1) $loc($4)) Type_level + | _ -> + raise_error_text (rr $loc(t)) Fatal_SyntaxError + "Syntax error: To use well-founded relations, write e1 e2" + } + + | ATTRIBUTES es=nonempty_list(atomicTerm) + { mk_term (Attributes es) (rr2 $loc($1) $loc(es)) Type_level } + | op=ifMaybeOp e1=noSeqTerm ret_opt=option(match_returning) THEN e2=noSeqTerm ELSE e3=noSeqTerm + { mk_term (If(e1, op, ret_opt, e2, e3)) (rr2 $loc(op) $loc(e3)) Expr } + | op=ifMaybeOp e1=noSeqTerm ret_opt=option(match_returning) THEN e2=noSeqTerm + { + let e3 = mk_term (Const Const_unit) (rr2 $loc(op) $loc(e2)) Expr in + mk_term (If(e1, op, ret_opt, e2, e3)) (rr2 $loc(op) $loc(e2)) Expr + } + | TRY e1=term WITH pbs=left_flexible_nonempty_list(BAR, patternBranch) + { + let branches = focusBranches (pbs) (rr2 $loc($1) $loc(pbs)) in + mk_term (TryWith(e1, branches)) (rr2 $loc($1) $loc(pbs)) Expr + } + | op=matchMaybeOp e=term ret_opt=option(match_returning) WITH pbs=left_flexible_list(BAR, pb=patternBranch {pb}) + { + let branches = focusBranches pbs (rr2 $loc(op) $loc(pbs)) in + mk_term (Match(e, op, ret_opt, branches)) (rr2 $loc(op) $loc(pbs)) Expr + } + | LET OPEN t=term IN e=term + { + match t.tm with + | Ascribed(r, rty, None, _) -> + mk_term (LetOpenRecord(r, rty, e)) (rr2 $loc($1) $loc(e)) Expr + + | Name uid -> + mk_term (LetOpen(uid, e)) (rr2 $loc($1) $loc(e)) Expr + + | _ -> + raise_error_text (rr $loc(t)) Fatal_SyntaxError + "Syntax error: local opens expects either opening\n\ + a module or namespace using `let open T in e`\n\ + or, a record type with `let open e <: t in e'`" + } + + | attrs=ioption(attribute) + LET q=letqualifier lb=letbinding lbs=list(attr_letbinding) IN e=term + { + let lbs = (attrs, lb)::lbs in + let lbs = focusAttrLetBindings lbs (rr2 $loc(q) $loc(lb)) in + mk_term (Let(q, lbs, e)) (rr $loc) Expr + } + | op=let_op b=letoperatorbinding lbs=list(op=and_op b=letoperatorbinding {(op, b)}) IN e=term + { let lbs = (op, b)::lbs in + mk_term (LetOperator ( List.map (fun (op, (pat, tm)) -> (op, pat, tm)) lbs + , e)) (rr2 $loc(op) $loc(e)) Expr + } + | FUNCTION pbs=left_flexible_nonempty_list(BAR, patternBranch) + { + let branches = focusBranches pbs (rr2 $loc($1) $loc(pbs)) in + mk_function branches (rr $loc) (rr2 $loc($1) $loc(pbs)) + } + | a=ASSUME e=noSeqTerm + { let a = set_lid_range assume_lid (rr $loc(a)) in + mkExplicitApp (mk_term (Var a) (rr $loc(a)) Expr) [e] (rr $loc) + } + + | a=ASSERT e=noSeqTerm + { + let a = set_lid_range assert_lid (rr $loc(a)) in + mkExplicitApp (mk_term (Var a) (rr $loc(a)) Expr) [e] (rr $loc) + } + + | a=ASSERT e=noSeqTerm BY tactic=thunk2(typ) + { + let a = set_lid_range assert_by_tactic_lid (rr $loc(a)) in + mkExplicitApp (mk_term (Var a) (rr $loc(a)) Expr) [e; tactic] (rr $loc) + } + + | u=UNDERSCORE BY tactic=thunk(atomicTerm) + { + let a = set_lid_range synth_lid (rr $loc(u)) in + mkExplicitApp (mk_term (Var a) (rr $loc(u)) Expr) [tactic] (rr $loc) + } + + | s=SYNTH tactic=atomicTerm + { + let a = set_lid_range synth_lid (rr $loc(s)) in + mkExplicitApp (mk_term (Var a) (rr $loc(s)) Expr) [tactic] (rr $loc) + } + + | CALC rel=atomicTerm LBRACE init=noSeqTerm SEMICOLON steps=list(calcStep) RBRACE + { + mk_term (CalcProof (rel, init, steps)) (rr2 $loc($1) $loc($7)) Expr + } + + | INTRO FORALL bs=binders DOT p=noSeqTerm WITH e=noSeqTerm + { + mk_term (IntroForall(bs, p, e)) (rr2 $loc($1) $loc(e)) Expr + } + + | INTRO EXISTS bs=binders DOT p=noSeqTerm WITH vs=list(atomicTerm) AND e=noSeqTerm + { + if List.length bs <> List.length vs + then raise_error_text (rr $loc(vs)) Fatal_SyntaxError "Syntax error: expected instantiations for all binders" + else mk_term (IntroExists(bs, p, vs, e)) (rr2 $loc($1) $loc(e)) Expr + } + + | INTRO p=tmFormula IMPLIES q=tmFormula WITH y=singleBinder DOT e=noSeqTerm + { + mk_term (IntroImplies(p, q, y, e)) (rr2 $loc($1) $loc(e)) Expr + } + + | INTRO p=tmFormula DISJUNCTION q=tmConjunction WITH lr=NAME e=noSeqTerm + { + let b = + if lr = "Left" then true + else if lr = "Right" then false + else raise_error_text (rr $loc(lr)) Fatal_SyntaxError "Syntax error: _intro_ \\/ expects either 'Left' or 'Right'" + in + mk_term (IntroOr(b, p, q, e)) (rr2 $loc($1) $loc(e)) Expr + } + + | INTRO p=tmConjunction CONJUNCTION q=tmTuple WITH e1=noSeqTerm AND e2=noSeqTerm + { + mk_term (IntroAnd(p, q, e1, e2)) (rr2 $loc($1) $loc(e2)) Expr + } + + | ELIM FORALL xs=binders DOT p=noSeqTerm WITH vs=list(atomicTerm) + { + mk_term (ElimForall(xs, p, vs)) (rr2 $loc($1) $loc(vs)) Expr + } + + | ELIM EXISTS bs=binders DOT p=noSeqTerm RETURNS q=noSeqTerm WITH y=singleBinder DOT e=noSeqTerm + { + mk_term (ElimExists(bs, p, q, y, e)) (rr2 $loc($1) $loc(e)) Expr + } + + | ELIM p=tmFormula IMPLIES q=tmFormula WITH e=noSeqTerm + { + mk_term (ElimImplies(p, q, e)) (rr2 $loc($1) $loc(e)) Expr + } + + | ELIM p=tmFormula DISJUNCTION q=tmConjunction RETURNS r=noSeqTerm WITH x=singleBinder DOT e1=noSeqTerm AND y=singleBinder DOT e2=noSeqTerm + { + mk_term (ElimOr(p, q, r, x, e1, y, e2)) (rr2 $loc($1) $loc(e2)) Expr + } + + | ELIM p=tmConjunction CONJUNCTION q=tmTuple RETURNS r=noSeqTerm WITH xs=binders DOT e=noSeqTerm + { + match xs with + | [x;y] -> mk_term (ElimAnd(p, q, r, x, y, e)) (rr2 $loc($1) $loc(e)) Expr + } + +singleBinder: + | bs=binders + { + match bs with + | [b] -> b + | _ -> raise_error_text (rr $loc(bs)) Fatal_SyntaxError "Syntax error: expected a single binder" + } + +calcRel: + | i=binop_name { mk_term (Op (i, [])) (rr $loc(i)) Expr } + | BACKTICK id=qlident BACKTICK { mk_term (Var id) (rr $loc) Un } + | t=atomicTerm { t } + +calcStep: + | rel=calcRel LBRACE justif=option(term) RBRACE next=noSeqTerm SEMICOLON + { + let justif = + match justif with + | Some t -> t + | None -> mk_term (Const Const_unit) (rr2 $loc($2) $loc($4)) Expr + in + CalcStep (rel, justif, next) + } + +%inline +typ: + | t=simpleTerm { t } + +%public +%inline quantifier: + | FORALL { fun x -> QForall x } + | EXISTS { fun x -> QExists x} + | op=FORALL_OP + { + let op = mk_ident("forall" ^ op, rr $loc(op)) in + fun (x,y,z) -> QuantOp (op, x, y, z) + } + | op=EXISTS_OP + { + let op = mk_ident("exists" ^ op, rr $loc(op)) in + fun (x,y,z) -> QuantOp (op, x, y, z) + } + +%public +trigger: + | { [] } + | LBRACE_COLON_PATTERN pats=disjunctivePats RBRACE { pats } + +disjunctivePats: + | pats=separated_nonempty_list(DISJUNCTION, conjunctivePat) { pats } + +conjunctivePat: + | pats=separated_nonempty_list(SEMICOLON, appTerm) { pats } + +%inline simpleTerm: + | e=tmIff { e } + +maybeFocusArrow: + | RARROW { false } + | SQUIGGLY_RARROW { true } + +patternBranch: + | pat=disjunctivePattern when_opt=maybeWhen focus=maybeFocusArrow e=term + { + let pat = match pat with + | [p] -> p + | ps -> mk_pattern (PatOr ps) (rr2 $loc(pat) $loc(pat)) + in + (focus, (pat, when_opt, e)) + } + +%inline maybeWhen: + | { None } + | WHEN e=tmFormula { Some e } + + + +tmIff: + | e1=tmImplies tok=IFF e2=tmIff + { mk_term (Op(mk_ident("<==>", rr $loc(tok)), [e1; e2])) (rr2 $loc(e1) $loc(e2)) Formula } + | e=tmImplies { e } + +tmImplies: + | e1=tmArrow(tmFormula) tok=IMPLIES e2=tmImplies + { mk_term (Op(mk_ident("==>", rr $loc(tok)), [e1; e2])) (rr2 $loc(e1) $loc(e2)) Formula } + | e=tmArrow(tmFormula) + { e } + + +(* Tm : either tmFormula, containing EQUALS or tmNoEq, without EQUALS *) +tmArrow(Tm): + | dom=tmArrowDomain(Tm) RARROW tgt=tmArrow(Tm) + { + let ((aq_opt, attrs), dom_tm) = dom in + let b = match extract_named_refinement true dom_tm with + | None -> mk_binder_with_attrs (NoName dom_tm) (rr $loc(dom)) Un aq_opt attrs + | Some (x, t, f) -> mkRefinedBinder x t true f (rr2 $loc(dom) $loc(dom)) aq_opt attrs + in + mk_term (Product([b], tgt)) (rr2 $loc(dom) $loc(tgt)) Un + } + | e=Tm { e } + +simpleArrow: + | dom=simpleArrowDomain RARROW tgt=simpleArrow + { + let ((aq_opt, attrs), dom_tm) = dom in + let b = match extract_named_refinement true dom_tm with + | None -> mk_binder_with_attrs (NoName dom_tm) (rr $loc(dom)) Un aq_opt attrs + | Some (x, t, f) -> mkRefinedBinder x t true f (rr2 $loc(dom) $loc(dom)) aq_opt attrs + in + mk_term (Product([b], tgt)) (rr2 $loc(dom) $loc(tgt)) Un + } + | e=tmEqNoRefinement { e } + +simpleArrowDomain: + | LBRACE_BAR t=tmEqNoRefinement BAR_RBRACE { ((Some TypeClassArg, []), t) } + | aq_opt=ioption(aqual) attrs_opt=ioption(binderAttributes) dom_tm=tmEqNoRefinement { (aq_opt, none_to_empty_list attrs_opt), dom_tm } + +(* Tm already accounts for ( term ), we need to add an explicit case for (#Tm), (#[@@@...]Tm) and ([@@@...]Tm) *) +%inline tmArrowDomain(Tm): + | LBRACE_BAR t=Tm BAR_RBRACE { ((Some TypeClassArg, []), t) } + | LPAREN q=aqual attrs_opt=ioption(binderAttributes) dom_tm=Tm RPAREN { (Some q, none_to_empty_list attrs_opt), dom_tm } + | LPAREN attrs=binderAttributes dom_tm=Tm RPAREN { (None, attrs), dom_tm } + | aq_opt=ioption(aqual) attrs_opt=ioption(binderAttributes) dom_tm=Tm { (aq_opt, none_to_empty_list attrs_opt), dom_tm } + +tmFormula: + | e1=tmFormula tok=DISJUNCTION e2=tmConjunction + { mk_term (Op(mk_ident("\\/", rr $loc(tok)), [e1;e2])) (rr2 $loc(e1) $loc(e2)) Formula } + | e=tmConjunction { e } + +tmConjunction: + | e1=tmConjunction tok=CONJUNCTION e2=tmTuple + { mk_term (Op(mk_ident("/\\", rr $loc(tok)), [e1;e2])) (rr2 $loc(e1) $loc(e2)) Formula } + | e=tmTuple { e } + +tmTuple: + | el=separated_nonempty_list(COMMA, tmEq) + { + match el with + | [x] -> x + | components -> mkTuple components (rr2 $loc(el) $loc(el)) + } + + + +%public +tmEqWith(X): + | e1=tmEqWith(X) tok=EQUALS e2=tmEqWith(X) + { mk_term (Op(mk_ident("=", rr $loc(tok)), [e1; e2])) (rr $loc) Un} + (* non-associativity of COLON_EQUALS is currently not well handled by fsyacc which reports a s/r conflict *) + (* see https:/ /github.com/fsprojects/FsLexYacc/issues/39 *) + | e1=tmEqWith(X) tok=COLON_EQUALS e2=tmEqWith(X) + { mk_term (Op(mk_ident(":=", rr $loc(tok)), [e1; e2])) (rr $loc) Un} + + | e1=tmEqWith(X) op=PIPE_LEFT e2=tmEqWith(X) + { mk_term (Op(mk_ident("<|", rr $loc(op)), [e1; e2])) (rr $loc) Un} + + | e1=tmEqWith(X) op=PIPE_RIGHT e2=tmEqWith(X) + { mk_term (Op(mk_ident("|>", rr $loc(op)), [e1; e2])) (rr $loc) Un} + + + | e1=tmEqWith(X) op=operatorInfix0ad12 e2=tmEqWith(X) + { mk_term (Op(op, [e1; e2])) (rr2 $loc(e1) $loc(e2)) Un} + | e1=tmEqWith(X) tok=MINUS e2=tmEqWith(X) + { mk_term (Op(mk_ident("-", rr $loc(tok)), [e1; e2])) (rr $loc) Un} + | tok=MINUS e=tmEqWith(X) + { mk_uminus e (rr $loc(tok)) (rr $loc) Expr } + | QUOTE e=tmEqWith(X) + { mk_term (Quote (e, Dynamic)) (rr $loc) Un } + | BACKTICK e=tmEqWith(X) + { mk_term (Quote (e, Static)) (rr $loc) Un } + | BACKTICK_AT e=atomicTerm + { let q = mk_term (Quote (e, Dynamic)) (rr $loc) Un in + mk_term (Antiquote q) (rr $loc) Un } + | BACKTICK_HASH e=atomicTerm + { mk_term (Antiquote e) (rr $loc) Un } + | e=tmNoEqWith(X) + { e } + +%inline recordTerm: + | LBRACE e=recordExp RBRACE { e } + +tmNoEqWith(X): + | e1=tmNoEqWith(X) COLON_COLON e2=tmNoEqWith(X) + { consTerm (rr $loc) e1 e2 } + | e1=tmNoEqWith(X) AMP e2=tmNoEqWith(X) + { + let dom = + match extract_named_refinement false e1 with + | Some (x, t, f) -> + let dom = mkRefinedBinder x t true f (rr $loc(e1)) None [] in + Inl dom + | _ -> + Inr e1 + in + let tail = e2 in + let dom, res = + match tail.tm with + | Sum(dom', res) -> dom::dom', res + | _ -> [dom], tail + in + mk_term (Sum(dom, res)) (rr2 $loc(e1) $loc(e2)) Type_level + } + | e1=tmNoEqWith(X) op=OPINFIX3 e2=tmNoEqWith(X) + { mk_term (Op(mk_ident(op, rr $loc(op)), [e1; e2])) (rr $loc) Un} + | e1=tmNoEqWith(X) BACKTICK op=tmNoEqWith(X) BACKTICK e2=tmNoEqWith(X) + { mkApp op [ e1, Infix; e2, Nothing ] (rr $loc) } + | e1=tmNoEqWith(X) op=OPINFIX4 e2=tmNoEqWith(X) + { mk_term (Op(mk_ident(op, rr $loc(op)), [e1; e2])) (rr $loc) Un} + | e=recordTerm { e } + | BACKTICK_PERC e=atomicTerm + { mk_term (VQuote e) (rr $loc) Un } + | op=TILDE e=atomicTerm + { mk_term (Op(mk_ident (op, rr $loc(op)), [e])) (rr $loc) Formula } + | e=X { e } + +binop_name: + | o=OPINFIX0a { mk_ident (o, rr $loc) } + | o=OPINFIX0b { mk_ident (o, rr $loc) } + | o=OPINFIX0c { mk_ident (o, rr $loc) } + | o=EQUALS { mk_ident ("=", rr $loc) } + | o=OPINFIX0d { mk_ident (o, rr $loc) } + | o=OPINFIX1 { mk_ident (o, rr $loc) } + | o=OPINFIX2 { mk_ident (o, rr $loc) } + | o=OPINFIX3 { mk_ident (o, rr $loc) } + | o=OPINFIX4 { mk_ident (o, rr $loc) } + | o=IMPLIES { mk_ident ("==>", rr $loc) } + | o=CONJUNCTION { mk_ident ("/\\", rr $loc) } + | o=DISJUNCTION { mk_ident ("\\/", rr $loc) } + | o=IFF { mk_ident ("<==>", rr $loc) } + | o=COLON_EQUALS { mk_ident (":=", rr $loc) } + | o=COLON_COLON { mk_ident ("::", rr $loc) } + | o=OP_MIXFIX_ASSIGNMENT { mk_ident (o, rr $loc) } + | o=OP_MIXFIX_ACCESS { mk_ident (o, rr $loc) } + +tmEqNoRefinement: + | e=tmEqWith(appTermNoRecordExp) { e } + +tmEq: + | e=tmEqWith(tmRefinement) { e } + +tmNoEq: + | e=tmNoEqWith(tmRefinement) { e } + +tmRefinement: + | id=lidentOrUnderscore COLON e=appTermNoRecordExp phi_opt=refineOpt + { + let t = match phi_opt with + | None -> NamedTyp(id, e) + | Some phi -> Refine(mk_binder (Annotated(id, e)) (rr2 $loc(id) $loc(e)) Type_level None, phi) + in mk_term t (rr2 $loc(id) $loc(phi_opt)) Type_level + } + | e=appTerm { e } + +refineOpt: + | phi_opt=option(LBRACE phi=formula RBRACE {phi}) {phi_opt} + +%inline formula: + | e=noSeqTerm { {e with level=Formula} } + +%public +recordExp: + | record_fields=right_flexible_nonempty_list(SEMICOLON, simpleDef) + { mk_term (Record (None, record_fields)) (rr $loc(record_fields)) Expr } + | e=appTerm WITH record_fields=right_flexible_nonempty_list(SEMICOLON, simpleDef) + { mk_term (Record (Some e, record_fields)) (rr2 $loc(e) $loc(record_fields)) Expr } + +simpleDef: + | e=separated_pair(qlidentOrOperator, EQUALS, noSeqTerm) { e } + | lid=qlidentOrOperator { lid, mk_term (Name (lid_of_ids [ ident_of_lid lid ])) (rr $loc(lid)) Un } + +appTermArgs: + | h=maybeHash a=onlyTrailingTerm { [h, a] } + | h=maybeHash a=indexingTerm rest=appTermArgs { (h, a) :: rest } + | h=maybeHash a=recordTerm rest=appTermArgs { (h, a) :: rest } + | a=universe rest=appTermArgs { a :: rest } + | { [] } + +appTermCommon(args): + | head=indexingTerm args=args + { mkApp head (map (fun (x,y) -> (y,x)) args) (rr2 $loc(head) $loc(args)) } + +%public +appTerm: + | t=onlyTrailingTerm { t } + | t=appTermCommon(appTermArgs) { t } + +appTermArgsNoRecordExp: + | h=maybeHash a=indexingTerm rest=appTermArgsNoRecordExp { (h, a) :: rest } + | a=universe rest=appTermArgsNoRecordExp { a :: rest } + | { [] } + +%public +appTermNoRecordExp: + | t=appTermCommon(appTermArgsNoRecordExp) {t} + +%inline maybeHash: + | { Nothing } + | HASH { Hash } + +%public +indexingTerm: + | e1=atomicTermNotQUident op_exprs=nonempty_list(dotOperator) + { + List.fold_left (fun e1 (op, e2, r) -> + mk_term (Op(op, [ e1; e2 ])) (union_ranges e1.range r) Expr) + e1 op_exprs + } + | e=atomicTerm + { e } + +%public +atomicTerm: + | x=atomicTermNotQUident + { x } + | x=atomicTermQUident + { x } + | x=opPrefixTerm(atomicTermQUident) + { x } + +trailingTerm: + | x=atomicTerm + { x } + | x=onlyTrailingTerm + { x } + +onlyTrailingTerm: + | FUN pats=nonempty_list(patternOrMultibinder) RARROW e=term + { mk_term (Abs(flatten pats, e)) (rr2 $loc($1) $loc(e)) Un } + | q=quantifier bs=binders DOT trigger=trigger e=term + { + match bs with + | [] -> + raise_error_text (rr2 $loc(q) $loc($3)) Fatal_MissingQuantifierBinder "Missing binders for a quantifier" + | _ -> + let idents = idents_of_binders bs (rr2 $loc(q) $loc($3)) in + mk_term (q (bs, (idents, trigger), e)) (rr2 $loc(q) $loc(e)) Formula + } + +atomicTermQUident: + | id=quident + { + let t = Name id in + let e = mk_term t (rr $loc(id)) Un in + e + } + | id=quident DOT_LPAREN t=term RPAREN + { + mk_term (LetOpen (id, t)) (rr2 $loc(id) $loc($4)) Expr + } + +atomicTermNotQUident: + | UNDERSCORE { mk_term Wild (rr $loc) Un } + | tv=tvar { mk_term (Tvar tv) (rr $loc) Type_level } + | c=constant { mk_term (Const c) (rr $loc) Expr } + | x=opPrefixTerm(atomicTermNotQUident) + { x } + | LPAREN op=operator RPAREN + { mk_term (Op(op, [])) (rr2 $loc($1) $loc($3)) Un } + | LENS_PAREN_LEFT e0=tmEq COMMA el=separated_nonempty_list(COMMA, tmEq) LENS_PAREN_RIGHT + { mkDTuple (e0::el) (rr2 $loc($1) $loc($5)) } + | e=projectionLHS field_projs=list(DOT id=qlident {id}) + { fold_left (fun e lid -> mk_term (Project(e, lid)) (rr2 $loc(e) $loc(field_projs)) Expr ) e field_projs } + | BEGIN e=term END + { e } + +(* Tm: atomicTermQUident or atomicTermNotQUident *) +opPrefixTerm(Tm): + | op=OPPREFIX e=Tm + { mk_term (Op(mk_ident(op, rr $loc(op)), [e])) (rr2 $loc(op) $loc(e)) Expr } + + +projectionLHS: + | e=qidentWithTypeArgs(qlident, option(fsTypeArgs)) + { e } + | e=qidentWithTypeArgs(quident, some(fsTypeArgs)) + { e } + | LPAREN e=term sort_opt=option(pair(hasSort, simpleTerm)) RPAREN + { + (* Note: we have to keep the parentheses here. Consider t * u * v. This + * is parsed as Op2( *, Op2( *, t, u), v). The desugaring phase then looks + * up * and figures out that it hasn't been overridden, meaning that + * it's a tuple type, and proceeds to flatten out the whole tuple. Now + * consider (t * u) * v. We keep the Paren node, which prevents the + * flattening from happening, hence ensuring the proper type is + * generated. *) + let e1 = match sort_opt with + | None -> e + | Some (level, t) -> mk_term (Ascribed(e,{t with level=level},None,false)) (rr2 $loc($1) $loc($4)) level + in mk_term (Paren e1) (rr2 $loc($1) $loc($4)) (e.level) + } + | LBRACK es=semiColonTermList RBRACK + { mkListLit (rr2 $loc($1) $loc($3)) es } + | SEQ_BANG_LBRACK es=semiColonTermList RBRACK + { mkSeqLit (rr2 $loc($1) $loc($3)) es } + | PERCENT_LBRACK es=semiColonTermList RBRACK + { mk_term (LexList es) (rr2 $loc($1) $loc($3)) Type_level } + | BANG_LBRACE es=separated_list(COMMA, appTerm) RBRACE + { mkRefSet (rr2 $loc($1) $loc($3)) es } + | ns=quident QMARK_DOT id=lident + { mk_term (Projector (ns, id)) (rr2 $loc(ns) $loc(id)) Expr } + | lid=quident QMARK + { mk_term (Discrim lid) (rr2 $loc(lid) $loc($2)) Un } + +fsTypeArgs: + | TYP_APP_LESS targs=separated_nonempty_list(COMMA, atomicTerm) TYP_APP_GREATER + {targs} + +(* Qid : quident or qlident. + TypeArgs : option(fsTypeArgs) or someFsTypeArgs. *) +qidentWithTypeArgs(Qid,TypeArgs): + | id=Qid targs_opt=TypeArgs + { + let t = if is_name id then Name id else Var id in + let e = mk_term t (rr $loc(id)) Un in + match targs_opt with + | None -> e + | Some targs -> mkFsTypApp e targs (rr2 $loc(id) $loc(targs_opt)) + } + +hasSort: + (* | SUBTYPE { Expr } *) + | SUBKIND { Type_level } (* Remove with stratify *) + + (* use flexible_list *) +%inline semiColonTermList: + | l=right_flexible_list(SEMICOLON, noSeqTerm) { l } + +constant: + | LPAREN_RPAREN { Const_unit } + | n=INT + { + if snd n then + log_issue_text (rr $loc) Error_OutOfRange "This number is outside the allowable range for representable integer constants"; + Const_int (fst n, None) + } + | c=CHAR { Const_char c } + | s=STRING { Const_string (s, rr $loc) } + | TRUE { Const_bool true } + | FALSE { Const_bool false } + | r=REAL { Const_real r } + | n=UINT8 { Const_int (n, Some (Unsigned, Int8)) } + | n=INT8 + { + if snd n then + log_issue_text (rr $loc) Error_OutOfRange "This number is outside the allowable range for 8-bit signed integers"; + Const_int (fst n, Some (Signed, Int8)) + } + | n=UINT16 { Const_int (n, Some (Unsigned, Int16)) } + | n=INT16 + { + if snd n then + log_issue_text (rr $loc) Error_OutOfRange "This number is outside the allowable range for 16-bit signed integers"; + Const_int (fst n, Some (Signed, Int16)) + } + | n=UINT32 { Const_int (n, Some (Unsigned, Int32)) } + | n=INT32 + { + if snd n then + log_issue_text (rr $loc) Error_OutOfRange "This number is outside the allowable range for 32-bit signed integers"; + Const_int (fst n, Some (Signed, Int32)) + } + | n=UINT64 { Const_int (n, Some (Unsigned, Int64)) } + | n=INT64 + { + if snd n then + log_issue_text (rr $loc) Error_OutOfRange "This number is outside the allowable range for 64-bit signed integers"; + Const_int (fst n, Some (Signed, Int64)) + } + | n=SIZET { Const_int (n, Some (Unsigned, Sizet)) } + (* TODO : What about reflect ? There is also a constant representing it *) + | REIFY { Const_reify None } + | RANGE_OF { Const_range_of } + | SET_RANGE_OF { Const_set_range_of } + + +universe: + | UNIV_HASH ua=atomicUniverse { (UnivApp, ua) } + +universeFrom: + | ua=atomicUniverse { ua } + | u1=universeFrom op_plus=OPINFIX2 u2=universeFrom + { + if op_plus <> "+" + then log_issue_text (rr $loc(u1)) Error_OpPlusInUniverse ("The operator " ^ op_plus ^ " was found in universe context." + ^ "The only allowed operator in that context is +."); + mk_term (Op(mk_ident (op_plus, rr $loc(op_plus)), [u1 ; u2])) (rr2 $loc(u1) $loc(u2)) Expr + } + | max=ident us=nonempty_list(atomicUniverse) + { + if string_of_id max <> string_of_lid max_lid + then log_issue_text (rr $loc(max)) Error_InvalidUniverseVar ("A lower case ident " ^ string_of_id max ^ + " was found in a universe context. " ^ + "It should be either max or a universe variable 'usomething."); + let max = mk_term (Var (lid_of_ids [max])) (rr $loc(max)) Expr in + mkApp max (map (fun u -> u, Nothing) us) (rr $loc) + } + +atomicUniverse: + | UNDERSCORE + { mk_term Wild (rr $loc) Expr } + | n=INT + { + if snd n then + log_issue_text (rr $loc) Error_OutOfRange ("This number is outside the allowable range for representable integer constants"); + mk_term (Const (Const_int (fst n, None))) (rr $loc(n)) Expr + } + | u=lident { mk_term (Uvar u) (range_of_id u) Expr } + | LPAREN u=universeFrom RPAREN + { u (*mk_term (Paren u) (rr2 $loc($1) $loc($3)) Expr*) } + +warn_error_list: + | e=warn_error EOF { e } + +warn_error: + | f=flag r=range + { [(f, r)] } + | f=flag r=range e=warn_error + { (f, r) :: e } + +flag: + | op=OPINFIX1 + { if op = "@" then CAlwaysError else failwith (format1 "unexpected token %s in warn-error list" op)} + | op=OPINFIX2 + { if op = "+" then CWarning else failwith (format1 "unexpected token %s in warn-error list" op)} + | MINUS + { CSilent } + +range: + | i=INT + { format2 "%s..%s" (fst i) (fst i) } + | r=RANGE + { r } + + +/******************************************************************************/ +/* Miscellanous, tools */ +/******************************************************************************/ + +string: + | s=STRING { s } + +%inline operator: + | op=OPPREFIX { mk_ident (op, rr $loc) } + | op=binop_name { op } + | op=TILDE { mk_ident (op, rr $loc) } + | op=and_op {op} + | op=let_op {op} + | op=quantifier_op {op} + +%inline quantifier_op: + | op=EXISTS_OP { mk_ident ("exists" ^ op, rr $loc) } + | op=FORALL_OP { mk_ident ("forall" ^ op, rr $loc) } + +%inline and_op: + | op=AND_OP { mk_ident ("and" ^ op, rr $loc) } +%inline let_op: + | op=LET_OP { mk_ident ("let" ^ op, rr $loc) } + +/* These infix operators have a lower precedence than EQUALS */ +%inline operatorInfix0ad12: + | op=OPINFIX0a + | op=OPINFIX0b + | op=OPINFIX0c + | op=OPINFIX0d + | op=OPINFIX1 + | op=OPINFIX2 + { mk_ident (op, rr $loc) } + +%inline dotOperator: + | op=DOT_LPAREN e=term RPAREN { mk_ident (".()", rr $loc(op)), e, rr2 $loc(op) $loc($3) } + | op=DOT_LBRACK e=term RBRACK { mk_ident (".[]", rr $loc(op)), e, rr2 $loc(op) $loc($3) } + | op=DOT_LBRACK_BAR e=term BAR_RBRACK { mk_ident (".[||]", rr $loc(op)), e, rr2 $loc(op) $loc($3) } + | op=DOT_LENS_PAREN_LEFT e=term LENS_PAREN_RIGHT { mk_ident (".(||)", rr $loc(op)), e, rr2 $loc(op) $loc($3) } + +some(X): + | x=X { Some x } + +right_flexible_list(SEP, X): + | { [] } + | x=X { [x] } + | x=X SEP xs=right_flexible_list(SEP, X) { x :: xs } + +right_flexible_nonempty_list(SEP, X): + | x=X { [x] } + | x=X SEP xs=right_flexible_list(SEP, X) { x :: xs } + +reverse_left_flexible_list(delim, X): +| (* nothing *) + { [] } +| x = X + { [x] } +| xs = reverse_left_flexible_list(delim, X) delim x = X + { x :: xs } + +%inline left_flexible_list(delim, X): + xs = reverse_left_flexible_list(delim, X) + { List.rev xs } + +reverse_left_flexible_nonempty_list(delim, X): +| ioption(delim) x = X + { [x] } +| xs = reverse_left_flexible_nonempty_list(delim, X) delim x = X + { x :: xs } + +%inline left_flexible_nonempty_list(delim, X): + xs = reverse_left_flexible_nonempty_list(delim, X) + { List.rev xs } diff --git a/stage0/fstar-lib/FStarC_Parser_ParseIt.ml b/stage0/dune/fstar-guts/ml/FStarC_Parser_ParseIt.ml similarity index 89% rename from stage0/fstar-lib/FStarC_Parser_ParseIt.ml rename to stage0/dune/fstar-guts/ml/FStarC_Parser_ParseIt.ml index 792cd095f58..707bb89a0c1 100644 --- a/stage0/fstar-lib/FStarC_Parser_ParseIt.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Parser_ParseIt.ml @@ -1,4 +1,4 @@ -module U = FStarC_Compiler_Util +module U = FStarC_Util open FStarC_Errors open FStarC_Syntax_Syntax open Lexing @@ -37,7 +37,7 @@ let find_file filename = | Some s -> s | None -> - raise_error_text FStarC_Compiler_Range.dummyRange Fatal_ModuleOrFileNotFound (U.format1 "Unable to find file: %s\n" filename) + raise_error_text FStarC_Range.dummyRange Fatal_ModuleOrFileNotFound (U.format1 "Unable to find file: %s\n" filename) let vfs_entries : (U.time_of_day * string) U.smap = U.smap_create (Z.of_int 1) @@ -62,10 +62,10 @@ let read_physical_file (filename: string) = (fun channel -> really_input_string channel (in_channel_length channel)) channel with e -> - raise_error_text FStarC_Compiler_Range.dummyRange Fatal_UnableToReadFile (U.format1 "Unable to read file %s\n" filename) + raise_error_text FStarC_Range.dummyRange Fatal_UnableToReadFile (U.format1 "Unable to read file %s\n" filename) let read_file (filename:string) = - let debug = FStarC_Compiler_Debug.any () in + let debug = FStarC_Debug.any () in match read_vfs_entry filename with | Some (_mtime, contents) -> if debug then U.print1 "Reading in-memory file %s\n" filename; @@ -88,7 +88,7 @@ let has_extension file extensions = let check_extension fn = if (not (has_extension fn (valid_extensions ()))) then let message = U.format1 "Unrecognized extension '%s'" fn in - raise_error_text FStarC_Compiler_Range.dummyRange Fatal_UnrecognizedExtension + raise_error_text FStarC_Range.dummyRange Fatal_UnrecognizedExtension (if has_extension fn fs_extensions then message ^ " (pass --MLish to process .fs and .fsi files)" else message) @@ -99,31 +99,31 @@ type parse_frag = | Incremental of input_frag | Fragment of input_frag -type parse_error = (Codes.error_code * Msg.error_message * FStarC_Compiler_Range.range) +type parse_error = (Codes.error_code * Msg.error_message * FStarC_Range.range) type code_fragment = { - range: FStarC_Compiler_Range.range; + range: FStarC_Range.range; code: string; } type 'a incremental_result = - ('a * code_fragment) list * (string * FStarC_Compiler_Range.range) list * parse_error option + ('a * code_fragment) list * (string * FStarC_Range.range) list * parse_error option type parse_result = - | ASTFragment of (FStarC_Parser_AST.inputFragment * (string * FStarC_Compiler_Range.range) list) + | ASTFragment of (FStarC_Parser_AST.inputFragment * (string * FStarC_Range.range) list) | IncrementalFragment of FStarC_Parser_AST.decl incremental_result | Term of FStarC_Parser_AST.term | ParseError of parse_error -module BU = FStarC_Compiler_Util -module Range = FStarC_Compiler_Range +module BU = FStarC_Util +module Range = FStarC_Range module MHL = MenhirLib.Convert let range_of_positions filename start fin = let start_pos = FStarC_Parser_Util.pos_of_lexpos start in let end_pos = FStarC_Parser_Util.pos_of_lexpos fin in - FStarC_Compiler_Range.mk_range filename start_pos end_pos + FStarC_Range.mk_range filename start_pos end_pos let err_of_parse_error filename lexbuf tag = let pos = lexbuf.cur_p in @@ -138,14 +138,14 @@ let err_of_parse_error filename lexbuf tag = let string_of_lexpos lp = let r = range_of_positions "" lp lp in - FStarC_Compiler_Range.string_of_range r + FStarC_Range.string_of_range r let parse_incremental_decls filename (contents:string) lexbuf (lexer:unit -> 'token * Lexing.position * Lexing.position) - (range_of: 'semantic_value -> FStarC_Compiler_Range.range) + (range_of: 'semantic_value -> FStarC_Range.range) (parse_one: (Lexing.lexbuf -> 'token) -> Lexing.lexbuf -> @@ -205,7 +205,7 @@ let contents_at contents = let chars = FStar_String.list_of_string line in if col <= List.length chars then ( - let prefix, suffix = FStarC_Compiler_Util.first_N (Z.of_int col) chars in + let prefix, suffix = FStarC_Util.first_N (Z.of_int col) chars in Some (FStar_String.string_of_list prefix, FStar_String.string_of_list suffix) ) @@ -237,13 +237,13 @@ let contents_at contents = let end_line = Z.to_int (Range.line_of_pos end_pos) in let end_col = Z.to_int (Range.col_of_pos end_pos) in let suffix = - FStarC_Compiler_Util.nth_tail + FStarC_Util.nth_tail (Z.of_int (if start_line > 0 then start_line - 1 else 0)) lines in (* Take all the lines between the start and end lines *) let text, rest = - FStarC_Compiler_Util.first_N + FStarC_Util.first_N (Z.of_int (end_line - start_line)) suffix in @@ -283,7 +283,7 @@ let parse_incremental_fragment (contents:string) lexbuf (lexer:unit -> 'token * Lexing.position * Lexing.position) - (range_of: 'semantic_value -> FStarC_Compiler_Range.range) + (range_of: 'semantic_value -> FStarC_Range.range) (parse_one: (Lexing.lexbuf -> 'token) -> Lexing.lexbuf -> @@ -299,9 +299,9 @@ let parse_incremental_fragment let parse_fstar_incrementally : FStarC_Parser_AST_Util.extension_lang_parser = let f = - fun (s:string) (r:FStarC_Compiler_Range.range) -> + fun (s:string) (r:FStarC_Range.range) -> let open FStar_Pervasives in - let open FStarC_Compiler_Range in + let open FStarC_Range in let lexbuf = create s (file_of_range r) @@ -337,7 +337,7 @@ let parse_fstar_incrementally Inl err | e -> let pos = FStarC_Parser_Util.pos_of_lexpos (lexbuf.cur_p) in - let r = FStarC_Compiler_Range.mk_range filename pos pos in + let r = FStarC_Range.mk_range filename pos pos in let err : FStarC_Parser_AST_Util.error_message = { message = "Syntax error parsing #lang-fstar block: "; range = r } in Inl err in @@ -354,8 +354,8 @@ let parse_lang lang fn = | Toplevel s | Fragment s -> try - let frag_pos = FStarC_Compiler_Range.mk_pos s.frag_line s.frag_col in - let rng = FStarC_Compiler_Range.mk_range s.frag_fname frag_pos frag_pos in + let frag_pos = FStarC_Range.mk_pos s.frag_line s.frag_col in + let rng = FStarC_Range.mk_range s.frag_fname frag_pos frag_pos in let decls = FStarC_Parser_AST_Util.parse_extension_lang lang s.frag_text rng in let comments = FStarC_Parser_Util.flush_comments () in ASTFragment (Inr decls, comments) @@ -375,7 +375,7 @@ let parse (lang_opt:lang_opts) fn = check_extension f; let f', contents = read_file f in (try create contents f' 1 0, f', contents - with _ -> raise_error_text FStarC_Compiler_Range.dummyRange Fatal_InvalidUTF8Encoding (U.format1 "File %s has invalid UTF-8 encoding." f')) + with _ -> raise_error_text FStarC_Range.dummyRange Fatal_InvalidUTF8Encoding (U.format1 "File %s has invalid UTF-8 encoding." f')) | Incremental s | Toplevel s | Fragment s -> diff --git a/stage0/fstar-lib/FStarC_Parser_Utf8.ml b/stage0/dune/fstar-guts/ml/FStarC_Parser_Utf8.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Parser_Utf8.ml rename to stage0/dune/fstar-guts/ml/FStarC_Parser_Utf8.ml diff --git a/stage0/fstar-lib/FStarC_Parser_Util.ml b/stage0/dune/fstar-guts/ml/FStarC_Parser_Util.ml similarity index 77% rename from stage0/fstar-lib/FStarC_Parser_Util.ml rename to stage0/dune/fstar-guts/ml/FStarC_Parser_Util.ml index c6c03febb0f..0364c3b07b6 100644 --- a/stage0/fstar-lib/FStarC_Parser_Util.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Parser_Util.ml @@ -1,4 +1,4 @@ -open FStarC_Compiler_Range +open FStarC_Range open Lexing (* This brings into scope enough the translation of F# type names into the @@ -28,16 +28,16 @@ exception ReportedError exception StopProcessing let warningHandler = ref (fun (e:exn) -> - FStarC_Compiler_Util.print_string "no warning handler installed\n" ; - FStarC_Compiler_Util.print_any e; ()) + FStarC_Util.print_string "no warning handler installed\n" ; + FStarC_Util.print_any e; ()) let errorHandler = ref (fun (e:exn) -> - FStarC_Compiler_Util.print_string "no warning handler installed\n" ; - FStarC_Compiler_Util.print_any e; ()) + FStarC_Util.print_string "no warning handler installed\n" ; + FStarC_Util.print_any e; ()) let errorAndWarningCount = ref 0 let errorR exn = incr errorAndWarningCount; match exn with StopProcessing | ReportedError -> raise exn | _ -> !errorHandler exn let warning exn = incr errorAndWarningCount; match exn with StopProcessing | ReportedError -> raise exn | _ -> !warningHandler exn -let comments : (string * FStarC_Compiler_Range.range) list ref = ref [] +let comments : (string * FStarC_Range.range) list ref = ref [] let add_comment x = comments := x :: !comments let flush_comments () = let lexed_comments = !comments in diff --git a/stage0/dune/fstar-guts/ml/FStarC_Platform_Base.ml b/stage0/dune/fstar-guts/ml/FStarC_Platform_Base.ml new file mode 100644 index 00000000000..712a61f7882 --- /dev/null +++ b/stage0/dune/fstar-guts/ml/FStarC_Platform_Base.ml @@ -0,0 +1,17 @@ +type sys = + | Unix + | Win32 + | Cygwin + +let system = + match Sys.os_type with + | "Unix" -> Unix + | "Win32" -> Win32 + | "Cygwin" -> Cygwin + | s -> failwith ("Unrecognized system: " ^ s) + +let kernel () : string = + try + List.hd (Process.read_stdout "uname" [| |]) + with + | _ -> Sys.os_type diff --git a/stage0/fstar-lib/FStarC_Compiler_Plugins_Base.ml b/stage0/dune/fstar-guts/ml/FStarC_Plugins_Base.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Compiler_Plugins_Base.ml rename to stage0/dune/fstar-guts/ml/FStarC_Plugins_Base.ml diff --git a/stage0/fstar-lib/FStarC_Pprint.ml b/stage0/dune/fstar-guts/ml/FStarC_Pprint.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Pprint.ml rename to stage0/dune/fstar-guts/ml/FStarC_Pprint.ml diff --git a/stage0/dune/fstar-guts/ml/FStarC_Range.ml b/stage0/dune/fstar-guts/ml/FStarC_Range.ml new file mode 100644 index 00000000000..3b56db3b3f8 --- /dev/null +++ b/stage0/dune/fstar-guts/ml/FStarC_Range.ml @@ -0,0 +1,2 @@ +include FStarC_Range_Type +include FStarC_Range_Ops diff --git a/stage0/fstar-lib/FStarC_Reflection_Types.ml b/stage0/dune/fstar-guts/ml/FStarC_Reflection_Types.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Reflection_Types.ml rename to stage0/dune/fstar-guts/ml/FStarC_Reflection_Types.ml diff --git a/stage0/fstar-lib/FStarC_Sedlexing.ml b/stage0/dune/fstar-guts/ml/FStarC_Sedlexing.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Sedlexing.ml rename to stage0/dune/fstar-guts/ml/FStarC_Sedlexing.ml diff --git a/stage0/fstar-lib/FStarC_Compiler_String.ml b/stage0/dune/fstar-guts/ml/FStarC_String.ml similarity index 100% rename from stage0/fstar-lib/FStarC_Compiler_String.ml rename to stage0/dune/fstar-guts/ml/FStarC_String.ml diff --git a/stage0/fstar-lib/FStarC_StringBuffer.ml b/stage0/dune/fstar-guts/ml/FStarC_StringBuffer.ml similarity index 100% rename from stage0/fstar-lib/FStarC_StringBuffer.ml rename to stage0/dune/fstar-guts/ml/FStarC_StringBuffer.ml diff --git a/stage0/fstar-lib/FStarC_Syntax_TermHashTable.ml b/stage0/dune/fstar-guts/ml/FStarC_Syntax_TermHashTable.ml similarity index 98% rename from stage0/fstar-lib/FStarC_Syntax_TermHashTable.ml rename to stage0/dune/fstar-guts/ml/FStarC_Syntax_TermHashTable.ml index 3e018dd7a62..ad91fed00b0 100644 --- a/stage0/fstar-lib/FStarC_Syntax_TermHashTable.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Syntax_TermHashTable.ml @@ -1,6 +1,6 @@ module S = FStarC_Syntax_Syntax module P = FStarC_Profiling -module BU = FStarC_Compiler_Util +module BU = FStarC_Util let now () = BatUnix.gettimeofday () let record_time f = let start = now () in diff --git a/stage0/fstar-lib/FStarC_Tactics_Native.ml b/stage0/dune/fstar-guts/ml/FStarC_Tactics_Native.ml similarity index 94% rename from stage0/fstar-lib/FStarC_Tactics_Native.ml rename to stage0/dune/fstar-guts/ml/FStarC_Tactics_Native.ml index 10c405034fb..7c74bc4ae36 100644 --- a/stage0/fstar-lib/FStarC_Tactics_Native.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Tactics_Native.ml @@ -1,4 +1,4 @@ -open FStarC_Compiler_Range +open FStarC_Range open FStarC_Tactics_Types open FStarC_Tactics_Result open FStarC_Tactics_Monad @@ -6,7 +6,7 @@ open FStarC_Syntax_Syntax module N = FStarC_TypeChecker_Normalize module C = FStarC_TypeChecker_Cfg -module BU = FStarC_Compiler_Util +module BU = FStarC_Util module NBETerm = FStarC_TypeChecker_NBETerm module O = FStarC_Options module PO = FStarC_TypeChecker_Primops @@ -30,8 +30,8 @@ type native_primitive_step = strong_reduction_ok: bool; tactic: itac} -let perr s = if FStarC_Compiler_Debug.any () then BU.print_error s -let perr1 s x = if FStarC_Compiler_Debug.any () then BU.print1_error s x +let perr s = if FStarC_Debug.any () then BU.print_error s +let perr1 s x = if FStarC_Debug.any () then BU.print1_error s x let compiled_tactics: native_primitive_step list ref = ref [] diff --git a/stage0/fstar-lib/FStarC_Unionfind.ml b/stage0/dune/fstar-guts/ml/FStarC_Unionfind.ml similarity index 98% rename from stage0/fstar-lib/FStarC_Unionfind.ml rename to stage0/dune/fstar-guts/ml/FStarC_Unionfind.ml index aa13f1e8d8d..798a07f5dd7 100644 --- a/stage0/fstar-lib/FStarC_Unionfind.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Unionfind.ml @@ -1,8 +1,8 @@ (* Persistent union-find implementation adapted from https://www.lri.fr/~filliatr/puf/ *) -open FStarC_Compiler_Effect -open FStarC_Compiler_Util +open FStarC_Effect +open FStarC_Util (* Persistent arrays *) type 'a pa_t = 'a data ref diff --git a/stage0/fstar-lib/FStarC_Compiler_Util.ml b/stage0/dune/fstar-guts/ml/FStarC_Util.ml similarity index 95% rename from stage0/fstar-lib/FStarC_Compiler_Util.ml rename to stage0/dune/fstar-guts/ml/FStarC_Util.ml index 8264ef00022..e19e022192b 100644 --- a/stage0/fstar-lib/FStarC_Compiler_Util.ml +++ b/stage0/dune/fstar-guts/ml/FStarC_Util.ml @@ -16,7 +16,7 @@ let return_all x = x type time_ns = int64 let now_ns () = Mtime_clock.now_ns() -let time_diff_ns t1 t2 = +let time_diff_ns t1 t2 = Z.of_int (Int64.to_int (Int64.sub t2 t1)) let time_diff_ms t1 t2 = Z.div (time_diff_ns t1 t2) (Z.of_int 1000000) let record_time_ns f = @@ -188,8 +188,13 @@ let kill_process (p: proc) = attempt (fun () -> Unix.close (Unix.descr_of_in_channel p.inc)); attempt (fun () -> Unix.close (Unix.descr_of_in_channel p.errc)); attempt (fun () -> Unix.close (Unix.descr_of_out_channel p.outc)); + (* Try to kill, but the process may already be gone. On Unix we + get ESRCH. On Windows, we apparently get EACCES (permission denied). *) (try Unix.kill p.pid Sys.sigkill - with Unix.Unix_error (Unix.ESRCH, _, _) -> ()); + with Unix.Unix_error (Unix.ESRCH, _, _) -> () + | Unix.Unix_error (Unix.EACCES, _, _) when FStarC_Platform.windows -> () + ); + (* Avoid zombie processes (Unix.close_process does the same thing. *) waitpid_ignore_signals p.pid; (* print_string ("Killed process " ^ p.id ^ "\n" ^ (stack_dump())); *) @@ -341,11 +346,23 @@ let ask_process kill_process p; raise e let get_file_extension (fn:string) : string = snd (BatString.rsplit fn ".") + +(* NOTE: Working around https://github.com/ocaml-batteries-team/batteries-included/issues/1136 *) +let is_absolute_windows (path_str : string) : bool = + if FStarC_Platform.windows then + match BatString.to_list path_str with + | '\\' :: _ -> true + | letter :: ':' :: '\\' :: _ -> BatChar.is_letter letter + | _ -> false + else + false + let is_path_absolute path_str = let open Batteries.Incubator in let open BatPathGen.OfString in - let path_str' = of_string path_str in - is_absolute path_str' + let path = of_string path_str in + is_absolute path || is_absolute_windows path_str + let join_paths path_str0 path_str1 = let open Batteries.Incubator in let open BatPathGen.OfString in @@ -353,17 +370,15 @@ let join_paths path_str0 path_str1 = to_string ((of_string path_str0) //@ (of_string path_str1)) let normalize_file_path (path_str:string) = - let open Batteries.Incubator in - let open BatPathGen.OfString in - let open BatPathGen.OfString.Operators in - to_string - (normalize_in_tree - (let path = of_string path_str in - if is_absolute path then - path - else - let pwd = of_string (BatSys.getcwd ()) in - pwd //@ path)) + if is_path_absolute path_str then + path_str + else + let open Batteries.Incubator in + let open BatPathGen.OfString in + let open BatPathGen.OfString.Operators in + let path = of_string path_str in + let cwd = of_string (BatSys.getcwd ()) in + to_string (normalize_in_tree (cwd //@ path)) type stream_reader = BatIO.input let open_stdin () = BatIO.stdin @@ -824,7 +839,8 @@ let string_to_ascii_bytes (s:string) : char array = BatArray.of_list (BatString.explode s) let ascii_bytes_to_string (b:char array) : string = BatString.implode (BatArray.to_list b) -let mk_ref a = FStar_ST.alloc a + +let mk_ref a = ref a let write_file (fn:string) s = let fh = open_file_for_writing fn in @@ -917,12 +933,17 @@ let for_range lo hi f = done -let incr r = FStar_ST.(Z.(write r (read r + one))) -let decr r = FStar_ST.(Z.(write r (read r - one))) +let incr r = r := Z.(!r + one) +let decr r = r := Z.(!r - one) let geq (i:int) (j:int) = i >= j -let exec_name = Sys.executable_name -let get_exec_dir () = Filename.dirname (Sys.executable_name) +(* Note: If F* is called invoked via a symlink, executable_name contains + the name of the unresolved link in macos (not so in Linux). Since + F* needs to find its library relative to the path of its installed + executable, we must resolve all links, so we use realpath. *) +let exec_name = Unix.realpath Sys.executable_name + +let get_exec_dir () = Filename.dirname exec_name let get_cmd_args () = Array.to_list Sys.argv let expand_environment_variable x = try Some (Sys.getenv x) with Not_found -> None @@ -1119,11 +1140,12 @@ let return_execution_time f = (* Outside of this file the reference to FStar_Util.ref must use the following combinators *) (* Export it at the end of the file so that we don't break other internal uses of ref *) -type 'a ref = 'a FStar_Monotonic_Heap.ref -let read = FStar_ST.read -let write = FStar_ST.write -let (!) = FStar_ST.read -let (:=) = FStar_ST.write +(* type 'a ref = 'a ref *) + +let read r = !r +let write r v = r := v +let (!) = read +let (:=) = write let marshal (x:'a) : string = Marshal.to_string x [] let unmarshal (x:string) : 'a = Marshal.from_string x 0 diff --git a/stage0/dune/fstar-plugins/app/FStar_All.ml b/stage0/dune/fstar-plugins/app/FStar_All.ml new file mode 100644 index 00000000000..c9a376ee3ac --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_All.ml @@ -0,0 +1,3 @@ +exception Failure = Failure +let failwith x = raise (Failure x) +let exit i = exit (Z.to_int i) diff --git a/stage0/dune/fstar-plugins/app/FStar_Bytes.ml b/stage0/dune/fstar-plugins/app/FStar_Bytes.ml new file mode 100644 index 00000000000..ac80dca1b1b --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_Bytes.ml @@ -0,0 +1,249 @@ +module U8 = FStar_UInt8 +module U16 = FStar_UInt16 +module U32 = FStar_UInt32 +module U64 = FStar_UInt64 + +type u8 = U8.t +type u16 = U16.t +type u32 = U32.t + +type byte = u8 + +type bytes = string +type cbytes = string (* not in FStar.Bytes *) + +let len (b:bytes) = U32.of_native_int (String.length b) +let length (b:bytes) = Z.of_int (String.length b) + +let reveal (b:bytes) = () +let length_reveal (x:bytes) = () +let hide s = () +let hide_reveal (x:bytes) = () +let reveal_hide s = () + +type 'a lbytes = bytes +type 'a lbytes32 = bytes +type kbytes = bytes + +let empty_bytes = "" +let empty_unique (b:bytes) = () + +let get (b:bytes) (pos:u32) = int_of_char (String.get b (Z.to_int (U32.to_int pos))) +let op_String_Access = get + +let index (b:bytes) (i:Z.t) = get b (U32.uint_to_t i) + +type ('b1, 'b2) equal = unit + +let extensionality (b1:bytes) (b2:bytes) = () + +let create (len:u32) (v:byte) = String.make (U32.to_native_int len) (char_of_int v) +let create_ (len:Z.t) (v:byte) = String.make (Z.to_int len) (char_of_int v) + +let init (len:u32) (f:u32 -> byte) = + String.init (U32.to_native_int len) + (fun (i:int) -> + let b : byte = f (U32.of_native_int i) in + char_of_int b) + +let abyte (b:byte) = create (U32.of_native_int 1) b +let twobytes (bs:(byte * byte)) = + init (U32.of_native_int 2) (fun i -> if i = U32.of_native_int 0 then fst bs else snd bs) + +let append (b1:bytes) (b2:bytes) = b1 ^ b2 +let op_At_Bar = append + +let slice (b:bytes) (s:u32) (e:u32) = + String.sub b (U32.to_native_int s) (U32.to_native_int (U32.sub e s)) +let slice_ (b:bytes) (s:Z.t) (e:Z.t) = + slice b (U32.uint_to_t s) (U32.uint_to_t e) + +let sub (b:bytes) (s:u32) (l:u32) = + String.sub b (U32.to_native_int s) (U32.to_native_int l) + +let split (b:bytes) (k:u32) = + sub b (U32.of_native_int 0) k, + sub b k (U32.sub (U32.of_native_int (String.length b)) k) +let split_ (b:bytes) (k:Z.t) = + split b (U32.of_int k) + +let fits_in_k_bytes (n:Z.t) (k:Z.t) = (* expects k to fit in an int *) + Z.leq Z.zero n && + Z.leq n (Z.of_int (BatInt.pow 2 (8 * Z.to_int k))) +type 'a uint_k = Z.t + +let rec repr_bytes (n:Z.t) = + if Z.to_int n < 256 then Z.of_int 1 + else Z.add (Z.of_int 1) (repr_bytes (Z.div n (Z.of_int 256))) + +let lemma_repr_bytes_values (n:Z.t) = () +let repr_bytes_size (k:Z.t) (n:'a uint_k) = () +let int_of_bytes (b:bytes) = + let x = ref Z.zero in + let len = String.length b in + let n = Z.of_int 256 in + for y = 0 to len-1 do + x := Z.add (Z.mul n !x) (Z.of_int (get b (U32.of_native_int y))) + done; + !x + +let bytes_of_int (nb:Z.t) (i:Z.t) = + let nb = Z.to_int nb in + let i = Z.to_int64 i in + if Int64.compare i Int64.zero < 0 then failwith "Negative 64bit."; + let rec put_bytes bb lb n = + if lb = 0 then failwith "not enough bytes" + else + begin + let lown = Int64.logand n (Int64.of_int 255) in + Bytes.set bb (lb-1) (char_of_int (Int64.to_int lown)); + let ns = Int64.div n (Int64.of_int 256) in + if Int64.compare ns Int64.zero > 0 then + put_bytes bb (lb-1) ns + else bb + end + in + let b = Bytes.make nb (char_of_int 0) in + Bytes.to_string (put_bytes b nb i) + +let int_of_bytes_of_int (k:Z.t) (n:'a uint_k) = () +let bytes_of_int_of_bytes (b:bytes) = () + +let int32_of_bytes (b:bytes) = + Z.to_int (int_of_bytes b) + +let int16_of_bytes (b:bytes) = + Z.to_int (int_of_bytes b) + +let int8_of_bytes (b:bytes) = + Z.to_int (int_of_bytes b) + +let bytes_of_int32 (n:U32.t) = + bytes_of_int (Z.of_int 4) (U32.to_int n) + +let bytes_of_int16 (n:U32.t) = + bytes_of_int (Z.of_int 2) (U32.to_int n) + +let bytes_of_int8 (n:U32.t) = + bytes_of_int (Z.of_int 1) (U32.to_int n) + +type 'a minbytes = bytes + +let xor (len:U32.t) (s1:'a minbytes) (s2:'b minbytes) : bytes = + let f (i:u32) : byte = + let l = int_of_char s1.[U32.to_native_int i] in + let r = int_of_char s2.[U32.to_native_int i] in + l lxor r + in + init len f + +let xor_ (len:Z.t) = xor (U32.of_int len) + +let xor_commutative (n:U32.t) (b1: 'a minbytes) (b2: 'b minbytes) = () +let xor_append (b1:bytes) (b2:bytes) (x1:bytes) (b2:bytes) = () +let xor_idempotent (n:U32.t) (b1:bytes) (b2:bytes) = () + +(*********************************************************************************) +(* Under discussion *) +let utf8 (x:string) : bytes = x (* TODO: use Camomile *) +let utf8_encode = utf8 +let iutf8 (x:bytes) : string = x (* TODO: use Camomile *) +let iutf8_opt (x:bytes) : string option = Some (x) +(*********************************************************************************) + +(* Some helpers to deal with the conversation from hex literals to bytes and + * conversely. Mostly for tests. *) + +let digit_to_int c = match c with + | '0'..'9' -> Char.code c - Char.code '0' + | 'a'..'f' -> 10 + Char.code c - Char.code 'a' + | _ -> failwith "hex_to_char: invalid hex digit" + +let hex_to_char a b = + Char.chr ((digit_to_int a) lsl 4 + digit_to_int b) + +let char_to_hex c = + let n = Char.code c in + let digits = "0123456789abcdef" in + digits.[n lsr 4], digits.[n land 0x0f] + +let string_of_hex s = + let n = String.length s in + if n mod 2 <> 0 then + failwith "string_of_hex: invalid length" + else + let res = Bytes.create (n/2) in + let rec aux i = + if i >= n then () + else ( + Bytes.set res (i/2) (hex_to_char s.[i] s.[i+1]); + aux (i+2) + ) + in + aux 0; + res +let bytes_of_hex s = Bytes.to_string (string_of_hex s) + +let hex_of_string s = + let n = String.length s in + let buf = Buffer.create n in + for i = 0 to n - 1 do + let d1,d2 = char_to_hex s.[i] in + Buffer.add_char buf d1; + Buffer.add_char buf d2; + done; + Buffer.contents buf +let hex_of_bytes b = hex_of_string b + +let print_bytes (s:bytes) : string = + let b = Buffer.create 1024 in + for i = 0 to String.length s - 1 do + Buffer.add_string b (Printf.sprintf "%02X" (int_of_char s.[i])); + done; + Buffer.contents b + +let string_of_bytes b = b +let bytes_of_string s = s + +(*********************************************************************************) +(* OLD *) +(*********************************************************************************) + +let cbyte (b:bytes) = + try int_of_char (String.get b 0) + with _ -> failwith "cbyte: called on empty string" + +let cbyte2 (b:bytes) = + try (int_of_char (String.get b 0), int_of_char (String.get b 1)) + with _ -> failwith "cbyte2: need at least length 2" + +let index (b:bytes) i = + try int_of_char (String.get b (Z.to_int i)) + with _ -> failwith "index: called out of bound" + +let get_cbytes (b:bytes) = b +let abytes (ba:cbytes) = ba +let abyte (ba:byte) = String.make 1 (char_of_int ba) +let abyte2 (ba1,ba2) = + String.init 2 (fun i -> if i = 0 then char_of_int ba1 else char_of_int ba2) + +let split_eq = split + +let createBytes len (value:int) : bytes = + let len = Z.to_int len in + try abytes (String.make len (char_of_int value)) + with _ -> failwith "Default integer for createBytes was greater than max_value" + +let initBytes len f : bytes = + let len = Z.to_int len in + try abytes (String.init len (fun i -> char_of_int (f (Z.of_int i)))) + with _ -> failwith "Platform.Bytes.initBytes: invalid char returned" + +let equalBytes (b1:bytes) (b2:bytes) = b1 = b2 + +let split2 (b:bytes) i j : bytes * bytes * bytes = + let b1, b2 = split b i in + let b2a, b2b = split b2 j in + (b1, b2a, b2b) + +let byte_of_int i = Z.to_int i diff --git a/stage0/dune/fstar-plugins/app/FStar_Char.ml b/stage0/dune/fstar-plugins/app/FStar_Char.ml new file mode 100644 index 00000000000..2727e723626 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_Char.ml @@ -0,0 +1,21 @@ +module UChar = BatUChar + +module U32 = FStar_UInt32 + +type char = int[@@deriving yojson,show] +type char_code = U32.t + +(* FIXME(adl) UChar.lowercase/uppercase removed from recent Batteries. Use Camomile? *) +let lowercase (x:char) : char = + try Char.code (Char.lowercase_ascii (Char.chr x)) + with _ -> x + +let uppercase (x:char) : char = + try Char.code (Char.uppercase_ascii (Char.chr x)) + with _ -> x + +let int_of_char (x:char) : Z.t= Z.of_int x +let char_of_int (i:Z.t) : char = Z.to_int i + +let u32_of_char (x:char) : char_code = U32.of_native_int x +let char_of_u32 (x:char_code) : char = U32.to_native_int x diff --git a/stage0/ulib/fs/FStar_CommonST.fs b/stage0/dune/fstar-plugins/app/FStar_CommonST.ml similarity index 53% rename from stage0/ulib/fs/FStar_CommonST.fs rename to stage0/dune/fstar-plugins/app/FStar_CommonST.ml index cc470325dd3..2a798438918 100644 --- a/stage0/ulib/fs/FStar_CommonST.fs +++ b/stage0/dune/fstar-plugins/app/FStar_CommonST.ml @@ -1,21 +1,14 @@ -module FStar_CommonST - open FStar_Monotonic_Heap -let read x = x.contents +let read x = !x let op_Bang x = read x -let write x y = x.contents <- y +let write x y = x := y let op_Colon_Equals x y = write x y -let uid = ref 0 - -let alloc contents = - let id = incr uid; !uid in - let r = { id = id; contents = contents } in - r +let alloc contents = ref contents let recall = (fun r -> ()) let get () = () diff --git a/stage0/ulib/fs/FStar_Exn.fs b/stage0/dune/fstar-plugins/app/FStar_Exn.ml similarity index 50% rename from stage0/ulib/fs/FStar_Exn.fs rename to stage0/dune/fstar-plugins/app/FStar_Exn.ml index b931f23bae9..8128ed78d96 100644 --- a/stage0/ulib/fs/FStar_Exn.fs +++ b/stage0/dune/fstar-plugins/app/FStar_Exn.ml @@ -1,3 +1 @@ -module FStar_Exn - let raise = raise diff --git a/stage0/dune/fstar-plugins/app/FStar_Float.ml b/stage0/dune/fstar-plugins/app/FStar_Float.ml new file mode 100644 index 00000000000..39546f9599e --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_Float.ml @@ -0,0 +1,2 @@ +type double = float[@@deriving yojson,show] +type float = double[@@deriving yojson,show] diff --git a/stage0/dune/fstar-plugins/app/FStar_Heap.ml b/stage0/dune/fstar-plugins/app/FStar_Heap.ml new file mode 100644 index 00000000000..f58f5935c55 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_Heap.ml @@ -0,0 +1,5 @@ +open FStar_Monotonic_Heap + +type 'a ref = 'a FStar_Monotonic_Heap.ref +type ('a, 'b, 'c) trivial_rel = Prims.l_True +type ('a, 'b, 'c) trivial_preorder = ('a, 'b, 'c) trivial_rel diff --git a/stage0/dune/fstar-plugins/app/FStar_IO.ml b/stage0/dune/fstar-plugins/app/FStar_IO.ml new file mode 100644 index 00000000000..0888665e028 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_IO.ml @@ -0,0 +1,82 @@ +exception EOF +type fd_read = in_channel +type fd_write = out_channel +let stdin = stdin +let stdout = stdout +let stderr = stderr + +let pr = Printf.printf +let spr = Printf.sprintf +let fpr = Printf.fprintf + +let print_newline = print_newline +let print_string s = pr "%s" s; flush stdout + + +(* let print_nat s = + * pr "%x" s; + * flush stdout + * + * let print_nat_dec s = + * pr "%u" s; + * flush stdout *) + +let print_via (f:'a -> string) (x:'a) : unit = + print_string (f x); + flush stdout + +let print_uint8 = print_via FStar_UInt8.to_string_hex +let print_uint16 = print_via FStar_UInt16.to_string_hex +let print_uint32 = print_via FStar_UInt32.to_string_hex +let print_uint64 = print_via FStar_UInt64.to_string_hex + +let print_uint8_dec = print_via FStar_UInt8.to_string +let print_uint16_dec = print_via FStar_UInt16.to_string +let print_uint32_dec = print_via FStar_UInt32.to_string +let print_uint64_dec = print_via FStar_UInt64.to_string + +let print_uint8_hex_pad = print_via FStar_UInt8.to_string_hex_pad +let print_uint16_hex_pad = print_via FStar_UInt16.to_string_hex_pad +let print_uint32_hex_pad = print_via FStar_UInt32.to_string_hex_pad +let print_uint64_hex_pad = print_via FStar_UInt64.to_string_hex_pad + + +let __zeropad n s = + String.make (n - String.length s) '0' ^ s + +(* The magic numbers in these dec_pad functions are the precomputed + * string lengths of the maximum number when printed in decimal. + * + * - length "255" = 3 + * - length "65535" = 5 + * - length "4294967296" = 10 + * - length "18446744073709551616" = 20 + *) +let print_uint8_dec_pad n = + let s = FStar_UInt8.to_string n in + print_string (__zeropad 3 s) + +let print_uint16_dec_pad n = + let s = FStar_UInt16.to_string n in + print_string (__zeropad 5 s) + +let print_uint32_dec_pad n = + let s = FStar_UInt32.to_string n in + print_string (__zeropad 10 s) + +let print_uint64_dec_pad n = + let s = FStar_UInt64.to_string n in + print_string (__zeropad 20 s) + +let print_any s = output_value stdout s; flush stdout +let input_line = read_line +let input_int () = Z.of_int (read_int ()) +let input_float = read_float +let open_read_file = open_in +let open_write_file = open_out +let close_read_file = close_in +let close_write_file = close_out +let read_line fd = try Stdlib.input_line fd with End_of_file -> raise EOF +let write_string = output_string + +let debug_print_string s = print_string s; false diff --git a/stage0/dune/fstar-plugins/app/FStar_ImmutableArray.ml b/stage0/dune/fstar-plugins/app/FStar_ImmutableArray.ml new file mode 100644 index 00000000000..342a434e9e9 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_ImmutableArray.ml @@ -0,0 +1,2 @@ +module IAB = FStar_ImmutableArray_Base +let to_list (x:'a IAB.t) = Array.to_list x diff --git a/stage0/dune/fstar-plugins/app/FStar_ImmutableArray_Base.ml b/stage0/dune/fstar-plugins/app/FStar_ImmutableArray_Base.ml new file mode 100644 index 00000000000..2cb272926af --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_ImmutableArray_Base.ml @@ -0,0 +1,7 @@ +type 'a t = 'a array + +let of_list (l:'a list) = Array.of_list l + +let length (a: 'a t) = Z.of_int (Array.length a) + +let index (a: 'a t) (i:Z.t) = Array.get a (Z.to_int i) diff --git a/stage0/dune/fstar-plugins/app/FStar_List.ml b/stage0/dune/fstar-plugins/app/FStar_List.ml new file mode 100644 index 00000000000..4ae3e5c1b49 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_List.ml @@ -0,0 +1,82 @@ +(* We give an implementation here using OCaml's BatList, + which provides tail-recursive versions of most functions *) +include FStar_List_Tot_Base + +let isEmpty l = l = [] +let singleton x = [x] +let mem = BatList.mem +let memT = mem +let hd = BatList.hd +let tl = BatList.tl +let tail = BatList.tl + +let nth l i = BatList.nth l (Z.to_int i) +let length l = Z.of_int (BatList.length l) +let rev = BatList.rev +let map = BatList.map +let mapT = map +let mapi f l = BatList.mapi (fun i x -> f (Z.of_int i) x) l +let map2 = BatList.map2 +let rec map3 f l1 l2 l3 = + match l1, l2, l3 with + | [], [], [] -> [] + | x::xs, y::ys, z::zs -> (f x y z)::(map3 f xs ys zs) + | _, _, _ -> failwith "The lists do not have the same length" +let iter = BatList.iter +let iter2 = BatList.iter2 +let iteri_aux _ _ _ = failwith "FStar_List.ml: Not implemented: iteri_aux" +let iteri f l = BatList.iteri (fun i x -> f (Z.of_int i) x) l +let partition = BatList.partition +let append = BatList.append +let rev_append = BatList.rev_append +let fold_left = BatList.fold_left +let fold_right = BatList.fold_right +let fold_left2 = BatList.fold_left2 +let fold_right2 = BatList.fold_right2 +let rev_map_onto f l acc = fold_left (fun acc x -> f x :: acc) acc l +let rec init = function + | [] -> failwith "init: empty list" + | [h] -> [] + | h::t -> h::(init t) +let last = BatList.last +let last_opt l = List.fold_left (fun _ x -> Some x) None l +let collect f l = BatList.flatten (BatList.map f l) +let unzip = BatList.split +let rec unzip3 = function + | [] -> ([],[],[]) + | (x,y,z)::xyzs -> + let (xs,ys,zs) = unzip3 xyzs in + (x::xs,y::ys,z::zs) +let filter = BatList.filter +let sortWith f l = BatList.sort (fun x y -> Z.to_int (f x y)) l +let for_all = BatList.for_all +let forall2 = BatList.for_all2 +let tryFind f l = try Some (BatList.find f l) with | Not_found -> None +let tryFindT = tryFind +let find = tryFind +let tryPick f l = try f (BatList.find (fun x -> f x <> None) l) with | Not_found -> None +let flatten = BatList.flatten +let concat = flatten +let split = unzip +let choose = BatList.filter_map +let existsb f l = BatList.exists f l +let existsML f l = BatList.exists f l +let contains x l = BatList.exists (fun y -> x = y) l +let zip = BatList.combine +let splitAt x l = BatList.split_at (Z.to_int x) l +let filter_map = BatList.filter_map +let index f l = + Z.of_int (fst (BatList.findi (fun _ x -> f x) l)) + +let rec zip3 l1 l2 l3 = + match l1, l2, l3 with + | [], [], [] -> [] + | h1::t1, h2::t2, h3::t3 -> (h1, h2, h3) :: (zip3 t1 t2 t3) + | _ -> failwith "zip3" +let unique = BatList.unique +let map_flatten f l = flatten (map f l) + +let span = BatList.span + +let deduplicate (f:'a -> 'a -> bool) (l:'a list) : 'a list = BatList.unique ~eq:f l +let fold_left_map = BatList.fold_left_map diff --git a/stage0/dune/fstar-plugins/app/FStar_List_Tot_Base.ml b/stage0/dune/fstar-plugins/app/FStar_List_Tot_Base.ml new file mode 100644 index 00000000000..537c03abb2a --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_List_Tot_Base.ml @@ -0,0 +1,76 @@ +(* We give an implementation here using OCaml's BatList, + which provide tail-recursive versions of most functions. + The rest we implement manually. *) + +let isEmpty l = l = [] +let hd = BatList.hd +let tail = BatList.tl +let tl = BatList.tl + +let rec last = function + | x :: [] -> x + | _ :: tl -> last tl + +let rec init = function + | _ :: [] -> [] + | hd :: tl -> hd :: init tl + +let length l = Z.of_int (BatList.length l) +let nth l i = try Some (BatList.nth l (Z.to_int i)) with _ -> None +let index l i = BatList.nth l (Z.to_int i) + +let rec count x = function + | [] -> Prims.int_zero + | hd::tl -> if x=hd then Z.add Prims.int_one (count x tl) else count x tl + +let rev_acc l r = BatList.rev_append l r +let rev = BatList.rev +let append = BatList.append +let op_At = append +let snoc (x, y) = append x [y] +let flatten = BatList.flatten +let map = BatList.map +let mapi_init _ _ _ = failwith "FStar_List_Tot_Base.ml: Not implemented: mapi_init" +let mapi f l = BatList.mapi (fun i x -> f (Z.of_int i) x) l +let concatMap f l = flatten (map f l) +let fold_left = BatList.fold_left +let fold_right = BatList.fold_right +let fold_left2 = BatList.fold_left2 +let mem = BatList.mem +type ('a, 'b, 'c) memP = unit +let contains x l = BatList.exists (fun y -> x = y) l +let existsb f l = BatList.exists f l +let find f l = try Some (BatList.find f l) with | Not_found -> None +let filter = BatList.filter +let for_all = BatList.for_all +let collect f l = BatList.flatten (BatList.map f l) +let tryFind = find +let tryPick f l = try f (BatList.find (fun x -> f x <> None) l) with | Not_found -> None +let choose = BatList.filter_map +let partition = BatList.partition +let subset la lb = BatList.subset (fun x y -> if x = y then 0 else 1) la lb + +let rec noRepeats = function + | [] -> true + | h :: tl -> not (mem h tl) && noRepeats tl + +let assoc x l = match List.assoc x l with exception Not_found -> None | x -> Some x +let split = BatList.split +let unzip = split +let rec unzip3 = function + | [] -> ([],[],[]) + | (x,y,z)::xyzs -> + let (xs,ys,zs) = unzip3 xyzs in + (x::xs,y::ys,z::zs) + +let splitAt n l = BatList.split_at (Z.to_int n) l +let unsnoc l = let l1, l2 = splitAt (Z.sub (length l) Z.one) l in l1, hd l2 +let split3 l i = let a, a1 = splitAt i l in let b :: c = a1 in a, b, c + +let bool_of_compare f x y = Z.gt (f x y) Z.zero +let compare_of_bool = + fun rel -> fun x -> fun y -> if (rel x y) then Z.one else (if x = y then Z.zero else (Z.neg Z.one)) +let sortWith f l = BatList.sort (fun x y -> Z.to_int (f x y)) l +let list_unref l = l +let list_ref _ l = l +let list_refb _ l = l diff --git a/stage0/dune/fstar-plugins/app/FStar_Monotonic_Heap.ml b/stage0/dune/fstar-plugins/app/FStar_Monotonic_Heap.ml new file mode 100644 index 00000000000..1c1cc85cb10 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_Monotonic_Heap.ml @@ -0,0 +1,36 @@ +type heap = unit + +type nonrec 'a ref = 'a ref + +type ('a, 'b) mref = 'a ref + +let emp = + () + +(* Logical functions on heap *) +(* TODO : complete the functions to have the same interface as in FStar.Heap.fsti *) + +let addr_of _ = Obj.magic () +let is_mm _ = Obj.magic () + +(* let compare_addrs *) + +type ('a, 'b, 'c, 'd) contains +type ('a, 'b) addr_unused_in +type ('a, 'b, 'c, 'd) unused_in +let fresh _ _ _ = Obj.magic () + +let sel _ _ = Obj.magic () +let upd _ _ _ = Obj.magic () +let alloc _ _ _ = Obj.magic () + +let free_mm _ _ = Obj.magic () +let sel_tot = sel +let upd_tot = upd + +(* Untyped view of references *) +type aref = + | Ref of (unit * unit) +let dummy_aref = Ref ((), ()) +let aref_of _ = dummy_aref +let ref_of _ _ = Obj.magic () diff --git a/stage0/dune/fstar-plugins/app/FStar_Option.ml b/stage0/dune/fstar-plugins/app/FStar_Option.ml new file mode 100644 index 00000000000..18b7837e926 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_Option.ml @@ -0,0 +1,37 @@ +open Prims +let isNone: 'a . 'a FStar_Pervasives_Native.option -> Prims.bool = + fun uu___10_12 -> + match uu___10_12 with + | FStar_Pervasives_Native.None -> true + | FStar_Pervasives_Native.Some uu____15 -> false +let isSome: 'a . 'a FStar_Pervasives_Native.option -> Prims.bool = + fun uu___11_27 -> + match uu___11_27 with + | FStar_Pervasives_Native.Some uu____30 -> true + | FStar_Pervasives_Native.None -> false +let map: + 'a 'b . + ('a -> 'b) -> + 'a FStar_Pervasives_Native.option -> 'b FStar_Pervasives_Native.option + = + fun f -> + fun uu___12_58 -> + match uu___12_58 with + | FStar_Pervasives_Native.Some x -> + let uu____64 = f x in FStar_Pervasives_Native.Some uu____64 + | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None +let mapTot: + 'a 'b . + ('a -> 'b) -> + 'a FStar_Pervasives_Native.option -> 'b FStar_Pervasives_Native.option + = + fun f -> + fun uu___13_91 -> + match uu___13_91 with + | FStar_Pervasives_Native.Some x -> FStar_Pervasives_Native.Some (f x) + | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None +let get: 'a . 'a FStar_Pervasives_Native.option -> 'a = + fun uu___14_108 -> + match uu___14_108 with + | FStar_Pervasives_Native.Some x -> x + | FStar_Pervasives_Native.None -> failwith "empty option" \ No newline at end of file diff --git a/stage0/ulib/fs/FStar_Pervasives_Native.fs b/stage0/dune/fstar-plugins/app/FStar_Pervasives_Native.ml similarity index 94% rename from stage0/ulib/fs/FStar_Pervasives_Native.fs rename to stage0/dune/fstar-plugins/app/FStar_Pervasives_Native.ml index c37bfcc2aa4..0027fcb263a 100644 --- a/stage0/ulib/fs/FStar_Pervasives_Native.fs +++ b/stage0/dune/fstar-plugins/app/FStar_Pervasives_Native.ml @@ -1,25 +1,28 @@ -#light "off" -module FStar_Pervasives_Native -open Prims -type 'Aa option = -| None -| Some of 'Aa +type 'a option' = 'a option = + | None + | Some of 'a[@@deriving yojson,show] + +type 'a option = 'a option' = + | None + | Some of 'a[@@deriving yojson,show] let uu___is_None = function None -> true | _ -> false let uu___is_Some = function Some _ -> true | _ -> false -let __proj__Some__item__v = function Some x -> x | _ -> failwith "Option value not available" +let __proj__Some__item__v = function Some x -> x | _ -> assert false -type ('a,'b) tuple2 = 'a * 'b +(* 'a * 'b *) +type ('a,'b) tuple2 = 'a * 'b[@@deriving yojson,show] -let fst = Microsoft.FSharp.Core.Operators.fst -let snd = Microsoft.FSharp.Core.Operators.snd +let fst = Stdlib.fst +let snd = Stdlib.snd -let __proj__Mktuple2__1 = fst -let __proj__Mktuple2__2 = snd +let __proj__Mktuple2__item___1 = fst +let __proj__Mktuple2__item___2 = snd type ('a,'b,'c) tuple3 = 'a* 'b* 'c +[@@deriving yojson,show] let uu___is_Mktuple3 projectee = true let __proj__Mktuple3__item___1 projectee = match projectee with | (_1,_2,_3) -> _1 @@ -30,6 +33,7 @@ let __proj__Mktuple3__item___3 projectee = type ('a,'b,'c,'d) tuple4 = 'a* 'b* 'c* 'd +[@@deriving yojson,show] let uu___is_Mktuple4 projectee = true let __proj__Mktuple4__item___1 projectee = match projectee with | (_1,_2,_3,_4) -> _1 @@ -42,6 +46,7 @@ let __proj__Mktuple4__item___4 projectee = type ('a,'b,'c,'d,'e) tuple5 = 'a* 'b* 'c* 'd* 'e +[@@deriving yojson,show] let uu___is_Mktuple5 projectee = true let __proj__Mktuple5__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5) -> _1 @@ -56,6 +61,7 @@ let __proj__Mktuple5__item___5 projectee = type ('a,'b,'c,'d,'e,'f) tuple6 = 'a* 'b* 'c* 'd* 'e* 'f +[@@deriving yojson,show] let uu___is_Mktuple6 projectee = true let __proj__Mktuple6__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6) -> _1 @@ -72,6 +78,7 @@ let __proj__Mktuple6__item___6 projectee = type ('a,'b,'c,'d,'e,'f,'g) tuple7 = 'a* 'b* 'c* 'd* 'e* 'f* 'g +[@@deriving yojson,show] let uu___is_Mktuple7 projectee = true let __proj__Mktuple7__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6,_7) -> _1 @@ -90,6 +97,7 @@ let __proj__Mktuple7__item___7 projectee = type ('a,'b,'c,'d,'e,'f,'g,'h) tuple8 = 'a* 'b* 'c* 'd* 'e* 'f* 'g* 'h +[@@deriving yojson,show] let uu___is_Mktuple8 projectee = true let __proj__Mktuple8__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _1 @@ -110,6 +118,7 @@ let __proj__Mktuple8__item___8 projectee = type ('a,'b,'c,'d,'e,'f,'g,'h,'i) tuple9 = 'a *'b *'c *'d *'e *'f *'g *'h *'i +[@@deriving yojson,show] let uu___is_Mktuple9 projectee = true let __proj__Mktuple9__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _1 @@ -132,6 +141,7 @@ let __proj__Mktuple9__item___9 projectee = type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j) tuple10 = 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j +[@@deriving yojson,show] let uu___is_Mktuple10 projectee = true let __proj__Mktuple10__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _1 @@ -156,6 +166,7 @@ let __proj__Mktuple10__item___10 projectee = type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k) tuple11 = 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j *'k +[@@deriving yojson,show] let uu___is_Mktuple11 projectee = true let __proj__Mktuple11__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _1 @@ -182,6 +193,7 @@ let __proj__Mktuple11__item___11 projectee = type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l) tuple12 = 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j *'k *'l +[@@deriving yojson,show] let uu___is_Mktuple12 projectee = true let __proj__Mktuple12__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _1 @@ -210,6 +222,7 @@ let __proj__Mktuple12__item___12 projectee = type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l,'m) tuple13 = 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j *'k *'l *'m +[@@deriving yojson,show] let uu___is_Mktuple13 projectee = true let __proj__Mktuple13__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _1 @@ -240,6 +253,7 @@ let __proj__Mktuple13__item___13 projectee = type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l,'m,'n) tuple14 = 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j *'k *'l *'m *'n +[@@deriving yojson,show] let uu___is_Mktuple14 projectee = true let __proj__Mktuple14__item___1 projectee = match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _1 diff --git a/stage0/dune/fstar-plugins/app/FStar_Pprint.ml b/stage0/dune/fstar-plugins/app/FStar_Pprint.ml new file mode 100644 index 00000000000..83bf2f366ee --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_Pprint.ml @@ -0,0 +1,95 @@ +(* + Copyright 2016 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +(* NOTE!!! This is a copy of FStarC_Pprint that is exposed to applications +via the library, without needing to link against compiler modules. The compiler +itself could also use this but there are some issues with effect polymorphism +(e.g. flow_map would need two versions, and having the ML one in the ulib module +would introduce a lot of dependencies) and also would need to have a single definition +of `float` (the compiler defines its own, though this is probably unneeded and can +be removed). *) + +(* prettyprint.fsti's OCaml implementation is just a thin wrapper around + Francois Pottier's pprint package. *) +include PPrint + +(* FIXME(adl) also print the char in a comment if it's representable *) +let doc_of_char c = PPrint.OCaml.char (Char.chr c) +let doc_of_string = PPrint.string +let doc_of_bool b = PPrint.string (string_of_bool b) +let blank_buffer_doc = [ ("", PPrint.empty) ] + +let substring s ofs len = + PPrint.substring s (Z.to_int ofs) (Z.to_int len) + +let fancystring s apparent_length = + PPrint.fancystring s (Z.to_int apparent_length) + +let fancysubstring s ofs len apparent_length = + PPrint.fancysubstring s (Z.to_int ofs) (Z.to_int len) (Z.to_int apparent_length) + +let blank n = PPrint.blank (Z.to_int n) + +let break_ n = PPrint.break (Z.to_int n) + +let op_Hat_Hat = PPrint.(^^) +let op_Hat_Slash_Hat = PPrint.(^/^) + +let nest j doc = PPrint.nest (Z.to_int j) doc + +let long_left_arrow = PPrint.string "<--" +let larrow = PPrint.string "<-" +let rarrow = PPrint.string "->" + +let repeat n doc = PPrint.repeat (Z.to_int n) doc + +let hang n doc = PPrint.hang (Z.to_int n) doc + +let prefix n b left right = + PPrint.prefix (Z.to_int n) (Z.to_int b) left right + +let jump n b right = + PPrint.jump (Z.to_int n) (Z.to_int b) right + +let infix n b middle left right = + PPrint.infix (Z.to_int n) (Z.to_int b) middle left right + +let surround n b opening contents closing = + PPrint.surround (Z.to_int n) (Z.to_int b) opening contents closing + +let soft_surround n b opening contents closing = + PPrint.soft_surround (Z.to_int n) (Z.to_int b) opening contents closing + +let surround_separate n b void_ opening sep closing docs = + PPrint.surround_separate (Z.to_int n) (Z.to_int b) void_ opening sep closing docs + +let surround_separate_map n b void_ opening sep closing f xs = + PPrint.surround_separate_map (Z.to_int n) (Z.to_int b) void_ opening sep closing f xs + +(* Wrap up ToBuffer.pretty. *) +let pretty_string rfrac width doc = + let buf = Buffer.create 0 in + PPrint.ToBuffer.pretty rfrac (Z.to_int width) buf doc; + Buffer.contents buf + +(* Wrap up ToChannel.pretty *) +let pretty_out_channel rfrac width doc ch = + PPrint.ToChannel.pretty rfrac (Z.to_int width) ch doc; + flush ch + +(* A simple renderer, with some default values. *) +let render (doc:document) : string = + pretty_string 1.0 (Z.of_int 80) doc diff --git a/stage0/dune/fstar-plugins/app/FStar_ST.ml b/stage0/dune/fstar-plugins/app/FStar_ST.ml new file mode 100644 index 00000000000..a27ecf12ba2 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_ST.ml @@ -0,0 +1,28 @@ +(* https://www.lexifi.com/blog/references-physical-equality *) + +open FStar_CommonST + +type ('a, 'b) mref = ('a, 'b) FStar_Monotonic_Heap.mref + +type 'a ref = 'a FStar_Monotonic_Heap.ref + +let ref_to_yojson _ _ = `Null +let ref_of_yojson _ _ = failwith "cannot readback" + +let read = read + +let op_Bang = op_Bang + +let write = write + +let op_Colon_Equals = op_Colon_Equals + +let alloc = alloc + +let recall = recall +let get = get + +type 'a witnessed = 'a FStar_CommonST.witnessed + +let gst_witness = gst_witness +let gst_recall = gst_recall diff --git a/stage0/dune/fstar-plugins/app/FStar_String.ml b/stage0/dune/fstar-plugins/app/FStar_String.ml new file mode 100644 index 00000000000..9dcff4a94df --- /dev/null +++ b/stage0/dune/fstar-plugins/app/FStar_String.ml @@ -0,0 +1,43 @@ +let make i c = BatUTF8.init (Z.to_int i) (fun _ -> BatUChar.chr c) +let strcat s t = s ^ t +let op_Hat s t = strcat s t + +(* restore pre-2.11 BatString.nsplit behavior, + see https://github.com/ocaml-batteries-team/batteries-included/issues/845 *) +let batstring_nsplit s t = + if s = "" then [] else BatString.split_on_string t s + +let split seps s = + let rec repeat_split acc = function + | [] -> acc + | sep::seps -> + let usep = BatUTF8.init 1 (fun _ -> BatUChar.chr sep) in + let l = BatList.flatten (BatList.map (fun x -> batstring_nsplit x usep) acc) in + repeat_split l seps in + repeat_split [s] seps +let compare x y = Z.of_int (BatString.compare x y) +type char = FStar_Char.char +let concat = BatString.concat +let length s = Z.of_int (BatUTF8.length s) +let strlen s = length s + +let substring s i j = + BatUTF8.init (Z.to_int j) (fun k -> BatUTF8.get s (k + Z.to_int i)) +let sub = substring + +let get s i = BatUChar.code (BatUTF8.get s (Z.to_int i)) +let collect f s = + let r = ref "" in + BatUTF8.iter (fun c -> r := !r ^ f (BatUChar.code c)) s; !r +let lowercase = BatString.lowercase_ascii +let uppercase = BatString.uppercase_ascii +let escaped = BatString.escaped +let index = get +exception Found of int +let index_of s c = + let c = BatUChar.chr c in + try let _ = BatUTF8.iteri (fun c' i -> if c = c' then raise (Found i) else ()) s in Z.of_int (-1) + with Found i -> Z.of_int i +let list_of_string s = BatList.init (BatUTF8.length s) (fun i -> BatUChar.code (BatUTF8.get s i)) +let string_of_list l = BatUTF8.init (BatList.length l) (fun i -> BatUChar.chr (BatList.at l i)) +let string_of_char (c:char) = BatString.of_char (Char.chr c) diff --git a/stage0/ulib/fs/FStar_UInt8.fs b/stage0/dune/fstar-plugins/app/FStar_UInt8.ml similarity index 51% rename from stage0/ulib/fs/FStar_UInt8.fs rename to stage0/dune/fstar-plugins/app/FStar_UInt8.ml index 4d08b53a04c..2148ee255f1 100644 --- a/stage0/ulib/fs/FStar_UInt8.fs +++ b/stage0/dune/fstar-plugins/app/FStar_UInt8.ml @@ -1,43 +1,45 @@ -module FStar_UInt8 +(* GM: This file is manual due to the derivings, + and that sucks. *) -// TODO: Would it make sense to use .net byte here? -type uint8 = Prims.int -type byte = uint8 -type t = uint8 -type t' = t +type uint8 = int[@@deriving yojson,show] +type byte = uint8[@@deriving yojson,show] +type t = uint8[@@deriving yojson,show] +type t' = t[@@deriving yojson,show] + +let (%) x y = if x < 0 then (x mod y) + y else x mod y let n = Prims.parse_int "8" -let v (x:uint8) : Prims.int = Prims.parse_int (string x) +let v (x:uint8) : Prims.int = Prims.parse_int (string_of_int x) let zero = 0 let one = 1 let ones = 255 let add (a:uint8) (b:uint8) : uint8 = a + b -let add_underspec a b = (add a b) &&& 255I +let add_underspec a b = (add a b) land 255 let add_mod = add_underspec let sub (a:uint8) (b:uint8) : uint8 = a - b -let sub_underspec a b = (sub a b) &&& 255I +let sub_underspec a b = (sub a b) land 255 let sub_mod = sub_underspec let mul (a:uint8) (b:uint8) : uint8 = a * b -let mul_underspec a b = (mul a b) &&& 255I +let mul_underspec a b = (mul a b) land 255 let mul_mod = mul_underspec -let div (a:uint8) (b:uint8) : uint8 = Prims.(/) a b +let div (a:uint8) (b:uint8) : uint8 = a / b -let rem (a:uint8) (b:uint8) : uint8 = Prims.(mod) a b +let rem (a:uint8) (b:uint8) : uint8 = a mod b -let logand (a:uint8) (b:uint8) : uint8 = a &&& b -let logxor (a:uint8) (b:uint8) : uint8 = a ^^^ b -let logor (a:uint8) (b:uint8) : uint8 = a ||| b -let lognot (a:uint8) : uint8 = bigint.op_OnesComplement a +let logand (a:uint8) (b:uint8) : uint8 = a land b +let logxor (a:uint8) (b:uint8) : uint8 = a lxor b +let logor (a:uint8) (b:uint8) : uint8 = a lor b +let lognot (a:uint8) : uint8 = lnot a -let int_to_uint8 (x:Prims.int) : uint8 = x % 256I +let int_to_uint8 (x:Prims.int) : uint8 = Z.to_int x % 256 -let shift_right (a:uint8) (b:System.UInt32) : uint8 = a >>> (int32 b) -let shift_left (a:uint8) (b:System.UInt32) : uint8 = (a <<< (int32 b)) &&& 255I +let shift_right (a:uint8) (b:Stdint.Uint32.t) : uint8 = a lsr (Stdint.Uint32.to_int b) +let shift_left (a:uint8) (b:Stdint.Uint32.t) : uint8 = (a lsl (Stdint.Uint32.to_int b)) land 255 (* Comparison operators *) let eq (a:uint8) (b:uint8) : bool = a = b @@ -47,8 +49,8 @@ let lt (a:uint8) (b:uint8) : bool = a < b let lte (a:uint8) (b:uint8) : bool = a <= b (* NOT Constant time comparison operators *) -let gte_mask (a:uint8) (b:uint8) : uint8 = if a >= b then 255I else 0I -let eq_mask (a:uint8) (b:uint8) : uint8 = if a = b then 255I else 0I +let gte_mask (a:uint8) (b:uint8) : uint8 = if a >= b then 255 else 0 +let eq_mask (a:uint8) (b:uint8) : uint8 = if a = b then 255 else 0 (* Infix notations *) let op_Plus_Hat = add @@ -73,12 +75,10 @@ let op_Greater_Equals_Hat = gte let op_Less_Hat = lt let op_Less_Equals_Hat = lte -let of_string s = Prims.parse_int s -let to_string s = Prims.to_string s -// The hex printing for BigInteger in .NET is a bit non-standard as it -// prints an extra leading '0' for positive numbers -let to_string_hex (s : t) = "0x" + (s.ToString("X").TrimStart([| '0' |])) -let to_string_hex_pad (s : t) = s.ToString("X").TrimStart([| '0' |]).PadLeft(2, '0') +let of_string s = int_of_string s +let to_string s = string_of_int s +let to_string_hex s = Printf.sprintf "0x%x" s +let to_string_hex_pad s = Printf.sprintf "%02x" s let uint_to_t s = int_to_uint8 s let to_int s = s let __uint_to_t = uint_to_t diff --git a/stage0/dune/fstar-plugins/app/Prims.ml b/stage0/dune/fstar-plugins/app/Prims.ml new file mode 100644 index 00000000000..b96a81ebdc7 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/Prims.ml @@ -0,0 +1,195 @@ +type int = Z.t[@printer Z.pp_print][@@deriving show] +let of_int = Z.of_int +let int_zero = Z.zero +let int_one = Z.one +let parse_int = Z.of_string +let to_string = Z.to_string + +type tmp = string [@@deriving yojson] +let int_to_yojson x = tmp_to_yojson (to_string x) +let int_of_yojson x = + match tmp_of_yojson x with + | Ok x -> Ok (parse_int x) + | Error x -> Error x + +type attribute = unit +let (cps : attribute) = () +type 'Auu____5 hasEq = unit +type eqtype = unit +type bool' = bool +[@@deriving yojson,show] +type bool = bool' +[@@deriving yojson,show] +type empty = unit +(*This is how Coq extracts Inductive void := . Our extraction needs to be fixed to recognize when there + are no constructors and generate this type abbreviation*) +type trivial = + | T +let (uu___is_T : trivial -> bool) = fun projectee -> true +type nonrec unit = unit +type 'Ap squash = unit +type 'Ap auto_squash = unit +type l_True = unit +type l_False = unit +type ('Aa,'Ax,'dummyV0) equals = + | Refl +let uu___is_Refl : 'Aa . 'Aa -> 'Aa -> ('Aa,unit,unit) equals -> bool = + fun x -> fun uu____65 -> fun projectee -> true +type ('Aa,'Ax,'Ay) eq2 = unit +type ('Aa,'Ab,'Ax,'Ay) op_Equals_Equals_Equals = unit +type 'Ab b2t = unit +type ('Ap,'Aq) pair = + | Pair of 'Ap * 'Aq +let uu___is_Pair : 'Ap 'Aq . ('Ap,'Aq) pair -> bool = + fun projectee -> true +let __proj__Pair__item___1 : 'Ap 'Aq . ('Ap,'Aq) pair -> 'Ap = + fun projectee -> match projectee with | Pair (_0,_1) -> _0 +let __proj__Pair__item___2 : 'Ap 'Aq . ('Ap,'Aq) pair -> 'Aq = + fun projectee -> match projectee with | Pair (_0,_1) -> _1 +type ('Ap,'Aq) l_and = unit +type ('Ap,'Aq) sum = + | Left of 'Ap + | Right of 'Aq +let uu___is_Left : 'Ap 'Aq . ('Ap,'Aq) sum -> bool = + fun projectee -> + match projectee with | Left _0 -> true | uu____344 -> false + +let __proj__Left__item___0 : 'Ap 'Aq . ('Ap,'Aq) sum -> 'Ap = + fun projectee -> match projectee with | Left _0 -> _0 +let uu___is_Right : 'Ap 'Aq . ('Ap,'Aq) sum -> bool = + fun projectee -> + match projectee with | Right _0 -> true | uu____404 -> false + +let __proj__Right__item___0 : 'Ap 'Aq . ('Ap,'Aq) sum -> 'Aq = + fun projectee -> match projectee with | Right _0 -> _0 +type ('Ap,'Aq) l_or = unit +type ('Ap,'Aq) l_imp = unit +type ('Ap,'Aq) l_iff = unit +type 'Ap l_not = unit +type ('Ap,'Aq,'Ar) l_ITE = unit +type ('Aa,'Ab,'Auu____484,'Auu____485) precedes = unit +type ('Aa,'Auu____490,'Auu____491) has_type = unit +type ('Aa,'Ap) l_Forall = unit +type prop = unit +let id x = x +type ('Aa,'Ab) dtuple2 = + | Mkdtuple2 of 'Aa * 'Ab +let uu___is_Mkdtuple2 : 'Aa 'Ab . ('Aa,'Ab) dtuple2 -> bool = + fun projectee -> true +let __proj__Mkdtuple2__item___1 : 'Aa 'Ab . ('Aa,'Ab) dtuple2 -> 'Aa = + fun projectee -> match projectee with | Mkdtuple2 (_1,_2) -> _1 +let __proj__Mkdtuple2__item___2 : 'Aa 'Ab . ('Aa,'Ab) dtuple2 -> 'Ab = + fun projectee -> match projectee with | Mkdtuple2 (_1,_2) -> _2 +type ('Aa,'Ap) l_Exists = unit +type string' = string[@@deriving yojson,show] +type string = string'[@@deriving yojson,show] +type pure_pre = unit +type ('Aa,'Apre) pure_post' = unit +type 'Aa pure_post = unit +type 'Aa pure_wp = unit +type 'Auu____655 guard_free = unit +type ('Aa,'Ax,'Ap) pure_return = unit +type ('Ar1,'Aa,'Ab,'Awp1,'Awp2,'Ap) pure_bind_wp = 'Awp1 +type ('Aa,'Ap,'Awp_then,'Awp_else,'Apost) pure_if_then_else = unit[@@deriving yojson,show] +type ('Aa,'Awp,'Apost) pure_ite_wp = unit +type ('Aa,'Awp1,'Awp2) pure_stronger = unit +type ('Aa,'Ab,'Awp,'Ap) pure_close_wp = unit +type ('Aa,'Aq,'Awp,'Ap) pure_assert_p = unit +type ('Aa,'Aq,'Awp,'Ap) pure_assume_p = unit +type ('Aa,'Ap) pure_null_wp = unit +type ('Aa,'Awp) pure_trivial = 'Awp +type ('Ap, 'Apost) pure_assert_wp = unit +type ('Aa,'Awp,'Auu____878) purewp_id = 'Awp + + +let op_AmpAmp x y = x && y +let op_BarBar x y = x || y +let op_Negation x = not x + +let ( + ) = Z.add +let ( - ) = Z.sub +let ( * ) = Z.mul +let ( / ) = Z.ediv +let ( <= ) = Z.leq +let ( >= ) = Z.geq +let ( < ) = Z.lt +let ( > ) = Z.gt +let ( mod ) = Z.erem +let ( ~- ) = Z.neg +let abs = Z.abs + +let op_Multiply x y = x * y +let op_Subtraction x y = x - y +let op_Addition x y = x + y +let op_Minus x = -x +let op_LessThan x y = x < y +let op_LessThanOrEqual x y = x <= y +let op_GreaterThan x y = x > y +let op_GreaterThanOrEqual x y = x >= y +let op_Equality x y = x = y +let op_disEquality x y = x<>y + +type nonrec exn = exn +type 'a array' = 'a array[@@deriving yojson,show] +type 'a array = 'a array'[@@deriving yojson,show] +let strcat x y = x ^ y +let op_Hat x y = x ^ y + +type 'a list' = 'a list[@@deriving yojson,show] +type 'a list = 'a list'[@@deriving yojson,show] +let uu___is_Nil : 'Aa . 'Aa list -> bool = + fun projectee -> match projectee with | [] -> true | uu____1190 -> false +let uu___is_Cons : 'Aa . 'Aa list -> bool = + fun projectee -> + match projectee with | hd::tl -> true | uu____1216 -> false + +let __proj__Cons__item__hd : 'Aa . 'Aa list -> 'Aa = + fun projectee -> match projectee with | hd::tl -> hd +let __proj__Cons__item__tl : 'Aa . 'Aa list -> 'Aa list = + fun projectee -> match projectee with | hd::tl -> tl +type pattern = unit + + +type ('Aa,'Auu____1278) decreases = unit +let returnM : 'Aa . 'Aa -> 'Aa = fun x -> x +type lex_t = + | LexTop + | LexCons of unit * Obj.t * lex_t +let (uu___is_LexTop : lex_t -> bool) = + fun projectee -> + match projectee with | LexTop -> true | uu____1313 -> false + +let (uu___is_LexCons : lex_t -> bool) = + fun projectee -> + match projectee with | LexCons (a,_1,_2) -> true | uu____1327 -> false + +type 'Aprojectee __proj__LexCons__item__a = Obj.t +let (__proj__LexCons__item___1 : lex_t -> Obj.t) = + fun projectee -> match projectee with | LexCons (a,_1,_2) -> _1 +let (__proj__LexCons__item___2 : lex_t -> lex_t) = + fun projectee -> match projectee with | LexCons (a,_1,_2) -> _2 +type ('Aa,'Awp) as_requires = 'Awp +type ('Aa,'Awp,'Ax) as_ensures = unit +let admit () = failwith "Prims.admit: cannot be executed" +let magic () = failwith "Prims.magic: cannot be executed" +let unsafe_coerce : 'Aa 'Ab . 'Aa -> 'Ab = + fun x -> Obj.magic x + +type 'Ap spinoff = 'Ap + + +type nat = int +type pos = int +type nonzero = int +let op_Modulus x y = x mod y +let op_Division x y = x / y +let rec (pow2 : nat -> pos) = + fun x -> + Z.shift_left Z.one (Z.to_int x) + +let (min : int -> int -> int) = + fun x -> fun y -> if x <= y then x else y +let (abs : int -> int) = + fun x -> if x >= (parse_int "0") then x else op_Minus x +let string_of_bool = string_of_bool +let string_of_int = to_string diff --git a/stage0/fstar-lib/generated/FStar_Int32.ml b/stage0/dune/fstar-plugins/app/ints/FStar_Ints.ml.body similarity index 90% rename from stage0/fstar-lib/generated/FStar_Int32.ml rename to stage0/dune/fstar-plugins/app/ints/FStar_Ints.ml.body index 07bfb0ee7ff..de9b5d23188 100644 --- a/stage0/fstar-lib/generated/FStar_Int32.ml +++ b/stage0/dune/fstar-plugins/app/ints/FStar_Ints.ml.body @@ -1,19 +1,10 @@ -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS IS AN AUTOGENERATED FILE! See ulib/ml/Makefile *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -module M = Stdint.Int32 -type int32 = M.t -type t = M.t -let n = Prims.of_int 32 - -let int_to_t x = M.of_string (Z.to_string x) -let __int_to_t = int_to_t (* This .ml.body file is concatenated to every .ml.prefix file in this * directory (ulib/ml/) to generate the OCaml realizations for machine * integers, as they all pretty much share their definitions and are * based on Stdint. *) +type t = M.t + let v (x:t) : Prims.int = Prims.parse_int (M.to_string x) let zero = M.zero diff --git a/stage0/dune/fstar-plugins/app/ints/dune b/stage0/dune/fstar-plugins/app/ints/dune new file mode 100644 index 00000000000..2f7e19e83a6 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/ints/dune @@ -0,0 +1,46 @@ +; NOTE: We explcitly write 'bash ./mk_int_file.sh' instead of just +; calling the script so this works in native Windows. This is needed to +; even build a source package in Windows, since we ship exactly this +; dune file and script. We should consider just shipping the generated +; ML files, if there's a convenient way to do so. + +; This one is special and hand-written... sigh +; (rule +; (target FStar_UInt8.ml) +; (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) +; (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 8)))) + +(rule + (target FStar_UInt16.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 16)))) + +(rule + (target FStar_UInt32.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 32)))) + +(rule + (target FStar_UInt64.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 64)))) + +(rule + (target FStar_Int8.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 8)))) + +(rule + (target FStar_Int16.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 16)))) + +(rule + (target FStar_Int32.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 32)))) + +(rule + (target FStar_Int64.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 64)))) diff --git a/stage0/dune/fstar-plugins/app/ints/mk_int_file.sh b/stage0/dune/fstar-plugins/app/ints/mk_int_file.sh new file mode 100755 index 00000000000..6d4f6d64c32 --- /dev/null +++ b/stage0/dune/fstar-plugins/app/ints/mk_int_file.sh @@ -0,0 +1,34 @@ +#!/usr/bin/env bash + +# This script must run on Windows/Cygwin too. + +set -eu + +SIGN=$1 +WIDTH=$2 + +if [ "$SIGN" == "U" ]; then + cat << EOF + module M = Stdint.Uint${WIDTH} + type uint${WIDTH} = M.t + let n = Prims.of_int ${WIDTH} + + let uint_to_t x = M.of_string (Z.to_string x) + let __uint_to_t = uint_to_t +EOF +elif [ "$SIGN" == "S" ]; then + cat << EOF + module M = Stdint.Int${WIDTH} + type int${WIDTH} = M.t + let n = Prims.of_int ${WIDTH} + + let int_to_t x = M.of_string (Z.to_string x) + let __int_to_t = int_to_t +EOF +else + echo "Bad usage" &>2 + exit 1 +fi + +cat ./FStar_Ints.ml.body +exit 0 diff --git a/stage0/dune/fstar-plugins/dune b/stage0/dune/fstar-plugins/dune new file mode 100644 index 00000000000..41cea55c81b --- /dev/null +++ b/stage0/dune/fstar-plugins/dune @@ -0,0 +1,11 @@ +(include_subdirs unqualified) +(library + (name fstar_plugins) + (libraries + fstarcompiler + ) + (modes native) + (wrapped false) + (preprocess (pps ppx_deriving.show ppx_deriving_yojson sedlex.ppx)) + ; ^ Needed for some of the base modules. +) diff --git a/stage0/dune/fstar-plugins/plugin/FStarC_Tactics_Unseal.ml b/stage0/dune/fstar-plugins/plugin/FStarC_Tactics_Unseal.ml new file mode 100644 index 00000000000..62339692c70 --- /dev/null +++ b/stage0/dune/fstar-plugins/plugin/FStarC_Tactics_Unseal.ml @@ -0,0 +1,7 @@ +open Fstarcompiler +open FStarC_Tactics_Result +open FStarC_Tactics_Types + +let tac_return x = fun ps -> Success (x, ps) + +let unseal x = tac_return x diff --git a/stage0/fstar-lib/FStarC_Tactics_V1_Builtins.ml b/stage0/dune/fstar-plugins/plugin/FStarC_Tactics_V1_Builtins.ml similarity index 92% rename from stage0/fstar-lib/FStarC_Tactics_V1_Builtins.ml rename to stage0/dune/fstar-plugins/plugin/FStarC_Tactics_V1_Builtins.ml index b6ace620316..ef0bc1b2ca7 100644 --- a/stage0/fstar-lib/FStarC_Tactics_V1_Builtins.ml +++ b/stage0/dune/fstar-plugins/plugin/FStarC_Tactics_V1_Builtins.ml @@ -1,22 +1,21 @@ +open Fstarcompiler open Prims open FStar_Pervasives_Native open FStar_Pervasives open FStarC_Tactics_Result open FStarC_Tactics_Types -open FStar_Tactics_Effect -module N = FStarC_TypeChecker_Normalize -module E = FStar_Tactics_Effect -module B = FStarC_Tactics_V1_Basic -module TM = FStarC_Tactics_Monad -module CTRW = FStarC_Tactics_CtrlRewrite -module RT = FStarC_Reflection_Types -module RD = FStarC_Reflection_V1_Data -module EMB = FStarC_Syntax_Embeddings +module N = FStarC_TypeChecker_Normalize +module B = FStarC_Tactics_V1_Basic +module TM = FStarC_Tactics_Monad +module CTRW = FStarC_Tactics_CtrlRewrite +module RD = FStarC_Reflection_V1_Data +module EMB = FStarC_Syntax_Embeddings module EMBBase = FStarC_Syntax_Embeddings_Base -module NBET = FStarC_TypeChecker_NBETerm +module NBET = FStarC_TypeChecker_NBETerm -type 'a __tac = ('a, unit) E.tac_repr +type ('a,'wp) tac_repr = proofstate -> 'a __result +type 'a __tac = ('a, unit) tac_repr let interpret_tac (t: 'a TM.tac) (ps: proofstate): 'a __result = TM.run t ps @@ -138,7 +137,7 @@ let recover (t: unit -> 'a __tac): ((exn, 'a) either) __tac = from_tac_1 TM.reco let ctrl_rewrite (d : direction) - (t1 : RT.term -> (bool * ctrl_flag) __tac) + (t1 : FStarC_Syntax_Syntax.term -> (bool * ctrl_flag) __tac) (t2 : unit -> unit __tac) : unit __tac = from_tac_3 CTRW.ctrl_rewrite d (to_tac_1 t1) (to_tac_0 (t2 ())) diff --git a/stage0/fstar-lib/FStarC_Tactics_V2_Builtins.ml b/stage0/dune/fstar-plugins/plugin/FStarC_Tactics_V2_Builtins.ml similarity index 93% rename from stage0/fstar-lib/FStarC_Tactics_V2_Builtins.ml rename to stage0/dune/fstar-plugins/plugin/FStarC_Tactics_V2_Builtins.ml index 51ea88a8c6e..f47e475f23a 100644 --- a/stage0/fstar-lib/FStarC_Tactics_V2_Builtins.ml +++ b/stage0/dune/fstar-plugins/plugin/FStarC_Tactics_V2_Builtins.ml @@ -1,22 +1,22 @@ +open Fstarcompiler open Prims open FStar_Pervasives_Native open FStar_Pervasives open FStarC_Tactics_Result open FStarC_Tactics_Types -open FStar_Tactics_Effect -module N = FStarC_TypeChecker_Normalize -module E = FStar_Tactics_Effect -module B = FStarC_Tactics_V2_Basic -module TM = FStarC_Tactics_Monad -module CTRW = FStarC_Tactics_CtrlRewrite -module RT = FStarC_Reflection_Types -module RD = FStarC_Reflection_Data -module EMB = FStarC_Syntax_Embeddings -module EMB_Base = FStarC_Syntax_Embeddings_Base -module NBET = FStarC_TypeChecker_NBETerm +module N = FStarC_TypeChecker_Normalize +module B = FStarC_Tactics_V2_Basic +module TM = FStarC_Tactics_Monad +module CTRW = FStarC_Tactics_CtrlRewrite +module RT = FStarC_Reflection_Types +module RD = FStarC_Reflection_V1_Data +module EMB = FStarC_Syntax_Embeddings +module EMBBase = FStarC_Syntax_Embeddings_Base +module NBET = FStarC_TypeChecker_NBETerm -type 'a __tac = ('a, unit) E.tac_repr +type ('a,'wp) tac_repr = proofstate -> 'a __result +type 'a __tac = ('a, unit) tac_repr let interpret_tac (s:string) (t: 'a TM.tac) (ps: proofstate): 'a __result = FStarC_Errors.with_ctx @@ -61,6 +61,7 @@ let from_tac_5 s (t: 'a -> 'b -> 'c -> 'd -> 'e -> 'r TM.tac): 'a -> 'b -> 'c - (* Pointing to the internal primitives *) +let fixup_range = from_tac_1 "B.fixup_range" B.fixup_range let compress = from_tac_1 "B.compress" B.compress let set_goals = from_tac_1 "TM.set_goals" TM.set_goals let set_smt_goals = from_tac_1 "TM.set_smt_goals" TM.set_smt_goals @@ -135,6 +136,7 @@ let t_smt_sync = from_tac_1 "B.t_smt_sync" B.t_smt_sync let free_uvars = from_tac_1 "B.free_uvars" B.free_uvars let all_ext_options = from_tac_1 "B.all_ext_options" B.all_ext_options let ext_getv = from_tac_1 "B.ext_getv" B.ext_getv +let ext_enabled = from_tac_1 "B.ext_enabled" B.ext_enabled let ext_getns = from_tac_1 "B.ext_getns" B.ext_getns let alloc x = from_tac_1 "B.alloc" B.alloc x @@ -171,7 +173,7 @@ let recover (t: unit -> 'a __tac): ((exn, 'a) either) __tac = from_tac_1 "TM.rec let ctrl_rewrite (d : direction) - (t1 : RT.term -> (bool * ctrl_flag) __tac) + (t1 : FStarC_Syntax_Syntax.term -> (bool * ctrl_flag) __tac) (t2 : unit -> unit __tac) : unit __tac = from_tac_3 "ctrl_rewrite" CTRW.ctrl_rewrite d (to_tac_1 t1) (to_tac_0 (t2 ())) diff --git a/stage0/fstar-lib/FStar_Issue.ml b/stage0/dune/fstar-plugins/plugin/FStar_Issue.ml similarity index 87% rename from stage0/fstar-lib/FStar_Issue.ml rename to stage0/dune/fstar-plugins/plugin/FStar_Issue.ml index 09fb6a51837..3286f0ca6cf 100644 --- a/stage0/fstar-lib/FStar_Issue.ml +++ b/stage0/dune/fstar-plugins/plugin/FStar_Issue.ml @@ -1,3 +1,4 @@ +open Fstarcompiler type issue_level = FStarC_Errors.issue_level type issue = FStarC_Errors.issue type issue_level_string = string @@ -28,11 +29,12 @@ let mk_issue_level (i:issue_level_string) | "Info" -> EInfo | "Warning" -> EWarning +let issue_to_doc (i:issue) : FStarC_Pprint.document = FStarC_Errors.issue_to_doc' true i let render_issue (i:issue) : string = FStarC_Errors.format_issue i let mk_issue_doc (i:issue_level_string) (msg:FStarC_Pprint.document list) - (range:FStarC_Compiler_Range.range option) + (range:FStarC_Range.range option) (number:Z.t option) (ctx:string list) = { issue_level = mk_issue_level i; @@ -44,7 +46,7 @@ let mk_issue_doc (i:issue_level_string) (* repeated... could be extracted *) let mk_issue (i:issue_level_string) (msg:string) - (range:FStarC_Compiler_Range.range option) + (range:FStarC_Range.range option) (number:Z.t option) (ctx:string list) = { issue_level = mk_issue_level i; diff --git a/stage0/fstar-lib/FStar_Range.ml b/stage0/dune/fstar-plugins/plugin/FStar_Range.ml similarity index 57% rename from stage0/fstar-lib/FStar_Range.ml rename to stage0/dune/fstar-plugins/plugin/FStar_Range.ml index d7f3f16d42e..c615d145464 100644 --- a/stage0/fstar-lib/FStar_Range.ml +++ b/stage0/dune/fstar-plugins/plugin/FStar_Range.ml @@ -1,9 +1,9 @@ -type __range = FStarC_Compiler_Range_Type.range +type __range = Fstarcompiler.FStarC_Range_Type.range type range = __range -let mk_range f a b c d = FStarC_Compiler_Range_Type.mk_range f {line=a;col=b} {line=c;col=d} +let mk_range f a b c d = Fstarcompiler.FStarC_Range_Type.mk_range f {line=a;col=b} {line=c;col=d} let range_0 : range = let z = Prims.parse_int "0" in mk_range "dummy" z z z z -let join_range r1 r2 = FStarC_Compiler_Range_Ops.union_ranges r1 r2 +let join_range r1 r2 = Fstarcompiler.FStarC_Range_Ops.union_ranges r1 r2 let explode (r:__range) = (r.use_range.file_name, diff --git a/stage0/fstar-lib/FStar_Reflection_Typing_Builtins.ml b/stage0/dune/fstar-plugins/plugin/FStar_Reflection_Typing_Builtins.ml similarity index 92% rename from stage0/fstar-lib/FStar_Reflection_Typing_Builtins.ml rename to stage0/dune/fstar-plugins/plugin/FStar_Reflection_Typing_Builtins.ml index 1a0e98d571b..c0ad1c3e3c0 100644 --- a/stage0/fstar-lib/FStar_Reflection_Typing_Builtins.ml +++ b/stage0/dune/fstar-plugins/plugin/FStar_Reflection_Typing_Builtins.ml @@ -1,6 +1,6 @@ +open Fstarcompiler open FStarC_Syntax_Syntax -open FStarC_Reflection_Types -module R = FStarC_Compiler_Range +module R = FStarC_Range let dummy_range = R.dummyRange let underscore = FStarC_Ident.mk_ident ("_", R.dummyRange) @@ -26,6 +26,3 @@ let open_with (t:term) (v:term) let rename (t:term) (x:Prims.int) (y:Prims.int) : term = FStarC_Syntax_Subst.subst [NT(int_as_bv x, bv_to_name (int_as_bv y))] t - - - diff --git a/stage0/fstar-lib/FStar_Sealed.ml b/stage0/dune/fstar-plugins/plugin/FStar_Sealed.ml similarity index 100% rename from stage0/fstar-lib/FStar_Sealed.ml rename to stage0/dune/fstar-plugins/plugin/FStar_Sealed.ml diff --git a/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Equiv.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Algebra_CommMonoid_Equiv.ml similarity index 98% rename from stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Equiv.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Algebra_CommMonoid_Equiv.ml index 1ae7447d3e5..81918270a2c 100644 --- a/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Equiv.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Algebra_CommMonoid_Equiv.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type 'a equiv = | EQ of unit * unit * unit * unit diff --git a/stage0/fstar-lib/generated/FStar_BV.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_BV.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_BV.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_BV.ml index 71bcbe65a27..2b47f8ee225 100644 --- a/stage0/fstar-lib/generated/FStar_BV.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_BV.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type 'n bv_t = unit FStar_BitVector.bv_t let (bv_uext : diff --git a/stage0/fstar-lib/generated/FStar_BitVector.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_BitVector.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_BitVector.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_BitVector.ml index e5881773b8b..8e74fba1fae 100644 --- a/stage0/fstar-lib/generated/FStar_BitVector.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_BitVector.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type 'n bv_t = Prims.bool FStar_Seq_Base.seq let (zero_vec : Prims.pos -> unit bv_t) = diff --git a/stage0/fstar-lib/generated/FStar_Calc.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Calc.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Calc.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Calc.ml index cd377cd8d98..dc3ddc27dce 100644 --- a/stage0/fstar-lib/generated/FStar_Calc.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Calc.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'dummyV0, 'dummyV1, 'dummyV2) calc_chain = | CalcRefl of 'a diff --git a/stage0/fstar-lib/generated/FStar_Classical.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Classical.ml similarity index 84% rename from stage0/fstar-lib/generated/FStar_Classical.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Classical.ml index 9737d41291c..c64317e8f1f 100644 --- a/stage0/fstar-lib/generated/FStar_Classical.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Classical.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let get_squashed : 'b 'a . unit -> 'a = fun uu___ -> (fun uu___ -> Obj.magic ()) uu___ diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Classical_Sugar.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Classical_Sugar.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Classical_Sugar.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_ErasedLogic.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_ErasedLogic.ml similarity index 75% rename from stage0/fstar-lib/generated/FStar_ErasedLogic.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_ErasedLogic.ml index e4f44df3662..4b1e8a07d7d 100644 --- a/stage0/fstar-lib/generated/FStar_ErasedLogic.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_ErasedLogic.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'p) sig_ = unit type ('a, 'p) ex = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_FunctionalExtensionality.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_FunctionalExtensionality.ml similarity index 97% rename from stage0/fstar-lib/generated/FStar_FunctionalExtensionality.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_FunctionalExtensionality.ml index 95a5418d64f..b51fafc4369 100644 --- a/stage0/fstar-lib/generated/FStar_FunctionalExtensionality.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_FunctionalExtensionality.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'b) arrow = 'a -> 'b type ('a, 'b) efun = 'a -> 'b @@ -12,7 +13,6 @@ let on : 'a 'b . ('a -> 'b) -> ('a, 'b) restricted_t = fun f -> fun x -> f x type ('a, 'b) arrow_g = unit type ('a, 'b) efun_g = unit type ('a, 'b, 'f, 'g) feq_g = unit - type ('a, 'b, 'f) is_restricted_g = unit type ('a, 'b) restricted_g_t = unit type ('a, 'b) op_Hat_Subtraction_Greater_Greater = unit diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_IndefiniteDescription.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_IndefiniteDescription.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_IndefiniteDescription.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_List_Tot_Properties.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_List_Tot_Properties.ml similarity index 96% rename from stage0/fstar-lib/generated/FStar_List_Tot_Properties.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_List_Tot_Properties.ml index 59678332e0d..7dac681c648 100644 --- a/stage0/fstar-lib/generated/FStar_List_Tot_Properties.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_List_Tot_Properties.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'n) llist = 'a Prims.list let rec rev' : 'a . 'a Prims.list -> 'a Prims.list = diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Math_Lemmas.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Math_Lemmas.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Math_Lemmas.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Math_Lib.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Math_Lib.ml similarity index 98% rename from stage0/fstar-lib/generated/FStar_Math_Lib.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Math_Lib.ml index 6fb7b4a32d3..bf9cfa82c3b 100644 --- a/stage0/fstar-lib/generated/FStar_Math_Lib.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Math_Lib.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let rec (log_2 : Prims.pos -> Prims.nat) = fun x -> diff --git a/stage0/fstar-lib/generated/FStar_Monotonic_Pure.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Monotonic_Pure.ml similarity index 89% rename from stage0/fstar-lib/generated/FStar_Monotonic_Pure.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Monotonic_Pure.ml index b8178572663..fd4edc42fb6 100644 --- a/stage0/fstar-lib/generated/FStar_Monotonic_Pure.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Monotonic_Pure.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'wp) is_monotonic = unit type ('a, 'wp) as_pure_wp = 'wp diff --git a/stage0/fstar-lib/generated/FStar_Monotonic_Witnessed.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Monotonic_Witnessed.ml similarity index 91% rename from stage0/fstar-lib/generated/FStar_Monotonic_Witnessed.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Monotonic_Witnessed.ml index 41f6268bbcd..13deef3f6ea 100644 --- a/stage0/fstar-lib/generated/FStar_Monotonic_Witnessed.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Monotonic_Witnessed.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('world, 'uuuuu) get = unit type ('world, 'uuuuu, 'uuuuu1) set = unit diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Mul.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Mul.ml new file mode 100644 index 00000000000..a4699d6ae00 --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Mul.ml @@ -0,0 +1,3 @@ +open Fstarcompiler +open Prims +let (op_Star : Prims.int -> Prims.int -> Prims.int) = ( * ) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Order.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Order.ml similarity index 78% rename from stage0/fstar-lib/generated/FStar_Order.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Order.ml index f9bf2ea67c8..c1bfc968770 100644 --- a/stage0/fstar-lib/generated/FStar_Order.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Order.ml @@ -1,10 +1,12 @@ +open Fstarcompiler open Prims type order = | Lt | Eq | Gt let rec __knot_e_order _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Order.order" + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + "FStar.Order.order" (fun tm_0 -> match tm_0 with | ("FStar.Order.Lt", []) -> FStar_Pervasives_Native.Some Lt @@ -14,17 +16,17 @@ let rec __knot_e_order _ = (fun tm_4 -> match tm_4 with | Lt -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Order.Lt")) [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Order.Lt")) [] | Eq -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Order.Eq")) [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Order.Eq")) [] | Gt -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Order.Gt")) []) + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Order.Gt")) []) let e_order = __knot_e_order () let (uu___is_Lt : order -> Prims.bool) = fun projectee -> match projectee with | Lt -> true | uu___ -> false diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Pervasives.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Pervasives.ml new file mode 100644 index 00000000000..3b22e6e29e9 --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Pervasives.ml @@ -0,0 +1,352 @@ +open Fstarcompiler +open Prims +type pattern = unit + + +type eqtype_u = unit +type 'p spinoff = 'p +let id : 'a . 'a -> 'a = fun x -> x +type ('a, 'uuuuu) trivial_pure_post = unit +type ('uuuuu, 'uuuuu1) ambient = unit +let normalize_term : 'uuuuu . 'uuuuu -> 'uuuuu = fun x -> x +type 'a normalize = 'a +type norm_step = + | Simpl + | Weak + | HNF + | Primops + | Delta + | Zeta + | ZetaFull + | Iota + | NBE + | Reify + | NormDebug + | UnfoldOnly of Prims.string Prims.list + | UnfoldOnce of Prims.string Prims.list + | UnfoldFully of Prims.string Prims.list + | UnfoldAttr of Prims.string Prims.list + | UnfoldQual of Prims.string Prims.list + | UnfoldNamespace of Prims.string Prims.list + | Unmeta + | Unascribe +let (uu___is_Simpl : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) + = fun projectee -> match projectee with | Simpl -> true | uu___ -> false +let (uu___is_Weak : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | Weak -> true | uu___ -> false +let (uu___is_HNF : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | HNF -> true | uu___ -> false +let (uu___is_Primops : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | Primops -> true | uu___ -> false +let (uu___is_Delta : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) + = fun projectee -> match projectee with | Delta -> true | uu___ -> false +let (uu___is_Zeta : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | Zeta -> true | uu___ -> false +let (uu___is_ZetaFull : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | ZetaFull -> true | uu___ -> false +let (uu___is_Iota : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | Iota -> true | uu___ -> false +let (uu___is_NBE : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | NBE -> true | uu___ -> false +let (uu___is_Reify : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) + = fun projectee -> match projectee with | Reify -> true | uu___ -> false +let (uu___is_NormDebug : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | NormDebug -> true | uu___ -> false +let (uu___is_UnfoldOnly : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> + match projectee with | UnfoldOnly _0 -> true | uu___ -> false +let (__proj__UnfoldOnly__item___0 : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.string Prims.list) = + fun projectee -> match projectee with | UnfoldOnly _0 -> _0 +let (uu___is_UnfoldOnce : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> + match projectee with | UnfoldOnce _0 -> true | uu___ -> false +let (__proj__UnfoldOnce__item___0 : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.string Prims.list) = + fun projectee -> match projectee with | UnfoldOnce _0 -> _0 +let (uu___is_UnfoldFully : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> + match projectee with | UnfoldFully _0 -> true | uu___ -> false +let (__proj__UnfoldFully__item___0 : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.string Prims.list) = + fun projectee -> match projectee with | UnfoldFully _0 -> _0 +let (uu___is_UnfoldAttr : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> + match projectee with | UnfoldAttr _0 -> true | uu___ -> false +let (__proj__UnfoldAttr__item___0 : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.string Prims.list) = + fun projectee -> match projectee with | UnfoldAttr _0 -> _0 +let (uu___is_UnfoldQual : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> + match projectee with | UnfoldQual _0 -> true | uu___ -> false +let (__proj__UnfoldQual__item___0 : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.string Prims.list) = + fun projectee -> match projectee with | UnfoldQual _0 -> _0 +let (uu___is_UnfoldNamespace : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> + match projectee with | UnfoldNamespace _0 -> true | uu___ -> false +let (__proj__UnfoldNamespace__item___0 : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.string Prims.list) = + fun projectee -> match projectee with | UnfoldNamespace _0 -> _0 +let (uu___is_Unmeta : Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) + = fun projectee -> match projectee with | Unmeta -> true | uu___ -> false +let (uu___is_Unascribe : + Fstarcompiler.FStar_Pervasives.norm_step -> Prims.bool) = + fun projectee -> match projectee with | Unascribe -> true | uu___ -> false +let (simplify : Fstarcompiler.FStar_Pervasives.norm_step) = Simpl +let (weak : Fstarcompiler.FStar_Pervasives.norm_step) = Weak +let (hnf : Fstarcompiler.FStar_Pervasives.norm_step) = HNF +let (primops : Fstarcompiler.FStar_Pervasives.norm_step) = Primops +let (delta : Fstarcompiler.FStar_Pervasives.norm_step) = Delta +let (norm_debug : Fstarcompiler.FStar_Pervasives.norm_step) = NormDebug +let (zeta : Fstarcompiler.FStar_Pervasives.norm_step) = Zeta +let (zeta_full : Fstarcompiler.FStar_Pervasives.norm_step) = ZetaFull +let (iota : Fstarcompiler.FStar_Pervasives.norm_step) = Iota +let (nbe : Fstarcompiler.FStar_Pervasives.norm_step) = NBE +let (reify_ : Fstarcompiler.FStar_Pervasives.norm_step) = Reify +let (delta_only : + Prims.string Prims.list -> Fstarcompiler.FStar_Pervasives.norm_step) = + fun s -> UnfoldOnly s +let (delta_once : + Prims.string Prims.list -> Fstarcompiler.FStar_Pervasives.norm_step) = + fun s -> UnfoldOnce s +let (delta_fully : + Prims.string Prims.list -> Fstarcompiler.FStar_Pervasives.norm_step) = + fun s -> UnfoldFully s +let (delta_attr : + Prims.string Prims.list -> Fstarcompiler.FStar_Pervasives.norm_step) = + fun s -> UnfoldAttr s +let (delta_qualifier : + Prims.string Prims.list -> Fstarcompiler.FStar_Pervasives.norm_step) = + fun s -> UnfoldAttr s +let (delta_namespace : + Prims.string Prims.list -> Fstarcompiler.FStar_Pervasives.norm_step) = + fun s -> UnfoldNamespace s +let (unmeta : Fstarcompiler.FStar_Pervasives.norm_step) = Unmeta +let (unascribe : Fstarcompiler.FStar_Pervasives.norm_step) = Unascribe +let (norm : + Fstarcompiler.FStar_Pervasives.norm_step Prims.list -> + unit -> Obj.t -> Obj.t) + = fun uu___ -> fun uu___1 -> fun x -> x +type ('a, 'x, 'uuuuu) pure_return = unit +type ('a, 'b, 'wp1, 'wp2, 'uuuuu) pure_bind_wp = 'wp1 +type ('a, 'p, 'wputhen, 'wpuelse, 'uuuuu) pure_if_then_else = unit +type ('a, 'wp, 'uuuuu) pure_ite_wp = unit +type ('a, 'b, 'wp, 'uuuuu) pure_close_wp = unit +type ('a, 'uuuuu) pure_null_wp = unit +type ('p, 'uuuuu) pure_assert_wp = unit +type ('p, 'uuuuu) pure_assume_wp = unit +type ('a, 'pre, 'post, 'uuuuu) div_hoare_to_wp = unit +type 'heap st_pre_h = unit +type ('heap, 'a, 'pre) st_post_h' = unit +type ('heap, 'a) st_post_h = unit +type ('heap, 'a) st_wp_h = unit +type ('heap, 'a, 'x, 'p, 'uuuuu) st_return = 'p +type ('heap, 'a, 'b, 'wp1, 'wp2, 'p, 'h0) st_bind_wp = 'wp1 +type ('heap, 'a, 'p, 'wputhen, 'wpuelse, 'post, 'h0) st_if_then_else = unit +type ('heap, 'a, 'wp, 'post, 'h0) st_ite_wp = unit +type ('heap, 'a, 'wp1, 'wp2) st_stronger = unit +type ('heap, 'a, 'b, 'wp, 'p, 'h) st_close_wp = unit +type ('heap, 'a, 'wp) st_trivial = unit +type 'a result = + | V of 'a + | E of Prims.exn + | Err of Prims.string +let uu___is_V : 'a . 'a result -> Prims.bool = + fun projectee -> match projectee with | V v -> true | uu___ -> false +let __proj__V__item__v : 'a . 'a result -> 'a = + fun projectee -> match projectee with | V v -> v +let uu___is_E : 'a . 'a result -> Prims.bool = + fun projectee -> match projectee with | E e -> true | uu___ -> false +let __proj__E__item__e : 'a . 'a result -> Prims.exn = + fun projectee -> match projectee with | E e -> e +let uu___is_Err : 'a . 'a result -> Prims.bool = + fun projectee -> match projectee with | Err msg -> true | uu___ -> false +let __proj__Err__item__msg : 'a . 'a result -> Prims.string = + fun projectee -> match projectee with | Err msg -> msg +type ex_pre = unit +type ('a, 'pre) ex_post' = unit +type 'a ex_post = unit +type 'a ex_wp = unit +type ('a, 'x, 'p) ex_return = 'p +type ('a, 'b, 'wp1, 'wp2, 'p) ex_bind_wp = unit +type ('a, 'p, 'wputhen, 'wpuelse, 'post) ex_if_then_else = unit +type ('a, 'wp, 'post) ex_ite_wp = unit +type ('a, 'wp1, 'wp2) ex_stronger = unit +type ('a, 'b, 'wp, 'p) ex_close_wp = unit +type ('a, 'wp) ex_trivial = 'wp +type ('a, 'wp, 'p) lift_div_exn = 'wp +type 'h all_pre_h = unit +type ('h, 'a, 'pre) all_post_h' = unit +type ('h, 'a) all_post_h = unit +type ('h, 'a) all_wp_h = unit +type ('heap, 'a, 'x, 'p, 'uuuuu) all_return = 'p +type ('heap, 'a, 'b, 'wp1, 'wp2, 'p, 'h0) all_bind_wp = 'wp1 +type ('heap, 'a, 'p, 'wputhen, 'wpuelse, 'post, 'h0) all_if_then_else = unit +type ('heap, 'a, 'wp, 'post, 'h0) all_ite_wp = unit +type ('heap, 'a, 'wp1, 'wp2) all_stronger = unit +type ('heap, 'a, 'b, 'wp, 'p, 'h) all_close_wp = unit +type ('heap, 'a, 'wp) all_trivial = unit +type 'uuuuu inversion = unit +type ('a, 'b) either = + | Inl of 'a + | Inr of 'b +let uu___is_Inl : + 'a 'b . ('a, 'b) Fstarcompiler.FStar_Pervasives.either -> Prims.bool = + fun projectee -> + match projectee with + | Fstarcompiler.FStar_Pervasives.Inl v -> true + | uu___ -> false +let __proj__Inl__item__v : + 'a 'b . ('a, 'b) Fstarcompiler.FStar_Pervasives.either -> 'a = + fun projectee -> + match projectee with | Fstarcompiler.FStar_Pervasives.Inl v -> v +let uu___is_Inr : + 'a 'b . ('a, 'b) Fstarcompiler.FStar_Pervasives.either -> Prims.bool = + fun projectee -> + match projectee with + | Fstarcompiler.FStar_Pervasives.Inr v -> true + | uu___ -> false +let __proj__Inr__item__v : + 'a 'b . ('a, 'b) Fstarcompiler.FStar_Pervasives.either -> 'b = + fun projectee -> + match projectee with | Fstarcompiler.FStar_Pervasives.Inr v -> v +let dfst : 'a 'b . ('a, 'b) Fstarcompiler.Prims.dtuple2 -> 'a = + fun t -> Prims.__proj__Mkdtuple2__item___1 t +let dsnd : 'a 'b . ('a, 'b) Fstarcompiler.Prims.dtuple2 -> 'b = + fun t -> Prims.__proj__Mkdtuple2__item___2 t +type ('a, 'b, 'c) dtuple3 = + | Mkdtuple3 of 'a * 'b * 'c +let uu___is_Mkdtuple3 : 'a 'b 'c . ('a, 'b, 'c) dtuple3 -> Prims.bool = + fun projectee -> true +let __proj__Mkdtuple3__item___1 : 'a 'b 'c . ('a, 'b, 'c) dtuple3 -> 'a = + fun projectee -> match projectee with | Mkdtuple3 (_1, _2, _3) -> _1 +let __proj__Mkdtuple3__item___2 : 'a 'b 'c . ('a, 'b, 'c) dtuple3 -> 'b = + fun projectee -> match projectee with | Mkdtuple3 (_1, _2, _3) -> _2 +let __proj__Mkdtuple3__item___3 : 'a 'b 'c . ('a, 'b, 'c) dtuple3 -> 'c = + fun projectee -> match projectee with | Mkdtuple3 (_1, _2, _3) -> _3 +type ('a, 'b, 'c, 'd) dtuple4 = + | Mkdtuple4 of 'a * 'b * 'c * 'd +let uu___is_Mkdtuple4 : 'a 'b 'c 'd . ('a, 'b, 'c, 'd) dtuple4 -> Prims.bool + = fun projectee -> true +let __proj__Mkdtuple4__item___1 : + 'a 'b 'c 'd . ('a, 'b, 'c, 'd) dtuple4 -> 'a = + fun projectee -> match projectee with | Mkdtuple4 (_1, _2, _3, _4) -> _1 +let __proj__Mkdtuple4__item___2 : + 'a 'b 'c 'd . ('a, 'b, 'c, 'd) dtuple4 -> 'b = + fun projectee -> match projectee with | Mkdtuple4 (_1, _2, _3, _4) -> _2 +let __proj__Mkdtuple4__item___3 : + 'a 'b 'c 'd . ('a, 'b, 'c, 'd) dtuple4 -> 'c = + fun projectee -> match projectee with | Mkdtuple4 (_1, _2, _3, _4) -> _3 +let __proj__Mkdtuple4__item___4 : + 'a 'b 'c 'd . ('a, 'b, 'c, 'd) dtuple4 -> 'd = + fun projectee -> match projectee with | Mkdtuple4 (_1, _2, _3, _4) -> _4 +type ('a, 'b, 'c, 'd, 'e) dtuple5 = + | Mkdtuple5 of 'a * 'b * 'c * 'd * 'e +let uu___is_Mkdtuple5 : + 'a 'b 'c 'd 'e . ('a, 'b, 'c, 'd, 'e) dtuple5 -> Prims.bool = + fun projectee -> true +let __proj__Mkdtuple5__item___1 : + 'a 'b 'c 'd 'e . ('a, 'b, 'c, 'd, 'e) dtuple5 -> 'a = + fun projectee -> + match projectee with | Mkdtuple5 (_1, _2, _3, _4, _5) -> _1 +let __proj__Mkdtuple5__item___2 : + 'a 'b 'c 'd 'e . ('a, 'b, 'c, 'd, 'e) dtuple5 -> 'b = + fun projectee -> + match projectee with | Mkdtuple5 (_1, _2, _3, _4, _5) -> _2 +let __proj__Mkdtuple5__item___3 : + 'a 'b 'c 'd 'e . ('a, 'b, 'c, 'd, 'e) dtuple5 -> 'c = + fun projectee -> + match projectee with | Mkdtuple5 (_1, _2, _3, _4, _5) -> _3 +let __proj__Mkdtuple5__item___4 : + 'a 'b 'c 'd 'e . ('a, 'b, 'c, 'd, 'e) dtuple5 -> 'd = + fun projectee -> + match projectee with | Mkdtuple5 (_1, _2, _3, _4, _5) -> _4 +let __proj__Mkdtuple5__item___5 : + 'a 'b 'c 'd 'e . ('a, 'b, 'c, 'd, 'e) dtuple5 -> 'e = + fun projectee -> + match projectee with | Mkdtuple5 (_1, _2, _3, _4, _5) -> _5 +let rec false_elim : 'uuuuu . unit -> 'uuuuu = fun uu___ -> false_elim () +type __internal_ocaml_attributes = + | PpxDerivingShow + | PpxDerivingShowConstant of Prims.string + | PpxDerivingYoJson + | CInline + | Substitute + | Gc + | Comment of Prims.string + | CPrologue of Prims.string + | CEpilogue of Prims.string + | CConst of Prims.string + | CCConv of Prims.string + | CAbstractStruct + | CIfDef + | CMacro + | CNoInline +let (uu___is_PpxDerivingShow : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> + match projectee with | PpxDerivingShow -> true | uu___ -> false +let (uu___is_PpxDerivingShowConstant : + __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> + match projectee with + | PpxDerivingShowConstant _0 -> true + | uu___ -> false +let (__proj__PpxDerivingShowConstant__item___0 : + __internal_ocaml_attributes -> Prims.string) = + fun projectee -> match projectee with | PpxDerivingShowConstant _0 -> _0 +let (uu___is_PpxDerivingYoJson : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> + match projectee with | PpxDerivingYoJson -> true | uu___ -> false +let (uu___is_CInline : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | CInline -> true | uu___ -> false +let (uu___is_Substitute : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | Substitute -> true | uu___ -> false +let (uu___is_Gc : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | Gc -> true | uu___ -> false +let (uu___is_Comment : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | Comment _0 -> true | uu___ -> false +let (__proj__Comment__item___0 : __internal_ocaml_attributes -> Prims.string) + = fun projectee -> match projectee with | Comment _0 -> _0 +let (uu___is_CPrologue : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> + match projectee with | CPrologue _0 -> true | uu___ -> false +let (__proj__CPrologue__item___0 : + __internal_ocaml_attributes -> Prims.string) = + fun projectee -> match projectee with | CPrologue _0 -> _0 +let (uu___is_CEpilogue : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> + match projectee with | CEpilogue _0 -> true | uu___ -> false +let (__proj__CEpilogue__item___0 : + __internal_ocaml_attributes -> Prims.string) = + fun projectee -> match projectee with | CEpilogue _0 -> _0 +let (uu___is_CConst : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | CConst _0 -> true | uu___ -> false +let (__proj__CConst__item___0 : __internal_ocaml_attributes -> Prims.string) + = fun projectee -> match projectee with | CConst _0 -> _0 +let (uu___is_CCConv : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | CCConv _0 -> true | uu___ -> false +let (__proj__CCConv__item___0 : __internal_ocaml_attributes -> Prims.string) + = fun projectee -> match projectee with | CCConv _0 -> _0 +let (uu___is_CAbstractStruct : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> + match projectee with | CAbstractStruct -> true | uu___ -> false +let (uu___is_CIfDef : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | CIfDef -> true | uu___ -> false +let (uu___is_CMacro : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | CMacro -> true | uu___ -> false +let (uu___is_CNoInline : __internal_ocaml_attributes -> Prims.bool) = + fun projectee -> match projectee with | CNoInline -> true | uu___ -> false +let singleton : 'uuuuu . 'uuuuu -> 'uuuuu = fun x -> x +type 'a eqtype_as_type = 'a +let coerce_eq : 'a 'b . unit -> 'a -> 'b = + fun uu___1 -> fun uu___ -> (fun uu___ -> fun x -> Obj.magic x) uu___1 uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_PredicateExtensionality.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_PredicateExtensionality.ml similarity index 77% rename from stage0/fstar-lib/generated/FStar_PredicateExtensionality.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_PredicateExtensionality.ml index d1654b038ef..c05e9f6f32a 100644 --- a/stage0/fstar-lib/generated/FStar_PredicateExtensionality.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_PredicateExtensionality.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type 'a predicate = unit type ('a, 'p1, 'p2) peq = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Preorder.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Preorder.ml similarity index 92% rename from stage0/fstar-lib/generated/FStar_Preorder.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Preorder.ml index 538b10ad377..c7aa02f9cde 100644 --- a/stage0/fstar-lib/generated/FStar_Preorder.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Preorder.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type 'a relation = unit type 'a predicate = unit diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_PropositionalExtensionality.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_PropositionalExtensionality.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_PropositionalExtensionality.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_Const.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_Const.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Reflection_Const.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_Const.ml index b77b66aa164..ca230140e17 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_Const.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_Const.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (imp_qn : Prims.string Prims.list) = ["Prims"; "l_imp"] let (and_qn : Prims.string Prims.list) = ["Prims"; "l_and"] diff --git a/stage0/fstar-lib/generated/FStar_Reflection_TermEq.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_TermEq.ml similarity index 81% rename from stage0/fstar-lib/generated/FStar_Reflection_TermEq.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_TermEq.ml index 8e797d1b111..936b71f6f6e 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_TermEq.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_TermEq.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'pred, 'l) allP0 = Obj.t type ('a, 'b, 'top, 'pred, 'l) allP = Obj.t @@ -88,7 +89,8 @@ let opt_cmp : let either_cmp : 'a 'b . 'a comparator_for -> - 'b comparator_for -> ('a, 'b) FStar_Pervasives.either comparator_for + 'b comparator_for -> + ('a, 'b) Fstarcompiler.FStar_Pervasives.either comparator_for = fun uu___1 -> fun uu___ -> @@ -97,9 +99,11 @@ let either_cmp : fun e1 -> fun e2 -> match (e1, e2) with - | (FStar_Pervasives.Inl x, FStar_Pervasives.Inl y) -> + | (Fstarcompiler.FStar_Pervasives.Inl x, + Fstarcompiler.FStar_Pervasives.Inl y) -> Obj.magic (Obj.repr (cmpa x y)) - | (FStar_Pervasives.Inr x, FStar_Pervasives.Inr y) -> + | (Fstarcompiler.FStar_Pervasives.Inr x, + Fstarcompiler.FStar_Pervasives.Inr y) -> Obj.magic (Obj.repr (cmpb x y)) | uu___ -> Obj.magic (Obj.repr Neq)) uu___1 uu___ let pair_cmp : @@ -166,9 +170,10 @@ let either_dec_cmp : 'c -> ('a -> 'a -> ('a, unit, unit) cmpres) -> ('b -> 'b -> ('b, unit, unit) cmpres) -> - ('a, 'b) FStar_Pervasives.either -> - ('a, 'b) FStar_Pervasives.either -> - (('a, 'b) FStar_Pervasives.either, unit, unit) cmpres + ('a, 'b) Fstarcompiler.FStar_Pervasives.either -> + ('a, 'b) Fstarcompiler.FStar_Pervasives.either -> + (('a, 'b) Fstarcompiler.FStar_Pervasives.either, unit, + unit) cmpres = fun uu___5 -> fun uu___4 -> @@ -183,10 +188,12 @@ let either_dec_cmp : fun e1 -> fun e2 -> match (e1, e2) with - | (FStar_Pervasives.Inl x, FStar_Pervasives.Inl y) - -> Obj.magic (Obj.repr (cmpa x y)) - | (FStar_Pervasives.Inr x, FStar_Pervasives.Inr y) - -> Obj.magic (Obj.repr (cmpb x y)) + | (Fstarcompiler.FStar_Pervasives.Inl x, + Fstarcompiler.FStar_Pervasives.Inl y) -> + Obj.magic (Obj.repr (cmpa x y)) + | (Fstarcompiler.FStar_Pervasives.Inr x, + Fstarcompiler.FStar_Pervasives.Inr y) -> + Obj.magic (Obj.repr (cmpb x y)) | uu___ -> Obj.magic (Obj.repr Neq)) uu___5 uu___4 uu___3 uu___2 uu___1 uu___ let eq_cmp : 'uuuuu . 'uuuuu comparator_for = @@ -499,122 +506,126 @@ let (term_eq : FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) = fun t1 -> fun t2 -> uu___is_Eq (term_cmp t1 t2) let _ = - FStarC_Tactics_Native.register_plugin "FStar.Reflection.TermEq.term_eq" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Reflection.TermEq.term_eq" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.TermEq.term_eq" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_bool term_eq - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool term_eq + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.TermEq.term_eq") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.TermEq.term_eq" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_term - FStarC_Reflection_V2_NBEEmbeddings.e_term - FStarC_TypeChecker_NBETerm.e_bool term_eq - (FStarC_Ident.lid_of_str "FStar.Reflection.TermEq.term_eq") - cb us) args)) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + Fstarcompiler.FStarC_TypeChecker_NBETerm.e_bool term_eq + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.TermEq.term_eq") cb us) args)) let (term_eq_dec : faithful_term -> faithful_term -> Prims.bool) = fun t1 -> fun t2 -> uu___is_Eq (term_cmp t1 t2) let _ = - FStarC_Tactics_Native.register_plugin "FStar.Reflection.TermEq.term_eq_dec" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Reflection.TermEq.term_eq_dec" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.TermEq.term_eq_dec" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_bool term_eq_dec - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool + term_eq_dec + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.TermEq.term_eq_dec") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.TermEq.term_eq_dec" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_term - FStarC_Reflection_V2_NBEEmbeddings.e_term - FStarC_TypeChecker_NBETerm.e_bool term_eq_dec - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + Fstarcompiler.FStarC_TypeChecker_NBETerm.e_bool + term_eq_dec + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.TermEq.term_eq_dec") cb us) args)) let (univ_eq : FStarC_Reflection_Types.universe -> FStarC_Reflection_Types.universe -> Prims.bool) = fun u1 -> fun u2 -> uu___is_Eq (univ_cmp u1 u2) let _ = - FStarC_Tactics_Native.register_plugin "FStar.Reflection.TermEq.univ_eq" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Reflection.TermEq.univ_eq" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.TermEq.univ_eq" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_universe - FStarC_Reflection_V2_Embeddings.e_universe - FStarC_Syntax_Embeddings.e_bool univ_eq - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool univ_eq + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.TermEq.univ_eq") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.TermEq.univ_eq" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_universe - FStarC_Reflection_V2_NBEEmbeddings.e_universe - FStarC_TypeChecker_NBETerm.e_bool univ_eq - (FStarC_Ident.lid_of_str "FStar.Reflection.TermEq.univ_eq") - cb us) args)) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + Fstarcompiler.FStarC_TypeChecker_NBETerm.e_bool univ_eq + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.TermEq.univ_eq") cb us) args)) let (univ_eq_dec : faithful_universe -> faithful_universe -> Prims.bool) = fun u1 -> fun u2 -> uu___is_Eq (univ_cmp u1 u2) let _ = - FStarC_Tactics_Native.register_plugin "FStar.Reflection.TermEq.univ_eq_dec" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Reflection.TermEq.univ_eq_dec" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.TermEq.univ_eq_dec" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_universe - FStarC_Reflection_V2_Embeddings.e_universe - FStarC_Syntax_Embeddings.e_bool univ_eq_dec - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool + univ_eq_dec + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.TermEq.univ_eq_dec") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.TermEq.univ_eq_dec" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_universe - FStarC_Reflection_V2_NBEEmbeddings.e_universe - FStarC_TypeChecker_NBETerm.e_bool univ_eq_dec - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + Fstarcompiler.FStarC_TypeChecker_NBETerm.e_bool + univ_eq_dec + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.TermEq.univ_eq_dec") cb us) args)) \ No newline at end of file diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_TermEq_Simple.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_TermEq_Simple.ml new file mode 100644 index 00000000000..ed879fe372b --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_TermEq_Simple.ml @@ -0,0 +1,65 @@ +open Fstarcompiler +open Prims +let (term_eq : + FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) + = FStar_Reflection_TermEq.term_eq +let _ = + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Reflection.TermEq.Simple.term_eq" (Prims.of_int (2)) + (fun _psc -> + fun cb -> + fun us -> + fun args -> + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap + "FStar.Reflection.TermEq.Simple.term_eq" + (fun _ -> + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool term_eq + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.TermEq.Simple.term_eq") cb us) args)) + (fun cb -> + fun us -> + fun args -> + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap + "FStar.Reflection.TermEq.Simple.term_eq" + (fun _ -> + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + Fstarcompiler.FStarC_TypeChecker_NBETerm.e_bool term_eq + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.TermEq.Simple.term_eq") cb us) args)) +let (univ_eq : + FStarC_Reflection_Types.universe -> + FStarC_Reflection_Types.universe -> Prims.bool) + = FStar_Reflection_TermEq.univ_eq +let _ = + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Reflection.TermEq.Simple.univ_eq" (Prims.of_int (2)) + (fun _psc -> + fun cb -> + fun us -> + fun args -> + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap + "FStar.Reflection.TermEq.Simple.univ_eq" + (fun _ -> + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool univ_eq + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.TermEq.Simple.univ_eq") cb us) args)) + (fun cb -> + fun us -> + fun args -> + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap + "FStar.Reflection.TermEq.Simple.univ_eq" + (fun _ -> + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + Fstarcompiler.FStarC_TypeChecker_NBETerm.e_bool univ_eq + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.TermEq.Simple.univ_eq") cb us) args)) \ No newline at end of file diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V1_Derived.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Derived.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Reflection_V1_Derived.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Derived.ml index 6fa30d46414..a4639605088 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V1_Derived.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Derived.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (bv_of_binder : FStarC_Reflection_Types.binder -> FStarC_Reflection_Types.bv) = diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V1_Derived_Lemmas.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Derived_Lemmas.ml similarity index 98% rename from stage0/fstar-lib/generated/FStar_Reflection_V1_Derived_Lemmas.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Derived_Lemmas.ml index 17ac43edc7b..0d5abb8e925 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V1_Derived_Lemmas.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Derived_Lemmas.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'p, 'l) forall_list = Obj.t type ('a, 'p, 'l) forallP = unit diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V1_Formula.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Formula.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Reflection_V1_Formula.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Formula.ml index aaf2f853e05..5426b9e2477 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V1_Formula.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V1_Formula.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (bv_to_string : FStarC_Reflection_Types.bv -> diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V2_Arith.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Arith.ml similarity index 93% rename from stage0/fstar-lib/generated/FStar_Reflection_V2_Arith.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Arith.ml index 0290be4ca44..ae033262e43 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V2_Arith.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Arith.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type expr = | Lit of Prims.int @@ -183,15 +184,16 @@ let (ge : expr -> expr -> prop) = type st = (Prims.nat * FStarC_Reflection_Types.term Prims.list) type 'a tm = st -> - ((Prims.string, ('a * st)) FStar_Pervasives.either, unit) - FStar_Tactics_Effect.tac_repr + ((Prims.string, ('a * st)) Fstarcompiler.FStar_Pervasives.either, + unit) FStar_Tactics_Effect.tac_repr let return : 'a . 'a -> 'a tm = fun uu___ -> (fun x -> fun i -> Obj.magic (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives.Inr (x, i)))) uu___ + (fun uu___ -> Fstarcompiler.FStar_Pervasives.Inr (x, i)))) + uu___ let op_let_Bang : 'a 'b . 'a tm -> ('a -> 'b tm) -> 'b tm = fun m -> fun f -> @@ -212,13 +214,14 @@ let op_let_Bang : 'a 'b . 'a tm -> ('a -> 'b tm) -> 'b tm = (fun uu___1 -> (fun uu___1 -> match uu___1 with - | FStar_Pervasives.Inr (x, j) -> Obj.magic (Obj.repr (f x j)) + | Fstarcompiler.FStar_Pervasives.Inr (x, j) -> + Obj.magic (Obj.repr (f x j)) | s -> Obj.magic (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> - FStar_Pervasives.Inl + Fstarcompiler.FStar_Pervasives.Inl (FStar_Pervasives.__proj__Inl__item__v s))))) uu___1) let lift : @@ -256,7 +259,7 @@ let lift : (Prims.of_int (17))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> FStar_Pervasives.Inr uu___1)) + (fun uu___2 -> Fstarcompiler.FStar_Pervasives.Inr uu___1)) let liftM : 'a 'b . ('a -> 'b) -> 'a tm -> 'b tm = fun f -> fun x -> op_let_Bang x (fun xx -> return (f xx)) let liftM2 : 'a 'b 'c . ('a -> 'b -> 'c) -> 'a tm -> 'b tm -> 'c tm = @@ -342,14 +345,15 @@ let rec find_idx : (Prims.of_int (43))))) (Obj.magic uu___3) (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - match uu___4 with - | FStar_Pervasives_Native.None - -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some - (i, x1) -> + match uu___4 with + | FStar_Pervasives_Native.None -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> + FStar_Pervasives_Native.None) + | FStar_Pervasives_Native.Some + (i, x1) -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> FStar_Pervasives_Native.Some ((i + Prims.int_one), x1)))))) uu___1)))) @@ -374,15 +378,17 @@ let (atom : FStarC_Reflection_Types.term -> expr tm) = (Prims.of_int (118)) (Prims.of_int (57))))) (Obj.magic uu___1) (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - match uu___2 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives.Inr + match uu___2 with + | FStar_Pervasives_Native.None -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + Fstarcompiler.FStar_Pervasives.Inr ((Atom (n, t)), - ((n + Prims.int_one), (t :: atoms))) - | FStar_Pervasives_Native.Some (i, t1) -> - FStar_Pervasives.Inr + ((n + Prims.int_one), (t :: atoms)))) + | FStar_Pervasives_Native.Some (i, t1) -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + Fstarcompiler.FStar_Pervasives.Inr ((Atom (((n - Prims.int_one) - i), t1)), (n, atoms)))) let fail : 'a . Prims.string -> 'a tm = @@ -391,7 +397,7 @@ let fail : 'a . Prims.string -> 'a tm = fun i -> Obj.magic (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives.Inl s))) uu___ + (fun uu___ -> Fstarcompiler.FStar_Pervasives.Inl s))) uu___ let rec (as_arith_expr : FStarC_Reflection_Types.term -> expr tm) = fun t -> let uu___ = FStar_Reflection_V2_Collect.collect_app_ln t in @@ -542,8 +548,8 @@ let (is_arith_expr : FStarC_Reflection_Types.term -> expr tm) = let rec (is_arith_prop : FStarC_Reflection_Types.term -> st -> - ((Prims.string, (prop * st)) FStar_Pervasives.either, unit) - FStar_Tactics_Effect.tac_repr) + ((Prims.string, (prop * st)) Fstarcompiler.FStar_Pervasives.either, + unit) FStar_Tactics_Effect.tac_repr) = fun t -> fun i -> @@ -577,7 +583,7 @@ let rec (is_arith_prop : let run_tm : 'a . 'a tm -> - ((Prims.string, 'a) FStar_Pervasives.either, unit) + ((Prims.string, 'a) Fstarcompiler.FStar_Pervasives.either, unit) FStar_Tactics_Effect.tac_repr = fun m -> @@ -594,12 +600,14 @@ let run_tm : (Prims.of_int (212)) (Prims.of_int (4)) (Prims.of_int (214)) (Prims.of_int (25))))) (Obj.magic uu___) (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | FStar_Pervasives.Inr (x, uu___3) -> FStar_Pervasives.Inr x - | s -> - FStar_Pervasives.Inl + match uu___1 with + | Fstarcompiler.FStar_Pervasives.Inr (x, uu___2) -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> Fstarcompiler.FStar_Pervasives.Inr x) + | s -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + Fstarcompiler.FStar_Pervasives.Inl (FStar_Pervasives.__proj__Inl__item__v s))) let rec (expr_to_string : expr -> Prims.string) = fun e -> diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V2_Collect.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Collect.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Reflection_V2_Collect.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Collect.ml index 6c4b185d85c..30c1a766c11 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V2_Collect.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Collect.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let rec (inspect_ln_unascribe : FStarC_Reflection_Types.term -> FStarC_Reflection_V2_Data.term_view) = diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V2_Compare.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Compare.ml similarity index 74% rename from stage0/fstar-lib/generated/FStar_Reflection_V2_Compare.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Compare.ml index c0d77cc302c..579d3a44340 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V2_Compare.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Compare.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (compare_name : FStarC_Reflection_Types.name -> @@ -11,37 +12,38 @@ let (compare_name : FStar_Order.order_from_int (FStarC_Reflection_V2_Builtins.compare_string s1 s2)) let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_name" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_name" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) FStar_Order.e_order compare_name - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_name") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_name" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - (FStarC_TypeChecker_NBETerm.e_list - FStarC_TypeChecker_NBETerm.e_string) - (FStarC_TypeChecker_NBETerm.e_list - FStarC_TypeChecker_NBETerm.e_string) - (FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_name - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_list + Fstarcompiler.FStarC_TypeChecker_NBETerm.e_string) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_list + Fstarcompiler.FStarC_TypeChecker_NBETerm.e_string) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) + compare_name + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_name") cb us) args)) let (compare_fv : FStarC_Reflection_Types.fv -> @@ -52,32 +54,33 @@ let (compare_fv : compare_name (FStarC_Reflection_V2_Builtins.inspect_fv f1) (FStarC_Reflection_V2_Builtins.inspect_fv f2) let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_fv" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_fv" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_fv - FStarC_Reflection_V2_Embeddings.e_fv FStar_Order.e_order - compare_fv - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv + FStar_Order.e_order compare_fv + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_fv") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_fv" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_fv - FStarC_Reflection_V2_NBEEmbeddings.e_fv - (FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_fv - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_fv + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_fv + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) + compare_fv + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_fv") cb us) args)) let (compare_const : FStarC_Reflection_V2_Data.vconst -> @@ -127,34 +130,34 @@ let (compare_const : | (FStarC_Reflection_V2_Data.C_Real uu___, uu___1) -> FStar_Order.Lt | (uu___, FStarC_Reflection_V2_Data.C_Real uu___1) -> FStar_Order.Gt let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_const" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_const" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_vconst - FStarC_Reflection_V2_Embeddings.e_vconst + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_vconst + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_vconst FStar_Order.e_order compare_const - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_const") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_const" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_vconst - FStarC_Reflection_V2_NBEEmbeddings.e_vconst - (FStarC_TypeChecker_NBETerm.e_unsupported ()) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_vconst + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_vconst + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_const - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_const") cb us) args)) let (compare_ident : @@ -172,34 +175,34 @@ let (compare_ident : FStar_Order.order_from_int (FStarC_Reflection_V2_Builtins.compare_string nm1 nm2)) let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_ident" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_ident" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_ident - FStarC_Reflection_V2_Embeddings.e_ident + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_ident + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_ident FStar_Order.e_order compare_ident - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_ident") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_ident" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_ident - FStarC_Reflection_V2_NBEEmbeddings.e_ident - (FStarC_TypeChecker_NBETerm.e_unsupported ()) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_ident + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_ident + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_ident - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_ident") cb us) args)) let rec (compare_universe : @@ -242,34 +245,34 @@ let rec (compare_universe : | (uu___, FStarC_Reflection_V2_Data.Uv_Unif uu___1) -> FStar_Order.Gt | (FStarC_Reflection_V2_Data.Uv_Unk, uu___) -> FStar_Order.Lt let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_universe" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_universe" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_universe - FStarC_Reflection_V2_Embeddings.e_universe + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe FStar_Order.e_order compare_universe - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_universe") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_universe" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_universe - FStarC_Reflection_V2_NBEEmbeddings.e_universe - (FStarC_TypeChecker_NBETerm.e_unsupported ()) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_universe - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_universe") cb us) args)) let (compare_universes : @@ -277,38 +280,38 @@ let (compare_universes : FStarC_Reflection_V2_Data.universes -> FStar_Order.order) = fun us1 -> fun us2 -> FStar_Order.compare_list us1 us2 compare_universe let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_universes" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_universes" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe) - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe) + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe) FStar_Order.e_order compare_universes - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_universes") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_universes" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - (FStarC_TypeChecker_NBETerm.e_list - FStarC_Reflection_V2_NBEEmbeddings.e_universe) - (FStarC_TypeChecker_NBETerm.e_list - FStarC_Reflection_V2_NBEEmbeddings.e_universe) - (FStarC_TypeChecker_NBETerm.e_unsupported ()) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_list + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_list + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_universes - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_universes") cb us) args)) let rec (__compare_term : @@ -568,99 +571,101 @@ let (compare_term : FStarC_Reflection_Types.term -> FStar_Order.order) = __compare_term let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_term" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_term" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term FStar_Order.e_order compare_term - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_term") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_term" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_term - FStarC_Reflection_V2_NBEEmbeddings.e_term - (FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_term - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) + compare_term + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_term") cb us) args)) let (compare_comp : FStarC_Reflection_Types.comp -> FStarC_Reflection_Types.comp -> FStar_Order.order) = __compare_comp let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_comp" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_comp" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_comp - FStarC_Reflection_V2_Embeddings.e_comp + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp FStar_Order.e_order compare_comp - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_comp") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_comp" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_comp - FStarC_Reflection_V2_NBEEmbeddings.e_comp - (FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_comp - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_comp + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_comp + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) + compare_comp + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_comp") cb us) args)) let (compare_binder : FStarC_Reflection_Types.binder -> FStarC_Reflection_Types.binder -> FStar_Order.order) = __compare_binder let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Reflection.V2.Compare.compare_binder" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_binder" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_binder - FStarC_Reflection_V2_Embeddings.e_binder + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder FStar_Order.e_order compare_binder - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_binder") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Reflection.V2.Compare.compare_binder" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_binder - FStarC_Reflection_V2_NBEEmbeddings.e_binder - (FStarC_TypeChecker_NBETerm.e_unsupported ()) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_binder + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_binder + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) compare_binder - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Compare.compare_binder") cb us) args)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V2_Derived.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Derived.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Reflection_V2_Derived.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Derived.ml index 320f436e7e7..875b3227e22 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V2_Derived.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Derived.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (type_of_binder : FStarC_Reflection_Types.binder -> FStarC_Reflection_Types.typ) = diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V2_Derived_Lemmas.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Derived_Lemmas.ml similarity index 98% rename from stage0/fstar-lib/generated/FStar_Reflection_V2_Derived_Lemmas.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Derived_Lemmas.ml index 9ad19feb760..ac8b1ba1658 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V2_Derived_Lemmas.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Derived_Lemmas.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'p, 'l) forall_list = Obj.t type ('a, 'p, 'l) forallP = unit diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V2_Formula.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Formula.ml similarity index 88% rename from stage0/fstar-lib/generated/FStar_Reflection_V2_Formula.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Formula.ml index d3a18e6431d..47f514d8176 100644 --- a/stage0/fstar-lib/generated/FStar_Reflection_V2_Formula.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Reflection_V2_Formula.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (term_eq : FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) @@ -78,21 +79,21 @@ type comparison = | Gt | Ge let rec __knot_e_comparison _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Reflection.V2.Formula.comparison" (fun tm_0 -> match tm_0 with | ("FStar.Reflection.V2.Formula.Eq", _0_2::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) _0_2) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) _0_2) (fun _0_2 -> FStar_Pervasives_Native.Some (Eq _0_2)) | ("FStar.Reflection.V2.Formula.BoolEq", _0_4::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) _0_4) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) _0_4) (fun _0_4 -> FStar_Pervasives_Native.Some (BoolEq _0_4)) | ("FStar.Reflection.V2.Formula.Lt", []) -> FStar_Pervasives_Native.Some Lt @@ -106,41 +107,43 @@ let rec __knot_e_comparison _ = (fun tm_9 -> match tm_9 with | Eq _0_11 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Eq")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) _0_11), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Eq")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + _0_11), FStar_Pervasives_Native.None)] | BoolEq _0_13 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.BoolEq")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) _0_13), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.BoolEq")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + _0_13), FStar_Pervasives_Native.None)] | Lt -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Lt")) - [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Lt")) [] | Le -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Le")) - [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Le")) [] | Gt -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Gt")) - [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Gt")) [] | Ge -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Ge")) - []) + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Ge")) []) let e_comparison = __knot_e_comparison () let (uu___is_Eq : comparison -> Prims.bool) = fun projectee -> match projectee with | Eq _0 -> true | uu___ -> false @@ -180,7 +183,7 @@ type formula = | IntLit of Prims.int | F_Unknown let rec __knot_e_formula _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Reflection.V2.Formula.formula" (fun tm_18 -> match tm_18 with @@ -189,119 +192,131 @@ let rec __knot_e_formula _ = | ("FStar.Reflection.V2.Formula.False_", []) -> FStar_Pervasives_Native.Some False_ | ("FStar.Reflection.V2.Formula.Comp", _0_22::_1_23::_2_24::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed e_comparison - _0_22) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + e_comparison _0_22) (fun _0_22 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _1_23) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _1_23) (fun _1_23 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _2_24) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _2_24) (fun _2_24 -> FStar_Pervasives_Native.Some (Comp (_0_22, _1_23, _2_24))))) | ("FStar.Reflection.V2.Formula.And", _0_26::_1_27::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _0_26) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_26) (fun _0_26 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _1_27) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _1_27) (fun _1_27 -> FStar_Pervasives_Native.Some (And (_0_26, _1_27)))) | ("FStar.Reflection.V2.Formula.Or", _0_29::_1_30::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _0_29) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_29) (fun _0_29 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _1_30) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _1_30) (fun _1_30 -> FStar_Pervasives_Native.Some (Or (_0_29, _1_30)))) | ("FStar.Reflection.V2.Formula.Not", _0_32::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _0_32) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_32) (fun _0_32 -> FStar_Pervasives_Native.Some (Not _0_32)) | ("FStar.Reflection.V2.Formula.Implies", _0_34::_1_35::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _0_34) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_34) (fun _0_34 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _1_35) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _1_35) (fun _1_35 -> FStar_Pervasives_Native.Some (Implies (_0_34, _1_35)))) | ("FStar.Reflection.V2.Formula.Iff", _0_37::_1_38::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _0_37) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_37) (fun _0_37 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _1_38) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _1_38) (fun _1_38 -> FStar_Pervasives_Native.Some (Iff (_0_37, _1_38)))) | ("FStar.Reflection.V2.Formula.Forall", _0_40::_1_41::_2_42::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_bv_view _0_40) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_bv_view _0_40) (fun _0_40 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _1_41) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _1_41) (fun _1_41 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _2_42) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _2_42) (fun _2_42 -> FStar_Pervasives_Native.Some (Forall (_0_40, _1_41, _2_42))))) | ("FStar.Reflection.V2.Formula.Exists", _0_44::_1_45::_2_46::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_bv_view _0_44) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_bv_view _0_44) (fun _0_44 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _1_45) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _1_45) (fun _1_45 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _2_46) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _2_46) (fun _2_46 -> FStar_Pervasives_Native.Some (Exists (_0_44, _1_45, _2_46))))) | ("FStar.Reflection.V2.Formula.App", _0_48::_1_49::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _0_48) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_48) (fun _0_48 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term _1_49) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + _1_49) (fun _1_49 -> FStar_Pervasives_Native.Some (App (_0_48, _1_49)))) | ("FStar.Reflection.V2.Formula.Name", _0_51::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_namedv_view _0_51) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_namedv_view + _0_51) (fun _0_51 -> FStar_Pervasives_Native.Some (Name _0_51)) | ("FStar.Reflection.V2.Formula.FV", _0_53::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_fv _0_53) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv _0_53) (fun _0_53 -> FStar_Pervasives_Native.Some (FV _0_53)) | ("FStar.Reflection.V2.Formula.IntLit", _0_55::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Syntax_Embeddings.e_int _0_55) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Syntax_Embeddings.e_int _0_55) (fun _0_55 -> FStar_Pervasives_Native.Some (IntLit _0_55)) | ("FStar.Reflection.V2.Formula.F_Unknown", []) -> FStar_Pervasives_Native.Some F_Unknown @@ -309,136 +324,147 @@ let rec __knot_e_formula _ = (fun tm_57 -> match tm_57 with | True_ -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.True_")) - [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.True_")) [] | False_ -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.False_")) - [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.False_")) [] | Comp (_0_61, _1_62, _2_63) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Comp")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed e_comparison - _0_61), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _1_62), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Comp")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + e_comparison _0_61), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _1_62), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _2_63), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _2_63), FStar_Pervasives_Native.None)] | And (_0_65, _1_66) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.And")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _0_65), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.And")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_65), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _1_66), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _1_66), FStar_Pervasives_Native.None)] | Or (_0_68, _1_69) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Or")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _0_68), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Or")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_68), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _1_69), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _1_69), FStar_Pervasives_Native.None)] | Not _0_71 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Not")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _0_71), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Not")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_71), FStar_Pervasives_Native.None)] | Implies (_0_73, _1_74) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Implies")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _0_73), + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_73), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _1_74), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _1_74), FStar_Pervasives_Native.None)] | Iff (_0_76, _1_77) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Iff")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _0_76), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Iff")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_76), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _1_77), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _1_77), FStar_Pervasives_Native.None)] | Forall (_0_79, _1_80, _2_81) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Forall")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_bv_view _0_79), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _1_80), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Forall")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_bv_view + _0_79), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _1_80), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _2_81), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _2_81), FStar_Pervasives_Native.None)] | Exists (_0_83, _1_84, _2_85) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Exists")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_bv_view _0_83), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _1_84), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Exists")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_bv_view + _0_83), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _1_84), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _2_85), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _2_85), FStar_Pervasives_Native.None)] | App (_0_87, _1_88) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.App")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _0_87), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.App")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _0_87), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term _1_88), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term _1_88), FStar_Pervasives_Native.None)] | Name _0_90 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.Name")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_namedv_view _0_90), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.Name")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_namedv_view + _0_90), FStar_Pervasives_Native.None)] | FV _0_92 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.FV")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_fv _0_92), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.FV")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv _0_92), FStar_Pervasives_Native.None)] | IntLit _0_94 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.IntLit")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Syntax_Embeddings.e_int _0_94), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Reflection.V2.Formula.IntLit")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Embeddings.e_int _0_94), FStar_Pervasives_Native.None)] | F_Unknown -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Reflection.V2.Formula.F_Unknown")) []) let e_formula = __knot_e_formula () let (uu___is_True_ : formula -> Prims.bool) = @@ -717,18 +743,18 @@ let (term_as_formula' : (Prims.of_int (26))))) (Obj.magic uu___5) (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - match uu___6 with - | (FStar_Tactics_NamedView.Tv_FVar - fv, - (a1, - FStarC_Reflection_V2_Data.Q_Implicit):: - (a2, - FStarC_Reflection_V2_Data.Q_Explicit):: - (a3, - FStarC_Reflection_V2_Data.Q_Explicit)::[]) - -> + match uu___6 with + | (FStar_Tactics_NamedView.Tv_FVar + fv, + (a1, + FStarC_Reflection_V2_Data.Q_Implicit):: + (a2, + FStarC_Reflection_V2_Data.Q_Explicit):: + (a3, + FStarC_Reflection_V2_Data.Q_Explicit)::[]) + -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> if (FStarC_Reflection_V2_Builtins.inspect_fv fv) @@ -791,14 +817,16 @@ let (term_as_formula' : App (h0, (FStar_Pervasives_Native.fst - t1)) - | (FStar_Tactics_NamedView.Tv_FVar - fv, - (a1, - FStarC_Reflection_V2_Data.Q_Explicit):: - (a2, - FStarC_Reflection_V2_Data.Q_Explicit)::[]) - -> + t1))) + | (FStar_Tactics_NamedView.Tv_FVar + fv, + (a1, + FStarC_Reflection_V2_Data.Q_Explicit):: + (a2, + FStarC_Reflection_V2_Data.Q_Explicit)::[]) + -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> if (FStarC_Reflection_V2_Builtins.inspect_fv fv) @@ -855,14 +883,16 @@ let (term_as_formula' : App (h0, (FStar_Pervasives_Native.fst - t1)) - | (FStar_Tactics_NamedView.Tv_FVar - fv, - (a1, - FStarC_Reflection_V2_Data.Q_Implicit):: - (a2, - FStarC_Reflection_V2_Data.Q_Explicit)::[]) - -> + t1))) + | (FStar_Tactics_NamedView.Tv_FVar + fv, + (a1, + FStarC_Reflection_V2_Data.Q_Implicit):: + (a2, + FStarC_Reflection_V2_Data.Q_Explicit)::[]) + -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> if (FStarC_Reflection_V2_Builtins.inspect_fv fv) @@ -883,12 +913,14 @@ let (term_as_formula' : App (h0, (FStar_Pervasives_Native.fst - t1)) - | (FStar_Tactics_NamedView.Tv_FVar - fv, - (a, - FStarC_Reflection_V2_Data.Q_Explicit)::[]) - -> + t1))) + | (FStar_Tactics_NamedView.Tv_FVar + fv, + (a, + FStarC_Reflection_V2_Data.Q_Explicit)::[]) + -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> if (FStarC_Reflection_V2_Builtins.inspect_fv fv) @@ -925,8 +957,10 @@ let (term_as_formula' : App (h0, (FStar_Pervasives_Native.fst - t1)) - | uu___8 -> + t1))) + | uu___7 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___8 -> App (h0, (FStar_Pervasives_Native.fst @@ -1003,17 +1037,18 @@ let (term_as_formula' : "Unexpected: term_as_formula"], FStar_Pervasives_Native.None))))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Reflection.V2.Formula.term_as_formula'" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Reflection.V2.Formula.term_as_formula' (plugin)" - (FStarC_Tactics_Native.from_tactic_1 term_as_formula') - FStarC_Reflection_V2_Embeddings.e_term e_formula psc ncb us - args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + term_as_formula') + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term e_formula + psc ncb us args) let (term_as_formula : FStar_Tactics_NamedView.term -> (formula, unit) FStar_Tactics_Effect.tac_repr) diff --git a/stage0/fstar-lib/generated/FStar_Sealed_Inhabited.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Sealed_Inhabited.ml similarity index 92% rename from stage0/fstar-lib/generated/FStar_Sealed_Inhabited.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Sealed_Inhabited.ml index 760623317c6..201b4e36040 100644 --- a/stage0/fstar-lib/generated/FStar_Sealed_Inhabited.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Sealed_Inhabited.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type ('a, 'witness) sealed_ = 'a FStar_Sealed.sealed type ('a, 'witness, 'x) is_sealed = unit diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq_Base.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq_Base.ml new file mode 100644 index 00000000000..2697c354ac5 --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq_Base.ml @@ -0,0 +1,89 @@ +open Fstarcompiler +open Prims +type 'a seq = + | MkSeq of 'a Prims.list +let uu___is_MkSeq : 'a . 'a seq -> Prims.bool = fun projectee -> true +let __proj__MkSeq__item__l : 'a . 'a seq -> 'a Prims.list = + fun projectee -> match projectee with | MkSeq l -> l +let length : 'uuuuu . 'uuuuu seq -> Prims.nat = + fun s -> FStar_List_Tot_Base.length (__proj__MkSeq__item__l s) +let seq_to_list : 'uuuuu . 'uuuuu seq -> 'uuuuu Prims.list = + fun s -> match s with | MkSeq l -> l +let seq_of_list : 'uuuuu . 'uuuuu Prims.list -> 'uuuuu seq = fun l -> MkSeq l +let index : 'uuuuu . 'uuuuu seq -> Prims.nat -> 'uuuuu = + fun s -> fun i -> FStar_List_Tot_Base.index (__proj__MkSeq__item__l s) i +let _cons : 'a . 'a -> 'a seq -> 'a seq = + fun x -> fun s -> MkSeq (x :: (__proj__MkSeq__item__l s)) +let hd : 'a . 'a seq -> 'a = + fun s -> FStar_List_Tot_Base.hd (__proj__MkSeq__item__l s) +let tl : 'a . 'a seq -> 'a seq = + fun s -> MkSeq (FStar_List_Tot_Base.tl (__proj__MkSeq__item__l s)) +let rec create : 'uuuuu . Prims.nat -> 'uuuuu -> 'uuuuu seq = + fun len -> + fun v -> + if len = Prims.int_zero + then MkSeq [] + else _cons v (create (len - Prims.int_one) v) +let rec init_aux' : + 'a . Prims.nat -> Prims.nat -> (Prims.nat -> 'a) -> 'a seq = + fun len -> + fun k -> + fun contents -> + if (k + Prims.int_one) = len + then MkSeq [contents k] + else _cons (contents k) (init_aux' len (k + Prims.int_one) contents) +let init_aux : 'a . Prims.nat -> Prims.nat -> (Prims.nat -> 'a) -> 'a seq = + init_aux' +let init : 'uuuuu . Prims.nat -> (Prims.nat -> 'uuuuu) -> 'uuuuu seq = + fun len -> + fun contents -> + if len = Prims.int_zero + then MkSeq [] + else init_aux len Prims.int_zero contents +let empty : 'uuuuu . unit -> 'uuuuu seq = fun uu___ -> MkSeq [] +let createEmpty : 'a . unit -> 'a seq = fun uu___ -> empty () +let rec upd' : 'a . 'a seq -> Prims.nat -> 'a -> 'a seq = + fun s -> + fun n -> + fun v -> + if n = Prims.int_zero + then _cons v (tl s) + else _cons (hd s) (upd' (tl s) (n - Prims.int_one) v) +let upd : 'a . 'a seq -> Prims.nat -> 'a -> 'a seq = upd' +let append : 'uuuuu . 'uuuuu seq -> 'uuuuu seq -> 'uuuuu seq = + fun s1 -> + fun s2 -> + MkSeq + (FStar_List_Tot_Base.append (__proj__MkSeq__item__l s1) + (__proj__MkSeq__item__l s2)) +let cons : 'a . 'a -> 'a seq -> 'a seq = + fun x -> fun s -> append (create Prims.int_one x) s +let op_At_Bar : 'a . 'a seq -> 'a seq -> 'a seq = + fun s1 -> fun s2 -> append s1 s2 +let rec slice' : 'a . 'a seq -> Prims.nat -> Prims.nat -> 'a seq = + fun s -> + fun i -> + fun j -> + if i > Prims.int_zero + then slice' (tl s) (i - Prims.int_one) (j - Prims.int_one) + else + if j = Prims.int_zero + then MkSeq [] + else _cons (hd s) (slice' (tl s) i (j - Prims.int_one)) +let slice : 'a . 'a seq -> Prims.nat -> Prims.nat -> 'a seq = slice' +type ('a, 's1, 's2) equal = unit +let rec eq_i' : 'a . 'a seq -> 'a seq -> Prims.nat -> Prims.bool = + fun s1 -> + fun s2 -> + fun i -> + if i = (length s1) + then true + else + if (index s1 i) = (index s2 i) + then eq_i' s1 s2 (i + Prims.int_one) + else false +let eq_i : 'a . 'a seq -> 'a seq -> Prims.nat -> Prims.bool = eq_i' +let eq : 'uuuuu . 'uuuuu seq -> 'uuuuu seq -> Prims.bool = + fun s1 -> + fun s2 -> + if (length s1) = (length s2) then eq_i s1 s2 Prims.int_zero else false \ No newline at end of file diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq_Properties.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq_Properties.ml new file mode 100644 index 00000000000..df3a9084774 --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Seq_Properties.ml @@ -0,0 +1,226 @@ +open Fstarcompiler +open Prims +type ('a, 'l) lseq = 'a FStar_Seq_Base.seq +type ('a, 's, 'j) indexable = unit +let head : 'a . 'a FStar_Seq_Base.seq -> 'a = + fun s -> FStar_Seq_Base.index s Prims.int_zero +let tail : 'a . 'a FStar_Seq_Base.seq -> 'a FStar_Seq_Base.seq = + fun s -> FStar_Seq_Base.slice s Prims.int_one (FStar_Seq_Base.length s) +let last : 'a . 'a FStar_Seq_Base.seq -> 'a = + fun s -> FStar_Seq_Base.index s ((FStar_Seq_Base.length s) - Prims.int_one) +let split : + 'a . + 'a FStar_Seq_Base.seq -> + Prims.nat -> ('a FStar_Seq_Base.seq * 'a FStar_Seq_Base.seq) + = + fun s -> + fun i -> + ((FStar_Seq_Base.slice s Prims.int_zero i), + (FStar_Seq_Base.slice s i (FStar_Seq_Base.length s))) +let split_eq : + 'a . + 'a FStar_Seq_Base.seq -> + Prims.nat -> ('a FStar_Seq_Base.seq * 'a FStar_Seq_Base.seq) + = fun s -> fun i -> let x = split s i in x +let rec count : 'a . 'a -> 'a FStar_Seq_Base.seq -> Prims.nat = + fun x -> + fun s -> + if (FStar_Seq_Base.length s) = Prims.int_zero + then Prims.int_zero + else + if (head s) = x + then Prims.int_one + (count x (tail s)) + else count x (tail s) +let mem : 'a . 'a -> 'a FStar_Seq_Base.seq -> Prims.bool = + fun x -> fun l -> (count x l) > Prims.int_zero +let rec index_mem : 'a . 'a -> 'a FStar_Seq_Base.seq -> Prims.nat = + fun x -> + fun s -> + if (head s) = x + then Prims.int_zero + else Prims.int_one + (index_mem x (tail s)) +let swap : + 'a . + 'a FStar_Seq_Base.seq -> Prims.nat -> Prims.nat -> 'a FStar_Seq_Base.seq + = + fun s -> + fun i -> + fun j -> + FStar_Seq_Base.upd + (FStar_Seq_Base.upd s j (FStar_Seq_Base.index s i)) i + (FStar_Seq_Base.index s j) +let rec sorted : + 'a . ('a -> 'a -> Prims.bool) -> 'a FStar_Seq_Base.seq -> Prims.bool = + fun f -> + fun s -> + if (FStar_Seq_Base.length s) <= Prims.int_one + then true + else + (let hd = head s in + (f hd (FStar_Seq_Base.index s Prims.int_one)) && (sorted f (tail s))) +type ('a, 'f) total_order = unit +type 'a tot_ord = 'a -> 'a -> Prims.bool +let split_5 : + 'a . + 'a FStar_Seq_Base.seq -> + Prims.nat -> Prims.nat -> 'a FStar_Seq_Base.seq FStar_Seq_Base.seq + = + fun s -> + fun i -> + fun j -> + let frag_lo = FStar_Seq_Base.slice s Prims.int_zero i in + let frag_i = FStar_Seq_Base.slice s i (i + Prims.int_one) in + let frag_mid = FStar_Seq_Base.slice s (i + Prims.int_one) j in + let frag_j = FStar_Seq_Base.slice s j (j + Prims.int_one) in + let frag_hi = + FStar_Seq_Base.slice s (j + Prims.int_one) + (FStar_Seq_Base.length s) in + FStar_Seq_Base.upd + (FStar_Seq_Base.upd + (FStar_Seq_Base.upd + (FStar_Seq_Base.upd + (FStar_Seq_Base.create (Prims.of_int (5)) frag_lo) + Prims.int_one frag_i) (Prims.of_int (2)) frag_mid) + (Prims.of_int (3)) frag_j) (Prims.of_int (4)) frag_hi +type ('a, 's1, 's2) permutation = unit +let splice : + 'a . + 'a FStar_Seq_Base.seq -> + Prims.nat -> + 'a FStar_Seq_Base.seq -> Prims.nat -> 'a FStar_Seq_Base.seq + = + fun s1 -> + fun i -> + fun s2 -> + fun j -> + FStar_Seq_Base.append (FStar_Seq_Base.slice s1 Prims.int_zero i) + (FStar_Seq_Base.append (FStar_Seq_Base.slice s2 i j) + (FStar_Seq_Base.slice s1 j (FStar_Seq_Base.length s1))) +let replace_subseq : + 'a . + 'a FStar_Seq_Base.seq -> + Prims.nat -> + Prims.nat -> 'a FStar_Seq_Base.seq -> 'a FStar_Seq_Base.seq + = + fun s -> + fun i -> + fun j -> + fun sub -> + FStar_Seq_Base.append (FStar_Seq_Base.slice s Prims.int_zero i) + (FStar_Seq_Base.append sub + (FStar_Seq_Base.slice s j (FStar_Seq_Base.length s))) +let snoc : 'a . 'a FStar_Seq_Base.seq -> 'a -> 'a FStar_Seq_Base.seq = + fun s -> + fun x -> FStar_Seq_Base.append s (FStar_Seq_Base.create Prims.int_one x) +let rec find_l : + 'a . + ('a -> Prims.bool) -> + 'a FStar_Seq_Base.seq -> 'a FStar_Pervasives_Native.option + = + fun f -> + fun l -> + if (FStar_Seq_Base.length l) = Prims.int_zero + then FStar_Pervasives_Native.None + else + if f (head l) + then FStar_Pervasives_Native.Some (head l) + else find_l f (tail l) +let un_snoc : 'a . 'a FStar_Seq_Base.seq -> ('a FStar_Seq_Base.seq * 'a) = + fun s -> + let uu___ = split s ((FStar_Seq_Base.length s) - Prims.int_one) in + match uu___ with + | (s', a1) -> (s', (FStar_Seq_Base.index a1 Prims.int_zero)) +let rec find_r : + 'a . + ('a -> Prims.bool) -> + 'a FStar_Seq_Base.seq -> 'a FStar_Pervasives_Native.option + = + fun f -> + fun l -> + if (FStar_Seq_Base.length l) = Prims.int_zero + then FStar_Pervasives_Native.None + else + (let uu___1 = un_snoc l in + match uu___1 with + | (prefix, last1) -> + if f last1 + then FStar_Pervasives_Native.Some last1 + else find_r f prefix) +type 'i found = unit +let rec seq_find_aux : + 'a . + ('a -> Prims.bool) -> + 'a FStar_Seq_Base.seq -> Prims.nat -> 'a FStar_Pervasives_Native.option + = + fun f -> + fun l -> + fun ctr -> + match ctr with + | uu___ when uu___ = Prims.int_zero -> FStar_Pervasives_Native.None + | uu___ -> + let i = ctr - Prims.int_one in + if f (FStar_Seq_Base.index l i) + then FStar_Pervasives_Native.Some (FStar_Seq_Base.index l i) + else seq_find_aux f l i +let seq_find : + 'a . + ('a -> Prims.bool) -> + 'a FStar_Seq_Base.seq -> 'a FStar_Pervasives_Native.option + = fun f -> fun l -> seq_find_aux f l (FStar_Seq_Base.length l) +let for_all : 'a . ('a -> Prims.bool) -> 'a FStar_Seq_Base.seq -> Prims.bool + = + fun f -> + fun l -> + FStar_Pervasives_Native.uu___is_None + (seq_find (fun i -> Prims.op_Negation (f i)) l) +type ('a, 'l, 's) createL_post = unit +let createL : 'a . 'a Prims.list -> 'a FStar_Seq_Base.seq = + fun l -> let s = FStar_Seq_Base.seq_of_list l in s +type ('a, 's, 'x) contains = unit +type ('a, 'susuff, 's) suffix_of = unit +let of_list : 'a . 'a Prims.list -> 'a FStar_Seq_Base.seq = + fun l -> FStar_Seq_Base.seq_of_list l +type ('a, 'i, 's, 'l) explode_and = Obj.t +type ('uuuuu, 's, 'l) pointwise_and = Obj.t +let sortWith : + 'a . + ('a -> 'a -> Prims.int) -> 'a FStar_Seq_Base.seq -> 'a FStar_Seq_Base.seq + = + fun f -> + fun s -> + FStar_Seq_Base.seq_of_list + (FStar_List_Tot_Base.sortWith f (FStar_Seq_Base.seq_to_list s)) +let sort_lseq : + 'a . Prims.nat -> 'a tot_ord -> ('a, unit) lseq -> ('a, unit) lseq = + fun n -> + fun f -> + fun s -> + let s' = sortWith (FStar_List_Tot_Base.compare_of_bool f) s in s' +let rec foldr : 'a 'b . ('b -> 'a -> 'a) -> 'b FStar_Seq_Base.seq -> 'a -> 'a + = + fun f -> + fun s -> + fun init -> + if (FStar_Seq_Base.length s) = Prims.int_zero + then init + else f (head s) (foldr f (tail s) init) +let rec foldr_snoc : + 'a 'b . ('b -> 'a -> 'a) -> 'b FStar_Seq_Base.seq -> 'a -> 'a = + fun f -> + fun s -> + fun init -> + if (FStar_Seq_Base.length s) = Prims.int_zero + then init + else + (let uu___1 = un_snoc s in + match uu___1 with | (s1, last1) -> f last1 (foldr_snoc f s1 init)) +let rec map_seq : + 'a 'b . ('a -> 'b) -> 'a FStar_Seq_Base.seq -> 'b FStar_Seq_Base.seq = + fun f -> + fun s -> + if (FStar_Seq_Base.length s) = Prims.int_zero + then FStar_Seq_Base.empty () + else + (let uu___1 = ((head s), (tail s)) in + match uu___1 with + | (hd, tl) -> FStar_Seq_Base.cons (f hd) (map_seq f tl)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Set.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Set.ml similarity index 98% rename from stage0/fstar-lib/generated/FStar_Set.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Set.ml index 843939084b7..361865f35b4 100644 --- a/stage0/fstar-lib/generated/FStar_Set.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Set.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type 'a set = ('a, Prims.bool) FStar_FunctionalExtensionality.restricted_t type ('a, 's1, 's2) equal = unit diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Squash.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Squash.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Squash.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_StrongExcludedMiddle.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_StrongExcludedMiddle.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_StrongExcludedMiddle.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_BV.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_BV.ml similarity index 97% rename from stage0/fstar-lib/generated/FStar_Tactics_BV.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_BV.ml index d053282bccc..386d092e3ea 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_BV.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_BV.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let rec (arith_expr_to_bv : FStar_Reflection_V2_Arith.expr -> @@ -1172,7 +1173,7 @@ let (arith_to_bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___1 -> let uu___2 = FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.delta_only ["FStar.BV.bvult"]] in + [Fstarcompiler.FStar_Pervasives.delta_only ["FStar.BV.bvult"]] in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic @@ -1257,7 +1258,7 @@ let (arith_to_bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___8 -> (fun uu___8 -> match uu___8 with - | FStar_Pervasives.Inl + | Fstarcompiler.FStar_Pervasives.Inl s -> let uu___9 = FStarC_Tactics_V2_Builtins.dump @@ -1291,7 +1292,7 @@ let (arith_to_bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Tactics_V2_Derived.trefl ())) uu___10)) - | FStar_Pervasives.Inr + | Fstarcompiler.FStar_Pervasives.Inr e -> Obj.magic (FStar_Tactics_V2_Derived.seq @@ -1349,21 +1350,24 @@ let (arith_to_bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Prims.of_int (65))))) (Obj.magic uu___7) (fun uu___8 -> - FStar_Tactics_V2_Derived.fail - uu___8))) uu___6))) - uu___5))) uu___3)) + (fun uu___8 -> + Obj.magic + (FStar_Tactics_V2_Derived.fail + uu___8)) uu___8))) + uu___6))) uu___5))) uu___3)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.BV.arith_to_bv_tac" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.BV.arith_to_bv_tac" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.BV.arith_to_bv_tac (plugin)" - (FStarC_Tactics_Native.from_tactic_1 arith_to_bv_tac) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + arith_to_bv_tac) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.focus @@ -1479,7 +1483,7 @@ let (bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___11 -> let uu___12 = FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.delta] in + [Fstarcompiler.FStar_Pervasives.delta] in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -1513,17 +1517,17 @@ let (bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = uu___11))) uu___9))) uu___7))) uu___5))) uu___3)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.BV.bv_tac" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.BV.bv_tac" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.BV.bv_tac (plugin)" - (FStarC_Tactics_Native.from_tactic_1 bv_tac) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 bv_tac) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (bv_tac_lt : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun n -> FStar_Tactics_V2_Derived.focus @@ -1682,17 +1686,17 @@ let (bv_tac_lt : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = uu___8))) uu___6))) uu___4))) uu___3))) uu___2)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.BV.bv_tac_lt" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.BV.bv_tac_lt" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.BV.bv_tac_lt (plugin)" - (FStarC_Tactics_Native.from_tactic_1 bv_tac_lt) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 bv_tac_lt) + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (to_bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.focus @@ -1763,14 +1767,14 @@ let (to_bv_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = Obj.magic (arith_to_bv_tac ())) uu___7))) uu___5))) uu___3)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.BV.to_bv_tac" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.BV.to_bv_tac" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.BV.to_bv_tac (plugin)" - (FStarC_Tactics_Native.from_tactic_1 to_bv_tac) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 to_bv_tac) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_BV_Lemmas.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_BV_Lemmas.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_BV_Lemmas.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Canon.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Canon.ml similarity index 98% rename from stage0/fstar-lib/generated/FStar_Tactics_Canon.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Canon.ml index f3e95f91d7d..5f7e20f5efb 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_Canon.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Canon.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (step : (unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> @@ -69,7 +70,8 @@ let rec (canon_point : FStar_Reflection_V2_Arith.Lit b) -> let uu___1 = - FStarC_Tactics_V2_Builtins.norm [FStar_Pervasives.primops] in + FStarC_Tactics_V2_Builtins.norm + [Fstarcompiler.FStar_Pervasives.primops] in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -116,7 +118,8 @@ let rec (canon_point : -> let uu___1 = FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.delta; FStar_Pervasives.primops] in + [Fstarcompiler.FStar_Pervasives.delta; + Fstarcompiler.FStar_Pervasives.primops] in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -1248,7 +1251,9 @@ let rec (canon_point : let (canon_point_entry : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> - let uu___1 = FStarC_Tactics_V2_Builtins.norm [FStar_Pervasives.primops] in + let uu___1 = + FStarC_Tactics_V2_Builtins.norm + [Fstarcompiler.FStar_Pervasives.primops] in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic @@ -1328,7 +1333,8 @@ let (canon_point_entry : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (fun uu___8 -> (fun uu___8 -> match uu___8 with - | FStar_Pervasives.Inr e -> + | Fstarcompiler.FStar_Pervasives.Inr + e -> let uu___9 = canon_point e in Obj.magic @@ -1354,7 +1360,7 @@ let (canon_point_entry : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) FStar_Tactics_Effect.lift_div_tac (fun uu___10 -> ()))) - | FStar_Pervasives.Inl + | Fstarcompiler.FStar_Pervasives.Inl uu___9 -> Obj.magic (FStar_Tactics_V2_Derived.trefl @@ -1407,20 +1413,22 @@ let (canon_point_entry : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Prims.of_int (48))))) (Obj.magic uu___7) (fun uu___8 -> - FStar_Tactics_V2_Derived.fail - uu___8))) uu___5))) uu___4))) - uu___2) + (fun uu___8 -> + Obj.magic + (FStar_Tactics_V2_Derived.fail + uu___8)) uu___8))) + uu___5))) uu___4))) uu___2) let (canon : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.pointwise canon_point_entry let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.Canon.canon" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.Canon.canon" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Canon.canon (plugin)" - (FStarC_Tactics_Native.from_tactic_1 canon) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 canon) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoidSimple_Equiv.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CanonCommMonoidSimple_Equiv.ml similarity index 93% rename from stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoidSimple_Equiv.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CanonCommMonoidSimple_Equiv.ml index 42cf1d19ce8..de37c16d6fa 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoidSimple_Equiv.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CanonCommMonoidSimple_Equiv.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (term_eq : FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) @@ -183,8 +184,8 @@ let (fatom : (fun vfresh -> let uu___3 = FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.iota; - FStar_Pervasives.zeta] t in + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta] t in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -391,9 +392,9 @@ let (reification : fun t -> let uu___ = FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.iota; - FStar_Pervasives.zeta; - FStar_Pervasives.delta] + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta; + Fstarcompiler.FStar_Pervasives.delta] (FStarC_Reflection_V2_Builtins.pack_ln (FStarC_Reflection_V2_Data.Tv_App ((FStarC_Reflection_V2_Builtins.pack_ln @@ -423,9 +424,9 @@ let (reification : (fun mult -> let uu___1 = FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.iota; - FStar_Pervasives.zeta; - FStar_Pervasives.delta] + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta; + Fstarcompiler.FStar_Pervasives.delta] (FStarC_Reflection_V2_Builtins.pack_ln (FStarC_Reflection_V2_Data.Tv_App ((FStarC_Reflection_V2_Builtins.pack_ln @@ -456,8 +457,8 @@ let (reification : (fun unit -> let uu___2 = FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.iota; - FStar_Pervasives.zeta] t in + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta] t in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -705,9 +706,9 @@ let (canon_lhs_rhs : fun rhs -> let uu___ = FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.iota; - FStar_Pervasives.zeta; - FStar_Pervasives.delta] + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta; + Fstarcompiler.FStar_Pervasives.delta] (FStarC_Reflection_V2_Builtins.pack_ln (FStarC_Reflection_V2_Data.Tv_App ((FStarC_Reflection_V2_Builtins.pack_ln @@ -1037,9 +1038,9 @@ let (canon_lhs_rhs : let uu___14 = FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.iota; - FStar_Pervasives.zeta; - FStar_Pervasives.delta_only + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta; + Fstarcompiler.FStar_Pervasives.delta_only ["FStar.Tactics.CanonCommMonoidSimple.Equiv.canon"; "FStar.Tactics.CanonCommMonoidSimple.Equiv.xsdenote"; "FStar.Tactics.CanonCommMonoidSimple.Equiv.flatten"; @@ -1054,7 +1055,7 @@ let (canon_lhs_rhs : "FStar.List.Tot.Base.partition"; "FStar.List.Tot.Base.bool_of_compare"; "FStar.List.Tot.Base.compare_of_bool"]; - FStar_Pervasives.primops] in + Fstarcompiler.FStar_Pervasives.primops] in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -1121,7 +1122,8 @@ let (canon_monoid : fun m -> let uu___ = FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.iota; FStar_Pervasives.zeta] in + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta] in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic @@ -1183,91 +1185,85 @@ let (canon_monoid : | (sq, rel_xy) -> (match rel_xy with | (rel_xy1, uu___5)::[] -> + let uu___6 = + FStar_Tactics_V2_SyntaxHelpers.collect_app + rel_xy1 in Obj.magic - (Obj.repr - (let uu___6 = - FStar_Tactics_V2_SyntaxHelpers.collect_app - rel_xy1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.Equiv.fst" - (Prims.of_int (381)) - (Prims.of_int (21)) - (Prims.of_int (381)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.Equiv.fst" - (Prims.of_int (380)) - (Prims.of_int (21)) - (Prims.of_int (391)) - (Prims.of_int (6))))) - (Obj.magic uu___6) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.CanonCommMonoidSimple.Equiv.fst" + (Prims.of_int (381)) + (Prims.of_int (21)) + (Prims.of_int (381)) + (Prims.of_int (39))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.CanonCommMonoidSimple.Equiv.fst" + (Prims.of_int (380)) + (Prims.of_int (21)) + (Prims.of_int (391)) + (Prims.of_int (6))))) + (Obj.magic uu___6) + (fun uu___7 -> (fun uu___7 -> - (fun uu___7 -> - match uu___7 with - | (rel, xy) -> - if - (FStar_List_Tot_Base.length - xy) - >= - (Prims.of_int (2)) - then - Obj.magic - (Obj.repr - (match - ((FStar_List_Tot_Base.index + match uu___7 with + | (rel, xy) -> + if + (FStar_List_Tot_Base.length + xy) + >= + (Prims.of_int (2)) + then + (match + ((FStar_List_Tot_Base.index xy ((FStar_List_Tot_Base.length xy) - (Prims.of_int (2)))), - (FStar_List_Tot_Base.index + (FStar_List_Tot_Base.index xy ((FStar_List_Tot_Base.length xy) - Prims.int_one))) - with - | - ((lhs, - FStarC_Reflection_V2_Data.Q_Explicit), - (rhs, - FStarC_Reflection_V2_Data.Q_Explicit)) - -> - Obj.repr + with + | ((lhs, + FStarC_Reflection_V2_Data.Q_Explicit), + (rhs, + FStarC_Reflection_V2_Data.Q_Explicit)) + -> + Obj.magic (canon_lhs_rhs eq m lhs rhs) - | - uu___8 -> - Obj.repr - (FStar_Tactics_V2_Derived.fail - "Goal should have been an application of a binary relation to 2 explicit arguments"))) - else - Obj.magic - (Obj.repr + | uu___8 -> + Obj.magic (FStar_Tactics_V2_Derived.fail - "Goal should have been an application of a binary relation to n implicit and 2 explicit arguments"))) - uu___7))) + "Goal should have been an application of a binary relation to 2 explicit arguments")) + else + Obj.magic + (FStar_Tactics_V2_Derived.fail + "Goal should have been an application of a binary relation to n implicit and 2 explicit arguments")) + uu___7)) | uu___5 -> Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Goal should be squash applied to a binary relation")))) + (FStar_Tactics_V2_Derived.fail + "Goal should be squash applied to a binary relation"))) uu___4))) uu___3))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.CanonCommMonoidSimple.Equiv.canon_monoid" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.CanonCommMonoidSimple.Equiv.canon_monoid (plugin)" - (FStarC_Tactics_Native.from_tactic_2 canon_monoid) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 + canon_monoid) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommSwaps.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CanonCommSwaps.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Tactics_CanonCommSwaps.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CanonCommSwaps.ml index 21f3cb8991e..5268f8ae4ca 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommSwaps.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CanonCommSwaps.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type 'n swap = Prims.nat let rec apply_swap_aux : diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Canon_Lemmas.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Canon_Lemmas.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Canon_Lemmas.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_CheckLN.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CheckLN.ml similarity index 97% rename from stage0/fstar-lib/generated/FStar_Tactics_CheckLN.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CheckLN.ml index 53843f6bf50..ddb2d415645 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_CheckLN.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_CheckLN.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let rec for_all : 'a . @@ -698,12 +699,15 @@ and (check_comp : (Prims.of_int (9))))) (Obj.magic uu___9) (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 - -> - if uu___10 - then false - else true))))) + if uu___10 + then + FStar_Tactics_Effect.lift_div_tac + (fun uu___11 + -> false) + else + FStar_Tactics_Effect.lift_div_tac + (fun uu___12 + -> true))))) uu___7)))) uu___4)))) uu___1) and (check_br : FStar_Tactics_NamedView.branch -> @@ -731,14 +735,14 @@ let (check_ln : (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = fun t -> check t let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.CheckLN.check_ln" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.CheckLN.check_ln" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.CheckLN.check_ln (plugin)" - (FStarC_Tactics_Native.from_tactic_1 check_ln) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_bool psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 check_ln) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Effect.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Effect.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Tactics_Effect.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Effect.ml index f3643d1db31..f5563c37a55 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_Effect.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Effect.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type 'a tac_wp_t0 = unit type ('a, 'wp) tac_wp_monotonic = unit diff --git a/stage0/fstar-lib/generated/FStar_Tactics_MApply0.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_MApply0.ml similarity index 73% rename from stage0/fstar-lib/generated/FStar_Tactics_MApply0.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_MApply0.ml index bbe9736c9cb..8ce3dca9396 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_MApply0.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_MApply0.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let rec (apply_squash_or_lem : Prims.nat -> @@ -41,152 +42,125 @@ let rec (apply_squash_or_lem : match () with | () -> FStar_Tactics_V2_Derived.apply_lemma t) (fun uu___2 -> - (fun uu___2 -> - if d <= Prims.int_zero - then - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "mapply: out of fuel")) - else - Obj.magic - (Obj.repr - (let uu___4 = - let uu___5 = - FStar_Tactics_V2_Derived.cur_env () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MApply0.fst" - (Prims.of_int (30)) - (Prims.of_int (16)) - (Prims.of_int (30)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MApply0.fst" - (Prims.of_int (30)) - (Prims.of_int (13)) - (Prims.of_int (30)) - (Prims.of_int (30))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (FStarC_Tactics_V2_Builtins.tc - uu___6 t)) uu___6) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MApply0.fst" - (Prims.of_int (30)) - (Prims.of_int (13)) - (Prims.of_int (30)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MApply0.fst" - (Prims.of_int (30)) - (Prims.of_int (33)) - (Prims.of_int (79)) - (Prims.of_int (41))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun ty -> - let uu___5 = - FStar_Tactics_V2_SyntaxHelpers.collect_arr - ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MApply0.fst" - (Prims.of_int (31)) - (Prims.of_int (17)) - (Prims.of_int (31)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MApply0.fst" - (Prims.of_int (30)) - (Prims.of_int (33)) - (Prims.of_int (79)) - (Prims.of_int (41))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 with - | (tys, c) -> - (match FStar_Tactics_NamedView.inspect_comp - c - with - | FStarC_Reflection_V2_Data.C_Lemma - (pre, post, - uu___7) - -> - Obj.magic - (Obj.repr - (let uu___8 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - (post, + if d <= Prims.int_zero + then FStar_Tactics_V2_Derived.fail "mapply: out of fuel" + else + (let uu___4 = + let uu___5 = FStar_Tactics_V2_Derived.cur_env () in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MApply0.fst" + (Prims.of_int (30)) (Prims.of_int (16)) + (Prims.of_int (30)) (Prims.of_int (28))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MApply0.fst" + (Prims.of_int (30)) (Prims.of_int (13)) + (Prims.of_int (30)) (Prims.of_int (30))))) + (Obj.magic uu___5) + (fun uu___6 -> + (fun uu___6 -> + Obj.magic + (FStarC_Tactics_V2_Builtins.tc uu___6 t)) + uu___6) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MApply0.fst" + (Prims.of_int (30)) (Prims.of_int (13)) + (Prims.of_int (30)) (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MApply0.fst" + (Prims.of_int (30)) (Prims.of_int (33)) + (Prims.of_int (79)) (Prims.of_int (41))))) + (Obj.magic uu___4) + (fun uu___5 -> + (fun ty -> + let uu___5 = + FStar_Tactics_V2_SyntaxHelpers.collect_arr + ty in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MApply0.fst" + (Prims.of_int (31)) + (Prims.of_int (17)) + (Prims.of_int (31)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MApply0.fst" + (Prims.of_int (30)) + (Prims.of_int (33)) + (Prims.of_int (79)) + (Prims.of_int (41))))) + (Obj.magic uu___5) + (fun uu___6 -> + (fun uu___6 -> + match uu___6 with + | (tys, c) -> + (match FStar_Tactics_NamedView.inspect_comp + c + with + | FStarC_Reflection_V2_Data.C_Lemma + (pre, post, uu___7) -> + let uu___8 = + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___9 -> + FStarC_Reflection_V2_Builtins.pack_ln + (FStarC_Reflection_V2_Data.Tv_App + (post, ((FStarC_Reflection_V2_Builtins.pack_ln (FStarC_Reflection_V2_Data.Tv_Const FStarC_Reflection_V2_Data.C_Unit)), FStarC_Reflection_V2_Data.Q_Explicit))))) in - FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MApply0.fst" - (Prims.of_int (35)) - (Prims.of_int (18)) - (Prims.of_int (35)) - (Prims.of_int (32))))) + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MApply0.fst" + (Prims.of_int (35)) + (Prims.of_int (18)) + (Prims.of_int (35)) + (Prims.of_int (32))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MApply0.fst" + (Prims.of_int (35)) + (Prims.of_int (35)) + (Prims.of_int (44)) + (Prims.of_int (41))))) + (Obj.magic uu___8) + (fun uu___9 -> + (fun post1 -> + let uu___9 = + FStar_Tactics_V2_Derived.norm_term + [] post1 in + Obj.magic + (FStar_Tactics_Effect.tac_bind ( FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply0.fst" - (Prims.of_int (35)) - (Prims.of_int (35)) - (Prims.of_int (44)) - (Prims.of_int (41))))) - ( - Obj.magic - uu___8) - ( - fun - uu___9 -> - (fun - post1 -> - let uu___9 - = - FStar_Tactics_V2_Derived.norm_term - [] post1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MApply0.fst" (Prims.of_int (36)) (Prims.of_int (18)) (Prims.of_int (36)) (Prims.of_int (35))))) - (FStar_Sealed.seal + ( + FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MApply0.fst" @@ -194,9 +168,11 @@ let rec (apply_squash_or_lem : (Prims.of_int (7)) (Prims.of_int (44)) (Prims.of_int (41))))) - (Obj.magic + ( + Obj.magic uu___9) - (fun + ( + fun uu___10 -> (fun @@ -236,9 +212,7 @@ let rec (apply_squash_or_lem : | FStar_Reflection_V2_Formula.Implies (p, q) -> - Obj.magic - (Obj.repr - (let uu___12 + let uu___12 = FStar_Tactics_V2_Derived.apply_lemma (FStarC_Reflection_V2_Builtins.pack_ln @@ -248,7 +222,8 @@ let rec (apply_squash_or_lem : "Tactics"; "MApply0"; "push1"]))) in - FStar_Tactics_Effect.tac_bind + Obj.magic + (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range @@ -278,54 +253,50 @@ let rec (apply_squash_or_lem : (d - Prims.int_one) t)) - uu___13))) + uu___13)) | uu___12 -> Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail - "mapply: can't apply (1)"))) + "mapply: can't apply (1)")) uu___11))) uu___10))) - uu___9))) - | FStarC_Reflection_V2_Data.C_Total - rt -> - Obj.magic - (Obj.repr - (match - FStar_Reflection_V2_Derived.unsquash_term - rt - with - | FStar_Pervasives_Native.Some - rt1 -> - let uu___7 - = - FStar_Tactics_V2_Derived.norm_term - [] rt1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + uu___9)) + | FStarC_Reflection_V2_Data.C_Total + rt -> + (match FStar_Reflection_V2_Derived.unsquash_term + rt + with + | FStar_Pervasives_Native.Some + rt1 -> + let uu___7 = + FStar_Tactics_V2_Derived.norm_term + [] rt1 in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range "FStar.Tactics.MApply0.fst" (Prims.of_int (52)) (Prims.of_int (18)) (Prims.of_int (52)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range "FStar.Tactics.MApply0.fst" (Prims.of_int (54)) (Prims.of_int (9)) (Prims.of_int (60)) (Prims.of_int (43))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun rt2 - -> + (Obj.magic + uu___7) + (fun uu___8 -> + (fun rt2 -> let uu___8 = FStar_Reflection_V2_Formula.term_as_formula' @@ -359,9 +330,7 @@ let rec (apply_squash_or_lem : | FStar_Reflection_V2_Formula.Implies (p, q) -> - Obj.magic - (Obj.repr - (let uu___10 + let uu___10 = FStar_Tactics_V2_Derived.apply_lemma (FStarC_Reflection_V2_Builtins.pack_ln @@ -371,7 +340,8 @@ let rec (apply_squash_or_lem : "Tactics"; "MApply0"; "push1"]))) in - FStar_Tactics_Effect.tac_bind + Obj.magic + (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range @@ -401,45 +371,44 @@ let rec (apply_squash_or_lem : (d - Prims.int_one) t)) - uu___11))) + uu___11)) | uu___10 -> Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail - "mapply: can't apply (2)"))) + "mapply: can't apply (2)")) uu___9))) - uu___8) - | FStar_Pervasives_Native.None - -> - let uu___7 - = - FStar_Tactics_V2_Derived.norm_term - [] rt in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + uu___8)) + | FStar_Pervasives_Native.None + -> + let uu___7 = + FStar_Tactics_V2_Derived.norm_term + [] rt in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range "FStar.Tactics.MApply0.fst" (Prims.of_int (67)) (Prims.of_int (18)) (Prims.of_int (67)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (FStar_Sealed.seal + (Obj.magic + ( + FStar_Range.mk_range "FStar.Tactics.MApply0.fst" (Prims.of_int (69)) (Prims.of_int (9)) (Prims.of_int (76)) (Prims.of_int (20))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun rt1 - -> + (Obj.magic + uu___7) + (fun uu___8 -> + (fun rt1 -> let uu___8 = FStar_Reflection_V2_Formula.term_as_formula' @@ -558,25 +527,24 @@ let rec (apply_squash_or_lem : t)) uu___12))) uu___9))) - uu___8))) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "mapply: can't apply (3)")))) - uu___6))) uu___5)))) uu___2))) + uu___8))) + | uu___7 -> + Obj.magic + (FStar_Tactics_V2_Derived.fail + "mapply: can't apply (3)"))) + uu___6))) uu___5))))) let (mapply0 : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun t -> apply_squash_or_lem (Prims.of_int (10)) t let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.MApply0.mapply0" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.MApply0.mapply0" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.MApply0.mapply0 (plugin)" - (FStarC_Tactics_Native.from_tactic_1 mapply0) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 mapply0) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_MkProjectors.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_MkProjectors.ml similarity index 97% rename from stage0/fstar-lib/generated/FStar_Tactics_MkProjectors.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_MkProjectors.ml index 49e90793ba8..dd32ec01991 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_MkProjectors.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_MkProjectors.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims exception NotFound let (uu___is_NotFound : Prims.exn -> Prims.bool) = @@ -157,49 +158,45 @@ let (mk_one_projector : (fun r -> match r with | (cons, arity)::[] -> + let uu___5 = + if i >= arity + then + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "proj: bad index in mk_one_projector")) + else + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___7 + -> ()))) in Obj.magic - (Obj.repr - (let uu___5 = - if i >= arity - then - Obj.magic - (FStar_Tactics_V2_Derived.fail - "proj: bad index in mk_one_projector") - else - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - ( - fun - uu___7 -> - ())) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MkProjectors.fst" - (Prims.of_int (34)) - (Prims.of_int (4)) - (Prims.of_int (35)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.MkProjectors.fst" - (Prims.of_int (35)) - (Prims.of_int (49)) - (Prims.of_int (46)) - (Prims.of_int (15))))) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.MkProjectors.fst" + (Prims.of_int (34)) + (Prims.of_int (4)) + (Prims.of_int (35)) + (Prims.of_int (48))))) + (FStar_Sealed.seal (Obj.magic - uu___5) + (FStar_Range.mk_range + "FStar.Tactics.MkProjectors.fst" + (Prims.of_int (35)) + (Prims.of_int (49)) + (Prims.of_int (46)) + (Prims.of_int (15))))) + (Obj.magic uu___5) + (fun uu___6 -> (fun uu___6 -> - (fun uu___6 - -> - let uu___7 - = - FStarC_Tactics_V2_Builtins.intros + let uu___7 = + FStarC_Tactics_V2_Builtins.intros i in - Obj.magic - (FStar_Tactics_Effect.tac_bind + Obj.magic + (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range @@ -345,10 +342,10 @@ let (mk_one_projector : let uu___15 = FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.iota; - FStar_Pervasives.delta_only + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.delta_only unf; - FStar_Pervasives.zeta_full] in + Fstarcompiler.FStar_Pervasives.zeta_full] in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -385,28 +382,29 @@ let (mk_one_projector : uu___11))) uu___10))) uu___8))) - uu___6))) + uu___6)) | uu___5 -> Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "proj: more than one case?"))) + (FStar_Tactics_V2_Derived.fail + "proj: more than one case?")) uu___5))) uu___4))) uu___3))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.MkProjectors.mk_one_projector" (Prims.of_int (4)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 "FStar.Tactics.MkProjectors.mk_one_projector (plugin)" - (FStarC_Tactics_Native.from_tactic_3 mk_one_projector) - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_int - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_3 + mk_one_projector) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (mk_one_method : Prims.string -> Prims.nat -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun proj -> @@ -580,18 +578,19 @@ let (mk_one_method : uu___6))) uu___5))) uu___4))) uu___3))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.MkProjectors.mk_one_method" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.MkProjectors.mk_one_method (plugin)" - (FStarC_Tactics_Native.from_tactic_2 mk_one_method) - FStarC_Syntax_Embeddings.e_string - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 + mk_one_method) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (subst_map : (FStar_Tactics_NamedView.namedv * FStarC_Reflection_Types.fv) Prims.list -> FStar_Tactics_NamedView.term -> @@ -2051,46 +2050,47 @@ let (mk_projs : FStar_Tactics_NamedView.ctors = ctors;_} -> - Obj.magic - (Obj.repr - (let uu___7 = - if - (FStar_List_Tot_Base.length - ctors) <> - Prims.int_one - then - Obj.magic - (FStar_Tactics_V2_Derived.fail - "Expected an inductive with one constructor") - else - Obj.magic - (FStar_Tactics_Effect.lift_div_tac + let uu___7 = + if + (FStar_List_Tot_Base.length + ctors) + <> + Prims.int_one + then + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "Expected an inductive with one constructor")) + else + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac (fun uu___9 -> - ())) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic + ()))) in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MkProjectors.fst" (Prims.of_int (210)) (Prims.of_int (6)) (Prims.of_int (211)) (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic + (FStar_Sealed.seal + (Obj.magic (FStar_Range.mk_range "FStar.Tactics.MkProjectors.fst" (Prims.of_int (211)) (Prims.of_int (58)) (Prims.of_int (230)) (Prims.of_int (11))))) - (Obj.magic - uu___7) + (Obj.magic + uu___7) + (fun uu___8 -> (fun uu___8 -> - (fun - uu___8 -> let uu___9 = let uu___10 @@ -2158,14 +2158,16 @@ let (mk_projs : indices then Obj.magic + (Obj.repr (FStar_Tactics_V2_Derived.fail - "Inductive indices nonempty?") + "Inductive indices nonempty?")) else Obj.magic + (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___12 - -> ())) in + -> ()))) in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -2452,25 +2454,25 @@ let (mk_projs : uu___13))) uu___11))) uu___10))) - uu___8))) + uu___8)) | uu___7 -> Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an inductive"))) + (FStar_Tactics_V2_Derived.fail + "not an inductive")) uu___6)))) uu___4))) uu___3))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.MkProjectors.mk_projs" - (Prims.of_int (3)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.MkProjectors.mk_projs" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.MkProjectors.mk_projs (plugin)" - (FStarC_Tactics_Native.from_tactic_2 mk_projs) - FStarC_Syntax_Embeddings.e_bool - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_sigelt) psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 mk_projs) + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_sigelt) psc + ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_NamedView.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_NamedView.ml similarity index 77% rename from stage0/fstar-lib/generated/FStar_Tactics_NamedView.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_NamedView.ml index 246699a6fd8..83196a0cbdb 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_NamedView.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_NamedView.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims type namedv = FStarC_Reflection_V2_Data.namedv_view type bv = FStarC_Reflection_V2_Data.bv_view @@ -13,34 +14,36 @@ type binder = qual: FStarC_Reflection_V2_Data.aqualv ; attrs: term Prims.list } let rec __knot_e_binder _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.binder" (fun tm_0 -> match tm_0 with | ("FStar.Tactics.NamedView.Mkbinder", uniq_2::ppname_3::sort_4::qual_5::attrs_6::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Syntax_Embeddings.e_int uniq_2) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Syntax_Embeddings.e_int uniq_2) (fun uniq_2 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e_string) ppname_3) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + ppname_3) (fun ppname_3 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term sort_4) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + sort_4) (fun sort_4 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_aqualv + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_aqualv qual_5) (fun qual_5 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) attrs_6) (fun attrs_6 -> FStar_Pervasives_Native.Some @@ -56,26 +59,27 @@ let rec __knot_e_binder _ = match tm_7 with | { uniq = uniq_9; ppname = ppname_10; sort = sort_11; qual = qual_12; attrs = attrs_13;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mkbinder")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Syntax_Embeddings.e_int uniq_9), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Mkbinder")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Embeddings.e_int uniq_9), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e_string) ppname_10), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + ppname_10), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term sort_11), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term sort_11), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_aqualv qual_12), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) attrs_13), - FStar_Pervasives_Native.None)]) + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_aqualv + qual_12), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + attrs_13), FStar_Pervasives_Native.None)]) let e_binder = __knot_e_binder () let (__proj__Mkbinder__item__uniq : binder -> Prims.nat) = fun projectee -> @@ -107,40 +111,44 @@ type named_universe_view = | Uv_Unif of FStarC_Reflection_Types.universe_uvar | Uv_Unk let rec __knot_e_named_universe_view _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.named_universe_view" (fun tm_14 -> match tm_14 with | ("FStar.Tactics.NamedView.Uv_Zero", []) -> FStar_Pervasives_Native.Some Uv_Zero | ("FStar.Tactics.NamedView.Uv_Succ", _0_17::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_universe _0_17) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + _0_17) (fun _0_17 -> FStar_Pervasives_Native.Some (Uv_Succ _0_17)) | ("FStar.Tactics.NamedView.Uv_Max", _0_19::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe) _0_19) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe) + _0_19) (fun _0_19 -> FStar_Pervasives_Native.Some (Uv_Max _0_19)) | ("FStar.Tactics.NamedView.Uv_BVar", _0_21::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Syntax_Embeddings.e_int _0_21) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Syntax_Embeddings.e_int _0_21) (fun _0_21 -> FStar_Pervasives_Native.Some (Uv_BVar _0_21)) | ("FStar.Tactics.NamedView.Uv_Name", _0_23::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e___range)) _0_23) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e___range)) + _0_23) (fun _0_23 -> FStar_Pervasives_Native.Some (Uv_Name _0_23)) | ("FStar.Tactics.NamedView.Uv_Unif", _0_25::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_universe_uvar _0_25) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe_uvar + _0_25) (fun _0_25 -> FStar_Pervasives_Native.Some (Uv_Unif _0_25)) | ("FStar.Tactics.NamedView.Uv_Unk", []) -> FStar_Pervasives_Native.Some Uv_Unk @@ -148,54 +156,59 @@ let rec __knot_e_named_universe_view _ = (fun tm_27 -> match tm_27 with | Uv_Zero -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Uv_Zero")) - [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Uv_Zero")) [] | Uv_Succ _0_30 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Uv_Succ")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_universe _0_30), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Uv_Succ")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + _0_30), FStar_Pervasives_Native.None)] | Uv_Max _0_32 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Uv_Max")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe) _0_32), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Uv_Max")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe) + _0_32), FStar_Pervasives_Native.None)] | Uv_BVar _0_34 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Uv_BVar")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Syntax_Embeddings.e_int _0_34), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Uv_BVar")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Embeddings.e_int _0_34), FStar_Pervasives_Native.None)] | Uv_Name _0_36 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Uv_Name")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e___range)) _0_36), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Uv_Name")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e___range)) + _0_36), FStar_Pervasives_Native.None)] | Uv_Unif _0_38 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Uv_Unif")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_universe_uvar _0_38), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Uv_Unif")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe_uvar + _0_38), FStar_Pervasives_Native.None)] | Uv_Unk -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Uv_Unk")) - []) + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Uv_Unk")) []) let e_named_universe_view = __knot_e_named_universe_view () let (uu___is_Uv_Zero : named_universe_view -> Prims.bool) = fun projectee -> match projectee with | Uv_Zero -> true | uu___ -> false @@ -243,51 +256,52 @@ and pattern = | Pat_Var of pattern__Pat_Var__payload | Pat_Dot_Term of pattern__Pat_Dot_Term__payload let rec __knot_e_pattern__Pat_Constant__payload _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.pattern__Pat_Constant__payload" (fun tm_40 -> match tm_40 with | ("FStar.Tactics.NamedView.Mkpattern__Pat_Constant__payload", c_42::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_vconst c_42) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_vconst c_42) (fun c_42 -> FStar_Pervasives_Native.Some { c = c_42 }) | _ -> FStar_Pervasives_Native.None) (fun tm_43 -> match tm_43 with | { c = c_45;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mkpattern__Pat_Constant__payload")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_vconst c_45), + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_vconst c_45), FStar_Pervasives_Native.None)]) and __knot_e_pattern__Pat_Cons__payload _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.pattern__Pat_Cons__payload" (fun tm_46 -> match tm_46 with | ("FStar.Tactics.NamedView.Mkpattern__Pat_Cons__payload", head_48::univs_49::subpats_50::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_fv head_48) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv head_48) (fun head_48 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_option - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe)) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe)) univs_49) (fun univs_49 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 (__knot_e_pattern ()) - FStarC_Syntax_Embeddings.e_bool)) subpats_50) + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool)) + subpats_50) (fun subpats_50 -> FStar_Pervasives_Native.Some { @@ -299,38 +313,41 @@ and __knot_e_pattern__Pat_Cons__payload _ = (fun tm_51 -> match tm_51 with | { head = head_53; univs = univs_54; subpats = subpats_55;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mkpattern__Pat_Cons__payload")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_fv head_53), + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv head_53), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_option - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe)) univs_54), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 (__knot_e_pattern ()) - FStarC_Syntax_Embeddings.e_bool)) subpats_55), - FStar_Pervasives_Native.None)]) + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe)) + univs_54), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (__knot_e_pattern ()) + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool)) + subpats_55), FStar_Pervasives_Native.None)]) and __knot_e_pattern__Pat_Var__payload _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.pattern__Pat_Var__payload" (fun tm_56 -> match tm_56 with | ("FStar.Tactics.NamedView.Mkpattern__Pat_Var__payload", v_58::sort_59::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_namedv_view v_58) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_namedv_view + v_58) (fun v_58 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Reflection_V2_Embeddings.e_term) sort_59) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + sort_59) (fun sort_59 -> FStar_Pervasives_Native.Some { v = v_58; sort1 = sort_59 })) @@ -338,97 +355,99 @@ and __knot_e_pattern__Pat_Var__payload _ = (fun tm_60 -> match tm_60 with | { v = v_62; sort1 = sort_63;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mkpattern__Pat_Var__payload")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_namedv_view v_62), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Reflection_V2_Embeddings.e_term) sort_63), - FStar_Pervasives_Native.None)]) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_namedv_view + v_62), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + sort_63), FStar_Pervasives_Native.None)]) and __knot_e_pattern__Pat_Dot_Term__payload _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.pattern__Pat_Dot_Term__payload" (fun tm_64 -> match tm_64 with | ("FStar.Tactics.NamedView.Mkpattern__Pat_Dot_Term__payload", t_66::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) t_66) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) t_66) (fun t_66 -> FStar_Pervasives_Native.Some { t = t_66 }) | _ -> FStar_Pervasives_Native.None) (fun tm_67 -> match tm_67 with | { t = t_69;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mkpattern__Pat_Dot_Term__payload")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) t_69), - FStar_Pervasives_Native.None)]) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + t_69), FStar_Pervasives_Native.None)]) and __knot_e_pattern _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.pattern" (fun tm_70 -> match tm_70 with | ("FStar.Tactics.NamedView.Pat_Constant", _0_72::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed (__knot_e_pattern__Pat_Constant__payload ()) _0_72) (fun _0_72 -> FStar_Pervasives_Native.Some (Pat_Constant _0_72)) | ("FStar.Tactics.NamedView.Pat_Cons", _0_74::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed (__knot_e_pattern__Pat_Cons__payload ()) _0_74) (fun _0_74 -> FStar_Pervasives_Native.Some (Pat_Cons _0_74)) | ("FStar.Tactics.NamedView.Pat_Var", _0_76::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed (__knot_e_pattern__Pat_Var__payload ()) _0_76) (fun _0_76 -> FStar_Pervasives_Native.Some (Pat_Var _0_76)) | ("FStar.Tactics.NamedView.Pat_Dot_Term", _0_78::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed (__knot_e_pattern__Pat_Dot_Term__payload ()) _0_78) (fun _0_78 -> FStar_Pervasives_Native.Some (Pat_Dot_Term _0_78)) | _ -> FStar_Pervasives_Native.None) (fun tm_79 -> match tm_79 with | Pat_Constant _0_81 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Pat_Constant")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed (__knot_e_pattern__Pat_Constant__payload ()) _0_81), FStar_Pervasives_Native.None)] | Pat_Cons _0_83 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Pat_Cons")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Pat_Cons")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed (__knot_e_pattern__Pat_Cons__payload ()) _0_83), FStar_Pervasives_Native.None)] | Pat_Var _0_85 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Pat_Var")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Pat_Var")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed (__knot_e_pattern__Pat_Var__payload ()) _0_85), FStar_Pervasives_Native.None)] | Pat_Dot_Term _0_87 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Pat_Dot_Term")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed (__knot_e_pattern__Pat_Dot_Term__payload ()) _0_87), FStar_Pervasives_Native.None)]) let e_pattern__Pat_Constant__payload = @@ -486,7 +505,7 @@ let (__proj__Pat_Dot_Term__item___0 : fun projectee -> match projectee with | Pat_Dot_Term _0 -> _0 type branch = (pattern * term) type match_returns_ascription = - (binder * ((term, comp) FStar_Pervasives.either * term + (binder * ((term, comp) Fstarcompiler.FStar_Pervasives.either * term FStar_Pervasives_Native.option * Prims.bool)) type named_term_view = | Tv_Var of namedv @@ -511,119 +530,131 @@ type named_term_view = | Tv_Unknown | Tv_Unsupp let rec __knot_e_named_term_view _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.named_term_view" (fun tm_88 -> match tm_88 with | ("FStar.Tactics.NamedView.Tv_Var", v_90::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_namedv_view v_90) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_namedv_view + v_90) (fun v_90 -> FStar_Pervasives_Native.Some (Tv_Var v_90)) | ("FStar.Tactics.NamedView.Tv_BVar", v_92::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_bv_view v_92) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_bv_view v_92) (fun v_92 -> FStar_Pervasives_Native.Some (Tv_BVar v_92)) | ("FStar.Tactics.NamedView.Tv_FVar", v_94::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_fv v_94) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv v_94) (fun v_94 -> FStar_Pervasives_Native.Some (Tv_FVar v_94)) | ("FStar.Tactics.NamedView.Tv_UInst", v_96::us_97::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_fv v_96) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv v_96) (fun v_96 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe) us_97) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe) + us_97) (fun us_97 -> FStar_Pervasives_Native.Some (Tv_UInst (v_96, us_97)))) | ("FStar.Tactics.NamedView.Tv_App", hd_99::a_100::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term hd_99) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term hd_99) (fun hd_99 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_aqualv) a_100) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_aqualv) + a_100) (fun a_100 -> FStar_Pervasives_Native.Some (Tv_App (hd_99, a_100)))) | ("FStar.Tactics.NamedView.Tv_Abs", b_102::body_103::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed e_binder b_102) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + e_binder b_102) (fun b_102 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term body_103) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + body_103) (fun body_103 -> FStar_Pervasives_Native.Some (Tv_Abs (b_102, body_103)))) | ("FStar.Tactics.NamedView.Tv_Arrow", b_105::c_106::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed e_binder b_105) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + e_binder b_105) (fun b_105 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_comp_view c_106) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view + c_106) (fun c_106 -> FStar_Pervasives_Native.Some (Tv_Arrow (b_105, c_106)))) | ("FStar.Tactics.NamedView.Tv_Type", _0_108::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_universe _0_108) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + _0_108) (fun _0_108 -> FStar_Pervasives_Native.Some (Tv_Type _0_108)) | ("FStar.Tactics.NamedView.Tv_Refine", b_110::ref_111::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed e_binder b_110) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + e_binder b_110) (fun b_110 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term ref_111) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + ref_111) (fun ref_111 -> FStar_Pervasives_Native.Some (Tv_Refine (b_110, ref_111)))) | ("FStar.Tactics.NamedView.Tv_Const", _0_113::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_vconst _0_113) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_vconst _0_113) (fun _0_113 -> FStar_Pervasives_Native.Some (Tv_Const _0_113)) | ("FStar.Tactics.NamedView.Tv_Uvar", _0_115::_1_116::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Syntax_Embeddings.e_int _0_115) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Syntax_Embeddings.e_int _0_115) (fun _0_115 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_ctx_uvar_and_subst + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_ctx_uvar_and_subst _1_116) (fun _1_116 -> FStar_Pervasives_Native.Some (Tv_Uvar (_0_115, _1_116)))) | ("FStar.Tactics.NamedView.Tv_Let", recf_118::attrs_119::b_120::def_121::body_122::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Syntax_Embeddings.e_bool recf_118) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool recf_118) (fun recf_118 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) attrs_119) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + attrs_119) (fun attrs_119 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed e_binder b_120) (fun b_120 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term def_121) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + def_121) (fun def_121 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term body_122) (fun body_122 -> FStar_Pervasives_Native.Some @@ -632,71 +663,81 @@ let rec __knot_e_named_term_view _ = def_121, body_122))))))) | ("FStar.Tactics.NamedView.Tv_Match", scrutinee_124::ret_125::brs_126::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term scrutinee_124) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + scrutinee_124) (fun scrutinee_124 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_option - (FStarC_Syntax_Embeddings.e_tuple2 e_binder - (FStarC_Syntax_Embeddings.e_tuple3 - (FStarC_Syntax_Embeddings.e_either - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_comp_view) - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) - FStarC_Syntax_Embeddings.e_bool))) ret_125) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + e_binder + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple3 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_either + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool))) + ret_125) (fun ret_125 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 e_pattern - FStarC_Reflection_V2_Embeddings.e_term)) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + e_pattern + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term)) brs_126) (fun brs_126 -> FStar_Pervasives_Native.Some (Tv_Match (scrutinee_124, ret_125, brs_126))))) | ("FStar.Tactics.NamedView.Tv_AscribedT", e_128::t_129::tac_130::use_eq_131::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term e_128) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term e_128) (fun e_128 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term t_129) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + t_129) (fun t_129 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) tac_130) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + tac_130) (fun tac_130 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Syntax_Embeddings.e_bool use_eq_131) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool + use_eq_131) (fun use_eq_131 -> FStar_Pervasives_Native.Some (Tv_AscribedT (e_128, t_129, tac_130, use_eq_131)))))) | ("FStar.Tactics.NamedView.Tv_AscribedC", e_133::c_134::tac_135::use_eq_136::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term e_133) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term e_133) (fun e_133 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_comp_view c_134) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view + c_134) (fun c_134 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) tac_135) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + tac_135) (fun tac_135 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Syntax_Embeddings.e_bool use_eq_136) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool + use_eq_136) (fun use_eq_136 -> FStar_Pervasives_Native.Some (Tv_AscribedC @@ -709,188 +750,202 @@ let rec __knot_e_named_term_view _ = (fun tm_139 -> match tm_139 with | Tv_Var v_141 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Var")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_namedv_view v_141), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Var")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_namedv_view + v_141), FStar_Pervasives_Native.None)] | Tv_BVar v_143 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_BVar")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_bv_view v_143), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_BVar")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_bv_view + v_143), FStar_Pervasives_Native.None)] | Tv_FVar v_145 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_FVar")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_fv v_145), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_FVar")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv v_145), FStar_Pervasives_Native.None)] | Tv_UInst (v_147, us_148) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_UInst")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_fv v_147), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_UInst")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv v_147), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe) us_148), - FStar_Pervasives_Native.None)] + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe) + us_148), FStar_Pervasives_Native.None)] | Tv_App (hd_150, a_151) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_App")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term hd_150), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_App")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term hd_150), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_aqualv) a_151), - FStar_Pervasives_Native.None)] + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_aqualv) + a_151), FStar_Pervasives_Native.None)] | Tv_Abs (b_153, body_154) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Abs")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed e_binder b_153), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term body_154), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Abs")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + e_binder b_153), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + body_154), FStar_Pervasives_Native.None)] | Tv_Arrow (b_156, c_157) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Arrow")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed e_binder b_156), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_comp_view c_157), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Arrow")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + e_binder b_156), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view + c_157), FStar_Pervasives_Native.None)] | Tv_Type _0_159 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Type")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_universe _0_159), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Type")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + _0_159), FStar_Pervasives_Native.None)] | Tv_Refine (b_161, ref_162) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Refine")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed e_binder b_161), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term ref_162), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Refine")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + e_binder b_161), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term ref_162), FStar_Pervasives_Native.None)] | Tv_Const _0_164 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Const")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_vconst _0_164), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Const")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_vconst + _0_164), FStar_Pervasives_Native.None)] | Tv_Uvar (_0_166, _1_167) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Uvar")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Syntax_Embeddings.e_int _0_166), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Uvar")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Embeddings.e_int _0_166), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_ctx_uvar_and_subst _1_167), - FStar_Pervasives_Native.None)] + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_ctx_uvar_and_subst + _1_167), FStar_Pervasives_Native.None)] | Tv_Let (recf_169, attrs_170, b_171, def_172, body_173) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Let")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Syntax_Embeddings.e_bool recf_169), + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Let")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool recf_169), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) attrs_170), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + attrs_170), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + e_binder b_171), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term def_172), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed e_binder b_171), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term def_172), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term body_173), - FStar_Pervasives_Native.None)] + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + body_173), FStar_Pervasives_Native.None)] | Tv_Match (scrutinee_175, ret_176, brs_177) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Match")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term scrutinee_175), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_option - (FStarC_Syntax_Embeddings.e_tuple2 e_binder - (FStarC_Syntax_Embeddings.e_tuple3 - (FStarC_Syntax_Embeddings.e_either - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_comp_view) - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) - FStarC_Syntax_Embeddings.e_bool))) ret_176), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 e_pattern - FStarC_Reflection_V2_Embeddings.e_term)) brs_177), - FStar_Pervasives_Native.None)] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Match")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + scrutinee_175), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 e_binder + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple3 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_either + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool))) + ret_176), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + e_pattern + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term)) + brs_177), FStar_Pervasives_Native.None)] | Tv_AscribedT (e_179, t_180, tac_181, use_eq_182) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_AscribedT")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term e_179), + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term e_179), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term t_180), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term t_180), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) tac_181), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Syntax_Embeddings.e_bool use_eq_182), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + tac_181), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool use_eq_182), FStar_Pervasives_Native.None)] | Tv_AscribedC (e_184, c_185, tac_186, use_eq_187) -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_AscribedC")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term e_184), + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term e_184), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_comp_view c_185), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) tac_186), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Syntax_Embeddings.e_bool use_eq_187), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view + c_185), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + tac_186), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool use_eq_187), FStar_Pervasives_Native.None)] | Tv_Unknown -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Unknown")) - [] + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Unknown")) [] | Tv_Unsupp -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Tv_Unsupp")) - []) + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Tv_Unsupp")) []) let e_named_term_view = __knot_e_named_term_view () let (uu___is_Tv_Var : named_term_view -> Prims.bool) = fun projectee -> match projectee with | Tv_Var v -> true | uu___ -> false @@ -1048,31 +1103,33 @@ type letbinding = lb_typ: FStarC_Reflection_Types.typ ; lb_def: term } let rec __knot_e_letbinding _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.letbinding" (fun tm_190 -> match tm_190 with | ("FStar.Tactics.NamedView.Mkletbinding", lb_fv_192::lb_us_193::lb_typ_194::lb_def_195::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_fv lb_fv_192) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv lb_fv_192) (fun lb_fv_192 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e___range))) lb_us_193) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e___range))) + lb_us_193) (fun lb_us_193 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term lb_typ_194) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + lb_typ_194) (fun lb_typ_194 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term lb_def_195) (fun lb_def_195 -> FStar_Pervasives_Native.Some @@ -1087,26 +1144,26 @@ let rec __knot_e_letbinding _ = match tm_196 with | { lb_fv = lb_fv_198; lb_us = lb_us_199; lb_typ = lb_typ_200; lb_def = lb_def_201;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mkletbinding")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_fv lb_fv_198), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e___range))) lb_us_199), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term lb_typ_200), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term lb_def_201), - FStar_Pervasives_Native.None)]) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv + lb_fv_198), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e___range))) + lb_us_199), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + lb_typ_200), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + lb_def_201), FStar_Pervasives_Native.None)]) let e_letbinding = __knot_e_letbinding () let (__proj__Mkletbinding__item__lb_fv : letbinding -> FStarC_Reflection_Types.fv) = @@ -1145,19 +1202,20 @@ and named_sigelt_view = | Sg_Val of named_sigelt_view__Sg_Val__payload | Unk let rec __knot_e_named_sigelt_view__Sg_Let__payload _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.named_sigelt_view__Sg_Let__payload" (fun tm_202 -> match tm_202 with | ("FStar.Tactics.NamedView.Mknamed_sigelt_view__Sg_Let__payload", isrec_204::lbs_205::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Syntax_Embeddings.e_bool isrec_204) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool isrec_204) (fun isrec_204 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list e_letbinding) lbs_205) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + e_letbinding) lbs_205) (fun lbs_205 -> FStar_Pervasives_Native.Some { isrec = isrec_204; lbs = lbs_205 })) @@ -1165,52 +1223,54 @@ let rec __knot_e_named_sigelt_view__Sg_Let__payload _ = (fun tm_206 -> match tm_206 with | { isrec = isrec_208; lbs = lbs_209;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mknamed_sigelt_view__Sg_Let__payload")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Syntax_Embeddings.e_bool isrec_208), + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool isrec_208), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list e_letbinding) lbs_209), - FStar_Pervasives_Native.None)]) + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list e_letbinding) + lbs_209), FStar_Pervasives_Native.None)]) and __knot_e_named_sigelt_view__Sg_Inductive__payload _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.named_sigelt_view__Sg_Inductive__payload" (fun tm_210 -> match tm_210 with | ("FStar.Tactics.NamedView.Mknamed_sigelt_view__Sg_Inductive__payload", nm_212::univs_213::params_214::typ_215::ctors_216::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) nm_212) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) nm_212) (fun nm_212 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e___range))) univs_213) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e___range))) + univs_213) (fun univs_213 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list e_binder) - params_214) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + e_binder) params_214) (fun params_214 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term typ_215) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + typ_215) (fun typ_215 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) - FStarC_Reflection_V2_Embeddings.e_term)) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term)) ctors_216) (fun ctors_216 -> FStar_Pervasives_Native.Some @@ -1226,57 +1286,59 @@ and __knot_e_named_sigelt_view__Sg_Inductive__payload _ = match tm_217 with | { nm = nm_219; univs1 = univs_220; params = params_221; typ = typ_222; ctors = ctors_223;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mknamed_sigelt_view__Sg_Inductive__payload")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) nm_219), + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) nm_219), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e___range))) univs_220), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list e_binder) params_221), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e___range))) + univs_220), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list e_binder) + params_221), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term typ_222), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term typ_222), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) - FStarC_Reflection_V2_Embeddings.e_term)) ctors_223), - FStar_Pervasives_Native.None)]) + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term)) + ctors_223), FStar_Pervasives_Native.None)]) and __knot_e_named_sigelt_view__Sg_Val__payload _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.named_sigelt_view__Sg_Val__payload" (fun tm_224 -> match tm_224 with | ("FStar.Tactics.NamedView.Mknamed_sigelt_view__Sg_Val__payload", nm_226::univs_227::typ_228::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) nm_226) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) nm_226) (fun nm_226 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e___range))) univs_227) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e___range))) + univs_227) (fun univs_227 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - FStarC_Reflection_V2_Embeddings.e_term typ_228) + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + typ_228) (fun typ_228 -> FStar_Pervasives_Native.Some { @@ -1288,43 +1350,43 @@ and __knot_e_named_sigelt_view__Sg_Val__payload _ = (fun tm_229 -> match tm_229 with | { nm1 = nm_231; univs2 = univs_232; typ1 = typ_233;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Mknamed_sigelt_view__Sg_Val__payload")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) nm_231), + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) nm_231), FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_sealed - FStarC_Syntax_Embeddings.e___range))) univs_232), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - FStarC_Reflection_V2_Embeddings.e_term typ_233), + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_sealed + Fstarcompiler.FStarC_Syntax_Embeddings.e___range))) + univs_232), FStar_Pervasives_Native.None); + ((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term typ_233), FStar_Pervasives_Native.None)]) and __knot_e_named_sigelt_view _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding + Fstarcompiler.FStarC_Syntax_Embeddings_Base.mk_extracted_embedding "FStar.Tactics.NamedView.named_sigelt_view" (fun tm_234 -> match tm_234 with | ("FStar.Tactics.NamedView.Sg_Let", _0_236::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed (__knot_e_named_sigelt_view__Sg_Let__payload ()) _0_236) (fun _0_236 -> FStar_Pervasives_Native.Some (Sg_Let _0_236)) | ("FStar.Tactics.NamedView.Sg_Inductive", _0_238::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed (__knot_e_named_sigelt_view__Sg_Inductive__payload ()) _0_238) (fun _0_238 -> FStar_Pervasives_Native.Some (Sg_Inductive _0_238)) | ("FStar.Tactics.NamedView.Sg_Val", _0_240::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed + Fstarcompiler.FStarC_Util.bind_opt + (Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_unembed (__knot_e_named_sigelt_view__Sg_Val__payload ()) _0_240) (fun _0_240 -> FStar_Pervasives_Native.Some (Sg_Val _0_240)) | ("FStar.Tactics.NamedView.Unk", []) -> @@ -1333,31 +1395,34 @@ and __knot_e_named_sigelt_view _ = (fun tm_242 -> match tm_242 with | Sg_Let _0_244 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Sg_Let")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Sg_Let")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed (__knot_e_named_sigelt_view__Sg_Let__payload ()) _0_244), FStar_Pervasives_Native.None)] | Sg_Inductive _0_246 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Sg_Inductive")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed (__knot_e_named_sigelt_view__Sg_Inductive__payload ()) _0_246), FStar_Pervasives_Native.None)] | Sg_Val _0_248 -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Sg_Val")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Sg_Val")) + [((Fstarcompiler.FStarC_Syntax_Embeddings_Base.extracted_embed (__knot_e_named_sigelt_view__Sg_Val__payload ()) _0_248), FStar_Pervasives_Native.None)] | Unk -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.Unk")) []) + Fstarcompiler.FStarC_Syntax_Util.mk_app + (Fstarcompiler.FStarC_Syntax_Syntax.tdataconstr + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.Unk")) []) let e_named_sigelt_view__Sg_Let__payload = __knot_e_named_sigelt_view__Sg_Let__payload () let e_named_sigelt_view__Sg_Inductive__payload = @@ -1477,32 +1542,32 @@ let (inspect_universe : universe -> named_universe_view) = let v = FStarC_Reflection_V2_Builtins.inspect_universe u in open_universe_view v let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Tactics.NamedView.inspect_universe" Prims.int_one (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.NamedView.inspect_universe" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_1 - FStarC_Reflection_V2_Embeddings.e_universe + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_1 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe e_named_universe_view inspect_universe - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.inspect_universe") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.NamedView.inspect_universe" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 - FStarC_Reflection_V2_NBEEmbeddings.e_universe - (FStarC_TypeChecker_NBETerm.e_unsupported ()) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) inspect_universe - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.inspect_universe") cb us) args)) let (close_universe_view : named_universe_view -> FStarC_Reflection_V2_Data.universe_view) = @@ -1522,31 +1587,32 @@ let (pack_universe : named_universe_view -> universe) = let uv1 = close_universe_view uv in FStarC_Reflection_V2_Builtins.pack_universe uv1 let _ = - FStarC_Tactics_Native.register_plugin + Fstarcompiler.FStarC_Tactics_Native.register_plugin "FStar.Tactics.NamedView.pack_universe" Prims.int_one (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.NamedView.pack_universe" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_1 + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_1 e_named_universe_view - FStarC_Reflection_V2_Embeddings.e_universe pack_universe - (FStarC_Ident.lid_of_str + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + pack_universe + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.pack_universe") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.NamedView.pack_universe" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 - (FStarC_TypeChecker_NBETerm.e_unsupported ()) - FStarC_Reflection_V2_NBEEmbeddings.e_universe + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_universe pack_universe - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.pack_universe") cb us) args)) let (__binding_to_binder : binding -> FStarC_Reflection_Types.binder -> binder) = @@ -1859,35 +1925,38 @@ let (close_term : binder -> term -> (FStarC_Reflection_Types.binder * term)) } in (b1, t') let _ = - FStarC_Tactics_Native.register_plugin "FStar.Tactics.NamedView.close_term" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Tactics.NamedView.close_term" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.NamedView.close_term" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 e_binder - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_binder - FStarC_Reflection_V2_Embeddings.e_term) close_term - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_2 + e_binder + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + close_term + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.close_term") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.NamedView.close_term" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - (FStarC_TypeChecker_NBETerm.e_unsupported ()) - FStarC_Reflection_V2_NBEEmbeddings.e_term - (FStarC_TypeChecker_NBETerm.e_tuple2 - FStarC_Reflection_V2_NBEEmbeddings.e_binder - FStarC_Reflection_V2_NBEEmbeddings.e_term) close_term - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_binder + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term) + close_term + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.close_term") cb us) args)) let (close_comp : binder -> comp -> (FStarC_Reflection_Types.binder * comp)) = @@ -2605,7 +2674,7 @@ let (open_match_returns_ascription : (fun nb -> let uu___3 = match ct with - | FStar_Pervasives.Inl t -> + | Fstarcompiler.FStar_Pervasives.Inl t -> let uu___4 = open_term_with b nb t in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -2628,8 +2697,9 @@ let (open_match_returns_ascription : (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac (fun uu___6 -> - FStar_Pervasives.Inl uu___5)) - | FStar_Pervasives.Inr c -> + Fstarcompiler.FStar_Pervasives.Inl + uu___5)) + | Fstarcompiler.FStar_Pervasives.Inr c -> let uu___4 = Obj.magic (FStar_Tactics_Effect.lift_div_tac @@ -2679,8 +2749,8 @@ let (open_match_returns_ascription : (fun c2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___6 -> - FStar_Pervasives.Inr c2)))) - uu___5) in + Fstarcompiler.FStar_Pervasives.Inr + c2)))) uu___5) in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -2772,15 +2842,15 @@ let (close_match_returns_ascription : let b = close_binder nb in let ct1 = match ct with - | FStar_Pervasives.Inl t -> - FStar_Pervasives.Inl + | Fstarcompiler.FStar_Pervasives.Inl t -> + Fstarcompiler.FStar_Pervasives.Inl (FStar_Pervasives_Native.snd (close_term nb t)) - | FStar_Pervasives.Inr c -> + | Fstarcompiler.FStar_Pervasives.Inr c -> let uu___1 = close_comp nb c in (match uu___1 with | (uu___2, c1) -> let c2 = FStarC_Reflection_V2_Builtins.pack_comp c1 in - FStar_Pervasives.Inr c2) in + Fstarcompiler.FStar_Pervasives.Inr c2) in let topt1 = match topt with | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None @@ -3088,45 +3158,48 @@ let (inspect : term -> (named_term_view, unit) FStar_Tactics_Effect.tac_repr) (fun uu___2 -> (fun tv -> Obj.magic (open_view tv)) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.NamedView.inspect" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.NamedView.inspect" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.NamedView.inspect (plugin)" - (FStarC_Tactics_Native.from_tactic_1 inspect) - FStarC_Reflection_V2_Embeddings.e_term e_named_term_view psc - ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 inspect) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + e_named_term_view psc ncb us args) let (pack : named_term_view -> term) = fun tv -> let tv1 = close_view tv in FStarC_Reflection_V2_Builtins.pack_ln tv1 let _ = - FStarC_Tactics_Native.register_plugin "FStar.Tactics.NamedView.pack" - Prims.int_one + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Tactics.NamedView.pack" Prims.int_one (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.NamedView.pack" (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_1 - e_named_term_view FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_1 + e_named_term_view + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term pack - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.pack") - cb us) args)) + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.pack") cb us) args)) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.NamedView.pack" + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap + "FStar.Tactics.NamedView.pack" (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 - (FStarC_TypeChecker_NBETerm.e_unsupported ()) - FStarC_Reflection_V2_NBEEmbeddings.e_term pack - (FStarC_Ident.lid_of_str "FStar.Tactics.NamedView.pack") - cb us) args)) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 + (Fstarcompiler.FStarC_TypeChecker_NBETerm.e_unsupported ()) + Fstarcompiler.FStarC_Reflection_V2_NBEEmbeddings.e_term + pack + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.NamedView.pack") cb us) args)) let (open_univ_s : FStarC_Reflection_Types.univ_name Prims.list -> ((univ_name Prims.list * FStarC_Syntax_Syntax.subst_t), unit) @@ -3753,8 +3826,10 @@ let rec (mk_arr : (Prims.of_int (610)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" Prims.int_zero - Prims.int_zero Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.NamedView.fst" + (Prims.of_int (611)) (Prims.of_int (4)) + (Prims.of_int (611)) (Prims.of_int (24))))) (Obj.magic uu___) (fun t' -> FStar_Tactics_Effect.lift_div_tac @@ -4061,17 +4136,18 @@ let (inspect_sigelt : (Prims.of_int (21))))) (Obj.magic uu___) (fun uu___1 -> (fun sv -> Obj.magic (open_sigelt_view sv)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.NamedView.inspect_sigelt" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.NamedView.inspect_sigelt (plugin)" - (FStarC_Tactics_Native.from_tactic_1 inspect_sigelt) - FStarC_Reflection_V2_Embeddings.e_sigelt e_named_sigelt_view - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + inspect_sigelt) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_sigelt + e_named_sigelt_view psc ncb us args) let (pack_sigelt : named_sigelt_view -> (FStarC_Reflection_Types.sigelt, unit) FStar_Tactics_Effect.tac_repr) @@ -4093,17 +4169,18 @@ let (pack_sigelt : FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStarC_Reflection_V2_Builtins.pack_sigelt sv1)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.NamedView.pack_sigelt" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.NamedView.pack_sigelt" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.NamedView.pack_sigelt (plugin)" - (FStarC_Tactics_Native.from_tactic_1 pack_sigelt) - e_named_sigelt_view FStarC_Reflection_V2_Embeddings.e_sigelt - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 pack_sigelt) + e_named_sigelt_view + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_sigelt psc ncb + us args) let (tcc : FStarC_Reflection_Types.env -> term -> (comp, unit) FStar_Tactics_Effect.tac_repr) @@ -4126,35 +4203,38 @@ let (tcc : FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> FStarC_Reflection_V2_Builtins.inspect_comp c)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.NamedView.tcc" - (Prims.of_int (3)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.NamedView.tcc" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.NamedView.tcc (plugin)" - (FStarC_Tactics_Native.from_tactic_2 tcc) - FStarC_Reflection_V2_Embeddings.e_env - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_comp_view psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 tcc) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_env + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view psc + ncb us args) let (comp_to_string : comp -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = fun c -> FStarC_Tactics_V2_Builtins.comp_to_string (FStarC_Reflection_V2_Builtins.pack_comp c) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.NamedView.comp_to_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.NamedView.comp_to_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 comp_to_string) - FStarC_Reflection_V2_Embeddings.e_comp_view - FStarC_Syntax_Embeddings.e_string psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + comp_to_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) type universe_view = named_universe_view type term_view = named_term_view type sigelt_view = named_sigelt_view @@ -4179,25 +4259,38 @@ let (tag_of : term -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = (Prims.of_int (220)) (Prims.of_int (2)) (Prims.of_int (237)) (Prims.of_int (28))))) (Obj.magic uu___) (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | Tv_Var bv1 -> "Tv_Var" - | Tv_BVar fv -> "Tv_BVar" - | Tv_FVar fv -> "Tv_FVar" - | Tv_UInst (uu___3, uu___4) -> "Tv_UInst" - | Tv_App (f, x) -> "Tv_App" - | Tv_Abs (x, t1) -> "Tv_Abs" - | Tv_Arrow (x, t1) -> "Tv_Arrow" - | Tv_Type uu___3 -> "Tv_Type" - | Tv_Refine (x, t1) -> "Tv_Refine" - | Tv_Const cst -> "Tv_Const" - | Tv_Uvar (i, t1) -> "Tv_Uvar" - | Tv_Let (r, attrs, b, t1, t2) -> "Tv_Let" - | Tv_Match (t1, uu___3, branches) -> "Tv_Match" - | Tv_AscribedT (uu___3, uu___4, uu___5, uu___6) -> - "Tv_AscribedT" - | Tv_AscribedC (uu___3, uu___4, uu___5, uu___6) -> - "Tv_AscribedC" - | Tv_Unknown -> "Tv_Unknown" - | Tv_Unsupp -> "Tv_Unsupp")) \ No newline at end of file + match uu___1 with + | Tv_Var bv1 -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Var") + | Tv_BVar fv -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_BVar") + | Tv_FVar fv -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_FVar") + | Tv_UInst (uu___2, uu___3) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> "Tv_UInst") + | Tv_App (f, x) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_App") + | Tv_Abs (x, t1) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Abs") + | Tv_Arrow (x, t1) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Arrow") + | Tv_Type uu___2 -> + FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> "Tv_Type") + | Tv_Refine (x, t1) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Refine") + | Tv_Const cst -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Const") + | Tv_Uvar (i, t1) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Uvar") + | Tv_Let (r, attrs, b, t1, t2) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Let") + | Tv_Match (t1, uu___2, branches) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> "Tv_Match") + | Tv_AscribedT (uu___2, uu___3, uu___4, uu___5) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___6 -> "Tv_AscribedT") + | Tv_AscribedC (uu___2, uu___3, uu___4, uu___5) -> + FStar_Tactics_Effect.lift_div_tac (fun uu___6 -> "Tv_AscribedC") + | Tv_Unknown -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Unknown") + | Tv_Unsupp -> + FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> "Tv_Unsupp")) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Names.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Names.ml similarity index 90% rename from stage0/fstar-lib/generated/FStar_Tactics_Names.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Names.ml index 297318d795b..fa0337ab963 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_Names.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Names.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims exception Appears let (uu___is_Appears : Prims.exn -> Prims.bool) = @@ -136,24 +137,25 @@ let (name_appears_in : (Obj.magic uu___1) (fun uu___2 -> match uu___2 with - | FStar_Pervasives.Inr x -> + | Fstarcompiler.FStar_Pervasives.Inr x -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> x) - | FStar_Pervasives.Inl (Appears) -> + | Fstarcompiler.FStar_Pervasives.Inl (Appears) -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> true) - | FStar_Pervasives.Inl e -> + | Fstarcompiler.FStar_Pervasives.Inl e -> FStar_Tactics_Effect.raise e))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.Names.name_appears_in" - (Prims.of_int (3)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.Names.name_appears_in" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.Names.name_appears_in (plugin)" - (FStarC_Tactics_Native.from_tactic_2 name_appears_in) - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_bool psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 + name_appears_in) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Parametricity.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Parametricity.ml similarity index 87% rename from stage0/fstar-lib/generated/FStar_Tactics_Parametricity.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Parametricity.ml index b7449188997..9798be09845 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_Parametricity.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Parametricity.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims exception Unsupported of Prims.string let (uu___is_Unsupported : Prims.exn -> Prims.bool) = @@ -97,8 +98,11 @@ let last : 'a . 'a Prims.list -> ('a, unit) FStar_Tactics_Effect.tac_repr = (fun xs -> match FStar_List_Tot_Base.rev xs with | h::uu___ -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> h)) - | [] -> Obj.magic (FStar_Tactics_V2_Derived.fail "last: empty list")) + Obj.magic + (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> h))) + | [] -> + Obj.magic + (Obj.repr (FStar_Tactics_V2_Derived.fail "last: empty list"))) uu___ let (app_binders : FStar_Tactics_NamedView.term -> @@ -440,11 +444,11 @@ let rec (param' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range - "dummy" - Prims.int_zero - Prims.int_zero - Prims.int_zero - Prims.int_zero))) + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (105)) + (Prims.of_int (4)) + (Prims.of_int (105)) + (Prims.of_int (100))))) (Obj.magic uu___6) (fun xr -> @@ -465,10 +469,10 @@ let rec (param' : (FStar_Tactics_NamedView.Tv_Arrow (xr, (FStarC_Reflection_V2_Data.C_Total - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Type - (FStarC_Reflection_V2_Builtins.pack_universe - FStarC_Reflection_V2_Data.Uv_Unk)))))))))))))))))))) + (FStar_Tactics_NamedView.pack + (FStar_Tactics_NamedView.Tv_Type + (FStar_Tactics_NamedView.pack_universe + FStar_Tactics_NamedView.Uv_Unk)))))))))))))))))))) uu___6))) uu___5))) uu___4))) | FStar_Tactics_NamedView.Tv_Var bv -> @@ -1212,9 +1216,10 @@ let rec (param' : (Prims.of_int (140)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" - Prims.int_zero Prims.int_zero - Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (140)) (Prims.of_int (4)) + (Prims.of_int (140)) (Prims.of_int (60))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -1256,9 +1261,10 @@ let rec (param' : (Prims.of_int (144)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" - Prims.int_zero Prims.int_zero - Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (144)) (Prims.of_int (4)) + (Prims.of_int (144)) (Prims.of_int (34))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -1300,9 +1306,10 @@ let rec (param' : (Prims.of_int (144)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" - Prims.int_zero Prims.int_zero - Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (144)) (Prims.of_int (4)) + (Prims.of_int (144)) (Prims.of_int (34))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -1932,93 +1939,88 @@ and (param_pat : FStar_Tactics_NamedView.univs = us; FStar_Tactics_NamedView.subpats = pats;_} -> + let uu___1 = param_fv s fv in Obj.magic - (Obj.repr - (let uu___1 = param_fv s fv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (197)) (Prims.of_int (14)) - (Prims.of_int (197)) (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (197)) (Prims.of_int (30)) - (Prims.of_int (215)) (Prims.of_int (56))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun fv' -> - let uu___2 = - FStar_Tactics_Util.fold_left - (fun uu___3 -> - fun uu___4 -> - match (uu___3, uu___4) with - | ((s1, (pats0, pats1, patsr)), - (p1, i)) -> - let uu___5 = is_dot_pat p1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (200)) - (Prims.of_int (23)) - (Prims.of_int (200)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (200)) - (Prims.of_int (20)) - (Prims.of_int (206)) - (Prims.of_int (60))))) - (Obj.magic uu___5) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (197)) (Prims.of_int (14)) + (Prims.of_int (197)) (Prims.of_int (27))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (197)) (Prims.of_int (30)) + (Prims.of_int (215)) (Prims.of_int (56))))) + (Obj.magic uu___1) + (fun uu___2 -> + (fun fv' -> + let uu___2 = + FStar_Tactics_Util.fold_left + (fun uu___3 -> + fun uu___4 -> + match (uu___3, uu___4) with + | ((s1, (pats0, pats1, patsr)), + (p1, i)) -> + let uu___5 = is_dot_pat p1 in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (200)) + (Prims.of_int (23)) + (Prims.of_int (200)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (200)) + (Prims.of_int (20)) + (Prims.of_int (206)) + (Prims.of_int (60))))) + (Obj.magic uu___5) + (fun uu___6 -> (fun uu___6 -> - (fun uu___6 -> - if uu___6 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - (s1, - (pats0, - pats1, - patsr))))) - else - Obj.magic - (Obj.repr - (let uu___8 = - param_pat s1 - p1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + if uu___6 + then + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> + (s1, + (pats0, + pats1, + patsr))))) + else + Obj.magic + (Obj.repr + (let uu___8 = + param_pat s1 p1 in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" (Prims.of_int (202)) (Prims.of_int (45)) (Prims.of_int (202)) (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" (Prims.of_int (201)) (Prims.of_int (24)) (Prims.of_int (206)) (Prims.of_int (60))))) - (Obj.magic - uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - ( - fun - uu___10 + (Obj.magic uu___8) + (fun uu___9 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___10 -> match uu___9 with @@ -2040,211 +2042,208 @@ and (param_pat : (p0, i) :: patsr)))))))) - uu___6)) - (s, ([], [], [])) pats in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (199)) - (Prims.of_int (6)) - (Prims.of_int (208)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (197)) - (Prims.of_int (30)) - (Prims.of_int (215)) - (Prims.of_int (56))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - match uu___3 with - | (s', (pats0, pats1, patsr)) -> - (s', - ((FStar_Tactics_NamedView.Pat_Cons - { - FStar_Tactics_NamedView.head - = fv; - FStar_Tactics_NamedView.univs - = us; - FStar_Tactics_NamedView.subpats - = - (FStar_List_Tot_Base.rev - pats0) - }), - (FStar_Tactics_NamedView.Pat_Cons - { - FStar_Tactics_NamedView.head - = fv; - FStar_Tactics_NamedView.univs - = us; - FStar_Tactics_NamedView.subpats - = - (FStar_List_Tot_Base.rev - pats1) - }), - (FStar_Tactics_NamedView.Pat_Cons - { - FStar_Tactics_NamedView.head - = fv'; - FStar_Tactics_NamedView.univs - = us; - FStar_Tactics_NamedView.subpats - = - (FStar_List_Tot_Base.rev - patsr) - }))))))) uu___2))) + uu___6)) (s, ([], [], [])) + pats in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (199)) + (Prims.of_int (6)) + (Prims.of_int (208)) + (Prims.of_int (21))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (197)) + (Prims.of_int (30)) + (Prims.of_int (215)) + (Prims.of_int (56))))) + (Obj.magic uu___2) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + match uu___3 with + | (s', (pats0, pats1, patsr)) -> + (s', + ((FStar_Tactics_NamedView.Pat_Cons + { + FStar_Tactics_NamedView.head + = fv; + FStar_Tactics_NamedView.univs + = us; + FStar_Tactics_NamedView.subpats + = + (FStar_List_Tot_Base.rev + pats0) + }), + (FStar_Tactics_NamedView.Pat_Cons + { + FStar_Tactics_NamedView.head + = fv; + FStar_Tactics_NamedView.univs + = us; + FStar_Tactics_NamedView.subpats + = + (FStar_List_Tot_Base.rev + pats1) + }), + (FStar_Tactics_NamedView.Pat_Cons + { + FStar_Tactics_NamedView.head + = fv'; + FStar_Tactics_NamedView.univs + = us; + FStar_Tactics_NamedView.subpats + = + (FStar_List_Tot_Base.rev + patsr) + }))))))) uu___2)) | FStar_Tactics_NamedView.Pat_Var { FStar_Tactics_NamedView.v = v; FStar_Tactics_NamedView.sort1 = sort;_} -> + let uu___1 = + let uu___2 = FStarC_Tactics_Unseal.unseal sort in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (218)) (Prims.of_int (31)) + (Prims.of_int (218)) (Prims.of_int (44))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (218)) (Prims.of_int (12)) + (Prims.of_int (218)) (Prims.of_int (44))))) + (Obj.magic uu___2) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + FStar_Tactics_NamedView.namedv_to_binder v + uu___3)) in Obj.magic - (Obj.repr - (let uu___1 = - let uu___2 = FStarC_Tactics_Unseal.unseal sort in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (218)) (Prims.of_int (31)) - (Prims.of_int (218)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (218)) (Prims.of_int (12)) - (Prims.of_int (218)) (Prims.of_int (44))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Tactics_NamedView.namedv_to_binder - v uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (218)) (Prims.of_int (12)) - (Prims.of_int (218)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (218)) (Prims.of_int (47)) - (Prims.of_int (222)) (Prims.of_int (80))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun b -> - let uu___2 = push_binder b s in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (219)) - (Prims.of_int (29)) - (Prims.of_int (219)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (218)) - (Prims.of_int (47)) - (Prims.of_int (222)) - (Prims.of_int (80))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - match uu___3 with - | (s', (b0, b1, bR)) -> - (s', - ((FStar_Tactics_NamedView.Pat_Var - { - FStar_Tactics_NamedView.v - = - (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv - b0); - FStar_Tactics_NamedView.sort1 - = - (FStar_Sealed.seal - (FStar_Tactics_V2_Derived.binder_sort - b0)) - }), - (FStar_Tactics_NamedView.Pat_Var - { - FStar_Tactics_NamedView.v - = - (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv - b1); - FStar_Tactics_NamedView.sort1 - = - (FStar_Sealed.seal - (FStar_Tactics_V2_Derived.binder_sort - b1)) - }), - (FStar_Tactics_NamedView.Pat_Var - { - FStar_Tactics_NamedView.v - = - (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv - bR); - FStar_Tactics_NamedView.sort1 - = - (FStar_Sealed.seal - (FStar_Tactics_V2_Derived.binder_sort - bR)) - }))))))) uu___2))) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (218)) (Prims.of_int (12)) + (Prims.of_int (218)) (Prims.of_int (44))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (218)) (Prims.of_int (47)) + (Prims.of_int (222)) (Prims.of_int (80))))) + (Obj.magic uu___1) + (fun uu___2 -> + (fun b -> + let uu___2 = push_binder b s in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (219)) + (Prims.of_int (29)) + (Prims.of_int (219)) + (Prims.of_int (44))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (218)) + (Prims.of_int (47)) + (Prims.of_int (222)) + (Prims.of_int (80))))) + (Obj.magic uu___2) + (fun uu___3 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + match uu___3 with + | (s', (b0, b1, bR)) -> + (s', + ((FStar_Tactics_NamedView.Pat_Var + { + FStar_Tactics_NamedView.v + = + (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv + b0); + FStar_Tactics_NamedView.sort1 + = + (FStar_Sealed.seal + (FStar_Tactics_V2_Derived.binder_sort + b0)) + }), + (FStar_Tactics_NamedView.Pat_Var + { + FStar_Tactics_NamedView.v + = + (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv + b1); + FStar_Tactics_NamedView.sort1 + = + (FStar_Sealed.seal + (FStar_Tactics_V2_Derived.binder_sort + b1)) + }), + (FStar_Tactics_NamedView.Pat_Var + { + FStar_Tactics_NamedView.v + = + (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv + bR); + FStar_Tactics_NamedView.sort1 + = + (FStar_Sealed.seal + (FStar_Tactics_V2_Derived.binder_sort + bR)) + }))))))) uu___2)) | FStar_Tactics_NamedView.Pat_Dot_Term t -> - Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail "no dot pats")) + Obj.magic (FStar_Tactics_V2_Derived.fail "no dot pats") | FStar_Tactics_NamedView.Pat_Constant c -> + let uu___1 = + FStar_Tactics_V2_Derived.fresh_binder_named "cR" + (FStarC_Reflection_V2_Builtins.pack_ln + FStarC_Reflection_V2_Data.Tv_Unknown) in Obj.magic - (Obj.repr - (let uu___1 = - FStar_Tactics_V2_Derived.fresh_binder_named "cR" - (FStarC_Reflection_V2_Builtins.pack_ln - FStarC_Reflection_V2_Data.Tv_Unknown) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (232)) (Prims.of_int (12)) - (Prims.of_int (232)) (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (233)) (Prims.of_int (4)) - (Prims.of_int (235)) (Prims.of_int (57))))) - (Obj.magic uu___1) - (fun b -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - (s, - ((FStar_Tactics_NamedView.Pat_Constant c), - (FStar_Tactics_NamedView.Pat_Constant c), - (FStar_Tactics_NamedView.Pat_Var - { - FStar_Tactics_NamedView.v = - (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv - b); - FStar_Tactics_NamedView.sort1 = - (FStar_Sealed.seal - (FStarC_Reflection_V2_Builtins.pack_ln - FStarC_Reflection_V2_Data.Tv_Unknown)) - })))))))) uu___1) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (232)) (Prims.of_int (12)) + (Prims.of_int (232)) (Prims.of_int (40))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (233)) (Prims.of_int (4)) + (Prims.of_int (235)) (Prims.of_int (57))))) + (Obj.magic uu___1) + (fun b -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + (s, + ((FStar_Tactics_NamedView.Pat_Constant c), + (FStar_Tactics_NamedView.Pat_Constant c), + (FStar_Tactics_NamedView.Pat_Var + { + FStar_Tactics_NamedView.v = + (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv + b); + FStar_Tactics_NamedView.sort1 = + (FStar_Sealed.seal + (FStarC_Reflection_V2_Builtins.pack_ln + FStarC_Reflection_V2_Data.Tv_Unknown)) + }))))))) uu___1) and (param_br : param_state -> FStar_Tactics_NamedView.branch -> @@ -2905,17 +2904,18 @@ let (param : (Prims.of_int (7))))) (Obj.magic uu___) (fun t1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> t1)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.Parametricity.param" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.Parametricity.param" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Parametricity.param (plugin)" - (FStarC_Tactics_Native.from_tactic_1 param) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 param) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term psc ncb + us args) let (fv_to_tm : FStarC_Reflection_Types.fv -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) @@ -3254,16 +3254,18 @@ let (param_ctor : FStarC_Reflection_V2_Data.C_Total ty1 -> Obj.magic + (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___10 - -> ty1)) + -> ty1))) | uu___10 -> Obj.magic + (Obj.repr (FStar_Tactics_V2_Derived.fail - "param_ctor got a non-tot comp") in + "param_ctor got a non-tot comp")) in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -3543,175 +3545,170 @@ let (param_inductive : FStar_Tactics_NamedView.typ = typ; FStar_Tactics_NamedView.ctors = ctors;_} -> + let uu___2 = + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> push_fv fv0 fv1 init_param_state)) in Obj.magic - (Obj.repr - (let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - push_fv fv0 fv1 init_param_state)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (308)) (Prims.of_int (12)) - (Prims.of_int (308)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (308)) (Prims.of_int (47)) - (Prims.of_int (325)) (Prims.of_int (20))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun s -> - let uu___3 = - let uu___4 = - fv_to_tm - (FStarC_Reflection_V2_Builtins.pack_fv - nm) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (309)) - (Prims.of_int (27)) - (Prims.of_int (309)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (309)) - (Prims.of_int (15)) - (Prims.of_int (309)) - (Prims.of_int (57))))) - (Obj.magic uu___4) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (308)) (Prims.of_int (12)) + (Prims.of_int (308)) (Prims.of_int (44))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (308)) (Prims.of_int (47)) + (Prims.of_int (325)) (Prims.of_int (20))))) + (Obj.magic uu___2) + (fun uu___3 -> + (fun s -> + let uu___3 = + let uu___4 = + fv_to_tm + (FStarC_Reflection_V2_Builtins.pack_fv + nm) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (309)) + (Prims.of_int (27)) + (Prims.of_int (309)) + (Prims.of_int (50))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (309)) + (Prims.of_int (15)) + (Prims.of_int (309)) + (Prims.of_int (57))))) + (Obj.magic uu___4) + (fun uu___5 -> (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (app_binders uu___5 params)) - uu___5) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (309)) - (Prims.of_int (15)) - (Prims.of_int (309)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (309)) - (Prims.of_int (60)) - (Prims.of_int (325)) - (Prims.of_int (20))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun orig -> - let uu___4 = - FStar_Tactics_Util.fold_left - (fun uu___5 -> - fun b -> - match uu___5 with - | (s1, bvs) -> - let uu___6 = - push_binder b s1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (312)) - (Prims.of_int (64)) - (Prims.of_int (312)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (312)) - (Prims.of_int (36)) - (Prims.of_int (316)) - (Prims.of_int (57))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 - -> - match uu___7 - with - | - (s2, - (bx0, - bx1, bxr)) - -> - (s2, (bxr - :: bx1 :: - bx0 :: - bvs))))) - (s, []) params in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (312)) - (Prims.of_int (8)) - (Prims.of_int (316)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (309)) - (Prims.of_int (60)) - (Prims.of_int (325)) - (Prims.of_int (20))))) - (Obj.magic uu___4) + Obj.magic + (app_binders uu___5 params)) + uu___5) in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (309)) + (Prims.of_int (15)) + (Prims.of_int (309)) + (Prims.of_int (57))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (309)) + (Prims.of_int (60)) + (Prims.of_int (325)) + (Prims.of_int (20))))) + (Obj.magic uu___3) + (fun uu___4 -> + (fun orig -> + let uu___4 = + FStar_Tactics_Util.fold_left + (fun uu___5 -> + fun b -> + match uu___5 with + | (s1, bvs) -> + let uu___6 = + push_binder b s1 in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (312)) + (Prims.of_int (64)) + (Prims.of_int (312)) + (Prims.of_int (79))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (312)) + (Prims.of_int (36)) + (Prims.of_int (316)) + (Prims.of_int (57))))) + (Obj.magic uu___6) + (fun uu___7 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___8 -> + match uu___7 + with + | (s2, + (bx0, + bx1, bxr)) + -> + (s2, (bxr + :: bx1 :: + bx0 :: + bvs))))) + (s, []) params in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (312)) + (Prims.of_int (8)) + (Prims.of_int (316)) + (Prims.of_int (73))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (309)) + (Prims.of_int (60)) + (Prims.of_int (325)) + (Prims.of_int (20))))) + (Obj.magic uu___4) + (fun uu___5 -> (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | (s1, param_bs) -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - FStar_List_Tot_Base.rev + match uu___5 with + | (s1, param_bs) -> + let uu___6 = + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___7 + -> + FStar_List_Tot_Base.rev param_bs)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic ( - Obj.magic - (FStar_Range.mk_range + FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" (Prims.of_int (318)) (Prims.of_int (19)) (Prims.of_int (318)) (Prims.of_int (40))))) - (FStar_Sealed.seal + (FStar_Sealed.seal + (Obj.magic ( - Obj.magic - (FStar_Range.mk_range + FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" (Prims.of_int (318)) (Prims.of_int (43)) (Prims.of_int (325)) (Prims.of_int (20))))) - (Obj.magic - uu___6) - (fun uu___7 - -> - (fun + (Obj.magic + uu___6) + (fun uu___7 -> + (fun param_bs1 -> let uu___7 @@ -4008,11 +4005,10 @@ let (param_inductive : uu___10))) uu___9))) uu___8))) - uu___7))) - uu___5))) uu___4))) - uu___3))) - | uu___2 -> - Obj.magic (Obj.repr (FStar_Tactics_V2_Derived.fail ""))) + uu___7))) + uu___5))) uu___4))) + uu___3)) + | uu___2 -> Obj.magic (FStar_Tactics_V2_Derived.fail "")) uu___1) let (param_letbinding : FStarC_Reflection_Types.sigelt -> @@ -4043,332 +4039,327 @@ let (param_letbinding : { FStar_Tactics_NamedView.isrec = r; FStar_Tactics_NamedView.lbs = lb::[];_} -> + let uu___2 = param lb.FStar_Tactics_NamedView.lb_typ in Obj.magic - (Obj.repr - (let uu___2 = - param lb.FStar_Tactics_NamedView.lb_typ in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (331)) (Prims.of_int (14)) - (Prims.of_int (331)) (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (331)) (Prims.of_int (32)) - (Prims.of_int (334)) (Prims.of_int (21))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun rrr -> - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = fv_to_tm fv0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (51)) - (Prims.of_int (332)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (50)) - (Prims.of_int (332)) - (Prims.of_int (78))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - let uu___8 = - let uu___9 = fv_to_tm fv0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (65)) - (Prims.of_int (332)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (50)) - (Prims.of_int (332)) - (Prims.of_int (78))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> - [uu___10])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (50)) - (Prims.of_int (332)) - (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (50)) - (Prims.of_int (332)) - (Prims.of_int (78))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - uu___7 :: uu___9)))) - uu___7) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (50)) - (Prims.of_int (332)) - (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (36)) - (Prims.of_int (332)) - (Prims.of_int (79))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - FStar_Reflection_V2_Derived.mk_e_app - rrr uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (36)) - (Prims.of_int (332)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (332)) - (Prims.of_int (23)) - (Prims.of_int (332)) - (Prims.of_int (79))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStar_Tactics_V2_Derived.norm_term - [] uu___5)) uu___5) in - Obj.magic - (FStar_Tactics_Effect.tac_bind + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (331)) (Prims.of_int (14)) + (Prims.of_int (331)) (Prims.of_int (29))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (331)) (Prims.of_int (32)) + (Prims.of_int (334)) (Prims.of_int (21))))) + (Obj.magic uu___2) + (fun uu___3 -> + (fun rrr -> + let uu___3 = + let uu___4 = + let uu___5 = + let uu___6 = fv_to_tm fv0 in + FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" (Prims.of_int (332)) - (Prims.of_int (23)) + (Prims.of_int (51)) (Prims.of_int (332)) - (Prims.of_int (79))))) + (Prims.of_int (63))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" (Prims.of_int (332)) - (Prims.of_int (82)) - (Prims.of_int (334)) - (Prims.of_int (21))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun expected_typ -> - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - param - lb.FStar_Tactics_NamedView.lb_def in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (333)) - (Prims.of_int (94)) - (Prims.of_int (333)) - (Prims.of_int (111))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (333)) - (Prims.of_int (37)) - (Prims.of_int (333)) - (Prims.of_int (111))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - { - FStar_Tactics_NamedView.lb_fv - = fv1; - FStar_Tactics_NamedView.lb_us - = - (lb.FStar_Tactics_NamedView.lb_us); - FStar_Tactics_NamedView.lb_typ - = - expected_typ; - FStar_Tactics_NamedView.lb_def - = uu___9 - })) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (333)) - (Prims.of_int (37)) - (Prims.of_int (333)) - (Prims.of_int (111))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (333)) - (Prims.of_int (35)) - (Prims.of_int (333)) - (Prims.of_int (113))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - [uu___8])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (333)) - (Prims.of_int (35)) - (Prims.of_int (333)) - (Prims.of_int (113))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (333)) - (Prims.of_int (22)) - (Prims.of_int (333)) - (Prims.of_int (113))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - { - FStar_Tactics_NamedView.isrec - = r; - FStar_Tactics_NamedView.lbs - = uu___7 - })) in + (Prims.of_int (50)) + (Prims.of_int (332)) + (Prims.of_int (78))))) + (Obj.magic uu___6) + (fun uu___7 -> + (fun uu___7 -> + let uu___8 = + let uu___9 = fv_to_tm fv0 in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" - (Prims.of_int (333)) - (Prims.of_int (22)) - (Prims.of_int (333)) - (Prims.of_int (113))))) + (Prims.of_int (332)) + (Prims.of_int (65)) + (Prims.of_int (332)) + (Prims.of_int (77))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" - (Prims.of_int (333)) - (Prims.of_int (14)) - (Prims.of_int (333)) - (Prims.of_int (114))))) - (Obj.magic uu___5) - (fun uu___6 -> + (Prims.of_int (332)) + (Prims.of_int (50)) + (Prims.of_int (332)) + (Prims.of_int (78))))) + (Obj.magic uu___9) + (fun uu___10 -> FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - FStar_Tactics_NamedView.Sg_Let - uu___6)) in + (fun uu___11 -> + [uu___10])) in Obj.magic (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (332)) + (Prims.of_int (50)) + (Prims.of_int (332)) + (Prims.of_int (78))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (332)) + (Prims.of_int (50)) + (Prims.of_int (332)) + (Prims.of_int (78))))) + (Obj.magic uu___8) + (fun uu___9 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___10 -> uu___7 + :: uu___9)))) + uu___7) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (332)) + (Prims.of_int (50)) + (Prims.of_int (332)) + (Prims.of_int (78))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (332)) + (Prims.of_int (36)) + (Prims.of_int (332)) + (Prims.of_int (79))))) + (Obj.magic uu___5) + (fun uu___6 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> + FStar_Reflection_V2_Derived.mk_e_app + rrr uu___6)) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (332)) + (Prims.of_int (36)) + (Prims.of_int (332)) + (Prims.of_int (79))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (332)) + (Prims.of_int (23)) + (Prims.of_int (332)) + (Prims.of_int (79))))) + (Obj.magic uu___4) + (fun uu___5 -> + (fun uu___5 -> + Obj.magic + (FStar_Tactics_V2_Derived.norm_term + [] uu___5)) uu___5) in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (332)) + (Prims.of_int (23)) + (Prims.of_int (332)) + (Prims.of_int (79))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (332)) + (Prims.of_int (82)) + (Prims.of_int (334)) + (Prims.of_int (21))))) + (Obj.magic uu___3) + (fun uu___4 -> + (fun expected_typ -> + let uu___4 = + let uu___5 = + let uu___6 = + let uu___7 = + let uu___8 = + param + lb.FStar_Tactics_NamedView.lb_def in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (333)) + (Prims.of_int (94)) + (Prims.of_int (333)) + (Prims.of_int (111))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (333)) + (Prims.of_int (37)) + (Prims.of_int (333)) + (Prims.of_int (111))))) + (Obj.magic uu___8) + (fun uu___9 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___10 -> + { + FStar_Tactics_NamedView.lb_fv + = fv1; + FStar_Tactics_NamedView.lb_us + = + (lb.FStar_Tactics_NamedView.lb_us); + FStar_Tactics_NamedView.lb_typ + = + expected_typ; + FStar_Tactics_NamedView.lb_def + = uu___9 + })) in + FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" (Prims.of_int (333)) - (Prims.of_int (14)) + (Prims.of_int (37)) (Prims.of_int (333)) - (Prims.of_int (114))))) + (Prims.of_int (111))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Parametricity.fst" - (Prims.of_int (334)) - (Prims.of_int (4)) - (Prims.of_int (334)) - (Prims.of_int (21))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun se' -> - let uu___5 = - FStar_Tactics_NamedView.pack_sigelt - se' in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (334)) - (Prims.of_int (5)) - (Prims.of_int (334)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (334)) - (Prims.of_int (4)) - (Prims.of_int (334)) - (Prims.of_int (21))))) + (Prims.of_int (333)) + (Prims.of_int (35)) + (Prims.of_int (333)) + (Prims.of_int (113))))) + (Obj.magic uu___7) + (fun uu___8 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___9 -> + [uu___8])) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (333)) + (Prims.of_int (35)) + (Prims.of_int (333)) + (Prims.of_int (113))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (333)) + (Prims.of_int (22)) + (Prims.of_int (333)) + (Prims.of_int (113))))) + (Obj.magic uu___6) + (fun uu___7 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___8 -> + { + FStar_Tactics_NamedView.isrec + = r; + FStar_Tactics_NamedView.lbs + = uu___7 + })) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (333)) + (Prims.of_int (22)) + (Prims.of_int (333)) + (Prims.of_int (113))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (333)) + (Prims.of_int (14)) + (Prims.of_int (333)) + (Prims.of_int (114))))) + (Obj.magic uu___5) + (fun uu___6 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> + FStar_Tactics_NamedView.Sg_Let + uu___6)) in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (333)) + (Prims.of_int (14)) + (Prims.of_int (333)) + (Prims.of_int (114))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (334)) + (Prims.of_int (4)) + (Prims.of_int (334)) + (Prims.of_int (21))))) + (Obj.magic uu___4) + (fun uu___5 -> + (fun se' -> + let uu___5 = + FStar_Tactics_NamedView.pack_sigelt + se' in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic - uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 - -> - [uu___6])))) - uu___5))) uu___4))) - uu___3))) + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (334)) + (Prims.of_int (5)) + (Prims.of_int (334)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (334)) + (Prims.of_int (4)) + (Prims.of_int (334)) + (Prims.of_int (21))))) + (Obj.magic uu___5) + (fun uu___6 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> + [uu___6])))) + uu___5))) uu___4))) + uu___3)) | uu___2 -> Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail "no mutual recursion"))) + (FStar_Tactics_V2_Derived.fail "no mutual recursion")) uu___1) let (paramd : Prims.string -> @@ -4577,96 +4568,91 @@ let (paramd : | FStar_Pervasives_Native.None -> Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "param_letbinding: not found")) + (FStar_Tactics_V2_Derived.fail + "param_letbinding: not found") | FStar_Pervasives_Native.Some se1 -> - Obj.magic - (Obj.repr - (let uu___4 = - let uu___5 = - FStar_Tactics_NamedView.inspect_sigelt - se1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (345)) - (Prims.of_int (9)) - (Prims.of_int (345)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (345)) - (Prims.of_int (3)) - (Prims.of_int (348)) - (Prims.of_int (43))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 - with - | FStar_Tactics_NamedView.Sg_Let - uu___7 -> - Obj.magic - (Obj.repr - (param_letbinding + let uu___4 = + let uu___5 = + FStar_Tactics_NamedView.inspect_sigelt + se1 in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (345)) + (Prims.of_int (9)) + (Prims.of_int (345)) + (Prims.of_int (26))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (345)) + (Prims.of_int (3)) + (Prims.of_int (348)) + (Prims.of_int (43))))) + (Obj.magic uu___5) + (fun uu___6 -> + (fun uu___6 -> + match uu___6 with + | FStar_Tactics_NamedView.Sg_Let + uu___7 -> + Obj.magic + (param_letbinding se1 fv0 - fv1)) - | FStar_Tactics_NamedView.Sg_Inductive - uu___7 -> - Obj.magic - (Obj.repr - (param_inductive + fv1) + | FStar_Tactics_NamedView.Sg_Inductive + uu___7 -> + Obj.magic + (param_inductive se1 fv0 - fv1)) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "paramd: unsupported sigelt"))) - uu___6) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (345)) - (Prims.of_int (3)) - (Prims.of_int (348)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Parametricity.fst" - (Prims.of_int (344)) - (Prims.of_int (6)) - (Prims.of_int (344)) - (Prims.of_int (11))))) - (Obj.magic uu___4) - (fun decls -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - decls))))) + fv1) + | uu___7 -> + Obj.magic + (FStar_Tactics_V2_Derived.fail + "paramd: unsupported sigelt")) + uu___6) in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (345)) + (Prims.of_int (3)) + (Prims.of_int (348)) + (Prims.of_int (43))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.Parametricity.fst" + (Prims.of_int (344)) + (Prims.of_int (6)) + (Prims.of_int (344)) + (Prims.of_int (11))))) + (Obj.magic uu___4) + (fun decls -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> + decls)))) uu___4))) uu___3))) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.Parametricity.paramd" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.Parametricity.paramd" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Parametricity.paramd (plugin)" - (FStarC_Tactics_Native.from_tactic_1 paramd) - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_sigelt) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 paramd) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_sigelt) psc + ncb us args) let (paramds : Prims.string Prims.list -> (FStarC_Reflection_Types.decls, unit) FStar_Tactics_Effect.tac_repr) @@ -4688,19 +4674,20 @@ let (paramds : FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> FStar_List_Tot_Base.flatten uu___1)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.Parametricity.paramds" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.Parametricity.paramds" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Parametricity.paramds (plugin)" - (FStarC_Tactics_Native.from_tactic_1 paramds) - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_sigelt) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 paramds) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_sigelt) psc + ncb us args) type ('a, 'x, 'y) param_of_eqtype = unit type ('uuuuu, 'uuuuu1) int_param = unit type ('uuuuu, 'uuuuu1) bool_param = unit diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Print.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Print.ml similarity index 85% rename from stage0/fstar-lib/generated/FStar_Tactics_Print.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Print.ml index 2af1f86a317..eacfd12851a 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_Print.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Print.ml @@ -1,6 +1,7 @@ +open Fstarcompiler open Prims -let (namedv_to_string : - FStar_Tactics_NamedView.namedv -> +let (namedv_view_to_string : + FStarC_Reflection_V2_Data.namedv_view -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = fun x -> @@ -14,27 +15,50 @@ let (namedv_to_string : (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___) + (FStar_Range.mk_range "FStar.Tactics.Print.fst" + (Prims.of_int (10)) (Prims.of_int (2)) (Prims.of_int (10)) + (Prims.of_int (46))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> Prims.strcat uu___1 (Prims.strcat "#" (Prims.string_of_int x.FStarC_Reflection_V2_Data.uniq)))) +let (namedv_to_string : + FStarC_Reflection_Types.namedv -> + (Prims.string, unit) FStar_Tactics_Effect.tac_repr) + = + fun x -> + let uu___ = + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___1 -> FStarC_Reflection_V2_Builtins.inspect_namedv x)) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Print.fst" + (Prims.of_int (13)) (Prims.of_int (10)) (Prims.of_int (13)) + (Prims.of_int (55))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.Print.fst" + (Prims.of_int (14)) (Prims.of_int (2)) (Prims.of_int (14)) + (Prims.of_int (25))))) (Obj.magic uu___) + (fun uu___1 -> (fun x1 -> Obj.magic (namedv_view_to_string x1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.namedv_to_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.namedv_to_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 namedv_to_string) - FStarC_Reflection_V2_Embeddings.e_namedv_view - FStarC_Syntax_Embeddings.e_string psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + namedv_to_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_namedv + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) let (paren : Prims.string -> Prims.string) = fun s -> Prims.strcat "(" (Prims.strcat s ")") let rec print_list_aux : @@ -60,13 +84,13 @@ let rec print_list_aux : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (21)) (Prims.of_int (13)) - (Prims.of_int (21)) (Prims.of_int (16))))) + (Prims.of_int (25)) (Prims.of_int (13)) + (Prims.of_int (25)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (21)) (Prims.of_int (13)) - (Prims.of_int (21)) (Prims.of_int (45))))) + (Prims.of_int (25)) (Prims.of_int (13)) + (Prims.of_int (25)) (Prims.of_int (45))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -77,9 +101,9 @@ let rec print_list_aux : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (21)) + (Prims.of_int (25)) (Prims.of_int (26)) - (Prims.of_int (21)) + (Prims.of_int (25)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic @@ -98,9 +122,9 @@ let rec print_list_aux : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (21)) + (Prims.of_int (25)) (Prims.of_int (19)) - (Prims.of_int (21)) + (Prims.of_int (25)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic @@ -128,7 +152,7 @@ let print_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (25)) (Prims.of_int (9)) (Prims.of_int (25)) + (Prims.of_int (29)) (Prims.of_int (9)) (Prims.of_int (29)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic @@ -142,13 +166,13 @@ let print_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (25)) (Prims.of_int (9)) (Prims.of_int (25)) + (Prims.of_int (29)) (Prims.of_int (9)) (Prims.of_int (29)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___) + (FStar_Range.mk_range "FStar.Tactics.Print.fst" + (Prims.of_int (29)) (Prims.of_int (3)) (Prims.of_int (29)) + (Prims.of_int (33))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> Prims.strcat "[" uu___1)) @@ -172,13 +196,13 @@ let rec (universe_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (30)) (Prims.of_int (35)) - (Prims.of_int (30)) (Prims.of_int (61))))) + (Prims.of_int (34)) (Prims.of_int (35)) + (Prims.of_int (34)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (30)) (Prims.of_int (29)) - (Prims.of_int (30)) (Prims.of_int (61))))) + (Prims.of_int (34)) (Prims.of_int (29)) + (Prims.of_int (34)) (Prims.of_int (61))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -187,8 +211,8 @@ let rec (universe_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (30)) (Prims.of_int (29)) - (Prims.of_int (30)) (Prims.of_int (61))))) + (Prims.of_int (34)) (Prims.of_int (29)) + (Prims.of_int (34)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -206,8 +230,8 @@ let rec (universe_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (31)) (Prims.of_int (28)) - (Prims.of_int (31)) (Prims.of_int (64))))) + (Prims.of_int (35)) (Prims.of_int (28)) + (Prims.of_int (35)) (Prims.of_int (64))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -240,34 +264,38 @@ let rec (universe_to_ast_string : (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> "Uv_Unk")))) uu___ let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.universe_to_ast_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.universe_to_ast_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 universe_to_ast_string) - FStarC_Reflection_V2_Embeddings.e_universe - FStarC_Syntax_Embeddings.e_string psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + universe_to_ast_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) let (universes_to_ast_string : FStarC_Reflection_V2_Data.universes -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = fun us -> print_list universe_to_ast_string us let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.universes_to_ast_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.universes_to_ast_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 universes_to_ast_string) - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe) - FStarC_Syntax_Embeddings.e_string psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + universes_to_ast_string) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) let rec (term_to_ast_string : FStar_Tactics_NamedView.term -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) @@ -278,12 +306,12 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (41)) (Prims.of_int (8)) (Prims.of_int (41)) + (Prims.of_int (45)) (Prims.of_int (8)) (Prims.of_int (45)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (41)) (Prims.of_int (2)) (Prims.of_int (70)) + (Prims.of_int (45)) (Prims.of_int (2)) (Prims.of_int (74)) (Prims.of_int (30))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -291,13 +319,13 @@ let rec (term_to_ast_string : | FStar_Tactics_NamedView.Tv_Var bv -> Obj.magic (Obj.repr - (let uu___2 = namedv_to_string bv in + (let uu___2 = namedv_view_to_string bv in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (42)) (Prims.of_int (29)) - (Prims.of_int (42)) (Prims.of_int (48))))) + (Prims.of_int (46)) (Prims.of_int (29)) + (Prims.of_int (46)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -315,8 +343,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (43)) (Prims.of_int (31)) - (Prims.of_int (43)) (Prims.of_int (46))))) + (Prims.of_int (47)) (Prims.of_int (31)) + (Prims.of_int (47)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -345,9 +373,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (46)) + (Prims.of_int (50)) (Prims.of_int (49)) - (Prims.of_int (46)) + (Prims.of_int (50)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic @@ -365,8 +393,8 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (46)) (Prims.of_int (42)) - (Prims.of_int (46)) (Prims.of_int (75))))) + (Prims.of_int (50)) (Prims.of_int (42)) + (Prims.of_int (50)) (Prims.of_int (75))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -384,14 +412,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (46)) (Prims.of_int (23)) - (Prims.of_int (46)) (Prims.of_int (76))))) + (Prims.of_int (50)) (Prims.of_int (23)) + (Prims.of_int (50)) (Prims.of_int (76))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (46)) (Prims.of_int (17)) - (Prims.of_int (46)) (Prims.of_int (76))))) + (Prims.of_int (50)) (Prims.of_int (17)) + (Prims.of_int (50)) (Prims.of_int (76))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -400,8 +428,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (46)) (Prims.of_int (17)) - (Prims.of_int (46)) (Prims.of_int (76))))) + (Prims.of_int (50)) (Prims.of_int (17)) + (Prims.of_int (50)) (Prims.of_int (76))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -422,14 +450,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (47)) (Prims.of_int (43)) - (Prims.of_int (47)) (Prims.of_int (64))))) + (Prims.of_int (51)) (Prims.of_int (43)) + (Prims.of_int (51)) (Prims.of_int (64))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (47)) (Prims.of_int (42)) - (Prims.of_int (47)) (Prims.of_int (95))))) + (Prims.of_int (51)) (Prims.of_int (42)) + (Prims.of_int (51)) (Prims.of_int (95))))) (Obj.magic uu___5) (fun uu___6 -> (fun uu___6 -> @@ -440,9 +468,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (47)) + (Prims.of_int (51)) (Prims.of_int (74)) - (Prims.of_int (47)) + (Prims.of_int (51)) (Prims.of_int (94))))) (FStar_Sealed.seal (Obj.magic @@ -462,9 +490,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (47)) + (Prims.of_int (51)) (Prims.of_int (67)) - (Prims.of_int (47)) + (Prims.of_int (51)) (Prims.of_int (94))))) (FStar_Sealed.seal (Obj.magic @@ -485,14 +513,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (47)) (Prims.of_int (42)) - (Prims.of_int (47)) (Prims.of_int (95))))) + (Prims.of_int (51)) (Prims.of_int (42)) + (Prims.of_int (51)) (Prims.of_int (95))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (47)) (Prims.of_int (36)) - (Prims.of_int (47)) (Prims.of_int (95))))) + (Prims.of_int (51)) (Prims.of_int (36)) + (Prims.of_int (51)) (Prims.of_int (95))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -501,8 +529,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (47)) (Prims.of_int (36)) - (Prims.of_int (47)) (Prims.of_int (95))))) + (Prims.of_int (51)) (Prims.of_int (36)) + (Prims.of_int (51)) (Prims.of_int (95))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -524,14 +552,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (48)) (Prims.of_int (37)) - (Prims.of_int (48)) (Prims.of_int (55))))) + (Prims.of_int (52)) (Prims.of_int (37)) + (Prims.of_int (52)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (48)) (Prims.of_int (36)) - (Prims.of_int (48)) (Prims.of_int (86))))) + (Prims.of_int (52)) (Prims.of_int (36)) + (Prims.of_int (52)) (Prims.of_int (86))))) (Obj.magic uu___4) (fun uu___5 -> (fun uu___5 -> @@ -542,9 +570,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (48)) + (Prims.of_int (52)) (Prims.of_int (65)) - (Prims.of_int (48)) + (Prims.of_int (52)) (Prims.of_int (85))))) (FStar_Sealed.seal (Obj.magic @@ -564,9 +592,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (48)) + (Prims.of_int (52)) (Prims.of_int (58)) - (Prims.of_int (48)) + (Prims.of_int (52)) (Prims.of_int (85))))) (FStar_Sealed.seal (Obj.magic @@ -587,14 +615,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (48)) (Prims.of_int (36)) - (Prims.of_int (48)) (Prims.of_int (86))))) + (Prims.of_int (52)) (Prims.of_int (36)) + (Prims.of_int (52)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (48)) (Prims.of_int (30)) - (Prims.of_int (48)) (Prims.of_int (86))))) + (Prims.of_int (52)) (Prims.of_int (30)) + (Prims.of_int (52)) (Prims.of_int (86))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -603,8 +631,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (48)) (Prims.of_int (30)) - (Prims.of_int (48)) (Prims.of_int (86))))) + (Prims.of_int (52)) (Prims.of_int (30)) + (Prims.of_int (52)) (Prims.of_int (86))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -626,14 +654,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (49)) (Prims.of_int (41)) - (Prims.of_int (49)) (Prims.of_int (59))))) + (Prims.of_int (53)) (Prims.of_int (41)) + (Prims.of_int (53)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (49)) (Prims.of_int (40)) - (Prims.of_int (49)) (Prims.of_int (90))))) + (Prims.of_int (53)) (Prims.of_int (40)) + (Prims.of_int (53)) (Prims.of_int (90))))) (Obj.magic uu___4) (fun uu___5 -> (fun uu___5 -> @@ -644,9 +672,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (49)) + (Prims.of_int (53)) (Prims.of_int (69)) - (Prims.of_int (49)) + (Prims.of_int (53)) (Prims.of_int (89))))) (FStar_Sealed.seal (Obj.magic @@ -666,9 +694,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (49)) + (Prims.of_int (53)) (Prims.of_int (62)) - (Prims.of_int (49)) + (Prims.of_int (53)) (Prims.of_int (89))))) (FStar_Sealed.seal (Obj.magic @@ -689,14 +717,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (49)) (Prims.of_int (40)) - (Prims.of_int (49)) (Prims.of_int (90))))) + (Prims.of_int (53)) (Prims.of_int (40)) + (Prims.of_int (53)) (Prims.of_int (90))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (49)) (Prims.of_int (34)) - (Prims.of_int (49)) (Prims.of_int (90))))) + (Prims.of_int (53)) (Prims.of_int (34)) + (Prims.of_int (53)) (Prims.of_int (90))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -705,8 +733,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (49)) (Prims.of_int (34)) - (Prims.of_int (49)) (Prims.of_int (90))))) + (Prims.of_int (53)) (Prims.of_int (34)) + (Prims.of_int (53)) (Prims.of_int (90))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -726,14 +754,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (50)) (Prims.of_int (32)) - (Prims.of_int (50)) (Prims.of_int (58))))) + (Prims.of_int (54)) (Prims.of_int (32)) + (Prims.of_int (54)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (50)) (Prims.of_int (26)) - (Prims.of_int (50)) (Prims.of_int (58))))) + (Prims.of_int (54)) (Prims.of_int (26)) + (Prims.of_int (54)) (Prims.of_int (58))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -742,8 +770,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (50)) (Prims.of_int (26)) - (Prims.of_int (50)) (Prims.of_int (58))))) + (Prims.of_int (54)) (Prims.of_int (26)) + (Prims.of_int (54)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -765,14 +793,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (51)) (Prims.of_int (43)) - (Prims.of_int (51)) (Prims.of_int (61))))) + (Prims.of_int (55)) (Prims.of_int (43)) + (Prims.of_int (55)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (51)) (Prims.of_int (42)) - (Prims.of_int (51)) (Prims.of_int (92))))) + (Prims.of_int (55)) (Prims.of_int (42)) + (Prims.of_int (55)) (Prims.of_int (92))))) (Obj.magic uu___4) (fun uu___5 -> (fun uu___5 -> @@ -783,9 +811,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (51)) + (Prims.of_int (55)) (Prims.of_int (71)) - (Prims.of_int (51)) + (Prims.of_int (55)) (Prims.of_int (91))))) (FStar_Sealed.seal (Obj.magic @@ -805,9 +833,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (51)) + (Prims.of_int (55)) (Prims.of_int (64)) - (Prims.of_int (51)) + (Prims.of_int (55)) (Prims.of_int (91))))) (FStar_Sealed.seal (Obj.magic @@ -828,14 +856,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (51)) (Prims.of_int (42)) - (Prims.of_int (51)) (Prims.of_int (92))))) + (Prims.of_int (55)) (Prims.of_int (42)) + (Prims.of_int (55)) (Prims.of_int (92))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (51)) (Prims.of_int (36)) - (Prims.of_int (51)) (Prims.of_int (92))))) + (Prims.of_int (55)) (Prims.of_int (36)) + (Prims.of_int (55)) (Prims.of_int (92))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -844,8 +872,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (51)) (Prims.of_int (36)) - (Prims.of_int (51)) (Prims.of_int (92))))) + (Prims.of_int (55)) (Prims.of_int (36)) + (Prims.of_int (55)) (Prims.of_int (92))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -877,17 +905,17 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (56)) + (Prims.of_int (60)) (Prims.of_int (30)) - (Prims.of_int (56)) + (Prims.of_int (60)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (56)) + (Prims.of_int (60)) (Prims.of_int (30)) - (Prims.of_int (58)) + (Prims.of_int (62)) (Prims.of_int (51))))) (Obj.magic uu___7) (fun uu___8 -> @@ -900,17 +928,17 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (57)) + (Prims.of_int (61)) (Prims.of_int (30)) - (Prims.of_int (57)) + (Prims.of_int (61)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (57)) + (Prims.of_int (61)) (Prims.of_int (30)) - (Prims.of_int (58)) + (Prims.of_int (62)) (Prims.of_int (51))))) (Obj.magic uu___11) (fun uu___12 -> @@ -923,9 +951,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (58)) + (Prims.of_int (62)) (Prims.of_int (30)) - (Prims.of_int (58)) + (Prims.of_int (62)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -947,9 +975,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (57)) + (Prims.of_int (61)) (Prims.of_int (54)) - (Prims.of_int (58)) + (Prims.of_int (62)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -972,9 +1000,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (57)) + (Prims.of_int (61)) (Prims.of_int (30)) - (Prims.of_int (58)) + (Prims.of_int (62)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -995,9 +1023,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (56)) + (Prims.of_int (60)) (Prims.of_int (51)) - (Prims.of_int (58)) + (Prims.of_int (62)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -1018,9 +1046,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (56)) + (Prims.of_int (60)) (Prims.of_int (30)) - (Prims.of_int (58)) + (Prims.of_int (62)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -1038,8 +1066,8 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (55)) (Prims.of_int (52)) - (Prims.of_int (58)) (Prims.of_int (51))))) + (Prims.of_int (59)) (Prims.of_int (52)) + (Prims.of_int (62)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1056,14 +1084,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (55)) (Prims.of_int (29)) - (Prims.of_int (58)) (Prims.of_int (52))))) + (Prims.of_int (59)) (Prims.of_int (29)) + (Prims.of_int (62)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (55)) (Prims.of_int (23)) - (Prims.of_int (58)) (Prims.of_int (52))))) + (Prims.of_int (59)) (Prims.of_int (23)) + (Prims.of_int (62)) (Prims.of_int (52))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -1072,8 +1100,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (55)) (Prims.of_int (23)) - (Prims.of_int (58)) (Prims.of_int (52))))) + (Prims.of_int (59)) (Prims.of_int (23)) + (Prims.of_int (62)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1094,14 +1122,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (62)) (Prims.of_int (8)) - (Prims.of_int (62)) (Prims.of_int (28))))) + (Prims.of_int (66)) (Prims.of_int (8)) + (Prims.of_int (66)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (61)) (Prims.of_int (12)) - (Prims.of_int (66)) (Prims.of_int (35))))) + (Prims.of_int (65)) (Prims.of_int (12)) + (Prims.of_int (70)) (Prims.of_int (35))))) (Obj.magic uu___4) (fun uu___5 -> (fun uu___5 -> @@ -1114,17 +1142,17 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (64)) + (Prims.of_int (68)) (Prims.of_int (8)) - (Prims.of_int (64)) + (Prims.of_int (68)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (64)) + (Prims.of_int (68)) (Prims.of_int (8)) - (Prims.of_int (66)) + (Prims.of_int (70)) (Prims.of_int (34))))) (Obj.magic uu___8) (fun uu___9 -> @@ -1137,9 +1165,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (66)) + (Prims.of_int (70)) (Prims.of_int (8)) - (Prims.of_int (66)) + (Prims.of_int (70)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic @@ -1161,9 +1189,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (65)) + (Prims.of_int (69)) (Prims.of_int (8)) - (Prims.of_int (66)) + (Prims.of_int (70)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic @@ -1185,9 +1213,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (64)) + (Prims.of_int (68)) (Prims.of_int (8)) - (Prims.of_int (66)) + (Prims.of_int (70)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic @@ -1207,9 +1235,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (63)) + (Prims.of_int (67)) (Prims.of_int (8)) - (Prims.of_int (66)) + (Prims.of_int (70)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic @@ -1230,14 +1258,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (61)) (Prims.of_int (12)) - (Prims.of_int (66)) (Prims.of_int (35))))) + (Prims.of_int (65)) (Prims.of_int (12)) + (Prims.of_int (70)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (61)) (Prims.of_int (6)) - (Prims.of_int (66)) (Prims.of_int (35))))) + (Prims.of_int (65)) (Prims.of_int (6)) + (Prims.of_int (70)) (Prims.of_int (35))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -1246,8 +1274,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (61)) (Prims.of_int (6)) - (Prims.of_int (66)) (Prims.of_int (35))))) + (Prims.of_int (65)) (Prims.of_int (6)) + (Prims.of_int (70)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1268,14 +1296,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (67)) (Prims.of_int (58)) - (Prims.of_int (67)) (Prims.of_int (78))))) + (Prims.of_int (71)) (Prims.of_int (58)) + (Prims.of_int (71)) (Prims.of_int (78))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (67)) (Prims.of_int (57)) - (Prims.of_int (67)) (Prims.of_int (140))))) + (Prims.of_int (71)) (Prims.of_int (57)) + (Prims.of_int (71)) (Prims.of_int (140))))) (Obj.magic uu___5) (fun uu___6 -> (fun uu___6 -> @@ -1287,9 +1315,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (67)) + (Prims.of_int (71)) (Prims.of_int (88)) - (Prims.of_int (67)) + (Prims.of_int (71)) (Prims.of_int (108))))) (FStar_Sealed.seal (Obj.magic @@ -1312,9 +1340,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (67)) + (Prims.of_int (71)) (Prims.of_int (88)) - (Prims.of_int (67)) + (Prims.of_int (71)) (Prims.of_int (139))))) (FStar_Sealed.seal (Obj.magic @@ -1334,9 +1362,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (67)) + (Prims.of_int (71)) (Prims.of_int (81)) - (Prims.of_int (67)) + (Prims.of_int (71)) (Prims.of_int (139))))) (FStar_Sealed.seal (Obj.magic @@ -1357,14 +1385,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (67)) (Prims.of_int (57)) - (Prims.of_int (67)) (Prims.of_int (140))))) + (Prims.of_int (71)) (Prims.of_int (57)) + (Prims.of_int (71)) (Prims.of_int (140))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (67)) (Prims.of_int (51)) - (Prims.of_int (67)) (Prims.of_int (140))))) + (Prims.of_int (71)) (Prims.of_int (51)) + (Prims.of_int (71)) (Prims.of_int (140))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -1373,8 +1401,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (67)) (Prims.of_int (51)) - (Prims.of_int (67)) (Prims.of_int (140))))) + (Prims.of_int (71)) (Prims.of_int (51)) + (Prims.of_int (71)) (Prims.of_int (140))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1396,14 +1424,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (68)) (Prims.of_int (58)) - (Prims.of_int (68)) (Prims.of_int (78))))) + (Prims.of_int (72)) (Prims.of_int (58)) + (Prims.of_int (72)) (Prims.of_int (78))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (68)) (Prims.of_int (57)) - (Prims.of_int (68)) (Prims.of_int (140))))) + (Prims.of_int (72)) (Prims.of_int (57)) + (Prims.of_int (72)) (Prims.of_int (140))))) (Obj.magic uu___5) (fun uu___6 -> (fun uu___6 -> @@ -1415,9 +1443,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (68)) + (Prims.of_int (72)) (Prims.of_int (88)) - (Prims.of_int (68)) + (Prims.of_int (72)) (Prims.of_int (108))))) (FStar_Sealed.seal (Obj.magic @@ -1440,9 +1468,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (68)) + (Prims.of_int (72)) (Prims.of_int (88)) - (Prims.of_int (68)) + (Prims.of_int (72)) (Prims.of_int (139))))) (FStar_Sealed.seal (Obj.magic @@ -1462,9 +1490,9 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (68)) + (Prims.of_int (72)) (Prims.of_int (81)) - (Prims.of_int (68)) + (Prims.of_int (72)) (Prims.of_int (139))))) (FStar_Sealed.seal (Obj.magic @@ -1485,14 +1513,14 @@ let rec (term_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (68)) (Prims.of_int (57)) - (Prims.of_int (68)) (Prims.of_int (140))))) + (Prims.of_int (72)) (Prims.of_int (57)) + (Prims.of_int (72)) (Prims.of_int (140))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (68)) (Prims.of_int (51)) - (Prims.of_int (68)) (Prims.of_int (140))))) + (Prims.of_int (72)) (Prims.of_int (51)) + (Prims.of_int (72)) (Prims.of_int (140))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -1501,8 +1529,8 @@ let rec (term_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (68)) (Prims.of_int (51)) - (Prims.of_int (68)) (Prims.of_int (140))))) + (Prims.of_int (72)) (Prims.of_int (51)) + (Prims.of_int (72)) (Prims.of_int (140))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1550,9 +1578,9 @@ and (match_returns_to_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (76)) + (Prims.of_int (80)) (Prims.of_int (27)) - (Prims.of_int (76)) + (Prims.of_int (80)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic @@ -1571,12 +1599,12 @@ and (match_returns_to_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (74)) (Prims.of_int (4)) (Prims.of_int (76)) + (Prims.of_int (78)) (Prims.of_int (4)) (Prims.of_int (80)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (77)) (Prims.of_int (2)) (Prims.of_int (84)) + (Prims.of_int (81)) (Prims.of_int (2)) (Prims.of_int (88)) (Prims.of_int (78))))) (Obj.magic uu___) (fun uu___1 -> (fun tacopt_to_string -> @@ -1596,8 +1624,8 @@ and (match_returns_to_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (80)) (Prims.of_int (5)) - (Prims.of_int (80)) (Prims.of_int (23))))) + (Prims.of_int (84)) (Prims.of_int (5)) + (Prims.of_int (84)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1611,36 +1639,37 @@ and (match_returns_to_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (80)) (Prims.of_int (4)) - (Prims.of_int (80)) (Prims.of_int (30))))) + (Prims.of_int (84)) (Prims.of_int (4)) + (Prims.of_int (84)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (80)) (Prims.of_int (4)) - (Prims.of_int (84)) (Prims.of_int (78))))) + (Prims.of_int (84)) (Prims.of_int (4)) + (Prims.of_int (88)) (Prims.of_int (78))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> let uu___3 = match asc with - | (FStar_Pervasives.Inl t, tacopt, uu___4) -> + | (Fstarcompiler.FStar_Pervasives.Inl t, + tacopt, uu___4) -> let uu___5 = term_to_ast_string t in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (83)) + (Prims.of_int (87)) (Prims.of_int (27)) - (Prims.of_int (83)) + (Prims.of_int (87)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (83)) + (Prims.of_int (87)) (Prims.of_int (27)) - (Prims.of_int (83)) + (Prims.of_int (87)) (Prims.of_int (77))))) (Obj.magic uu___5) (fun uu___6 -> @@ -1653,9 +1682,9 @@ and (match_returns_to_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (83)) + (Prims.of_int (87)) (Prims.of_int (52)) - (Prims.of_int (83)) + (Prims.of_int (87)) (Prims.of_int (77))))) (FStar_Sealed.seal (Obj.magic @@ -1671,24 +1700,25 @@ and (match_returns_to_string : (fun uu___9 -> Prims.strcat uu___6 uu___8)))) uu___6) - | (FStar_Pervasives.Inr c, tacopt, uu___4) -> + | (Fstarcompiler.FStar_Pervasives.Inr c, + tacopt, uu___4) -> let uu___5 = comp_to_ast_string c in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (84)) + (Prims.of_int (88)) (Prims.of_int (27)) - (Prims.of_int (84)) + (Prims.of_int (88)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (84)) + (Prims.of_int (88)) (Prims.of_int (27)) - (Prims.of_int (84)) + (Prims.of_int (88)) (Prims.of_int (77))))) (Obj.magic uu___5) (fun uu___6 -> @@ -1701,9 +1731,9 @@ and (match_returns_to_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (84)) + (Prims.of_int (88)) (Prims.of_int (52)) - (Prims.of_int (84)) + (Prims.of_int (88)) (Prims.of_int (77))))) (FStar_Sealed.seal (Obj.magic @@ -1725,9 +1755,9 @@ and (match_returns_to_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (82)) + (Prims.of_int (86)) (Prims.of_int (4)) - (Prims.of_int (84)) + (Prims.of_int (88)) (Prims.of_int (78))))) (FStar_Sealed.seal (Obj.magic @@ -1757,12 +1787,12 @@ and (branch_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (90)) (Prims.of_int (13)) (Prims.of_int (90)) + (Prims.of_int (94)) (Prims.of_int (13)) (Prims.of_int (94)) (Prims.of_int (14))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (89)) (Prims.of_int (50)) (Prims.of_int (91)) + (Prims.of_int (93)) (Prims.of_int (50)) (Prims.of_int (95)) (Prims.of_int (41))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -1774,8 +1804,8 @@ and (branch_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (91)) (Prims.of_int (20)) - (Prims.of_int (91)) (Prims.of_int (40))))) + (Prims.of_int (95)) (Prims.of_int (20)) + (Prims.of_int (95)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1790,13 +1820,13 @@ and (branch_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (91)) (Prims.of_int (8)) - (Prims.of_int (91)) (Prims.of_int (41))))) + (Prims.of_int (95)) (Prims.of_int (8)) + (Prims.of_int (95)) (Prims.of_int (41))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (91)) (Prims.of_int (2)) - (Prims.of_int (91)) (Prims.of_int (41))))) + (Prims.of_int (95)) (Prims.of_int (2)) + (Prims.of_int (95)) (Prims.of_int (41))))) (Obj.magic uu___2) (fun uu___3 -> FStar_Tactics_Effect.lift_div_tac @@ -1813,8 +1843,8 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (95)) (Prims.of_int (26)) - (Prims.of_int (95)) (Prims.of_int (46))))) + (Prims.of_int (99)) (Prims.of_int (26)) + (Prims.of_int (99)) (Prims.of_int (46))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) @@ -1829,8 +1859,8 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (96)) (Prims.of_int (28)) - (Prims.of_int (96)) (Prims.of_int (48))))) + (Prims.of_int (100)) (Prims.of_int (28)) + (Prims.of_int (100)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) @@ -1846,13 +1876,13 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (97)) (Prims.of_int (37)) - (Prims.of_int (97)) (Prims.of_int (59))))) + (Prims.of_int (101)) (Prims.of_int (37)) + (Prims.of_int (101)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (97)) (Prims.of_int (37)) - (Prims.of_int (97)) (Prims.of_int (91))))) + (Prims.of_int (101)) (Prims.of_int (37)) + (Prims.of_int (101)) (Prims.of_int (91))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -1862,8 +1892,8 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (97)) (Prims.of_int (68)) - (Prims.of_int (97)) (Prims.of_int (91))))) + (Prims.of_int (101)) (Prims.of_int (68)) + (Prims.of_int (101)) (Prims.of_int (91))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1878,8 +1908,8 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (97)) (Prims.of_int (62)) - (Prims.of_int (97)) (Prims.of_int (91))))) + (Prims.of_int (101)) (Prims.of_int (62)) + (Prims.of_int (101)) (Prims.of_int (91))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1894,8 +1924,8 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (97)) (Prims.of_int (37)) - (Prims.of_int (97)) (Prims.of_int (91))))) + (Prims.of_int (101)) (Prims.of_int (37)) + (Prims.of_int (101)) (Prims.of_int (91))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) @@ -1912,13 +1942,13 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (21)) - (Prims.of_int (99)) (Prims.of_int (47))))) + (Prims.of_int (103)) (Prims.of_int (21)) + (Prims.of_int (103)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (21)) - (Prims.of_int (99)) (Prims.of_int (111))))) + (Prims.of_int (103)) (Prims.of_int (21)) + (Prims.of_int (103)) (Prims.of_int (111))))) (Obj.magic uu___4) (fun uu___5 -> (fun uu___5 -> @@ -1932,9 +1962,9 @@ and (comp_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) + (Prims.of_int (103)) (Prims.of_int (88)) - (Prims.of_int (99)) + (Prims.of_int (103)) (Prims.of_int (110))))) (FStar_Sealed.seal (Obj.magic @@ -1952,8 +1982,9 @@ and (comp_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (81)) - (Prims.of_int (99)) (Prims.of_int (110))))) + (Prims.of_int (103)) (Prims.of_int (81)) + (Prims.of_int (103)) + (Prims.of_int (110))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -1971,14 +2002,14 @@ and (comp_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (63)) - (Prims.of_int (99)) (Prims.of_int (111))))) + (Prims.of_int (103)) (Prims.of_int (63)) + (Prims.of_int (103)) (Prims.of_int (111))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (57)) - (Prims.of_int (99)) (Prims.of_int (111))))) + (Prims.of_int (103)) (Prims.of_int (57)) + (Prims.of_int (103)) (Prims.of_int (111))))) (Obj.magic uu___8) (fun uu___9 -> FStar_Tactics_Effect.lift_div_tac @@ -1987,8 +2018,8 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (57)) - (Prims.of_int (99)) (Prims.of_int (111))))) + (Prims.of_int (103)) (Prims.of_int (57)) + (Prims.of_int (103)) (Prims.of_int (111))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -2004,8 +2035,8 @@ and (comp_to_ast_string : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (50)) - (Prims.of_int (99)) (Prims.of_int (111))))) + (Prims.of_int (103)) (Prims.of_int (50)) + (Prims.of_int (103)) (Prims.of_int (111))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" @@ -2020,8 +2051,8 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (21)) - (Prims.of_int (99)) (Prims.of_int (111))))) + (Prims.of_int (103)) (Prims.of_int (21)) + (Prims.of_int (103)) (Prims.of_int (111))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) @@ -2034,8 +2065,8 @@ and (comp_to_ast_string : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.Print.fst" - (Prims.of_int (99)) (Prims.of_int (15)) - (Prims.of_int (99)) (Prims.of_int (111))))) + (Prims.of_int (103)) (Prims.of_int (15)) + (Prims.of_int (103)) (Prims.of_int (111))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) @@ -2069,88 +2100,100 @@ and (const_to_ast_string : | FStarC_Reflection_V2_Data.C_Real r -> Prims.strcat "C_Real \"" (Prims.strcat r "\"")))) uu___ let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.term_to_ast_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.term_to_ast_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 term_to_ast_string) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_string psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + term_to_ast_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.match_returns_to_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.match_returns_to_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 match_returns_to_string) - (FStarC_Syntax_Embeddings.e_option - (FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + match_returns_to_string) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 FStar_Tactics_NamedView.e_binder - (FStarC_Syntax_Embeddings.e_tuple3 - (FStarC_Syntax_Embeddings.e_either - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_comp_view) - (FStarC_Syntax_Embeddings.e_option - FStarC_Reflection_V2_Embeddings.e_term) - FStarC_Syntax_Embeddings.e_bool))) - FStarC_Syntax_Embeddings.e_string psc ncb us args) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple3 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_either + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + Fstarcompiler.FStarC_Syntax_Embeddings.e_bool))) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.branches_to_ast_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.branches_to_ast_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 branches_to_ast_string) - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + branches_to_ast_string) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 FStar_Tactics_NamedView.e_pattern - FStarC_Reflection_V2_Embeddings.e_term)) - FStarC_Syntax_Embeddings.e_string psc ncb us args) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term)) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.branch_to_ast_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.branch_to_ast_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 branch_to_ast_string) - (FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + branch_to_ast_string) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 FStar_Tactics_NamedView.e_pattern - FStarC_Reflection_V2_Embeddings.e_term) - FStarC_Syntax_Embeddings.e_string psc ncb us args) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.comp_to_ast_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.comp_to_ast_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 comp_to_ast_string) - FStarC_Reflection_V2_Embeddings.e_comp_view - FStarC_Syntax_Embeddings.e_string psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + comp_to_ast_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.Print.const_to_ast_string" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Print.const_to_ast_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 const_to_ast_string) - FStarC_Reflection_V2_Embeddings.e_vconst - FStarC_Syntax_Embeddings.e_string psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + const_to_ast_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_vconst + Fstarcompiler.FStarC_Syntax_Embeddings.e_string psc ncb us + args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_SMT.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_SMT.ml similarity index 87% rename from stage0/fstar-lib/generated/FStar_Tactics_SMT.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_SMT.ml index 80afcad9c98..f697db4f11e 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_SMT.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_SMT.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (smt_sync : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> @@ -16,17 +17,17 @@ let (smt_sync : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___2 -> Obj.magic (FStarC_Tactics_V2_Builtins.t_smt_sync uu___2)) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.smt_sync" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.smt_sync" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.smt_sync (plugin)" - (FStarC_Tactics_Native.from_tactic_1 smt_sync) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 smt_sync) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (smt_sync' : Prims.nat -> Prims.nat -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun fuel -> @@ -122,17 +123,18 @@ let (smt_sync' : (FStarC_Tactics_V2_Builtins.t_smt_sync vcfg')) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.smt_sync'" - (Prims.of_int (3)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.smt_sync'" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.SMT.smt_sync' (plugin)" - (FStarC_Tactics_Native.from_tactic_2 smt_sync') - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_int - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 smt_sync') + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (get_rlimit : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = FStarC_Tactics_V2_Builtins.get_vconfig () in @@ -150,17 +152,17 @@ let (get_rlimit : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> uu___2.FStarC_VConfig.z3rlimit)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.get_rlimit" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.get_rlimit" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.get_rlimit (plugin)" - (FStarC_Tactics_Native.from_tactic_1 get_rlimit) - FStarC_Syntax_Embeddings.e_unit FStarC_Syntax_Embeddings.e_int - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 get_rlimit) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_int psc ncb us args) let (set_rlimit : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun v -> let uu___ = @@ -241,17 +243,17 @@ let (set_rlimit : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___1 -> Obj.magic (FStarC_Tactics_V2_Builtins.set_vconfig uu___1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.set_rlimit" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.set_rlimit" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.set_rlimit (plugin)" - (FStarC_Tactics_Native.from_tactic_1 set_rlimit) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 set_rlimit) + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (get_initial_fuel : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> @@ -270,17 +272,18 @@ let (get_initial_fuel : FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> uu___2.FStarC_VConfig.initial_fuel)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.get_initial_fuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.get_initial_fuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.get_initial_fuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 get_initial_fuel) - FStarC_Syntax_Embeddings.e_unit FStarC_Syntax_Embeddings.e_int - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + get_initial_fuel) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_int psc ncb us args) let (get_initial_ifuel : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> @@ -299,17 +302,18 @@ let (get_initial_ifuel : FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> uu___2.FStarC_VConfig.initial_ifuel)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.get_initial_ifuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.get_initial_ifuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.get_initial_ifuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 get_initial_ifuel) - FStarC_Syntax_Embeddings.e_unit FStarC_Syntax_Embeddings.e_int - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + get_initial_ifuel) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_int psc ncb us args) let (get_max_fuel : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> @@ -328,17 +332,17 @@ let (get_max_fuel : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> uu___2.FStarC_VConfig.max_fuel)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.get_max_fuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.get_max_fuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.get_max_fuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 get_max_fuel) - FStarC_Syntax_Embeddings.e_unit FStarC_Syntax_Embeddings.e_int - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + get_max_fuel) Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_int psc ncb us args) let (get_max_ifuel : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> @@ -357,17 +361,18 @@ let (get_max_ifuel : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> uu___2.FStarC_VConfig.max_ifuel)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.get_max_ifuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.get_max_ifuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.get_max_ifuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 get_max_ifuel) - FStarC_Syntax_Embeddings.e_unit FStarC_Syntax_Embeddings.e_int - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + get_max_ifuel) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_int psc ncb us args) let (set_initial_fuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun v -> @@ -448,17 +453,18 @@ let (set_initial_fuel : (fun uu___1 -> Obj.magic (FStarC_Tactics_V2_Builtins.set_vconfig uu___1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.set_initial_fuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.set_initial_fuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.set_initial_fuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 set_initial_fuel) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + set_initial_fuel) + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (set_initial_ifuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun v -> @@ -539,17 +545,18 @@ let (set_initial_ifuel : (fun uu___1 -> Obj.magic (FStarC_Tactics_V2_Builtins.set_vconfig uu___1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.set_initial_ifuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.set_initial_ifuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.set_initial_ifuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 set_initial_ifuel) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + set_initial_ifuel) + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (set_max_fuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun v -> @@ -631,17 +638,17 @@ let (set_max_fuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) (fun uu___1 -> Obj.magic (FStarC_Tactics_V2_Builtins.set_vconfig uu___1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.set_max_fuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.set_max_fuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.set_max_fuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 set_max_fuel) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + set_max_fuel) Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (set_max_ifuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun v -> @@ -722,17 +729,17 @@ let (set_max_ifuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) (fun uu___1 -> Obj.magic (FStarC_Tactics_V2_Builtins.set_vconfig uu___1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.set_max_ifuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.set_max_ifuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.set_max_ifuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 set_max_ifuel) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + set_max_ifuel) Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (set_fuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun v -> let uu___ = @@ -812,17 +819,17 @@ let (set_fuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___1 -> Obj.magic (FStarC_Tactics_V2_Builtins.set_vconfig uu___1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.set_fuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.set_fuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.set_fuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 set_fuel) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 set_fuel) + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (set_ifuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun v -> let uu___ = @@ -901,14 +908,14 @@ let (set_ifuel : Prims.int -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (fun uu___1 -> Obj.magic (FStarC_Tactics_V2_Builtins.set_vconfig uu___1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.SMT.set_ifuel" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.SMT.set_ifuel" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.SMT.set_ifuel (plugin)" - (FStarC_Tactics_Native.from_tactic_1 set_ifuel) - FStarC_Syntax_Embeddings.e_int FStarC_Syntax_Embeddings.e_unit - psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 set_ifuel) + Fstarcompiler.FStarC_Syntax_Embeddings.e_int + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_TypeRepr.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_TypeRepr.ml similarity index 96% rename from stage0/fstar-lib/generated/FStar_Tactics_TypeRepr.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_TypeRepr.ml index 3b2719a8d7d..5e6d444e68b 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_TypeRepr.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_TypeRepr.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (empty_elim : Prims.empty -> unit -> Obj.t) = fun uu___1 -> @@ -113,43 +114,46 @@ let (get_inductive_typ : match se with | FStar_Pervasives_Native.None -> Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "ctors_of_typ: type not found")) + (FStar_Tactics_V2_Derived.fail + "ctors_of_typ: type not found") | FStar_Pervasives_Native.Some se1 -> + let uu___2 = + FStar_Tactics_NamedView.inspect_sigelt se1 in Obj.magic - (Obj.repr - (let uu___2 = - FStar_Tactics_NamedView.inspect_sigelt se1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.TypeRepr.fst" - (Prims.of_int (23)) - (Prims.of_int (14)) - (Prims.of_int (23)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.TypeRepr.fst" - (Prims.of_int (24)) - (Prims.of_int (4)) - (Prims.of_int (27)) - (Prims.of_int (48))))) - (Obj.magic uu___2) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (23)) + (Prims.of_int (14)) + (Prims.of_int (23)) + (Prims.of_int (31))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.TypeRepr.fst" + (Prims.of_int (24)) + (Prims.of_int (4)) + (Prims.of_int (27)) + (Prims.of_int (48))))) + (Obj.magic uu___2) + (fun uu___3 -> (fun sev -> if FStar_Tactics_NamedView.uu___is_Sg_Inductive sev then - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> sev) + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> sev))) else - FStar_Tactics_V2_Derived.fail - "ctors_of_typ: not an inductive type")))) - uu___2))) uu___1) + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "ctors_of_typ: not an inductive type"))) + uu___3))) uu___2))) uu___1) let (alg_ctor : FStarC_Reflection_Types.typ -> (FStarC_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) @@ -232,23 +236,25 @@ let (generate_repr_typ : FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> alternative_typ)))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.generate_repr_typ" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.TypeRepr.generate_repr_typ (plugin)" - (FStarC_Tactics_Native.from_tactic_2 generate_repr_typ) - (FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 + generate_repr_typ) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list FStar_Tactics_NamedView.e_binder) - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) - FStarC_Reflection_V2_Embeddings.e_term)) - FStarC_Reflection_V2_Embeddings.e_term psc ncb us args) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term)) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term psc ncb + us args) let (generate_down : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = FStarC_Tactics_V2_Builtins.intro () in @@ -458,17 +464,18 @@ let (generate_down : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = uu___6))) uu___5)) cases)) uu___3))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.generate_down" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.TypeRepr.generate_down (plugin)" - (FStarC_Tactics_Native.from_tactic_1 generate_down) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + generate_down) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let rec (get_apply_tuple : FStar_Tactics_NamedView.binding -> (FStar_Tactics_NamedView.binding Prims.list, unit) @@ -771,8 +778,10 @@ let rec (get_apply_tuple : (Prims.of_int (71))))) (Obj.magic uu___6) (fun uu___7 -> - FStar_Tactics_V2_Derived.fail - uu___7)))) + (fun uu___7 -> + Obj.magic + (FStar_Tactics_V2_Derived.fail + uu___7)) uu___7)))) | (FStar_Tactics_NamedView.Tv_FVar fv, b1::b2::[]) -> Obj.magic @@ -1017,8 +1026,10 @@ let rec (get_apply_tuple : (Prims.of_int (71))))) (Obj.magic uu___5) (fun uu___6 -> - FStar_Tactics_V2_Derived.fail - uu___6)))) + (fun uu___6 -> + Obj.magic + (FStar_Tactics_V2_Derived.fail + uu___6)) uu___6)))) | (FStar_Tactics_NamedView.Tv_FVar fv, []) -> Obj.magic (Obj.repr @@ -1079,8 +1090,10 @@ let rec (get_apply_tuple : (Prims.of_int (71))))) (Obj.magic uu___5) (fun uu___6 -> - FStar_Tactics_V2_Derived.fail - uu___6)))) + (fun uu___6 -> + Obj.magic + (FStar_Tactics_V2_Derived.fail + uu___6)) uu___6)))) | uu___4 -> Obj.magic (Obj.repr @@ -1131,8 +1144,11 @@ let rec (get_apply_tuple : (Prims.of_int (69))))) (Obj.magic uu___5) (fun uu___6 -> - FStar_Tactics_V2_Derived.fail - uu___6)))) uu___3))) uu___1) + (fun uu___6 -> + Obj.magic + (FStar_Tactics_V2_Derived.fail + uu___6)) uu___6)))) uu___3))) + uu___1) let rec (generate_up_aux : FStarC_Reflection_V2_Data.ctor Prims.list -> FStar_Tactics_NamedView.binding -> @@ -1190,11 +1206,14 @@ let rec (generate_up_aux : (Prims.of_int (2)) then Obj.magic - (FStar_Tactics_V2_Derived.fail - "generate_up_aux: expected Inl/Inr???") + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "generate_up_aux: expected Inl/Inr???")) else Obj.magic - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())) in + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> ()))) in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -1512,18 +1531,18 @@ let (generate_up : (fun b -> Obj.magic (generate_up_aux ctors b)) uu___8))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.generate_up" - (Prims.of_int (3)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.TypeRepr.generate_up" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.TypeRepr.generate_up (plugin)" - (FStarC_Tactics_Native.from_tactic_2 generate_up) - FStarC_Syntax_Embeddings.e_string - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 generate_up) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (make_implicits : FStar_Tactics_NamedView.binders -> FStar_Tactics_NamedView.binders) = fun bs -> @@ -2513,15 +2532,16 @@ let (entry : FStar_Tactics_NamedView.ctors = ctors;_} -> Obj.magic (generate_all nm1 params ctors)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.TypeRepr.entry" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.TypeRepr.entry" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.TypeRepr.entry (plugin)" - (FStarC_Tactics_Native.from_tactic_1 entry) - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_sigelt) psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 entry) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_sigelt) psc + ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Typeclasses.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Typeclasses.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Tactics_Typeclasses.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Typeclasses.ml index 5e5d511d1ff..8afe08e0fb2 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_Typeclasses.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Typeclasses.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (debug : (unit -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) -> @@ -416,15 +417,16 @@ let rec unembed_list : (Prims.of_int (17))))) (Obj.magic uu___3) (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - match uu___4 with - | (FStar_Pervasives_Native.Some hd1, - FStar_Pervasives_Native.Some tl1) - -> + match uu___4 with + | (FStar_Pervasives_Native.Some hd1, + FStar_Pervasives_Native.Some tl1) -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> FStar_Pervasives_Native.Some (hd1 - :: tl1) - | uu___6 -> + :: tl1)) + | uu___5 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___6 -> FStar_Pervasives_Native.None))) else Obj.repr @@ -833,30 +835,24 @@ let (trywith : Obj.magic (FStar_Tactics_V2_Derived.seq (fun uu___7 -> - (fun uu___7 - -> - if - (Prims.uu___is_Cons + if + (Prims.uu___is_Cons unresolved_args) && (FStar_Pervasives_Native.uu___is_None g.fundeps) - then - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Will not continue as there are unresolved args (and no fundeps)")) - else - Obj.magic - (Obj.repr - (if + then + FStar_Tactics_V2_Derived.fail + "Will not continue as there are unresolved args (and no fundeps)" + else + if (Prims.uu___is_Cons unresolved_args) && (FStar_Pervasives_Native.uu___is_Some g.fundeps) - then - let uu___9 + then + (let uu___9 = Obj.magic (FStar_Tactics_Effect.lift_div_tac @@ -979,21 +975,18 @@ let (trywith : all_good then Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.apply - t)) + t) else Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail - "fundeps"))) + "fundeps")) uu___14))) uu___12))) - uu___10) - else + uu___10)) + else FStar_Tactics_V2_Derived.apply_noinst - t))) - uu___7) + t) (fun uu___7 -> let uu___8 = debug @@ -2412,17 +2405,17 @@ let (tcresolve : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = uu___9))) uu___7))) uu___6))) uu___4))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.Typeclasses.tcresolve" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.Typeclasses.tcresolve" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Typeclasses.tcresolve (plugin)" - (FStarC_Tactics_Native.from_tactic_1 tcresolve) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 tcresolve) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let rec (mk_abs : FStar_Tactics_NamedView.binder Prims.list -> FStar_Tactics_NamedView.term -> @@ -2469,8 +2462,10 @@ let rec (mk_abs : (Prims.of_int (312)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" Prims.int_zero - Prims.int_zero Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.Typeclasses.fst" + (Prims.of_int (312)) (Prims.of_int (15)) + (Prims.of_int (312)) (Prims.of_int (47))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -4011,19 +4006,17 @@ let (mk_class : FStar_Pervasives_Native.None -> Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail - "mk_class: proj not found?")) + "mk_class: proj not found?") | FStar_Pervasives_Native.Some se1 -> - Obj.magic - (Obj.repr - (let uu___54 + let uu___54 = FStar_Tactics_NamedView.inspect_sigelt se1 in - FStar_Tactics_Effect.tac_bind + Obj.magic + (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range @@ -4059,18 +4052,16 @@ let (mk_class : = lbs;_} -> Obj.magic - (Obj.repr (FStar_Tactics_V2_SyntaxHelpers.lookup_lb lbs - proj_name)) + proj_name) | uu___56 -> Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail - "mk_class: proj not Sg_Let?"))) - uu___55)))) + "mk_class: proj not Sg_Let?")) + uu___55))) uu___53) in Obj.magic (FStar_Tactics_Effect.tac_bind @@ -4246,15 +4237,12 @@ let (mk_class : | [] -> Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail - "mk_class: impossible, no binders")) + "mk_class: impossible, no binders") | b1::bs' -> - Obj.magic - (Obj.repr - (let uu___59 + let uu___59 = Obj.magic (FStar_Tactics_Effect.lift_div_tac @@ -4263,7 +4251,8 @@ let (mk_class : -> binder_set_meta b1 tcr)) in - FStar_Tactics_Effect.tac_bind + Obj.magic + (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range @@ -4294,7 +4283,7 @@ let (mk_class : (b11 :: bs')) cod2)) - uu___60))))) + uu___60)))) uu___58))) uu___56) in Obj.magic @@ -4405,15 +4394,12 @@ let (mk_class : | [] -> Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail - "mk_class: impossible, no binders")) + "mk_class: impossible, no binders") | b1::bs' -> - Obj.magic - (Obj.repr - (let uu___60 + let uu___60 = Obj.magic (FStar_Tactics_Effect.lift_div_tac @@ -4422,7 +4408,8 @@ let (mk_class : -> binder_set_meta b1 tcr)) in - FStar_Tactics_Effect.tac_bind + Obj.magic + (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range @@ -4453,7 +4440,7 @@ let (mk_class : (b11 :: bs')) body)) - uu___61))))) + uu___61)))) uu___59))) uu___57) in Obj.magic @@ -4834,16 +4821,17 @@ let (mk_class : uu___7))) uu___5))) uu___3))) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.Typeclasses.mk_class" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.Typeclasses.mk_class" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.Typeclasses.mk_class (plugin)" - (FStarC_Tactics_Native.from_tactic_1 mk_class) - FStarC_Syntax_Embeddings.e_string - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_sigelt) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 mk_class) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_sigelt) psc + ncb us args) let solve : 'a . 'a -> 'a = fun ev -> ev \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Util.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Util.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Tactics_Util.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Util.ml index 9a8e66785f5..6f51df96a59 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_Util.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Util.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let rec map : 'a 'b . diff --git a/stage0/fstar-lib/generated/FStar_Tactics_V1_Derived.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Derived.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Tactics_V1_Derived.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Derived.ml index 2b98f67d299..9bfb467fcf9 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_V1_Derived.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Derived.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let op_At : 'uuuuu . @@ -199,8 +200,8 @@ let (cur_goal_safe : (Prims.of_int (80)) (Prims.of_int (3)) (Prims.of_int (81)) (Prims.of_int (16))))) (Obj.magic uu___1) (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> match uu___2 with | g::uu___4 -> g)) + match uu___2 with + | g::uu___3 -> FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> g)) let (cur_binders : unit -> (FStarC_Reflection_Types.binders, unit) FStar_Tactics_Effect.tac_repr) @@ -321,13 +322,13 @@ let (trivial : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = FStarC_Tactics_V1_Builtins.norm - [FStar_Pervasives.iota; - FStar_Pervasives.zeta; - FStar_Pervasives.reify_; - FStar_Pervasives.delta; - FStar_Pervasives.primops; - FStar_Pervasives.simplify; - FStar_Pervasives.unmeta] in + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta; + Fstarcompiler.FStar_Pervasives.reify_; + Fstarcompiler.FStar_Pervasives.delta; + Fstarcompiler.FStar_Pervasives.primops; + Fstarcompiler.FStar_Pervasives.simplify; + Fstarcompiler.FStar_Pervasives.unmeta] in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic @@ -2476,8 +2477,9 @@ let try_with : (fun uu___1 -> (fun uu___1 -> match uu___1 with - | FStar_Pervasives.Inl e -> Obj.magic (Obj.repr (h e)) - | FStar_Pervasives.Inr x -> + | Fstarcompiler.FStar_Pervasives.Inl e -> + Obj.magic (Obj.repr (h e)) + | Fstarcompiler.FStar_Pervasives.Inr x -> Obj.magic (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> x)))) @@ -2559,11 +2561,11 @@ let rec repeat : (fun uu___1 -> (fun uu___1 -> match uu___1 with - | FStar_Pervasives.Inl uu___2 -> + | Fstarcompiler.FStar_Pervasives.Inl uu___2 -> Obj.magic (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> []))) - | FStar_Pervasives.Inr x -> + | Fstarcompiler.FStar_Pervasives.Inr x -> Obj.magic (Obj.repr (let uu___2 = repeat t in @@ -2641,7 +2643,7 @@ let repeat' : (Prims.of_int (26))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (norm_term : - FStar_Pervasives.norm_step Prims.list -> + Fstarcompiler.FStar_Pervasives.norm_step Prims.list -> FStarC_Reflection_Types.term -> (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) = @@ -2957,21 +2959,22 @@ let (guards_to_smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = let (simpl : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStarC_Tactics_V1_Builtins.norm - [FStar_Pervasives.simplify; FStar_Pervasives.primops] + [Fstarcompiler.FStar_Pervasives.simplify; + Fstarcompiler.FStar_Pervasives.primops] let (whnf : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStarC_Tactics_V1_Builtins.norm - [FStar_Pervasives.weak; - FStar_Pervasives.hnf; - FStar_Pervasives.primops; - FStar_Pervasives.delta] + [Fstarcompiler.FStar_Pervasives.weak; + Fstarcompiler.FStar_Pervasives.hnf; + Fstarcompiler.FStar_Pervasives.primops; + Fstarcompiler.FStar_Pervasives.delta] let (compute : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStarC_Tactics_V1_Builtins.norm - [FStar_Pervasives.primops; - FStar_Pervasives.iota; - FStar_Pervasives.delta; - FStar_Pervasives.zeta] + [Fstarcompiler.FStar_Pervasives.primops; + Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.delta; + Fstarcompiler.FStar_Pervasives.zeta] let (intros : unit -> (FStarC_Reflection_Types.binder Prims.list, unit) @@ -3658,8 +3661,8 @@ let (unfold_def : (fun n -> Obj.magic (FStarC_Tactics_V1_Builtins.norm - [FStar_Pervasives.delta_fully [n]])) - uu___3))) + [Fstarcompiler.FStar_Pervasives.delta_fully + [n]])) uu___3))) | uu___2 -> Obj.magic (Obj.repr (fail "unfold_def: term is not a fv"))) uu___1) @@ -3825,21 +3828,22 @@ let (grewrite : (Prims.of_int (20))))) (Obj.magic uu___4) (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - match uu___5 with - | FStar_Reflection_V1_Formula.Comp - (FStar_Reflection_V1_Formula.Eq - uu___7, lhs, rhs) - -> - (match FStarC_Reflection_V1_Builtins.inspect_ln - lhs - with - | FStarC_Reflection_V1_Data.Tv_Uvar - (uu___8, uu___9) -> - true - | uu___8 -> false) - | uu___7 -> false)) in + match uu___5 with + | FStar_Reflection_V1_Formula.Comp + (FStar_Reflection_V1_Formula.Eq + uu___6, lhs, rhs) + -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> + match FStarC_Reflection_V1_Builtins.inspect_ln + lhs + with + | FStarC_Reflection_V1_Data.Tv_Uvar + (uu___8, uu___9) -> true + | uu___8 -> false) + | uu___6 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> false)) in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic @@ -4974,9 +4978,9 @@ let specialize : (fun uu___3 -> (fun uu___3 -> Obj.magic (exact uu___3)) uu___3)) (fun uu___1 -> FStarC_Tactics_V1_Builtins.norm - [FStar_Pervasives.delta_only l; - FStar_Pervasives.iota; - FStar_Pervasives.zeta]) + [Fstarcompiler.FStar_Pervasives.delta_only l; + Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta]) let (tlabel : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun l -> let uu___ = goals () in @@ -5464,7 +5468,7 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = Obj.magic ( FStarC_Tactics_V1_Builtins.norm - [FStar_Pervasives.iota])) + [Fstarcompiler.FStar_Pervasives.iota])) uu___9))) uu___8))) uu___7)))) uu___4))) uu___3)) diff --git a/stage0/fstar-lib/generated/FStar_Tactics_V1_Logic.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Logic.ml similarity index 89% rename from stage0/fstar-lib/generated/FStar_Tactics_V1_Logic.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Logic.ml index a33c6c2f840..588aa713076 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_V1_Logic.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Logic.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (cur_goal : unit -> (FStarC_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) @@ -89,17 +90,17 @@ let (l_revert : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = "Lemmas"; "revert_squash"]))))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.l_revert" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.l_revert" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.l_revert (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_revert) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 l_revert) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let rec (l_revert_all : FStarC_Reflection_Types.binders -> (unit, unit) FStar_Tactics_Effect.tac_repr) @@ -130,18 +131,19 @@ let rec (l_revert_all : (fun uu___2 -> Obj.magic (l_revert_all tl)) uu___2)))) uu___ let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.l_revert_all" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.l_revert_all" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.l_revert_all (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_revert_all) - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binder) - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + l_revert_all) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (forall_intro : unit -> (FStarC_Reflection_Types.binder, unit) FStar_Tactics_Effect.tac_repr) @@ -173,17 +175,18 @@ let (forall_intro : (fun uu___2 -> Obj.magic (FStarC_Tactics_V1_Builtins.intro ())) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.forall_intro" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.forall_intro" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.forall_intro (plugin)" - (FStarC_Tactics_Native.from_tactic_1 forall_intro) - FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + forall_intro) Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) let (forall_intro_as : Prims.string -> (FStarC_Reflection_Types.binder, unit) FStar_Tactics_Effect.tac_repr) @@ -215,34 +218,38 @@ let (forall_intro_as : (fun uu___1 -> Obj.magic (FStar_Tactics_V1_Derived.intro_as s)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.forall_intro_as" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.forall_intro_as (plugin)" - (FStarC_Tactics_Native.from_tactic_1 forall_intro_as) - FStarC_Syntax_Embeddings.e_string - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + forall_intro_as) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) let (forall_intros : unit -> (FStarC_Reflection_Types.binders, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V1_Derived.repeat1 forall_intro let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.forall_intros" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.forall_intros (plugin)" - (FStarC_Tactics_Native.from_tactic_1 forall_intros) - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binder) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + forall_intros) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder) psc + ncb us args) let (split : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V1_Derived.try_with @@ -264,17 +271,17 @@ let (split : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = Obj.magic (FStar_Tactics_V1_Derived.fail "Could not split goal")) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.split" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.split" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.split (plugin)" - (FStarC_Tactics_Native.from_tactic_1 split) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 split) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (implies_intro : unit -> (FStarC_Reflection_Types.binder, unit) FStar_Tactics_Effect.tac_repr) @@ -306,17 +313,19 @@ let (implies_intro : (fun uu___2 -> Obj.magic (FStarC_Tactics_V1_Builtins.intro ())) uu___2) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.implies_intro" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.implies_intro (plugin)" - (FStarC_Tactics_Native.from_tactic_1 implies_intro) - FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + implies_intro) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) let (implies_intro_as : Prims.string -> (FStarC_Reflection_Types.binder, unit) FStar_Tactics_Effect.tac_repr) @@ -348,68 +357,74 @@ let (implies_intro_as : (fun uu___1 -> Obj.magic (FStar_Tactics_V1_Derived.intro_as s)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.implies_intro_as" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.implies_intro_as (plugin)" - (FStarC_Tactics_Native.from_tactic_1 implies_intro_as) - FStarC_Syntax_Embeddings.e_string - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + implies_intro_as) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) let (implies_intros : unit -> (FStarC_Reflection_Types.binders, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V1_Derived.repeat1 implies_intro let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.implies_intros" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.implies_intros (plugin)" - (FStarC_Tactics_Native.from_tactic_1 implies_intros) - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binder) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + implies_intros) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder) psc + ncb us args) let (l_intro : unit -> (FStarC_Reflection_Types.binder, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V1_Derived.or_else forall_intro implies_intro let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.l_intro" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.l_intro" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.l_intro (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_intro) - FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 l_intro) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) let (l_intros : unit -> (FStarC_Reflection_Types.binder Prims.list, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V1_Derived.repeat l_intro let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.l_intros" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.l_intros" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.l_intros (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_intros) - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binder) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 l_intros) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder) psc + ncb us args) let (squash_intro : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V1_Derived.apply @@ -418,17 +433,17 @@ let (squash_intro : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStarC_Reflection_V2_Builtins.pack_fv ["FStar"; "Squash"; "return_squash"]))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.squash_intro" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.squash_intro" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.squash_intro (plugin)" - (FStarC_Tactics_Native.from_tactic_1 squash_intro) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + squash_intro) Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (l_exact : FStarC_Reflection_Types.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -453,17 +468,17 @@ let (l_exact : (fun uu___2 -> Obj.magic (FStar_Tactics_V1_Derived.exact t)) uu___2)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.l_exact" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.l_exact" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.l_exact (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_exact) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 l_exact) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (hyp : FStarC_Reflection_Types.binder -> (unit, unit) FStar_Tactics_Effect.tac_repr) @@ -483,17 +498,17 @@ let (hyp : (Prims.of_int (58))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> Obj.magic (l_exact uu___1)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.hyp" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.hyp" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.hyp (plugin)" - (FStarC_Tactics_Native.from_tactic_1 hyp) - FStarC_Reflection_V2_Embeddings.e_binder - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 hyp) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (pose_lemma : FStarC_Reflection_Types.term -> (FStarC_Reflection_Types.binder, unit) FStar_Tactics_Effect.tac_repr) @@ -983,17 +998,18 @@ let (pose_lemma : uu___6))) uu___5))) uu___4))) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.pose_lemma" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.pose_lemma" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.pose_lemma (plugin)" - (FStarC_Tactics_Native.from_tactic_1 pose_lemma) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 pose_lemma) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) let (explode : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = @@ -1045,17 +1061,17 @@ let (explode : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Prims.of_int (64))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.explode" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.explode" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.explode (plugin)" - (FStarC_Tactics_Native.from_tactic_1 explode) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 explode) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let rec (visit : (unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> (unit, unit) FStar_Tactics_Effect.tac_repr) @@ -1321,32 +1337,34 @@ let rec (simplify_eq_implication : uu___6)))) uu___4))) uu___3))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.simplify_eq_implication" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.simplify_eq_implication (plugin)" - (FStarC_Tactics_Native.from_tactic_1 simplify_eq_implication) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + simplify_eq_implication) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (rewrite_all_equalities : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> visit simplify_eq_implication let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.rewrite_all_equalities" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.rewrite_all_equalities (plugin)" - (FStarC_Tactics_Native.from_tactic_1 rewrite_all_equalities) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + rewrite_all_equalities) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let rec (unfold_definition_and_simplify_eq : FStarC_Reflection_Types.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1522,19 +1540,19 @@ let rec (unfold_definition_and_simplify_eq : uu___7)))) uu___5)))) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.unfold_definition_and_simplify_eq" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.unfold_definition_and_simplify_eq (plugin)" - (FStarC_Tactics_Native.from_tactic_1 + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 unfold_definition_and_simplify_eq) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (unsquash : FStarC_Reflection_Types.term -> (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) @@ -1603,17 +1621,18 @@ let (unsquash : (FStar_Reflection_V1_Derived.bv_of_binder b)))))) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.unsquash" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.unsquash" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.unsquash (plugin)" - (FStarC_Tactics_Native.from_tactic_1 unsquash) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 unsquash) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term psc ncb + us args) let (cases_or : FStarC_Reflection_Types.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1626,17 +1645,17 @@ let (cases_or : ["FStar"; "Tactics"; "V1"; "Logic"; "Lemmas"; "or_ind"]))) [o]) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.cases_or" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.cases_or" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.cases_or (plugin)" - (FStarC_Tactics_Native.from_tactic_1 cases_or) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 cases_or) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (cases_bool : FStarC_Reflection_Types.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1741,17 +1760,17 @@ let (cases_bool : FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> ()))))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.cases_bool" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.cases_bool" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.cases_bool (plugin)" - (FStarC_Tactics_Native.from_tactic_1 cases_bool) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 cases_bool) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (left : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V1_Derived.apply_lemma @@ -1760,17 +1779,17 @@ let (left : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStarC_Reflection_V2_Builtins.pack_fv ["FStar"; "Tactics"; "V1"; "Logic"; "Lemmas"; "or_intro_1"]))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.left" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.left" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.left (plugin)" - (FStarC_Tactics_Native.from_tactic_1 left) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 left) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (right : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V1_Derived.apply_lemma @@ -1779,17 +1798,17 @@ let (right : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStarC_Reflection_V2_Builtins.pack_fv ["FStar"; "Tactics"; "V1"; "Logic"; "Lemmas"; "or_intro_2"]))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.right" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.right" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.right (plugin)" - (FStarC_Tactics_Native.from_tactic_1 right) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 right) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (and_elim : FStarC_Reflection_Types.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1826,17 +1845,17 @@ let (and_elim : "__and_elim'"]))), (t, FStarC_Reflection_V2_Data.Q_Explicit))))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.and_elim" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.and_elim" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.and_elim (plugin)" - (FStarC_Tactics_Native.from_tactic_1 and_elim) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 and_elim) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (destruct_and : FStarC_Reflection_Types.term -> ((FStarC_Reflection_Types.binder * FStarC_Reflection_Types.binder), @@ -1894,19 +1913,21 @@ let (destruct_and : (fun uu___6 -> (uu___3, uu___5))))) uu___3))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.destruct_and" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.destruct_and" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.destruct_and (plugin)" - (FStarC_Tactics_Native.from_tactic_1 destruct_and) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_binder - FStarC_Reflection_V2_Embeddings.e_binder) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + destruct_and) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder) psc + ncb us args) let (witness : FStarC_Reflection_Types.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1931,17 +1952,17 @@ let (witness : (fun uu___1 -> (fun uu___1 -> Obj.magic (FStar_Tactics_V1_Derived.exact t)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.witness" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.witness" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.witness (plugin)" - (FStarC_Tactics_Native.from_tactic_1 witness) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 witness) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (elim_exists : FStarC_Reflection_Types.term -> ((FStarC_Reflection_Types.binder * FStarC_Reflection_Types.binder), @@ -2011,19 +2032,20 @@ let (elim_exists : FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> (x, pf))))) uu___3))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.elim_exists" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.elim_exists" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.elim_exists (plugin)" - (FStarC_Tactics_Native.from_tactic_1 elim_exists) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_binder - FStarC_Reflection_V2_Embeddings.e_binder) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 elim_exists) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder) psc + ncb us args) let (instantiate : FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> @@ -2079,18 +2101,19 @@ let (instantiate : (FStar_Tactics_V1_Derived.fail "could not instantiate")) uu___1)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.instantiate" - (Prims.of_int (3)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.instantiate" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.V1.Logic.instantiate (plugin)" - (FStarC_Tactics_Native.from_tactic_2 instantiate) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 instantiate) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) let (instantiate_as : FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> @@ -2117,19 +2140,21 @@ let (instantiate_as : (fun b -> Obj.magic (FStarC_Tactics_V1_Builtins.rename_to b s)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.instantiate_as" (Prims.of_int (4)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 "FStar.Tactics.V1.Logic.instantiate_as (plugin)" - (FStarC_Tactics_Native.from_tactic_3 instantiate_as) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_string - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_3 + instantiate_as) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) let rec (sk_binder' : FStarC_Reflection_Types.binders -> FStarC_Reflection_Types.binder -> @@ -2413,22 +2438,22 @@ let (skolem : (fun uu___2 -> (fun bs -> Obj.magic (FStar_Tactics_Util.map sk_binder bs)) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.skolem" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.skolem" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.skolem (plugin)" - (FStarC_Tactics_Native.from_tactic_1 skolem) - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binder) - FStarC_Reflection_V2_Embeddings.e_binder)) psc ncb us - args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 skolem) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder)) + psc ncb us args) let (easy_fill : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = @@ -2494,48 +2519,53 @@ let (easy_fill : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = Obj.magic (FStar_Tactics_V1_Derived.smt ())) uu___4))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.easy_fill" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.easy_fill" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.easy_fill (plugin)" - (FStarC_Tactics_Native.from_tactic_1 easy_fill) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 easy_fill) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let easy : 'a . 'a -> 'a = fun x -> x let _ = - FStarC_Tactics_Native.register_plugin "FStar.Tactics.V1.Logic.easy" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Tactics.V1.Logic.easy" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.V1.Logic.easy" (fun _ -> match args with | (tv_0, _)::args_tail -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_1 - (FStarC_Syntax_Embeddings.mk_any_emb tv_0) - (FStarC_Syntax_Embeddings.mk_any_emb tv_0) easy - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_1 + (Fstarcompiler.FStarC_Syntax_Embeddings.mk_any_emb + tv_0) + (Fstarcompiler.FStarC_Syntax_Embeddings.mk_any_emb + tv_0) easy + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.V1.Logic.easy") cb us) args_tail | _ -> failwith "arity mismatch")) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.V1.Logic.easy" + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap + "FStar.Tactics.V1.Logic.easy" (fun _ -> match args with | (tv_0, _)::args_tail -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 - (FStarC_TypeChecker_NBETerm.mk_any_emb tv_0) - (FStarC_TypeChecker_NBETerm.mk_any_emb tv_0) easy - (FStarC_Ident.lid_of_str "FStar.Tactics.V1.Logic.easy") - cb us) args_tail + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 + (Fstarcompiler.FStarC_TypeChecker_NBETerm.mk_any_emb + tv_0) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.mk_any_emb + tv_0) easy + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.V1.Logic.easy") cb us) args_tail | _ -> failwith "arity mismatch")) let (using_lemma : FStarC_Reflection_Types.term -> @@ -2601,14 +2631,15 @@ let (using_lemma : (FStar_Tactics_V1_Derived.fail "using_lemma: failed to instantiate")) uu___2))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V1.Logic.using_lemma" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V1.Logic.using_lemma" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V1.Logic.using_lemma (plugin)" - (FStarC_Tactics_Native.from_tactic_1 using_lemma) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_binder psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 using_lemma) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binder psc ncb + us args) \ No newline at end of file diff --git a/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Logic_Lemmas.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Logic_Lemmas.ml new file mode 100644 index 00000000000..8c63d712f3f --- /dev/null +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_Logic_Lemmas.ml @@ -0,0 +1,2 @@ +open Fstarcompiler +open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_V1_SyntaxHelpers.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_SyntaxHelpers.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Tactics_V1_SyntaxHelpers.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_SyntaxHelpers.ml index 5864df15e4e..911a3371a2b 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_V1_SyntaxHelpers.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V1_SyntaxHelpers.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let rec (collect_arr' : FStarC_Reflection_Types.binder Prims.list -> diff --git a/stage0/fstar-lib/generated/FStar_Tactics_V2_Derived.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_Derived.ml similarity index 80% rename from stage0/fstar-lib/generated/FStar_Tactics_V2_Derived.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_Derived.ml index e28d77e7458..f5a879264a7 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_V2_Derived.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_Derived.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let op_At : 'uuuuu . @@ -186,15 +187,69 @@ let (smt_goals : (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> FStarC_Tactics_Types.smt_goals_of uu___2)) +let map_optRO : + 'a 'b . + ('a -> ('b, unit) FStar_Tactics_Effect.tac_repr) -> + 'a FStar_Pervasives_Native.option -> + ('b FStar_Pervasives_Native.option, unit) + FStar_Tactics_Effect.tac_repr + = + fun uu___1 -> + fun uu___ -> + (fun f -> + fun x -> + match x with + | FStar_Pervasives_Native.None -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___ -> FStar_Pervasives_Native.None))) + | FStar_Pervasives_Native.Some x1 -> + Obj.magic + (Obj.repr + (let uu___ = f x1 in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (70)) (Prims.of_int (19)) + (Prims.of_int (70)) (Prims.of_int (24))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (70)) (Prims.of_int (14)) + (Prims.of_int (70)) (Prims.of_int (24))))) + (Obj.magic uu___) + (fun uu___1 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___2 -> + FStar_Pervasives_Native.Some uu___1))))) + uu___1 uu___ let fail_doc_at : 'a . FStarC_Errors_Msg.error_message -> FStar_Range.range FStar_Pervasives_Native.option -> - ('a, Obj.t) FStar_Tactics_Effect.tac_repr + ('a, unit) FStar_Tactics_Effect.tac_repr = fun m -> fun r -> - FStar_Tactics_Effect.raise (FStarC_Tactics_Common.TacticFailure (m, r)) + let uu___ = map_optRO FStarC_Tactics_V2_Builtins.fixup_range r in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (74)) (Prims.of_int (12)) (Prims.of_int (74)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (75)) (Prims.of_int (4)) (Prims.of_int (75)) + (Prims.of_int (35))))) (Obj.magic uu___) + (fun r1 -> + FStar_Tactics_Effect.raise + (FStarC_Tactics_Common.TacticFailure (m, r1))) let fail_doc : 'a . FStarC_Errors_Msg.error_message -> @@ -207,9 +262,9 @@ let fail_at : 'a . Prims.string -> FStar_Range.range FStar_Pervasives_Native.option -> - ('a, Obj.t) FStar_Tactics_Effect.tac_repr + ('a, unit) FStar_Tactics_Effect.tac_repr = fun m -> fun r -> fail_doc_at (FStarC_Errors_Msg.mkmsg m) r -let fail : 'a . Prims.string -> ('a, Obj.t) FStar_Tactics_Effect.tac_repr = +let fail : 'a . Prims.string -> ('a, unit) FStar_Tactics_Effect.tac_repr = fun m -> fail_at m FStar_Pervasives_Native.None let fail_silently_doc : 'a . @@ -222,12 +277,12 @@ let fail_silently_doc : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (84)) (Prims.of_int (4)) (Prims.of_int (84)) + (Prims.of_int (91)) (Prims.of_int (4)) (Prims.of_int (91)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (85)) (Prims.of_int (4)) (Prims.of_int (85)) + (Prims.of_int (92)) (Prims.of_int (4)) (Prims.of_int (92)) (Prims.of_int (38))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.raise @@ -244,17 +299,22 @@ let (_cur_goal : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (93)) (Prims.of_int (10)) (Prims.of_int (93)) + (Prims.of_int (100)) (Prims.of_int (10)) (Prims.of_int (100)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (93)) (Prims.of_int (4)) (Prims.of_int (95)) + (Prims.of_int (100)) (Prims.of_int (4)) (Prims.of_int (102)) (Prims.of_int (15))))) (Obj.magic uu___1) (fun uu___2 -> - match uu___2 with - | [] -> fail "no more goals" - | g::uu___3 -> FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> g)) + (fun uu___2 -> + match uu___2 with + | [] -> Obj.magic (Obj.repr (fail "no more goals")) + | g::uu___3 -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> g)))) + uu___2) let (cur_env : unit -> (FStarC_Reflection_Types.env, unit) FStar_Tactics_Effect.tac_repr) = @@ -264,12 +324,12 @@ let (cur_env : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (98)) (Prims.of_int (36)) (Prims.of_int (98)) + (Prims.of_int (105)) (Prims.of_int (36)) (Prims.of_int (105)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (98)) (Prims.of_int (27)) (Prims.of_int (98)) + (Prims.of_int (105)) (Prims.of_int (27)) (Prims.of_int (105)) (Prims.of_int (50))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -283,12 +343,12 @@ let (cur_goal : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (101)) (Prims.of_int (38)) (Prims.of_int (101)) + (Prims.of_int (108)) (Prims.of_int (38)) (Prims.of_int (108)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (101)) (Prims.of_int (28)) (Prims.of_int (101)) + (Prims.of_int (108)) (Prims.of_int (28)) (Prims.of_int (108)) (Prims.of_int (52))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -302,12 +362,12 @@ let (cur_witness : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (104)) (Prims.of_int (45)) (Prims.of_int (104)) + (Prims.of_int (111)) (Prims.of_int (45)) (Prims.of_int (111)) (Prims.of_int (59))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (104)) (Prims.of_int (32)) (Prims.of_int (104)) + (Prims.of_int (111)) (Prims.of_int (32)) (Prims.of_int (111)) (Prims.of_int (59))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -321,12 +381,12 @@ let (cur_goal_safe : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (111)) (Prims.of_int (18)) - (Prims.of_int (111)) (Prims.of_int (26))))) + (Prims.of_int (118)) (Prims.of_int (18)) + (Prims.of_int (118)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (111)) (Prims.of_int (9)) (Prims.of_int (111)) + (Prims.of_int (118)) (Prims.of_int (9)) (Prims.of_int (118)) (Prims.of_int (26))))) (Obj.magic uu___2) (fun uu___3 -> FStar_Tactics_Effect.lift_div_tac @@ -335,16 +395,16 @@ let (cur_goal_safe : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (111)) (Prims.of_int (9)) (Prims.of_int (111)) + (Prims.of_int (118)) (Prims.of_int (9)) (Prims.of_int (118)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (111)) (Prims.of_int (3)) (Prims.of_int (112)) + (Prims.of_int (118)) (Prims.of_int (3)) (Prims.of_int (119)) (Prims.of_int (16))))) (Obj.magic uu___1) (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> match uu___2 with | g::uu___4 -> g)) + match uu___2 with + | g::uu___3 -> FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> g)) let (cur_vars : unit -> (FStar_Tactics_NamedView.binding Prims.list, unit) @@ -356,12 +416,12 @@ let (cur_vars : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (115)) (Prims.of_int (16)) (Prims.of_int (115)) + (Prims.of_int (122)) (Prims.of_int (16)) (Prims.of_int (122)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (115)) (Prims.of_int (4)) (Prims.of_int (115)) + (Prims.of_int (122)) (Prims.of_int (4)) (Prims.of_int (122)) (Prims.of_int (28))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -379,12 +439,12 @@ let with_policy : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (119)) (Prims.of_int (18)) - (Prims.of_int (119)) (Prims.of_int (37))))) + (Prims.of_int (126)) (Prims.of_int (18)) + (Prims.of_int (126)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (120)) (Prims.of_int (4)) (Prims.of_int (123)) + (Prims.of_int (127)) (Prims.of_int (4)) (Prims.of_int (130)) (Prims.of_int (5))))) (Obj.magic uu___) (fun uu___1 -> (fun old_pol -> @@ -394,13 +454,13 @@ let with_policy : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (120)) (Prims.of_int (4)) - (Prims.of_int (120)) (Prims.of_int (24))))) + (Prims.of_int (127)) (Prims.of_int (4)) + (Prims.of_int (127)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (120)) (Prims.of_int (25)) - (Prims.of_int (123)) (Prims.of_int (5))))) + (Prims.of_int (127)) (Prims.of_int (25)) + (Prims.of_int (130)) (Prims.of_int (5))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -411,17 +471,17 @@ let with_policy : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (121)) + (Prims.of_int (128)) (Prims.of_int (12)) - (Prims.of_int (121)) + (Prims.of_int (128)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (122)) + (Prims.of_int (129)) (Prims.of_int (4)) - (Prims.of_int (123)) + (Prims.of_int (130)) (Prims.of_int (5))))) (Obj.magic uu___3) (fun uu___4 -> @@ -435,17 +495,17 @@ let with_policy : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (122)) + (Prims.of_int (129)) (Prims.of_int (4)) - (Prims.of_int (122)) + (Prims.of_int (129)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (121)) + (Prims.of_int (128)) (Prims.of_int (8)) - (Prims.of_int (121)) + (Prims.of_int (128)) (Prims.of_int (9))))) (Obj.magic uu___4) (fun uu___5 -> @@ -468,23 +528,23 @@ let (trivial : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.iota; - FStar_Pervasives.zeta; - FStar_Pervasives.reify_; - FStar_Pervasives.delta; - FStar_Pervasives.primops; - FStar_Pervasives.simplify; - FStar_Pervasives.unmeta] in + [Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta; + Fstarcompiler.FStar_Pervasives.reify_; + Fstarcompiler.FStar_Pervasives.delta; + Fstarcompiler.FStar_Pervasives.primops; + Fstarcompiler.FStar_Pervasives.simplify; + Fstarcompiler.FStar_Pervasives.unmeta] in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (137)) (Prims.of_int (2)) (Prims.of_int (137)) + (Prims.of_int (144)) (Prims.of_int (2)) (Prims.of_int (144)) (Prims.of_int (61))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (137)) (Prims.of_int (62)) (Prims.of_int (141)) + (Prims.of_int (144)) (Prims.of_int (62)) (Prims.of_int (148)) (Prims.of_int (31))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -494,13 +554,13 @@ let (trivial : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (138)) (Prims.of_int (10)) - (Prims.of_int (138)) (Prims.of_int (21))))) + (Prims.of_int (145)) (Prims.of_int (10)) + (Prims.of_int (145)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (139)) (Prims.of_int (2)) - (Prims.of_int (141)) (Prims.of_int (31))))) + (Prims.of_int (146)) (Prims.of_int (2)) + (Prims.of_int (148)) (Prims.of_int (31))))) (Obj.magic uu___3) (fun uu___4 -> (fun g -> @@ -512,14 +572,14 @@ let (trivial : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (139)) (Prims.of_int (8)) - (Prims.of_int (139)) (Prims.of_int (25))))) + (Prims.of_int (146)) (Prims.of_int (8)) + (Prims.of_int (146)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (139)) (Prims.of_int (2)) - (Prims.of_int (141)) (Prims.of_int (31))))) + (Prims.of_int (146)) (Prims.of_int (2)) + (Prims.of_int (148)) (Prims.of_int (31))))) (Obj.magic uu___4) (fun uu___5 -> (fun uu___5 -> @@ -544,21 +604,19 @@ let (dismiss : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (153)) (Prims.of_int (10)) (Prims.of_int (153)) + (Prims.of_int (160)) (Prims.of_int (10)) (Prims.of_int (160)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (153)) (Prims.of_int (4)) (Prims.of_int (155)) + (Prims.of_int (160)) (Prims.of_int (4)) (Prims.of_int (162)) (Prims.of_int (27))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> match uu___2 with - | [] -> Obj.magic (Obj.repr (fail "dismiss: no more goals")) + | [] -> Obj.magic (fail "dismiss: no more goals") | uu___3::gs -> - Obj.magic - (Obj.repr (FStarC_Tactics_V2_Builtins.set_goals gs))) - uu___2) + Obj.magic (FStarC_Tactics_V2_Builtins.set_goals gs)) uu___2) let (flip : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = goals () in @@ -566,12 +624,12 @@ let (flip : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (159)) (Prims.of_int (13)) (Prims.of_int (159)) + (Prims.of_int (166)) (Prims.of_int (13)) (Prims.of_int (166)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (160)) (Prims.of_int (4)) (Prims.of_int (162)) + (Prims.of_int (167)) (Prims.of_int (4)) (Prims.of_int (169)) (Prims.of_int (42))))) (Obj.magic uu___1) (fun uu___2 -> (fun gs -> @@ -581,28 +639,24 @@ let (flip : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (160)) (Prims.of_int (10)) - (Prims.of_int (160)) (Prims.of_int (18))))) + (Prims.of_int (167)) (Prims.of_int (10)) + (Prims.of_int (167)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (160)) (Prims.of_int (4)) - (Prims.of_int (162)) (Prims.of_int (42))))) + (Prims.of_int (167)) (Prims.of_int (4)) + (Prims.of_int (169)) (Prims.of_int (42))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> match uu___3 with - | [] -> - Obj.magic - (Obj.repr (fail "flip: less than two goals")) + | [] -> Obj.magic (fail "flip: less than two goals") | uu___4::[] -> - Obj.magic - (Obj.repr (fail "flip: less than two goals")) + Obj.magic (fail "flip: less than two goals") | g1::g2::gs1 -> Obj.magic - (Obj.repr - (FStarC_Tactics_V2_Builtins.set_goals (g2 :: - g1 :: gs1)))) uu___3))) uu___2) + (FStarC_Tactics_V2_Builtins.set_goals (g2 :: g1 + :: gs1))) uu___3))) uu___2) let (qed : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = goals () in @@ -610,17 +664,21 @@ let (qed : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (166)) (Prims.of_int (10)) (Prims.of_int (166)) + (Prims.of_int (173)) (Prims.of_int (10)) (Prims.of_int (173)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (166)) (Prims.of_int (4)) (Prims.of_int (168)) + (Prims.of_int (173)) (Prims.of_int (4)) (Prims.of_int (175)) (Prims.of_int (32))))) (Obj.magic uu___1) (fun uu___2 -> - match uu___2 with - | [] -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ()) - | uu___3 -> fail "qed: not done!") + (fun uu___2 -> + match uu___2 with + | [] -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ()))) + | uu___3 -> Obj.magic (Obj.repr (fail "qed: not done!"))) uu___2) let (debug : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun m -> let uu___ = FStarC_Tactics_V2_Builtins.debugging () in @@ -628,12 +686,12 @@ let (debug : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (173)) (Prims.of_int (7)) (Prims.of_int (173)) + (Prims.of_int (180)) (Prims.of_int (7)) (Prims.of_int (180)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (173)) (Prims.of_int (4)) (Prims.of_int (173)) + (Prims.of_int (180)) (Prims.of_int (4)) (Prims.of_int (180)) (Prims.of_int (32))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -652,13 +710,13 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (180)) (Prims.of_int (10)) - (Prims.of_int (180)) (Prims.of_int (18))))) + (Prims.of_int (187)) (Prims.of_int (10)) + (Prims.of_int (187)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (180)) (Prims.of_int (10)) - (Prims.of_int (180)) (Prims.of_int (32))))) + (Prims.of_int (187)) (Prims.of_int (10)) + (Prims.of_int (187)) (Prims.of_int (32))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -668,13 +726,13 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (180)) (Prims.of_int (20)) - (Prims.of_int (180)) (Prims.of_int (32))))) + (Prims.of_int (187)) (Prims.of_int (20)) + (Prims.of_int (187)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (180)) (Prims.of_int (10)) - (Prims.of_int (180)) (Prims.of_int (32))))) + (Prims.of_int (187)) (Prims.of_int (10)) + (Prims.of_int (187)) (Prims.of_int (32))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -683,41 +741,39 @@ let (smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (180)) (Prims.of_int (10)) (Prims.of_int (180)) + (Prims.of_int (187)) (Prims.of_int (10)) (Prims.of_int (187)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (180)) (Prims.of_int (4)) (Prims.of_int (186)) + (Prims.of_int (187)) (Prims.of_int (4)) (Prims.of_int (193)) (Prims.of_int (11))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> match uu___2 with - | ([], uu___3) -> - Obj.magic (Obj.repr (fail "smt: no active goals")) + | ([], uu___3) -> Obj.magic (fail "smt: no active goals") | (g::gs, gs') -> + let uu___3 = FStarC_Tactics_V2_Builtins.set_goals gs in Obj.magic - (Obj.repr - (let uu___3 = FStarC_Tactics_V2_Builtins.set_goals gs in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (184)) (Prims.of_int (8)) - (Prims.of_int (184)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (185)) (Prims.of_int (8)) - (Prims.of_int (185)) (Prims.of_int (32))))) - (Obj.magic uu___3) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (191)) (Prims.of_int (8)) + (Prims.of_int (191)) (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (192)) (Prims.of_int (8)) + (Prims.of_int (192)) (Prims.of_int (32))))) + (Obj.magic uu___3) + (fun uu___4 -> (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStarC_Tactics_V2_Builtins.set_smt_goals (g - :: gs'))) uu___4)))) uu___2) + Obj.magic + (FStarC_Tactics_V2_Builtins.set_smt_goals (g :: + gs'))) uu___4))) uu___2) let (idtac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> (fun uu___ -> @@ -730,22 +786,20 @@ let (later : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (192)) (Prims.of_int (10)) (Prims.of_int (192)) + (Prims.of_int (199)) (Prims.of_int (10)) (Prims.of_int (199)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (192)) (Prims.of_int (4)) (Prims.of_int (194)) + (Prims.of_int (199)) (Prims.of_int (4)) (Prims.of_int (201)) (Prims.of_int (33))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> match uu___2 with | g::gs -> Obj.magic - (Obj.repr - (FStarC_Tactics_V2_Builtins.set_goals - ((op_At ()) gs [g]))) - | uu___3 -> Obj.magic (Obj.repr (fail "later: no goals"))) uu___2) + (FStarC_Tactics_V2_Builtins.set_goals ((op_At ()) gs [g])) + | uu___3 -> Obj.magic (fail "later: no goals")) uu___2) let (apply : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun t -> FStarC_Tactics_V2_Builtins.t_apply true false false t @@ -800,12 +854,12 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (253)) (Prims.of_int (4)) (Prims.of_int (253)) + (Prims.of_int (260)) (Prims.of_int (4)) (Prims.of_int (260)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (254)) (Prims.of_int (4)) (Prims.of_int (258)) + (Prims.of_int (261)) (Prims.of_int (4)) (Prims.of_int (265)) (Prims.of_int (24))))) (Obj.magic uu___) (fun uu___1 -> (fun ctrl -> @@ -818,13 +872,13 @@ let (t_pointwise : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (256)) (Prims.of_int (4)) - (Prims.of_int (256)) (Prims.of_int (10))))) + (Prims.of_int (263)) (Prims.of_int (4)) + (Prims.of_int (263)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (258)) (Prims.of_int (2)) - (Prims.of_int (258)) (Prims.of_int (24))))) + (Prims.of_int (265)) (Prims.of_int (2)) + (Prims.of_int (265)) (Prims.of_int (24))))) (Obj.magic uu___1) (fun uu___2 -> (fun rw -> @@ -851,14 +905,14 @@ let (topdown_rewrite : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (283)) (Prims.of_int (17)) - (Prims.of_int (283)) (Prims.of_int (23))))) + (Prims.of_int (290)) (Prims.of_int (17)) + (Prims.of_int (290)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (282)) (Prims.of_int (49)) - (Prims.of_int (291)) (Prims.of_int (10))))) + (Prims.of_int (289)) (Prims.of_int (49)) + (Prims.of_int (298)) (Prims.of_int (10))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -868,40 +922,44 @@ let (topdown_rewrite : match i with | uu___5 when uu___5 = Prims.int_zero -> Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStarC_Tactics_Types.Continue)) + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___6 -> + FStarC_Tactics_Types.Continue))) | uu___5 when uu___5 = Prims.int_one -> Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStarC_Tactics_Types.Skip)) + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___6 -> + FStarC_Tactics_Types.Skip))) | uu___5 when uu___5 = (Prims.of_int (2)) -> Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStarC_Tactics_Types.Abort)) + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___6 -> + FStarC_Tactics_Types.Abort))) | uu___5 -> Obj.magic - (fail - "topdown_rewrite: bad value from ctrl") in + (Obj.repr + (fail + "topdown_rewrite: bad value from ctrl")) in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (285)) + (Prims.of_int (292)) (Prims.of_int (8)) - (Prims.of_int (289)) + (Prims.of_int (296)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (291)) + (Prims.of_int (298)) (Prims.of_int (6)) - (Prims.of_int (291)) + (Prims.of_int (298)) (Prims.of_int (10))))) (Obj.magic uu___4) (fun f -> @@ -911,12 +969,12 @@ let (topdown_rewrite : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (282)) (Prims.of_int (49)) - (Prims.of_int (291)) (Prims.of_int (10))))) + (Prims.of_int (289)) (Prims.of_int (49)) + (Prims.of_int (298)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (293)) (Prims.of_int (4)) (Prims.of_int (293)) + (Prims.of_int (300)) (Prims.of_int (4)) (Prims.of_int (300)) (Prims.of_int (33))))) (Obj.magic uu___) (fun uu___1 -> (fun ctrl' -> @@ -940,12 +998,12 @@ let (cur_module : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (299)) (Prims.of_int (13)) (Prims.of_int (299)) + (Prims.of_int (306)) (Prims.of_int (13)) (Prims.of_int (306)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (299)) (Prims.of_int (4)) (Prims.of_int (299)) + (Prims.of_int (306)) (Prims.of_int (4)) (Prims.of_int (306)) (Prims.of_int (25))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -961,12 +1019,12 @@ let (open_modules : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (302)) (Prims.of_int (21)) (Prims.of_int (302)) + (Prims.of_int (309)) (Prims.of_int (21)) (Prims.of_int (309)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (302)) (Prims.of_int (4)) (Prims.of_int (302)) + (Prims.of_int (309)) (Prims.of_int (4)) (Prims.of_int (309)) (Prims.of_int (33))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -982,12 +1040,12 @@ let (fresh_uvar : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (305)) (Prims.of_int (12)) (Prims.of_int (305)) + (Prims.of_int (312)) (Prims.of_int (12)) (Prims.of_int (312)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (306)) (Prims.of_int (4)) (Prims.of_int (306)) + (Prims.of_int (313)) (Prims.of_int (4)) (Prims.of_int (313)) (Prims.of_int (16))))) (Obj.magic uu___) (fun uu___1 -> (fun e -> Obj.magic (FStarC_Tactics_V2_Builtins.uvar_env e o)) @@ -1004,12 +1062,12 @@ let (unify : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (309)) (Prims.of_int (12)) - (Prims.of_int (309)) (Prims.of_int (22))))) + (Prims.of_int (316)) (Prims.of_int (12)) + (Prims.of_int (316)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (310)) (Prims.of_int (4)) (Prims.of_int (310)) + (Prims.of_int (317)) (Prims.of_int (4)) (Prims.of_int (317)) (Prims.of_int (21))))) (Obj.magic uu___) (fun uu___1 -> (fun e -> Obj.magic (FStarC_Tactics_V2_Builtins.unify_env e t1 t2)) @@ -1026,12 +1084,12 @@ let (unify_guard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (313)) (Prims.of_int (12)) - (Prims.of_int (313)) (Prims.of_int (22))))) + (Prims.of_int (320)) (Prims.of_int (12)) + (Prims.of_int (320)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (314)) (Prims.of_int (4)) (Prims.of_int (314)) + (Prims.of_int (321)) (Prims.of_int (4)) (Prims.of_int (321)) (Prims.of_int (27))))) (Obj.magic uu___) (fun uu___1 -> (fun e -> @@ -1049,12 +1107,12 @@ let (tmatch : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (317)) (Prims.of_int (12)) - (Prims.of_int (317)) (Prims.of_int (22))))) + (Prims.of_int (324)) (Prims.of_int (12)) + (Prims.of_int (324)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (318)) (Prims.of_int (4)) (Prims.of_int (318)) + (Prims.of_int (325)) (Prims.of_int (4)) (Prims.of_int (325)) (Prims.of_int (21))))) (Obj.magic uu___) (fun uu___1 -> (fun e -> Obj.magic (FStarC_Tactics_V2_Builtins.match_env e t1 t2)) @@ -1071,20 +1129,22 @@ let divide : fun r -> let uu___ = if n < Prims.int_zero - then Obj.magic (fail "divide: negative n") + then Obj.magic (Obj.repr (fail "divide: negative n")) else - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) in + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ()))) in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (324)) (Prims.of_int (4)) - (Prims.of_int (325)) (Prims.of_int (31))))) + (Prims.of_int (331)) (Prims.of_int (4)) + (Prims.of_int (332)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (325)) (Prims.of_int (32)) - (Prims.of_int (338)) (Prims.of_int (10))))) + (Prims.of_int (332)) (Prims.of_int (32)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -1095,14 +1155,14 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) (Prims.of_int (18)) - (Prims.of_int (326)) (Prims.of_int (26))))) + (Prims.of_int (333)) (Prims.of_int (18)) + (Prims.of_int (333)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) (Prims.of_int (18)) - (Prims.of_int (326)) (Prims.of_int (40))))) + (Prims.of_int (333)) (Prims.of_int (18)) + (Prims.of_int (333)) (Prims.of_int (40))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> @@ -1113,17 +1173,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (333)) (Prims.of_int (28)) - (Prims.of_int (326)) + (Prims.of_int (333)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (333)) (Prims.of_int (18)) - (Prims.of_int (326)) + (Prims.of_int (333)) (Prims.of_int (40))))) (Obj.magic uu___5) (fun uu___6 -> @@ -1136,14 +1196,14 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) (Prims.of_int (18)) - (Prims.of_int (326)) (Prims.of_int (40))))) + (Prims.of_int (333)) (Prims.of_int (18)) + (Prims.of_int (333)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (325)) (Prims.of_int (32)) - (Prims.of_int (338)) (Prims.of_int (10))))) + (Prims.of_int (332)) (Prims.of_int (32)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -1160,17 +1220,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (327)) + (Prims.of_int (334)) (Prims.of_int (19)) - (Prims.of_int (327)) + (Prims.of_int (334)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (326)) + (Prims.of_int (333)) (Prims.of_int (43)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___4) (fun uu___5 -> @@ -1186,17 +1246,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (329)) + (Prims.of_int (336)) (Prims.of_int (4)) - (Prims.of_int (329)) + (Prims.of_int (336)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (329)) + (Prims.of_int (336)) (Prims.of_int (19)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___6) (fun uu___7 -> @@ -1211,18 +1271,18 @@ let divide : ( FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (329)) + (Prims.of_int (336)) (Prims.of_int (19)) - (Prims.of_int (329)) + (Prims.of_int (336)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic ( FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (329)) + (Prims.of_int (336)) (Prims.of_int (36)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___8) @@ -1237,17 +1297,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (330)) + (Prims.of_int (337)) (Prims.of_int (12)) - (Prims.of_int (330)) + (Prims.of_int (337)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (330)) + (Prims.of_int (337)) (Prims.of_int (19)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___10) @@ -1265,17 +1325,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (20)) - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (20)) - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (42))))) (Obj.magic uu___12) @@ -1295,17 +1355,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (30)) - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (20)) - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (42))))) (Obj.magic uu___14) @@ -1325,17 +1385,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (20)) - (Prims.of_int (331)) + (Prims.of_int (338)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (330)) + (Prims.of_int (337)) (Prims.of_int (19)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___11) @@ -1360,17 +1420,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (333)) + (Prims.of_int (340)) (Prims.of_int (4)) - (Prims.of_int (333)) + (Prims.of_int (340)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (333)) + (Prims.of_int (340)) (Prims.of_int (19)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___13) @@ -1390,17 +1450,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (333)) + (Prims.of_int (340)) (Prims.of_int (19)) - (Prims.of_int (333)) + (Prims.of_int (340)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (333)) + (Prims.of_int (340)) (Prims.of_int (36)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___15) @@ -1418,17 +1478,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (334)) + (Prims.of_int (341)) (Prims.of_int (12)) - (Prims.of_int (334)) + (Prims.of_int (341)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (334)) + (Prims.of_int (341)) (Prims.of_int (19)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___17) @@ -1446,17 +1506,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (20)) - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (20)) - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (42))))) (Obj.magic uu___19) @@ -1476,17 +1536,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (30)) - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (20)) - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (42))))) (Obj.magic uu___21) @@ -1506,17 +1566,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (20)) - (Prims.of_int (335)) + (Prims.of_int (342)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (334)) + (Prims.of_int (341)) (Prims.of_int (19)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___18) @@ -1543,17 +1603,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (337)) + (Prims.of_int (344)) (Prims.of_int (4)) - (Prims.of_int (337)) + (Prims.of_int (344)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (337)) + (Prims.of_int (344)) (Prims.of_int (27)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___20) @@ -1577,17 +1637,17 @@ let divide : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (337)) + (Prims.of_int (344)) (Prims.of_int (27)) - (Prims.of_int (337)) + (Prims.of_int (344)) (Prims.of_int (60))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (4)) - (Prims.of_int (338)) + (Prims.of_int (345)) (Prims.of_int (10))))) (Obj.magic uu___22) @@ -1623,13 +1683,13 @@ let rec (iseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (23)) - (Prims.of_int (342)) (Prims.of_int (53))))) + (Prims.of_int (349)) (Prims.of_int (23)) + (Prims.of_int (349)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (342)) (Prims.of_int (57)) - (Prims.of_int (342)) (Prims.of_int (59))))) + (Prims.of_int (349)) (Prims.of_int (57)) + (Prims.of_int (349)) (Prims.of_int (59))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())))) @@ -1648,131 +1708,129 @@ let focus : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (348)) (Prims.of_int (10)) (Prims.of_int (348)) + (Prims.of_int (355)) (Prims.of_int (10)) (Prims.of_int (355)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (348)) (Prims.of_int (4)) (Prims.of_int (355)) + (Prims.of_int (355)) (Prims.of_int (4)) (Prims.of_int (362)) (Prims.of_int (9))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> match uu___1 with - | [] -> Obj.magic (Obj.repr (fail "focus: no goals")) + | [] -> Obj.magic (fail "focus: no goals") | g::gs -> + let uu___2 = smt_goals () in Obj.magic - (Obj.repr - (let uu___2 = smt_goals () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (351)) (Prims.of_int (18)) - (Prims.of_int (351)) (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) (Prims.of_int (8)) - (Prims.of_int (355)) (Prims.of_int (9))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun sgs -> - let uu___3 = - FStarC_Tactics_V2_Builtins.set_goals [g] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) - (Prims.of_int (8)) - (Prims.of_int (352)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) - (Prims.of_int (23)) - (Prims.of_int (355)) - (Prims.of_int (9))))) - (Obj.magic uu___3) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (358)) (Prims.of_int (18)) + (Prims.of_int (358)) (Prims.of_int (30))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (359)) (Prims.of_int (8)) + (Prims.of_int (362)) (Prims.of_int (9))))) + (Obj.magic uu___2) + (fun uu___3 -> + (fun sgs -> + let uu___3 = + FStarC_Tactics_V2_Builtins.set_goals [g] in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (359)) + (Prims.of_int (8)) + (Prims.of_int (359)) + (Prims.of_int (21))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (359)) + (Prims.of_int (23)) + (Prims.of_int (362)) + (Prims.of_int (9))))) + (Obj.magic uu___3) + (fun uu___4 -> (fun uu___4 -> - (fun uu___4 -> - let uu___5 = - FStarC_Tactics_V2_Builtins.set_smt_goals - [] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) - (Prims.of_int (23)) - (Prims.of_int (352)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (352)) - (Prims.of_int (40)) - (Prims.of_int (355)) - (Prims.of_int (9))))) - (Obj.magic uu___5) + let uu___5 = + FStarC_Tactics_V2_Builtins.set_smt_goals + [] in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (359)) + (Prims.of_int (23)) + (Prims.of_int (359)) + (Prims.of_int (39))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (359)) + (Prims.of_int (40)) + (Prims.of_int (362)) + (Prims.of_int (9))))) + (Obj.magic uu___5) + (fun uu___6 -> (fun uu___6 -> - (fun uu___6 -> - let uu___7 = t () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (353)) - (Prims.of_int (16)) - (Prims.of_int (353)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) - (Prims.of_int (8)) - (Prims.of_int (355)) - (Prims.of_int (9))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun x -> - let uu___8 = - let uu___9 = - let uu___10 - = - goals () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal + let uu___7 = t () in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (360)) + (Prims.of_int (16)) + (Prims.of_int (360)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (361)) + (Prims.of_int (8)) + (Prims.of_int (362)) + (Prims.of_int (9))))) + (Obj.magic uu___7) + (fun uu___8 -> + (fun x -> + let uu___8 = + let uu___9 = + let uu___10 = + goals () in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (19)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (27))))) - (FStar_Sealed.seal + (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (18)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (33))))) - (Obj.magic + (Obj.magic uu___10) - (fun + (fun uu___11 -> FStar_Tactics_Effect.lift_div_tac @@ -1782,61 +1840,58 @@ let focus : (op_At ()) uu___11 gs)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (18)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic + (FStar_Sealed.seal + (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (8)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (33))))) - (Obj.magic - uu___9) + (Obj.magic + uu___9) + (fun uu___10 + -> (fun - uu___10 - -> - (fun uu___10 -> Obj.magic (FStarC_Tactics_V2_Builtins.set_goals uu___10)) uu___10) in - Obj.magic - (FStar_Tactics_Effect.tac_bind + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal ( - FStar_Sealed.seal - (Obj.magic + Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (8)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (33))))) + (FStar_Sealed.seal ( - FStar_Sealed.seal - (Obj.magic + Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (35)) - (Prims.of_int (355)) + (Prims.of_int (362)) (Prims.of_int (9))))) - ( - Obj.magic + (Obj.magic uu___8) - ( - fun - uu___9 -> + (fun uu___9 + -> (fun uu___9 -> let uu___10 @@ -1852,17 +1907,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (50)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (49)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (69))))) (Obj.magic uu___12) @@ -1881,17 +1936,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (49)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (35)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (69))))) (Obj.magic uu___11) @@ -1911,17 +1966,17 @@ let focus : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (35)) - (Prims.of_int (354)) + (Prims.of_int (361)) (Prims.of_int (69))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (353)) + (Prims.of_int (360)) (Prims.of_int (12)) - (Prims.of_int (353)) + (Prims.of_int (360)) (Prims.of_int (13))))) (Obj.magic uu___10) @@ -1933,9 +1988,8 @@ let focus : uu___12 -> x)))) uu___9))) - uu___8))) - uu___6))) uu___4))) uu___3)))) - uu___1) + uu___8))) uu___6))) + uu___4))) uu___3))) uu___1) let (dump1 : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun m -> focus (fun uu___ -> FStarC_Tactics_V2_Builtins.dump m) let rec mapAll : @@ -1949,12 +2003,12 @@ let rec mapAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (10)) (Prims.of_int (361)) + (Prims.of_int (368)) (Prims.of_int (10)) (Prims.of_int (368)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (361)) (Prims.of_int (4)) (Prims.of_int (363)) + (Prims.of_int (368)) (Prims.of_int (4)) (Prims.of_int (370)) (Prims.of_int (66))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -1973,14 +2027,14 @@ let rec mapAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (363)) (Prims.of_int (27)) - (Prims.of_int (363)) (Prims.of_int (58))))) + (Prims.of_int (370)) (Prims.of_int (27)) + (Prims.of_int (370)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (363)) (Prims.of_int (13)) - (Prims.of_int (363)) (Prims.of_int (66))))) + (Prims.of_int (370)) (Prims.of_int (13)) + (Prims.of_int (370)) (Prims.of_int (66))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -1997,12 +2051,12 @@ let rec (iterAll : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (367)) (Prims.of_int (10)) (Prims.of_int (367)) + (Prims.of_int (374)) (Prims.of_int (10)) (Prims.of_int (374)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (367)) (Prims.of_int (4)) (Prims.of_int (369)) + (Prims.of_int (374)) (Prims.of_int (4)) (Prims.of_int (376)) (Prims.of_int (60))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -2021,14 +2075,14 @@ let rec (iterAll : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (369)) (Prims.of_int (22)) - (Prims.of_int (369)) (Prims.of_int (54))))) + (Prims.of_int (376)) (Prims.of_int (22)) + (Prims.of_int (376)) (Prims.of_int (54))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (369)) (Prims.of_int (58)) - (Prims.of_int (369)) (Prims.of_int (60))))) + (Prims.of_int (376)) (Prims.of_int (58)) + (Prims.of_int (376)) (Prims.of_int (60))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -2044,13 +2098,13 @@ let (iterAllSMT : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (372)) (Prims.of_int (18)) - (Prims.of_int (372)) (Prims.of_int (26))))) + (Prims.of_int (379)) (Prims.of_int (18)) + (Prims.of_int (379)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (372)) (Prims.of_int (18)) - (Prims.of_int (372)) (Prims.of_int (40))))) + (Prims.of_int (379)) (Prims.of_int (18)) + (Prims.of_int (379)) (Prims.of_int (40))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -2060,13 +2114,13 @@ let (iterAllSMT : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (372)) (Prims.of_int (28)) - (Prims.of_int (372)) (Prims.of_int (40))))) + (Prims.of_int (379)) (Prims.of_int (28)) + (Prims.of_int (379)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (372)) (Prims.of_int (18)) - (Prims.of_int (372)) (Prims.of_int (40))))) + (Prims.of_int (379)) (Prims.of_int (18)) + (Prims.of_int (379)) (Prims.of_int (40))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -2075,12 +2129,12 @@ let (iterAllSMT : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (372)) (Prims.of_int (18)) (Prims.of_int (372)) + (Prims.of_int (379)) (Prims.of_int (18)) (Prims.of_int (379)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (371)) (Prims.of_int (50)) (Prims.of_int (378)) + (Prims.of_int (378)) (Prims.of_int (50)) (Prims.of_int (385)) (Prims.of_int (28))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -2093,14 +2147,14 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (373)) (Prims.of_int (4)) - (Prims.of_int (373)) (Prims.of_int (17))))) + (Prims.of_int (380)) (Prims.of_int (4)) + (Prims.of_int (380)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (374)) (Prims.of_int (4)) - (Prims.of_int (378)) (Prims.of_int (28))))) + (Prims.of_int (381)) (Prims.of_int (4)) + (Prims.of_int (385)) (Prims.of_int (28))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -2112,17 +2166,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (374)) + (Prims.of_int (381)) (Prims.of_int (4)) - (Prims.of_int (374)) + (Prims.of_int (381)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (375)) + (Prims.of_int (382)) (Prims.of_int (4)) - (Prims.of_int (378)) + (Prims.of_int (385)) (Prims.of_int (28))))) (Obj.magic uu___4) (fun uu___5 -> @@ -2134,17 +2188,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (375)) + (Prims.of_int (382)) (Prims.of_int (4)) - (Prims.of_int (375)) + (Prims.of_int (382)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (375)) + (Prims.of_int (382)) (Prims.of_int (14)) - (Prims.of_int (378)) + (Prims.of_int (385)) (Prims.of_int (28))))) (Obj.magic uu___6) (fun uu___7 -> @@ -2156,17 +2210,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (20)) - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (20)) - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (42))))) (Obj.magic uu___9) (fun uu___10 -> @@ -2179,17 +2233,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (30)) - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (20)) - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (42))))) (Obj.magic uu___11) @@ -2208,17 +2262,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (20)) - (Prims.of_int (376)) + (Prims.of_int (383)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (375)) + (Prims.of_int (382)) (Prims.of_int (14)) - (Prims.of_int (378)) + (Prims.of_int (385)) (Prims.of_int (28))))) (Obj.magic uu___8) (fun uu___9 -> @@ -2234,17 +2288,17 @@ let (iterAllSMT : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (377)) + (Prims.of_int (384)) (Prims.of_int (4)) - (Prims.of_int (377)) + (Prims.of_int (384)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (378)) + (Prims.of_int (385)) (Prims.of_int (4)) - (Prims.of_int (378)) + (Prims.of_int (385)) (Prims.of_int (28))))) (Obj.magic uu___10) @@ -2276,13 +2330,13 @@ let (seq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (384)) (Prims.of_int (21)) - (Prims.of_int (384)) (Prims.of_int (25))))) + (Prims.of_int (391)) (Prims.of_int (21)) + (Prims.of_int (391)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (384)) (Prims.of_int (27)) - (Prims.of_int (384)) (Prims.of_int (36))))) + (Prims.of_int (391)) (Prims.of_int (27)) + (Prims.of_int (391)) (Prims.of_int (36))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> Obj.magic (iterAll g)) uu___2)) let (exact_args : @@ -2302,13 +2356,13 @@ let (exact_args : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (388)) (Prims.of_int (16)) - (Prims.of_int (388)) (Prims.of_int (39))))) + (Prims.of_int (395)) (Prims.of_int (16)) + (Prims.of_int (395)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (388)) (Prims.of_int (42)) - (Prims.of_int (394)) (Prims.of_int (44))))) + (Prims.of_int (395)) (Prims.of_int (42)) + (Prims.of_int (401)) (Prims.of_int (44))))) (Obj.magic uu___1) (fun uu___2 -> (fun n -> @@ -2321,14 +2375,14 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (389)) (Prims.of_int (18)) - (Prims.of_int (389)) (Prims.of_int (55))))) + (Prims.of_int (396)) (Prims.of_int (18)) + (Prims.of_int (396)) (Prims.of_int (55))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (389)) (Prims.of_int (58)) - (Prims.of_int (394)) (Prims.of_int (44))))) + (Prims.of_int (396)) (Prims.of_int (58)) + (Prims.of_int (401)) (Prims.of_int (44))))) (Obj.magic uu___2) (fun uu___3 -> (fun uvs -> @@ -2339,17 +2393,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (390)) + (Prims.of_int (397)) (Prims.of_int (26)) - (Prims.of_int (390)) + (Prims.of_int (397)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (390)) + (Prims.of_int (397)) (Prims.of_int (17)) - (Prims.of_int (390)) + (Prims.of_int (397)) (Prims.of_int (38))))) (Obj.magic uu___4) (fun uu___5 -> @@ -2363,17 +2417,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (390)) + (Prims.of_int (397)) (Prims.of_int (17)) - (Prims.of_int (390)) + (Prims.of_int (397)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (391)) + (Prims.of_int (398)) (Prims.of_int (8)) - (Prims.of_int (394)) + (Prims.of_int (401)) (Prims.of_int (44))))) (Obj.magic uu___3) (fun uu___4 -> @@ -2385,17 +2439,17 @@ let (exact_args : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (391)) + (Prims.of_int (398)) (Prims.of_int (8)) - (Prims.of_int (391)) + (Prims.of_int (398)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (392)) + (Prims.of_int (399)) (Prims.of_int (8)) - (Prims.of_int (394)) + (Prims.of_int (401)) (Prims.of_int (44))))) (Obj.magic uu___4) (fun uu___5 -> @@ -2442,12 +2496,12 @@ let (exact_n : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (398)) (Prims.of_int (15)) - (Prims.of_int (398)) (Prims.of_int (49))))) + (Prims.of_int (405)) (Prims.of_int (15)) + (Prims.of_int (405)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (398)) (Prims.of_int (4)) (Prims.of_int (398)) + (Prims.of_int (405)) (Prims.of_int (4)) (Prims.of_int (405)) (Prims.of_int (51))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> Obj.magic (exact_args uu___1 t)) uu___1) let (ngoals : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = @@ -2457,12 +2511,12 @@ let (ngoals : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (401)) (Prims.of_int (47)) (Prims.of_int (401)) + (Prims.of_int (408)) (Prims.of_int (47)) (Prims.of_int (408)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (401)) (Prims.of_int (26)) (Prims.of_int (401)) + (Prims.of_int (408)) (Prims.of_int (26)) (Prims.of_int (408)) (Prims.of_int (57))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -2474,12 +2528,12 @@ let (ngoals_smt : unit -> (Prims.int, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (404)) (Prims.of_int (51)) (Prims.of_int (404)) + (Prims.of_int (411)) (Prims.of_int (51)) (Prims.of_int (411)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (404)) (Prims.of_int (30)) (Prims.of_int (404)) + (Prims.of_int (411)) (Prims.of_int (30)) (Prims.of_int (411)) (Prims.of_int (65))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -2494,12 +2548,12 @@ let (fresh_namedv_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (408)) (Prims.of_int (10)) (Prims.of_int (408)) + (Prims.of_int (415)) (Prims.of_int (10)) (Prims.of_int (415)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (409)) (Prims.of_int (2)) (Prims.of_int (413)) + (Prims.of_int (416)) (Prims.of_int (2)) (Prims.of_int (420)) (Prims.of_int (4))))) (Obj.magic uu___) (fun n -> FStar_Tactics_Effect.lift_div_tac @@ -2509,8 +2563,8 @@ let (fresh_namedv_named : FStarC_Reflection_V2_Data.uniq = n; FStarC_Reflection_V2_Data.sort = (FStar_Sealed.seal - (FStarC_Reflection_V2_Builtins.pack_ln - FStarC_Reflection_V2_Data.Tv_Unknown)); + (FStar_Tactics_NamedView.pack + FStar_Tactics_NamedView.Tv_Unknown)); FStarC_Reflection_V2_Data.ppname = (FStar_Sealed.seal s) })) let (fresh_namedv : @@ -2523,12 +2577,12 @@ let (fresh_namedv : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (418)) (Prims.of_int (10)) (Prims.of_int (418)) + (Prims.of_int (425)) (Prims.of_int (10)) (Prims.of_int (425)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (419)) (Prims.of_int (2)) (Prims.of_int (423)) + (Prims.of_int (426)) (Prims.of_int (2)) (Prims.of_int (430)) (Prims.of_int (4))))) (Obj.magic uu___1) (fun n -> FStar_Tactics_Effect.lift_div_tac @@ -2538,8 +2592,8 @@ let (fresh_namedv : FStarC_Reflection_V2_Data.uniq = n; FStarC_Reflection_V2_Data.sort = (FStar_Sealed.seal - (FStarC_Reflection_V2_Builtins.pack_ln - FStarC_Reflection_V2_Data.Tv_Unknown)); + (FStar_Tactics_NamedView.pack + FStar_Tactics_NamedView.Tv_Unknown)); FStarC_Reflection_V2_Data.ppname = (FStar_Sealed.seal (Prims.strcat "x" (Prims.string_of_int n))) @@ -2557,12 +2611,12 @@ let (fresh_binder_named : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (426)) (Prims.of_int (10)) - (Prims.of_int (426)) (Prims.of_int (18))))) + (Prims.of_int (433)) (Prims.of_int (10)) + (Prims.of_int (433)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (428)) (Prims.of_int (4)) (Prims.of_int (432)) + (Prims.of_int (435)) (Prims.of_int (4)) (Prims.of_int (439)) (Prims.of_int (17))))) (Obj.magic uu___) (fun n -> FStar_Tactics_Effect.lift_div_tac @@ -2586,12 +2640,12 @@ let (fresh_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (436)) (Prims.of_int (10)) (Prims.of_int (436)) + (Prims.of_int (443)) (Prims.of_int (10)) (Prims.of_int (443)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (438)) (Prims.of_int (4)) (Prims.of_int (442)) + (Prims.of_int (445)) (Prims.of_int (4)) (Prims.of_int (449)) (Prims.of_int (17))))) (Obj.magic uu___) (fun n -> FStar_Tactics_Effect.lift_div_tac @@ -2616,12 +2670,12 @@ let (fresh_implicit_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (446)) (Prims.of_int (10)) (Prims.of_int (446)) + (Prims.of_int (453)) (Prims.of_int (10)) (Prims.of_int (453)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (448)) (Prims.of_int (4)) (Prims.of_int (452)) + (Prims.of_int (455)) (Prims.of_int (4)) (Prims.of_int (459)) (Prims.of_int (17))))) (Obj.magic uu___) (fun n -> FStar_Tactics_Effect.lift_div_tac @@ -2640,8 +2694,10 @@ let (guard : Prims.bool -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> (fun b -> if Prims.op_Negation b - then Obj.magic (fail "guard failed") - else Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ()))) + then Obj.magic (Obj.repr (fail "guard failed")) + else + Obj.magic + (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())))) uu___ let try_with : 'a . @@ -2656,18 +2712,19 @@ let try_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (466)) (Prims.of_int (10)) - (Prims.of_int (466)) (Prims.of_int (17))))) + (Prims.of_int (473)) (Prims.of_int (10)) + (Prims.of_int (473)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (466)) (Prims.of_int (4)) (Prims.of_int (468)) + (Prims.of_int (473)) (Prims.of_int (4)) (Prims.of_int (475)) (Prims.of_int (16))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> match uu___1 with - | FStar_Pervasives.Inl e -> Obj.magic (Obj.repr (h e)) - | FStar_Pervasives.Inr x -> + | Fstarcompiler.FStar_Pervasives.Inl e -> + Obj.magic (Obj.repr (h e)) + | Fstarcompiler.FStar_Pervasives.Inr x -> Obj.magic (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> x)))) @@ -2687,13 +2744,13 @@ let trytac : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (471)) (Prims.of_int (13)) - (Prims.of_int (471)) (Prims.of_int (19))))) + (Prims.of_int (478)) (Prims.of_int (13)) + (Prims.of_int (478)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (471)) (Prims.of_int (8)) - (Prims.of_int (471)) (Prims.of_int (19))))) + (Prims.of_int (478)) (Prims.of_int (8)) + (Prims.of_int (478)) (Prims.of_int (19))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -2726,8 +2783,7 @@ let first : = fun ts -> FStar_List_Tot_Base.fold_right op_Less_Bar_Greater ts - (fun uu___ -> (fun uu___ -> Obj.magic (fail "no tactics to try")) uu___) - () + (fun uu___ -> fail "no tactics to try") () let rec repeat : 'a . (unit -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> @@ -2739,21 +2795,21 @@ let rec repeat : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (488)) (Prims.of_int (10)) (Prims.of_int (488)) + (Prims.of_int (495)) (Prims.of_int (10)) (Prims.of_int (495)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (488)) (Prims.of_int (4)) (Prims.of_int (490)) + (Prims.of_int (495)) (Prims.of_int (4)) (Prims.of_int (497)) (Prims.of_int (28))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> match uu___1 with - | FStar_Pervasives.Inl uu___2 -> + | Fstarcompiler.FStar_Pervasives.Inl uu___2 -> Obj.magic (Obj.repr (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> []))) - | FStar_Pervasives.Inr x -> + | Fstarcompiler.FStar_Pervasives.Inr x -> Obj.magic (Obj.repr (let uu___2 = repeat t in @@ -2762,14 +2818,14 @@ let rec repeat : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (490)) (Prims.of_int (20)) - (Prims.of_int (490)) (Prims.of_int (28))))) + (Prims.of_int (497)) (Prims.of_int (20)) + (Prims.of_int (497)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (490)) (Prims.of_int (15)) - (Prims.of_int (490)) (Prims.of_int (28))))) + (Prims.of_int (497)) (Prims.of_int (15)) + (Prims.of_int (497)) (Prims.of_int (28))))) (Obj.magic uu___2) (fun uu___3 -> FStar_Tactics_Effect.lift_div_tac @@ -2785,12 +2841,12 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (493)) (Prims.of_int (4)) (Prims.of_int (493)) + (Prims.of_int (500)) (Prims.of_int (4)) (Prims.of_int (500)) (Prims.of_int (8))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (493)) (Prims.of_int (4)) (Prims.of_int (493)) + (Prims.of_int (500)) (Prims.of_int (4)) (Prims.of_int (500)) (Prims.of_int (20))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -2800,13 +2856,13 @@ let repeat1 : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (493)) (Prims.of_int (12)) - (Prims.of_int (493)) (Prims.of_int (20))))) + (Prims.of_int (500)) (Prims.of_int (12)) + (Prims.of_int (500)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (493)) (Prims.of_int (4)) - (Prims.of_int (493)) (Prims.of_int (20))))) + (Prims.of_int (500)) (Prims.of_int (4)) + (Prims.of_int (500)) (Prims.of_int (20))))) (Obj.magic uu___2) (fun uu___3 -> FStar_Tactics_Effect.lift_div_tac @@ -2822,16 +2878,16 @@ let repeat' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (496)) (Prims.of_int (12)) (Prims.of_int (496)) + (Prims.of_int (503)) (Prims.of_int (12)) (Prims.of_int (503)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (496)) (Prims.of_int (24)) (Prims.of_int (496)) + (Prims.of_int (503)) (Prims.of_int (24)) (Prims.of_int (503)) (Prims.of_int (26))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (norm_term : - FStar_Pervasives.norm_step Prims.list -> + Fstarcompiler.FStar_Pervasives.norm_step Prims.list -> FStar_Tactics_NamedView.term -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) = @@ -2844,12 +2900,12 @@ let (norm_term : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (500)) (Prims.of_int (8)) (Prims.of_int (501)) + (Prims.of_int (507)) (Prims.of_int (8)) (Prims.of_int (508)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (503)) (Prims.of_int (4)) (Prims.of_int (503)) + (Prims.of_int (510)) (Prims.of_int (4)) (Prims.of_int (510)) (Prims.of_int (23))))) (Obj.magic uu___) (fun uu___1 -> (fun e -> @@ -2864,13 +2920,13 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (510)) (Prims.of_int (16)) - (Prims.of_int (510)) (Prims.of_int (24))))) + (Prims.of_int (517)) (Prims.of_int (16)) + (Prims.of_int (517)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (510)) (Prims.of_int (16)) - (Prims.of_int (510)) (Prims.of_int (38))))) + (Prims.of_int (517)) (Prims.of_int (16)) + (Prims.of_int (517)) (Prims.of_int (38))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -2880,13 +2936,13 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (510)) (Prims.of_int (26)) - (Prims.of_int (510)) (Prims.of_int (38))))) + (Prims.of_int (517)) (Prims.of_int (26)) + (Prims.of_int (517)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (510)) (Prims.of_int (16)) - (Prims.of_int (510)) (Prims.of_int (38))))) + (Prims.of_int (517)) (Prims.of_int (16)) + (Prims.of_int (517)) (Prims.of_int (38))))) (Obj.magic uu___4) (fun uu___5 -> FStar_Tactics_Effect.lift_div_tac @@ -2895,12 +2951,12 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (510)) (Prims.of_int (16)) (Prims.of_int (510)) + (Prims.of_int (517)) (Prims.of_int (16)) (Prims.of_int (517)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (509)) (Prims.of_int (27)) (Prims.of_int (516)) + (Prims.of_int (516)) (Prims.of_int (27)) (Prims.of_int (523)) (Prims.of_int (20))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -2913,14 +2969,14 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (511)) (Prims.of_int (2)) - (Prims.of_int (511)) (Prims.of_int (18))))) + (Prims.of_int (518)) (Prims.of_int (2)) + (Prims.of_int (518)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (512)) (Prims.of_int (2)) - (Prims.of_int (516)) (Prims.of_int (20))))) + (Prims.of_int (519)) (Prims.of_int (2)) + (Prims.of_int (523)) (Prims.of_int (20))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> @@ -2932,17 +2988,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (512)) + (Prims.of_int (519)) (Prims.of_int (2)) - (Prims.of_int (512)) + (Prims.of_int (519)) (Prims.of_int (15))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (513)) + (Prims.of_int (520)) (Prims.of_int (2)) - (Prims.of_int (516)) + (Prims.of_int (523)) (Prims.of_int (20))))) (Obj.magic uu___5) (fun uu___6 -> @@ -2956,17 +3012,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (513)) + (Prims.of_int (520)) (Prims.of_int (2)) - (Prims.of_int (513)) + (Prims.of_int (520)) (Prims.of_int (14))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (513)) + (Prims.of_int (520)) (Prims.of_int (15)) - (Prims.of_int (516)) + (Prims.of_int (523)) (Prims.of_int (20))))) (Obj.magic uu___7) (fun uu___8 -> @@ -2978,17 +3034,17 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (514)) + (Prims.of_int (521)) (Prims.of_int (13)) - (Prims.of_int (514)) + (Prims.of_int (521)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (515)) + (Prims.of_int (522)) (Prims.of_int (2)) - (Prims.of_int (516)) + (Prims.of_int (523)) (Prims.of_int (20))))) (Obj.magic uu___9) (fun uu___10 -> @@ -3003,18 +3059,18 @@ let (join_all_smt_goals : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (515)) + (Prims.of_int (522)) (Prims.of_int (2)) - (Prims.of_int (515)) + (Prims.of_int (522)) (Prims.of_int (14))))) (FStar_Sealed.seal ( Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (516)) + (Prims.of_int (523)) (Prims.of_int (2)) - (Prims.of_int (516)) + (Prims.of_int (523)) (Prims.of_int (20))))) (Obj.magic uu___10) @@ -3041,13 +3097,13 @@ let discard : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (519)) (Prims.of_int (22)) - (Prims.of_int (519)) (Prims.of_int (28))))) + (Prims.of_int (526)) (Prims.of_int (22)) + (Prims.of_int (526)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (519)) (Prims.of_int (32)) - (Prims.of_int (519)) (Prims.of_int (34))))) + (Prims.of_int (526)) (Prims.of_int (32)) + (Prims.of_int (526)) (Prims.of_int (34))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())) let rec repeatseq : @@ -3063,12 +3119,12 @@ let rec repeatseq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (523)) (Prims.of_int (12)) (Prims.of_int (523)) + (Prims.of_int (530)) (Prims.of_int (12)) (Prims.of_int (530)) (Prims.of_int (82))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (523)) (Prims.of_int (86)) (Prims.of_int (523)) + (Prims.of_int (530)) (Prims.of_int (86)) (Prims.of_int (530)) (Prims.of_int (88))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (tadmit : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -3085,12 +3141,12 @@ let (admit_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (531)) (Prims.of_int (12)) (Prims.of_int (531)) + (Prims.of_int (538)) (Prims.of_int (12)) (Prims.of_int (538)) (Prims.of_int (25))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (532)) (Prims.of_int (4)) (Prims.of_int (532)) + (Prims.of_int (539)) (Prims.of_int (4)) (Prims.of_int (539)) (Prims.of_int (6))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())) let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = @@ -3100,12 +3156,12 @@ let (is_guard : unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (536)) (Prims.of_int (33)) (Prims.of_int (536)) + (Prims.of_int (543)) (Prims.of_int (33)) (Prims.of_int (543)) (Prims.of_int (47))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (536)) (Prims.of_int (4)) (Prims.of_int (536)) + (Prims.of_int (543)) (Prims.of_int (4)) (Prims.of_int (543)) (Prims.of_int (47))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -3117,18 +3173,17 @@ let (skip_guard : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (539)) (Prims.of_int (7)) (Prims.of_int (539)) + (Prims.of_int (546)) (Prims.of_int (7)) (Prims.of_int (546)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (539)) (Prims.of_int (4)) (Prims.of_int (541)) + (Prims.of_int (546)) (Prims.of_int (4)) (Prims.of_int (548)) (Prims.of_int (16))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> - if uu___2 - then Obj.magic (Obj.repr (smt ())) - else Obj.magic (Obj.repr (fail ""))) uu___2) + if uu___2 then Obj.magic (smt ()) else Obj.magic (fail "")) + uu___2) let (guards_to_smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = repeat skip_guard in @@ -3136,32 +3191,33 @@ let (guards_to_smt : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (544)) (Prims.of_int (12)) (Prims.of_int (544)) + (Prims.of_int (551)) (Prims.of_int (12)) (Prims.of_int (551)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (545)) (Prims.of_int (4)) (Prims.of_int (545)) + (Prims.of_int (552)) (Prims.of_int (4)) (Prims.of_int (552)) (Prims.of_int (6))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())) let (simpl : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.simplify; FStar_Pervasives.primops] + [Fstarcompiler.FStar_Pervasives.simplify; + Fstarcompiler.FStar_Pervasives.primops] let (whnf : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.weak; - FStar_Pervasives.hnf; - FStar_Pervasives.primops; - FStar_Pervasives.delta] + [Fstarcompiler.FStar_Pervasives.weak; + Fstarcompiler.FStar_Pervasives.hnf; + Fstarcompiler.FStar_Pervasives.primops; + Fstarcompiler.FStar_Pervasives.delta] let (compute : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.primops; - FStar_Pervasives.iota; - FStar_Pervasives.delta; - FStar_Pervasives.zeta] + [Fstarcompiler.FStar_Pervasives.primops; + Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.delta; + Fstarcompiler.FStar_Pervasives.zeta] let (intros : unit -> (FStar_Tactics_NamedView.binding Prims.list, unit) @@ -3174,12 +3230,12 @@ let (intros' : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (553)) (Prims.of_int (36)) (Prims.of_int (553)) + (Prims.of_int (560)) (Prims.of_int (36)) (Prims.of_int (560)) (Prims.of_int (45))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (553)) (Prims.of_int (49)) (Prims.of_int (553)) + (Prims.of_int (560)) (Prims.of_int (49)) (Prims.of_int (560)) (Prims.of_int (51))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())) let (destruct : @@ -3191,12 +3247,12 @@ let (destruct : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (554)) (Prims.of_int (37)) (Prims.of_int (554)) + (Prims.of_int (561)) (Prims.of_int (37)) (Prims.of_int (561)) (Prims.of_int (50))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (554)) (Prims.of_int (54)) (Prims.of_int (554)) + (Prims.of_int (561)) (Prims.of_int (54)) (Prims.of_int (561)) (Prims.of_int (56))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) let (destruct_intros : @@ -3210,13 +3266,13 @@ let (destruct_intros : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (555)) (Prims.of_int (59)) - (Prims.of_int (555)) (Prims.of_int (72))))) + (Prims.of_int (562)) (Prims.of_int (59)) + (Prims.of_int (562)) (Prims.of_int (72))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (555)) (Prims.of_int (76)) - (Prims.of_int (555)) (Prims.of_int (78))))) + (Prims.of_int (562)) (Prims.of_int (76)) + (Prims.of_int (562)) (Prims.of_int (78))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ()))) intros' @@ -3231,12 +3287,12 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (561)) (Prims.of_int (12)) (Prims.of_int (561)) + (Prims.of_int (568)) (Prims.of_int (12)) (Prims.of_int (568)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (561)) (Prims.of_int (26)) (Prims.of_int (564)) + (Prims.of_int (568)) (Prims.of_int (26)) (Prims.of_int (571)) (Prims.of_int (12))))) (Obj.magic uu___) (fun uu___1 -> (fun g -> @@ -3258,13 +3314,13 @@ let (tcut : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (562)) (Prims.of_int (13)) - (Prims.of_int (562)) (Prims.of_int (37))))) + (Prims.of_int (569)) (Prims.of_int (13)) + (Prims.of_int (569)) (Prims.of_int (37))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (563)) (Prims.of_int (4)) - (Prims.of_int (564)) (Prims.of_int (12))))) + (Prims.of_int (570)) (Prims.of_int (4)) + (Prims.of_int (571)) (Prims.of_int (12))))) (Obj.magic uu___1) (fun uu___2 -> (fun tt -> @@ -3275,14 +3331,14 @@ let (tcut : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (563)) (Prims.of_int (4)) - (Prims.of_int (563)) (Prims.of_int (12))))) + (Prims.of_int (570)) (Prims.of_int (4)) + (Prims.of_int (570)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (564)) (Prims.of_int (4)) - (Prims.of_int (564)) (Prims.of_int (12))))) + (Prims.of_int (571)) (Prims.of_int (4)) + (Prims.of_int (571)) (Prims.of_int (12))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -3304,12 +3360,12 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (567)) (Prims.of_int (4)) (Prims.of_int (567)) + (Prims.of_int (574)) (Prims.of_int (4)) (Prims.of_int (574)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (568)) (Prims.of_int (4)) (Prims.of_int (570)) + (Prims.of_int (575)) (Prims.of_int (4)) (Prims.of_int (577)) (Prims.of_int (12))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -3319,13 +3375,13 @@ let (pose : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (568)) (Prims.of_int (4)) - (Prims.of_int (568)) (Prims.of_int (11))))) + (Prims.of_int (575)) (Prims.of_int (4)) + (Prims.of_int (575)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (569)) (Prims.of_int (4)) - (Prims.of_int (570)) (Prims.of_int (12))))) + (Prims.of_int (576)) (Prims.of_int (4)) + (Prims.of_int (577)) (Prims.of_int (12))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -3336,14 +3392,14 @@ let (pose : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (569)) (Prims.of_int (4)) - (Prims.of_int (569)) (Prims.of_int (11))))) + (Prims.of_int (576)) (Prims.of_int (4)) + (Prims.of_int (576)) (Prims.of_int (11))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (570)) (Prims.of_int (4)) - (Prims.of_int (570)) (Prims.of_int (12))))) + (Prims.of_int (577)) (Prims.of_int (4)) + (Prims.of_int (577)) (Prims.of_int (12))))) (Obj.magic uu___4) (fun uu___5 -> (fun uu___5 -> @@ -3360,12 +3416,12 @@ let (intro_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (573)) (Prims.of_int (12)) (Prims.of_int (573)) + (Prims.of_int (580)) (Prims.of_int (12)) (Prims.of_int (580)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (574)) (Prims.of_int (4)) (Prims.of_int (574)) + (Prims.of_int (581)) (Prims.of_int (4)) (Prims.of_int (581)) (Prims.of_int (17))))) (Obj.magic uu___) (fun uu___1 -> (fun b -> Obj.magic (FStarC_Tactics_V2_Builtins.rename_to b s)) @@ -3382,12 +3438,12 @@ let (pose_as : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (577)) (Prims.of_int (12)) - (Prims.of_int (577)) (Prims.of_int (18))))) + (Prims.of_int (584)) (Prims.of_int (12)) + (Prims.of_int (584)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (578)) (Prims.of_int (4)) (Prims.of_int (578)) + (Prims.of_int (585)) (Prims.of_int (4)) (Prims.of_int (585)) (Prims.of_int (17))))) (Obj.magic uu___) (fun uu___1 -> (fun b -> Obj.magic (FStarC_Tactics_V2_Builtins.rename_to b s)) @@ -3404,12 +3460,12 @@ let for_each_binding : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (581)) (Prims.of_int (10)) (Prims.of_int (581)) + (Prims.of_int (588)) (Prims.of_int (10)) (Prims.of_int (588)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (581)) (Prims.of_int (4)) (Prims.of_int (581)) + (Prims.of_int (588)) (Prims.of_int (4)) (Prims.of_int (588)) (Prims.of_int (23))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> Obj.magic (FStar_Tactics_Util.map f uu___1)) uu___1) @@ -3431,13 +3487,13 @@ let rec (revert_all : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (586)) (Prims.of_int (15)) - (Prims.of_int (586)) (Prims.of_int (24))))) + (Prims.of_int (593)) (Prims.of_int (15)) + (Prims.of_int (593)) (Prims.of_int (24))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (587)) (Prims.of_int (13)) - (Prims.of_int (587)) (Prims.of_int (26))))) + (Prims.of_int (594)) (Prims.of_int (13)) + (Prims.of_int (594)) (Prims.of_int (26))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> Obj.magic (revert_all tl)) uu___2)))) @@ -3449,58 +3505,47 @@ let rec (__assumption_aux : FStar_Tactics_NamedView.binding Prims.list -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - (fun xs -> - match xs with - | [] -> Obj.magic (Obj.repr (fail "no assumption matches goal")) - | b::bs -> - Obj.magic - (Obj.repr - (try_with - (fun uu___ -> - match () with - | () -> - exact - (FStar_Tactics_V2_SyntaxCoercions.binding_to_term - b)) - (fun uu___ -> - try_with - (fun uu___1 -> - match () with - | () -> - let uu___2 = - apply - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Squash"; - "return_squash"]))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (599)) - (Prims.of_int (13)) - (Prims.of_int (599)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (600)) - (Prims.of_int (13)) - (Prims.of_int (600)) - (Prims.of_int (20))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (exact - (FStar_Tactics_V2_SyntaxCoercions.binding_to_term - b))) uu___3)) - (fun uu___1 -> __assumption_aux bs))))) uu___ + fun xs -> + match xs with + | [] -> fail "no assumption matches goal" + | b::bs -> + try_with + (fun uu___ -> + match () with + | () -> + exact (FStar_Tactics_V2_SyntaxCoercions.binding_to_term b)) + (fun uu___ -> + try_with + (fun uu___1 -> + match () with + | () -> + let uu___2 = + apply + (FStarC_Reflection_V2_Builtins.pack_ln + (FStarC_Reflection_V2_Data.Tv_FVar + (FStarC_Reflection_V2_Builtins.pack_fv + ["FStar"; "Squash"; "return_squash"]))) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (606)) (Prims.of_int (13)) + (Prims.of_int (606)) (Prims.of_int (48))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (607)) (Prims.of_int (13)) + (Prims.of_int (607)) (Prims.of_int (20))))) + (Obj.magic uu___2) + (fun uu___3 -> + (fun uu___3 -> + Obj.magic + (exact + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b))) uu___3)) + (fun uu___1 -> __assumption_aux bs)) let (assumption : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = cur_vars () in @@ -3508,12 +3553,12 @@ let (assumption : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (604)) (Prims.of_int (21)) (Prims.of_int (604)) + (Prims.of_int (611)) (Prims.of_int (21)) (Prims.of_int (611)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (604)) (Prims.of_int (4)) (Prims.of_int (604)) + (Prims.of_int (611)) (Prims.of_int (4)) (Prims.of_int (611)) (Prims.of_int (34))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> Obj.magic (__assumption_aux uu___2)) uu___2) @@ -3529,12 +3574,12 @@ let (destruct_equality_implication : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (607)) (Prims.of_int (10)) (Prims.of_int (607)) + (Prims.of_int (614)) (Prims.of_int (10)) (Prims.of_int (614)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (607)) (Prims.of_int (4)) (Prims.of_int (614)) + (Prims.of_int (614)) (Prims.of_int (4)) (Prims.of_int (621)) (Prims.of_int (15))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -3549,14 +3594,14 @@ let (destruct_equality_implication : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (609)) (Prims.of_int (18)) - (Prims.of_int (609)) (Prims.of_int (38))))) + (Prims.of_int (616)) (Prims.of_int (18)) + (Prims.of_int (616)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (610)) (Prims.of_int (14)) - (Prims.of_int (612)) (Prims.of_int (19))))) + (Prims.of_int (617)) (Prims.of_int (14)) + (Prims.of_int (619)) (Prims.of_int (19))))) (Obj.magic uu___2) (fun lhs1 -> FStar_Tactics_Effect.lift_div_tac @@ -3588,13 +3633,13 @@ let (rewrite' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (623)) (Prims.of_int (20)) - (Prims.of_int (623)) (Prims.of_int (32))))) + (Prims.of_int (630)) (Prims.of_int (20)) + (Prims.of_int (630)) (Prims.of_int (32))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (624)) (Prims.of_int (20)) - (Prims.of_int (625)) (Prims.of_int (29))))) + (Prims.of_int (631)) (Prims.of_int (20)) + (Prims.of_int (632)) (Prims.of_int (29))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -3614,22 +3659,21 @@ let (rewrite' : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (624)) (Prims.of_int (20)) - (Prims.of_int (624)) (Prims.of_int (43))))) + (Prims.of_int (631)) (Prims.of_int (20)) + (Prims.of_int (631)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (625)) (Prims.of_int (20)) - (Prims.of_int (625)) (Prims.of_int (29))))) + (Prims.of_int (632)) (Prims.of_int (20)) + (Prims.of_int (632)) (Prims.of_int (29))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> Obj.magic (FStarC_Tactics_V2_Builtins.rewrite x)) uu___4))) uu___2))) - (fun uu___ -> (fun uu___ -> Obj.magic (fail "rewrite' failed")) uu___) - () + (fun uu___ -> fail "rewrite' failed") () let rec (try_rewrite_equality : FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.binding Prims.list -> @@ -3655,14 +3699,14 @@ let rec (try_rewrite_equality : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (633)) (Prims.of_int (20)) - (Prims.of_int (633)) (Prims.of_int (57))))) + (Prims.of_int (640)) (Prims.of_int (20)) + (Prims.of_int (640)) (Prims.of_int (57))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (633)) (Prims.of_int (14)) - (Prims.of_int (639)) (Prims.of_int (37))))) + (Prims.of_int (640)) (Prims.of_int (14)) + (Prims.of_int (646)) (Prims.of_int (37))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -3706,13 +3750,13 @@ let rec (rewrite_all_context_equalities : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (646)) (Prims.of_int (8)) - (Prims.of_int (646)) (Prims.of_int (40))))) + (Prims.of_int (653)) (Prims.of_int (8)) + (Prims.of_int (653)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (647)) (Prims.of_int (8)) - (Prims.of_int (647)) (Prims.of_int (41))))) + (Prims.of_int (654)) (Prims.of_int (8)) + (Prims.of_int (654)) (Prims.of_int (41))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -3726,12 +3770,12 @@ let (rewrite_eqs_from_context : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (651)) (Prims.of_int (35)) (Prims.of_int (651)) + (Prims.of_int (658)) (Prims.of_int (35)) (Prims.of_int (658)) (Prims.of_int (48))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (651)) (Prims.of_int (4)) (Prims.of_int (651)) + (Prims.of_int (658)) (Prims.of_int (4)) (Prims.of_int (658)) (Prims.of_int (48))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> Obj.magic (rewrite_all_context_equalities uu___2)) @@ -3745,12 +3789,12 @@ let (rewrite_equality : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (654)) (Prims.of_int (27)) (Prims.of_int (654)) + (Prims.of_int (661)) (Prims.of_int (27)) (Prims.of_int (661)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (654)) (Prims.of_int (4)) (Prims.of_int (654)) + (Prims.of_int (661)) (Prims.of_int (4)) (Prims.of_int (661)) (Prims.of_int (40))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> Obj.magic (try_rewrite_equality t uu___1)) uu___1) @@ -3763,48 +3807,45 @@ let (unfold_def : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (657)) (Prims.of_int (10)) (Prims.of_int (657)) + (Prims.of_int (664)) (Prims.of_int (10)) (Prims.of_int (664)) (Prims.of_int (19))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (657)) (Prims.of_int (4)) (Prims.of_int (661)) + (Prims.of_int (664)) (Prims.of_int (4)) (Prims.of_int (668)) (Prims.of_int (46))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> match uu___1 with | FStar_Tactics_NamedView.Tv_FVar fv -> + let uu___2 = + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + FStarC_Reflection_V2_Builtins.implode_qn + (FStarC_Reflection_V2_Builtins.inspect_fv fv))) in Obj.magic - (Obj.repr - (let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Reflection_V2_Builtins.implode_qn - (FStarC_Reflection_V2_Builtins.inspect_fv - fv))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (659)) (Prims.of_int (16)) - (Prims.of_int (659)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (660)) (Prims.of_int (8)) - (Prims.of_int (660)) (Prims.of_int (30))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun n -> - Obj.magic - (FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.delta_fully [n]])) - uu___3))) - | uu___2 -> - Obj.magic (Obj.repr (fail "unfold_def: term is not a fv"))) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (666)) (Prims.of_int (16)) + (Prims.of_int (666)) (Prims.of_int (42))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (667)) (Prims.of_int (8)) + (Prims.of_int (667)) (Prims.of_int (30))))) + (Obj.magic uu___2) + (fun uu___3 -> + (fun n -> + Obj.magic + (FStarC_Tactics_V2_Builtins.norm + [Fstarcompiler.FStar_Pervasives.delta_fully + [n]])) uu___3)) + | uu___2 -> Obj.magic (fail "unfold_def: term is not a fv")) uu___1) let (l_to_r : FStar_Tactics_NamedView.term Prims.list -> @@ -3833,25 +3874,25 @@ let (l_to_r : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (668)) (Prims.of_int (8)) - (Prims.of_int (671)) (Prims.of_int (31))))) + (Prims.of_int (675)) (Prims.of_int (8)) + (Prims.of_int (678)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (668)) (Prims.of_int (8)) - (Prims.of_int (671)) (Prims.of_int (31))))) + (Prims.of_int (675)) (Prims.of_int (8)) + (Prims.of_int (678)) (Prims.of_int (31))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> Obj.magic (uu___4 ())) uu___4))) in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (668)) (Prims.of_int (8)) (Prims.of_int (671)) + (Prims.of_int (675)) (Prims.of_int (8)) (Prims.of_int (678)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (672)) (Prims.of_int (4)) (Prims.of_int (672)) + (Prims.of_int (679)) (Prims.of_int (4)) (Prims.of_int (679)) (Prims.of_int (28))))) (Obj.magic uu___) (fun uu___1 -> (fun first_or_trefl -> Obj.magic (pointwise first_or_trefl)) uu___1) @@ -3888,13 +3929,13 @@ let (__grewrite_derived : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (687)) (Prims.of_int (12)) - (Prims.of_int (687)) (Prims.of_int (33))))) + (Prims.of_int (694)) (Prims.of_int (12)) + (Prims.of_int (694)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (687)) (Prims.of_int (36)) - (Prims.of_int (703)) (Prims.of_int (5))))) (Obj.magic uu___) + (Prims.of_int (694)) (Prims.of_int (36)) + (Prims.of_int (710)) (Prims.of_int (5))))) (Obj.magic uu___) (fun uu___1 -> (fun e -> let uu___1 = @@ -3910,13 +3951,13 @@ let (__grewrite_derived : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (688)) (Prims.of_int (12)) - (Prims.of_int (688)) (Prims.of_int (27))))) + (Prims.of_int (695)) (Prims.of_int (12)) + (Prims.of_int (695)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (689)) (Prims.of_int (4)) - (Prims.of_int (703)) (Prims.of_int (5))))) + (Prims.of_int (696)) (Prims.of_int (4)) + (Prims.of_int (710)) (Prims.of_int (5))))) (Obj.magic uu___1) (fun uu___2 -> (fun e1 -> @@ -3931,17 +3972,17 @@ let (__grewrite_derived : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (691)) + (Prims.of_int (698)) (Prims.of_int (30)) - (Prims.of_int (691)) + (Prims.of_int (698)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (691)) + (Prims.of_int (698)) (Prims.of_int (14)) - (Prims.of_int (691)) + (Prims.of_int (698)) (Prims.of_int (42))))) (Obj.magic uu___5) (fun uu___6 -> @@ -3954,17 +3995,17 @@ let (__grewrite_derived : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (691)) + (Prims.of_int (698)) (Prims.of_int (14)) - (Prims.of_int (691)) + (Prims.of_int (698)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (691)) + (Prims.of_int (698)) (Prims.of_int (8)) - (Prims.of_int (695)) + (Prims.of_int (702)) (Prims.of_int (20))))) (Obj.magic uu___4) (fun uu___5 -> @@ -3983,17 +4024,17 @@ let (__grewrite_derived : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (691)) + (Prims.of_int (698)) (Prims.of_int (8)) - (Prims.of_int (695)) + (Prims.of_int (702)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (689)) + (Prims.of_int (696)) (Prims.of_int (24)) - (Prims.of_int (702)) + (Prims.of_int (709)) (Prims.of_int (40))))) (Obj.magic uu___3) (fun uu___4 -> @@ -4010,17 +4051,17 @@ let (__grewrite_derived : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (697)) + (Prims.of_int (704)) (Prims.of_int (6)) - (Prims.of_int (702)) + (Prims.of_int (709)) (Prims.of_int (40))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (697)) + (Prims.of_int (704)) (Prims.of_int (6)) - (Prims.of_int (702)) + (Prims.of_int (709)) (Prims.of_int (40))))) (Obj.magic uu___5) (fun uu___6 -> @@ -4034,17 +4075,17 @@ let (__grewrite_derived : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (690)) + (Prims.of_int (697)) (Prims.of_int (11)) - (Prims.of_int (690)) + (Prims.of_int (697)) (Prims.of_int (14))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (697)) + (Prims.of_int (704)) (Prims.of_int (9)) - (Prims.of_int (697)) + (Prims.of_int (704)) (Prims.of_int (21))))) (Obj.magic uu___8) (fun uu___9 -> @@ -4059,17 +4100,17 @@ let (__grewrite_derived : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (697)) + (Prims.of_int (704)) (Prims.of_int (9)) - (Prims.of_int (697)) + (Prims.of_int (704)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (697)) + (Prims.of_int (704)) (Prims.of_int (6)) - (Prims.of_int (702)) + (Prims.of_int (709)) (Prims.of_int (40))))) (Obj.magic uu___7) @@ -4121,12 +4162,12 @@ let (grewrite_eq : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (710)) (Prims.of_int (8)) (Prims.of_int (710)) + (Prims.of_int (717)) (Prims.of_int (8)) (Prims.of_int (717)) (Prims.of_int (43))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (710)) (Prims.of_int (2)) (Prims.of_int (722)) + (Prims.of_int (717)) (Prims.of_int (2)) (Prims.of_int (729)) (Prims.of_int (7))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -4140,14 +4181,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (712)) (Prims.of_int (4)) - (Prims.of_int (712)) (Prims.of_int (16))))) + (Prims.of_int (719)) (Prims.of_int (4)) + (Prims.of_int (719)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (713)) (Prims.of_int (4)) - (Prims.of_int (713)) (Prims.of_int (37))))) + (Prims.of_int (720)) (Prims.of_int (4)) + (Prims.of_int (720)) (Prims.of_int (37))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> @@ -4168,14 +4209,14 @@ let (grewrite_eq : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (715)) (Prims.of_int (16)) - (Prims.of_int (715)) (Prims.of_int (52))))) + (Prims.of_int (722)) (Prims.of_int (16)) + (Prims.of_int (722)) (Prims.of_int (52))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (715)) (Prims.of_int (10)) - (Prims.of_int (721)) (Prims.of_int (56))))) + (Prims.of_int (722)) (Prims.of_int (10)) + (Prims.of_int (728)) (Prims.of_int (56))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> @@ -4183,76 +4224,72 @@ let (grewrite_eq : | FStar_Reflection_V2_Formula.Comp (FStar_Reflection_V2_Formula.Eq uu___5, l, r) -> + let uu___6 = + FStarC_Tactics_V2_Builtins.grewrite l r in Obj.magic - (Obj.repr - (let uu___6 = - FStarC_Tactics_V2_Builtins.grewrite l - r in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (717)) - (Prims.of_int (6)) - (Prims.of_int (717)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (718)) - (Prims.of_int (6)) - (Prims.of_int (719)) - (Prims.of_int (39))))) - (Obj.magic uu___6) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (724)) + (Prims.of_int (6)) + (Prims.of_int (724)) + (Prims.of_int (18))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (725)) + (Prims.of_int (6)) + (Prims.of_int (726)) + (Prims.of_int (39))))) + (Obj.magic uu___6) + (fun uu___7 -> (fun uu___7 -> - (fun uu___7 -> - Obj.magic - (iseq - [idtac; - (fun uu___8 -> - let uu___9 = - apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "V2"; - "Derived"; - "__un_sq_eq"]))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (718)) - (Prims.of_int (30)) - (Prims.of_int (718)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (719)) - (Prims.of_int (30)) - (Prims.of_int (719)) - (Prims.of_int (37))))) - (Obj.magic uu___9) + Obj.magic + (iseq + [idtac; + (fun uu___8 -> + let uu___9 = + apply_lemma + (FStarC_Reflection_V2_Builtins.pack_ln + (FStarC_Reflection_V2_Data.Tv_FVar + (FStarC_Reflection_V2_Builtins.pack_fv + ["FStar"; + "Tactics"; + "V2"; + "Derived"; + "__un_sq_eq"]))) in + FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (725)) + (Prims.of_int (30)) + (Prims.of_int (725)) + (Prims.of_int (55))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (726)) + (Prims.of_int (30)) + (Prims.of_int (726)) + (Prims.of_int (37))))) + (Obj.magic uu___9) + (fun uu___10 -> (fun uu___10 -> - (fun uu___10 -> - Obj.magic - (exact - (FStar_Tactics_V2_SyntaxCoercions.binding_to_term - b))) - uu___10))])) - uu___7))) + Obj.magic + (exact + (FStar_Tactics_V2_SyntaxCoercions.binding_to_term + b))) + uu___10))])) uu___7)) | uu___5 -> Obj.magic - (Obj.repr - (fail - "grewrite_eq: binder type is not an equality"))) + (fail + "grewrite_eq: binder type is not an equality")) uu___4))) uu___1) let (admit_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> @@ -4261,12 +4298,12 @@ let (admit_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (726)) (Prims.of_int (2)) (Prims.of_int (726)) + (Prims.of_int (733)) (Prims.of_int (2)) (Prims.of_int (733)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (727)) (Prims.of_int (2)) (Prims.of_int (727)) + (Prims.of_int (734)) (Prims.of_int (2)) (Prims.of_int (734)) (Prims.of_int (16))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -4284,12 +4321,12 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (734)) (Prims.of_int (2)) (Prims.of_int (734)) + (Prims.of_int (741)) (Prims.of_int (2)) (Prims.of_int (741)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (735)) (Prims.of_int (2)) (Prims.of_int (737)) + (Prims.of_int (742)) (Prims.of_int (2)) (Prims.of_int (744)) (Prims.of_int (4))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -4304,13 +4341,13 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (735)) (Prims.of_int (2)) - (Prims.of_int (735)) (Prims.of_int (16))))) + (Prims.of_int (742)) (Prims.of_int (2)) + (Prims.of_int (742)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (736)) (Prims.of_int (2)) - (Prims.of_int (737)) (Prims.of_int (4))))) + (Prims.of_int (743)) (Prims.of_int (2)) + (Prims.of_int (744)) (Prims.of_int (4))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> @@ -4325,14 +4362,14 @@ let (magic_dump_t : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (736)) (Prims.of_int (2)) - (Prims.of_int (736)) (Prims.of_int (13))))) + (Prims.of_int (743)) (Prims.of_int (2)) + (Prims.of_int (743)) (Prims.of_int (13))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (737)) (Prims.of_int (2)) - (Prims.of_int (737)) (Prims.of_int (4))))) + (Prims.of_int (744)) (Prims.of_int (2)) + (Prims.of_int (744)) (Prims.of_int (4))))) (Obj.magic uu___5) (fun uu___6 -> FStar_Tactics_Effect.lift_div_tac @@ -4352,13 +4389,13 @@ let (change_with : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (744)) (Prims.of_int (8)) - (Prims.of_int (744)) (Prims.of_int (22))))) + (Prims.of_int (751)) (Prims.of_int (8)) + (Prims.of_int (751)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (745)) (Prims.of_int (8)) - (Prims.of_int (745)) (Prims.of_int (29))))) + (Prims.of_int (752)) (Prims.of_int (8)) + (Prims.of_int (752)) (Prims.of_int (29))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> Obj.magic (iseq [idtac; trivial])) uu___2)) @@ -4383,32 +4420,29 @@ let finish_by : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (752)) (Prims.of_int (12)) (Prims.of_int (752)) + (Prims.of_int (759)) (Prims.of_int (12)) (Prims.of_int (759)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (753)) (Prims.of_int (4)) (Prims.of_int (754)) + (Prims.of_int (760)) (Prims.of_int (4)) (Prims.of_int (761)) (Prims.of_int (5))))) (Obj.magic uu___) (fun uu___1 -> (fun x -> let uu___1 = - or_else qed - (fun uu___2 -> - (fun uu___2 -> Obj.magic (fail "finish_by: not finished")) - uu___2) in + or_else qed (fun uu___2 -> fail "finish_by: not finished") in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (753)) (Prims.of_int (4)) - (Prims.of_int (753)) (Prims.of_int (58))))) + (Prims.of_int (760)) (Prims.of_int (4)) + (Prims.of_int (760)) (Prims.of_int (58))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (752)) (Prims.of_int (8)) - (Prims.of_int (752)) (Prims.of_int (9))))) + (Prims.of_int (759)) (Prims.of_int (8)) + (Prims.of_int (759)) (Prims.of_int (9))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> x)))) @@ -4426,13 +4460,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (757)) (Prims.of_int (4)) (Prims.of_int (757)) + (Prims.of_int (764)) (Prims.of_int (4)) (Prims.of_int (764)) (Prims.of_int (10))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (757)) (Prims.of_int (11)) - (Prims.of_int (761)) (Prims.of_int (5))))) (Obj.magic uu___) + (Prims.of_int (764)) (Prims.of_int (11)) + (Prims.of_int (768)) (Prims.of_int (5))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> let uu___2 = focus (fun uu___3 -> finish_by t1) in @@ -4441,13 +4475,13 @@ let solve_then : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (758)) (Prims.of_int (12)) - (Prims.of_int (758)) (Prims.of_int (42))))) + (Prims.of_int (765)) (Prims.of_int (12)) + (Prims.of_int (765)) (Prims.of_int (42))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (758)) (Prims.of_int (45)) - (Prims.of_int (761)) (Prims.of_int (5))))) + (Prims.of_int (765)) (Prims.of_int (45)) + (Prims.of_int (768)) (Prims.of_int (5))))) (Obj.magic uu___2) (fun uu___3 -> (fun x -> @@ -4458,17 +4492,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (759)) + (Prims.of_int (766)) (Prims.of_int (12)) - (Prims.of_int (759)) + (Prims.of_int (766)) (Prims.of_int (16))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (760)) + (Prims.of_int (767)) (Prims.of_int (4)) - (Prims.of_int (761)) + (Prims.of_int (768)) (Prims.of_int (5))))) (Obj.magic uu___3) (fun uu___4 -> @@ -4480,17 +4514,17 @@ let solve_then : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (760)) + (Prims.of_int (767)) (Prims.of_int (4)) - (Prims.of_int (760)) + (Prims.of_int (767)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (759)) + (Prims.of_int (766)) (Prims.of_int (8)) - (Prims.of_int (759)) + (Prims.of_int (766)) (Prims.of_int (9))))) (Obj.magic uu___4) (fun uu___5 -> @@ -4514,13 +4548,13 @@ let add_elem : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (764)) (Prims.of_int (4)) - (Prims.of_int (764)) (Prims.of_int (17))))) + (Prims.of_int (771)) (Prims.of_int (4)) + (Prims.of_int (771)) (Prims.of_int (17))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (765)) (Prims.of_int (4)) - (Prims.of_int (769)) (Prims.of_int (5))))) + (Prims.of_int (772)) (Prims.of_int (4)) + (Prims.of_int (776)) (Prims.of_int (5))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -4533,14 +4567,14 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (766)) (Prims.of_int (14)) - (Prims.of_int (766)) (Prims.of_int (18))))) + (Prims.of_int (773)) (Prims.of_int (14)) + (Prims.of_int (773)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (767)) (Prims.of_int (6)) - (Prims.of_int (768)) (Prims.of_int (7))))) + (Prims.of_int (774)) (Prims.of_int (6)) + (Prims.of_int (775)) (Prims.of_int (7))))) (Obj.magic uu___4) (fun uu___5 -> (fun x -> @@ -4551,17 +4585,17 @@ let add_elem : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (767)) + (Prims.of_int (774)) (Prims.of_int (6)) - (Prims.of_int (767)) + (Prims.of_int (774)) (Prims.of_int (12))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (766)) + (Prims.of_int (773)) (Prims.of_int (10)) - (Prims.of_int (766)) + (Prims.of_int (773)) (Prims.of_int (11))))) (Obj.magic uu___5) (fun uu___6 -> @@ -4592,20 +4626,20 @@ let specialize : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (788)) (Prims.of_int (42)) - (Prims.of_int (788)) (Prims.of_int (51))))) + (Prims.of_int (795)) (Prims.of_int (42)) + (Prims.of_int (795)) (Prims.of_int (51))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (788)) (Prims.of_int (36)) - (Prims.of_int (788)) (Prims.of_int (51))))) + (Prims.of_int (795)) (Prims.of_int (36)) + (Prims.of_int (795)) (Prims.of_int (51))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> Obj.magic (exact uu___3)) uu___3)) (fun uu___1 -> FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.delta_only l; - FStar_Pervasives.iota; - FStar_Pervasives.zeta]) + [Fstarcompiler.FStar_Pervasives.delta_only l; + Fstarcompiler.FStar_Pervasives.iota; + Fstarcompiler.FStar_Pervasives.zeta]) let (tlabel : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun l -> let uu___ = goals () in @@ -4613,22 +4647,21 @@ let (tlabel : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (791)) (Prims.of_int (10)) (Prims.of_int (791)) + (Prims.of_int (798)) (Prims.of_int (10)) (Prims.of_int (798)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (791)) (Prims.of_int (4)) (Prims.of_int (794)) + (Prims.of_int (798)) (Prims.of_int (4)) (Prims.of_int (801)) (Prims.of_int (38))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> match uu___1 with - | [] -> Obj.magic (Obj.repr (fail "tlabel: no goals")) + | [] -> Obj.magic (fail "tlabel: no goals") | h::t -> Obj.magic - (Obj.repr - (FStarC_Tactics_V2_Builtins.set_goals - ((FStarC_Tactics_Types.set_label l h) :: t)))) uu___1) + (FStarC_Tactics_V2_Builtins.set_goals + ((FStarC_Tactics_Types.set_label l h) :: t))) uu___1) let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun l -> let uu___ = goals () in @@ -4636,46 +4669,45 @@ let (tlabel' : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (797)) (Prims.of_int (10)) (Prims.of_int (797)) + (Prims.of_int (804)) (Prims.of_int (10)) (Prims.of_int (804)) (Prims.of_int (18))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (797)) (Prims.of_int (4)) (Prims.of_int (801)) + (Prims.of_int (804)) (Prims.of_int (4)) (Prims.of_int (808)) (Prims.of_int (26))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> match uu___1 with - | [] -> Obj.magic (Obj.repr (fail "tlabel': no goals")) + | [] -> Obj.magic (fail "tlabel': no goals") | h::t -> + let uu___2 = + Obj.magic + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> + FStarC_Tactics_Types.set_label + (Prims.strcat l + (FStarC_Tactics_Types.get_label h)) h)) in Obj.magic - (Obj.repr - (let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Tactics_Types.set_label - (Prims.strcat l - (FStarC_Tactics_Types.get_label h)) h)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (800)) (Prims.of_int (16)) - (Prims.of_int (800)) (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (801)) (Prims.of_int (8)) - (Prims.of_int (801)) (Prims.of_int (26))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun h1 -> - Obj.magic - (FStarC_Tactics_V2_Builtins.set_goals (h1 :: - t))) uu___3)))) uu___1) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (807)) (Prims.of_int (16)) + (Prims.of_int (807)) (Prims.of_int (45))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (808)) (Prims.of_int (8)) + (Prims.of_int (808)) (Prims.of_int (26))))) + (Obj.magic uu___2) + (fun uu___3 -> + (fun h1 -> + Obj.magic + (FStarC_Tactics_V2_Builtins.set_goals (h1 :: t))) + uu___3))) uu___1) let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = @@ -4685,13 +4717,13 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (804)) (Prims.of_int (15)) - (Prims.of_int (804)) (Prims.of_int (23))))) + (Prims.of_int (811)) (Prims.of_int (15)) + (Prims.of_int (811)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (804)) (Prims.of_int (14)) - (Prims.of_int (804)) (Prims.of_int (39))))) + (Prims.of_int (811)) (Prims.of_int (14)) + (Prims.of_int (811)) (Prims.of_int (39))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> @@ -4702,14 +4734,14 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (804)) (Prims.of_int (26)) - (Prims.of_int (804)) (Prims.of_int (38))))) + (Prims.of_int (811)) (Prims.of_int (26)) + (Prims.of_int (811)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (804)) (Prims.of_int (14)) - (Prims.of_int (804)) (Prims.of_int (39))))) + (Prims.of_int (811)) (Prims.of_int (14)) + (Prims.of_int (811)) (Prims.of_int (39))))) (Obj.magic uu___5) (fun uu___6 -> FStar_Tactics_Effect.lift_div_tac @@ -4718,12 +4750,12 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (804)) (Prims.of_int (14)) - (Prims.of_int (804)) (Prims.of_int (39))))) + (Prims.of_int (811)) (Prims.of_int (14)) + (Prims.of_int (811)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (804)) (Prims.of_int (4)) (Prims.of_int (804)) + (Prims.of_int (811)) (Prims.of_int (4)) (Prims.of_int (811)) (Prims.of_int (39))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -4732,12 +4764,12 @@ let (focus_all : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (804)) (Prims.of_int (4)) (Prims.of_int (804)) + (Prims.of_int (811)) (Prims.of_int (4)) (Prims.of_int (811)) (Prims.of_int (39))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (805)) (Prims.of_int (4)) (Prims.of_int (805)) + (Prims.of_int (812)) (Prims.of_int (4)) (Prims.of_int (812)) (Prims.of_int (20))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -4766,12 +4798,12 @@ let (bump_nth : Prims.pos -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (820)) (Prims.of_int (28)) - (Prims.of_int (820)) (Prims.of_int (38))))) + (Prims.of_int (827)) (Prims.of_int (28)) + (Prims.of_int (827)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (820)) (Prims.of_int (8)) (Prims.of_int (820)) + (Prims.of_int (827)) (Prims.of_int (8)) (Prims.of_int (827)) (Prims.of_int (38))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -4780,21 +4812,20 @@ let (bump_nth : Prims.pos -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (820)) (Prims.of_int (8)) (Prims.of_int (820)) + (Prims.of_int (827)) (Prims.of_int (8)) (Prims.of_int (827)) (Prims.of_int (38))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (820)) (Prims.of_int (2)) (Prims.of_int (822)) + (Prims.of_int (827)) (Prims.of_int (2)) (Prims.of_int (829)) (Prims.of_int (37))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> match uu___1 with | FStar_Pervasives_Native.None -> - Obj.magic (Obj.repr (fail "bump_nth: not that many goals")) + Obj.magic (fail "bump_nth: not that many goals") | FStar_Pervasives_Native.Some (h, t) -> - Obj.magic - (Obj.repr (FStarC_Tactics_V2_Builtins.set_goals (h :: t)))) + Obj.magic (FStarC_Tactics_V2_Builtins.set_goals (h :: t))) uu___1) let rec (destruct_list : FStar_Tactics_NamedView.term -> @@ -4807,12 +4838,12 @@ let rec (destruct_list : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (825)) (Prims.of_int (21)) (Prims.of_int (825)) + (Prims.of_int (832)) (Prims.of_int (21)) (Prims.of_int (832)) (Prims.of_int (34))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (824)) (Prims.of_int (52)) (Prims.of_int (837)) + (Prims.of_int (831)) (Prims.of_int (52)) (Prims.of_int (844)) (Prims.of_int (27))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -4825,14 +4856,14 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (826)) (Prims.of_int (10)) - (Prims.of_int (826)) (Prims.of_int (22))))) + (Prims.of_int (833)) (Prims.of_int (10)) + (Prims.of_int (833)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (826)) (Prims.of_int (10)) - (Prims.of_int (826)) (Prims.of_int (28))))) + (Prims.of_int (833)) (Prims.of_int (10)) + (Prims.of_int (833)) (Prims.of_int (28))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -4843,14 +4874,14 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (826)) (Prims.of_int (10)) - (Prims.of_int (826)) (Prims.of_int (28))))) + (Prims.of_int (833)) (Prims.of_int (10)) + (Prims.of_int (833)) (Prims.of_int (28))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (826)) (Prims.of_int (4)) - (Prims.of_int (837)) (Prims.of_int (27))))) + (Prims.of_int (833)) (Prims.of_int (4)) + (Prims.of_int (844)) (Prims.of_int (27))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -4873,17 +4904,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (830)) + (Prims.of_int (837)) (Prims.of_int (17)) - (Prims.of_int (830)) + (Prims.of_int (837)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (830)) + (Prims.of_int (837)) (Prims.of_int (11)) - (Prims.of_int (830)) + (Prims.of_int (837)) (Prims.of_int (33))))) (Obj.magic uu___4) (fun uu___5 -> @@ -4912,17 +4943,17 @@ let rec (destruct_list : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (830)) + (Prims.of_int (837)) (Prims.of_int (17)) - (Prims.of_int (830)) + (Prims.of_int (837)) (Prims.of_int (33))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (830)) + (Prims.of_int (837)) (Prims.of_int (11)) - (Prims.of_int (830)) + (Prims.of_int (837)) (Prims.of_int (33))))) (Obj.magic uu___5) (fun uu___6 -> @@ -4961,12 +4992,12 @@ let (get_match_body : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (840)) (Prims.of_int (22)) - (Prims.of_int (840)) (Prims.of_int (35))))) + (Prims.of_int (847)) (Prims.of_int (22)) + (Prims.of_int (847)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (840)) (Prims.of_int (8)) (Prims.of_int (840)) + (Prims.of_int (847)) (Prims.of_int (8)) (Prims.of_int (847)) (Prims.of_int (35))))) (Obj.magic uu___2) (fun uu___3 -> FStar_Tactics_Effect.lift_div_tac @@ -4975,43 +5006,48 @@ let (get_match_body : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (840)) (Prims.of_int (8)) (Prims.of_int (840)) + (Prims.of_int (847)) (Prims.of_int (8)) (Prims.of_int (847)) (Prims.of_int (35))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (840)) (Prims.of_int (2)) (Prims.of_int (844)) + (Prims.of_int (847)) (Prims.of_int (2)) (Prims.of_int (851)) (Prims.of_int (46))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> match uu___2 with - | FStar_Pervasives_Native.None -> Obj.magic (Obj.repr (fail "")) + | FStar_Pervasives_Native.None -> Obj.magic (fail "") | FStar_Pervasives_Native.Some t -> + let uu___3 = + FStar_Tactics_V2_SyntaxHelpers.inspect_unascribe t in Obj.magic - (Obj.repr - (let uu___3 = - FStar_Tactics_V2_SyntaxHelpers.inspect_unascribe t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (842)) (Prims.of_int (20)) - (Prims.of_int (842)) (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (842)) (Prims.of_int (14)) - (Prims.of_int (844)) (Prims.of_int (46))))) - (Obj.magic uu___3) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (849)) (Prims.of_int (20)) + (Prims.of_int (849)) (Prims.of_int (39))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (849)) (Prims.of_int (14)) + (Prims.of_int (851)) (Prims.of_int (46))))) + (Obj.magic uu___3) + (fun uu___4 -> (fun uu___4 -> match uu___4 with | FStar_Tactics_NamedView.Tv_Match (sc, uu___5, uu___6) -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> sc) - | uu___5 -> fail "Goal is not a match")))) uu___2) + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___7 -> sc))) + | uu___5 -> + Obj.magic + (Obj.repr (fail "Goal is not a match"))) + uu___4))) uu___2) let rec last : 'a . 'a Prims.list -> ('a, unit) FStar_Tactics_Effect.tac_repr = fun uu___ -> @@ -5031,13 +5067,13 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (857)) (Prims.of_int (14)) - (Prims.of_int (857)) (Prims.of_int (31))))) + (Prims.of_int (864)) (Prims.of_int (14)) + (Prims.of_int (864)) (Prims.of_int (31))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (857)) (Prims.of_int (34)) - (Prims.of_int (863)) (Prims.of_int (20))))) + (Prims.of_int (864)) (Prims.of_int (34)) + (Prims.of_int (870)) (Prims.of_int (20))))) (Obj.magic uu___2) (fun uu___3 -> (fun x -> @@ -5048,14 +5084,14 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (858)) (Prims.of_int (14)) - (Prims.of_int (858)) (Prims.of_int (26))))) + (Prims.of_int (865)) (Prims.of_int (14)) + (Prims.of_int (865)) (Prims.of_int (26))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (859)) (Prims.of_int (6)) - (Prims.of_int (863)) (Prims.of_int (20))))) + (Prims.of_int (866)) (Prims.of_int (6)) + (Prims.of_int (870)) (Prims.of_int (20))))) (Obj.magic uu___3) (fun uu___4 -> (fun uu___4 -> @@ -5069,17 +5105,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (860)) + (Prims.of_int (867)) (Prims.of_int (17)) - (Prims.of_int (860)) + (Prims.of_int (867)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (860)) + (Prims.of_int (867)) (Prims.of_int (32)) - (Prims.of_int (863)) + (Prims.of_int (870)) (Prims.of_int (19))))) (Obj.magic uu___6) (fun uu___7 -> @@ -5091,17 +5127,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (861)) + (Prims.of_int (868)) (Prims.of_int (16)) - (Prims.of_int (861)) + (Prims.of_int (868)) (Prims.of_int (23))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (862)) + (Prims.of_int (869)) (Prims.of_int (8)) - (Prims.of_int (863)) + (Prims.of_int (870)) (Prims.of_int (19))))) (Obj.magic uu___7) (fun uu___8 -> @@ -5114,17 +5150,17 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (862)) + (Prims.of_int (869)) (Prims.of_int (8)) - (Prims.of_int (862)) + (Prims.of_int (869)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (863)) + (Prims.of_int (870)) (Prims.of_int (8)) - (Prims.of_int (863)) + (Prims.of_int (870)) (Prims.of_int (19))))) (Obj.magic uu___8) (fun uu___9 -> @@ -5132,7 +5168,7 @@ let (branch_on_match : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = Obj.magic ( FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.iota])) + [Fstarcompiler.FStar_Pervasives.iota])) uu___9))) uu___8))) uu___7)))) uu___4))) uu___3)) @@ -5146,12 +5182,12 @@ let (nth_var : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (872)) (Prims.of_int (11)) (Prims.of_int (872)) + (Prims.of_int (879)) (Prims.of_int (11)) (Prims.of_int (879)) (Prims.of_int (22))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (872)) (Prims.of_int (25)) (Prims.of_int (877)) + (Prims.of_int (879)) (Prims.of_int (25)) (Prims.of_int (884)) (Prims.of_int (15))))) (Obj.magic uu___) (fun uu___1 -> (fun bs -> @@ -5167,45 +5203,52 @@ let (nth_var : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (873)) (Prims.of_int (16)) - (Prims.of_int (873)) (Prims.of_int (65))))) + (Prims.of_int (880)) (Prims.of_int (16)) + (Prims.of_int (880)) (Prims.of_int (65))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (873)) (Prims.of_int (68)) - (Prims.of_int (877)) (Prims.of_int (15))))) + (Prims.of_int (880)) (Prims.of_int (68)) + (Prims.of_int (884)) (Prims.of_int (15))))) (Obj.magic uu___1) (fun uu___2 -> (fun k -> let uu___2 = if k < Prims.int_zero - then Obj.magic (fail "not enough binders") + then + Obj.magic (Obj.repr (fail "not enough binders")) else Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> k)) in + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> k))) in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (874)) (Prims.of_int (16)) - (Prims.of_int (874)) (Prims.of_int (62))))) + (Prims.of_int (881)) (Prims.of_int (16)) + (Prims.of_int (881)) (Prims.of_int (62))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (875)) (Prims.of_int (2)) - (Prims.of_int (877)) (Prims.of_int (15))))) + (Prims.of_int (882)) (Prims.of_int (2)) + (Prims.of_int (884)) (Prims.of_int (15))))) (Obj.magic uu___2) - (fun k1 -> - match FStar_List_Tot_Base.nth bs k1 with - | FStar_Pervasives_Native.None -> - fail "not enough binders" - | FStar_Pervasives_Native.Some b -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> b)))) uu___2))) uu___1) + (fun uu___3 -> + (fun k1 -> + match FStar_List_Tot_Base.nth bs k1 with + | FStar_Pervasives_Native.None -> + Obj.magic + (Obj.repr (fail "not enough binders")) + | FStar_Pervasives_Native.Some b -> + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> b)))) uu___3))) + uu___2))) uu___1) let rec (mk_abs : FStar_Tactics_NamedView.binder Prims.list -> FStar_Tactics_NamedView.term -> @@ -5229,12 +5272,14 @@ let rec (mk_abs : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (884)) (Prims.of_int (13)) - (Prims.of_int (884)) (Prims.of_int (27))))) + (Prims.of_int (891)) (Prims.of_int (13)) + (Prims.of_int (891)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" Prims.int_zero - Prims.int_zero Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.V2.Derived.fst" + (Prims.of_int (892)) (Prims.of_int (4)) + (Prims.of_int (892)) (Prims.of_int (22))))) (Obj.magic uu___) (fun t' -> FStar_Tactics_Effect.lift_div_tac @@ -5256,12 +5301,12 @@ let (namedv_to_simple_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (889)) (Prims.of_int (11)) (Prims.of_int (889)) + (Prims.of_int (896)) (Prims.of_int (11)) (Prims.of_int (896)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (891)) (Prims.of_int (4)) (Prims.of_int (895)) + (Prims.of_int (898)) (Prims.of_int (4)) (Prims.of_int (902)) (Prims.of_int (16))))) (Obj.magic uu___) (fun uu___1 -> (fun nv -> @@ -5272,13 +5317,13 @@ let (namedv_to_simple_binder : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (893)) (Prims.of_int (13)) - (Prims.of_int (893)) (Prims.of_int (27))))) + (Prims.of_int (900)) (Prims.of_int (13)) + (Prims.of_int (900)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (891)) (Prims.of_int (4)) - (Prims.of_int (895)) (Prims.of_int (16))))) + (Prims.of_int (898)) (Prims.of_int (4)) + (Prims.of_int (902)) (Prims.of_int (16))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac @@ -5325,14 +5370,14 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (916)) (Prims.of_int (19)) - (Prims.of_int (916)) (Prims.of_int (36))))) + (Prims.of_int (923)) (Prims.of_int (19)) + (Prims.of_int (923)) (Prims.of_int (36))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (915)) (Prims.of_int (42)) - (Prims.of_int (917)) (Prims.of_int (25))))) + (Prims.of_int (922)) (Prims.of_int (42)) + (Prims.of_int (924)) (Prims.of_int (25))))) (Obj.magic uu___3) (fun uu___4 -> FStar_Tactics_Effect.lift_div_tac @@ -5344,13 +5389,13 @@ let (string_to_term_with_lb : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (915)) (Prims.of_int (6)) - (Prims.of_int (918)) (Prims.of_int (27))))) + (Prims.of_int (922)) (Prims.of_int (6)) + (Prims.of_int (925)) (Prims.of_int (27))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (914)) (Prims.of_int (3)) - (Prims.of_int (922)) (Prims.of_int (21))))) + (Prims.of_int (921)) (Prims.of_int (3)) + (Prims.of_int (929)) (Prims.of_int (21))))) (Obj.magic uu___) (fun uu___1 -> (fun uu___1 -> @@ -5366,14 +5411,14 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (918)) (Prims.of_int (30)) - (Prims.of_int (922)) (Prims.of_int (21))))) + (Prims.of_int (925)) (Prims.of_int (30)) + (Prims.of_int (929)) (Prims.of_int (21))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (918)) (Prims.of_int (30)) - (Prims.of_int (922)) (Prims.of_int (21))))) + (Prims.of_int (925)) (Prims.of_int (30)) + (Prims.of_int (929)) (Prims.of_int (21))))) (Obj.magic uu___2) (fun uu___3 -> (fun uu___3 -> @@ -5386,17 +5431,17 @@ let (string_to_term_with_lb : (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (919)) + (Prims.of_int (926)) (Prims.of_int (12)) - (Prims.of_int (919)) + (Prims.of_int (926)) (Prims.of_int (30))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (920)) + (Prims.of_int (927)) (Prims.of_int (4)) - (Prims.of_int (922)) + (Prims.of_int (929)) (Prims.of_int (21))))) (Obj.magic uu___4) (fun uu___5 -> @@ -5437,12 +5482,12 @@ let (smt_sync : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (934)) (Prims.of_int (40)) (Prims.of_int (934)) + (Prims.of_int (941)) (Prims.of_int (40)) (Prims.of_int (941)) (Prims.of_int (56))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (934)) (Prims.of_int (29)) (Prims.of_int (934)) + (Prims.of_int (941)) (Prims.of_int (29)) (Prims.of_int (941)) (Prims.of_int (56))))) (Obj.magic uu___1) (fun uu___2 -> (fun uu___2 -> @@ -5456,13 +5501,13 @@ let (smt_sync' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (938)) (Prims.of_int (15)) - (Prims.of_int (938)) (Prims.of_int (29))))) + (Prims.of_int (945)) (Prims.of_int (15)) + (Prims.of_int (945)) (Prims.of_int (29))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (938)) (Prims.of_int (32)) - (Prims.of_int (942)) (Prims.of_int (20))))) + (Prims.of_int (945)) (Prims.of_int (32)) + (Prims.of_int (949)) (Prims.of_int (20))))) (Obj.magic uu___) (fun uu___1 -> (fun vcfg -> @@ -5529,13 +5574,13 @@ let (smt_sync' : (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (939)) (Prims.of_int (18)) - (Prims.of_int (940)) (Prims.of_int (68))))) + (Prims.of_int (946)) (Prims.of_int (18)) + (Prims.of_int (947)) (Prims.of_int (68))))) (FStar_Sealed.seal (Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Derived.fst" - (Prims.of_int (942)) (Prims.of_int (4)) - (Prims.of_int (942)) (Prims.of_int (20))))) + (Prims.of_int (949)) (Prims.of_int (4)) + (Prims.of_int (949)) (Prims.of_int (20))))) (Obj.magic uu___1) (fun uu___2 -> (fun vcfg' -> diff --git a/stage0/fstar-lib/generated/FStar_Tactics_V2_Logic.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_Logic.ml similarity index 82% rename from stage0/fstar-lib/generated/FStar_Tactics_V2_Logic.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_Logic.ml index 6fb9719deca..bf085edee34 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_V2_Logic.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_Logic.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (cur_goal : unit -> (FStarC_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) @@ -92,17 +93,17 @@ let (l_revert : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = "Lemmas"; "revert_squash"]))))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.l_revert" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.l_revert" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.l_revert (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_revert) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 l_revert) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let rec (l_revert_all : FStar_Tactics_NamedView.binding Prims.list -> (unit, unit) FStar_Tactics_Effect.tac_repr) @@ -133,18 +134,19 @@ let rec (l_revert_all : (fun uu___2 -> Obj.magic (l_revert_all tl)) uu___2)))) uu___ let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.l_revert_all" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.l_revert_all" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.l_revert_all (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_revert_all) - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binding) - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + l_revert_all) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (forall_intro : unit -> (FStar_Tactics_NamedView.binding, unit) FStar_Tactics_Effect.tac_repr) @@ -176,17 +178,18 @@ let (forall_intro : (fun uu___2 -> Obj.magic (FStarC_Tactics_V2_Builtins.intro ())) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.forall_intro" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.forall_intro" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.forall_intro (plugin)" - (FStarC_Tactics_Native.from_tactic_1 forall_intro) - FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + forall_intro) Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) let (forall_intro_as : Prims.string -> (FStar_Tactics_NamedView.binding, unit) FStar_Tactics_Effect.tac_repr) @@ -218,35 +221,39 @@ let (forall_intro_as : (fun uu___1 -> Obj.magic (FStar_Tactics_V2_Derived.intro_as s)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.forall_intro_as" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.forall_intro_as (plugin)" - (FStarC_Tactics_Native.from_tactic_1 forall_intro_as) - FStarC_Syntax_Embeddings.e_string - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + forall_intro_as) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) let (forall_intros : unit -> (FStar_Tactics_NamedView.binding Prims.list, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.repeat1 forall_intro let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.forall_intros" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.forall_intros (plugin)" - (FStarC_Tactics_Native.from_tactic_1 forall_intros) - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binding) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + forall_intros) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding) + psc ncb us args) let (split : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.try_with @@ -263,22 +270,19 @@ let (split : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = "Logic"; "Lemmas"; "split_lem"])))) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic (FStar_Tactics_V2_Derived.fail "Could not split goal")) - uu___1) + (fun uu___1 -> FStar_Tactics_V2_Derived.fail "Could not split goal") let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.split" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.split" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.split (plugin)" - (FStarC_Tactics_Native.from_tactic_1 split) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 split) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (implies_intro : unit -> (FStar_Tactics_NamedView.binding, unit) FStar_Tactics_Effect.tac_repr) @@ -310,17 +314,19 @@ let (implies_intro : (fun uu___2 -> Obj.magic (FStarC_Tactics_V2_Builtins.intro ())) uu___2) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.implies_intro" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.implies_intro (plugin)" - (FStarC_Tactics_Native.from_tactic_1 implies_intro) - FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + implies_intro) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) let (implies_intro_as : Prims.string -> (FStar_Tactics_NamedView.binding, unit) FStar_Tactics_Effect.tac_repr) @@ -352,69 +358,75 @@ let (implies_intro_as : (fun uu___1 -> Obj.magic (FStar_Tactics_V2_Derived.intro_as s)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.implies_intro_as" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.implies_intro_as (plugin)" - (FStarC_Tactics_Native.from_tactic_1 implies_intro_as) - FStarC_Syntax_Embeddings.e_string - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + implies_intro_as) + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) let (implies_intros : unit -> (FStar_Tactics_NamedView.binding Prims.list, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.repeat1 implies_intro let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.implies_intros" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.implies_intros (plugin)" - (FStarC_Tactics_Native.from_tactic_1 implies_intros) - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binding) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + implies_intros) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding) + psc ncb us args) let (l_intro : unit -> (FStar_Tactics_NamedView.binding, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.or_else forall_intro implies_intro let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.l_intro" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.l_intro" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.l_intro (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_intro) - FStarC_Syntax_Embeddings.e_unit - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 l_intro) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) let (l_intros : unit -> (FStar_Tactics_NamedView.binding Prims.list, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.repeat l_intro let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.l_intros" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.l_intros" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.l_intros (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_intros) - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binding) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 l_intros) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding) + psc ncb us args) let (squash_intro : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.apply @@ -423,17 +435,17 @@ let (squash_intro : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStarC_Reflection_V2_Builtins.pack_fv ["FStar"; "Squash"; "return_squash"]))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.squash_intro" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.squash_intro" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.squash_intro (plugin)" - (FStarC_Tactics_Native.from_tactic_1 squash_intro) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + squash_intro) Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (l_exact : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -458,33 +470,33 @@ let (l_exact : (fun uu___2 -> Obj.magic (FStar_Tactics_V2_Derived.exact t)) uu___2)) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.l_exact" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.l_exact" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.l_exact (plugin)" - (FStarC_Tactics_Native.from_tactic_1 l_exact) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 l_exact) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (hyp : FStar_Tactics_NamedView.namedv -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun x -> l_exact (FStar_Tactics_V2_SyntaxCoercions.namedv_to_term x) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.hyp" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.hyp" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.hyp (plugin)" - (FStarC_Tactics_Native.from_tactic_1 hyp) - FStarC_Reflection_V2_Embeddings.e_namedv_view - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 hyp) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_namedv_view + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (pose_lemma : FStar_Tactics_NamedView.term -> (FStar_Tactics_NamedView.binding, unit) FStar_Tactics_Effect.tac_repr) @@ -523,9 +535,11 @@ let (pose_lemma : match c with | FStarC_Reflection_V2_Data.C_Lemma (pre, post, uu___2) -> Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> (pre, post))) - | uu___2 -> Obj.magic (FStar_Tactics_V2_Derived.fail "") in + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___3 -> (pre, post)))) + | uu___2 -> + Obj.magic (Obj.repr (FStar_Tactics_V2_Derived.fail "")) in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -880,17 +894,18 @@ let (pose_lemma : uu___6))) uu___5))) uu___4))) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.pose_lemma" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.pose_lemma" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.pose_lemma (plugin)" - (FStarC_Tactics_Native.from_tactic_1 pose_lemma) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 pose_lemma) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) let (explode : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = @@ -942,17 +957,17 @@ let (explode : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (Prims.of_int (64))))) (Obj.magic uu___1) (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.explode" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.explode" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.explode (plugin)" - (FStarC_Tactics_Native.from_tactic_1 explode) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 explode) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let rec (visit : (unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) -> (unit, unit) FStar_Tactics_Effect.tac_repr) @@ -1127,123 +1142,120 @@ let rec (simplify_eq_implication : match r with | FStar_Pervasives_Native.None -> Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Not an equality implication")) + (FStar_Tactics_V2_Derived.fail + "Not an equality implication") | FStar_Pervasives_Native.Some (uu___4, rhs) -> + let uu___5 = implies_intro () in Obj.magic - (Obj.repr - (let uu___5 = implies_intro () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Logic.fst" - (Prims.of_int (143)) - (Prims.of_int (19)) - (Prims.of_int (143)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Logic.fst" - (Prims.of_int (144)) - (Prims.of_int (8)) - (Prims.of_int (146)) - (Prims.of_int (37))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun eq_h -> - let uu___6 = - FStarC_Tactics_V2_Builtins.rewrite - eq_h in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Logic.fst" - (Prims.of_int (144)) - (Prims.of_int (8)) - (Prims.of_int (144)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Logic.fst" - (Prims.of_int (145)) - (Prims.of_int (8)) - (Prims.of_int (146)) - (Prims.of_int (37))))) - (Obj.magic uu___6) + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Logic.fst" + (Prims.of_int (143)) + (Prims.of_int (19)) + (Prims.of_int (143)) + (Prims.of_int (35))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Logic.fst" + (Prims.of_int (144)) + (Prims.of_int (8)) + (Prims.of_int (146)) + (Prims.of_int (37))))) + (Obj.magic uu___5) + (fun uu___6 -> + (fun eq_h -> + let uu___6 = + FStarC_Tactics_V2_Builtins.rewrite + eq_h in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Logic.fst" + (Prims.of_int (144)) + (Prims.of_int (8)) + (Prims.of_int (144)) + (Prims.of_int (20))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Logic.fst" + (Prims.of_int (145)) + (Prims.of_int (8)) + (Prims.of_int (146)) + (Prims.of_int (37))))) + (Obj.magic uu___6) + (fun uu___7 -> (fun uu___7 -> - (fun uu___7 -> - let uu___8 = - FStarC_Tactics_V2_Builtins.clear_top - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind + let uu___8 = + FStarC_Tactics_V2_Builtins.clear_top + () in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal ( - FStar_Sealed.seal - (Obj.magic + Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Logic.fst" (Prims.of_int (145)) (Prims.of_int (8)) (Prims.of_int (145)) (Prims.of_int (20))))) + (FStar_Sealed.seal ( - FStar_Sealed.seal - (Obj.magic + Obj.magic (FStar_Range.mk_range "FStar.Tactics.V2.Logic.fst" (Prims.of_int (146)) (Prims.of_int (8)) (Prims.of_int (146)) (Prims.of_int (37))))) - ( - Obj.magic + (Obj.magic uu___8) - ( - fun - uu___9 -> + (fun uu___9 + -> (fun uu___9 -> Obj.magic (visit simplify_eq_implication)) uu___9))) - uu___7))) - uu___6)))) uu___4))) - uu___3))) uu___2) + uu___7))) uu___6))) + uu___4))) uu___3))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.simplify_eq_implication" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.simplify_eq_implication (plugin)" - (FStarC_Tactics_Native.from_tactic_1 simplify_eq_implication) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + simplify_eq_implication) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (rewrite_all_equalities : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> visit simplify_eq_implication let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.rewrite_all_equalities" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.rewrite_all_equalities (plugin)" - (FStarC_Tactics_Native.from_tactic_1 rewrite_all_equalities) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + rewrite_all_equalities) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let rec (unfold_definition_and_simplify_eq : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1319,67 +1331,63 @@ let rec (unfold_definition_and_simplify_eq : match r with | FStar_Pervasives_Native.None -> Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Not an equality implication")) + (FStar_Tactics_V2_Derived.fail + "Not an equality implication") | FStar_Pervasives_Native.Some (uu___5, rhs) -> + let uu___6 = implies_intro () in Obj.magic - (Obj.repr - (let uu___6 = - implies_intro () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Logic.fst" - (Prims.of_int (163)) - (Prims.of_int (23)) - (Prims.of_int (163)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.V2.Logic.fst" - (Prims.of_int (164)) - (Prims.of_int (12)) - (Prims.of_int (166)) - (Prims.of_int (66))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun eq_h -> - let uu___7 = - FStarC_Tactics_V2_Builtins.rewrite - eq_h in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Logic.fst" + (Prims.of_int (163)) + (Prims.of_int (23)) + (Prims.of_int (163)) + (Prims.of_int (39))))) + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range + "FStar.Tactics.V2.Logic.fst" + (Prims.of_int (164)) + (Prims.of_int (12)) + (Prims.of_int (166)) + (Prims.of_int (66))))) + (Obj.magic uu___6) + (fun uu___7 -> + (fun eq_h -> + let uu___7 = + FStarC_Tactics_V2_Builtins.rewrite + eq_h in + Obj.magic + (FStar_Tactics_Effect.tac_bind + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.V2.Logic.fst" (Prims.of_int (164)) (Prims.of_int (12)) (Prims.of_int (164)) (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range + (FStar_Sealed.seal + (Obj.magic + (FStar_Range.mk_range "FStar.Tactics.V2.Logic.fst" (Prims.of_int (165)) (Prims.of_int (12)) (Prims.of_int (166)) (Prims.of_int (66))))) - (Obj.magic - uu___7) + (Obj.magic + uu___7) + (fun uu___8 -> (fun uu___8 -> - (fun - uu___8 -> - let uu___9 + let uu___9 = FStarC_Tactics_V2_Builtins.clear_top () in - Obj.magic + Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal (Obj.magic @@ -1413,23 +1421,23 @@ let rec (unfold_definition_and_simplify_eq : unfold_definition_and_simplify_eq tm))) uu___10))) - uu___8))) - uu___7)))) uu___5)))) + uu___8))) + uu___7))) uu___5)))) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.unfold_definition_and_simplify_eq" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.unfold_definition_and_simplify_eq (plugin)" - (FStarC_Tactics_Native.from_tactic_1 + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 unfold_definition_and_simplify_eq) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (unsquash : FStar_Tactics_NamedView.term -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) @@ -1485,9 +1493,10 @@ let (unsquash : (Prims.of_int (184)) (Prims.of_int (20))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" - Prims.int_zero Prims.int_zero - Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.V2.Logic.fst" + (Prims.of_int (185)) (Prims.of_int (4)) + (Prims.of_int (185)) (Prims.of_int (19))))) (Obj.magic uu___3) (fun b -> FStar_Tactics_Effect.lift_div_tac @@ -1497,17 +1506,18 @@ let (unsquash : (FStar_Tactics_V2_SyntaxCoercions.binding_to_namedv b)))))) uu___2))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.unsquash" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.unsquash" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.unsquash (plugin)" - (FStarC_Tactics_Native.from_tactic_1 unsquash) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 unsquash) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term psc ncb + us args) let (cases_or : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1520,17 +1530,17 @@ let (cases_or : ["FStar"; "Tactics"; "V1"; "Logic"; "Lemmas"; "or_ind"]))) [o]) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.cases_or" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.cases_or" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.cases_or (plugin)" - (FStarC_Tactics_Native.from_tactic_1 cases_or) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 cases_or) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (cases_bool : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1635,17 +1645,17 @@ let (cases_bool : FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> ()))))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.cases_bool" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.cases_bool" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.cases_bool (plugin)" - (FStarC_Tactics_Native.from_tactic_1 cases_bool) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 cases_bool) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (left : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.apply_lemma @@ -1654,17 +1664,17 @@ let (left : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStarC_Reflection_V2_Builtins.pack_fv ["FStar"; "Tactics"; "V1"; "Logic"; "Lemmas"; "or_intro_1"]))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.left" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.left" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.left (plugin)" - (FStarC_Tactics_Native.from_tactic_1 left) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 left) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (right : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> FStar_Tactics_V2_Derived.apply_lemma @@ -1673,17 +1683,17 @@ let (right : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = (FStarC_Reflection_V2_Builtins.pack_fv ["FStar"; "Tactics"; "V1"; "Logic"; "Lemmas"; "or_intro_2"]))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.right" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.right" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.right (plugin)" - (FStarC_Tactics_Native.from_tactic_1 right) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 right) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (and_elim : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1720,17 +1730,17 @@ let (and_elim : "__and_elim'"]))), (t, FStarC_Reflection_V2_Data.Q_Explicit))))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.and_elim" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.and_elim" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.and_elim (plugin)" - (FStarC_Tactics_Native.from_tactic_1 and_elim) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 and_elim) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (destruct_and : FStar_Tactics_NamedView.term -> ((FStar_Tactics_NamedView.binding * FStar_Tactics_NamedView.binding), @@ -1788,19 +1798,21 @@ let (destruct_and : (fun uu___6 -> (uu___3, uu___5))))) uu___3))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.destruct_and" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.destruct_and" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.destruct_and (plugin)" - (FStarC_Tactics_Native.from_tactic_1 destruct_and) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_binding - FStarC_Reflection_V2_Embeddings.e_binding) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + destruct_and) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding) + psc ncb us args) let (witness : FStar_Tactics_NamedView.term -> (unit, unit) FStar_Tactics_Effect.tac_repr) = @@ -1825,17 +1837,17 @@ let (witness : (fun uu___1 -> (fun uu___1 -> Obj.magic (FStar_Tactics_V2_Derived.exact t)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.witness" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.witness" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.witness (plugin)" - (FStarC_Tactics_Native.from_tactic_1 witness) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 witness) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let (elim_exists : FStar_Tactics_NamedView.term -> ((FStar_Tactics_NamedView.binding * FStar_Tactics_NamedView.binding), @@ -1905,19 +1917,20 @@ let (elim_exists : FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> (x, pf))))) uu___3))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.elim_exists" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.elim_exists" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.elim_exists (plugin)" - (FStarC_Tactics_Native.from_tactic_1 elim_exists) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_binding - FStarC_Reflection_V2_Embeddings.e_binding) psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 elim_exists) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding) + psc ncb us args) let (instantiate : FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.term -> @@ -1968,23 +1981,21 @@ let (instantiate : FStarC_Reflection_V2_Data.Q_Explicit)))), (x, FStarC_Reflection_V2_Data.Q_Explicit))))) (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_V2_Derived.fail "could not instantiate")) - uu___1)) + FStar_Tactics_V2_Derived.fail "could not instantiate")) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.instantiate" - (Prims.of_int (3)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.instantiate" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.V2.Logic.instantiate (plugin)" - (FStarC_Tactics_Native.from_tactic_2 instantiate) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 instantiate) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) let (instantiate_as : FStar_Tactics_NamedView.term -> FStar_Tactics_NamedView.term -> @@ -2011,19 +2022,21 @@ let (instantiate_as : (fun b -> Obj.magic (FStarC_Tactics_V2_Builtins.rename_to b s)) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.instantiate_as" (Prims.of_int (4)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 "FStar.Tactics.V2.Logic.instantiate_as (plugin)" - (FStarC_Tactics_Native.from_tactic_3 instantiate_as) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_string - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_3 + instantiate_as) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Syntax_Embeddings.e_string + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) let rec (sk_binder' : FStar_Tactics_NamedView.binding Prims.list -> FStar_Tactics_NamedView.binding -> @@ -2114,11 +2127,18 @@ let rec (sk_binder' : (Prims.of_int (38))))) (Obj.magic uu___5) (fun uu___6 -> - if uu___6 - then FStar_Tactics_V2_Derived.fail "no" - else - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> ())) in + (fun uu___6 -> + if uu___6 + then + Obj.magic + (Obj.repr + (FStar_Tactics_V2_Derived.fail + "no")) + else + Obj.magic + (Obj.repr + (FStar_Tactics_Effect.lift_div_tac + (fun uu___8 -> ())))) uu___6) in Obj.magic (FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -2270,22 +2290,22 @@ let (skolem : (fun uu___2 -> (fun bs -> Obj.magic (FStar_Tactics_Util.map sk_binder bs)) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.skolem" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.skolem" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.skolem (plugin)" - (FStarC_Tactics_Native.from_tactic_1 skolem) - FStarC_Syntax_Embeddings.e_unit - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_binding) - FStarC_Reflection_V2_Embeddings.e_binding)) psc ncb us - args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 skolem) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding)) + psc ncb us args) let (easy_fill : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = fun uu___ -> let uu___1 = @@ -2351,48 +2371,53 @@ let (easy_fill : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = Obj.magic (FStar_Tactics_V2_Derived.smt ())) uu___4))) uu___2) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.easy_fill" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.easy_fill" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.easy_fill (plugin)" - (FStarC_Tactics_Native.from_tactic_1 easy_fill) - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 easy_fill) + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit + Fstarcompiler.FStarC_Syntax_Embeddings.e_unit psc ncb us args) let easy : 'a . 'a -> 'a = fun x -> x let _ = - FStarC_Tactics_Native.register_plugin "FStar.Tactics.V2.Logic.easy" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_plugin + "FStar.Tactics.V2.Logic.easy" (Prims.of_int (2)) (fun _psc -> fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.V2.Logic.easy" (fun _ -> match args with | (tv_0, _)::args_tail -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_1 - (FStarC_Syntax_Embeddings.mk_any_emb tv_0) - (FStarC_Syntax_Embeddings.mk_any_emb tv_0) easy - (FStarC_Ident.lid_of_str + (Fstarcompiler.FStarC_Syntax_Embeddings.arrow_as_prim_step_1 + (Fstarcompiler.FStarC_Syntax_Embeddings.mk_any_emb + tv_0) + (Fstarcompiler.FStarC_Syntax_Embeddings.mk_any_emb + tv_0) easy + (Fstarcompiler.FStarC_Ident.lid_of_str "FStar.Tactics.V2.Logic.easy") cb us) args_tail | _ -> failwith "arity mismatch")) (fun cb -> fun us -> fun args -> - FStarC_Syntax_Embeddings.debug_wrap "FStar.Tactics.V2.Logic.easy" + Fstarcompiler.FStarC_Syntax_Embeddings.debug_wrap + "FStar.Tactics.V2.Logic.easy" (fun _ -> match args with | (tv_0, _)::args_tail -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 - (FStarC_TypeChecker_NBETerm.mk_any_emb tv_0) - (FStarC_TypeChecker_NBETerm.mk_any_emb tv_0) easy - (FStarC_Ident.lid_of_str "FStar.Tactics.V2.Logic.easy") - cb us) args_tail + (Fstarcompiler.FStarC_TypeChecker_NBETerm.arrow_as_prim_step_1 + (Fstarcompiler.FStarC_TypeChecker_NBETerm.mk_any_emb + tv_0) + (Fstarcompiler.FStarC_TypeChecker_NBETerm.mk_any_emb + tv_0) easy + (Fstarcompiler.FStarC_Ident.lid_of_str + "FStar.Tactics.V2.Logic.easy") cb us) args_tail | _ -> failwith "arity mismatch")) let (using_lemma : FStar_Tactics_NamedView.term -> @@ -2453,19 +2478,18 @@ let (using_lemma : "lem3_fa"]))), (t, FStarC_Reflection_V2_Data.Q_Explicit))))) (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_Tactics_V2_Derived.fail - "using_lemma: failed to instantiate")) uu___2))) + FStar_Tactics_V2_Derived.fail + "using_lemma: failed to instantiate"))) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.Logic.using_lemma" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.Logic.using_lemma" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.Logic.using_lemma (plugin)" - (FStarC_Tactics_Native.from_tactic_1 using_lemma) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_binding psc ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 using_lemma) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_binding psc + ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_V2_SyntaxCoercions.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_SyntaxCoercions.ml similarity index 98% rename from stage0/fstar-lib/generated/FStar_Tactics_V2_SyntaxCoercions.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_SyntaxCoercions.ml index 4b8b9c1077b..c2fc1e89927 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_V2_SyntaxCoercions.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_SyntaxCoercions.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (namedv_to_term : FStar_Tactics_NamedView.namedv -> FStar_Tactics_NamedView.term) = diff --git a/stage0/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_SyntaxHelpers.ml similarity index 78% rename from stage0/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_SyntaxHelpers.ml index d449deef000..2cefd970058 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_V2_SyntaxHelpers.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_V2_SyntaxHelpers.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let rec (collect_arr' : FStar_Tactics_NamedView.binder Prims.list -> @@ -70,21 +71,22 @@ let (collect_arr_bs : match uu___1 with | (bs, c) -> ((FStar_List_Tot_Base.rev bs), c))) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.collect_arr_bs" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.SyntaxHelpers.collect_arr_bs (plugin)" - (FStarC_Tactics_Native.from_tactic_1 collect_arr_bs) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - (FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + collect_arr_bs) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list FStar_Tactics_NamedView.e_binder) - FStarC_Reflection_V2_Embeddings.e_comp_view) psc ncb us - args) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view) + psc ncb us args) let (collect_arr : FStarC_Reflection_Types.typ -> ((FStarC_Reflection_Types.typ Prims.list * FStar_Tactics_NamedView.comp), @@ -112,21 +114,21 @@ let (collect_arr : (FStar_List_Tot_Base.map (fun b -> b.FStar_Tactics_NamedView.sort) bs)), c))) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.collect_arr" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.SyntaxHelpers.collect_arr (plugin)" - (FStarC_Tactics_Native.from_tactic_1 collect_arr) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) - FStarC_Reflection_V2_Embeddings.e_comp_view) psc ncb us - args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 collect_arr) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view) + psc ncb us args) let rec (collect_abs' : FStar_Tactics_NamedView.binder Prims.list -> FStar_Tactics_NamedView.term -> @@ -183,20 +185,21 @@ let (collect_abs : match uu___1 with | (bs, t') -> ((FStar_List_Tot_Base.rev bs), t'))) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.collect_abs" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.SyntaxHelpers.collect_abs (plugin)" - (FStarC_Tactics_Native.from_tactic_1 collect_abs) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - (FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 collect_abs) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list FStar_Tactics_NamedView.e_binder) - FStarC_Reflection_V2_Embeddings.e_term) psc ncb us args) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term) psc + ncb us args) let fail : 'a . Prims.string -> ('a, unit) FStar_Tactics_Effect.tac_repr = fun uu___ -> (fun m -> @@ -274,8 +277,10 @@ let rec (mk_arr : (Prims.of_int (53)) (Prims.of_int (49))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" Prims.int_zero - Prims.int_zero Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (53)) (Prims.of_int (6)) + (Prims.of_int (53)) (Prims.of_int (49))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -283,19 +288,20 @@ let rec (mk_arr : FStar_Tactics_NamedView.pack uu___1))))) uu___1 uu___ let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.mk_arr" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.V2.SyntaxHelpers.mk_arr (plugin)" - (FStarC_Tactics_Native.from_tactic_2 mk_arr) - (FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 mk_arr) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list FStar_Tactics_NamedView.e_binder) - FStarC_Reflection_V2_Embeddings.e_comp_view - FStarC_Reflection_V2_Embeddings.e_term psc ncb us args) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_comp_view + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term psc ncb + us args) let rec (mk_tot_arr : FStar_Tactics_NamedView.binder Prims.list -> FStar_Tactics_NamedView.term -> @@ -361,8 +367,10 @@ let rec (mk_tot_arr : (Prims.of_int (59)) (Prims.of_int (53))))) (FStar_Sealed.seal (Obj.magic - (FStar_Range.mk_range "dummy" Prims.int_zero - Prims.int_zero Prims.int_zero Prims.int_zero))) + (FStar_Range.mk_range + "FStar.Tactics.V2.SyntaxHelpers.fst" + (Prims.of_int (59)) (Prims.of_int (6)) + (Prims.of_int (59)) (Prims.of_int (53))))) (Obj.magic uu___) (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac @@ -370,19 +378,20 @@ let rec (mk_tot_arr : FStar_Tactics_NamedView.pack uu___1))))) uu___1 uu___ let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.mk_tot_arr" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.V2.SyntaxHelpers.mk_tot_arr (plugin)" - (FStarC_Tactics_Native.from_tactic_2 mk_tot_arr) - (FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 mk_tot_arr) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list FStar_Tactics_NamedView.e_binder) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term psc ncb us args) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term psc ncb + us args) let (lookup_lb : FStar_Tactics_NamedView.letbinding Prims.list -> FStarC_Reflection_Types.name -> @@ -424,19 +433,19 @@ let (lookup_lb : (fail "lookup_letbinding: Name not in let group"))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.lookup_lb" (Prims.of_int (3)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 "FStar.Tactics.V2.SyntaxHelpers.lookup_lb (plugin)" - (FStarC_Tactics_Native.from_tactic_2 lookup_lb) - (FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_2 lookup_lb) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list FStar_Tactics_NamedView.e_letbinding) - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_string) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Syntax_Embeddings.e_string) FStar_Tactics_NamedView.e_letbinding psc ncb us args) let rec (inspect_unascribe : FStar_Tactics_NamedView.term -> @@ -470,16 +479,17 @@ let rec (inspect_unascribe : (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> tv)))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.inspect_unascribe" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.SyntaxHelpers.inspect_unascribe (plugin)" - (FStarC_Tactics_Native.from_tactic_1 inspect_unascribe) - FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 + inspect_unascribe) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term FStar_Tactics_NamedView.e_named_term_view psc ncb us args) let rec (collect_app' : FStarC_Reflection_V2_Data.argv Prims.list -> @@ -519,23 +529,23 @@ let (collect_app : unit) FStar_Tactics_Effect.tac_repr) = collect_app' [] let _ = - FStarC_Tactics_Native.register_tactic + Fstarcompiler.FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.collect_app" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.SyntaxHelpers.collect_app (plugin)" - (FStarC_Tactics_Native.from_tactic_1 collect_app) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_aqualv))) psc ncb - us args) + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 collect_app) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_aqualv))) + psc ncb us args) let (hua : FStar_Tactics_NamedView.term -> ((FStarC_Reflection_Types.fv * FStarC_Reflection_V2_Data.universes * @@ -577,33 +587,37 @@ let (hua : (Prims.of_int (93)) (Prims.of_int (13))))) (Obj.magic uu___2) (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - match uu___3 with - | FStar_Tactics_NamedView.Tv_FVar fv -> - FStar_Pervasives_Native.Some (fv, [], args) - | FStar_Tactics_NamedView.Tv_UInst (fv, us) -> - FStar_Pervasives_Native.Some (fv, us, args) - | uu___5 -> FStar_Pervasives_Native.None)))) + match uu___3 with + | FStar_Tactics_NamedView.Tv_FVar fv -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + FStar_Pervasives_Native.Some (fv, [], args)) + | FStar_Tactics_NamedView.Tv_UInst (fv, us) -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___4 -> + FStar_Pervasives_Native.Some (fv, us, args)) + | uu___4 -> + FStar_Tactics_Effect.lift_div_tac + (fun uu___5 -> FStar_Pervasives_Native.None)))) uu___1) let _ = - FStarC_Tactics_Native.register_tactic "FStar.Tactics.V2.SyntaxHelpers.hua" - (Prims.of_int (2)) + Fstarcompiler.FStarC_Tactics_Native.register_tactic + "FStar.Tactics.V2.SyntaxHelpers.hua" (Prims.of_int (2)) (fun psc -> fun ncb -> fun us -> fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 + Fstarcompiler.FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 "FStar.Tactics.V2.SyntaxHelpers.hua (plugin)" - (FStarC_Tactics_Native.from_tactic_1 hua) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_option - (FStarC_Syntax_Embeddings.e_tuple3 - FStarC_Reflection_V2_Embeddings.e_fv - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_universe) - (FStarC_Syntax_Embeddings.e_list - (FStarC_Syntax_Embeddings.e_tuple2 - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_aqualv)))) psc - ncb us args) \ No newline at end of file + (Fstarcompiler.FStarC_Tactics_Native.from_tactic_1 hua) + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + (Fstarcompiler.FStarC_Syntax_Embeddings.e_option + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple3 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_fv + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_universe) + (Fstarcompiler.FStarC_Syntax_Embeddings.e_list + (Fstarcompiler.FStarC_Syntax_Embeddings.e_tuple2 + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_term + Fstarcompiler.FStarC_Reflection_V2_Embeddings.e_aqualv)))) + psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Visit.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Visit.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_Tactics_Visit.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Visit.ml index 0210307bd5c..c5d8cae2816 100644 --- a/stage0/fstar-lib/generated/FStar_Tactics_Visit.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_Tactics_Visit.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (on_sort_binder : (FStarC_Reflection_Types.term -> @@ -516,7 +517,7 @@ let rec (visit_tm : (fun b1 -> let uu___6 = match asc with - | (FStar_Pervasives.Inl + | (Fstarcompiler.FStar_Pervasives.Inl t1, tacopt, use_eq) -> let uu___7 = @@ -547,7 +548,7 @@ let rec (visit_tm : fun uu___10 -> - FStar_Pervasives.Inl + Fstarcompiler.FStar_Pervasives.Inl uu___9)) in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal @@ -608,7 +609,7 @@ let rec (visit_tm : uu___10, use_eq))))) uu___8) - | (FStar_Pervasives.Inr + | (Fstarcompiler.FStar_Pervasives.Inr c, tacopt, use_eq) -> let uu___7 = @@ -640,7 +641,7 @@ let rec (visit_tm : fun uu___10 -> - FStar_Pervasives.Inr + Fstarcompiler.FStar_Pervasives.Inr uu___9)) in FStar_Tactics_Effect.tac_bind (FStar_Sealed.seal diff --git a/stage0/fstar-lib/generated/FStar_UInt.ml b/stage0/dune/fstar-plugins/plugins.ml/FStar_UInt.ml similarity index 99% rename from stage0/fstar-lib/generated/FStar_UInt.ml rename to stage0/dune/fstar-plugins/plugins.ml/FStar_UInt.ml index 39dfd9e2345..bb5f53affa4 100644 --- a/stage0/fstar-lib/generated/FStar_UInt.ml +++ b/stage0/dune/fstar-plugins/plugins.ml/FStar_UInt.ml @@ -1,3 +1,4 @@ +open Fstarcompiler open Prims let (max_int : Prims.nat -> Prims.int) = fun n -> (Prims.pow2 n) - Prims.int_one diff --git a/stage0/fstar/dune b/stage0/dune/fstarc-bare/dune similarity index 61% rename from stage0/fstar/dune rename to stage0/dune/fstarc-bare/dune index d5f6c05ed61..e9e2822683e 100644 --- a/stage0/fstar/dune +++ b/stage0/dune/fstarc-bare/dune @@ -1,10 +1,9 @@ (include_subdirs unqualified) (executable - (name main) - (public_name fstar.exe) + (name fstarc2_bare) (libraries - fstar_lib - memtrace + fstarcompiler + memtrace ) (link_flags "-linkall") (modes (native exe)) diff --git a/stage0/dune/fstarc-bare/fstarc2_bare.ml b/stage0/dune/fstarc-bare/fstarc2_bare.ml new file mode 100644 index 00000000000..7dd2f108948 --- /dev/null +++ b/stage0/dune/fstarc-bare/fstarc2_bare.ml @@ -0,0 +1,19 @@ +let x = + (* On Unix, if we write to a pipe that tries to send something + to a process that died, we receive a SIGPIPE signal which + by default will terminate F*, and we won't get an exception + or anything. So, block them, and instead rely on OCaml exceptions + to detect this. *) + if Fstarcompiler.FStarC_Platform.unix then + ignore (Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigpipe]); + + (* Enable memtrace, only if the environment variable MEMTRACE is set. *) + Memtrace.trace_if_requested (); + + (* Record a backtrace on exceptions, for --trace_error. *) + Printexc.record_backtrace true; + + (* Tweak garbage collector parameters. *) + Gc.set { (Gc.get()) with Gc.minor_heap_size = 1048576; Gc.major_heap_increment = 4194304; Gc.space_overhead = 150; }; + + Fstarcompiler.FStarC_Main.main () diff --git a/stage0/dune/fstarc-full/dune b/stage0/dune/fstarc-full/dune new file mode 100644 index 00000000000..e568c29e224 --- /dev/null +++ b/stage0/dune/fstarc-full/dune @@ -0,0 +1,14 @@ +(include_subdirs unqualified) +(executable + (name fstarc2_full) + (public_name fstar.exe) + (libraries + ; Can we just say we extend fstar_bare instead of _guts, and duplicating main? + fstarcompiler + fstar_plugins + memtrace + ) + (link_flags "-linkall") + (modes (native exe)) + (preprocess (pps ppx_deriving.show ppx_deriving_yojson sedlex.ppx)) +) diff --git a/stage0/dune/fstarc-full/fstarc2_full.ml b/stage0/dune/fstarc-full/fstarc2_full.ml new file mode 100644 index 00000000000..7dd2f108948 --- /dev/null +++ b/stage0/dune/fstarc-full/fstarc2_full.ml @@ -0,0 +1,19 @@ +let x = + (* On Unix, if we write to a pipe that tries to send something + to a process that died, we receive a SIGPIPE signal which + by default will terminate F*, and we won't get an exception + or anything. So, block them, and instead rely on OCaml exceptions + to detect this. *) + if Fstarcompiler.FStarC_Platform.unix then + ignore (Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigpipe]); + + (* Enable memtrace, only if the environment variable MEMTRACE is set. *) + Memtrace.trace_if_requested (); + + (* Record a backtrace on exceptions, for --trace_error. *) + Printexc.record_backtrace true; + + (* Tweak garbage collector parameters. *) + Gc.set { (Gc.get()) with Gc.minor_heap_size = 1048576; Gc.major_heap_increment = 4194304; Gc.space_overhead = 150; }; + + Fstarcompiler.FStarC_Main.main () diff --git a/stage0/fstar/main.ml b/stage0/dune/main.ml similarity index 89% rename from stage0/fstar/main.ml rename to stage0/dune/main.ml index 2a33d943b4f..7dd2f108948 100644 --- a/stage0/fstar/main.ml +++ b/stage0/dune/main.ml @@ -4,7 +4,7 @@ let x = by default will terminate F*, and we won't get an exception or anything. So, block them, and instead rely on OCaml exceptions to detect this. *) - if FStarC_Platform.system = Posix then + if Fstarcompiler.FStarC_Platform.unix then ignore (Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigpipe]); (* Enable memtrace, only if the environment variable MEMTRACE is set. *) @@ -16,4 +16,4 @@ let x = (* Tweak garbage collector parameters. *) Gc.set { (Gc.get()) with Gc.minor_heap_size = 1048576; Gc.major_heap_increment = 4194304; Gc.space_overhead = 150; }; - FStarC_Main.main () + Fstarcompiler.FStarC_Main.main () diff --git a/stage0/fstar-lib/.gitignore b/stage0/fstar-lib/.gitignore deleted file mode 100644 index 25dee37f486..00000000000 --- a/stage0/fstar-lib/.gitignore +++ /dev/null @@ -1 +0,0 @@ -dynamic/ diff --git a/stage0/fstar-lib/FStarC_Compiler_Range.ml b/stage0/fstar-lib/FStarC_Compiler_Range.ml deleted file mode 100644 index 7d3435eed24..00000000000 --- a/stage0/fstar-lib/FStarC_Compiler_Range.ml +++ /dev/null @@ -1,2 +0,0 @@ -include FStarC_Compiler_Range_Type -include FStarC_Compiler_Range_Ops diff --git a/stage0/fstar-lib/FStarC_Parser_ParseIt.mli b/stage0/fstar-lib/FStarC_Parser_ParseIt.mli deleted file mode 100644 index 21c90174eae..00000000000 --- a/stage0/fstar-lib/FStarC_Parser_ParseIt.mli +++ /dev/null @@ -1,58 +0,0 @@ -module U = FStarC_Compiler_Util -open FStarC_Errors -open FStarC_Syntax_Syntax -open Lexing -open FStarC_Sedlexing -module Codes = FStarC_Errors_Codes -module Msg = FStarC_Errors_Msg - -type filename = string - -type input_frag = { - frag_fname:filename; - frag_text:string; - frag_line:Prims.int; - frag_col:Prims.int -} - -val read_vfs_entry : string -> (U.time_of_day * string) option -val add_vfs_entry: string -> string -> unit -val get_file_last_modification_time: string -> U.time_of_day - -type parse_frag = - | Filename of filename - | Toplevel of input_frag - | Incremental of input_frag - | Fragment of input_frag - -type parse_error = (Codes.error_code * Msg.error_message * FStarC_Compiler_Range.range) - -type code_fragment = { - range : FStarC_Compiler_Range.range; - code: string; -} - -type parse_result = - | ASTFragment of (FStarC_Parser_AST.inputFragment * (string * FStarC_Compiler_Range.range) list) - | IncrementalFragment of ((FStarC_Parser_AST.decl * code_fragment) list * (string * FStarC_Compiler_Range.range) list * parse_error option) - | Term of FStarC_Parser_AST.term - | ParseError of parse_error - -val parse_incremental_decls : - (*filename*)string -> - (*contents*)string -> - FStarC_Sedlexing.lexbuf -> - (unit -> 'token * Lexing.position * Lexing.position) -> - ('semantic_value -> FStarC_Compiler_Range.range) -> - ((Lexing.lexbuf -> 'token) -> Lexing.lexbuf -> - ('semantic_value list * FStarC_Sedlexing.snap option) option) -> -'semantic_value list * parse_error option - -type lang_opts = string option -val parse: lang_opts -> parse_frag -> parse_result - -val find_file: string -> string - -val parse_warn_error: string -> Codes.error_setting list - -val parse_fstar_incrementally: FStarC_Parser_AST_Util.extension_lang_parser diff --git a/stage0/fstar-lib/FStarC_Platform.ml b/stage0/fstar-lib/FStarC_Platform.ml deleted file mode 100644 index 038ed9060a9..00000000000 --- a/stage0/fstar-lib/FStarC_Platform.ml +++ /dev/null @@ -1,17 +0,0 @@ -type sys = -| Windows -| Posix - -let system = - if Sys.win32 || Sys.cygwin then - Windows - else - Posix - -let exe name = - if Sys.unix then - name - else - name^".exe" - -let is_fstar_compiler_using_ocaml = true diff --git a/stage0/fstar-lib/FStarC_Tactics_Unseal.ml b/stage0/fstar-lib/FStarC_Tactics_Unseal.ml deleted file mode 100644 index 1a30e19e18d..00000000000 --- a/stage0/fstar-lib/FStarC_Tactics_Unseal.ml +++ /dev/null @@ -1,2 +0,0 @@ -module E = FStar_Tactics_Effect -let unseal x = E.tac_return x diff --git a/stage0/fstar-lib/FStar_All.ml b/stage0/fstar-lib/FStar_All.ml deleted file mode 100644 index 2a567ba95ca..00000000000 --- a/stage0/fstar-lib/FStar_All.ml +++ /dev/null @@ -1,7 +0,0 @@ -exception Failure = Failure (* NB: reusing OCaml's native Failure. *) -let exit i = exit (Z.to_int i) -(* Not used: handled specially by extraction. If used, - you will get all sorts of weird failures (e.g. an incomplete match - on f2!). *) -(* let try_with f1 f2 = try f1 () with | e -> f2 e *) -(* let failwith x = raise (Failure x) *) diff --git a/stage0/fstar-lib/FStar_Date.ml b/stage0/fstar-lib/FStar_Date.ml deleted file mode 100644 index 33d7894ec02..00000000000 --- a/stage0/fstar-lib/FStar_Date.ml +++ /dev/null @@ -1,7 +0,0 @@ - type dateTime = DT of float - type timeSpan = TS of float - let now () = DT (Unix.gettimeofday()) - let secondsFromDawn () = Int64.of_float (Unix.time()) |> Z.of_int64 - let newTimeSpan d h m s = TS (((((float_of_int (Z.to_int d)) *. 24.0) +. (float_of_int (Z.to_int h))) *. 60.0 +. (float_of_int (Z.to_int m))) *. 60.0 +. (float_of_int (Z.to_int s))) - let addTimeSpan (DT(a)) (TS(b)) = DT (a +. b) - let greaterDateTime (DT(a)) (DT(b)) = a > b diff --git a/stage0/fstar-lib/FStar_Ghost.ml b/stage0/fstar-lib/FStar_Ghost.ml deleted file mode 100644 index bbb368b8ce2..00000000000 --- a/stage0/fstar-lib/FStar_Ghost.ml +++ /dev/null @@ -1,10 +0,0 @@ -type 'a erased = unit -let reveal : 'a. 'a erased -> unit = fun _ -> () -let hide : 'a. 'a -> 'a erased = fun _ -> () -let hide_reveal : 'a. 'a erased -> unit = fun _ -> () -let reveal_hide : 'a. 'a -> unit = fun _ -> () -let elift1 : 'a 'b. ('a -> unit) -> 'a erased -> 'b erased = fun _ _ -> () -let elift2 : 'a 'b 'c. ('a -> 'c -> unit) -> 'a erased -> 'c erased -> 'b erased = fun _ _ _ -> () -let elift3 : 'a 'b 'c 'd. ('a -> 'c -> 'd -> unit) -> 'a erased -> 'c erased -> 'd erased -> 'b erased = fun _ _ _ _ -> () -let elift1_p : 'a 'b. ('a -> unit) -> 'a erased -> 'b erased = fun _ _ -> () -let elift2_p : 'a 'b 'c. ('a -> 'c -> unit) -> 'a erased -> 'c erased -> 'b erased = fun _ _ _ -> () diff --git a/stage0/fstar-lib/FStar_HyperStack_All.ml b/stage0/fstar-lib/FStar_HyperStack_All.ml deleted file mode 100644 index 9bf39ff39aa..00000000000 --- a/stage0/fstar-lib/FStar_HyperStack_All.ml +++ /dev/null @@ -1,6 +0,0 @@ -let failwith x = failwith x -let exit i = exit (Z.to_int i) -let pipe_right a f = f a -let pipe_left f a = f a -let try_with f1 f2 = try f1 () with | e -> f2 e - diff --git a/stage0/fstar-lib/FStar_HyperStack_IO.ml b/stage0/fstar-lib/FStar_HyperStack_IO.ml deleted file mode 100644 index aa761d7ddc9..00000000000 --- a/stage0/fstar-lib/FStar_HyperStack_IO.ml +++ /dev/null @@ -1,4 +0,0 @@ -open Prims - -let print_string : Prims.string -> Prims.unit = - FStar_IO.print_string diff --git a/stage0/fstar-lib/FStar_Mul.ml b/stage0/fstar-lib/FStar_Mul.ml deleted file mode 100644 index 16836646e59..00000000000 --- a/stage0/fstar-lib/FStar_Mul.ml +++ /dev/null @@ -1 +0,0 @@ -let op_Star = Prims.op_Multiply diff --git a/stage0/fstar-lib/FStar_Tcp.ml b/stage0/fstar-lib/FStar_Tcp.ml deleted file mode 100644 index d4177a1dabd..00000000000 --- a/stage0/fstar-lib/FStar_Tcp.ml +++ /dev/null @@ -1,148 +0,0 @@ - open FStar_Bytes - open FStar_Error - open Unix - - type networkStream = file_descr - type tcpListener = file_descr - - let listen s i = - let i = Z.to_int i in - let server_sock = socket PF_INET SOCK_STREAM 0 in - (setsockopt server_sock SO_REUSEADDR true ; - let address = inet_addr_of_string s in - bind server_sock (ADDR_INET (address, i)) ; - listen server_sock 10; - server_sock) - - let accept s = - let (client_sock, client_addr) = accept s in - client_sock - - let acceptTimeout t s = accept s - - let stop s = shutdown s SHUTDOWN_ALL - - let connect s i = - let i = Z.to_int i in - let client_sock = socket PF_INET SOCK_STREAM 0 in - let hentry = gethostbyname s in - connect client_sock (ADDR_INET (hentry.h_addr_list.(0), i)) ; - client_sock - - let connectTimeout t s i = connect s i - - let sock_send sock str = - let str = get_cbytes str in - let len = String.length str in - send_substring sock str 0 len [] - - let sock_recv sock maxlen = - let str = Bytes.create maxlen in - let recvlen = recv sock str 0 maxlen [] in - let str = Bytes.sub_string str 0 recvlen in - abytes str - - type 'a recv_result = - | RecvWouldBlock - | RecvError of string - | Received of bytes - - let recv_async s i = - let i = Z.to_int i in - try Received (sock_recv s i) with - | Unix_error ((EAGAIN | EWOULDBLOCK),_,_) -> RecvWouldBlock - | Unix_error (e,s1,s2) -> RecvError (Printf.sprintf "%s: %s(%s)" (error_message e) s1 s2) - - let set_nonblock = set_nonblock - let clear_nonblock = clear_nonblock - - let recv s i = - let i = Z.to_int i in - try Correct (sock_recv s i) - with Unix_error (e,s1,s2) -> - Error (Printf.sprintf "%s: %s(%s)" (error_message e) s1 s2) - - let rec send s b = - try ( - let n = sock_send s b in - let m = String.length b in - if n < m - then - (* send s (String.sub str n (m - n) *) - Error(Printf.sprintf "Network error, wrote %d bytes" n) - else Correct()) - with - | Unix_error ((EAGAIN | EWOULDBLOCK),_,_) -> send s b - | Unix_error (e,s1,s2) -> Error (Printf.sprintf "%s: %s(%s)" (error_message e) s1 s2) - - let close s = - close s - - - (* - open Unix - - (* Convert human readable form to 32 bit value *) - let packed_ip = inet_addr_of_string "208.146.240.1" in - - - (* Convert 32 bit value to ip adress *) - let ip_address = string_of_inet_addr (packed_ip) in - - (* Create socket object *) - let sock = socket PF_INET SOCK_STREAM 0 in - - (* Get socketname *) - let saddr = getsockname sock ;; - - let sock_send sock str = - let len = String.length str in - send sock str 0 len [] - - let sock_recv sock maxlen = - let str = String.create maxlen in - let recvlen = recv sock str 0 maxlen [] in - String.sub str 0 recvlen - - let client_sock = socket PF_INET SOCK_STREAM 0 in - let hentry = gethostbyname "coltrane" in - connect client_sock (ADDR_INET (hentry.h_addr_list.(0), 25)) ; (* SMTP *) - - sock_recv client_sock 1024 ; - - sock_send client_sock "mail from: \n" ; - sock_recv client_sock 1024 ; - - sock_send client_sock "rcpt to: \n" ; - sock_recv client_sock 1024; - - sock_send client_sock "data\n" ; - sock_recv client_sock 1024 ; - - sock_send client_sock "From: Ocaml whiz\nSubject: Ocaml rulez!\n\nYES!\n.\n" ; - sock_recv client_sock 1024 ; - - close client_sock ;; - - let server_sock = socket PF_INET SOCK_STREAM 0 in - - (* so we can restart our server quickly *) - setsockopt server_sock SO_REUSEADDR true ; - - (* build up my socket address *) - let address = (gethostbyname(gethostname())).h_addr_list.(0) in - bind server_sock (ADDR_INET (address, 1029)) ; - - (* Listen on the socket. Max of 10 incoming connections. *) - listen server_sock 10 ; - - (* accept and process connections *) - while true do - let (client_sock, client_addr) = accept server_sock in - let str = "Hello\n" in - let len = String.length str in - let x = send client_sock str 0 len [] in - shutdown client_sock SHUTDOWN_ALL - done ;; - - *) diff --git a/stage0/fstar-lib/FStar_Udp.ml b/stage0/fstar-lib/FStar_Udp.ml deleted file mode 100644 index 3b8731923ef..00000000000 --- a/stage0/fstar-lib/FStar_Udp.ml +++ /dev/null @@ -1,104 +0,0 @@ - open FStar_Bytes - open FStar_Error - open Unix - - - type socket = file_descr - type udpListener = file_descr - - (* Default network input buffer size *) - let default_buffer_size = 2048 - - (* Close the network socket *) - let stop s = - shutdown s SHUTDOWN_ALL - - let close s = - close s - - (* Initiate a connection *) - let connect ip port = - let port = Z.to_int port in - let client_sock = socket PF_INET SOCK_DGRAM 0 in - let addr = inet_addr_of_string ip in - connect client_sock (ADDR_INET(addr,port)); - client_sock - - (* Send abstract bytes through the socket after making them concrete *) - let sock_send sock str = - let str = get_cbytes str in - let len = String.length str in - send_substring sock str 0 len [] - - (* Receive bytes from the socket and make them abstract *) - let sock_recv sock maxlen = - let str = Bytes.create maxlen in - let recvlen = recv sock str 0 maxlen [] in - let str = Bytes.sub_string str 0 recvlen in - abytes str - - (* Receive bytes from the netwok *) - let recv s i = - let i = Z.to_int i in - try Correct (sock_recv s i) - with Unix_error (e,s1,s2) -> - Error (Printf.sprintf "%s: %s(%s)" (error_message e) s1 s2) - - (* Send bytes to the network *) - let send s b = - try - (let n = sock_send s b in - if n < String.length b then - Error(Printf.sprintf "Network error, wrote %d bytes" n) - else Correct()) - with Unix_error (e,s1,s2) -> - Error (Printf.sprintf "%s: %s(%s)" (error_message e) s1 s2) - - (* Extract input and output channels from the socket *) - let sock_split s = - let oc = out_channel_of_descr s in - let ic = in_channel_of_descr s in - ic,oc - - (* Flush output channel of the socket *) - let flush oc = - flush oc - -(* - (* Read helper function *) - let rec read_acc s nbytes prev = - if nbytes = 0 then - abytes prev - else - try - let buf = String.create nbytes in - let r = read s buf 0 nbytes in - if r = 0 then - failwith "UDP connection closed: Read returned 0 bytes" - else - let rem = nbytes - r in - read_acc s rem (String.cat prev (String.sub buf 0 r)) - with - | _ -> failwith "UDP connection: Not enough bytes to read" - - (* Read the network *) - let read s nbytes = - try - (read_acc s nbytes String.empty) - with Unix_error (e,s1,s2) -> - Error (Printf.sprintf "%s: %s(%s)" (error_message e) s1 s2) - - (* Read all bytes from the network up to default_buffer_size *) - let read_all s = - try - let buf = String.create default_buffer_size in - let r = Unix.read s buf 0 default_buffer_size in - r,(abytes (String.sub buf 0 r)) - with Unix_error (e,s1,s2) -> - Error (Printf.sprintf "%s: %s(%s)" (error_message e) s1 s2) - - (* Write to the network *) - let write s b = - let oc = out_channel_of_descr s in - output_string oc b; flush oc - *) diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Debug.ml b/stage0/fstar-lib/generated/FStarC_Compiler_Debug.ml deleted file mode 100644 index 8c6382c1517..00000000000 --- a/stage0/fstar-lib/generated/FStarC_Compiler_Debug.ml +++ /dev/null @@ -1,151 +0,0 @@ -open Prims -let (anyref : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref false -let (_debug_all : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref false -let (toggle_list : - (Prims.string * Prims.bool FStarC_Compiler_Effect.ref) Prims.list - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref [] -type saved_state = - { - toggles: (Prims.string * Prims.bool) Prims.list ; - any: Prims.bool ; - all: Prims.bool } -let (__proj__Mksaved_state__item__toggles : - saved_state -> (Prims.string * Prims.bool) Prims.list) = - fun projectee -> match projectee with | { toggles; any; all;_} -> toggles -let (__proj__Mksaved_state__item__any : saved_state -> Prims.bool) = - fun projectee -> match projectee with | { toggles; any; all;_} -> any -let (__proj__Mksaved_state__item__all : saved_state -> Prims.bool) = - fun projectee -> match projectee with | { toggles; any; all;_} -> all -let (snapshot : unit -> saved_state) = - fun uu___ -> - let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang toggle_list in - FStarC_Compiler_List.map - (fun uu___3 -> - match uu___3 with - | (k, r) -> - let uu___4 = FStarC_Compiler_Effect.op_Bang r in (k, uu___4)) - uu___2 in - let uu___2 = FStarC_Compiler_Effect.op_Bang anyref in - let uu___3 = FStarC_Compiler_Effect.op_Bang _debug_all in - { toggles = uu___1; any = uu___2; all = uu___3 } -let (register_toggle : Prims.string -> Prims.bool FStarC_Compiler_Effect.ref) - = - fun k -> - let r = FStarC_Compiler_Util.mk_ref false in - (let uu___1 = FStarC_Compiler_Effect.op_Bang _debug_all in - if uu___1 then FStarC_Compiler_Effect.op_Colon_Equals r true else ()); - (let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang toggle_list in (k, r) :: - uu___3 in - FStarC_Compiler_Effect.op_Colon_Equals toggle_list uu___2); - r -let (get_toggle : Prims.string -> Prims.bool FStarC_Compiler_Effect.ref) = - fun k -> - let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang toggle_list in - FStarC_Compiler_List.tryFind - (fun uu___2 -> match uu___2 with | (k', uu___3) -> k = k') uu___1 in - match uu___ with - | FStar_Pervasives_Native.Some (uu___1, r) -> r - | FStar_Pervasives_Native.None -> register_toggle k -let (restore : saved_state -> unit) = - fun snapshot1 -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang toggle_list in - FStarC_Compiler_List.iter - (fun uu___2 -> - match uu___2 with - | (uu___3, r) -> FStarC_Compiler_Effect.op_Colon_Equals r false) - uu___1); - FStarC_Compiler_List.iter - (fun uu___2 -> - match uu___2 with - | (k, b) -> - let r = get_toggle k in - FStarC_Compiler_Effect.op_Colon_Equals r b) snapshot1.toggles; - FStarC_Compiler_Effect.op_Colon_Equals anyref snapshot1.any; - FStarC_Compiler_Effect.op_Colon_Equals _debug_all snapshot1.all -let (list_all_toggles : unit -> Prims.string Prims.list) = - fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang toggle_list in - FStarC_Compiler_List.map FStar_Pervasives_Native.fst uu___1 -let (any : unit -> Prims.bool) = - fun uu___ -> - (FStarC_Compiler_Effect.op_Bang anyref) || - (FStarC_Compiler_Effect.op_Bang _debug_all) -let (tag : Prims.string -> unit) = - fun s -> - let uu___ = any () in - if uu___ - then - FStarC_Compiler_Util.print_string - (Prims.strcat "DEBUG:" (Prims.strcat s "\n")) - else () -let (enable : unit -> unit) = - fun uu___ -> FStarC_Compiler_Effect.op_Colon_Equals anyref true -let (dbg_level : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero -let (low : unit -> Prims.bool) = - fun uu___ -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_level in - uu___1 >= Prims.int_one) || (FStarC_Compiler_Effect.op_Bang _debug_all) -let (medium : unit -> Prims.bool) = - fun uu___ -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_level in - uu___1 >= (Prims.of_int (2))) || - (FStarC_Compiler_Effect.op_Bang _debug_all) -let (high : unit -> Prims.bool) = - fun uu___ -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_level in - uu___1 >= (Prims.of_int (3))) || - (FStarC_Compiler_Effect.op_Bang _debug_all) -let (extreme : unit -> Prims.bool) = - fun uu___ -> - (let uu___1 = FStarC_Compiler_Effect.op_Bang dbg_level in - uu___1 >= (Prims.of_int (4))) || - (FStarC_Compiler_Effect.op_Bang _debug_all) -let (set_level_low : unit -> unit) = - fun uu___ -> FStarC_Compiler_Effect.op_Colon_Equals dbg_level Prims.int_one -let (set_level_medium : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (2)) -let (set_level_high : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (3)) -let (set_level_extreme : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Effect.op_Colon_Equals dbg_level (Prims.of_int (4)) -let (enable_toggles : Prims.string Prims.list -> unit) = - fun keys -> - if Prims.uu___is_Cons keys then enable () else (); - FStarC_Compiler_List.iter - (fun k -> - if k = "Low" - then set_level_low () - else - if k = "Medium" - then set_level_medium () - else - if k = "High" - then set_level_high () - else - if k = "Extreme" - then set_level_extreme () - else - (let t = get_toggle k in - FStarC_Compiler_Effect.op_Colon_Equals t true)) keys -let (disable_all : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Effect.op_Colon_Equals anyref false; - FStarC_Compiler_Effect.op_Colon_Equals dbg_level Prims.int_zero; - (let uu___3 = FStarC_Compiler_Effect.op_Bang toggle_list in - FStarC_Compiler_List.iter - (fun uu___4 -> - match uu___4 with - | (uu___5, r) -> FStarC_Compiler_Effect.op_Colon_Equals r false) - uu___3) -let (set_debug_all : unit -> unit) = - fun uu___ -> FStarC_Compiler_Effect.op_Colon_Equals _debug_all true \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Misc.ml b/stage0/fstar-lib/generated/FStarC_Compiler_Misc.ml deleted file mode 100644 index 878c4f94841..00000000000 --- a/stage0/fstar-lib/generated/FStarC_Compiler_Misc.ml +++ /dev/null @@ -1,21 +0,0 @@ -open Prims -let (compare_version : - Prims.string -> Prims.string -> FStarC_Compiler_Order.order) = - fun v1 -> - fun v2 -> - let cs1 = - FStarC_Compiler_List.map FStarC_Compiler_Util.int_of_string - (FStarC_Compiler_String.split [46] v1) in - let cs2 = - FStarC_Compiler_List.map FStarC_Compiler_Util.int_of_string - (FStarC_Compiler_String.split [46] v2) in - FStarC_Compiler_Order.compare_list cs1 cs2 - FStarC_Compiler_Order.compare_int -let (version_gt : Prims.string -> Prims.string -> Prims.bool) = - fun v1 -> - fun v2 -> - let uu___ = compare_version v1 v2 in uu___ = FStarC_Compiler_Order.Gt -let (version_ge : Prims.string -> Prims.string -> Prims.bool) = - fun v1 -> - fun v2 -> - let uu___ = compare_version v1 v2 in uu___ <> FStarC_Compiler_Order.Lt \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Plugins.ml b/stage0/fstar-lib/generated/FStarC_Compiler_Plugins.ml deleted file mode 100644 index 36e502db0f3..00000000000 --- a/stage0/fstar-lib/generated/FStarC_Compiler_Plugins.ml +++ /dev/null @@ -1,194 +0,0 @@ -open Prims -let (loaded : Prims.string Prims.list FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref [] -let (pout : Prims.string -> unit) = - fun s -> - let uu___ = FStarC_Compiler_Debug.any () in - if uu___ then FStarC_Compiler_Util.print_string s else () -let (pout1 : Prims.string -> Prims.string -> unit) = - fun s -> - fun x -> - let uu___ = FStarC_Compiler_Debug.any () in - if uu___ then FStarC_Compiler_Util.print1 s x else () -let (perr : Prims.string -> unit) = - fun s -> - let uu___ = FStarC_Compiler_Debug.any () in - if uu___ then FStarC_Compiler_Util.print_error s else () -let (perr1 : Prims.string -> Prims.string -> unit) = - fun s -> - fun x -> - let uu___ = FStarC_Compiler_Debug.any () in - if uu___ then FStarC_Compiler_Util.print1_error s x else () -let (dynlink : Prims.string -> unit) = - fun fname -> - let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang loaded in - FStarC_Compiler_List.mem fname uu___1 in - if uu___ - then pout1 "Plugin %s already loaded, skipping\n" fname - else - (pout (Prims.strcat "Attempting to load " (Prims.strcat fname "\n")); - (try - (fun uu___4 -> - match () with - | () -> FStarC_Compiler_Plugins_Base.dynlink_loadfile fname) () - with - | FStarC_Compiler_Plugins_Base.DynlinkError e -> - ((let uu___6 = - let uu___7 = - let uu___8 = - FStarC_Compiler_Util.format1 - "Failed to load plugin file %s" fname in - FStarC_Errors_Msg.text uu___8 in - let uu___8 = - let uu___9 = - let uu___10 = FStarC_Errors_Msg.text "Reason:" in - let uu___11 = FStarC_Errors_Msg.text e in - FStarC_Pprint.prefix (Prims.of_int (2)) Prims.int_one - uu___10 uu___11 in - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - FStarC_Errors.errno - FStarC_Errors_Codes.Error_PluginDynlink in - FStarC_Class_Show.show - FStarC_Class_Show.showable_int uu___14 in - FStarC_Compiler_Util.format1 - "Remove the `--load` option or use `--warn_error -%s` to ignore and continue." - uu___13 in - FStarC_Errors_Msg.text uu___12 in - [uu___11] in - uu___9 :: uu___10 in - uu___7 :: uu___8 in - FStarC_Errors.log_issue0 - FStarC_Errors_Codes.Error_PluginDynlink () - (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) - (Obj.magic uu___6)); - FStarC_Errors.stop_if_err ())); - (let uu___5 = - let uu___6 = FStarC_Compiler_Effect.op_Bang loaded in fname :: - uu___6 in - FStarC_Compiler_Effect.op_Colon_Equals loaded uu___5); - pout1 "Loaded %s\n" fname) -let (load_plugin : Prims.string -> unit) = fun tac -> dynlink tac -let (load_plugins : Prims.string Prims.list -> unit) = - fun tacs -> FStarC_Compiler_List.iter load_plugin tacs -let (load_plugins_dir : Prims.string -> unit) = - fun dir -> - let uu___ = - let uu___1 = - let uu___2 = FStarC_Compiler_Util.readdir dir in - FStarC_Compiler_List.filter - (fun s -> - ((FStarC_Compiler_String.length s) >= (Prims.of_int (5))) && - ((FStar_String.sub s - ((FStarC_Compiler_String.length s) - (Prims.of_int (5))) - (Prims.of_int (5))) - = ".cmxs")) uu___2 in - FStarC_Compiler_List.map - (fun s -> Prims.strcat dir (Prims.strcat "/" s)) uu___1 in - load_plugins uu___ -let (compile_modules : Prims.string -> Prims.string Prims.list -> unit) = - fun dir -> - fun ms -> - let compile m = - let packages = ["fstar.lib"] in - let pkg pname = Prims.strcat "-package " pname in - let args = - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = FStarC_Compiler_List.map pkg packages in - FStar_List_Tot_Base.append uu___3 - ["-o"; Prims.strcat m ".cmxs"; Prims.strcat m ".ml"] in - FStar_List_Tot_Base.append ["-w"; "-8-11-20-21-26-28"] uu___2 in - FStar_List_Tot_Base.append ["-I"; dir] uu___1 in - FStar_List_Tot_Base.append ["ocamlopt"; "-shared"] uu___ in - let ocamlpath_sep = - match FStarC_Platform.system with - | FStarC_Platform.Windows -> ";" - | FStarC_Platform.Posix -> ":" in - let old_ocamlpath = - let uu___ = - FStarC_Compiler_Util.expand_environment_variable "OCAMLPATH" in - match uu___ with - | FStar_Pervasives_Native.Some s -> s - | FStar_Pervasives_Native.None -> "" in - let env_setter = - FStarC_Compiler_Util.format5 - "env OCAMLPATH=\"%s/../lib/%s%s/%s%s\"" - FStarC_Find.fstar_bin_directory ocamlpath_sep - FStarC_Find.fstar_bin_directory ocamlpath_sep old_ocamlpath in - let cmd = - FStarC_Compiler_String.concat " " (env_setter :: "ocamlfind" :: - args) in - let rc = FStarC_Compiler_Util.system_run cmd in - if rc <> Prims.int_zero - then - let uu___ = - let uu___1 = - FStarC_Errors_Msg.text "Failed to compile native tactic." in - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStarC_Class_Show.show FStarC_Class_Show.showable_int rc in - FStarC_Compiler_Util.format2 - "Command\n`%s`\nreturned with exit code %s" cmd uu___5 in - FStarC_Errors_Msg.text uu___4 in - [uu___3] in - uu___1 :: uu___2 in - FStarC_Errors.raise_error0 - FStarC_Errors_Codes.Fatal_FailToCompileNativeTactic () - (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) - (Obj.magic uu___) - else () in - try - (fun uu___ -> - match () with - | () -> - let uu___1 = - FStarC_Compiler_List.map - (fun m -> Prims.strcat dir (Prims.strcat "/" m)) ms in - FStarC_Compiler_List.iter compile uu___1) () - with - | uu___ -> - ((let uu___2 = - let uu___3 = FStarC_Compiler_Util.print_exn uu___ in - FStarC_Compiler_Util.format1 - "Failed to load native tactic: %s\n" uu___3 in - perr uu___2); - FStarC_Compiler_Effect.raise uu___) -let (autoload_plugin : Prims.string -> Prims.bool) = - fun ext -> - let uu___ = - let uu___1 = FStarC_Options_Ext.get "noautoload" in uu___1 <> "" in - if uu___ - then false - else - ((let uu___3 = FStarC_Compiler_Debug.any () in - if uu___3 - then - FStarC_Compiler_Util.print1 - "Trying to find a plugin for extension %s\n" ext - else ()); - (let uu___3 = FStarC_Find.find_file (Prims.strcat ext ".cmxs") in - match uu___3 with - | FStar_Pervasives_Native.Some fn -> - let uu___4 = - let uu___5 = FStarC_Compiler_Effect.op_Bang loaded in - FStarC_Compiler_List.mem fn uu___5 in - if uu___4 - then false - else - ((let uu___7 = FStarC_Compiler_Debug.any () in - if uu___7 - then - FStarC_Compiler_Util.print1 "Autoloading plugin %s ...\n" - fn - else ()); - load_plugin fn; - true) - | FStar_Pervasives_Native.None -> false)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Compiler_Range_Ops.ml b/stage0/fstar-lib/generated/FStarC_Compiler_Range_Ops.ml deleted file mode 100644 index f02f6db234f..00000000000 --- a/stage0/fstar-lib/generated/FStarC_Compiler_Range_Ops.ml +++ /dev/null @@ -1,291 +0,0 @@ -open Prims -let (union_rng : - FStarC_Compiler_Range_Type.rng -> - FStarC_Compiler_Range_Type.rng -> FStarC_Compiler_Range_Type.rng) - = - fun r1 -> - fun r2 -> - if - r1.FStarC_Compiler_Range_Type.file_name <> - r2.FStarC_Compiler_Range_Type.file_name - then r2 - else - (let start_pos = - FStarC_Class_Ord.min FStarC_Compiler_Range_Type.ord_pos - r1.FStarC_Compiler_Range_Type.start_pos - r2.FStarC_Compiler_Range_Type.start_pos in - let end_pos = - FStarC_Class_Ord.max FStarC_Compiler_Range_Type.ord_pos - r1.FStarC_Compiler_Range_Type.end_pos - r2.FStarC_Compiler_Range_Type.end_pos in - FStarC_Compiler_Range_Type.mk_rng - r1.FStarC_Compiler_Range_Type.file_name start_pos end_pos) -let (union_ranges : - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.range) - = - fun r1 -> - fun r2 -> - let uu___ = - union_rng r1.FStarC_Compiler_Range_Type.def_range - r2.FStarC_Compiler_Range_Type.def_range in - let uu___1 = - union_rng r1.FStarC_Compiler_Range_Type.use_range - r2.FStarC_Compiler_Range_Type.use_range in - { - FStarC_Compiler_Range_Type.def_range = uu___; - FStarC_Compiler_Range_Type.use_range = uu___1 - } -let (rng_included : - FStarC_Compiler_Range_Type.rng -> - FStarC_Compiler_Range_Type.rng -> Prims.bool) - = - fun r1 -> - fun r2 -> - if - r1.FStarC_Compiler_Range_Type.file_name <> - r2.FStarC_Compiler_Range_Type.file_name - then false - else - (FStarC_Class_Ord.op_Less_Equals_Question - FStarC_Compiler_Range_Type.ord_pos - r2.FStarC_Compiler_Range_Type.start_pos - r1.FStarC_Compiler_Range_Type.start_pos) - && - (FStarC_Class_Ord.op_Greater_Equals_Question - FStarC_Compiler_Range_Type.ord_pos - r2.FStarC_Compiler_Range_Type.end_pos - r1.FStarC_Compiler_Range_Type.end_pos) -let (string_of_pos : FStarC_Compiler_Range_Type.pos -> Prims.string) = - fun pos -> - let uu___ = - FStarC_Compiler_Util.string_of_int pos.FStarC_Compiler_Range_Type.line in - let uu___1 = - FStarC_Compiler_Util.string_of_int pos.FStarC_Compiler_Range_Type.col in - FStarC_Compiler_Util.format2 "%s,%s" uu___ uu___1 -let (file_of_range : FStarC_Compiler_Range_Type.range -> Prims.string) = - fun r -> - let f = - (r.FStarC_Compiler_Range_Type.def_range).FStarC_Compiler_Range_Type.file_name in - FStarC_Compiler_Range_Type.string_of_file_name f -let (set_file_of_range : - FStarC_Compiler_Range_Type.range -> - Prims.string -> FStarC_Compiler_Range_Type.range) - = - fun r -> - fun f -> - { - FStarC_Compiler_Range_Type.def_range = - (let uu___ = r.FStarC_Compiler_Range_Type.def_range in - { - FStarC_Compiler_Range_Type.file_name = f; - FStarC_Compiler_Range_Type.start_pos = - (uu___.FStarC_Compiler_Range_Type.start_pos); - FStarC_Compiler_Range_Type.end_pos = - (uu___.FStarC_Compiler_Range_Type.end_pos) - }); - FStarC_Compiler_Range_Type.use_range = - (r.FStarC_Compiler_Range_Type.use_range) - } -let (string_of_rng : FStarC_Compiler_Range_Type.rng -> Prims.string) = - fun r -> - let uu___ = - FStarC_Compiler_Range_Type.string_of_file_name - r.FStarC_Compiler_Range_Type.file_name in - let uu___1 = string_of_pos r.FStarC_Compiler_Range_Type.start_pos in - let uu___2 = string_of_pos r.FStarC_Compiler_Range_Type.end_pos in - FStarC_Compiler_Util.format3 "%s(%s-%s)" uu___ uu___1 uu___2 -let (string_of_def_range : FStarC_Compiler_Range_Type.range -> Prims.string) - = fun r -> string_of_rng r.FStarC_Compiler_Range_Type.def_range -let (string_of_use_range : FStarC_Compiler_Range_Type.range -> Prims.string) - = fun r -> string_of_rng r.FStarC_Compiler_Range_Type.use_range -let (string_of_range : FStarC_Compiler_Range_Type.range -> Prims.string) = - fun r -> string_of_def_range r -let (start_of_range : - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.pos) = - fun r -> - (r.FStarC_Compiler_Range_Type.def_range).FStarC_Compiler_Range_Type.start_pos -let (end_of_range : - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.pos) = - fun r -> - (r.FStarC_Compiler_Range_Type.def_range).FStarC_Compiler_Range_Type.end_pos -let (file_of_use_range : FStarC_Compiler_Range_Type.range -> Prims.string) = - fun r -> - (r.FStarC_Compiler_Range_Type.use_range).FStarC_Compiler_Range_Type.file_name -let (start_of_use_range : - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.pos) = - fun r -> - (r.FStarC_Compiler_Range_Type.use_range).FStarC_Compiler_Range_Type.start_pos -let (end_of_use_range : - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.pos) = - fun r -> - (r.FStarC_Compiler_Range_Type.use_range).FStarC_Compiler_Range_Type.end_pos -let (line_of_pos : FStarC_Compiler_Range_Type.pos -> Prims.int) = - fun p -> p.FStarC_Compiler_Range_Type.line -let (col_of_pos : FStarC_Compiler_Range_Type.pos -> Prims.int) = - fun p -> p.FStarC_Compiler_Range_Type.col -let (end_range : - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.range) = - fun r -> - FStarC_Compiler_Range_Type.mk_range - (r.FStarC_Compiler_Range_Type.def_range).FStarC_Compiler_Range_Type.file_name - (r.FStarC_Compiler_Range_Type.def_range).FStarC_Compiler_Range_Type.end_pos - (r.FStarC_Compiler_Range_Type.def_range).FStarC_Compiler_Range_Type.end_pos -let (compare_rng : - FStarC_Compiler_Range_Type.rng -> - FStarC_Compiler_Range_Type.rng -> Prims.int) - = - fun r1 -> - fun r2 -> - let fcomp = - FStar_String.compare r1.FStarC_Compiler_Range_Type.file_name - r2.FStarC_Compiler_Range_Type.file_name in - if fcomp = Prims.int_zero - then - let start1 = r1.FStarC_Compiler_Range_Type.start_pos in - let start2 = r2.FStarC_Compiler_Range_Type.start_pos in - let lcomp = - start1.FStarC_Compiler_Range_Type.line - - start2.FStarC_Compiler_Range_Type.line in - (if lcomp = Prims.int_zero - then - start1.FStarC_Compiler_Range_Type.col - - start2.FStarC_Compiler_Range_Type.col - else lcomp) - else fcomp -let (compare : - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> Prims.int) - = - fun r1 -> - fun r2 -> - compare_rng r1.FStarC_Compiler_Range_Type.def_range - r2.FStarC_Compiler_Range_Type.def_range -let (compare_use_range : - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> Prims.int) - = - fun r1 -> - fun r2 -> - compare_rng r1.FStarC_Compiler_Range_Type.use_range - r2.FStarC_Compiler_Range_Type.use_range -let (range_before_pos : - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.pos -> Prims.bool) - = - fun m1 -> - fun p -> - let uu___ = end_of_range m1 in - FStarC_Class_Ord.op_Greater_Equals_Question - FStarC_Compiler_Range_Type.ord_pos p uu___ -let (end_of_line : - FStarC_Compiler_Range_Type.pos -> FStarC_Compiler_Range_Type.pos) = - fun p -> - { - FStarC_Compiler_Range_Type.line = (p.FStarC_Compiler_Range_Type.line); - FStarC_Compiler_Range_Type.col = FStarC_Compiler_Util.max_int - } -let (extend_to_end_of_line : - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.range) = - fun r -> - let uu___ = file_of_range r in - let uu___1 = start_of_range r in - let uu___2 = let uu___3 = end_of_range r in end_of_line uu___3 in - FStarC_Compiler_Range_Type.mk_range uu___ uu___1 uu___2 -let (json_of_pos : FStarC_Compiler_Range_Type.pos -> FStarC_Json.json) = - fun pos -> - let uu___ = - let uu___1 = let uu___2 = line_of_pos pos in FStarC_Json.JsonInt uu___2 in - let uu___2 = - let uu___3 = - let uu___4 = col_of_pos pos in FStarC_Json.JsonInt uu___4 in - [uu___3] in - uu___1 :: uu___2 in - FStarC_Json.JsonList uu___ -let (json_of_range_fields : - Prims.string -> - FStarC_Compiler_Range_Type.pos -> - FStarC_Compiler_Range_Type.pos -> FStarC_Json.json) - = - fun file -> - fun b -> - fun e -> - let uu___ = - let uu___1 = - let uu___2 = let uu___3 = json_of_pos b in ("beg", uu___3) in - let uu___3 = - let uu___4 = let uu___5 = json_of_pos e in ("end", uu___5) in - [uu___4] in - uu___2 :: uu___3 in - ("fname", (FStarC_Json.JsonStr file)) :: uu___1 in - FStarC_Json.JsonAssoc uu___ -let (json_of_use_range : - FStarC_Compiler_Range_Type.range -> FStarC_Json.json) = - fun r -> - let uu___ = file_of_use_range r in - let uu___1 = start_of_use_range r in - let uu___2 = end_of_use_range r in - json_of_range_fields uu___ uu___1 uu___2 -let (json_of_def_range : - FStarC_Compiler_Range_Type.range -> FStarC_Json.json) = - fun r -> - let uu___ = file_of_range r in - let uu___1 = start_of_range r in - let uu___2 = end_of_range r in json_of_range_fields uu___ uu___1 uu___2 -let (intersect_rng : - FStarC_Compiler_Range_Type.rng -> - FStarC_Compiler_Range_Type.rng -> FStarC_Compiler_Range_Type.rng) - = - fun r1 -> - fun r2 -> - if - r1.FStarC_Compiler_Range_Type.file_name <> - r2.FStarC_Compiler_Range_Type.file_name - then r2 - else - (let start_pos = - FStarC_Class_Ord.max FStarC_Compiler_Range_Type.ord_pos - r1.FStarC_Compiler_Range_Type.start_pos - r2.FStarC_Compiler_Range_Type.start_pos in - let end_pos = - FStarC_Class_Ord.min FStarC_Compiler_Range_Type.ord_pos - r1.FStarC_Compiler_Range_Type.end_pos - r2.FStarC_Compiler_Range_Type.end_pos in - let uu___1 = - FStarC_Class_Ord.op_Greater_Equals_Question - FStarC_Compiler_Range_Type.ord_pos start_pos end_pos in - if uu___1 - then r2 - else - FStarC_Compiler_Range_Type.mk_rng - r1.FStarC_Compiler_Range_Type.file_name start_pos end_pos) -let (intersect_ranges : - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.range) - = - fun r1 -> - fun r2 -> - let uu___ = - intersect_rng r1.FStarC_Compiler_Range_Type.def_range - r2.FStarC_Compiler_Range_Type.def_range in - let uu___1 = - intersect_rng r1.FStarC_Compiler_Range_Type.use_range - r2.FStarC_Compiler_Range_Type.use_range in - { - FStarC_Compiler_Range_Type.def_range = uu___; - FStarC_Compiler_Range_Type.use_range = uu___1 - } -let (bound_range : - FStarC_Compiler_Range_Type.range -> - FStarC_Compiler_Range_Type.range -> FStarC_Compiler_Range_Type.range) - = fun r -> fun bound -> intersect_ranges r bound -let (showable_range : - FStarC_Compiler_Range_Type.range FStarC_Class_Show.showable) = - { FStarC_Class_Show.show = string_of_range } -let (pretty_range : FStarC_Compiler_Range_Type.range FStarC_Class_PP.pretty) - = - { - FStarC_Class_PP.pp = - (fun r -> - let uu___ = string_of_range r in FStarC_Pprint.doc_of_string uu___) - } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_GenSym.ml b/stage0/fstar-lib/generated/FStarC_GenSym.ml deleted file mode 100644 index a58e412d22e..00000000000 --- a/stage0/fstar-lib/generated/FStarC_GenSym.ml +++ /dev/null @@ -1,20 +0,0 @@ -open Prims -let (gensym_st : Prims.int FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref Prims.int_zero -let (next_id : unit -> Prims.int) = - fun uu___ -> - let r = FStarC_Compiler_Effect.op_Bang gensym_st in - FStarC_Compiler_Effect.op_Colon_Equals gensym_st (r + Prims.int_one); r -let (reset_gensym : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Effect.op_Colon_Equals gensym_st Prims.int_zero -let with_frozen_gensym : 'a . (unit -> 'a) -> 'a = - fun f -> - let v = FStarC_Compiler_Effect.op_Bang gensym_st in - let r = - try (fun uu___ -> match () with | () -> f ()) () - with - | uu___ -> - (FStarC_Compiler_Effect.op_Colon_Equals gensym_st v; - FStarC_Compiler_Effect.raise uu___) in - FStarC_Compiler_Effect.op_Colon_Equals gensym_st v; r \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_Options_Ext.ml b/stage0/fstar-lib/generated/FStarC_Options_Ext.ml deleted file mode 100644 index 85d0582fcc0..00000000000 --- a/stage0/fstar-lib/generated/FStarC_Options_Ext.ml +++ /dev/null @@ -1,67 +0,0 @@ -open Prims -type key = Prims.string -type value = Prims.string -type ext_state = - | E of Prims.string FStarC_Compiler_Util.psmap -let (uu___is_E : ext_state -> Prims.bool) = fun projectee -> true -let (__proj__E__item__map : - ext_state -> Prims.string FStarC_Compiler_Util.psmap) = - fun projectee -> match projectee with | E map -> map -let (cur_state : ext_state FStarC_Compiler_Effect.ref) = - let uu___ = let uu___1 = FStarC_Compiler_Util.psmap_empty () in E uu___1 in - FStarC_Compiler_Util.mk_ref uu___ -let (set : key -> value -> unit) = - fun k -> - fun v -> - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = FStarC_Compiler_Effect.op_Bang cur_state in - __proj__E__item__map uu___3 in - FStarC_Compiler_Util.psmap_add uu___2 k v in - E uu___1 in - FStarC_Compiler_Effect.op_Colon_Equals cur_state uu___ -let (get : key -> value) = - fun k -> - let r = - let uu___ = - let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang cur_state in - __proj__E__item__map uu___2 in - FStarC_Compiler_Util.psmap_try_find uu___1 k in - match uu___ with - | FStar_Pervasives_Native.None -> "" - | FStar_Pervasives_Native.Some v -> v in - r -let (is_prefix : Prims.string -> Prims.string -> Prims.bool) = - fun s1 -> - fun s2 -> - let l1 = FStarC_Compiler_String.length s1 in - let l2 = FStarC_Compiler_String.length s2 in - (l2 >= l1) && - (let uu___ = FStarC_Compiler_String.substring s2 Prims.int_zero l1 in - uu___ = s1) -let (getns : Prims.string -> (key * value) Prims.list) = - fun ns -> - let f k v acc = - let uu___ = is_prefix (Prims.strcat ns ":") k in - if uu___ then (k, v) :: acc else acc in - let uu___ = - let uu___1 = FStarC_Compiler_Effect.op_Bang cur_state in - __proj__E__item__map uu___1 in - FStarC_Compiler_Util.psmap_fold uu___ f [] -let (all : unit -> (key * value) Prims.list) = - fun uu___ -> - let f k v acc = (k, v) :: acc in - let uu___1 = - let uu___2 = FStarC_Compiler_Effect.op_Bang cur_state in - __proj__E__item__map uu___2 in - FStarC_Compiler_Util.psmap_fold uu___1 f [] -let (save : unit -> ext_state) = - fun uu___ -> FStarC_Compiler_Effect.op_Bang cur_state -let (restore : ext_state -> unit) = - fun s -> FStarC_Compiler_Effect.op_Colon_Equals cur_state s -let (reset : unit -> unit) = - fun uu___ -> - let uu___1 = let uu___2 = FStarC_Compiler_Util.psmap_empty () in E uu___2 in - FStarC_Compiler_Effect.op_Colon_Equals cur_state uu___1 \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_MachineInts.ml b/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_MachineInts.ml deleted file mode 100644 index f8f8ad206d3..00000000000 --- a/stage0/fstar-lib/generated/FStarC_TypeChecker_Primops_MachineInts.ml +++ /dev/null @@ -1,646 +0,0 @@ -open Prims -type 'a mymon = - (FStarC_TypeChecker_Primops_Base.primitive_step Prims.list, unit, 'a) - FStarC_Compiler_Writer.writer -let (bounded_arith_ops_for : - FStarC_Compiler_MachineInts.machint_kind -> unit mymon) = - fun k -> - let mod_name = FStarC_Compiler_MachineInts.module_name_for k in - let nm s = - let uu___ = - let uu___1 = - let uu___2 = FStarC_Compiler_MachineInts.module_name_for k in - [uu___2; s] in - "FStar" :: uu___1 in - FStarC_Parser_Const.p2l uu___ in - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = nm "v" in - FStarC_TypeChecker_Primops_Base.mk1 Prims.int_zero uu___3 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - FStarC_Syntax_Embeddings.e_int FStarC_TypeChecker_NBETerm.e_int - (FStarC_Compiler_MachineInts.v k) in - let uu___3 = - let uu___4 = - let uu___5 = nm "add" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___5 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___6 = - let uu___7 = FStarC_Compiler_MachineInts.v k x in - let uu___8 = FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.add_big_int uu___7 uu___8 in - FStarC_Compiler_MachineInts.make_as k x uu___6) in - let uu___5 = - let uu___6 = - let uu___7 = nm "sub" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___7 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___8 = - let uu___9 = FStarC_Compiler_MachineInts.v k x in - let uu___10 = FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.sub_big_int uu___9 uu___10 in - FStarC_Compiler_MachineInts.make_as k x uu___8) in - let uu___7 = - let uu___8 = - let uu___9 = nm "mul" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___9 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___10 = - let uu___11 = FStarC_Compiler_MachineInts.v k x in - let uu___12 = FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.mult_big_int uu___11 uu___12 in - FStarC_Compiler_MachineInts.make_as k x uu___10) in - let uu___9 = - let uu___10 = - let uu___11 = nm "gt" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___11 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - FStarC_Syntax_Embeddings.e_bool - FStarC_TypeChecker_NBETerm.e_bool - (fun x -> - fun y -> - let uu___12 = FStarC_Compiler_MachineInts.v k x in - let uu___13 = FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.gt_big_int uu___12 uu___13) in - let uu___11 = - let uu___12 = - let uu___13 = nm "gte" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero - uu___13 (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - FStarC_Syntax_Embeddings.e_bool - FStarC_TypeChecker_NBETerm.e_bool - (fun x -> - fun y -> - let uu___14 = FStarC_Compiler_MachineInts.v k x in - let uu___15 = FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.ge_big_int uu___14 uu___15) in - let uu___13 = - let uu___14 = - let uu___15 = nm "lt" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero - uu___15 (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - FStarC_Syntax_Embeddings.e_bool - FStarC_TypeChecker_NBETerm.e_bool - (fun x -> - fun y -> - let uu___16 = FStarC_Compiler_MachineInts.v k x in - let uu___17 = FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.lt_big_int uu___16 uu___17) in - let uu___15 = - let uu___16 = - let uu___17 = nm "lte" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero - uu___17 (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - FStarC_Syntax_Embeddings.e_bool - FStarC_TypeChecker_NBETerm.e_bool - (fun x -> - fun y -> - let uu___18 = - FStarC_Compiler_MachineInts.v k x in - let uu___19 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.le_big_int uu___18 uu___19) in - [uu___16] in - uu___14 :: uu___15 in - uu___12 :: uu___13 in - uu___10 :: uu___11 in - uu___8 :: uu___9 in - uu___6 :: uu___7 in - uu___4 :: uu___5 in - uu___2 :: uu___3 in - FStarC_Compiler_Writer.emit (FStarC_Class_Monoid.monoid_list ()) uu___1 in - FStarC_Class_Monad.op_let_Bang - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list ())) () () uu___ - (fun uu___1 -> - (fun uu___1 -> - let uu___1 = Obj.magic uu___1 in - let sz = FStarC_Compiler_MachineInts.width k in - let modulus = - let uu___2 = FStarC_BigInt.of_int_fs sz in - FStarC_BigInt.shift_left_big_int FStarC_BigInt.one uu___2 in - let mod1 x = FStarC_BigInt.mod_big_int x modulus in - let uu___2 = - let uu___3 = FStarC_Compiler_MachineInts.is_unsigned k in - if uu___3 - then - let uu___4 = - let uu___5 = - let uu___6 = nm "add_mod" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero uu___6 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___7 = - let uu___8 = - let uu___9 = FStarC_Compiler_MachineInts.v k x in - let uu___10 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.add_big_int uu___9 uu___10 in - mod1 uu___8 in - FStarC_Compiler_MachineInts.make_as k x uu___7) in - let uu___6 = - let uu___7 = - let uu___8 = nm "sub_mod" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero - uu___8 (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___9 = - let uu___10 = - let uu___11 = - FStarC_Compiler_MachineInts.v k x in - let uu___12 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.sub_big_int uu___11 uu___12 in - mod1 uu___10 in - FStarC_Compiler_MachineInts.make_as k x uu___9) in - let uu___8 = - let uu___9 = - let uu___10 = nm "div" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero - uu___10 (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___11 = - let uu___12 = - let uu___13 = - FStarC_Compiler_MachineInts.v k x in - let uu___14 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.div_big_int uu___13 uu___14 in - mod1 uu___12 in - FStarC_Compiler_MachineInts.make_as k x - uu___11) in - let uu___10 = - let uu___11 = - let uu___12 = nm "rem" in - FStarC_TypeChecker_Primops_Base.mk2 Prims.int_zero - uu___12 (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___13 = - let uu___14 = - let uu___15 = - FStarC_Compiler_MachineInts.v k x in - let uu___16 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.mod_big_int uu___15 - uu___16 in - mod1 uu___14 in - FStarC_Compiler_MachineInts.make_as k x - uu___13) in - let uu___12 = - let uu___13 = - let uu___14 = nm "logor" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___14 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___15 = - let uu___16 = - FStarC_Compiler_MachineInts.v k x in - let uu___17 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.logor_big_int uu___16 - uu___17 in - FStarC_Compiler_MachineInts.make_as k x - uu___15) in - let uu___14 = - let uu___15 = - let uu___16 = nm "logand" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___16 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___17 = - let uu___18 = - FStarC_Compiler_MachineInts.v k x in - let uu___19 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.logand_big_int uu___18 - uu___19 in - FStarC_Compiler_MachineInts.make_as k x - uu___17) in - let uu___16 = - let uu___17 = - let uu___18 = nm "logxor" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___18 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___19 = - let uu___20 = - FStarC_Compiler_MachineInts.v k x in - let uu___21 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.logxor_big_int uu___20 - uu___21 in - FStarC_Compiler_MachineInts.make_as k - x uu___19) in - let uu___18 = - let uu___19 = - let uu___20 = nm "lognot" in - FStarC_TypeChecker_Primops_Base.mk1 - Prims.int_zero uu___20 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (fun x -> - let uu___21 = - let uu___22 = - let uu___23 = - FStarC_Compiler_MachineInts.v k - x in - FStarC_BigInt.lognot_big_int - uu___23 in - let uu___23 = - FStarC_Compiler_MachineInts.mask k in - FStarC_BigInt.logand_big_int uu___22 - uu___23 in - FStarC_Compiler_MachineInts.make_as k - x uu___21) in - let uu___20 = - let uu___21 = - let uu___22 = nm "shift_left" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___22 - (FStarC_Compiler_MachineInts.e_machint - k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (FStarC_Compiler_MachineInts.e_machint - FStarC_Compiler_MachineInts.UInt32) - (FStarC_Compiler_MachineInts.nbe_machint - FStarC_Compiler_MachineInts.UInt32) - (FStarC_Compiler_MachineInts.e_machint - k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (fun x -> - fun y -> - let uu___23 = - let uu___24 = - let uu___25 = - FStarC_Compiler_MachineInts.v - k x in - let uu___26 = - FStarC_Compiler_MachineInts.v - FStarC_Compiler_MachineInts.UInt32 - y in - FStarC_BigInt.shift_left_big_int - uu___25 uu___26 in - let uu___25 = - FStarC_Compiler_MachineInts.mask - k in - FStarC_BigInt.logand_big_int - uu___24 uu___25 in - FStarC_Compiler_MachineInts.make_as - k x uu___23) in - let uu___22 = - let uu___23 = - let uu___24 = nm "shift_right" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___24 - (FStarC_Compiler_MachineInts.e_machint - k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (FStarC_Compiler_MachineInts.e_machint - FStarC_Compiler_MachineInts.UInt32) - (FStarC_Compiler_MachineInts.nbe_machint - FStarC_Compiler_MachineInts.UInt32) - (FStarC_Compiler_MachineInts.e_machint - k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (fun x -> - fun y -> - let uu___25 = - let uu___26 = - let uu___27 = - FStarC_Compiler_MachineInts.v - k x in - let uu___28 = - FStarC_Compiler_MachineInts.v - FStarC_Compiler_MachineInts.UInt32 - y in - FStarC_BigInt.shift_right_big_int - uu___27 uu___28 in - let uu___27 = - FStarC_Compiler_MachineInts.mask - k in - FStarC_BigInt.logand_big_int - uu___26 uu___27 in - FStarC_Compiler_MachineInts.make_as - k x uu___25) in - [uu___23] in - uu___21 :: uu___22 in - uu___19 :: uu___20 in - uu___17 :: uu___18 in - uu___15 :: uu___16 in - uu___13 :: uu___14 in - uu___11 :: uu___12 in - uu___9 :: uu___10 in - uu___7 :: uu___8 in - uu___5 :: uu___6 in - FStarC_Compiler_Writer.emit - (FStarC_Class_Monoid.monoid_list ()) uu___4 - else - FStarC_Class_Monad.return - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list ())) () (Obj.repr ()) in - Obj.magic - (FStarC_Class_Monad.op_let_Bang - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list ())) () () uu___2 - (fun uu___3 -> - (fun uu___3 -> - let uu___3 = Obj.magic uu___3 in - let uu___4 = - let uu___5 = - (FStarC_Compiler_MachineInts.is_unsigned k) && - (k <> FStarC_Compiler_MachineInts.SizeT) in - if uu___5 - then - let uu___6 = - let uu___7 = - let uu___8 = nm "add_underspec" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___8 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___9 = - let uu___10 = - let uu___11 = - FStarC_Compiler_MachineInts.v k x in - let uu___12 = - FStarC_Compiler_MachineInts.v k y in - FStarC_BigInt.add_big_int uu___11 - uu___12 in - mod1 uu___10 in - FStarC_Compiler_MachineInts.make_as k x - uu___9) in - let uu___8 = - let uu___9 = - let uu___10 = nm "sub_underspec" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___10 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint k) - (fun x -> - fun y -> - let uu___11 = - let uu___12 = - let uu___13 = - FStarC_Compiler_MachineInts.v k - x in - let uu___14 = - FStarC_Compiler_MachineInts.v k - y in - FStarC_BigInt.sub_big_int uu___13 - uu___14 in - mod1 uu___12 in - FStarC_Compiler_MachineInts.make_as k - x uu___11) in - let uu___10 = - let uu___11 = - let uu___12 = nm "mul_underspec" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___12 - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (FStarC_Compiler_MachineInts.e_machint k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (fun x -> - fun y -> - let uu___13 = - let uu___14 = - let uu___15 = - FStarC_Compiler_MachineInts.v - k x in - let uu___16 = - FStarC_Compiler_MachineInts.v - k y in - FStarC_BigInt.mult_big_int - uu___15 uu___16 in - mod1 uu___14 in - FStarC_Compiler_MachineInts.make_as - k x uu___13) in - [uu___11] in - uu___9 :: uu___10 in - uu___7 :: uu___8 in - FStarC_Compiler_Writer.emit - (FStarC_Class_Monoid.monoid_list ()) uu___6 - else - FStarC_Class_Monad.return - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list ())) () - (Obj.repr ()) in - Obj.magic - (FStarC_Class_Monad.op_let_Bang - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list ())) () () - uu___4 - (fun uu___5 -> - (fun uu___5 -> - let uu___5 = Obj.magic uu___5 in - let uu___6 = - let uu___7 = - (FStarC_Compiler_MachineInts.is_unsigned - k) - && - ((k <> - FStarC_Compiler_MachineInts.SizeT) - && - (k <> - FStarC_Compiler_MachineInts.UInt128)) in - if uu___7 - then - let uu___8 = - let uu___9 = - let uu___10 = nm "mul_mod" in - FStarC_TypeChecker_Primops_Base.mk2 - Prims.int_zero uu___10 - (FStarC_Compiler_MachineInts.e_machint - k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (FStarC_Compiler_MachineInts.e_machint - k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (FStarC_Compiler_MachineInts.e_machint - k) - (FStarC_Compiler_MachineInts.nbe_machint - k) - (fun x -> - fun y -> - let uu___11 = - let uu___12 = - let uu___13 = - FStarC_Compiler_MachineInts.v - k x in - let uu___14 = - FStarC_Compiler_MachineInts.v - k y in - FStarC_BigInt.mult_big_int - uu___13 uu___14 in - mod1 uu___12 in - FStarC_Compiler_MachineInts.make_as - k x uu___11) in - [uu___9] in - FStarC_Compiler_Writer.emit - (FStarC_Class_Monoid.monoid_list ()) - uu___8 - else - FStarC_Class_Monad.return - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list - ())) () (Obj.repr ()) in - Obj.magic - (FStarC_Class_Monad.op_let_Bang - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list ())) - () () uu___6 - (fun uu___7 -> - (fun uu___7 -> - let uu___7 = Obj.magic uu___7 in - Obj.magic - (FStarC_Class_Monad.return - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list - ())) () (Obj.repr ()))) - uu___7))) uu___5))) uu___3))) - uu___1) -let (ops : FStarC_TypeChecker_Primops_Base.primitive_step Prims.list) = - let uu___ = - let uu___1 = - let uu___2 = - FStarC_Class_Monad.iterM - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list ())) () - (fun uu___3 -> (Obj.magic bounded_arith_ops_for) uu___3) - (Obj.magic FStarC_Compiler_MachineInts.all_machint_kinds) in - FStarC_Class_Monad.op_let_Bang - (FStarC_Compiler_Writer.monad_writer - (FStarC_Class_Monoid.monoid_list ())) () () uu___2 - (fun uu___3 -> - (fun uu___3 -> - let uu___3 = Obj.magic uu___3 in - let uu___4 = - let uu___5 = - FStarC_TypeChecker_Primops_Base.mk1 Prims.int_zero - FStarC_Parser_Const.char_u32_of_char - FStarC_Syntax_Embeddings.e_char - FStarC_TypeChecker_NBETerm.e_char - (FStarC_Compiler_MachineInts.e_machint - FStarC_Compiler_MachineInts.UInt32) - (FStarC_Compiler_MachineInts.nbe_machint - FStarC_Compiler_MachineInts.UInt32) - (fun c -> - let n = - FStarC_BigInt.of_int_fs - (FStarC_Compiler_Util.int_of_char c) in - FStarC_Compiler_MachineInts.mk - FStarC_Compiler_MachineInts.UInt32 n - FStar_Pervasives_Native.None) in - [uu___5] in - Obj.magic - (FStarC_Compiler_Writer.emit - (FStarC_Class_Monoid.monoid_list ()) uu___4)) uu___3) in - Obj.magic - (FStarC_Compiler_Writer.run_writer (FStarC_Class_Monoid.monoid_list ()) - () (Obj.magic uu___1)) in - FStar_Pervasives_Native.fst uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid.ml b/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid.ml deleted file mode 100644 index 39e8f47163b..00000000000 --- a/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid.ml +++ /dev/null @@ -1,14 +0,0 @@ -open Prims -type 'a cm = - | CM of 'a * ('a -> 'a -> 'a) * unit * unit * unit -let uu___is_CM : 'a . 'a cm -> Prims.bool = fun projectee -> true -let __proj__CM__item__unit : 'a . 'a cm -> 'a = - fun projectee -> - match projectee with - | CM (unit, mult, identity, associativity, commutativity) -> unit -let __proj__CM__item__mult : 'a . 'a cm -> 'a -> 'a -> 'a = - fun projectee -> - match projectee with - | CM (unit, mult, identity, associativity, commutativity) -> mult -let (int_plus_cm : Prims.int cm) = CM (Prims.int_zero, (+), (), (), ()) -let (int_multiply_cm : Prims.int cm) = CM (Prims.int_one, ( * ), (), (), ()) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Fold.ml b/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Fold.ml deleted file mode 100644 index 1e2139dfc12..00000000000 --- a/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Fold.ml +++ /dev/null @@ -1,29 +0,0 @@ -open Prims -let init_func_from_expr : - 'c . - Prims.int -> - unit FStar_IntegerIntervals.not_less_than -> - ((unit, unit) FStar_IntegerIntervals.ifrom_ito -> 'c) -> - (unit, unit) FStar_IntegerIntervals.ifrom_ito -> - (unit, unit) FStar_IntegerIntervals.ifrom_ito -> - (unit, unit, (unit, unit) FStar_IntegerIntervals.ifrom_ito) - FStar_IntegerIntervals.counter_for -> 'c - = fun n0 -> fun nk -> fun expr -> fun a -> fun b -> fun i -> expr (n0 + i) -let rec fold : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - Prims.int -> - unit FStar_IntegerIntervals.not_less_than -> - ((unit, unit) FStar_IntegerIntervals.ifrom_ito -> 'c) -> 'c - = - fun eq -> - fun cm -> - fun a -> - fun b -> - fun expr -> - if b = a - then expr b - else - FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__mult eq cm - (fold eq cm a (b - Prims.int_one) expr) (expr b) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Fold_Nested.ml b/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Fold_Nested.ml deleted file mode 100644 index a760f02b628..00000000000 --- a/stage0/fstar-lib/generated/FStar_Algebra_CommMonoid_Fold_Nested.ml +++ /dev/null @@ -1,48 +0,0 @@ -open Prims -let transpose_generator : - 'c . - Prims.int -> - Prims.int -> - Prims.int -> - Prims.int -> - ((unit, unit) FStar_IntegerIntervals.ifrom_ito -> - (unit, unit) FStar_IntegerIntervals.ifrom_ito -> 'c) - -> - (unit, unit) FStar_IntegerIntervals.ifrom_ito -> - (unit, unit) FStar_IntegerIntervals.ifrom_ito -> 'c - = - fun m0 -> - fun mk -> fun n0 -> fun nk -> fun gen -> fun j -> fun i -> gen i j -let double_fold : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - Prims.int -> - unit FStar_IntegerIntervals.not_less_than -> - Prims.int -> - unit FStar_IntegerIntervals.not_less_than -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ((unit, unit) FStar_IntegerIntervals.ifrom_ito -> - (unit, unit) FStar_IntegerIntervals.ifrom_ito -> 'c) - -> 'c - = - fun eq -> - fun a0 -> - fun ak -> - fun b0 -> - fun bk -> - fun cm -> - fun g -> - FStar_Algebra_CommMonoid_Fold.fold eq cm a0 ak - (fun i -> - FStar_Algebra_CommMonoid_Fold.fold eq cm b0 bk (g i)) -let matrix_seq : - 'c . - Prims.pos -> - Prims.pos -> - ('c, unit, unit) FStar_Matrix.matrix_generator -> - 'c FStar_Seq_Base.seq - = - fun m -> - fun r -> - fun generator -> - FStar_Matrix.seq_of_matrix m r (FStar_Matrix.init m r generator) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Algebra_Monoid.ml b/stage0/fstar-lib/generated/FStar_Algebra_Monoid.ml deleted file mode 100644 index 133c0713185..00000000000 --- a/stage0/fstar-lib/generated/FStar_Algebra_Monoid.ml +++ /dev/null @@ -1,86 +0,0 @@ -open Prims -type ('m, 'u, 'mult) right_unitality_lemma = unit -type ('m, 'u, 'mult) left_unitality_lemma = unit -type ('m, 'mult) associativity_lemma = unit -type 'm monoid = - | Monoid of 'm * ('m -> 'm -> 'm) * unit * unit * unit -let uu___is_Monoid : 'm . 'm monoid -> Prims.bool = fun projectee -> true -let __proj__Monoid__item__unit : 'm . 'm monoid -> 'm = - fun projectee -> - match projectee with - | Monoid (unit, mult, right_unitality, left_unitality, associativity) -> - unit -let __proj__Monoid__item__mult : 'm . 'm monoid -> 'm -> 'm -> 'm = - fun projectee -> - match projectee with - | Monoid (unit, mult, right_unitality, left_unitality, associativity) -> - mult -let intro_monoid : 'm . 'm -> ('m -> 'm -> 'm) -> 'm monoid = - fun u -> fun mult -> Monoid (u, mult, (), (), ()) -let (nat_plus_monoid : Prims.nat monoid) = - let add x y = x + y in intro_monoid Prims.int_zero add -let (int_plus_monoid : Prims.int monoid) = intro_monoid Prims.int_zero (+) -let (conjunction_monoid : unit monoid) = - intro_monoid () (fun uu___1 -> fun uu___ -> ()) -let (disjunction_monoid : unit monoid) = - intro_monoid () (fun uu___1 -> fun uu___ -> ()) -let (bool_and_monoid : Prims.bool monoid) = - let and_ b1 b2 = b1 && b2 in intro_monoid true and_ -let (bool_or_monoid : Prims.bool monoid) = - let or_ b1 b2 = b1 || b2 in intro_monoid false or_ -let (bool_xor_monoid : Prims.bool monoid) = - let xor b1 b2 = (b1 || b2) && (Prims.op_Negation (b1 && b2)) in - intro_monoid false xor -let lift_monoid_option : - 'a . 'a monoid -> 'a FStar_Pervasives_Native.option monoid = - fun m -> - let mult x y = - match (x, y) with - | (FStar_Pervasives_Native.Some x0, FStar_Pervasives_Native.Some y0) -> - FStar_Pervasives_Native.Some (__proj__Monoid__item__mult m x0 y0) - | (uu___, uu___1) -> FStar_Pervasives_Native.None in - intro_monoid - (FStar_Pervasives_Native.Some (__proj__Monoid__item__unit m)) mult -type ('a, 'b, 'f, 'ma, 'mb) monoid_morphism_unit_lemma = unit -type ('a, 'b, 'f, 'ma, 'mb) monoid_morphism_mult_lemma = unit -type ('a, 'b, 'f, 'ma, 'mb) monoid_morphism = - | MonoidMorphism of unit * unit -let uu___is_MonoidMorphism : - 'a 'b . - ('a -> 'b) -> - 'a monoid -> - 'b monoid -> ('a, 'b, unit, unit, unit) monoid_morphism -> Prims.bool - = fun f -> fun ma -> fun mb -> fun projectee -> true -let intro_monoid_morphism : - 'a 'b . - ('a -> 'b) -> - 'a monoid -> 'b monoid -> ('a, 'b, unit, unit, unit) monoid_morphism - = fun f -> fun ma -> fun mb -> MonoidMorphism ((), ()) -let (embed_nat_int : Prims.nat -> Prims.int) = fun n -> n -let (uu___0 : (Prims.nat, Prims.int, unit, unit, unit) monoid_morphism) = - intro_monoid_morphism embed_nat_int nat_plus_monoid int_plus_monoid -type 'p neg = unit -let (uu___1 : (unit, unit, unit neg, unit, unit) monoid_morphism) = - intro_monoid_morphism (fun uu___ -> ()) conjunction_monoid - disjunction_monoid -let (uu___2 : (unit, unit, unit neg, unit, unit) monoid_morphism) = - intro_monoid_morphism (fun uu___ -> ()) disjunction_monoid - conjunction_monoid -type ('m, 'a, 'mult, 'act) mult_act_lemma = unit -type ('m, 'a, 'u, 'act) unit_act_lemma = unit -type ('m, 'mm, 'a) left_action = - | LAct of ('m -> 'a -> 'a) * unit * unit -let uu___is_LAct : - 'm . 'm monoid -> unit -> ('m, unit, Obj.t) left_action -> Prims.bool = - fun mm -> fun a -> fun projectee -> true -let __proj__LAct__item__act : - 'm . - 'm monoid -> - unit -> ('m, unit, Obj.t) left_action -> 'm -> Obj.t -> Obj.t - = - fun mm -> - fun a -> - fun projectee -> - match projectee with | LAct (act, mult_lemma, unit_lemma) -> act -type ('a, 'b, 'ma, 'mb, 'f, 'mf, 'mma, 'mmb, 'la, 'lb) left_action_morphism = - unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_BigOps.ml b/stage0/fstar-lib/generated/FStar_BigOps.ml deleted file mode 100644 index 3fa8e91f913..00000000000 --- a/stage0/fstar-lib/generated/FStar_BigOps.ml +++ /dev/null @@ -1,13 +0,0 @@ -open Prims -let normal : 'a . 'a -> 'a = fun x -> x -type ('a, 'f, 'l) big_and' = Obj.t -type ('a, 'f, 'l) big_and = Obj.t -type ('a, 'f, 'l) big_or' = Obj.t -type ('a, 'f, 'l) big_or = Obj.t -type ('a, 'f) symmetric = unit -type ('a, 'f) reflexive = unit -type ('a, 'f) anti_reflexive = unit -type ('a, 'f, 'l) pairwise_and' = Obj.t -type ('a, 'f, 'l) pairwise_and = Obj.t -type ('a, 'f, 'l) pairwise_or' = Obj.t -type ('a, 'f, 'l) pairwise_or = Obj.t \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Cardinality_Cantor.ml b/stage0/fstar-lib/generated/FStar_Cardinality_Cantor.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Cardinality_Cantor.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Cardinality_Universes.ml b/stage0/fstar-lib/generated/FStar_Cardinality_Universes.ml deleted file mode 100644 index bca8bdc5e0f..00000000000 --- a/stage0/fstar-lib/generated/FStar_Cardinality_Universes.ml +++ /dev/null @@ -1,5 +0,0 @@ -open Prims -type 'dummyV0 type_powerset = - | Mk of unit -let (uu___is_Mk : unit -> unit type_powerset -> Prims.bool) = - fun uu___ -> fun projectee -> true \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Class_Add.ml b/stage0/fstar-lib/generated/FStar_Class_Add.ml deleted file mode 100644 index 1c94f0adfb1..00000000000 --- a/stage0/fstar-lib/generated/FStar_Class_Add.ml +++ /dev/null @@ -1,18 +0,0 @@ -open Prims -type 'a additive = { - zero: 'a ; - plus: 'a -> 'a -> 'a } -let __proj__Mkadditive__item__zero : 'a . 'a additive -> 'a = - fun projectee -> match projectee with | { zero; plus;_} -> zero -let __proj__Mkadditive__item__plus : 'a . 'a additive -> 'a -> 'a -> 'a = - fun projectee -> match projectee with | { zero; plus;_} -> plus -let zero : 'a . 'a additive -> 'a = - fun projectee -> match projectee with | { zero = zero1; plus;_} -> zero1 -let plus : 'a . 'a additive -> 'a -> 'a -> 'a = - fun projectee -> - match projectee with | { zero = zero1; plus = plus1;_} -> plus1 -let op_Plus_Plus : 'a . 'a additive -> 'a -> 'a -> 'a = plus -let (add_int : Prims.int additive) = { zero = Prims.int_zero; plus = (+) } -let (add_bool : Prims.bool additive) = { zero = false; plus = (||) } -let add_list : 'a . unit -> 'a Prims.list additive = - fun uu___ -> { zero = []; plus = FStar_List_Tot_Base.append } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Class_Embeddable.ml b/stage0/fstar-lib/generated/FStar_Class_Embeddable.ml deleted file mode 100644 index a9669e2ecb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Class_Embeddable.ml +++ /dev/null @@ -1,97 +0,0 @@ -open Prims -type 'a embeddable = - { - embed: 'a -> FStarC_Reflection_Types.term ; - typ: FStarC_Reflection_Types.term } -let __proj__Mkembeddable__item__embed : - 'a . 'a embeddable -> 'a -> FStarC_Reflection_Types.term = - fun projectee -> match projectee with | { embed; typ;_} -> embed -let __proj__Mkembeddable__item__typ : - 'a . 'a embeddable -> FStarC_Reflection_Types.term = - fun projectee -> match projectee with | { embed; typ;_} -> typ -let embed : 'a . 'a embeddable -> 'a -> FStarC_Reflection_Types.term = - fun projectee -> match projectee with | { embed = embed1; typ;_} -> embed1 -let typ : 'a . 'a embeddable -> FStarC_Reflection_Types.term = - fun projectee -> - match projectee with | { embed = embed1; typ = typ1;_} -> typ1 -let (embeddable_string : Prims.string embeddable) = - { - embed = - (fun s -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - (FStarC_Reflection_V2_Data.C_String s))); - typ = - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv ["Prims"; "string"]))) - } -let (embeddable_bool : Prims.bool embeddable) = - { - embed = - (fun b -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - (if b - then FStarC_Reflection_V2_Data.C_True - else FStarC_Reflection_V2_Data.C_False))); - typ = - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv ["Prims"; "bool"]))) - } -let (embeddable_int : Prims.int embeddable) = - { - embed = - (fun i -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - (FStarC_Reflection_V2_Data.C_Int i))); - typ = - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv ["Prims"; "int"]))) - } -let rec e_list : - 'a . 'a embeddable -> 'a Prims.list -> FStarC_Reflection_Types.term = - fun ea -> - fun xs -> - match xs with - | [] -> - let uu___ = ea.typ in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv ["Prims"; "Nil"]))), - (uu___, FStarC_Reflection_V2_Data.Q_Implicit))) - | x::xs1 -> - let uu___ = e_list ea xs1 in - let uu___1 = embed ea x in - let uu___2 = ea.typ in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "Cons"]))), - (uu___2, FStarC_Reflection_V2_Data.Q_Implicit)))), - (uu___1, FStarC_Reflection_V2_Data.Q_Explicit)))), - (uu___, FStarC_Reflection_V2_Data.Q_Explicit))) -let embeddable_list : 'a . 'a embeddable -> 'a Prims.list embeddable = - fun ea -> - { - embed = (e_list ea); - typ = - (let uu___ = ea.typ in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv ["Prims"; "list"]))), - (uu___, FStarC_Reflection_V2_Data.Q_Explicit)))) - } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Class_Eq.ml b/stage0/fstar-lib/generated/FStar_Class_Eq.ml deleted file mode 100644 index 57ebdad99c6..00000000000 --- a/stage0/fstar-lib/generated/FStar_Class_Eq.ml +++ /dev/null @@ -1,38 +0,0 @@ -open Prims -type ('a, 'f) decides_eq = unit -type 'a deq = { - raw: 'a FStar_Class_Eq_Raw.deq ; - eq_dec: unit } -let __proj__Mkdeq__item__raw : 'a . 'a deq -> 'a FStar_Class_Eq_Raw.deq = - fun projectee -> match projectee with | { raw; eq_dec;_} -> raw -let raw : 'a . 'a deq -> 'a FStar_Class_Eq_Raw.deq = - fun projectee -> match projectee with | { raw = raw1; eq_dec;_} -> raw1 -let deq_raw_deq : 'a . 'a deq -> 'a FStar_Class_Eq_Raw.deq = fun d -> d.raw -let eq : 'a . 'a deq -> 'a -> 'a -> Prims.bool = - fun d -> fun x -> fun y -> (d.raw).FStar_Class_Eq_Raw.eq x y -let eq_instance_of_eqtype : 'a . 'a FStar_Class_Eq_Raw.deq -> 'a deq = - fun uu___ -> - { raw = (FStar_Class_Eq_Raw.eq_instance_of_eqtype ()); eq_dec = () } -let (int_has_eq : Prims.int deq) = - eq_instance_of_eqtype FStar_Class_Eq_Raw.int_has_eq -let (unit_has_eq : unit deq) = - eq_instance_of_eqtype FStar_Class_Eq_Raw.unit_has_eq -let (bool_has_eq : Prims.bool deq) = - eq_instance_of_eqtype FStar_Class_Eq_Raw.bool_has_eq -let (string_has_eq : Prims.string deq) = - eq_instance_of_eqtype FStar_Class_Eq_Raw.string_has_eq -let eq_list : 'a . 'a deq -> 'a Prims.list deq = - fun d -> { raw = (FStar_Class_Eq_Raw.eq_list d.raw); eq_dec = () } -let eq_pair : 'a 'b . 'a deq -> 'b deq -> ('a * 'b) deq = - fun uu___ -> - fun uu___1 -> - { - raw = - (FStar_Class_Eq_Raw.eq_pair (deq_raw_deq uu___) - (deq_raw_deq uu___1)); - eq_dec = () - } -let eq_option : 'a . 'a deq -> 'a FStar_Pervasives_Native.option deq = - fun uu___ -> - { raw = (FStar_Class_Eq_Raw.eq_option (deq_raw_deq uu___)); eq_dec = () } -let op_Equals : 'a . 'a deq -> 'a -> 'a -> Prims.bool = eq \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Class_Eq_Raw.ml b/stage0/fstar-lib/generated/FStar_Class_Eq_Raw.ml deleted file mode 100644 index bd77b03b44d..00000000000 --- a/stage0/fstar-lib/generated/FStar_Class_Eq_Raw.ml +++ /dev/null @@ -1,50 +0,0 @@ -open Prims -type 'a deq = { - eq: 'a -> 'a -> Prims.bool } -let __proj__Mkdeq__item__eq : 'a . 'a deq -> 'a -> 'a -> Prims.bool = - fun projectee -> match projectee with | { eq;_} -> eq -let eq : 'a . 'a deq -> 'a -> 'a -> Prims.bool = - fun projectee -> match projectee with | { eq = eq1;_} -> eq1 -let eq_instance_of_eqtype : 'a . unit -> 'a deq = - fun uu___ -> { eq = (fun x -> fun y -> x = y) } -let (int_has_eq : Prims.int deq) = eq_instance_of_eqtype () -let (unit_has_eq : unit deq) = eq_instance_of_eqtype () -let (bool_has_eq : Prims.bool deq) = eq_instance_of_eqtype () -let (string_has_eq : Prims.string deq) = eq_instance_of_eqtype () -let rec eqList : - 'a . - ('a -> 'a -> Prims.bool) -> 'a Prims.list -> 'a Prims.list -> Prims.bool - = - fun eq1 -> - fun xs -> - fun ys -> - match (xs, ys) with - | ([], []) -> true - | (x::xs1, y::ys1) -> (eq1 x y) && (eqList eq1 xs1 ys1) - | (uu___, uu___1) -> false -let eq_list : 'a . 'a deq -> 'a Prims.list deq = - fun uu___ -> { eq = (eqList (eq uu___)) } -let eq_pair : 'a 'b . 'a deq -> 'b deq -> ('a * 'b) deq = - fun uu___ -> - fun uu___1 -> - { - eq = - (fun uu___2 -> - fun uu___3 -> - match (uu___2, uu___3) with - | ((a1, b1), (c, d)) -> (eq uu___ a1 c) && (eq uu___1 b1 d)) - } -let eq_option : 'a . 'a deq -> 'a FStar_Pervasives_Native.option deq = - fun uu___ -> - { - eq = - (fun o1 -> - fun o2 -> - match (o1, o2) with - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) - -> true - | (FStar_Pervasives_Native.Some x, FStar_Pervasives_Native.Some - y) -> eq uu___ x y - | (uu___1, uu___2) -> false) - } -let op_Equals : 'a . 'a deq -> 'a -> 'a -> Prims.bool = eq \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Class_Printable.ml b/stage0/fstar-lib/generated/FStar_Class_Printable.ml deleted file mode 100644 index a6c581cf4d4..00000000000 --- a/stage0/fstar-lib/generated/FStar_Class_Printable.ml +++ /dev/null @@ -1,262 +0,0 @@ -open Prims -type 'a printable = { - to_string: 'a -> Prims.string } -let __proj__Mkprintable__item__to_string : - 'a . 'a printable -> 'a -> Prims.string = - fun projectee -> match projectee with | { to_string;_} -> to_string -let to_string : 'a . 'a printable -> 'a -> Prims.string = - fun projectee -> - match projectee with | { to_string = to_string1;_} -> to_string1 -let (printable_unit : unit printable) = { to_string = (fun uu___ -> "()") } -let (printable_bool : Prims.bool printable) = - { to_string = Prims.string_of_bool } -let (printable_nat : Prims.nat printable) = - { to_string = Prims.string_of_int } -let (printable_int : Prims.int printable) = - { to_string = Prims.string_of_int } -let printable_ref : 'a 'p . 'a printable -> 'a printable = - fun d -> { to_string = (d.to_string) } -let printable_list : 'a . 'a printable -> 'a Prims.list printable = - fun x -> - { - to_string = - (fun l -> - Prims.strcat "[" - (Prims.strcat - (FStar_String.concat "; " - (FStar_List_Tot_Base.map (to_string x) l)) "]")) - } -let (printable_string : Prims.string printable) = - { to_string = (fun x -> Prims.strcat "\"" (Prims.strcat x "\"")) } -let printable_option : - 'a . 'a printable -> 'a FStar_Pervasives_Native.option printable = - fun uu___ -> - { - to_string = - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.None -> "None" - | FStar_Pervasives_Native.Some x -> - Prims.strcat "(Some " (Prims.strcat (to_string uu___ x) ")")) - } -let printable_either : - 'a 'b . - 'a printable -> - 'b printable -> ('a, 'b) FStar_Pervasives.either printable - = - fun uu___ -> - fun uu___1 -> - { - to_string = - (fun uu___2 -> - match uu___2 with - | FStar_Pervasives.Inl x -> - Prims.strcat "(Inl " (Prims.strcat (to_string uu___ x) ")") - | FStar_Pervasives.Inr x -> - Prims.strcat "(Inr " (Prims.strcat (to_string uu___1 x) ")")) - } -let (printable_char : FStar_Char.char printable) = - { to_string = FStar_String.string_of_char } -let (printable_byte : FStar_UInt8.t printable) = - { to_string = FStar_UInt8.to_string } -let (printable_int8 : FStar_Int8.t printable) = - { to_string = FStar_Int8.to_string } -let (printable_uint8 : FStar_UInt8.t printable) = - { to_string = FStar_UInt8.to_string } -let (printable_int16 : FStar_Int16.t printable) = - { to_string = FStar_Int16.to_string } -let (printable_uint16 : FStar_UInt16.t printable) = - { to_string = FStar_UInt16.to_string } -let (printable_int32 : FStar_Int32.t printable) = - { to_string = FStar_Int32.to_string } -let (printable_uint32 : FStar_UInt32.t printable) = - { to_string = FStar_UInt32.to_string } -let (printable_int64 : FStar_Int64.t printable) = - { to_string = FStar_Int64.to_string } -let (printable_uint64 : FStar_UInt64.t printable) = - { to_string = FStar_UInt64.to_string } -let printable_tuple2 : - 'a 'b . 'a printable -> 'b printable -> ('a * 'b) printable = - fun uu___ -> - fun uu___1 -> - { - to_string = - (fun uu___2 -> - match uu___2 with - | (x, y) -> - Prims.strcat "(" - (Prims.strcat (to_string uu___ x) - (Prims.strcat ", " - (Prims.strcat (to_string uu___1 y) ")")))) - } -let printable_tuple3 : - 't0 't1 't2 . - 't0 printable -> - 't1 printable -> 't2 printable -> ('t0 * 't1 * 't2) printable - = - fun uu___ -> - fun uu___1 -> - fun uu___2 -> - { - to_string = - (fun uu___3 -> - match uu___3 with - | (v0, v1, v2) -> - Prims.strcat "(" - (Prims.strcat (to_string uu___ v0) - (Prims.strcat ", " - (Prims.strcat (to_string uu___1 v1) - (Prims.strcat ", " - (Prims.strcat (to_string uu___2 v2) ")")))))) - } -let printable_tuple4 : - 't0 't1 't2 't3 . - 't0 printable -> - 't1 printable -> - 't2 printable -> 't3 printable -> ('t0 * 't1 * 't2 * 't3) printable - = - fun uu___ -> - fun uu___1 -> - fun uu___2 -> - fun uu___3 -> - { - to_string = - (fun uu___4 -> - match uu___4 with - | (v0, v1, v2, v3) -> - Prims.strcat "(" - (Prims.strcat (to_string uu___ v0) - (Prims.strcat ", " - (Prims.strcat (to_string uu___1 v1) - (Prims.strcat ", " - (Prims.strcat (to_string uu___2 v2) - (Prims.strcat ", " - (Prims.strcat (to_string uu___3 v3) - ")")))))))) - } -let printable_tuple5 : - 't0 't1 't2 't3 't4 . - 't0 printable -> - 't1 printable -> - 't2 printable -> - 't3 printable -> - 't4 printable -> ('t0 * 't1 * 't2 * 't3 * 't4) printable - = - fun uu___ -> - fun uu___1 -> - fun uu___2 -> - fun uu___3 -> - fun uu___4 -> - { - to_string = - (fun uu___5 -> - match uu___5 with - | (v0, v1, v2, v3, v4) -> - Prims.strcat "(" - (Prims.strcat (to_string uu___ v0) - (Prims.strcat ", " - (Prims.strcat (to_string uu___1 v1) - (Prims.strcat ", " - (Prims.strcat (to_string uu___2 v2) - (Prims.strcat ", " - (Prims.strcat - (to_string uu___3 v3) - (Prims.strcat ", " - (Prims.strcat - (to_string uu___4 v4) ")")))))))))) - } -let printable_tuple6 : - 't0 't1 't2 't3 't4 't5 . - 't0 printable -> - 't1 printable -> - 't2 printable -> - 't3 printable -> - 't4 printable -> - 't5 printable -> ('t0 * 't1 * 't2 * 't3 * 't4 * 't5) printable - = - fun uu___ -> - fun uu___1 -> - fun uu___2 -> - fun uu___3 -> - fun uu___4 -> - fun uu___5 -> - { - to_string = - (fun uu___6 -> - match uu___6 with - | (v0, v1, v2, v3, v4, v5) -> - Prims.strcat "(" - (Prims.strcat (to_string uu___ v0) - (Prims.strcat ", " - (Prims.strcat (to_string uu___1 v1) - (Prims.strcat ", " - (Prims.strcat (to_string uu___2 v2) - (Prims.strcat ", " - (Prims.strcat - (to_string uu___3 v3) - (Prims.strcat ", " - (Prims.strcat - (to_string uu___4 v4) - (Prims.strcat ", " - (Prims.strcat - (to_string uu___5 - v5) ")")))))))))))) - } -let printable_tuple7 : - 't0 't1 't2 't3 't4 't5 't6 . - 't0 printable -> - 't1 printable -> - 't2 printable -> - 't3 printable -> - 't4 printable -> - 't5 printable -> - 't6 printable -> - ('t0 * 't1 * 't2 * 't3 * 't4 * 't5 * 't6) printable - = - fun uu___ -> - fun uu___1 -> - fun uu___2 -> - fun uu___3 -> - fun uu___4 -> - fun uu___5 -> - fun uu___6 -> - { - to_string = - (fun uu___7 -> - match uu___7 with - | (v0, v1, v2, v3, v4, v5, v6) -> - Prims.strcat "(" - (Prims.strcat (to_string uu___ v0) - (Prims.strcat ", " - (Prims.strcat (to_string uu___1 v1) - (Prims.strcat ", " - (Prims.strcat (to_string uu___2 v2) - (Prims.strcat ", " - (Prims.strcat - (to_string uu___3 v3) - (Prims.strcat ", " - (Prims.strcat - (to_string uu___4 v4) - (Prims.strcat ", " - (Prims.strcat - (to_string - uu___5 v5) - (Prims.strcat - ", " - (Prims.strcat - ( - to_string - uu___6 v6) - ")")))))))))))))) - } -let printable_seq : 'b . 'b printable -> 'b FStar_Seq_Base.seq printable = - fun x -> - { - to_string = - (fun s -> - let strings_of_b = FStar_Seq_Properties.map_seq (to_string x) s in - Prims.strcat "<" - (Prims.strcat - (FStar_String.concat "; " - (FStar_Seq_Base.seq_to_list strings_of_b)) ">")) - } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Class_TotalOrder_Raw.ml b/stage0/fstar-lib/generated/FStar_Class_TotalOrder_Raw.ml deleted file mode 100644 index 302ec669bc1..00000000000 --- a/stage0/fstar-lib/generated/FStar_Class_TotalOrder_Raw.ml +++ /dev/null @@ -1,87 +0,0 @@ -open Prims -let (flip : FStar_Order.order -> FStar_Order.order) = - fun uu___ -> - match uu___ with - | FStar_Order.Lt -> FStar_Order.Gt - | FStar_Order.Eq -> FStar_Order.Eq - | FStar_Order.Gt -> FStar_Order.Lt -type 'a raw_comparator = 'a -> 'a -> FStar_Order.order -type 'a totalorder = { - compare: 'a raw_comparator } -let __proj__Mktotalorder__item__compare : - 'a . 'a totalorder -> 'a raw_comparator = - fun projectee -> match projectee with | { compare;_} -> compare -let compare : 'a . 'a totalorder -> 'a raw_comparator = - fun projectee -> match projectee with | { compare = compare1;_} -> compare1 -let op_Less : 't . 't totalorder -> 't -> 't -> Prims.bool = - fun uu___ -> fun x -> fun y -> (compare uu___ x y) = FStar_Order.Lt -let op_Greater : 't . 't totalorder -> 't -> 't -> Prims.bool = - fun uu___ -> fun x -> fun y -> (compare uu___ x y) = FStar_Order.Gt -let op_Equals : 't . 't totalorder -> 't -> 't -> Prims.bool = - fun uu___ -> fun x -> fun y -> (compare uu___ x y) = FStar_Order.Eq -let op_Less_Equals : 't . 't totalorder -> 't -> 't -> Prims.bool = - fun uu___ -> fun x -> fun y -> (compare uu___ x y) <> FStar_Order.Gt -let op_Greater_Equals : 't . 't totalorder -> 't -> 't -> Prims.bool = - fun uu___ -> fun x -> fun y -> (compare uu___ x y) <> FStar_Order.Lt -let op_Less_Greater : 't . 't totalorder -> 't -> 't -> Prims.bool = - fun uu___ -> fun x -> fun y -> (compare uu___ x y) <> FStar_Order.Eq -let (uu___0 : Prims.int totalorder) = { compare = FStar_Order.compare_int } -let (uu___1 : Prims.bool totalorder) = - { - compare = - (fun b1 -> - fun b2 -> - match (b1, b2) with - | (false, false) -> FStar_Order.Eq - | (true, true) -> FStar_Order.Eq - | (false, uu___) -> FStar_Order.Lt - | uu___ -> FStar_Order.Gt) - } -let totalorder_pair : - 'a 'b . 'a totalorder -> 'b totalorder -> ('a * 'b) totalorder = - fun d1 -> - fun d2 -> - { - compare = - (fun uu___ -> - fun uu___2 -> - match (uu___, uu___2) with - | ((xa, xb), (ya, yb)) -> - (match compare d1 xa ya with - | FStar_Order.Lt -> FStar_Order.Lt - | FStar_Order.Gt -> FStar_Order.Gt - | FStar_Order.Eq -> compare d2 xb yb)) - } -let totalorder_option : - 'a . 'a totalorder -> 'a FStar_Pervasives_Native.option totalorder = - fun d -> - { - compare = - (fun o1 -> - fun o2 -> - match (o1, o2) with - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.None) - -> FStar_Order.Eq - | (FStar_Pervasives_Native.None, FStar_Pervasives_Native.Some - uu___) -> FStar_Order.Lt - | (FStar_Pervasives_Native.Some uu___, - FStar_Pervasives_Native.None) -> FStar_Order.Gt - | (FStar_Pervasives_Native.Some a1, FStar_Pervasives_Native.Some - a2) -> compare d a1 a2) - } -let rec raw_compare_lists : - 'a . 'a totalorder -> 'a Prims.list raw_comparator = - fun d -> - fun l1 -> - fun l2 -> - match (l1, l2) with - | ([], []) -> FStar_Order.Eq - | ([], uu___::uu___2) -> FStar_Order.Lt - | (uu___::uu___2, []) -> FStar_Order.Gt - | (x::xs, y::ys) -> - (match compare d x y with - | FStar_Order.Lt -> FStar_Order.Lt - | FStar_Order.Gt -> FStar_Order.Gt - | FStar_Order.Eq -> raw_compare_lists d xs ys) -let totalorder_list : 'a . 'a totalorder -> 'a Prims.list totalorder = - fun d -> { compare = (raw_compare_lists d) } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Classical_Sugar.ml b/stage0/fstar-lib/generated/FStar_Classical_Sugar.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Classical_Sugar.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_ConstantTime_Integers.ml b/stage0/fstar-lib/generated/FStar_ConstantTime_Integers.ml deleted file mode 100644 index f1638ce8879..00000000000 --- a/stage0/fstar-lib/generated/FStar_ConstantTime_Integers.ml +++ /dev/null @@ -1,41 +0,0 @@ -open Prims -type sw = FStar_Integers.signed_width -type ('sl, 'l, 's) secret_int = (unit, unit, Obj.t) FStar_IFC.protected -let (promote : - unit -> - unit -> - sw -> - (unit, unit, unit) secret_int -> - unit -> (unit, unit, unit) secret_int) - = - fun sl -> - fun l0 -> - fun s -> - fun x -> - fun l1 -> - FStar_IFC.join () () () () - (Obj.magic (FStar_IFC.hide () () () (Obj.magic x))) -type qual = - | Secret of unit * unit * sw - | Public of FStar_Integers.signed_width -let (uu___is_Secret : qual -> Prims.bool) = - fun projectee -> - match projectee with | Secret (sl, l, sw1) -> true | uu___ -> false - - -let (__proj__Secret__item__sw : qual -> sw) = - fun projectee -> match projectee with | Secret (sl, l, sw1) -> sw1 -let (uu___is_Public : qual -> Prims.bool) = - fun projectee -> match projectee with | Public sw1 -> true | uu___ -> false -let (__proj__Public__item__sw : qual -> FStar_Integers.signed_width) = - fun projectee -> match projectee with | Public sw1 -> sw1 -let (sw_qual : qual -> FStar_Integers.signed_width) = - fun uu___ -> - match uu___ with - | Secret (uu___1, uu___2, sw1) -> sw1 - | Public sw1 -> sw1 - -type 'q t = Obj.t -let (as_secret : qual -> Obj.t -> (unit, unit, unit) secret_int) = - fun uu___1 -> fun uu___ -> (fun q -> fun x -> Obj.magic x) uu___1 uu___ -let (as_public : qual -> Obj.t -> Obj.t) = fun q -> fun x -> x \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_DependentMap.ml b/stage0/fstar-lib/generated/FStar_DependentMap.ml deleted file mode 100644 index c4ae061c786..00000000000 --- a/stage0/fstar-lib/generated/FStar_DependentMap.ml +++ /dev/null @@ -1,77 +0,0 @@ -open Prims -type ('key, 'value) t = - { - mappings: ('key, 'value) FStar_FunctionalExtensionality.restricted_t } -let __proj__Mkt__item__mappings : - 'key 'value . - ('key, 'value) t -> - ('key, 'value) FStar_FunctionalExtensionality.restricted_t - = fun projectee -> match projectee with | { mappings;_} -> mappings -let create : 'key 'value . ('key -> 'value) -> ('key, 'value) t = - fun f -> { mappings = (FStar_FunctionalExtensionality.on_domain f) } -let sel : 'key 'value . ('key, 'value) t -> 'key -> 'value = - fun m -> fun k -> m.mappings k -let upd : - 'key 'value . ('key, 'value) t -> 'key -> 'value -> ('key, 'value) t = - fun m -> - fun k -> - fun v -> - { - mappings = - (FStar_FunctionalExtensionality.on_domain - (fun k' -> if k' = k then v else m.mappings k')) - } -type ('key, 'value, 'm1, 'm2) equal = unit -let restrict : 'key 'value 'p . ('key, 'value) t -> ('key, 'value) t = - fun m -> - { mappings = (FStar_FunctionalExtensionality.on_domain m.mappings) } -type ('key1, 'value1, 'key2, 'value2, 'k) concat_value = Obj.t -let concat_mappings : - 'key1 'value1 'key2 'value2 . - ('key1 -> 'value1) -> - ('key2 -> 'value2) -> ('key1, 'key2) FStar_Pervasives.either -> Obj.t - = - fun m1 -> - fun m2 -> - fun k -> - match k with - | FStar_Pervasives.Inl k1 -> Obj.repr (m1 k1) - | FStar_Pervasives.Inr k2 -> Obj.repr (m2 k2) -let concat : - 'key1 'value1 'key2 'value2 . - ('key1, 'value1) t -> - ('key2, 'value2) t -> (('key1, 'key2) FStar_Pervasives.either, Obj.t) t - = - fun m1 -> - fun m2 -> - { - mappings = - (FStar_FunctionalExtensionality.on_domain - (concat_mappings m1.mappings m2.mappings)) - } -type ('key1, 'value1, 'key2, 'ren, 'k) rename_value = 'value1 -let rename : - 'key1 'value1 . - ('key1, 'value1) t -> - unit -> - (Obj.t -> 'key1) -> - (Obj.t, ('key1, 'value1, Obj.t, unit, unit) rename_value) t - = - fun m -> - fun key2 -> - fun ren -> - { - mappings = - (FStar_FunctionalExtensionality.on_domain - (fun k2 -> m.mappings (ren k2))) - } -let map : - 'key 'value1 'value2 . - ('key -> 'value1 -> 'value2) -> ('key, 'value1) t -> ('key, 'value2) t - = - fun f -> - fun m -> - { - mappings = - (FStar_FunctionalExtensionality.on_domain (fun k -> f k (sel m k))) - } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Endianness.ml b/stage0/fstar-lib/generated/FStar_Endianness.ml deleted file mode 100644 index 8a9ce9aa9d9..00000000000 --- a/stage0/fstar-lib/generated/FStar_Endianness.ml +++ /dev/null @@ -1,134 +0,0 @@ -open Prims -type bytes = FStar_UInt8.t FStar_Seq_Base.seq -let rec (le_to_n : bytes -> Prims.nat) = - fun b -> - if (FStar_Seq_Base.length b) = Prims.int_zero - then Prims.int_zero - else - (FStar_UInt8.v (FStar_Seq_Properties.head b)) + - ((Prims.pow2 (Prims.of_int (8))) * - (le_to_n (FStar_Seq_Properties.tail b))) -let rec (be_to_n : bytes -> Prims.nat) = - fun b -> - if (FStar_Seq_Base.length b) = Prims.int_zero - then Prims.int_zero - else - (FStar_UInt8.v (FStar_Seq_Properties.last b)) + - ((Prims.pow2 (Prims.of_int (8))) * - (be_to_n - (FStar_Seq_Base.slice b Prims.int_zero - ((FStar_Seq_Base.length b) - Prims.int_one)))) -let rec (n_to_le : Prims.nat -> Prims.nat -> bytes) = - fun len -> - fun n -> - if len = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let len1 = len - Prims.int_one in - let byte = FStar_UInt8.uint_to_t (n mod (Prims.of_int (256))) in - let n' = n / (Prims.of_int (256)) in - let b' = n_to_le len1 n' in let b = FStar_Seq_Base.cons byte b' in b) -let rec (n_to_be : Prims.nat -> Prims.nat -> bytes) = - fun len -> - fun n -> - if len = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let len1 = len - Prims.int_one in - let byte = FStar_UInt8.uint_to_t (n mod (Prims.of_int (256))) in - let n' = n / (Prims.of_int (256)) in - let b' = n_to_be len1 n' in - let b'' = FStar_Seq_Base.create Prims.int_one byte in - let b = FStar_Seq_Base.append b' b'' in b) -let (uint32_of_le : bytes -> FStar_UInt32.t) = - fun b -> let n = le_to_n b in FStar_UInt32.uint_to_t n -let (le_of_uint32 : FStar_UInt32.t -> bytes) = - fun x -> n_to_le (Prims.of_int (4)) (FStar_UInt32.v x) -let (uint32_of_be : bytes -> FStar_UInt32.t) = - fun b -> let n = be_to_n b in FStar_UInt32.uint_to_t n -let (be_of_uint32 : FStar_UInt32.t -> bytes) = - fun x -> n_to_be (Prims.of_int (4)) (FStar_UInt32.v x) -let (uint64_of_le : bytes -> FStar_UInt64.t) = - fun b -> let n = le_to_n b in FStar_UInt64.uint_to_t n -let (le_of_uint64 : FStar_UInt64.t -> bytes) = - fun x -> n_to_le (Prims.of_int (8)) (FStar_UInt64.v x) -let (uint64_of_be : bytes -> FStar_UInt64.t) = - fun b -> let n = be_to_n b in FStar_UInt64.uint_to_t n -let (be_of_uint64 : FStar_UInt64.t -> bytes) = - fun x -> n_to_be (Prims.of_int (8)) (FStar_UInt64.v x) -let rec (seq_uint32_of_le : - Prims.nat -> bytes -> FStar_UInt32.t FStar_Seq_Base.seq) = - fun l -> - fun b -> - if (FStar_Seq_Base.length b) = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let uu___1 = FStar_Seq_Properties.split b (Prims.of_int (4)) in - match uu___1 with - | (hd, tl) -> - FStar_Seq_Base.cons (uint32_of_le hd) - (seq_uint32_of_le (l - Prims.int_one) tl)) -let rec (le_of_seq_uint32 : FStar_UInt32.t FStar_Seq_Base.seq -> bytes) = - fun s -> - if (FStar_Seq_Base.length s) = Prims.int_zero - then FStar_Seq_Base.empty () - else - FStar_Seq_Base.append (le_of_uint32 (FStar_Seq_Properties.head s)) - (le_of_seq_uint32 (FStar_Seq_Properties.tail s)) -let rec (seq_uint32_of_be : - Prims.nat -> bytes -> FStar_UInt32.t FStar_Seq_Base.seq) = - fun l -> - fun b -> - if (FStar_Seq_Base.length b) = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let uu___1 = FStar_Seq_Properties.split b (Prims.of_int (4)) in - match uu___1 with - | (hd, tl) -> - FStar_Seq_Base.cons (uint32_of_be hd) - (seq_uint32_of_be (l - Prims.int_one) tl)) -let rec (be_of_seq_uint32 : FStar_UInt32.t FStar_Seq_Base.seq -> bytes) = - fun s -> - if (FStar_Seq_Base.length s) = Prims.int_zero - then FStar_Seq_Base.empty () - else - FStar_Seq_Base.append (be_of_uint32 (FStar_Seq_Properties.head s)) - (be_of_seq_uint32 (FStar_Seq_Properties.tail s)) -let rec (seq_uint64_of_le : - Prims.nat -> bytes -> FStar_UInt64.t FStar_Seq_Base.seq) = - fun l -> - fun b -> - if (FStar_Seq_Base.length b) = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let uu___1 = FStar_Seq_Properties.split b (Prims.of_int (8)) in - match uu___1 with - | (hd, tl) -> - FStar_Seq_Base.cons (uint64_of_le hd) - (seq_uint64_of_le (l - Prims.int_one) tl)) -let rec (le_of_seq_uint64 : FStar_UInt64.t FStar_Seq_Base.seq -> bytes) = - fun s -> - if (FStar_Seq_Base.length s) = Prims.int_zero - then FStar_Seq_Base.empty () - else - FStar_Seq_Base.append (le_of_uint64 (FStar_Seq_Properties.head s)) - (le_of_seq_uint64 (FStar_Seq_Properties.tail s)) -let rec (seq_uint64_of_be : - Prims.nat -> bytes -> FStar_UInt64.t FStar_Seq_Base.seq) = - fun l -> - fun b -> - if (FStar_Seq_Base.length b) = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let uu___1 = FStar_Seq_Properties.split b (Prims.of_int (8)) in - match uu___1 with - | (hd, tl) -> - FStar_Seq_Base.cons (uint64_of_be hd) - (seq_uint64_of_be (l - Prims.int_one) tl)) -let rec (be_of_seq_uint64 : FStar_UInt64.t FStar_Seq_Base.seq -> bytes) = - fun s -> - if (FStar_Seq_Base.length s) = Prims.int_zero - then FStar_Seq_Base.empty () - else - FStar_Seq_Base.append (be_of_uint64 (FStar_Seq_Properties.head s)) - (be_of_seq_uint64 (FStar_Seq_Properties.tail s)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Error.ml b/stage0/fstar-lib/generated/FStar_Error.ml deleted file mode 100644 index de303a64986..00000000000 --- a/stage0/fstar-lib/generated/FStar_Error.ml +++ /dev/null @@ -1,28 +0,0 @@ -open Prims -type ('a, 'b) optResult = - | Error of 'a - | Correct of 'b -let uu___is_Error : 'a 'b . ('a, 'b) optResult -> Prims.bool = - fun projectee -> match projectee with | Error _0 -> true | uu___ -> false -let __proj__Error__item___0 : 'a 'b . ('a, 'b) optResult -> 'a = - fun projectee -> match projectee with | Error _0 -> _0 -let uu___is_Correct : 'a 'b . ('a, 'b) optResult -> Prims.bool = - fun projectee -> match projectee with | Correct _0 -> true | uu___ -> false -let __proj__Correct__item___0 : 'a 'b . ('a, 'b) optResult -> 'b = - fun projectee -> match projectee with | Correct _0 -> _0 -let (perror : Prims.string -> Prims.int -> Prims.string -> Prims.string) = - fun file -> fun line -> fun text -> text -let correct : 'a 'r . 'r -> ('a, 'r) optResult = fun x -> Correct x -let rec unexpected : 'a . Prims.string -> 'a = - fun s -> - let uu___ = - FStar_IO.debug_print_string - (Prims.strcat "Platform.Error.unexpected: " s) in - unexpected s -let rec unreachable : 'a . Prims.string -> 'a = - fun s -> - let uu___ = - FStar_IO.debug_print_string - (Prims.strcat "Platform.Error.unreachable: " s) in - unreachable s -let if_ideal : 'a . (unit -> 'a) -> 'a -> 'a = fun f -> fun x -> x \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_ExtractAs.ml b/stage0/fstar-lib/generated/FStar_ExtractAs.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_ExtractAs.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Fin.ml b/stage0/fstar-lib/generated/FStar_Fin.ml deleted file mode 100644 index c2c3f8a0bb7..00000000000 --- a/stage0/fstar-lib/generated/FStar_Fin.ml +++ /dev/null @@ -1,93 +0,0 @@ -open Prims -type 'n fin = Prims.int -type 'p under = Prims.nat -type ('n, 'a) vect = 'a Prims.list -type ('n, 'a) seqn = 'a FStar_Seq_Base.seq -type ('a, 's) in_ = Prims.nat -let rec find : - 'a . - 'a FStar_Seq_Base.seq -> - ('a -> Prims.bool) -> - Prims.nat -> Prims.nat FStar_Pervasives_Native.option - = - fun s -> - fun p -> - fun i -> - if p (FStar_Seq_Base.index s i) - then FStar_Pervasives_Native.Some i - else - if (i + Prims.int_one) < (FStar_Seq_Base.length s) - then find s p (i + Prims.int_one) - else FStar_Pervasives_Native.None -let rec (pigeonhole : - Prims.pos -> Prims.nat FStar_Seq_Base.seq -> (Prims.nat * Prims.nat)) = - fun n -> - fun s -> - if n = Prims.int_one - then (Prims.int_zero, Prims.int_one) - else - (let k0 = FStar_Seq_Base.index s Prims.int_zero in - match find s (fun k -> k = k0) Prims.int_one with - | FStar_Pervasives_Native.Some i -> (Prims.int_zero, i) - | FStar_Pervasives_Native.None -> - let uu___1 = - pigeonhole (n - Prims.int_one) - (FStar_Seq_Base.init n - (fun i -> - let k = FStar_Seq_Base.index s (i + Prims.int_one) in - if k < k0 then k else k - Prims.int_one)) in - (match uu___1 with - | (i1, i2) -> ((i1 + Prims.int_one), (i2 + Prims.int_one)))) -type 'a binary_relation = 'a -> 'a -> Prims.bool -type ('a, 'r) is_reflexive = unit -type ('a, 'r) is_symmetric = unit -type ('a, 'r) is_transitive = unit -type 'a equivalence_relation = 'a -> 'a -> Prims.bool -type ('a, 'eq, 's, 'x) contains_eq = unit -type ('a, 'eq, 's) items_of = 'a -let rec find_eq : - 'a . 'a equivalence_relation -> 'a FStar_Seq_Base.seq -> 'a -> Prims.nat = - fun eq -> - fun s -> - fun x -> - if (FStar_Seq_Base.length s) = Prims.int_one - then Prims.int_zero - else - if eq x (FStar_Seq_Base.index s Prims.int_zero) - then Prims.int_zero - else - (let ieq = find_eq eq (FStar_Seq_Properties.tail s) x in - Prims.int_one + ieq) -let rec pigeonhole_eq : - 'a . - 'a equivalence_relation -> - 'a FStar_Seq_Base.seq -> - ('a, unit, unit) items_of FStar_Seq_Base.seq -> - (Prims.nat * Prims.nat) - = - fun eq -> - fun holes -> - fun pigeons -> - if (FStar_Seq_Base.length holes) = Prims.int_one - then (Prims.int_zero, Prims.int_one) - else - (let first_pigeon = FStar_Seq_Base.index pigeons Prims.int_zero in - match find pigeons (fun k -> eq k first_pigeon) Prims.int_one with - | FStar_Pervasives_Native.Some i -> (Prims.int_zero, i) - | FStar_Pervasives_Native.None -> - let index_of_first_pigeon = find_eq eq holes first_pigeon in - let holes_except_first_pigeon = - FStar_Seq_Base.append - (FStar_Seq_Base.slice holes Prims.int_zero - index_of_first_pigeon) - (FStar_Seq_Base.slice holes - (index_of_first_pigeon + Prims.int_one) - (FStar_Seq_Base.length holes)) in - let uu___1 = - pigeonhole_eq eq holes_except_first_pigeon - (FStar_Seq_Base.init - ((FStar_Seq_Base.length pigeons) - Prims.int_one) - (fun i -> - FStar_Seq_Base.index pigeons (i + Prims.int_one))) in - (match uu___1 with - | (i1, i2) -> ((i1 + Prims.int_one), (i2 + Prims.int_one)))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_FiniteMap_Ambient.ml b/stage0/fstar-lib/generated/FStar_FiniteMap_Ambient.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_FiniteMap_Ambient.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_FiniteMap_Base.ml b/stage0/fstar-lib/generated/FStar_FiniteMap_Base.ml deleted file mode 100644 index d278427f7f1..00000000000 --- a/stage0/fstar-lib/generated/FStar_FiniteMap_Base.ml +++ /dev/null @@ -1,106 +0,0 @@ -open Prims -type ('a, 'b, 's) setfun_t = - ('a, 'b FStar_Pervasives_Native.option) - FStar_FunctionalExtensionality.restricted_t -type ('a, 'b) map = - ('a FStar_FiniteSet_Base.set, ('a, 'b, unit) setfun_t) Prims.dtuple2 -let domain : 'a 'b . ('a, 'b) map -> 'a FStar_FiniteSet_Base.set = - fun m -> - let uu___ = m in - match uu___ with | Prims.Mkdtuple2 (keys, uu___1) -> keys -let elements : 'a 'b . ('a, 'b) map -> ('a, 'b, unit) setfun_t = - fun m -> - let uu___ = m in match uu___ with | Prims.Mkdtuple2 (uu___1, f) -> f -let mem : 'a 'b . 'a -> ('a, 'b) map -> Prims.bool = - fun key -> fun m -> FStar_FiniteSet_Base.mem key (domain m) -let rec key_in_item_list : 'a 'b . 'a -> ('a * 'b) Prims.list -> Prims.bool = - fun key -> - fun items -> - match items with - | [] -> false - | (k, v)::tl -> (key = k) || (key_in_item_list key tl) -let rec item_list_doesnt_repeat_keys : - 'a 'b . ('a * 'b) Prims.list -> Prims.bool = - fun items -> - match items with - | [] -> true - | (k, v)::tl -> - (Prims.op_Negation (key_in_item_list k tl)) && - (item_list_doesnt_repeat_keys tl) -let lookup : 'a 'b . 'a -> ('a, 'b) map -> 'b = - fun key -> - fun m -> FStar_Pervasives_Native.__proj__Some__item__v (elements m key) -type ('a, 'b, 'm) values = unit -type ('a, 'b, 'm) items = unit -let emptymap : 'a 'b . unit -> ('a, 'b) map = - fun uu___ -> - Prims.Mkdtuple2 - ((FStar_FiniteSet_Base.emptyset ()), - (FStar_FunctionalExtensionality.on_domain - (fun key -> FStar_Pervasives_Native.None))) -let glue : - 'a 'b . - 'a FStar_FiniteSet_Base.set -> ('a, 'b, unit) setfun_t -> ('a, 'b) map - = fun keys -> fun f -> Prims.Mkdtuple2 (keys, f) -let insert : 'a 'b . 'a -> 'b -> ('a, 'b) map -> ('a, 'b) map = - fun k -> - fun v -> - fun m -> - let keys' = FStar_FiniteSet_Base.insert k (domain m) in - let f' = - FStar_FunctionalExtensionality.on_domain - (fun key -> - if key = k - then FStar_Pervasives_Native.Some v - else elements m key) in - Prims.Mkdtuple2 (keys', f') -let merge : 'a 'b . ('a, 'b) map -> ('a, 'b) map -> ('a, 'b) map = - fun m1 -> - fun m2 -> - let keys' = FStar_FiniteSet_Base.union (domain m1) (domain m2) in - let f' = - FStar_FunctionalExtensionality.on_domain - (fun key -> - if FStar_FiniteSet_Base.mem key (domain m2) - then elements m2 key - else elements m1 key) in - Prims.Mkdtuple2 (keys', f') -let subtract : - 'a 'b . ('a, 'b) map -> 'a FStar_FiniteSet_Base.set -> ('a, 'b) map = - fun m -> - fun s -> - let keys' = FStar_FiniteSet_Base.difference (domain m) s in - let f' = - FStar_FunctionalExtensionality.on_domain - (fun key -> - if FStar_FiniteSet_Base.mem key keys' - then elements m key - else FStar_Pervasives_Native.None) in - Prims.Mkdtuple2 (keys', f') -type ('a, 'b, 'm1, 'm2) equal = unit -type ('a, 'b, 'm1, 'm2) disjoint = unit -let remove : 'a 'b . 'a -> ('a, 'b) map -> ('a, 'b) map = - fun key -> fun m -> subtract m (FStar_FiniteSet_Base.singleton key) -let notin : 'a 'b . 'a -> ('a, 'b) map -> Prims.bool = - fun key -> fun m -> Prims.op_Negation (mem key m) -type cardinality_zero_iff_empty_fact = unit -type empty_or_domain_occupied_fact = unit -type empty_or_values_occupied_fact = unit -type empty_or_items_occupied_fact = unit -type map_cardinality_matches_domain_fact = unit -type values_contains_fact = unit -type items_contains_fact = unit -type empty_domain_empty_fact = unit -type glue_domain_fact = unit -type glue_elements_fact = unit -type insert_elements_fact = unit -type insert_member_cardinality_fact = unit -type insert_nonmember_cardinality_fact = unit -type merge_domain_is_union_fact = unit -type merge_element_fact = unit -type subtract_domain_fact = unit -type subtract_element_fact = unit -type map_equal_fact = unit -type map_extensionality_fact = unit -type disjoint_fact = unit -type all_finite_map_facts = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_FiniteSet_Ambient.ml b/stage0/fstar-lib/generated/FStar_FiniteSet_Ambient.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_FiniteSet_Ambient.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_FiniteSet_Base.ml b/stage0/fstar-lib/generated/FStar_FiniteSet_Base.ml deleted file mode 100644 index 59afa81e01a..00000000000 --- a/stage0/fstar-lib/generated/FStar_FiniteSet_Base.ml +++ /dev/null @@ -1,118 +0,0 @@ -open Prims -type ('a, 'f, 'xs) has_elements = unit -type 'a set = ('a, Prims.bool) FStar_FunctionalExtensionality.restricted_t -let mem : 'a . 'a -> 'a set -> Prims.bool = fun x -> fun s -> s x -let rec list_nonrepeating : 'a . 'a Prims.list -> Prims.bool = - fun xs -> - match xs with - | [] -> true - | hd::tl -> - (Prims.op_Negation (FStar_List_Tot_Base.mem hd tl)) && - (list_nonrepeating tl) -let rec remove_repeats : 'a . 'a Prims.list -> 'a Prims.list = - fun xs -> - match xs with - | [] -> [] - | hd::tl -> - let tl' = remove_repeats tl in - if FStar_List_Tot_Base.mem hd tl then tl' else hd :: tl' -let intro_set : - 'a . - ('a, Prims.bool) FStar_FunctionalExtensionality.restricted_t -> - unit -> 'a set - = fun f -> fun xs -> f -let emptyset : 'a . unit -> 'a set = - fun uu___ -> - intro_set - (FStar_FunctionalExtensionality.on_domain (fun uu___1 -> false)) () -let insert : 'a . 'a -> 'a set -> 'a set = - fun x -> - fun s -> - intro_set - (FStar_FunctionalExtensionality.on_domain - (fun x' -> (x = x') || (s x'))) () -let singleton : 'a . 'a -> 'a set = fun x -> insert x (emptyset ()) -let rec union_lists : 'a . 'a Prims.list -> 'a Prims.list -> 'a Prims.list = - fun xs -> - fun ys -> match xs with | [] -> ys | hd::tl -> hd :: (union_lists tl ys) -let union : 'a . 'a set -> 'a set -> 'a set = - fun s1 -> - fun s2 -> - intro_set - (FStar_FunctionalExtensionality.on_domain (fun x -> (s1 x) || (s2 x))) - () -let rec intersect_lists : - 'a . 'a Prims.list -> 'a Prims.list -> 'a Prims.list = - fun xs -> - fun ys -> - match xs with - | [] -> [] - | hd::tl -> - let zs' = intersect_lists tl ys in - if FStar_List_Tot_Base.mem hd ys then hd :: zs' else zs' -let intersection : 'a . 'a set -> 'a set -> 'a set = - fun s1 -> - fun s2 -> - intro_set - (FStar_FunctionalExtensionality.on_domain (fun x -> (s1 x) && (s2 x))) - () -let rec difference_lists : - 'a . 'a Prims.list -> 'a Prims.list -> 'a Prims.list = - fun xs -> - fun ys -> - match xs with - | [] -> [] - | hd::tl -> - let zs' = difference_lists tl ys in - if FStar_List_Tot_Base.mem hd ys then zs' else hd :: zs' -let difference : 'a . 'a set -> 'a set -> 'a set = - fun s1 -> - fun s2 -> - intro_set - (FStar_FunctionalExtensionality.on_domain - (fun x -> (s1 x) && (Prims.op_Negation (s2 x)))) () -type ('a, 's1, 's2) subset = unit -type ('a, 's1, 's2) equal = unit -type ('a, 's1, 's2) disjoint = unit -let remove : 'a . 'a -> 'a set -> 'a set = - fun x -> fun s -> difference s (singleton x) -let notin : 'a . 'a -> 'a set -> Prims.bool = - fun x -> fun s -> Prims.op_Negation (mem x s) -type empty_set_contains_no_elements_fact = unit -type length_zero_fact = unit -type singleton_contains_argument_fact = unit -type singleton_contains_fact = unit -type singleton_cardinality_fact = unit -type insert_fact = unit -type insert_contains_argument_fact = unit -type insert_contains_fact = unit -type insert_member_cardinality_fact = unit -type insert_nonmember_cardinality_fact = unit -type union_contains_fact = unit -type union_contains_element_from_first_argument_fact = unit -type union_contains_element_from_second_argument_fact = unit -type union_of_disjoint_fact = unit -type intersection_contains_fact = unit -type union_idempotent_right_fact = unit -type union_idempotent_left_fact = unit -type intersection_idempotent_right_fact = unit -type intersection_idempotent_left_fact = unit -type intersection_cardinality_fact = unit -type difference_contains_fact = unit -type difference_doesnt_include_fact = unit -type difference_cardinality_fact = unit -type subset_fact = unit -type equal_fact = unit -type equal_extensionality_fact = unit -type disjoint_fact = unit -type insert_remove_fact = unit -type remove_insert_fact = unit -type set_as_list_cardinality_fact = unit -type all_finite_set_facts = unit -let rec remove_from_nonrepeating_list : - 'a . 'a -> 'a Prims.list -> 'a Prims.list = - fun x -> - fun xs -> - match xs with - | hd::tl -> - if x = hd then tl else hd :: (remove_from_nonrepeating_list x tl) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_FunctionalQueue.ml b/stage0/fstar-lib/generated/FStar_FunctionalQueue.ml deleted file mode 100644 index 7d6a4cad0d3..00000000000 --- a/stage0/fstar-lib/generated/FStar_FunctionalQueue.ml +++ /dev/null @@ -1,37 +0,0 @@ -open Prims -type 'a queue = ('a Prims.list * 'a Prims.list) -let empty : 'a . unit -> 'a queue = fun uu___ -> ([], []) -let queue_to_list : 'a . 'a queue -> 'a Prims.list = - fun q -> - match FStar_Pervasives_Native.fst q with - | [] -> [] - | uu___ -> - FStar_List_Tot_Base.op_At (FStar_Pervasives_Native.fst q) - (FStar_List_Tot_Base.rev (FStar_Pervasives_Native.snd q)) -let queue_of_list : 'a . 'a Prims.list -> 'a queue = - fun l -> match l with | [] -> empty () | uu___ -> (l, []) -let queue_to_seq : 'a . 'a queue -> 'a FStar_Seq_Base.seq = - fun q -> FStar_Seq_Base.seq_of_list (queue_to_list q) -let queue_of_seq : 'a . 'a FStar_Seq_Base.seq -> 'a queue = - fun s -> queue_of_list (FStar_Seq_Base.seq_to_list s) -type ('a, 'q1, 'q2) equal = unit -type ('a, 'q) not_empty = unit -let enqueue : 'a . 'a -> 'a queue -> 'a queue = - fun x -> - fun q -> - match FStar_Pervasives_Native.fst q with - | [] -> ([x], []) - | l -> (l, (x :: (FStar_Pervasives_Native.snd q))) -let dequeue : 'a . 'a queue -> ('a * 'a queue) = - fun q -> - let uu___ = FStar_Pervasives_Native.fst q in - match uu___ with - | hd::tl -> - (match tl with - | [] -> - (hd, - ((FStar_List_Tot_Base.rev (FStar_Pervasives_Native.snd q)), - [])) - | uu___1 -> (hd, (tl, (FStar_Pervasives_Native.snd q)))) -let peek : 'a . 'a queue -> 'a = - fun q -> FStar_List_Tot_Base.hd (FStar_Pervasives_Native.fst q) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Functions.ml b/stage0/fstar-lib/generated/FStar_Functions.ml deleted file mode 100644 index 24561405f25..00000000000 --- a/stage0/fstar-lib/generated/FStar_Functions.ml +++ /dev/null @@ -1,8 +0,0 @@ -open Prims -type ('a, 'b, 'f) is_inj = unit -type ('a, 'b, 'f) is_surj = unit -type ('a, 'b, 'f) is_bij = unit -type ('a, 'b, 'f, 'y) in_image = unit -type ('a, 'b, 'f) image_of = 'b -type ('a, 'b, 'g, 'f) is_inverse_of = unit -type 'a powerset = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_GSet.ml b/stage0/fstar-lib/generated/FStar_GSet.ml deleted file mode 100644 index 27aaacec689..00000000000 --- a/stage0/fstar-lib/generated/FStar_GSet.ml +++ /dev/null @@ -1,12 +0,0 @@ -open Prims -type 'a set = unit -type ('a, 's1, 's2) equal = unit - - - - - - - -type ('a, 's1, 's2) disjoint = unit -type ('a, 's1, 's2) subset = unit diff --git a/stage0/fstar-lib/generated/FStar_GhostSet.ml b/stage0/fstar-lib/generated/FStar_GhostSet.ml deleted file mode 100644 index 97098d4f063..00000000000 --- a/stage0/fstar-lib/generated/FStar_GhostSet.ml +++ /dev/null @@ -1,6 +0,0 @@ -open Prims -type 'a set = unit -type 'a decide_eq = unit -type ('a, 's1, 's2) equal = unit -type ('a, 's1, 's2) disjoint = unit -type ('a, 's1, 's2) subset = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_HyperStack.ml b/stage0/fstar-lib/generated/FStar_HyperStack.ml deleted file mode 100644 index b87442d7ff3..00000000000 --- a/stage0/fstar-lib/generated/FStar_HyperStack.ml +++ /dev/null @@ -1,7 +0,0 @@ -open Prims -type 'a reference = ('a, unit) FStar_Monotonic_HyperStack.mreference -type 'a stackref = ('a, unit) FStar_Monotonic_HyperStack.mstackref -type 'a ref = ('a, unit) FStar_Monotonic_HyperStack.mref -type 'a mmstackref = ('a, unit) FStar_Monotonic_HyperStack.mmmstackref -type 'a mmref = ('a, unit) FStar_Monotonic_HyperStack.mmmref -type ('i, 'a) s_ref = (unit, 'a, unit) FStar_Monotonic_HyperStack.s_mref \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_IFC.ml b/stage0/fstar-lib/generated/FStar_IFC.ml deleted file mode 100644 index 75cc7ebc776..00000000000 --- a/stage0/fstar-lib/generated/FStar_IFC.ml +++ /dev/null @@ -1,38 +0,0 @@ -open Prims -type ('a, 'f) associative = unit -type ('a, 'f) commutative = unit -type ('a, 'f) idempotent = unit -type semilattice = - | SemiLattice of unit * Obj.t * (Obj.t -> Obj.t -> Obj.t) -let (uu___is_SemiLattice : semilattice -> Prims.bool) = fun projectee -> true -let (__proj__SemiLattice__item__top : semilattice -> Obj.t) = - fun projectee -> - match projectee with | SemiLattice (carrier, top, lub) -> top -let (__proj__SemiLattice__item__lub : semilattice -> Obj.t -> Obj.t -> Obj.t) - = - fun projectee -> - match projectee with | SemiLattice (carrier, top, lub) -> lub -type sl = unit -type 'sl1 lattice_element = unit - -type ('sl1, 'l, 'b) protected = 'b -let (hide : unit -> unit -> unit -> Obj.t -> Obj.t) = - fun sl1 -> fun l -> fun b -> fun x -> x -let (return : unit -> unit -> unit -> Obj.t -> Obj.t) = - fun sl1 -> fun a -> fun l -> fun x -> hide () () () x -let map : - 'a 'b . - unit -> - unit -> - (unit, unit, 'a) protected -> - ('a -> 'b) -> (unit, unit, 'b) protected - = fun sl1 -> fun l -> fun x -> fun f -> f x -let (join : unit -> unit -> unit -> unit -> Obj.t -> Obj.t) = - fun sl1 -> fun l1 -> fun l2 -> fun a -> fun x -> x -let (op_let_Greater_Greater : - unit -> unit -> unit -> Obj.t -> unit -> unit -> (Obj.t -> Obj.t) -> Obj.t) - = - fun sl1 -> - fun l1 -> - fun a -> - fun x -> fun l2 -> fun b -> fun f -> join () () () () (map () () x f) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_IndefiniteDescription.ml b/stage0/fstar-lib/generated/FStar_IndefiniteDescription.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_IndefiniteDescription.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Int.ml b/stage0/fstar-lib/generated/FStar_Int.ml deleted file mode 100644 index 49f3a859391..00000000000 --- a/stage0/fstar-lib/generated/FStar_Int.ml +++ /dev/null @@ -1,130 +0,0 @@ -open Prims -let (max_int : Prims.pos -> Prims.int) = - fun n -> (Prims.pow2 (n - Prims.int_one)) - Prims.int_one -let (min_int : Prims.pos -> Prims.int) = - fun n -> - (Prims.pow2 (n - Prims.int_one)) -let (fits : Prims.int -> Prims.pos -> Prims.bool) = - fun x -> fun n -> ((min_int n) <= x) && (x <= (max_int n)) -type ('x, 'n) size = unit -type 'n int_t = Prims.int -let (op_Slash : Prims.int -> Prims.int -> Prims.int) = - fun a -> - fun b -> - if - ((a >= Prims.int_zero) && (b < Prims.int_zero)) || - ((a < Prims.int_zero) && (b >= Prims.int_zero)) - then - ((Prims.abs a) / (Prims.abs b)) - else (Prims.abs a) / (Prims.abs b) -let (op_At_Percent : Prims.int -> Prims.int -> Prims.int) = - fun v -> - fun p -> - let m = v mod p in - if m >= (op_Slash p (Prims.of_int (2))) then m - p else m -let (zero : Prims.pos -> unit int_t) = fun n -> Prims.int_zero -let (pow2_n : Prims.pos -> Prims.nat -> unit int_t) = - fun n -> fun p -> Prims.pow2 p -let (pow2_minus_one : Prims.pos -> Prims.nat -> unit int_t) = - fun n -> fun m -> (Prims.pow2 m) - Prims.int_one -let (one : Prims.pos -> unit int_t) = fun n -> Prims.int_one -let (ones : Prims.pos -> unit int_t) = fun n -> (Prims.of_int (-1)) -let (incr : Prims.pos -> unit int_t -> unit int_t) = - fun n -> fun a -> a + Prims.int_one -let (decr : Prims.pos -> unit int_t -> unit int_t) = - fun n -> fun a -> a - Prims.int_one -let (incr_underspec : Prims.pos -> unit int_t -> unit int_t) = - fun n -> - fun a -> if a < (max_int n) then a + Prims.int_one else Prims.int_zero -let (decr_underspec : Prims.pos -> unit int_t -> unit int_t) = - fun n -> - fun a -> if a > (min_int n) then a - Prims.int_one else Prims.int_zero -let (incr_mod : Prims.pos -> unit int_t -> unit int_t) = - fun n -> fun a -> (a + Prims.int_one) mod (Prims.pow2 (n - Prims.int_one)) -let (decr_mod : Prims.pos -> unit int_t -> unit int_t) = - fun n -> fun a -> (a - Prims.int_one) mod (Prims.pow2 (n - Prims.int_one)) -let (add : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> a + b -let (add_underspec : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> if fits (a + b) n then a + b else Prims.int_zero -let (add_mod : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> op_At_Percent (a + b) (Prims.pow2 n) -let (sub : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> a - b -let (sub_underspec : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> if fits (a - b) n then a - b else Prims.int_zero -let (sub_mod : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> op_At_Percent (a - b) (Prims.pow2 n) -let (mul : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> a * b -let (mul_underspec : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> if fits (a * b) n then a * b else Prims.int_zero -let (mul_mod : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> op_At_Percent (a * b) (Prims.pow2 n) -let (div : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> op_Slash a b -let (div_underspec : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> - fun a -> - fun b -> if fits (op_Slash a b) n then op_Slash a b else Prims.int_zero -let (udiv : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> op_Slash a b -let (mod1 : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> fun a -> fun b -> a - ((op_Slash a b) * b) -let (eq : Prims.pos -> unit int_t -> unit int_t -> Prims.bool) = - fun n -> fun a -> fun b -> a = b -let (gt : Prims.pos -> unit int_t -> unit int_t -> Prims.bool) = - fun n -> fun a -> fun b -> a > b -let (gte : Prims.pos -> unit int_t -> unit int_t -> Prims.bool) = - fun n -> fun a -> fun b -> a >= b -let (lt : Prims.pos -> unit int_t -> unit int_t -> Prims.bool) = - fun n -> fun a -> fun b -> a < b -let (lte : Prims.pos -> unit int_t -> unit int_t -> Prims.bool) = - fun n -> fun a -> fun b -> a <= b -let (to_uint : Prims.pos -> unit int_t -> unit FStar_UInt.uint_t) = - fun n -> fun x -> if Prims.int_zero <= x then x else x + (Prims.pow2 n) -let (from_uint : Prims.pos -> unit FStar_UInt.uint_t -> unit int_t) = - fun n -> fun x -> if x <= (max_int n) then x else x - (Prims.pow2 n) -let (to_int_t : Prims.pos -> Prims.int -> unit int_t) = - fun m -> fun a -> op_At_Percent a (Prims.pow2 m) -let (to_vec : Prims.pos -> unit int_t -> unit FStar_BitVector.bv_t) = - fun n -> fun num -> FStar_UInt.to_vec n (to_uint n num) -let (from_vec : Prims.pos -> unit FStar_BitVector.bv_t -> unit int_t) = - fun n -> - fun vec -> - let x = FStar_UInt.from_vec n vec in - if (max_int n) < x then x - (Prims.pow2 n) else x -let (nth : Prims.pos -> unit int_t -> Prims.nat -> Prims.bool) = - fun n -> fun a -> fun i -> FStar_Seq_Base.index (to_vec n a) i -let (logand : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> - fun a -> - fun b -> - from_vec n (FStar_BitVector.logand_vec n (to_vec n a) (to_vec n b)) -let (logxor : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> - fun a -> - fun b -> - from_vec n (FStar_BitVector.logxor_vec n (to_vec n a) (to_vec n b)) -let (logor : Prims.pos -> unit int_t -> unit int_t -> unit int_t) = - fun n -> - fun a -> - fun b -> - from_vec n (FStar_BitVector.logor_vec n (to_vec n a) (to_vec n b)) -let (lognot : Prims.pos -> unit int_t -> unit int_t) = - fun n -> fun a -> from_vec n (FStar_BitVector.lognot_vec n (to_vec n a)) -let (minus : Prims.pos -> unit int_t -> unit int_t) = - fun n -> fun a -> add_mod n (lognot n a) Prims.int_one -let (shift_left : Prims.pos -> unit int_t -> Prims.nat -> unit int_t) = - fun n -> - fun a -> - fun s -> from_vec n (FStar_BitVector.shift_left_vec n (to_vec n a) s) -let (shift_right : Prims.pos -> unit int_t -> Prims.nat -> unit int_t) = - fun n -> - fun a -> - fun s -> from_vec n (FStar_BitVector.shift_right_vec n (to_vec n a) s) -let (shift_arithmetic_right : - Prims.pos -> unit int_t -> Prims.nat -> unit int_t) = - fun n -> - fun a -> - fun s -> - from_vec n - (FStar_BitVector.shift_arithmetic_right_vec n (to_vec n a) s) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Int128.ml b/stage0/fstar-lib/generated/FStar_Int128.ml deleted file mode 100644 index 8f6fabf749a..00000000000 --- a/stage0/fstar-lib/generated/FStar_Int128.ml +++ /dev/null @@ -1,81 +0,0 @@ -open Prims -let (n : Prims.int) = (Prims.of_int (128)) -type t = - | Mk of unit FStar_Int.int_t -let (uu___is_Mk : t -> Prims.bool) = fun projectee -> true -let (__proj__Mk__item__v : t -> unit FStar_Int.int_t) = - fun projectee -> match projectee with | Mk v -> v -let (v : t -> unit FStar_Int.int_t) = fun x -> __proj__Mk__item__v x -let (int_to_t : unit FStar_Int.int_t -> t) = fun x -> Mk x -let (zero : t) = int_to_t Prims.int_zero -let (one : t) = int_to_t Prims.int_one -let (add : t -> t -> t) = - fun a -> fun b -> Mk (FStar_Int.add (Prims.of_int (128)) (v a) (v b)) -let (sub : t -> t -> t) = - fun a -> fun b -> Mk (FStar_Int.sub (Prims.of_int (128)) (v a) (v b)) -let (mul : t -> t -> t) = - fun a -> fun b -> Mk (FStar_Int.mul (Prims.of_int (128)) (v a) (v b)) -let (div : t -> t -> t) = - fun a -> fun b -> Mk (FStar_Int.div (Prims.of_int (128)) (v a) (v b)) -let (rem : t -> t -> t) = - fun a -> fun b -> Mk (FStar_Int.mod1 (Prims.of_int (128)) (v a) (v b)) -let (logand : t -> t -> t) = - fun x -> fun y -> Mk (FStar_Int.logand (Prims.of_int (128)) (v x) (v y)) -let (logxor : t -> t -> t) = - fun x -> fun y -> Mk (FStar_Int.logxor (Prims.of_int (128)) (v x) (v y)) -let (logor : t -> t -> t) = - fun x -> fun y -> Mk (FStar_Int.logor (Prims.of_int (128)) (v x) (v y)) -let (lognot : t -> t) = - fun x -> Mk (FStar_Int.lognot (Prims.of_int (128)) (v x)) -let (shift_right : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - Mk - (FStar_Int.shift_right (Prims.of_int (128)) (v a) (FStar_UInt32.v s)) -let (shift_left : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - Mk (FStar_Int.shift_left (Prims.of_int (128)) (v a) (FStar_UInt32.v s)) -let (shift_arithmetic_right : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - Mk - (FStar_Int.shift_arithmetic_right (Prims.of_int (128)) (v a) - (FStar_UInt32.v s)) -let (eq : t -> t -> Prims.bool) = - fun a -> fun b -> FStar_Int.eq (Prims.of_int (128)) (v a) (v b) -let (gt : t -> t -> Prims.bool) = - fun a -> fun b -> FStar_Int.gt (Prims.of_int (128)) (v a) (v b) -let (gte : t -> t -> Prims.bool) = - fun a -> fun b -> FStar_Int.gte (Prims.of_int (128)) (v a) (v b) -let (lt : t -> t -> Prims.bool) = - fun a -> fun b -> FStar_Int.lt (Prims.of_int (128)) (v a) (v b) -let (lte : t -> t -> Prims.bool) = - fun a -> fun b -> FStar_Int.lte (Prims.of_int (128)) (v a) (v b) -let (op_Plus_Hat : t -> t -> t) = add -let (op_Subtraction_Hat : t -> t -> t) = sub -let (op_Star_Hat : t -> t -> t) = mul -let (op_Slash_Hat : t -> t -> t) = div -let (op_Percent_Hat : t -> t -> t) = rem -let (op_Hat_Hat : t -> t -> t) = logxor -let (op_Amp_Hat : t -> t -> t) = logand -let (op_Bar_Hat : t -> t -> t) = logor -let (op_Less_Less_Hat : t -> FStar_UInt32.t -> t) = shift_left -let (op_Greater_Greater_Hat : t -> FStar_UInt32.t -> t) = shift_right -let (op_Greater_Greater_Greater_Hat : t -> FStar_UInt32.t -> t) = - shift_arithmetic_right -let (op_Equals_Hat : t -> t -> Prims.bool) = eq -let (op_Greater_Hat : t -> t -> Prims.bool) = gt -let (op_Greater_Equals_Hat : t -> t -> Prims.bool) = gte -let (op_Less_Hat : t -> t -> Prims.bool) = lt -let (op_Less_Equals_Hat : t -> t -> Prims.bool) = lte -let (ct_abs : t -> t) = - fun a -> - let mask = - shift_arithmetic_right a (FStar_UInt32.uint_to_t (Prims.of_int (127))) in - sub (logxor a mask) mask -let (to_string : t -> Prims.string) = fun uu___ -> Prims.admit () -let (of_string : Prims.string -> t) = fun uu___ -> Prims.admit () -let (__int_to_t : Prims.int -> t) = fun x -> int_to_t x -let (mul_wide : FStar_Int64.t -> FStar_Int64.t -> t) = - fun a -> fun b -> Mk ((FStar_Int64.v a) * (FStar_Int64.v b)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Int16.ml b/stage0/fstar-lib/generated/FStar_Int16.ml deleted file mode 100644 index 2d50e807f19..00000000000 --- a/stage0/fstar-lib/generated/FStar_Int16.ml +++ /dev/null @@ -1,105 +0,0 @@ -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS IS AN AUTOGENERATED FILE! See ulib/ml/Makefile *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -(* This file is meant to be concatenated to FStar_Ints.ml.body *) -module M = Stdint.Int16 -type int16 = M.t -type t = M.t -let n = Prims.of_int 16 - -let int_to_t x = M.of_string (Z.to_string x) -let __int_to_t = int_to_t -(* This .ml.body file is concatenated to every .ml.prefix file in this - * directory (ulib/ml/) to generate the OCaml realizations for machine - * integers, as they all pretty much share their definitions and are - * based on Stdint. *) - -let v (x:t) : Prims.int = Prims.parse_int (M.to_string x) - -let zero = M.zero -let one = M.one -let ones = M.pred M.zero - -(* Reexport add, plus aliases *) -let add = M.add -let add_underspec = M.add -let add_mod = M.add - -(* Reexport sub, plus aliases *) -let sub = M.sub -let sub_underspec = M.sub -let sub_mod = M.sub - -(* Reexport mul, plus aliases *) -let mul = M.mul -let mul_underspec = M.mul -let mul_mod = M.mul - -(* Conversions to Zarith's int *) -let to_int (x:t) : Z.t = Z.of_string (M.to_string x) -let of_int (x:Z.t) : t = M.of_string (Z.to_string x) - -(* Conversion to native ints; these are potentially unsafe and not part - * of the interface: they are meant to be called only from OCaml code - * that is doing the right thing *) -let of_native_int (x:int) : t = M.of_int x -let to_native_int (x:t) : int = M.to_int x - -(* Just reexport these *) -let div = M.div -let rem = M.rem -let logand = M.logand -let logxor = M.logxor -let logor = M.logor -let lognot = M.lognot -let to_string = M.to_string -let of_string = M.of_string - -let to_string_hex = M.to_string_hex - -let to_string_hex_pad i = - let s0 = M.to_string_hex i in - let len = (String.length s0 - 2) in - let s1 = String.sub s0 2 len in (* Remove leading "0x" *) - let zeroes = String.make ((Z.to_int n / 4) - len) '0' in - zeroes ^ s1 - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right n i = M.shift_right n (Stdint.Uint32.to_int i) -let shift_left n i = M.shift_left n (Stdint.Uint32.to_int i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/fstar-lib/generated/FStar_Int64.ml b/stage0/fstar-lib/generated/FStar_Int64.ml deleted file mode 100644 index 33d2e008278..00000000000 --- a/stage0/fstar-lib/generated/FStar_Int64.ml +++ /dev/null @@ -1,105 +0,0 @@ -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS IS AN AUTOGENERATED FILE! See ulib/ml/Makefile *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -(* This file is meant to be concatenated to FStar_Ints.ml.body *) -module M = Stdint.Int64 -type int64 = M.t -type t = M.t -let n = Prims.of_int 64 - -let int_to_t x = M.of_string (Z.to_string x) -let __int_to_t = int_to_t -(* This .ml.body file is concatenated to every .ml.prefix file in this - * directory (ulib/ml/) to generate the OCaml realizations for machine - * integers, as they all pretty much share their definitions and are - * based on Stdint. *) - -let v (x:t) : Prims.int = Prims.parse_int (M.to_string x) - -let zero = M.zero -let one = M.one -let ones = M.pred M.zero - -(* Reexport add, plus aliases *) -let add = M.add -let add_underspec = M.add -let add_mod = M.add - -(* Reexport sub, plus aliases *) -let sub = M.sub -let sub_underspec = M.sub -let sub_mod = M.sub - -(* Reexport mul, plus aliases *) -let mul = M.mul -let mul_underspec = M.mul -let mul_mod = M.mul - -(* Conversions to Zarith's int *) -let to_int (x:t) : Z.t = Z.of_string (M.to_string x) -let of_int (x:Z.t) : t = M.of_string (Z.to_string x) - -(* Conversion to native ints; these are potentially unsafe and not part - * of the interface: they are meant to be called only from OCaml code - * that is doing the right thing *) -let of_native_int (x:int) : t = M.of_int x -let to_native_int (x:t) : int = M.to_int x - -(* Just reexport these *) -let div = M.div -let rem = M.rem -let logand = M.logand -let logxor = M.logxor -let logor = M.logor -let lognot = M.lognot -let to_string = M.to_string -let of_string = M.of_string - -let to_string_hex = M.to_string_hex - -let to_string_hex_pad i = - let s0 = M.to_string_hex i in - let len = (String.length s0 - 2) in - let s1 = String.sub s0 2 len in (* Remove leading "0x" *) - let zeroes = String.make ((Z.to_int n / 4) - len) '0' in - zeroes ^ s1 - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right n i = M.shift_right n (Stdint.Uint32.to_int i) -let shift_left n i = M.shift_left n (Stdint.Uint32.to_int i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/fstar-lib/generated/FStar_Int_Cast.ml b/stage0/fstar-lib/generated/FStar_Int_Cast.ml deleted file mode 100644 index 9d6a9fe0212..00000000000 --- a/stage0/fstar-lib/generated/FStar_Int_Cast.ml +++ /dev/null @@ -1,197 +0,0 @@ -open Prims -let (op_At_Percent : Prims.int -> Prims.int -> Prims.int) = - FStar_Int.op_At_Percent -let (uint8_to_uint64 : FStar_UInt8.t -> FStar_UInt64.t) = - fun a -> FStar_UInt64.uint_to_t (FStar_UInt8.v a) -let (uint8_to_uint32 : FStar_UInt8.t -> FStar_UInt32.t) = - fun x -> FStar_UInt32.uint_to_t (FStar_UInt8.v x) -let (uint8_to_uint16 : FStar_UInt8.t -> FStar_UInt16.t) = - fun x -> FStar_UInt16.uint_to_t (FStar_UInt8.v x) -let (uint16_to_uint64 : FStar_UInt16.t -> FStar_UInt64.t) = - fun x -> FStar_UInt64.uint_to_t (FStar_UInt16.v x) -let (uint16_to_uint32 : FStar_UInt16.t -> FStar_UInt32.t) = - fun x -> FStar_UInt32.uint_to_t (FStar_UInt16.v x) -let (uint16_to_uint8 : FStar_UInt16.t -> FStar_UInt8.t) = - fun x -> - FStar_UInt8.uint_to_t - ((FStar_UInt16.v x) mod (Prims.pow2 (Prims.of_int (8)))) -let (uint32_to_uint64 : FStar_UInt32.t -> FStar_UInt64.t) = - fun x -> FStar_UInt64.uint_to_t (FStar_UInt32.v x) -let (uint32_to_uint16 : FStar_UInt32.t -> FStar_UInt16.t) = - fun x -> - FStar_UInt16.uint_to_t - ((FStar_UInt32.v x) mod (Prims.pow2 (Prims.of_int (16)))) -let (uint32_to_uint8 : FStar_UInt32.t -> FStar_UInt8.t) = - fun x -> - FStar_UInt8.uint_to_t - ((FStar_UInt32.v x) mod (Prims.pow2 (Prims.of_int (8)))) -let (uint64_to_uint32 : FStar_UInt64.t -> FStar_UInt32.t) = - fun x -> - FStar_UInt32.uint_to_t - ((FStar_UInt64.v x) mod (Prims.pow2 (Prims.of_int (32)))) -let (uint64_to_uint16 : FStar_UInt64.t -> FStar_UInt16.t) = - fun x -> - FStar_UInt16.uint_to_t - ((FStar_UInt64.v x) mod (Prims.pow2 (Prims.of_int (16)))) -let (uint64_to_uint8 : FStar_UInt64.t -> FStar_UInt8.t) = - fun x -> - FStar_UInt8.uint_to_t - ((FStar_UInt64.v x) mod (Prims.pow2 (Prims.of_int (8)))) -let (int8_to_int64 : FStar_Int8.t -> FStar_Int64.t) = - fun x -> FStar_Int64.int_to_t (FStar_Int8.v x) -let (int8_to_int32 : FStar_Int8.t -> FStar_Int32.t) = - fun x -> FStar_Int32.int_to_t (FStar_Int8.v x) -let (int8_to_int16 : FStar_Int8.t -> FStar_Int16.t) = - fun x -> FStar_Int16.int_to_t (FStar_Int8.v x) -let (int16_to_int64 : FStar_Int16.t -> FStar_Int64.t) = - fun x -> - FStar_Int64.int_to_t - (op_At_Percent (FStar_Int16.v x) (Prims.pow2 (Prims.of_int (64)))) -let (int16_to_int32 : FStar_Int16.t -> FStar_Int32.t) = - fun x -> - FStar_Int32.int_to_t - (op_At_Percent (FStar_Int16.v x) (Prims.pow2 (Prims.of_int (32)))) -let (int16_to_int8 : FStar_Int16.t -> FStar_Int8.t) = - fun x -> - FStar_Int8.int_to_t - (op_At_Percent (FStar_Int16.v x) (Prims.pow2 (Prims.of_int (8)))) -let (int32_to_int64 : FStar_Int32.t -> FStar_Int64.t) = - fun x -> - FStar_Int64.int_to_t - (op_At_Percent (FStar_Int32.v x) (Prims.pow2 (Prims.of_int (64)))) -let (int32_to_int16 : FStar_Int32.t -> FStar_Int16.t) = - fun x -> - FStar_Int16.int_to_t - (op_At_Percent (FStar_Int32.v x) (Prims.pow2 (Prims.of_int (16)))) -let (int32_to_int8 : FStar_Int32.t -> FStar_Int8.t) = - fun x -> - FStar_Int8.int_to_t - (op_At_Percent (FStar_Int32.v x) (Prims.pow2 (Prims.of_int (8)))) -let (int64_to_int32 : FStar_Int64.t -> FStar_Int32.t) = - fun x -> - FStar_Int32.int_to_t - (op_At_Percent (FStar_Int64.v x) (Prims.pow2 (Prims.of_int (32)))) -let (int64_to_int16 : FStar_Int64.t -> FStar_Int16.t) = - fun x -> - FStar_Int16.int_to_t - (op_At_Percent (FStar_Int64.v x) (Prims.pow2 (Prims.of_int (16)))) -let (int64_to_int8 : FStar_Int64.t -> FStar_Int8.t) = - fun x -> - FStar_Int8.int_to_t - (op_At_Percent (FStar_Int64.v x) (Prims.pow2 (Prims.of_int (8)))) -let (uint8_to_int64 : FStar_UInt8.t -> FStar_Int64.t) = - fun x -> FStar_Int64.int_to_t (FStar_UInt8.v x) -let (uint8_to_int32 : FStar_UInt8.t -> FStar_Int32.t) = - fun x -> FStar_Int32.int_to_t (FStar_UInt8.v x) -let (uint8_to_int16 : FStar_UInt8.t -> FStar_Int16.t) = - fun x -> FStar_Int16.int_to_t (FStar_UInt8.v x) -let (uint8_to_int8 : FStar_UInt8.t -> FStar_Int8.t) = - fun x -> - FStar_Int8.int_to_t - (op_At_Percent (FStar_UInt8.v x) (Prims.pow2 (Prims.of_int (8)))) -let (uint16_to_int64 : FStar_UInt16.t -> FStar_Int64.t) = - fun x -> FStar_Int64.int_to_t (FStar_UInt16.v x) -let (uint16_to_int32 : FStar_UInt16.t -> FStar_Int32.t) = - fun x -> FStar_Int32.int_to_t (FStar_UInt16.v x) -let (uint16_to_int16 : FStar_UInt16.t -> FStar_Int16.t) = - fun x -> - FStar_Int16.int_to_t - (op_At_Percent (FStar_UInt16.v x) (Prims.pow2 (Prims.of_int (16)))) -let (uint16_to_int8 : FStar_UInt16.t -> FStar_Int8.t) = - fun x -> - FStar_Int8.int_to_t - (op_At_Percent (FStar_UInt16.v x) (Prims.pow2 (Prims.of_int (8)))) -let (uint32_to_int64 : FStar_UInt32.t -> FStar_Int64.t) = - fun x -> FStar_Int64.int_to_t (FStar_UInt32.v x) -let (uint32_to_int32 : FStar_UInt32.t -> FStar_Int32.t) = - fun x -> - FStar_Int32.int_to_t - (op_At_Percent (FStar_UInt32.v x) (Prims.pow2 (Prims.of_int (32)))) -let (uint32_to_int16 : FStar_UInt32.t -> FStar_Int16.t) = - fun x -> - FStar_Int16.int_to_t - (op_At_Percent (FStar_UInt32.v x) (Prims.pow2 (Prims.of_int (16)))) -let (uint32_to_int8 : FStar_UInt32.t -> FStar_Int8.t) = - fun x -> - FStar_Int8.int_to_t - (op_At_Percent (FStar_UInt32.v x) (Prims.pow2 (Prims.of_int (8)))) -let (uint64_to_int64 : FStar_UInt64.t -> FStar_Int64.t) = - fun x -> - FStar_Int64.int_to_t - (op_At_Percent (FStar_UInt64.v x) (Prims.pow2 (Prims.of_int (64)))) -let (uint64_to_int32 : FStar_UInt64.t -> FStar_Int32.t) = - fun x -> - FStar_Int32.int_to_t - (op_At_Percent (FStar_UInt64.v x) (Prims.pow2 (Prims.of_int (32)))) -let (uint64_to_int16 : FStar_UInt64.t -> FStar_Int16.t) = - fun x -> - FStar_Int16.int_to_t - (op_At_Percent (FStar_UInt64.v x) (Prims.pow2 (Prims.of_int (16)))) -let (uint64_to_int8 : FStar_UInt64.t -> FStar_Int8.t) = - fun x -> - FStar_Int8.int_to_t - (op_At_Percent (FStar_UInt64.v x) (Prims.pow2 (Prims.of_int (8)))) -let (int8_to_uint64 : FStar_Int8.t -> FStar_UInt64.t) = - fun x -> - FStar_UInt64.uint_to_t - ((FStar_Int8.v x) mod (Prims.pow2 (Prims.of_int (64)))) -let (int8_to_uint32 : FStar_Int8.t -> FStar_UInt32.t) = - fun x -> - FStar_UInt32.uint_to_t - ((FStar_Int8.v x) mod (Prims.pow2 (Prims.of_int (32)))) -let (int8_to_uint16 : FStar_Int8.t -> FStar_UInt16.t) = - fun x -> - FStar_UInt16.uint_to_t - ((FStar_Int8.v x) mod (Prims.pow2 (Prims.of_int (16)))) -let (int8_to_uint8 : FStar_Int8.t -> FStar_UInt8.t) = - fun x -> - FStar_UInt8.uint_to_t - ((FStar_Int8.v x) mod (Prims.pow2 (Prims.of_int (8)))) -let (int16_to_uint64 : FStar_Int16.t -> FStar_UInt64.t) = - fun x -> - FStar_UInt64.uint_to_t - ((FStar_Int16.v x) mod (Prims.pow2 (Prims.of_int (64)))) -let (int16_to_uint32 : FStar_Int16.t -> FStar_UInt32.t) = - fun x -> - FStar_UInt32.uint_to_t - ((FStar_Int16.v x) mod (Prims.pow2 (Prims.of_int (32)))) -let (int16_to_uint16 : FStar_Int16.t -> FStar_UInt16.t) = - fun x -> - FStar_UInt16.uint_to_t - ((FStar_Int16.v x) mod (Prims.pow2 (Prims.of_int (16)))) -let (int16_to_uint8 : FStar_Int16.t -> FStar_UInt8.t) = - fun x -> - FStar_UInt8.uint_to_t - ((FStar_Int16.v x) mod (Prims.pow2 (Prims.of_int (8)))) -let (int32_to_uint64 : FStar_Int32.t -> FStar_UInt64.t) = - fun x -> - FStar_UInt64.uint_to_t - ((FStar_Int32.v x) mod (Prims.pow2 (Prims.of_int (64)))) -let (int32_to_uint32 : FStar_Int32.t -> FStar_UInt32.t) = - fun x -> - FStar_UInt32.uint_to_t - ((FStar_Int32.v x) mod (Prims.pow2 (Prims.of_int (32)))) -let (int32_to_uint16 : FStar_Int32.t -> FStar_UInt16.t) = - fun x -> - FStar_UInt16.uint_to_t - ((FStar_Int32.v x) mod (Prims.pow2 (Prims.of_int (16)))) -let (int32_to_uint8 : FStar_Int32.t -> FStar_UInt8.t) = - fun x -> - FStar_UInt8.uint_to_t - ((FStar_Int32.v x) mod (Prims.pow2 (Prims.of_int (8)))) -let (int64_to_uint64 : FStar_Int64.t -> FStar_UInt64.t) = - fun x -> - FStar_UInt64.uint_to_t - ((FStar_Int64.v x) mod (Prims.pow2 (Prims.of_int (64)))) -let (int64_to_uint32 : FStar_Int64.t -> FStar_UInt32.t) = - fun x -> - FStar_UInt32.uint_to_t - ((FStar_Int64.v x) mod (Prims.pow2 (Prims.of_int (32)))) -let (int64_to_uint16 : FStar_Int64.t -> FStar_UInt16.t) = - fun x -> - FStar_UInt16.uint_to_t - ((FStar_Int64.v x) mod (Prims.pow2 (Prims.of_int (16)))) -let (int64_to_uint8 : FStar_Int64.t -> FStar_UInt8.t) = - fun x -> - FStar_UInt8.uint_to_t - ((FStar_Int64.v x) mod (Prims.pow2 (Prims.of_int (8)))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Int_Cast_Full.ml b/stage0/fstar-lib/generated/FStar_Int_Cast_Full.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Int_Cast_Full.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_IntegerIntervals.ml b/stage0/fstar-lib/generated/FStar_IntegerIntervals.ml deleted file mode 100644 index 766fefec965..00000000000 --- a/stage0/fstar-lib/generated/FStar_IntegerIntervals.ml +++ /dev/null @@ -1,25 +0,0 @@ -open Prims -type 'k less_than = Prims.int -type 'k greater_than = Prims.int -type 'x not_less_than = unit greater_than -type 'x not_greater_than = unit less_than -let (coerce_to_less_than : - Prims.int -> unit not_greater_than -> unit less_than) = fun n -> fun x -> x -let (coerce_to_not_less_than : - Prims.int -> unit greater_than -> unit not_less_than) = fun n -> fun x -> x -let (interval_condition : Prims.int -> Prims.int -> Prims.int -> Prims.bool) - = fun x -> fun y -> fun t -> (x <= t) && (t < y) -type ('x, 'y) interval_type = unit -type ('x, 'y) interval = Prims.int -type ('x, 'y) efrom_eto = (unit, unit) interval -type ('x, 'y) efrom_ito = (unit, unit) interval -type ('x, 'y) ifrom_eto = (unit, unit) interval -type ('x, 'y) ifrom_ito = (unit, unit) interval -type 'k under = (unit, unit) interval -let (interval_size : Prims.int -> Prims.int -> unit -> Prims.nat) = - fun x -> fun y -> fun interval1 -> if y >= x then y - x else Prims.int_zero -type ('x, 'y, 'interval1) counter_for = unit under -let (closed_interval_size : Prims.int -> Prims.int -> Prims.nat) = - fun x -> fun y -> interval_size x (y + Prims.int_one) () -let (indices_seq : Prims.nat -> unit under FStar_Seq_Base.seq) = - fun n -> FStar_Seq_Base.init n (fun x -> x) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Integers.ml b/stage0/fstar-lib/generated/FStar_Integers.ml deleted file mode 100644 index 988173e5a68..00000000000 --- a/stage0/fstar-lib/generated/FStar_Integers.ml +++ /dev/null @@ -1,75 +0,0 @@ -open Prims -let norm : 'a . 'a -> 'a = fun x -> x -type width = - | W8 - | W16 - | W32 - | W64 - | W128 - | Winfinite -let (uu___is_W8 : width -> Prims.bool) = - fun projectee -> match projectee with | W8 -> true | uu___ -> false -let (uu___is_W16 : width -> Prims.bool) = - fun projectee -> match projectee with | W16 -> true | uu___ -> false -let (uu___is_W32 : width -> Prims.bool) = - fun projectee -> match projectee with | W32 -> true | uu___ -> false -let (uu___is_W64 : width -> Prims.bool) = - fun projectee -> match projectee with | W64 -> true | uu___ -> false -let (uu___is_W128 : width -> Prims.bool) = - fun projectee -> match projectee with | W128 -> true | uu___ -> false -let (uu___is_Winfinite : width -> Prims.bool) = - fun projectee -> match projectee with | Winfinite -> true | uu___ -> false -let (nat_of_width : width -> Prims.int FStar_Pervasives_Native.option) = - fun uu___ -> - match uu___ with - | W8 -> FStar_Pervasives_Native.Some (Prims.of_int (8)) - | W16 -> FStar_Pervasives_Native.Some (Prims.of_int (16)) - | W32 -> FStar_Pervasives_Native.Some (Prims.of_int (32)) - | W64 -> FStar_Pervasives_Native.Some (Prims.of_int (64)) - | W128 -> FStar_Pervasives_Native.Some (Prims.of_int (128)) - | Winfinite -> FStar_Pervasives_Native.None -type fixed_width = width -let (nat_of_fixed_width : fixed_width -> Prims.int) = - fun w -> match nat_of_width w with | FStar_Pervasives_Native.Some v -> v -type signed_width = - | Signed of width - | Unsigned of fixed_width -let (uu___is_Signed : signed_width -> Prims.bool) = - fun projectee -> match projectee with | Signed _0 -> true | uu___ -> false -let (__proj__Signed__item___0 : signed_width -> width) = - fun projectee -> match projectee with | Signed _0 -> _0 -let (uu___is_Unsigned : signed_width -> Prims.bool) = - fun projectee -> - match projectee with | Unsigned _0 -> true | uu___ -> false -let (__proj__Unsigned__item___0 : signed_width -> fixed_width) = - fun projectee -> match projectee with | Unsigned _0 -> _0 -let (width_of_sw : signed_width -> width) = - fun uu___ -> match uu___ with | Signed w -> w | Unsigned w -> w -type ('sw, 'x) within_bounds = Obj.t -type uint_8 = FStar_UInt8.t -type uint_16 = FStar_UInt16.t -type uint_32 = FStar_UInt32.t -type uint_64 = FStar_UInt64.t -type int = Prims.int -type int_8 = FStar_Int8.t -type int_16 = FStar_Int16.t -type int_32 = FStar_Int32.t -type int_64 = FStar_Int64.t -type int_128 = FStar_Int128.t -type ('sw, 'op, 'x, 'y) ok = Obj.t -type nat = Prims.int -type pos = Prims.int -let (f_int : Prims.int -> Prims.int -> Prims.int) = fun x -> fun y -> x + y -let (f_nat : Prims.int -> Prims.int -> Prims.int) = fun x -> fun y -> x + y -let (f_nat_int_pos : Prims.int -> Prims.int -> Prims.int -> Prims.int) = - fun x -> fun y -> fun z -> (x + y) + z -let (f_uint_8 : FStar_UInt8.t -> FStar_UInt8.t -> FStar_UInt8.t) = - fun x -> fun y -> FStar_UInt8.add x y -let (f_int_16 : FStar_Int16.t -> FStar_Int16.t -> FStar_Int16.t) = - fun x -> fun y -> FStar_Int16.add x y -let (g : FStar_UInt32.t -> FStar_UInt32.t -> FStar_UInt32.t) = - fun x -> fun y -> FStar_UInt32.add x (FStar_UInt32.mul y y) -let (h : Prims.nat -> Prims.nat -> Prims.int) = fun x -> fun y -> x + y -let (i : Prims.nat -> Prims.nat -> Prims.int) = fun x -> fun y -> x + y -let (j : Prims.int -> Prims.nat -> Prims.int) = fun x -> fun y -> x - y -let (k : Prims.int -> Prims.int -> Prims.int) = fun x -> fun y -> x * y \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_InteractiveHelpers.ml b/stage0/fstar-lib/generated/FStar_InteractiveHelpers.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_InteractiveHelpers.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Base.ml b/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Base.ml deleted file mode 100644 index 72632ed0e50..00000000000 --- a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Base.ml +++ /dev/null @@ -1,5471 +0,0 @@ -open Prims -let (bv_eq : - FStarC_Reflection_Types.bv -> FStarC_Reflection_Types.bv -> Prims.bool) = - fun bv1 -> - fun bv2 -> - let bvv1 = FStarC_Reflection_V1_Builtins.inspect_bv bv1 in - let bvv2 = FStarC_Reflection_V1_Builtins.inspect_bv bv2 in - bvv1.FStarC_Reflection_V1_Data.bv_index = - bvv2.FStarC_Reflection_V1_Data.bv_index -let (fv_eq : - FStarC_Reflection_Types.fv -> FStarC_Reflection_Types.fv -> Prims.bool) = - fun fv1 -> - fun fv2 -> - let n1 = FStarC_Reflection_V1_Builtins.inspect_fv fv1 in - let n2 = FStarC_Reflection_V1_Builtins.inspect_fv fv2 in n1 = n2 -let (fv_eq_name : - FStarC_Reflection_Types.fv -> FStarC_Reflection_Types.name -> Prims.bool) = - fun fv -> - fun n -> let fvn = FStarC_Reflection_V1_Builtins.inspect_fv fv in fvn = n -let opt_apply : - 'a 'b . - ('a -> 'b) -> - 'a FStar_Pervasives_Native.option -> 'b FStar_Pervasives_Native.option - = - fun f -> - fun x -> - match x with - | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some x' -> - FStar_Pervasives_Native.Some (f x') -let opt_tapply : - 'a 'b . - ('a -> ('b, unit) FStar_Tactics_Effect.tac_repr) -> - 'a FStar_Pervasives_Native.option -> - ('b FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun f -> - fun x -> - match x with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.None))) - | FStar_Pervasives_Native.Some x' -> - Obj.magic - (Obj.repr - (let uu___ = f x' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (42)) (Prims.of_int (20)) - (Prims.of_int (42)) (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (42)) (Prims.of_int (15)) - (Prims.of_int (42)) (Prims.of_int (26))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Pervasives_Native.Some uu___1))))) - uu___1 uu___ -let option_to_string : - 'a . - ('a -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) -> - 'a FStar_Pervasives_Native.option -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun f -> - fun x -> - match x with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> "None"))) - | FStar_Pervasives_Native.Some x' -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = f x' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (48)) (Prims.of_int (26)) - (Prims.of_int (48)) (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> Prims.strcat uu___2 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (48)) (Prims.of_int (26)) - (Prims.of_int (48)) (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "Some (" uu___1))))) - uu___1 uu___ -let opt_cons : - 'a . 'a FStar_Pervasives_Native.option -> 'a Prims.list -> 'a Prims.list = - fun opt_x -> - fun ls -> - match opt_x with - | FStar_Pervasives_Native.Some x -> x :: ls - | FStar_Pervasives_Native.None -> ls -let list_to_string : - 'a . - ('a -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) -> - 'a Prims.list -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr - = - fun f -> - fun ls -> - let uu___ = - FStar_Tactics_Util.fold_left - (fun s -> - fun x -> - let uu___1 = - let uu___2 = - let uu___3 = f x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (58)) (Prims.of_int (49)) - (Prims.of_int (58)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat uu___4 ");")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (58)) (Prims.of_int (49)) - (Prims.of_int (58)) (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat " (" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (58)) (Prims.of_int (42)) - (Prims.of_int (58)) (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> Prims.strcat s uu___2))) "[" ls in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (58)) (Prims.of_int (2)) (Prims.of_int (58)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat uu___1 "]")) -let (mk_app_norm : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term Prims.list -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - fun params -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStar_Reflection_V1_Derived.mk_e_app t params)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (65)) (Prims.of_int (11)) - (Prims.of_int (65)) (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (65)) (Prims.of_int (31)) - (Prims.of_int (67)) (Prims.of_int (4))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun t1 -> - let uu___1 = FStarC_Tactics_V1_Builtins.norm_term_env e [] t1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (66)) (Prims.of_int (11)) - (Prims.of_int (66)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (66)) (Prims.of_int (6)) - (Prims.of_int (66)) (Prims.of_int (8))))) - (Obj.magic uu___1) - (fun t2 -> - FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> t2)))) - uu___1) -let (opt_mk_app_norm : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - FStarC_Reflection_Types.term Prims.list -> - (FStarC_Reflection_Types.term FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun opt_t -> - fun params -> opt_tapply (fun t -> mk_app_norm e t params) opt_t -let rec unzip : - 'a 'b . ('a * 'b) Prims.list -> ('a Prims.list * 'b Prims.list) = - fun l -> - match l with - | [] -> ([], []) - | (hd1, hd2)::tl -> - let uu___ = unzip tl in - (match uu___ with | (tl1, tl2) -> ((hd1 :: tl1), (hd2 :: tl2))) -let (abv_to_string : - FStarC_Reflection_Types.bv -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun bv -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStarC_Reflection_V1_Builtins.inspect_bv bv)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (84)) (Prims.of_int (12)) (Prims.of_int (84)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (85)) (Prims.of_int (2)) (Prims.of_int (85)) - (Prims.of_int (60))))) (Obj.magic uu___) - (fun uu___1 -> - (fun bvv -> - let uu___1 = FStar_Tactics_V1_Derived.name_of_bv bv in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (85)) (Prims.of_int (2)) - (Prims.of_int (85)) (Prims.of_int (15))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat uu___2 - (Prims.strcat " (%" - (Prims.strcat - (Prims.string_of_int - bvv.FStarC_Reflection_V1_Data.bv_index) - ")")))))) uu___1) -let (print_binder_info : - Prims.bool -> - FStarC_Reflection_Types.binder -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun full -> - fun b -> - match FStarC_Reflection_V1_Builtins.inspect_binder b with - | { FStarC_Reflection_V1_Data.binder_bv = binder_bv; - FStarC_Reflection_V1_Data.binder_qual = binder_qual; - FStarC_Reflection_V1_Data.binder_attrs = binder_attrs; - FStarC_Reflection_V1_Data.binder_sort = binder_sort;_} -> - let uu___ = - match binder_qual with - | FStarC_Reflection_V1_Data.Q_Implicit -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> "Implicit"))) - | FStarC_Reflection_V1_Data.Q_Explicit -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> "Explicit"))) - | FStarC_Reflection_V1_Data.Q_Meta t -> - Obj.magic - (Obj.repr - (let uu___1 = - FStarC_Tactics_V1_Builtins.term_to_string t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (92)) (Prims.of_int (29)) - (Prims.of_int (92)) (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> Prims.strcat "Meta: " uu___2)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (89)) (Prims.of_int (17)) - (Prims.of_int (92)) (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (93)) (Prims.of_int (4)) - (Prims.of_int (105)) (Prims.of_int (33))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun qual_str -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStarC_Reflection_V1_Builtins.inspect_bv - binder_bv)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (94)) (Prims.of_int (14)) - (Prims.of_int (94)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (95)) (Prims.of_int (2)) - (Prims.of_int (105)) (Prims.of_int (33))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun bview -> - if full - then - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Tactics_V1_Derived.name_of_binder - b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (98)) - (Prims.of_int (21)) - (Prims.of_int (98)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (98)) - (Prims.of_int (21)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = - FStar_Tactics_V1_Derived.binder_to_string - b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (99)) - (Prims.of_int (26)) - (Prims.of_int (99)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (99)) - (Prims.of_int (26)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (Obj.magic uu___9) - (fun uu___10 -> - (fun uu___10 -> - let uu___11 = - let uu___12 = - let uu___13 = - let uu___14 = - let uu___15 - = - FStar_Tactics_V1_Derived.name_of_bv - binder_bv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (101)) - (Prims.of_int (23)) - (Prims.of_int (101)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (101)) - (Prims.of_int (23)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - let uu___17 - = - let uu___18 - = - let uu___19 - = - let uu___20 - = - FStarC_Tactics_V1_Builtins.term_to_string - binder_sort in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (103)) - (Prims.of_int (21)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___22 - -> - Prims.strcat - "\n- sort: " - uu___21)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (103)) - (Prims.of_int (6)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___21 - -> - Prims.strcat - (Prims.string_of_int - bview.FStarC_Reflection_V1_Data.bv_index) - uu___20)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (102)) - (Prims.of_int (22)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - Prims.strcat - "\n- index: " - uu___19)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (102)) - (Prims.of_int (6)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - Prims.strcat - uu___16 - uu___18)))) - uu___16) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (101)) - (Prims.of_int (23)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___14) - (fun uu___15 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - Prims.strcat - "\n- ppname: " - uu___15)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (101)) - (Prims.of_int (6)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___13) - (fun uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - ( - fun - uu___15 - -> - Prims.strcat - qual_str - uu___14)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (100)) - (Prims.of_int (22)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___12) - (fun uu___13 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - Prims.strcat - "\n- aqual: " - uu___13)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (100)) - (Prims.of_int (6)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___11) - (fun uu___12 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - Prims.strcat - uu___10 - uu___12)))) - uu___10) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (99)) - (Prims.of_int (26)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - Prims.strcat - "\n- as string: " - uu___9)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (99)) - (Prims.of_int (6)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat uu___6 - uu___8)))) uu___6) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (98)) - (Prims.of_int (21)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat "\n- name: " uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (98)) - (Prims.of_int (6)) - (Prims.of_int (103)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - Prims.strcat - "> print_binder_info:" uu___4)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (96)) - (Prims.of_int (10)) - (Prims.of_int (104)) - (Prims.of_int (5))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (96)) - (Prims.of_int (4)) - (Prims.of_int (104)) - (Prims.of_int (5))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print - uu___3)) uu___3)) - else - (let uu___3 = - FStar_Tactics_V1_Derived.binder_to_string b in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (105)) - (Prims.of_int (13)) - (Prims.of_int (105)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (105)) - (Prims.of_int (7)) - (Prims.of_int (105)) - (Prims.of_int (33))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print - uu___4)) uu___4)))) uu___2))) - uu___1) -let (print_binders_info : - Prims.bool -> - FStarC_Reflection_Types.env -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun full -> - fun e -> - FStar_Tactics_Util.iter (print_binder_info full) - (FStarC_Reflection_V1_Builtins.binders_of_env e) -let (acomp_to_string : - FStarC_Reflection_Types.comp -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun c -> - match FStarC_Reflection_V1_Builtins.inspect_comp c with - | FStarC_Reflection_V1_Data.C_Total ret -> - let uu___ = - let uu___1 = FStarC_Tactics_V1_Builtins.term_to_string ret in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (113)) (Prims.of_int (18)) - (Prims.of_int (113)) (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> Prims.strcat uu___2 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (113)) (Prims.of_int (18)) - (Prims.of_int (113)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "C_Total (" uu___1)) - | FStarC_Reflection_V1_Data.C_GTotal ret -> - let uu___ = - let uu___1 = FStarC_Tactics_V1_Builtins.term_to_string ret in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (115)) (Prims.of_int (19)) - (Prims.of_int (115)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> Prims.strcat uu___2 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (115)) (Prims.of_int (19)) - (Prims.of_int (115)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "C_GTotal (" uu___1)) - | FStarC_Reflection_V1_Data.C_Lemma (pre, post, patterns) -> - let uu___ = - let uu___1 = FStarC_Tactics_V1_Builtins.term_to_string pre in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (117)) (Prims.of_int (18)) - (Prims.of_int (117)) (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (117)) (Prims.of_int (18)) - (Prims.of_int (117)) (Prims.of_int (72))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - let uu___4 = - let uu___5 = - FStarC_Tactics_V1_Builtins.term_to_string post in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (117)) (Prims.of_int (47)) - (Prims.of_int (117)) (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> Prims.strcat uu___6 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (117)) (Prims.of_int (47)) - (Prims.of_int (117)) (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat ") (" uu___5)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (117)) (Prims.of_int (39)) - (Prims.of_int (117)) (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat uu___2 uu___4)))) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (117)) (Prims.of_int (18)) - (Prims.of_int (117)) (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "C_Lemma (" uu___1)) - | FStarC_Reflection_V1_Data.C_Eff (us, eff_name, result, eff_args, uu___) - -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - fun a -> - let uu___3 = - let uu___4 = - FStarC_Tactics_V1_Builtins.term_to_string a in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (120)) (Prims.of_int (13)) - (Prims.of_int (120)) (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat uu___5 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (120)) (Prims.of_int (13)) - (Prims.of_int (120)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat " (" uu___4)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (120)) (Prims.of_int (6)) - (Prims.of_int (120)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (121)) (Prims.of_int (6)) - (Prims.of_int (124)) (Prims.of_int (86))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun eff_arg_to_string -> - let uu___2 = - FStar_Tactics_Util.map - (fun uu___3 -> - match uu___3 with | (x, y) -> eff_arg_to_string x) - eff_args in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (122)) (Prims.of_int (19)) - (Prims.of_int (122)) (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (122)) (Prims.of_int (70)) - (Prims.of_int (124)) (Prims.of_int (86))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun args_str -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_List_Tot_Base.fold_left - (fun x -> fun y -> Prims.strcat x y) - "" args_str)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (123)) - (Prims.of_int (19)) - (Prims.of_int (123)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (124)) - (Prims.of_int (4)) - (Prims.of_int (124)) - (Prims.of_int (86))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun args_str1 -> - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - FStarC_Tactics_V1_Builtins.term_to_string - result in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (124)) - (Prims.of_int (48)) - (Prims.of_int (124)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat uu___8 - (Prims.strcat ")" - args_str1))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (124)) - (Prims.of_int (48)) - (Prims.of_int (124)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat ") (" uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (124)) - (Prims.of_int (40)) - (Prims.of_int (124)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat - (FStar_Reflection_V1_Derived.flatten_name - eff_name) uu___6)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (124)) - (Prims.of_int (16)) - (Prims.of_int (124)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat "C_Eff (" - uu___5)))) uu___4))) - uu___3))) uu___2) -exception MetaAnalysis of FStarC_Errors_Msg.error_message -let (uu___is_MetaAnalysis : Prims.exn -> Prims.bool) = - fun projectee -> - match projectee with | MetaAnalysis uu___ -> true | uu___ -> false -let (__proj__MetaAnalysis__item__uu___ : - Prims.exn -> FStarC_Errors_Msg.error_message) = - fun projectee -> match projectee with | MetaAnalysis uu___ -> uu___ -let mfail_doc : - 'uuuuu . - FStarC_Errors_Msg.error_message -> - ('uuuuu, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___ -> - (fun m -> Obj.magic (FStar_Tactics_Effect.raise (MetaAnalysis m))) uu___ -let mfail : - 'uuuuu . Prims.string -> ('uuuuu, unit) FStar_Tactics_Effect.tac_repr = - fun uu___ -> - (fun str -> - Obj.magic - (FStar_Tactics_Effect.raise - (MetaAnalysis (FStarC_Errors_Msg.mkmsg str)))) uu___ -let (print_dbg : - Prims.bool -> Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___1 -> - fun uu___ -> - (fun debug -> - fun s -> - if debug - then Obj.magic (Obj.repr (FStarC_Tactics_V1_Builtins.print s)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ())))) - uu___1 uu___ -let (term_view_construct : - FStarC_Reflection_V1_Data.term_view -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - (fun t -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - match t with - | FStarC_Reflection_V1_Data.Tv_Var uu___1 -> "Tv_Var" - | FStarC_Reflection_V1_Data.Tv_BVar uu___1 -> "Tv_BVar" - | FStarC_Reflection_V1_Data.Tv_FVar uu___1 -> "Tv_FVar" - | FStarC_Reflection_V1_Data.Tv_App (uu___1, uu___2) -> - "Tv_App" - | FStarC_Reflection_V1_Data.Tv_Abs (uu___1, uu___2) -> - "Tv_Abs" - | FStarC_Reflection_V1_Data.Tv_Arrow (uu___1, uu___2) -> - "Tv_Arrow" - | FStarC_Reflection_V1_Data.Tv_Type uu___1 -> "Tv_Type" - | FStarC_Reflection_V1_Data.Tv_Refine (uu___1, uu___2, uu___3) - -> "Tv_Refine" - | FStarC_Reflection_V1_Data.Tv_Const uu___1 -> "Tv_Const" - | FStarC_Reflection_V1_Data.Tv_Uvar (uu___1, uu___2) -> - "Tv_Uvar" - | FStarC_Reflection_V1_Data.Tv_Let - (uu___1, uu___2, uu___3, uu___4, uu___5, uu___6) -> - "Tv_Let" - | FStarC_Reflection_V1_Data.Tv_Match (uu___1, uu___2, uu___3) - -> "Tv_Match" - | FStarC_Reflection_V1_Data.Tv_AscribedT - (uu___1, uu___2, uu___3, uu___4) -> "Tv_AscribedT" - | FStarC_Reflection_V1_Data.Tv_AscribedC - (uu___1, uu___2, uu___3, uu___4) -> "Tv_AScribedC" - | uu___1 -> "Tv_Unknown"))) uu___ -let (term_construct : - FStarC_Reflection_Types.term -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (162)) (Prims.of_int (22)) (Prims.of_int (162)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (162)) (Prims.of_int (2)) (Prims.of_int (162)) - (Prims.of_int (33))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> Obj.magic (term_view_construct uu___1)) uu___1) -let (filter_ascriptions : - Prims.bool -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun t -> - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (174)) (Prims.of_int (27)) - (Prims.of_int (174)) (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (45)) - (Prims.of_int (175)) (Prims.of_int (66))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> Obj.magic (term_view_construct uu___5)) - uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (45)) - (Prims.of_int (175)) (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (45)) - (Prims.of_int (175)) (Prims.of_int (92))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = - let uu___6 = - FStarC_Tactics_V1_Builtins.term_to_string t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (76)) - (Prims.of_int (175)) (Prims.of_int (92))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> Prims.strcat ": " uu___7)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (69)) - (Prims.of_int (175)) (Prims.of_int (92))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> Prims.strcat uu___4 uu___6)))) - uu___4) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (45)) - (Prims.of_int (175)) (Prims.of_int (92))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat "[> filter_ascriptions: " uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (16)) - (Prims.of_int (175)) (Prims.of_int (94))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (2)) - (Prims.of_int (175)) (Prims.of_int (94))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> Obj.magic (print_dbg dbg uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (175)) (Prims.of_int (2)) (Prims.of_int (175)) - (Prims.of_int (94))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (176)) (Prims.of_int (2)) (Prims.of_int (180)) - (Prims.of_int (15))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (FStar_Tactics_Visit.visit_tm - (fun t1 -> - let uu___2 = FStarC_Tactics_V1_Builtins.inspect t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (177)) (Prims.of_int (10)) - (Prims.of_int (177)) (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (177)) (Prims.of_int (4)) - (Prims.of_int (180)) (Prims.of_int (12))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - match uu___3 with - | FStarC_Reflection_V1_Data.Tv_AscribedT - (e, uu___5, uu___6, uu___7) -> e - | FStarC_Reflection_V1_Data.Tv_AscribedC - (e, uu___5, uu___6, uu___7) -> e - | uu___5 -> t1))) t)) uu___1) -let (prettify_term : - Prims.bool -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = fun dbg -> fun t -> filter_ascriptions dbg t -type 'a bind_map = (FStarC_Reflection_Types.bv * 'a) Prims.list -let bind_map_push : - 'a . - 'a bind_map -> - FStarC_Reflection_Types.bv -> - 'a -> (FStarC_Reflection_Types.bv * 'a) Prims.list - = fun m -> fun b -> fun x -> (b, x) :: m -let rec bind_map_get : - 'a . - 'a bind_map -> - FStarC_Reflection_Types.bv -> 'a FStar_Pervasives_Native.option - = - fun m -> - fun b -> - match m with - | [] -> FStar_Pervasives_Native.None - | (b', x)::m' -> - if (FStarC_Reflection_V1_Builtins.compare_bv b b') = FStar_Order.Eq - then FStar_Pervasives_Native.Some x - else bind_map_get m' b -let rec bind_map_get_from_name : - 'a . - 'a bind_map -> - Prims.string -> - ((FStarC_Reflection_Types.bv * 'a) FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun m -> - fun name -> - match m with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.None))) - | (b', x)::m' -> - Obj.magic - (Obj.repr - (let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStarC_Reflection_V1_Builtins.inspect_bv b')) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (211)) (Prims.of_int (14)) - (Prims.of_int (211)) (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (212)) (Prims.of_int (4)) - (Prims.of_int (212)) (Prims.of_int (88))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun b'v -> - let uu___1 = - let uu___2 = - FStarC_Tactics_Unseal.unseal - b'v.FStarC_Reflection_V1_Data.bv_ppname in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (212)) - (Prims.of_int (7)) - (Prims.of_int (212)) - (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (212)) - (Prims.of_int (7)) - (Prims.of_int (212)) - (Prims.of_int (34))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> uu___3 = name)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (212)) - (Prims.of_int (7)) - (Prims.of_int (212)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (212)) - (Prims.of_int (4)) - (Prims.of_int (212)) - (Prims.of_int (88))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - if uu___2 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStar_Pervasives_Native.Some - (b', x)))) - else - Obj.magic - (Obj.repr - (bind_map_get_from_name m' - name))) uu___2))) uu___1)))) - uu___1 uu___ -type genv = - { - env: FStarC_Reflection_Types.env ; - bmap: - (FStarC_Reflection_Types.typ * Prims.bool * FStarC_Reflection_Types.term) - bind_map - ; - svars: - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) Prims.list } -let (__proj__Mkgenv__item__env : genv -> FStarC_Reflection_Types.env) = - fun projectee -> match projectee with | { env; bmap; svars;_} -> env -let (__proj__Mkgenv__item__bmap : - genv -> - (FStarC_Reflection_Types.typ * Prims.bool * FStarC_Reflection_Types.term) - bind_map) - = fun projectee -> match projectee with | { env; bmap; svars;_} -> bmap -let (__proj__Mkgenv__item__svars : - genv -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) Prims.list) - = fun projectee -> match projectee with | { env; bmap; svars;_} -> svars -let (get_env : genv -> FStarC_Reflection_Types.env) = fun e -> e.env -let (get_bind_map : - genv -> - (FStarC_Reflection_Types.typ * Prims.bool * FStarC_Reflection_Types.term) - bind_map) - = fun e -> e.bmap -let (mk_genv : - FStarC_Reflection_Types.env -> - (FStarC_Reflection_Types.typ * Prims.bool * FStarC_Reflection_Types.term) - bind_map -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) Prims.list - -> genv) - = fun env -> fun bmap -> fun svars -> { env; bmap; svars } -let (mk_init_genv : FStarC_Reflection_Types.env -> genv) = - fun env -> mk_genv env [] [] -let (genv_to_string : - genv -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun ge -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun b -> - let uu___2 = - abv_to_string (FStar_Reflection_V1_Derived.bv_of_binder b) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (248)) (Prims.of_int (4)) - (Prims.of_int (248)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat uu___3 "\n")))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (248)) (Prims.of_int (4)) (Prims.of_int (248)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (249)) (Prims.of_int (4)) (Prims.of_int (261)) - (Prims.of_int (34))))) (Obj.magic uu___) - (fun uu___1 -> - (fun binder_to_string -> - let uu___1 = - FStar_Tactics_Util.map binder_to_string - (FStarC_Reflection_V1_Builtins.binders_of_env ge.env) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (250)) (Prims.of_int (20)) - (Prims.of_int (250)) (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (250)) (Prims.of_int (67)) - (Prims.of_int (261)) (Prims.of_int (34))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun binders_str -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun e -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> e)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (252)) - (Prims.of_int (30)) - (Prims.of_int (252)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (251)) - (Prims.of_int (71)) - (Prims.of_int (254)) - (Prims.of_int (57))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | (bv, (_sort, abs, t)) -> - let uu___6 = - let uu___7 = - abv_to_string bv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (253)) - (Prims.of_int (10)) - (Prims.of_int (253)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (253)) - (Prims.of_int (10)) - (Prims.of_int (254)) - (Prims.of_int (57))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - let uu___9 = - let uu___10 = - let uu___11 = - let uu___12 = - let uu___13 - = - FStarC_Tactics_V1_Builtins.term_to_string - t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (254)) - (Prims.of_int (32)) - (Prims.of_int (254)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - Prims.strcat - uu___14 - "))\n")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (254)) - (Prims.of_int (32)) - (Prims.of_int (254)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___12) - (fun uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - Prims.strcat - ", " - uu___13)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (254)) - (Prims.of_int (25)) - (Prims.of_int (254)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___11) - (fun uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - ( - fun - uu___13 - -> - Prims.strcat - (Prims.string_of_bool - abs) - uu___12)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (254)) - (Prims.of_int (4)) - (Prims.of_int (254)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___10) - (fun uu___11 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - Prims.strcat - " -> (" - uu___11)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (253)) - (Prims.of_int (28)) - (Prims.of_int (254)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Prims.strcat - uu___8 - uu___10)))) - uu___8) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (253)) - (Prims.of_int (10)) - (Prims.of_int (254)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat "(" - uu___7)))) - uu___5))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (251)) (Prims.of_int (71)) - (Prims.of_int (254)) (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (255)) (Prims.of_int (4)) - (Prims.of_int (261)) (Prims.of_int (34))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun bmap_elem_to_string -> - let uu___3 = - FStar_Tactics_Util.map - bmap_elem_to_string ge.bmap in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (256)) - (Prims.of_int (17)) - (Prims.of_int (256)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (256)) - (Prims.of_int (51)) - (Prims.of_int (261)) - (Prims.of_int (34))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun bmap_str -> - let uu___4 = - FStar_Tactics_Util.map - (fun uu___5 -> - match uu___5 with - | (bv, uu___6) -> - let uu___7 = - abv_to_string bv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (257)) - (Prims.of_int (38)) - (Prims.of_int (257)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat - uu___8 - "\n"))) - ge.svars in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (257)) - (Prims.of_int (18)) - (Prims.of_int (257)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun svars_str -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - Prims.strcat - "> env:\n" - (Prims.strcat - (FStar_List_Tot_Base.fold_left - (fun x -> - fun y -> - Prims.strcat - x y) "" - binders_str) - (Prims.strcat - "> bmap:\n" - (Prims.strcat - (FStar_List_Tot_Base.fold_left - (fun x -> - fun y -> - Prims.strcat - x y) "" - bmap_str) - (Prims.strcat - "> svars:\n" - (FStar_List_Tot_Base.fold_left - (fun x -> - fun y -> - Prims.strcat - x y) "" - svars_str))))))))) - uu___4))) uu___3))) uu___2))) - uu___1) -let (genv_get : - genv -> - FStarC_Reflection_Types.bv -> - (FStarC_Reflection_Types.typ * Prims.bool * - FStarC_Reflection_Types.term) FStar_Pervasives_Native.option) - = fun ge -> fun b -> bind_map_get ge.bmap b -let (genv_get_from_name : - genv -> - Prims.string -> - (((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) * - (Prims.bool * FStarC_Reflection_Types.term)) - FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun name -> - let uu___ = bind_map_get_from_name ge.bmap name in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (268)) (Prims.of_int (8)) (Prims.of_int (268)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (268)) (Prims.of_int (2)) (Prims.of_int (270)) - (Prims.of_int (56))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some (bv, (sort, b, x)) -> - FStar_Pervasives_Native.Some ((bv, sort), (b, x)))) -let (genv_push_bv : - genv -> - FStarC_Reflection_Types.bv -> - FStarC_Reflection_Types.typ -> - Prims.bool -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - (genv, unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun b -> - fun sort -> - fun abs -> - fun t -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V1_Derived.mk_binder b sort)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (275)) (Prims.of_int (11)) - (Prims.of_int (275)) (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (275)) (Prims.of_int (30)) - (Prims.of_int (281)) (Prims.of_int (25))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun br -> - let uu___1 = - let uu___2 = FStar_Tactics_V1_Derived.name_of_bv b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (276)) (Prims.of_int (33)) - (Prims.of_int (276)) (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (276)) (Prims.of_int (11)) - (Prims.of_int (276)) (Prims.of_int (47))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic (genv_get_from_name ge uu___3)) - uu___3) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (276)) (Prims.of_int (11)) - (Prims.of_int (276)) (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (276)) (Prims.of_int (50)) - (Prims.of_int (281)) (Prims.of_int (25))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun sv -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - if - FStar_Pervasives_Native.uu___is_Some - sv - then - (FStar_Pervasives_Native.fst - (FStar_Pervasives_Native.__proj__Some__item__v - sv)) - :: (ge.svars) - else ge.svars)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (277)) - (Prims.of_int (15)) - (Prims.of_int (277)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (277)) - (Prims.of_int (77)) - (Prims.of_int (281)) - (Prims.of_int (25))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun svars' -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStarC_Reflection_V1_Builtins.push_binder - ge.env br)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (278)) - (Prims.of_int (11)) - (Prims.of_int (278)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (278)) - (Prims.of_int (35)) - (Prims.of_int (281)) - (Prims.of_int (25))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun e' -> - let uu___4 = - if - FStar_Pervasives_Native.uu___is_Some - t - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 - -> - FStar_Pervasives_Native.__proj__Some__item__v - t))) - else - Obj.magic - (Obj.repr - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - b))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (279)) - (Prims.of_int (11)) - (Prims.of_int (279)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (281)) - (Prims.of_int (2)) - (Prims.of_int (281)) - (Prims.of_int (25))))) - (Obj.magic uu___4) - (fun tm -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - mk_genv e' - ( - bind_map_push - ge.bmap b - (sort, - abs, tm)) - svars')))) - uu___4))) uu___3))) - uu___2))) uu___1) -let (genv_push_binder : - genv -> - FStarC_Reflection_Types.binder -> - Prims.bool -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - (genv, unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun b -> - fun abs -> - fun t -> - let uu___ = FStar_Tactics_V1_Derived.binder_sort b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (284)) (Prims.of_int (35)) - (Prims.of_int (284)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (284)) (Prims.of_int (2)) - (Prims.of_int (284)) (Prims.of_int (56))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (genv_push_bv ge - (FStar_Reflection_V1_Derived.bv_of_binder b) uu___1 - abs t)) uu___1) -let (bv_is_shadowed : genv -> FStarC_Reflection_Types.bv -> Prims.bool) = - fun ge -> - fun bv -> - FStar_List_Tot_Base.existsb - (fun uu___ -> match uu___ with | (b, uu___1) -> bv_eq bv b) ge.svars -let (binder_is_shadowed : - genv -> FStarC_Reflection_Types.binder -> Prims.bool) = - fun ge -> - fun b -> bv_is_shadowed ge (FStar_Reflection_V1_Derived.bv_of_binder b) -let (find_shadowed_bvs : - genv -> - FStarC_Reflection_Types.bv Prims.list -> - (FStarC_Reflection_Types.bv * Prims.bool) Prims.list) - = - fun ge -> - fun bl -> - FStar_List_Tot_Base.map (fun b -> (b, (bv_is_shadowed ge b))) bl -let (find_shadowed_binders : - genv -> - FStarC_Reflection_Types.binder Prims.list -> - (FStarC_Reflection_Types.binder * Prims.bool) Prims.list) - = - fun ge -> - fun bl -> - FStar_List_Tot_Base.map (fun b -> (b, (binder_is_shadowed ge b))) bl -let (bv_is_abstract : genv -> FStarC_Reflection_Types.bv -> Prims.bool) = - fun ge -> - fun bv -> - match genv_get ge bv with - | FStar_Pervasives_Native.None -> false - | FStar_Pervasives_Native.Some (uu___, abs, uu___1) -> abs -let (binder_is_abstract : - genv -> FStarC_Reflection_Types.binder -> Prims.bool) = - fun ge -> - fun b -> bv_is_abstract ge (FStar_Reflection_V1_Derived.bv_of_binder b) -let (genv_abstract_bvs : - genv -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) Prims.list) - = - fun ge -> - FStar_List_Tot_Base.concatMap - (fun uu___ -> - match uu___ with - | (bv, (ty, abs, uu___1)) -> if abs then [(bv, ty)] else []) - ge.bmap -let rec (_fresh_bv : - Prims.string Prims.list -> - Prims.string -> - Prims.int -> - (FStarC_Reflection_Types.bv, unit) FStar_Tactics_Effect.tac_repr) - = - fun binder_names -> - fun basename -> - fun i -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> Prims.strcat basename (Prims.string_of_int i))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (318)) (Prims.of_int (13)) - (Prims.of_int (318)) (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (321)) (Prims.of_int (2)) - (Prims.of_int (322)) (Prims.of_int (26))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun name -> - if FStar_List_Tot_Base.mem name binder_names - then - Obj.magic - (_fresh_bv binder_names basename (i + Prims.int_one)) - else - Obj.magic (FStarC_Tactics_V1_Builtins.fresh_bv_named name)) - uu___1) -let (fresh_bv : - FStarC_Reflection_Types.env -> - Prims.string -> - (FStarC_Reflection_Types.bv, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun basename -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStarC_Reflection_V1_Builtins.binders_of_env e)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (325)) (Prims.of_int (16)) - (Prims.of_int (325)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (325)) (Prims.of_int (35)) - (Prims.of_int (327)) (Prims.of_int (35))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun binders -> - let uu___1 = - FStar_Tactics_Util.map - FStar_Tactics_V1_Derived.name_of_binder binders in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (326)) (Prims.of_int (21)) - (Prims.of_int (326)) (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (327)) (Prims.of_int (2)) - (Prims.of_int (327)) (Prims.of_int (35))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun binder_names -> - Obj.magic - (_fresh_bv binder_names basename Prims.int_zero)) - uu___2))) uu___1) -let (fresh_binder : - FStarC_Reflection_Types.env -> - Prims.string -> - FStarC_Reflection_Types.typ -> - (FStarC_Reflection_Types.binder, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun basename -> - fun ty -> - let uu___ = fresh_bv e basename in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (330)) (Prims.of_int (11)) - (Prims.of_int (330)) (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (331)) (Prims.of_int (2)) - (Prims.of_int (331)) (Prims.of_int (17))))) - (Obj.magic uu___) - (fun bv -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStar_Reflection_V1_Derived.mk_binder bv ty)) -let (genv_push_fresh_binder : - genv -> - Prims.string -> - FStarC_Reflection_Types.typ -> - ((genv * FStarC_Reflection_Types.binder), unit) - FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun basename -> - fun ty -> - let uu___ = fresh_binder ge.env basename ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (334)) (Prims.of_int (10)) - (Prims.of_int (334)) (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (334)) (Prims.of_int (44)) - (Prims.of_int (337)) (Prims.of_int (8))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun b -> - let uu___1 = - genv_push_binder ge b true FStar_Pervasives_Native.None in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (336)) (Prims.of_int (12)) - (Prims.of_int (336)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (337)) (Prims.of_int (2)) - (Prims.of_int (337)) (Prims.of_int (8))))) - (Obj.magic uu___1) - (fun ge' -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> (ge', b))))) uu___1) -let (push_fresh_binder : - FStarC_Reflection_Types.env -> - Prims.string -> - FStarC_Reflection_Types.typ -> - ((FStarC_Reflection_Types.env * FStarC_Reflection_Types.binder), - unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun basename -> - fun ty -> - let uu___ = fresh_binder e basename ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (341)) (Prims.of_int (10)) - (Prims.of_int (341)) (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (341)) (Prims.of_int (39)) - (Prims.of_int (343)) (Prims.of_int (7))))) - (Obj.magic uu___) - (fun b -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - ((FStarC_Reflection_V1_Builtins.push_binder e b), b))) -let (genv_push_fresh_bv : - genv -> - Prims.string -> - FStarC_Reflection_Types.typ -> - ((genv * FStarC_Reflection_Types.bv), unit) - FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun basename -> - fun ty -> - let uu___ = genv_push_fresh_binder ge basename ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (346)) (Prims.of_int (15)) - (Prims.of_int (346)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (345)) (Prims.of_int (85)) - (Prims.of_int (347)) (Prims.of_int (21))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | (ge', b) -> - (ge', (FStar_Reflection_V1_Derived.bv_of_binder b)))) -let (push_fresh_var : - FStarC_Reflection_Types.env -> - Prims.string -> - FStarC_Reflection_Types.typ -> - ((FStarC_Reflection_Types.term * FStarC_Reflection_Types.binder * - FStarC_Reflection_Types.env), - unit) FStar_Tactics_Effect.tac_repr) - = - fun e0 -> - fun basename -> - fun ty -> - let uu___ = push_fresh_binder e0 basename ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (351)) (Prims.of_int (15)) - (Prims.of_int (351)) (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (350)) (Prims.of_int (35)) - (Prims.of_int (353)) (Prims.of_int (12))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (e1, b1) -> - let uu___2 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - (FStar_Reflection_V1_Derived.bv_of_binder b1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (352)) (Prims.of_int (11)) - (Prims.of_int (352)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (353)) (Prims.of_int (2)) - (Prims.of_int (353)) (Prims.of_int (12))))) - (Obj.magic uu___2) - (fun v1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> (v1, b1, e1))))) uu___1) -let (genv_push_fresh_var : - genv -> - Prims.string -> - FStarC_Reflection_Types.typ -> - ((FStarC_Reflection_Types.term * FStarC_Reflection_Types.binder * - genv), - unit) FStar_Tactics_Effect.tac_repr) - = - fun ge0 -> - fun basename -> - fun ty -> - let uu___ = genv_push_fresh_binder ge0 basename ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (357)) (Prims.of_int (16)) - (Prims.of_int (357)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (356)) (Prims.of_int (41)) - (Prims.of_int (359)) (Prims.of_int (13))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (ge1, b1) -> - let uu___2 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - (FStar_Reflection_V1_Derived.bv_of_binder b1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (358)) (Prims.of_int (11)) - (Prims.of_int (358)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (359)) (Prims.of_int (2)) - (Prims.of_int (359)) (Prims.of_int (13))))) - (Obj.magic uu___2) - (fun v1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> (v1, b1, ge1))))) uu___1) -let (push_two_fresh_vars : - FStarC_Reflection_Types.env -> - Prims.string -> - FStarC_Reflection_Types.typ -> - ((FStarC_Reflection_Types.term * FStarC_Reflection_Types.binder * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.binder * - FStarC_Reflection_Types.env), - unit) FStar_Tactics_Effect.tac_repr) - = - fun e0 -> - fun basename -> - fun ty -> - let uu___ = push_fresh_binder e0 basename ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (363)) (Prims.of_int (15)) - (Prims.of_int (363)) (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (362)) (Prims.of_int (40)) - (Prims.of_int (367)) (Prims.of_int (20))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (e1, b1) -> - let uu___2 = push_fresh_binder e1 basename ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (364)) (Prims.of_int (15)) - (Prims.of_int (364)) (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (363)) (Prims.of_int (50)) - (Prims.of_int (367)) (Prims.of_int (20))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (e2, b2) -> - let uu___4 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - (FStar_Reflection_V1_Derived.bv_of_binder - b1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (365)) - (Prims.of_int (11)) - (Prims.of_int (365)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (365)) - (Prims.of_int (45)) - (Prims.of_int (367)) - (Prims.of_int (20))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun v1 -> - let uu___5 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - (FStar_Reflection_V1_Derived.bv_of_binder - b2)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (366)) - (Prims.of_int (11)) - (Prims.of_int (366)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (367)) - (Prims.of_int (2)) - (Prims.of_int (367)) - (Prims.of_int (20))))) - (Obj.magic uu___5) - (fun v2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (v1, b1, v2, b2, - e2))))) uu___5))) - uu___3))) uu___1) -let (genv_push_two_fresh_vars : - genv -> - Prims.string -> - FStarC_Reflection_Types.typ -> - ((FStarC_Reflection_Types.term * FStarC_Reflection_Types.binder * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.binder * - genv), - unit) FStar_Tactics_Effect.tac_repr) - = - fun ge0 -> - fun basename -> - fun ty -> - let uu___ = genv_push_fresh_binder ge0 basename ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (371)) (Prims.of_int (16)) - (Prims.of_int (371)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (370)) (Prims.of_int (46)) - (Prims.of_int (375)) (Prims.of_int (21))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (ge1, b1) -> - let uu___2 = genv_push_fresh_binder ge1 basename ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (372)) (Prims.of_int (16)) - (Prims.of_int (372)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (371)) (Prims.of_int (57)) - (Prims.of_int (375)) (Prims.of_int (21))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (ge2, b2) -> - let uu___4 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - (FStar_Reflection_V1_Derived.bv_of_binder - b1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (373)) - (Prims.of_int (11)) - (Prims.of_int (373)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (373)) - (Prims.of_int (45)) - (Prims.of_int (375)) - (Prims.of_int (21))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun v1 -> - let uu___5 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - (FStar_Reflection_V1_Derived.bv_of_binder - b2)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (374)) - (Prims.of_int (11)) - (Prims.of_int (374)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (375)) - (Prims.of_int (2)) - (Prims.of_int (375)) - (Prims.of_int (21))))) - (Obj.magic uu___5) - (fun v2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (v1, b1, v2, b2, - ge2))))) uu___5))) - uu___3))) uu___1) -let (norm_apply_subst : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) * - FStarC_Reflection_Types.term) Prims.list -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - fun subst -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> unzip subst)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (389)) (Prims.of_int (15)) - (Prims.of_int (389)) (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (388)) (Prims.of_int (32)) - (Prims.of_int (393)) (Prims.of_int (23))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (bl, vl) -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStar_List_Tot_Base.map - (fun uu___4 -> - match uu___4 with - | (bv, ty) -> - FStar_Reflection_V1_Derived.mk_binder - bv ty) bl)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (390)) (Prims.of_int (11)) - (Prims.of_int (390)) (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (390)) (Prims.of_int (62)) - (Prims.of_int (393)) (Prims.of_int (23))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun bl1 -> - let uu___3 = - FStar_Tactics_V1_Derived.mk_abs bl1 t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (391)) - (Prims.of_int (11)) - (Prims.of_int (391)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (391)) - (Prims.of_int (25)) - (Prims.of_int (393)) - (Prims.of_int (23))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun t1 -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_Reflection_V1_Derived.mk_e_app - t1 vl)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (392)) - (Prims.of_int (11)) - (Prims.of_int (392)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (393)) - (Prims.of_int (2)) - (Prims.of_int (393)) - (Prims.of_int (23))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun t2 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.norm_term_env - e [] t2)) uu___5))) - uu___4))) uu___3))) uu___1) -let (norm_apply_subst_in_comp : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.comp -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) * - FStarC_Reflection_Types.term) Prims.list -> - (FStarC_Reflection_Types.comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun c -> - fun subst -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> fun x -> norm_apply_subst e x subst)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (396)) (Prims.of_int (14)) - (Prims.of_int (396)) (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (396)) (Prims.of_int (54)) - (Prims.of_int (419)) (Prims.of_int (55))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun subst1 -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun uu___2 -> - (fun uu___2 -> - fun a -> - match a with - | FStarC_Reflection_V1_Data.Q_Implicit -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> a))) - | FStarC_Reflection_V1_Data.Q_Explicit -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> a))) - | FStarC_Reflection_V1_Data.Q_Meta t -> - Obj.magic - (Obj.repr - (let uu___3 = subst1 t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (401)) - (Prims.of_int (25)) - (Prims.of_int (401)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (401)) - (Prims.of_int (18)) - (Prims.of_int (401)) - (Prims.of_int (34))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStarC_Reflection_V1_Data.Q_Meta - uu___4))))) uu___3 - uu___2)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (398)) (Prims.of_int (4)) - (Prims.of_int (401)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (403)) (Prims.of_int (2)) - (Prims.of_int (419)) (Prims.of_int (55))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun subst_in_aqualv -> - match FStarC_Reflection_V1_Builtins.inspect_comp c - with - | FStarC_Reflection_V1_Data.C_Total ret -> - let uu___2 = subst1 ret in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (405)) - (Prims.of_int (14)) - (Prims.of_int (405)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (406)) - (Prims.of_int (4)) - (Prims.of_int (406)) - (Prims.of_int (27))))) - (Obj.magic uu___2) - (fun ret1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Reflection_V1_Builtins.pack_comp - (FStarC_Reflection_V1_Data.C_Total - ret1)))) - | FStarC_Reflection_V1_Data.C_GTotal ret -> - let uu___2 = subst1 ret in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (408)) - (Prims.of_int (14)) - (Prims.of_int (408)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (409)) - (Prims.of_int (4)) - (Prims.of_int (409)) - (Prims.of_int (28))))) - (Obj.magic uu___2) - (fun ret1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Reflection_V1_Builtins.pack_comp - (FStarC_Reflection_V1_Data.C_GTotal - ret1)))) - | FStarC_Reflection_V1_Data.C_Lemma - (pre, post, patterns) -> - let uu___2 = subst1 pre in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (411)) - (Prims.of_int (14)) - (Prims.of_int (411)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (411)) - (Prims.of_int (26)) - (Prims.of_int (414)) - (Prims.of_int (41))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun pre1 -> - let uu___3 = subst1 post in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (412)) - (Prims.of_int (15)) - (Prims.of_int (412)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (412)) - (Prims.of_int (28)) - (Prims.of_int (414)) - (Prims.of_int (41))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun post1 -> - let uu___4 = - subst1 patterns in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (413)) - (Prims.of_int (19)) - (Prims.of_int (413)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (414)) - (Prims.of_int (4)) - (Prims.of_int (414)) - (Prims.of_int (41))))) - (Obj.magic uu___4) - (fun patterns1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStarC_Reflection_V1_Builtins.pack_comp - ( - FStarC_Reflection_V1_Data.C_Lemma - (pre1, - post1, - patterns1)))))) - uu___4))) uu___3)) - | FStarC_Reflection_V1_Data.C_Eff - (us, eff_name, result, eff_args, decrs) -> - let uu___2 = subst1 result in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (416)) - (Prims.of_int (17)) - (Prims.of_int (416)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (416)) - (Prims.of_int (32)) - (Prims.of_int (419)) - (Prims.of_int (55))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun result1 -> - let uu___3 = - FStar_Tactics_Util.map - (fun uu___4 -> - match uu___4 with - | (x, a) -> - let uu___5 = subst1 x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (417)) - (Prims.of_int (39)) - (Prims.of_int (417)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (417)) - (Prims.of_int (38)) - (Prims.of_int (417)) - (Prims.of_int (66))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - subst_in_aqualv - a in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (417)) - (Prims.of_int (48)) - (Prims.of_int (417)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (417)) - (Prims.of_int (38)) - (Prims.of_int (417)) - (Prims.of_int (66))))) - (Obj.magic - uu___7) - (fun uu___8 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - (uu___6, - uu___8))))) - uu___6)) eff_args in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (417)) - (Prims.of_int (19)) - (Prims.of_int (417)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (417)) - (Prims.of_int (79)) - (Prims.of_int (419)) - (Prims.of_int (55))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun eff_args1 -> - let uu___4 = - FStar_Tactics_Util.map - subst1 decrs in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (418)) - (Prims.of_int (16)) - (Prims.of_int (418)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (419)) - (Prims.of_int (4)) - (Prims.of_int (419)) - (Prims.of_int (55))))) - (Obj.magic uu___4) - (fun decrs1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStarC_Reflection_V1_Builtins.pack_comp - ( - FStarC_Reflection_V1_Data.C_Eff - (us, - eff_name, - result1, - eff_args1, - decrs1)))))) - uu___4))) uu___3))) - uu___2))) uu___1) -let rec (deep_apply_subst : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.term) Prims.list - -> (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - fun subst -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (438)) (Prims.of_int (8)) - (Prims.of_int (438)) (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (438)) (Prims.of_int (2)) - (Prims.of_int (513)) (Prims.of_int (5))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_Var b -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match bind_map_get subst b with - | FStar_Pervasives_Native.None -> t - | FStar_Pervasives_Native.Some t' -> t'))) - | FStarC_Reflection_V1_Data.Tv_BVar b -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match bind_map_get subst b with - | FStar_Pervasives_Native.None -> t - | FStar_Pervasives_Native.Some t' -> t'))) - | FStarC_Reflection_V1_Data.Tv_FVar uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> t))) - | FStarC_Reflection_V1_Data.Tv_App (hd, (a, qual)) -> - Obj.magic - (Obj.repr - (let uu___2 = deep_apply_subst e hd subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (452)) (Prims.of_int (13)) - (Prims.of_int (452)) (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (452)) (Prims.of_int (43)) - (Prims.of_int (454)) (Prims.of_int (30))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun hd1 -> - let uu___3 = deep_apply_subst e a subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (453)) - (Prims.of_int (12)) - (Prims.of_int (453)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (454)) - (Prims.of_int (4)) - (Prims.of_int (454)) - (Prims.of_int (30))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun a1 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_App - (hd1, (a1, qual))))) - uu___4))) uu___3))) - | FStarC_Reflection_V1_Data.Tv_Abs (br, body) -> - Obj.magic - (Obj.repr - (let uu___2 = deep_apply_subst e body subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (456)) (Prims.of_int (15)) - (Prims.of_int (456)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (457)) (Prims.of_int (4)) - (Prims.of_int (457)) (Prims.of_int (25))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun body1 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Abs - (br, body1)))) uu___3))) - | FStarC_Reflection_V1_Data.Tv_Arrow (br, c) -> - Obj.magic - (Obj.repr - (let uu___2 = deep_apply_subst_in_binder e br subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (459)) (Prims.of_int (20)) - (Prims.of_int (459)) (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (458)) (Prims.of_int (20)) - (Prims.of_int (461)) (Prims.of_int (24))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (br1, subst1) -> - let uu___4 = - deep_apply_subst_in_comp e c subst1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (460)) - (Prims.of_int (12)) - (Prims.of_int (460)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (461)) - (Prims.of_int (4)) - (Prims.of_int (461)) - (Prims.of_int (24))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun c1 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Arrow - (br1, c1)))) uu___5))) - uu___3))) - | FStarC_Reflection_V1_Data.Tv_Type uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> t))) - | FStarC_Reflection_V1_Data.Tv_Refine (bv, sort, ref) -> - Obj.magic - (Obj.repr - (let uu___2 = deep_apply_subst e sort subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (464)) (Prims.of_int (15)) - (Prims.of_int (464)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (464)) (Prims.of_int (47)) - (Prims.of_int (467)) (Prims.of_int (32))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun sort1 -> - let uu___3 = - deep_apply_subst_in_bv e bv subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (465)) - (Prims.of_int (20)) - (Prims.of_int (465)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (464)) - (Prims.of_int (47)) - (Prims.of_int (467)) - (Prims.of_int (32))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | (bv1, subst1) -> - let uu___5 = - deep_apply_subst e ref - subst1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (466)) - (Prims.of_int (14)) - (Prims.of_int (466)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (467)) - (Prims.of_int (4)) - (Prims.of_int (467)) - (Prims.of_int (32))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun ref1 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Refine - (bv1, - sort1, - ref1)))) - uu___6))) uu___4))) - uu___3))) - | FStarC_Reflection_V1_Data.Tv_Const uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> t))) - | FStarC_Reflection_V1_Data.Tv_Uvar (uu___2, uu___3) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___4 -> t))) - | FStarC_Reflection_V1_Data.Tv_Let - (recf, attrs, bv, ty, def, body) -> - Obj.magic - (Obj.repr - (let uu___2 = deep_apply_subst e ty subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (472)) (Prims.of_int (13)) - (Prims.of_int (472)) (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (472)) (Prims.of_int (43)) - (Prims.of_int (476)) (Prims.of_int (40))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun ty1 -> - let uu___3 = deep_apply_subst e def subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (473)) - (Prims.of_int (14)) - (Prims.of_int (473)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (473)) - (Prims.of_int (45)) - (Prims.of_int (476)) - (Prims.of_int (40))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun def1 -> - let uu___4 = - deep_apply_subst_in_bv e bv - subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (474)) - (Prims.of_int (20)) - (Prims.of_int (474)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (473)) - (Prims.of_int (45)) - (Prims.of_int (476)) - (Prims.of_int (40))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | (bv1, subst1) -> - let uu___6 = - deep_apply_subst - e body subst1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (475)) - (Prims.of_int (15)) - (Prims.of_int (475)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (476)) - (Prims.of_int (4)) - (Prims.of_int (476)) - (Prims.of_int (40))))) - (Obj.magic - uu___6) - (fun uu___7 - -> - (fun - body1 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Let - (recf, - [], bv1, - ty1, - def1, - body1)))) - uu___7))) - uu___5))) uu___4))) - uu___3))) - | FStarC_Reflection_V1_Data.Tv_Match - (scrutinee, ret_opt, branches) -> - Obj.magic - (Obj.repr - (let uu___2 = deep_apply_subst e scrutinee subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (478)) (Prims.of_int (20)) - (Prims.of_int (478)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (478)) (Prims.of_int (57)) - (Prims.of_int (500)) (Prims.of_int (46))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun scrutinee1 -> - let uu___3 = - FStar_Tactics_Util.map_opt - (fun uu___4 -> - match uu___4 with - | (b, asc) -> - let uu___5 = - deep_apply_subst_in_binder e b - subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (480)) - (Prims.of_int (21)) - (Prims.of_int (480)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (479)) - (Prims.of_int (42)) - (Prims.of_int (491)) - (Prims.of_int (12))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 with - | (b1, subst1) -> - let uu___7 = - match asc with - | (FStar_Pervasives.Inl - t1, tacopt, - use_eq) -> - let uu___8 = - let uu___9 = - deep_apply_subst - e t1 - subst1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (484)) - (Prims.of_int (14)) - (Prims.of_int (484)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (484)) - (Prims.of_int (10)) - (Prims.of_int (484)) - (Prims.of_int (42))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - FStar_Pervasives.Inl - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (484)) - (Prims.of_int (10)) - (Prims.of_int (484)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (484)) - (Prims.of_int (10)) - (Prims.of_int (486)) - (Prims.of_int (16))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - (fun - uu___9 -> - let uu___10 - = - FStar_Tactics_Util.map_opt - (fun tac - -> - deep_apply_subst - e tac - subst1) - tacopt in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (485)) - (Prims.of_int (10)) - (Prims.of_int (485)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (484)) - (Prims.of_int (10)) - (Prims.of_int (486)) - (Prims.of_int (16))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (uu___9, - uu___11, - use_eq))))) - uu___9) - | (FStar_Pervasives.Inr - c, tacopt, - use_eq) -> - let uu___8 = - let uu___9 = - deep_apply_subst_in_comp - e c - subst1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (488)) - (Prims.of_int (14)) - (Prims.of_int (488)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (488)) - (Prims.of_int (10)) - (Prims.of_int (488)) - (Prims.of_int (50))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - FStar_Pervasives.Inr - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (488)) - (Prims.of_int (10)) - (Prims.of_int (488)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (488)) - (Prims.of_int (10)) - (Prims.of_int (490)) - (Prims.of_int (16))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - (fun - uu___9 -> - let uu___10 - = - FStar_Tactics_Util.map_opt - (fun tac - -> - deep_apply_subst - e tac - subst1) - tacopt in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (489)) - (Prims.of_int (10)) - (Prims.of_int (489)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (488)) - (Prims.of_int (10)) - (Prims.of_int (490)) - (Prims.of_int (16))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (uu___9, - uu___11, - use_eq))))) - uu___9) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (482)) - (Prims.of_int (8)) - (Prims.of_int (490)) - (Prims.of_int (16))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (491)) - (Prims.of_int (6)) - (Prims.of_int (491)) - (Prims.of_int (12))))) - (Obj.magic - uu___7) - (fun asc1 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - (b1, - asc1))))) - uu___6)) ret_opt in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (479)) - (Prims.of_int (18)) - (Prims.of_int (491)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (491)) - (Prims.of_int (24)) - (Prims.of_int (500)) - (Prims.of_int (46))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun ret_opt1 -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - fun branch -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 - -> branch)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (494)) - (Prims.of_int (20)) - (Prims.of_int (494)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (493)) - (Prims.of_int (43)) - (Prims.of_int (497)) - (Prims.of_int (13))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - match uu___7 - with - | (pat, tm) - -> - let uu___8 - = - deep_apply_subst_in_pattern - e pat - subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (495)) - (Prims.of_int (23)) - (Prims.of_int (495)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (494)) - (Prims.of_int (29)) - (Prims.of_int (497)) - (Prims.of_int (13))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - match uu___9 - with - | - (pat1, - subst1) - -> - let uu___10 - = - deep_apply_subst - e tm - subst1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (496)) - (Prims.of_int (15)) - (Prims.of_int (496)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (497)) - (Prims.of_int (6)) - (Prims.of_int (497)) - (Prims.of_int (13))))) - (Obj.magic - uu___10) - (fun tm1 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - (pat1, - tm1))))) - uu___9))) - uu___7))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (493)) - (Prims.of_int (43)) - (Prims.of_int (497)) - (Prims.of_int (13))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (498)) - (Prims.of_int (6)) - (Prims.of_int (500)) - (Prims.of_int (46))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun - deep_apply_subst_in_branch - -> - let uu___5 = - FStar_Tactics_Util.map - deep_apply_subst_in_branch - branches in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (499)) - (Prims.of_int (19)) - (Prims.of_int (499)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (500)) - (Prims.of_int (4)) - (Prims.of_int (500)) - (Prims.of_int (46))))) - (Obj.magic - uu___5) - (fun uu___6 -> - (fun - branches1 - -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Match - (scrutinee1, - ret_opt1, - branches1)))) - uu___6))) - uu___5))) uu___4))) - uu___3))) - | FStarC_Reflection_V1_Data.Tv_AscribedT - (exp, ty, tac, use_eq) -> - Obj.magic - (Obj.repr - (let uu___2 = deep_apply_subst e exp subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (502)) (Prims.of_int (14)) - (Prims.of_int (502)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (502)) (Prims.of_int (45)) - (Prims.of_int (505)) (Prims.of_int (42))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun exp1 -> - let uu___3 = deep_apply_subst e ty subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (503)) - (Prims.of_int (13)) - (Prims.of_int (503)) - (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (505)) - (Prims.of_int (4)) - (Prims.of_int (505)) - (Prims.of_int (42))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun ty1 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_AscribedT - (exp1, ty1, - FStar_Pervasives_Native.None, - use_eq)))) uu___4))) - uu___3))) - | FStarC_Reflection_V1_Data.Tv_AscribedC - (exp, c, tac, use_eq) -> - Obj.magic - (Obj.repr - (let uu___2 = deep_apply_subst e exp subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (507)) (Prims.of_int (14)) - (Prims.of_int (507)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (507)) (Prims.of_int (45)) - (Prims.of_int (510)) (Prims.of_int (41))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun exp1 -> - let uu___3 = - deep_apply_subst_in_comp e c subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (508)) - (Prims.of_int (12)) - (Prims.of_int (508)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (510)) - (Prims.of_int (4)) - (Prims.of_int (510)) - (Prims.of_int (41))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun c1 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_AscribedC - (exp1, c1, - FStar_Pervasives_Native.None, - use_eq)))) uu___4))) - uu___3))) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> t)))) - uu___1) -and (deep_apply_subst_in_bv : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.bv -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.term) Prims.list - -> - ((FStarC_Reflection_Types.bv * (FStarC_Reflection_Types.bv * - FStarC_Reflection_Types.term) Prims.list), - unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun bv -> - fun subst -> - let uu___ = - let uu___1 = - let uu___2 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var bv) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (518)) (Prims.of_int (11)) - (Prims.of_int (518)) (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (518)) (Prims.of_int (6)) - (Prims.of_int (518)) (Prims.of_int (28))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> (bv, uu___3))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (518)) (Prims.of_int (6)) - (Prims.of_int (518)) (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (518)) (Prims.of_int (6)) - (Prims.of_int (518)) (Prims.of_int (35))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> uu___2 :: subst)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (518)) (Prims.of_int (6)) - (Prims.of_int (518)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (518)) (Prims.of_int (2)) - (Prims.of_int (518)) (Prims.of_int (35))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> (bv, uu___1))) -and (deep_apply_subst_in_binder : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.binder -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.term) Prims.list - -> - ((FStarC_Reflection_Types.binder * (FStarC_Reflection_Types.bv * - FStarC_Reflection_Types.term) Prims.list), - unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun br -> - fun subst -> - match FStarC_Reflection_V1_Builtins.inspect_binder br with - | { FStarC_Reflection_V1_Data.binder_bv = binder_bv; - FStarC_Reflection_V1_Data.binder_qual = binder_qual; - FStarC_Reflection_V1_Data.binder_attrs = binder_attrs; - FStarC_Reflection_V1_Data.binder_sort = binder_sort;_} -> - let uu___ = deep_apply_subst e binder_sort subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (525)) (Prims.of_int (20)) - (Prims.of_int (525)) (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (525)) (Prims.of_int (59)) - (Prims.of_int (532)) (Prims.of_int (10))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun binder_sort1 -> - let uu___1 = deep_apply_subst_in_bv e binder_bv subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (526)) (Prims.of_int (25)) - (Prims.of_int (526)) (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (525)) (Prims.of_int (59)) - (Prims.of_int (532)) (Prims.of_int (10))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - match uu___2 with - | (binder_bv1, subst1) -> - ((FStarC_Reflection_V1_Builtins.pack_binder - { - FStarC_Reflection_V1_Data.binder_bv - = binder_bv1; - FStarC_Reflection_V1_Data.binder_qual - = binder_qual; - FStarC_Reflection_V1_Data.binder_attrs - = binder_attrs; - FStarC_Reflection_V1_Data.binder_sort - = binder_sort1 - }), subst1))))) uu___1) -and (deep_apply_subst_in_comp : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.comp -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.term) Prims.list - -> (FStarC_Reflection_Types.comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun c -> - fun subst -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> fun x -> deep_apply_subst e x subst)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (535)) (Prims.of_int (14)) - (Prims.of_int (535)) (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (535)) (Prims.of_int (54)) - (Prims.of_int (558)) (Prims.of_int (55))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun subst1 -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun uu___2 -> - (fun uu___2 -> - fun a -> - match a with - | FStarC_Reflection_V1_Data.Q_Implicit -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> a))) - | FStarC_Reflection_V1_Data.Q_Explicit -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> a))) - | FStarC_Reflection_V1_Data.Q_Meta t -> - Obj.magic - (Obj.repr - (let uu___3 = subst1 t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (540)) - (Prims.of_int (25)) - (Prims.of_int (540)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (540)) - (Prims.of_int (18)) - (Prims.of_int (540)) - (Prims.of_int (34))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStarC_Reflection_V1_Data.Q_Meta - uu___4))))) uu___3 - uu___2)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (537)) (Prims.of_int (4)) - (Prims.of_int (540)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (542)) (Prims.of_int (2)) - (Prims.of_int (558)) (Prims.of_int (55))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun subst_in_aqualv -> - match FStarC_Reflection_V1_Builtins.inspect_comp c - with - | FStarC_Reflection_V1_Data.C_Total ret -> - let uu___2 = subst1 ret in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (544)) - (Prims.of_int (14)) - (Prims.of_int (544)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (545)) - (Prims.of_int (4)) - (Prims.of_int (545)) - (Prims.of_int (27))))) - (Obj.magic uu___2) - (fun ret1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Reflection_V1_Builtins.pack_comp - (FStarC_Reflection_V1_Data.C_Total - ret1)))) - | FStarC_Reflection_V1_Data.C_GTotal ret -> - let uu___2 = subst1 ret in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (547)) - (Prims.of_int (14)) - (Prims.of_int (547)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (548)) - (Prims.of_int (4)) - (Prims.of_int (548)) - (Prims.of_int (28))))) - (Obj.magic uu___2) - (fun ret1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Reflection_V1_Builtins.pack_comp - (FStarC_Reflection_V1_Data.C_GTotal - ret1)))) - | FStarC_Reflection_V1_Data.C_Lemma - (pre, post, patterns) -> - let uu___2 = subst1 pre in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (550)) - (Prims.of_int (14)) - (Prims.of_int (550)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (550)) - (Prims.of_int (26)) - (Prims.of_int (553)) - (Prims.of_int (41))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun pre1 -> - let uu___3 = subst1 post in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (551)) - (Prims.of_int (15)) - (Prims.of_int (551)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (551)) - (Prims.of_int (28)) - (Prims.of_int (553)) - (Prims.of_int (41))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun post1 -> - let uu___4 = - subst1 patterns in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (552)) - (Prims.of_int (19)) - (Prims.of_int (552)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (553)) - (Prims.of_int (4)) - (Prims.of_int (553)) - (Prims.of_int (41))))) - (Obj.magic uu___4) - (fun patterns1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStarC_Reflection_V1_Builtins.pack_comp - ( - FStarC_Reflection_V1_Data.C_Lemma - (pre1, - post1, - patterns1)))))) - uu___4))) uu___3)) - | FStarC_Reflection_V1_Data.C_Eff - (us, eff_name, result, eff_args, decrs) -> - let uu___2 = subst1 result in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (555)) - (Prims.of_int (17)) - (Prims.of_int (555)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (555)) - (Prims.of_int (32)) - (Prims.of_int (558)) - (Prims.of_int (55))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun result1 -> - let uu___3 = - FStar_Tactics_Util.map - (fun uu___4 -> - match uu___4 with - | (x, a) -> - let uu___5 = subst1 x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (556)) - (Prims.of_int (39)) - (Prims.of_int (556)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (556)) - (Prims.of_int (38)) - (Prims.of_int (556)) - (Prims.of_int (66))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - subst_in_aqualv - a in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (556)) - (Prims.of_int (48)) - (Prims.of_int (556)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (556)) - (Prims.of_int (38)) - (Prims.of_int (556)) - (Prims.of_int (66))))) - (Obj.magic - uu___7) - (fun uu___8 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - (uu___6, - uu___8))))) - uu___6)) eff_args in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (556)) - (Prims.of_int (19)) - (Prims.of_int (556)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (556)) - (Prims.of_int (79)) - (Prims.of_int (558)) - (Prims.of_int (55))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun eff_args1 -> - let uu___4 = - FStar_Tactics_Util.map - subst1 decrs in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (557)) - (Prims.of_int (16)) - (Prims.of_int (557)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (558)) - (Prims.of_int (4)) - (Prims.of_int (558)) - (Prims.of_int (55))))) - (Obj.magic uu___4) - (fun decrs1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStarC_Reflection_V1_Builtins.pack_comp - ( - FStarC_Reflection_V1_Data.C_Eff - (us, - eff_name, - result1, - eff_args1, - decrs1)))))) - uu___4))) uu___3))) - uu___2))) uu___1) -and (deep_apply_subst_in_pattern : - FStarC_Reflection_Types.env -> - FStarC_Reflection_V1_Data.pattern -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.term) Prims.list - -> - ((FStarC_Reflection_V1_Data.pattern * (FStarC_Reflection_Types.bv * - FStarC_Reflection_Types.term) Prims.list), - unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun e -> - fun pat -> - fun subst -> - match pat with - | FStarC_Reflection_V1_Data.Pat_Constant uu___ -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> (pat, subst)))) - | FStarC_Reflection_V1_Data.Pat_Cons (fv, us, patterns) -> - Obj.magic - (Obj.repr - (let uu___ = - FStar_Tactics_Util.fold_right - (fun uu___1 -> - fun uu___2 -> - match (uu___1, uu___2) with - | ((pat1, b), (pats, subst1)) -> - let uu___3 = - deep_apply_subst_in_pattern e pat1 - subst1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (568)) - (Prims.of_int (39)) - (Prims.of_int (568)) - (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (567)) - (Prims.of_int (47)) - (Prims.of_int (569)) - (Prims.of_int (47))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - match uu___4 with - | (pat2, subst2) -> - (((pat2, b) :: pats), - subst2)))) patterns - ([], subst) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (567)) (Prims.of_int (6)) - (Prims.of_int (569)) (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (563)) (Prims.of_int (30)) - (Prims.of_int (571)) (Prims.of_int (34))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | (patterns1, subst1) -> - ((FStarC_Reflection_V1_Data.Pat_Cons - (fv, us, patterns1)), subst1))))) - | FStarC_Reflection_V1_Data.Pat_Var (bv, st) -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = - let uu___2 = FStarC_Tactics_Unseal.unseal st in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (573)) - (Prims.of_int (45)) - (Prims.of_int (573)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (573)) - (Prims.of_int (25)) - (Prims.of_int (573)) - (Prims.of_int (63))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (deep_apply_subst e uu___3 subst)) - uu___3) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (573)) - (Prims.of_int (25)) - (Prims.of_int (573)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (573)) - (Prims.of_int (13)) - (Prims.of_int (573)) - (Prims.of_int (63))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> FStar_Sealed.seal uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (573)) (Prims.of_int (13)) - (Prims.of_int (573)) (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (573)) (Prims.of_int (66)) - (Prims.of_int (575)) (Prims.of_int (24))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun st1 -> - let uu___1 = - deep_apply_subst_in_bv e bv subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (574)) - (Prims.of_int (20)) - (Prims.of_int (574)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (573)) - (Prims.of_int (66)) - (Prims.of_int (575)) - (Prims.of_int (24))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - match uu___2 with - | (bv1, subst1) -> - ((FStarC_Reflection_V1_Data.Pat_Var - (bv1, st1)), subst1))))) - uu___1))) - | FStarC_Reflection_V1_Data.Pat_Dot_Term eopt -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = - FStar_Tactics_Util.map_opt - (fun t -> deep_apply_subst e t subst) eopt in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (577)) - (Prims.of_int (17)) - (Prims.of_int (577)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (577)) (Prims.of_int (4)) - (Prims.of_int (577)) - (Prims.of_int (69))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Reflection_V1_Data.Pat_Dot_Term - uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (577)) (Prims.of_int (4)) - (Prims.of_int (577)) (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (577)) (Prims.of_int (4)) - (Prims.of_int (577)) (Prims.of_int (76))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> (uu___1, subst)))))) uu___2 - uu___1 uu___ -let (apply_subst : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) * - FStarC_Reflection_Types.term) Prims.list -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = norm_apply_subst -let (apply_subst_in_comp : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.comp -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) * - FStarC_Reflection_Types.term) Prims.list -> - (FStarC_Reflection_Types.comp, unit) FStar_Tactics_Effect.tac_repr) - = norm_apply_subst_in_comp -let (opt_apply_subst : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) * - FStarC_Reflection_Types.term) Prims.list -> - (FStarC_Reflection_Types.term FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun e -> - fun opt_t -> - fun subst -> - match opt_t with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.None))) - | FStar_Pervasives_Native.Some t -> - Obj.magic - (Obj.repr - (let uu___ = apply_subst e t subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (593)) (Prims.of_int (19)) - (Prims.of_int (593)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (593)) (Prims.of_int (14)) - (Prims.of_int (593)) (Prims.of_int (42))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Pervasives_Native.Some uu___1))))) - uu___2 uu___1 uu___ -let rec (_generate_shadowed_subst : - genv -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) Prims.list - -> - ((genv * (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ * - FStarC_Reflection_Types.bv) Prims.list), - unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun ge -> - fun t -> - fun bvl -> - match bvl with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> (ge, [])))) - | old_bv::bvl' -> - Obj.magic - (Obj.repr - (let uu___ = FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (612)) (Prims.of_int (10)) - (Prims.of_int (612)) (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (612)) (Prims.of_int (4)) - (Prims.of_int (626)) (Prims.of_int (55))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_Abs - (b, uu___2) -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - (FStarC_Reflection_V1_Builtins.inspect_binder - b).FStarC_Reflection_V1_Data.binder_bv)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (615)) - (Prims.of_int (15)) - (Prims.of_int (615)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (615)) - (Prims.of_int (46)) - (Prims.of_int (625)) - (Prims.of_int (42))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun bv -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStarC_Reflection_V1_Builtins.inspect_bv - bv)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (616)) - (Prims.of_int (16)) - (Prims.of_int (616)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (616)) - (Prims.of_int (32)) - (Prims.of_int (625)) - (Prims.of_int (42))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun bvv -> - let uu___5 = - FStar_Tactics_V1_Derived.binder_sort - b in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (617)) - (Prims.of_int (15)) - (Prims.of_int (617)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (617)) - (Prims.of_int (31)) - (Prims.of_int (625)) - (Prims.of_int (42))))) - (Obj.magic - uu___5) - (fun uu___6 - -> - (fun ty -> - let uu___6 - = - FStarC_Tactics_Unseal.unseal - bvv.FStarC_Reflection_V1_Data.bv_ppname in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (618)) - (Prims.of_int (17)) - (Prims.of_int (618)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (618)) - (Prims.of_int (40)) - (Prims.of_int (625)) - (Prims.of_int (42))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun name - -> - let uu___7 - = - genv_push_fresh_bv - ge - (Prims.strcat - "__" name) - ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (619)) - (Prims.of_int (23)) - (Prims.of_int (619)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (618)) - (Prims.of_int (40)) - (Prims.of_int (625)) - (Prims.of_int (42))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - match uu___8 - with - | - (ge1, - fresh) -> - let uu___9 - = - let uu___10 - = - let uu___11 - = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - fresh) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (620)) - (Prims.of_int (27)) - (Prims.of_int (620)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (620)) - (Prims.of_int (26)) - (Prims.of_int (620)) - (Prims.of_int (47))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - [uu___12])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (620)) - (Prims.of_int (26)) - (Prims.of_int (620)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (620)) - (Prims.of_int (15)) - (Prims.of_int (620)) - (Prims.of_int (47))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - FStar_Reflection_V1_Derived.mk_e_app - t uu___11)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (620)) - (Prims.of_int (15)) - (Prims.of_int (620)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (620)) - (Prims.of_int (50)) - (Prims.of_int (625)) - (Prims.of_int (42))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun t1 - -> - let uu___10 - = - FStarC_Tactics_V1_Builtins.norm_term_env - ge1.env - [] t1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (621)) - (Prims.of_int (15)) - (Prims.of_int (621)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (621)) - (Prims.of_int (45)) - (Prims.of_int (625)) - (Prims.of_int (42))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun t2 - -> - let uu___11 - = - _generate_shadowed_subst - ge1 t2 - bvl' in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (623)) - (Prims.of_int (22)) - (Prims.of_int (623)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (621)) - (Prims.of_int (45)) - (Prims.of_int (625)) - (Prims.of_int (42))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - match uu___12 - with - | - (ge2, - nbvl) -> - (ge2, - (((FStar_Pervasives_Native.fst - old_bv), - ty, - fresh) :: - nbvl)))))) - uu___11))) - uu___10))) - uu___8))) - uu___7))) - uu___6))) - uu___5))) uu___4)) - | uu___2 -> - Obj.magic - (mfail - "_subst_with_fresh_vars: not a Tv_Abs")) - uu___1)))) uu___2 uu___1 uu___ -let (generate_shadowed_subst : - genv -> - ((genv * (FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ * - FStarC_Reflection_Types.bv) Prims.list), - unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStar_List_Tot_Base.rev ge.svars)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (630)) (Prims.of_int (12)) (Prims.of_int (630)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (630)) (Prims.of_int (36)) (Prims.of_int (633)) - (Prims.of_int (39))))) (Obj.magic uu___) - (fun uu___1 -> - (fun bvl -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_List_Tot_Base.map - (fun uu___3 -> - match uu___3 with - | (bv, sort) -> - FStar_Reflection_V1_Derived.mk_binder bv sort) - bvl)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (631)) (Prims.of_int (11)) - (Prims.of_int (631)) (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (631)) (Prims.of_int (68)) - (Prims.of_int (633)) (Prims.of_int (39))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun bl -> - let uu___2 = - FStar_Tactics_V1_Derived.mk_abs bl - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - FStarC_Reflection_V2_Data.C_Unit)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (632)) (Prims.of_int (14)) - (Prims.of_int (632)) (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Base.fst" - (Prims.of_int (633)) (Prims.of_int (2)) - (Prims.of_int (633)) (Prims.of_int (39))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun dummy -> - Obj.magic - (_generate_shadowed_subst ge dummy bvl)) - uu___3))) uu___2))) uu___1) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Effectful.ml b/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Effectful.ml deleted file mode 100644 index e31782c322a..00000000000 --- a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Effectful.ml +++ /dev/null @@ -1,10896 +0,0 @@ -open Prims -let (term_eq : - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) - = FStar_Reflection_TermEq_Simple.term_eq -type cast_info = - { - term: FStarC_Reflection_Types.term ; - p_ty: - FStar_InteractiveHelpers_ExploreTerm.type_info - FStar_Pervasives_Native.option - ; - exp_ty: - FStar_InteractiveHelpers_ExploreTerm.type_info - FStar_Pervasives_Native.option - } -let (__proj__Mkcast_info__item__term : - cast_info -> FStarC_Reflection_Types.term) = - fun projectee -> match projectee with | { term; p_ty; exp_ty;_} -> term -let (__proj__Mkcast_info__item__p_ty : - cast_info -> - FStar_InteractiveHelpers_ExploreTerm.type_info - FStar_Pervasives_Native.option) - = fun projectee -> match projectee with | { term; p_ty; exp_ty;_} -> p_ty -let (__proj__Mkcast_info__item__exp_ty : - cast_info -> - FStar_InteractiveHelpers_ExploreTerm.type_info - FStar_Pervasives_Native.option) - = fun projectee -> match projectee with | { term; p_ty; exp_ty;_} -> exp_ty -let (mk_cast_info : - FStarC_Reflection_Types.term -> - FStar_InteractiveHelpers_ExploreTerm.type_info - FStar_Pervasives_Native.option -> - FStar_InteractiveHelpers_ExploreTerm.type_info - FStar_Pervasives_Native.option -> cast_info) - = fun t -> fun p_ty -> fun exp_ty -> { term = t; p_ty; exp_ty } -let (cast_info_to_string : - cast_info -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun info -> - let uu___ = - let uu___1 = FStarC_Tactics_V1_Builtins.term_to_string info.term in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (33)) (Prims.of_int (20)) (Prims.of_int (33)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (33)) (Prims.of_int (20)) (Prims.of_int (35)) - (Prims.of_int (56))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - let uu___4 = - let uu___5 = - FStar_InteractiveHelpers_Base.option_to_string - FStar_InteractiveHelpers_ExploreTerm.type_info_to_string - info.p_ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (34)) (Prims.of_int (2)) - (Prims.of_int (34)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (34)) (Prims.of_int (2)) - (Prims.of_int (35)) (Prims.of_int (56))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = - FStar_InteractiveHelpers_Base.option_to_string - FStar_InteractiveHelpers_ExploreTerm.type_info_to_string - info.exp_ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (35)) - (Prims.of_int (2)) - (Prims.of_int (35)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> Prims.strcat uu___10 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (35)) (Prims.of_int (2)) - (Prims.of_int (35)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> Prims.strcat ") (" uu___9)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (34)) - (Prims.of_int (51)) - (Prims.of_int (35)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> Prims.strcat uu___6 uu___8)))) - uu___6) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (34)) (Prims.of_int (2)) - (Prims.of_int (35)) (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat ") (" uu___5)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (33)) (Prims.of_int (47)) - (Prims.of_int (35)) (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat uu___2 uu___4)))) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (33)) (Prims.of_int (20)) (Prims.of_int (35)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "Mkcast_info (" uu___1)) -type effect_info = - { - ei_type: FStar_InteractiveHelpers_ExploreTerm.effect_type ; - ei_ret_type: FStar_InteractiveHelpers_ExploreTerm.type_info ; - ei_pre: FStarC_Reflection_Types.term FStar_Pervasives_Native.option ; - ei_post: FStarC_Reflection_Types.term FStar_Pervasives_Native.option } -let (__proj__Mkeffect_info__item__ei_type : - effect_info -> FStar_InteractiveHelpers_ExploreTerm.effect_type) = - fun projectee -> - match projectee with - | { ei_type; ei_ret_type; ei_pre; ei_post;_} -> ei_type -let (__proj__Mkeffect_info__item__ei_ret_type : - effect_info -> FStar_InteractiveHelpers_ExploreTerm.type_info) = - fun projectee -> - match projectee with - | { ei_type; ei_ret_type; ei_pre; ei_post;_} -> ei_ret_type -let (__proj__Mkeffect_info__item__ei_pre : - effect_info -> FStarC_Reflection_Types.term FStar_Pervasives_Native.option) - = - fun projectee -> - match projectee with - | { ei_type; ei_ret_type; ei_pre; ei_post;_} -> ei_pre -let (__proj__Mkeffect_info__item__ei_post : - effect_info -> FStarC_Reflection_Types.term FStar_Pervasives_Native.option) - = - fun projectee -> - match projectee with - | { ei_type; ei_ret_type; ei_pre; ei_post;_} -> ei_post -let (mk_effect_info : - FStar_InteractiveHelpers_ExploreTerm.effect_type -> - FStar_InteractiveHelpers_ExploreTerm.type_info -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - effect_info) - = - fun uu___ -> - fun uu___1 -> - fun uu___2 -> - fun uu___3 -> - { - ei_type = uu___; - ei_ret_type = uu___1; - ei_pre = uu___2; - ei_post = uu___3 - } -let (effect_info_to_string : - effect_info -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun c -> - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string c.ei_pre in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (52)) (Prims.of_int (2)) - (Prims.of_int (52)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (52)) (Prims.of_int (2)) - (Prims.of_int (54)) (Prims.of_int (49))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = - let uu___6 = - let uu___7 = - FStar_InteractiveHelpers_ExploreTerm.type_info_to_string - c.ei_ret_type in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (53)) (Prims.of_int (2)) - (Prims.of_int (53)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (53)) (Prims.of_int (2)) - (Prims.of_int (54)) (Prims.of_int (49))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - let uu___9 = - let uu___10 = - let uu___11 = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - c.ei_post in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (54)) - (Prims.of_int (2)) - (Prims.of_int (54)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___11) - (fun uu___12 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___13 -> - Prims.strcat uu___12 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (54)) - (Prims.of_int (2)) - (Prims.of_int (54)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___10) - (fun uu___11 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___12 -> - Prims.strcat ") (" uu___11)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (53)) - (Prims.of_int (38)) - (Prims.of_int (54)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> - Prims.strcat uu___8 uu___10)))) - uu___8) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (53)) (Prims.of_int (2)) - (Prims.of_int (54)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> Prims.strcat ") (" uu___7)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (52)) (Prims.of_int (45)) - (Prims.of_int (54)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> Prims.strcat uu___4 uu___6)))) - uu___4) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (52)) (Prims.of_int (2)) (Prims.of_int (54)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat " (" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (51)) (Prims.of_int (36)) (Prims.of_int (54)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - (FStar_InteractiveHelpers_ExploreTerm.effect_type_to_string - c.ei_type) uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (51)) (Prims.of_int (2)) (Prims.of_int (54)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "Mkeffect_info " uu___1)) -type eterm_info = - { - einfo: effect_info ; - head: FStarC_Reflection_Types.term ; - parameters: cast_info Prims.list } -let (__proj__Mketerm_info__item__einfo : eterm_info -> effect_info) = - fun projectee -> - match projectee with | { einfo; head; parameters;_} -> einfo -let (__proj__Mketerm_info__item__head : - eterm_info -> FStarC_Reflection_Types.term) = - fun projectee -> - match projectee with | { einfo; head; parameters;_} -> head -let (__proj__Mketerm_info__item__parameters : - eterm_info -> cast_info Prims.list) = - fun projectee -> - match projectee with | { einfo; head; parameters;_} -> parameters -let (eterm_info_to_string : - eterm_info -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun info -> - let uu___ = - FStar_Tactics_Util.map - (fun x -> - let uu___1 = - let uu___2 = cast_info_to_string x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (66)) (Prims.of_int (35)) - (Prims.of_int (66)) (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat uu___3 "); \n")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (66)) (Prims.of_int (35)) - (Prims.of_int (66)) (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> Prims.strcat "(" uu___2))) info.parameters in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (66)) (Prims.of_int (15)) (Prims.of_int (66)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (66)) (Prims.of_int (87)) (Prims.of_int (71)) - (Prims.of_int (18))))) (Obj.magic uu___) - (fun uu___1 -> - (fun params -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_List_Tot_Base.fold_left - (fun x -> fun y -> Prims.strcat x y) "" params)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (67)) (Prims.of_int (19)) - (Prims.of_int (67)) (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (68)) (Prims.of_int (2)) - (Prims.of_int (71)) (Prims.of_int (18))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun params_str -> - let uu___2 = - let uu___3 = effect_info_to_string info.einfo in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (69)) (Prims.of_int (2)) - (Prims.of_int (69)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (69)) (Prims.of_int (2)) - (Prims.of_int (71)) (Prims.of_int (18))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = - let uu___6 = - let uu___7 = - FStarC_Tactics_V1_Builtins.term_to_string - info.head in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (70)) - (Prims.of_int (2)) - (Prims.of_int (70)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat uu___8 - (Prims.strcat ")\n[" - (Prims.strcat params_str - "]")))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (70)) - (Prims.of_int (2)) - (Prims.of_int (71)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat ") (" uu___7)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (69)) - (Prims.of_int (37)) - (Prims.of_int (71)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat uu___4 uu___6)))) - uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (69)) (Prims.of_int (2)) - (Prims.of_int (71)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat "Mketerm_info (" uu___3)))) - uu___2))) uu___1) -let (mk_eterm_info : - effect_info -> - FStarC_Reflection_Types.term -> cast_info Prims.list -> eterm_info) - = - fun uu___ -> - fun uu___1 -> - fun uu___2 -> { einfo = uu___; head = uu___1; parameters = uu___2 } -let rec (decompose_application_aux : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - ((FStarC_Reflection_Types.term * cast_info Prims.list), unit) - FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (83)) (Prims.of_int (8)) (Prims.of_int (83)) - (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (83)) (Prims.of_int (2)) (Prims.of_int (101)) - (Prims.of_int (14))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_App (hd, (a, qualif)) -> - Obj.magic - (Obj.repr - (let uu___2 = decompose_application_aux e hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (85)) (Prims.of_int (22)) - (Prims.of_int (85)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (84)) (Prims.of_int (28)) - (Prims.of_int (100)) (Prims.of_int (28))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (hd0, params) -> - let uu___4 = - FStar_InteractiveHelpers_ExploreTerm.get_type_info - e a in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (87)) - (Prims.of_int (17)) - (Prims.of_int (87)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (87)) - (Prims.of_int (37)) - (Prims.of_int (100)) - (Prims.of_int (28))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun a_type -> - let uu___5 = - FStar_InteractiveHelpers_ExploreTerm.safe_tc - e hd in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (89)) - (Prims.of_int (16)) - (Prims.of_int (89)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (89)) - (Prims.of_int (31)) - (Prims.of_int (100)) - (Prims.of_int (28))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun hd_ty -> - let uu___6 = - match hd_ty with - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - FStar_Pervasives_Native.None))) - | FStar_Pervasives_Native.Some - hd_ty' -> - Obj.magic - (Obj.repr - (let uu___7 - = - FStarC_Tactics_V1_Builtins.inspect - hd_ty' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (94)) - (Prims.of_int (14)) - (Prims.of_int (94)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (94)) - (Prims.of_int (8)) - (Prims.of_int (97)) - (Prims.of_int (19))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - match uu___8 - with - | - FStarC_Reflection_V1_Data.Tv_Arrow - (b, c) -> - Obj.magic - (Obj.repr - (let uu___9 - = - let uu___10 - = - FStar_Tactics_V1_Derived.binder_sort - b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (96)) - (Prims.of_int (40)) - (Prims.of_int (96)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (96)) - (Prims.of_int (15)) - (Prims.of_int (96)) - (Prims.of_int (56))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - Obj.magic - (FStar_InteractiveHelpers_ExploreTerm.get_type_info_from_type - uu___11)) - uu___11) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (96)) - (Prims.of_int (15)) - (Prims.of_int (96)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (96)) - (Prims.of_int (10)) - (Prims.of_int (96)) - (Prims.of_int (56))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - FStar_Pervasives_Native.Some - uu___10)))) - | - uu___9 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - FStar_Pervasives_Native.None)))) - uu___8))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (91)) - (Prims.of_int (6)) - (Prims.of_int (97)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (100)) - (Prims.of_int (4)) - (Prims.of_int (100)) - (Prims.of_int (28))))) - (Obj.magic - uu___6) - (fun - param_type - -> - FStar_Tactics_Effect.lift_div_tac - ( - fun - uu___7 -> - (hd0, - ((mk_cast_info - a a_type - param_type) - :: - params)))))) - uu___6))) uu___5))) - uu___3))) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> (t, []))))) uu___1) -let (decompose_application : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - ((FStarC_Reflection_Types.term * cast_info Prims.list), unit) - FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - let uu___ = decompose_application_aux e t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (105)) (Prims.of_int (19)) - (Prims.of_int (105)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (104)) (Prims.of_int (31)) - (Prims.of_int (106)) (Prims.of_int (25))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | (hd, params) -> (hd, (FStar_List_Tot_Base.rev params)))) -let (comp_view_to_effect_info : - Prims.bool -> - FStarC_Reflection_V1_Data.comp_view -> - (effect_info FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun cv -> - match cv with - | FStarC_Reflection_V1_Data.C_Total ret_ty -> - let uu___ = - FStar_InteractiveHelpers_ExploreTerm.get_type_info_from_type - ret_ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (114)) (Prims.of_int (24)) - (Prims.of_int (114)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (115)) (Prims.of_int (4)) - (Prims.of_int (115)) (Prims.of_int (57))))) - (Obj.magic uu___) - (fun ret_type_info -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Pervasives_Native.Some - (mk_effect_info - FStar_InteractiveHelpers_ExploreTerm.E_Total - ret_type_info FStar_Pervasives_Native.None - FStar_Pervasives_Native.None))) - | FStarC_Reflection_V1_Data.C_GTotal ret_ty -> - let uu___ = - FStar_InteractiveHelpers_ExploreTerm.get_type_info_from_type - ret_ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (117)) (Prims.of_int (24)) - (Prims.of_int (117)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (118)) (Prims.of_int (4)) - (Prims.of_int (118)) (Prims.of_int (57))))) - (Obj.magic uu___) - (fun ret_type_info -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Pervasives_Native.Some - (mk_effect_info - FStar_InteractiveHelpers_ExploreTerm.E_Total - ret_type_info FStar_Pervasives_Native.None - FStar_Pervasives_Native.None))) - | FStarC_Reflection_V1_Data.C_Lemma (pre, post, patterns) -> - let uu___ = FStar_InteractiveHelpers_Base.prettify_term dbg pre in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (121)) (Prims.of_int (14)) - (Prims.of_int (121)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (121)) (Prims.of_int (38)) - (Prims.of_int (123)) (Prims.of_int (71))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun pre1 -> - let uu___1 = - FStar_InteractiveHelpers_Base.prettify_term dbg post in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (122)) (Prims.of_int (15)) - (Prims.of_int (122)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (123)) (Prims.of_int (4)) - (Prims.of_int (123)) (Prims.of_int (71))))) - (Obj.magic uu___1) - (fun post1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Pervasives_Native.Some - (mk_effect_info - FStar_InteractiveHelpers_ExploreTerm.E_Lemma - FStar_InteractiveHelpers_ExploreTerm.unit_type_info - (FStar_Pervasives_Native.Some pre1) - (FStar_Pervasives_Native.Some post1)))))) - uu___1) - | FStarC_Reflection_V1_Data.C_Eff - (univs, eff_name, ret_ty, eff_args, uu___) -> - let uu___1 = - FStar_InteractiveHelpers_Base.print_dbg dbg - (Prims.strcat "comp_view_to_effect_info: C_Eff " - (FStar_Reflection_V1_Derived.flatten_name eff_name)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (125)) (Prims.of_int (4)) - (Prims.of_int (125)) (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (125)) (Prims.of_int (79)) - (Prims.of_int (142)) (Prims.of_int (7))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - FStar_InteractiveHelpers_ExploreTerm.get_type_info_from_type - ret_ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (126)) (Prims.of_int (24)) - (Prims.of_int (126)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (126)) (Prims.of_int (57)) - (Prims.of_int (142)) (Prims.of_int (7))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun ret_type_info -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_InteractiveHelpers_ExploreTerm.effect_name_to_type - eff_name)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (127)) - (Prims.of_int (16)) - (Prims.of_int (127)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (127)) - (Prims.of_int (47)) - (Prims.of_int (142)) - (Prims.of_int (7))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun etype -> - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - mk_effect_info etype - ret_type_info)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (128)) - (Prims.of_int (17)) - (Prims.of_int (128)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (128)) - (Prims.of_int (54)) - (Prims.of_int (142)) - (Prims.of_int (7))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun mk_res -> - let uu___6 = - FStar_Tactics_Util.map - (fun uu___7 -> - match uu___7 with - | (x, a) -> - let uu___8 = - FStar_InteractiveHelpers_Base.prettify_term - dbg x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (129)) - (Prims.of_int (38)) - (Prims.of_int (129)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (129)) - (Prims.of_int (37)) - (Prims.of_int (129)) - (Prims.of_int (61))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (uu___9, - a)))) - eff_args in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (129)) - (Prims.of_int (19)) - (Prims.of_int (129)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (130)) - (Prims.of_int (10)) - (Prims.of_int (141)) - (Prims.of_int (15))))) - (Obj.magic uu___6) - (fun eff_args1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - match - (etype, - eff_args1) - with - | (FStar_InteractiveHelpers_ExploreTerm.E_PURE, - (pre, - uu___8)::[]) - -> - FStar_Pervasives_Native.Some - (mk_res - (FStar_Pervasives_Native.Some - pre) - FStar_Pervasives_Native.None) - | (FStar_InteractiveHelpers_ExploreTerm.E_Pure, - (pre, - uu___8):: - (post, - uu___9)::[]) - -> - FStar_Pervasives_Native.Some - (mk_res - (FStar_Pervasives_Native.Some - pre) - (FStar_Pervasives_Native.Some - post)) - | (FStar_InteractiveHelpers_ExploreTerm.E_Stack, - (pre, - uu___8):: - (post, - uu___9)::[]) - -> - FStar_Pervasives_Native.Some - (mk_res - (FStar_Pervasives_Native.Some - pre) - (FStar_Pervasives_Native.Some - post)) - | (FStar_InteractiveHelpers_ExploreTerm.E_ST, - (pre, - uu___8):: - (post, - uu___9)::[]) - -> - FStar_Pervasives_Native.Some - (mk_res - (FStar_Pervasives_Native.Some - pre) - (FStar_Pervasives_Native.Some - post)) - | (FStar_InteractiveHelpers_ExploreTerm.E_Unknown, - []) -> - FStar_Pervasives_Native.Some - (mk_res - FStar_Pervasives_Native.None - FStar_Pervasives_Native.None) - | (FStar_InteractiveHelpers_ExploreTerm.E_Unknown, - (pre, - uu___8)::[]) - -> - FStar_Pervasives_Native.Some - (mk_res - (FStar_Pervasives_Native.Some - pre) - FStar_Pervasives_Native.None) - | (FStar_InteractiveHelpers_ExploreTerm.E_Unknown, - (pre, - uu___8):: - (post, - uu___9)::[]) - -> - FStar_Pervasives_Native.Some - (mk_res - (FStar_Pervasives_Native.Some - pre) - (FStar_Pervasives_Native.Some - post)) - | uu___8 -> - FStar_Pervasives_Native.None)))) - uu___6))) uu___5))) uu___4))) - uu___2) -let (comp_to_effect_info : - Prims.bool -> - FStarC_Reflection_Types.comp -> - (effect_info FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun c -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStarC_Reflection_V1_Builtins.inspect_comp c)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (147)) (Prims.of_int (23)) - (Prims.of_int (147)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (148)) (Prims.of_int (2)) (Prims.of_int (148)) - (Prims.of_int (33))))) (Obj.magic uu___) - (fun uu___1 -> - (fun cv -> Obj.magic (comp_view_to_effect_info dbg cv)) uu___1) -let (compute_effect_info : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (effect_info FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun tm -> - let uu___ = FStar_InteractiveHelpers_ExploreTerm.safe_tcc e tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (153)) (Prims.of_int (8)) - (Prims.of_int (153)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (153)) (Prims.of_int (2)) - (Prims.of_int (155)) (Prims.of_int (16))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.Some c -> - Obj.magic (Obj.repr (comp_to_effect_info dbg c)) - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> FStar_Pervasives_Native.None)))) - uu___1) -let (typ_or_comp_to_effect_info : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStar_InteractiveHelpers_ExploreTerm.typ_or_comp -> - (effect_info, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge -> - fun c -> - let uu___ = - FStar_InteractiveHelpers_ExploreTerm.flush_typ_or_comp dbg - ge.FStar_InteractiveHelpers_Base.env c in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (170)) (Prims.of_int (10)) - (Prims.of_int (170)) (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (171)) (Prims.of_int (2)) - (Prims.of_int (179)) (Prims.of_int (25))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun c1 -> - match c1 with - | FStar_InteractiveHelpers_ExploreTerm.TC_Typ - (ty, uu___1, uu___2) -> - let uu___3 = - FStar_InteractiveHelpers_ExploreTerm.get_type_info_from_type - ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (173)) (Prims.of_int (16)) - (Prims.of_int (173)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (174)) (Prims.of_int (4)) - (Prims.of_int (174)) (Prims.of_int (42))))) - (Obj.magic uu___3) - (fun tinfo -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - mk_effect_info - FStar_InteractiveHelpers_ExploreTerm.E_Total - tinfo FStar_Pervasives_Native.None - FStar_Pervasives_Native.None))) - | FStar_InteractiveHelpers_ExploreTerm.TC_Comp - (cv, uu___1, uu___2) -> - let uu___3 = comp_to_effect_info dbg cv in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (176)) (Prims.of_int (20)) - (Prims.of_int (176)) (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (177)) (Prims.of_int (4)) - (Prims.of_int (179)) (Prims.of_int (25))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun opt_einfo -> - match opt_einfo with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (let uu___4 = - let uu___5 = - FStar_InteractiveHelpers_Base.acomp_to_string - cv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (178)) - (Prims.of_int (64)) - (Prims.of_int (178)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat - "typ_or_comp_to_effect_info failed on: " - uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (178)) - (Prims.of_int (20)) - (Prims.of_int (178)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (178)) - (Prims.of_int (14)) - (Prims.of_int (178)) - (Prims.of_int (83))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___5)) uu___5))) - | FStar_Pervasives_Native.Some einfo -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> einfo)))) uu___4))) - uu___1) -let (tcc_no_lift : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (192)) (Prims.of_int (8)) (Prims.of_int (192)) - (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (192)) (Prims.of_int (2)) (Prims.of_int (199)) - (Prims.of_int (11))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_App (uu___2, uu___3) -> - let uu___4 = FStar_Tactics_V1_SyntaxHelpers.collect_app t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (194)) (Prims.of_int (19)) - (Prims.of_int (194)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (193)) (Prims.of_int (17)) - (Prims.of_int (196)) (Prims.of_int (41))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | (hd, args) -> - let uu___6 = - FStarC_Tactics_V1_Builtins.tcc e hd in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (195)) - (Prims.of_int (12)) - (Prims.of_int (195)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (196)) - (Prims.of_int (4)) - (Prims.of_int (196)) - (Prims.of_int (41))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun c -> - Obj.magic - (FStar_InteractiveHelpers_ExploreTerm.inst_comp - e c - (FStar_List_Tot_Base.map - FStar_Pervasives_Native.fst - args))) uu___7))) uu___5)) - | uu___2 -> Obj.magic (FStarC_Tactics_V1_Builtins.tcc e t)) - uu___1) -let (compute_eterm_info : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (eterm_info, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun t -> - let uu___ = decompose_application e t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (207)) (Prims.of_int (23)) - (Prims.of_int (207)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (205)) (Prims.of_int (58)) - (Prims.of_int (220)) (Prims.of_int (16))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (hd, parameters) -> - Obj.magic - (FStar_Tactics_V1_Derived.try_with - (fun uu___2 -> - match () with - | () -> - let uu___3 = tcc_no_lift e t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (210)) - (Prims.of_int (19)) - (Prims.of_int (210)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (210)) - (Prims.of_int (37)) - (Prims.of_int (215)) - (Prims.of_int (39))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun c -> - let uu___4 = - comp_to_effect_info dbg c in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (211)) - (Prims.of_int (20)) - (Prims.of_int (211)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (212)) - (Prims.of_int (4)) - (Prims.of_int (215)) - (Prims.of_int (39))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun opt_einfo -> - match opt_einfo with - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (let uu___5 = - let uu___6 = - FStarC_Tactics_V1_Builtins.term_to_string - t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (213)) - (Prims.of_int (57)) - (Prims.of_int (213)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___6) - (fun uu___7 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - Prims.strcat - "compute_eterm_info: failed on: " - uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (213)) - (Prims.of_int (20)) - (Prims.of_int (213)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (213)) - (Prims.of_int (14)) - (Prims.of_int (213)) - (Prims.of_int (74))))) - (Obj.magic - uu___5) - (fun uu___6 -> - (fun uu___6 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___6)) - uu___6))) - | FStar_Pervasives_Native.Some - einfo -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - mk_eterm_info - einfo hd - parameters)))) - uu___5))) uu___4)) - (fun uu___2 -> - (fun uu___2 -> - match uu___2 with - | FStarC_Tactics_Common.TacticFailure - (msg, uu___3) -> - Obj.magic - (Obj.repr - (FStar_InteractiveHelpers_Base.mfail_doc - (FStar_List_Tot_Base.op_At - [FStar_Pprint.arbitrary_string - "compute_eterm_info: failure"] - msg))) - | e1 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.raise e1))) - uu___2))) uu___1) -let (has_refinement : - FStar_InteractiveHelpers_ExploreTerm.type_info -> Prims.bool) = - fun ty -> - FStar_Pervasives_Native.uu___is_Some - ty.FStar_InteractiveHelpers_ExploreTerm.refin -let (get_refinement : - FStar_InteractiveHelpers_ExploreTerm.type_info -> - FStarC_Reflection_Types.term) - = - fun ty -> - FStar_Pervasives_Native.__proj__Some__item__v - ty.FStar_InteractiveHelpers_ExploreTerm.refin -let (get_opt_refinment : - FStar_InteractiveHelpers_ExploreTerm.type_info -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option) - = fun ty -> ty.FStar_InteractiveHelpers_ExploreTerm.refin -let (get_rawest_type : - FStar_InteractiveHelpers_ExploreTerm.type_info -> - FStarC_Reflection_Types.typ) - = fun ty -> ty.FStar_InteractiveHelpers_ExploreTerm.ty -type type_comparison = - | Refines - | Same_raw_type - | Unknown -let (uu___is_Refines : type_comparison -> Prims.bool) = - fun projectee -> match projectee with | Refines -> true | uu___ -> false -let (uu___is_Same_raw_type : type_comparison -> Prims.bool) = - fun projectee -> - match projectee with | Same_raw_type -> true | uu___ -> false -let (uu___is_Unknown : type_comparison -> Prims.bool) = - fun projectee -> match projectee with | Unknown -> true | uu___ -> false -let (type_comparison_to_string : type_comparison -> Prims.string) = - fun c -> - match c with - | Refines -> "Refines" - | Same_raw_type -> "Same_raw_type" - | Unknown -> "Unknown" -let (compare_types : - Prims.bool -> - FStar_InteractiveHelpers_ExploreTerm.type_info -> - FStar_InteractiveHelpers_ExploreTerm.type_info -> - (type_comparison, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun info1 -> - fun info2 -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg "[> compare_types" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (252)) (Prims.of_int (2)) - (Prims.of_int (252)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (253)) (Prims.of_int (2)) - (Prims.of_int (276)) (Prims.of_int (13))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - if - term_eq info1.FStar_InteractiveHelpers_ExploreTerm.ty - info2.FStar_InteractiveHelpers_ExploreTerm.ty - then - let uu___2 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "-> types are equal" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (254)) (Prims.of_int (14)) - (Prims.of_int (254)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (255)) (Prims.of_int (6)) - (Prims.of_int (273)) (Prims.of_int (15))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - if has_refinement info2 - then - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "-> 2nd type has refinement" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (256)) - (Prims.of_int (16)) - (Prims.of_int (256)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (259)) - (Prims.of_int (8)) - (Prims.of_int (270)) - (Prims.of_int (23))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - if has_refinement info1 - then - let uu___6 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "-> 1st type has refinement" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (260)) - (Prims.of_int (18)) - (Prims.of_int (260)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (261)) - (Prims.of_int (10)) - (Prims.of_int (266)) - (Prims.of_int (23))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - if - term_eq - (get_refinement - info1) - (get_refinement - info2) - then - let uu___8 = - FStar_InteractiveHelpers_Base.print_dbg - dbg "-> Refines" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (262)) - (Prims.of_int (20)) - (Prims.of_int (262)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (263)) - (Prims.of_int (12)) - (Prims.of_int (263)) - (Prims.of_int (19))))) - (Obj.magic - uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - Refines))) - else - (let uu___9 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "-> Same_raw_type" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (265)) - (Prims.of_int (18)) - (Prims.of_int (265)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (266)) - (Prims.of_int (10)) - (Prims.of_int (266)) - (Prims.of_int (23))))) - (Obj.magic - uu___9) - (fun uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - ( - fun - uu___11 - -> - Same_raw_type))))) - uu___7)) - else - (let uu___7 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "-> 1st type has no refinement" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (268)) - (Prims.of_int (18)) - (Prims.of_int (268)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (268)) - (Prims.of_int (66)) - (Prims.of_int (270)) - (Prims.of_int (23))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - let uu___9 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "-> Same_raw_type" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (269)) - (Prims.of_int (18)) - (Prims.of_int (269)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (270)) - (Prims.of_int (10)) - (Prims.of_int (270)) - (Prims.of_int (23))))) - (Obj.magic - uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Same_raw_type)))) - uu___8)))) uu___5)) - else - (let uu___5 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "-> 2nd type has no refinement: Refines" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (272)) - (Prims.of_int (16)) - (Prims.of_int (272)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (273)) - (Prims.of_int (8)) - (Prims.of_int (273)) - (Prims.of_int (15))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> Refines))))) uu___3)) - else - (let uu___3 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "types are not equal" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (275)) (Prims.of_int (14)) - (Prims.of_int (275)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (276)) (Prims.of_int (6)) - (Prims.of_int (276)) (Prims.of_int (13))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Unknown))))) uu___1) -let (compare_cast_types : - Prims.bool -> - cast_info -> (type_comparison, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun p -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg "[> compare_cast_types" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (282)) (Prims.of_int (2)) (Prims.of_int (282)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (283)) (Prims.of_int (2)) (Prims.of_int (286)) - (Prims.of_int (16))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match ((p.p_ty), (p.exp_ty)) with - | (FStar_Pervasives_Native.Some info1, - FStar_Pervasives_Native.Some info2) -> - Obj.magic (Obj.repr (compare_types dbg info1 info2)) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> Unknown)))) uu___1) -let (mk_has_type : - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.typ -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___1 -> - fun uu___ -> - (fun t -> - fun ty -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Reflection_V1_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "has_type"]))) - [(ty, FStarC_Reflection_V1_Data.Q_Implicit); - (t, FStarC_Reflection_V1_Data.Q_Explicit); - (ty, FStarC_Reflection_V1_Data.Q_Explicit)]))) uu___1 - uu___ -let (cast_info_to_propositions : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - cast_info -> - (FStar_InteractiveHelpers_Propositions.proposition Prims.list, - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge -> - fun ci -> - let uu___ = - let uu___1 = - let uu___2 = cast_info_to_string ci in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (313)) (Prims.of_int (53)) - (Prims.of_int (313)) (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat "[> cast_info_to_propositions:\n" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (313)) (Prims.of_int (16)) - (Prims.of_int (313)) (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (313)) (Prims.of_int (2)) - (Prims.of_int (313)) (Prims.of_int (76))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___2)) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (313)) (Prims.of_int (2)) - (Prims.of_int (313)) (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (314)) (Prims.of_int (2)) - (Prims.of_int (341)) (Prims.of_int (13))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = compare_cast_types dbg ci in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (314)) (Prims.of_int (8)) - (Prims.of_int (314)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (314)) (Prims.of_int (2)) - (Prims.of_int (341)) (Prims.of_int (13))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | Refines -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "-> Comparison result: Refines" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (316)) - (Prims.of_int (4)) - (Prims.of_int (316)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (317)) - (Prims.of_int (4)) - (Prims.of_int (317)) - (Prims.of_int (6))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> []))) - | Same_raw_type -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "-> Comparison result: Same_raw_type" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (319)) - (Prims.of_int (4)) - (Prims.of_int (319)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (319)) - (Prims.of_int (58)) - (Prims.of_int (322)) - (Prims.of_int (16))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - get_refinement - (FStar_Pervasives_Native.__proj__Some__item__v - ci.exp_ty))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (320)) - (Prims.of_int (16)) - (Prims.of_int (320)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (320)) - (Prims.of_int (53)) - (Prims.of_int (322)) - (Prims.of_int (16))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun refin -> - let uu___7 = - FStar_InteractiveHelpers_Base.mk_app_norm - ge.FStar_InteractiveHelpers_Base.env - refin [ci.term] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (321)) - (Prims.of_int (21)) - (Prims.of_int (321)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (322)) - (Prims.of_int (4)) - (Prims.of_int (322)) - (Prims.of_int (16))))) - (Obj.magic uu___7) - (fun inst_refin -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - [inst_refin])))) - uu___7))) uu___5)) - | Unknown -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "-> Comparison result: Unknown" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (324)) - (Prims.of_int (4)) - (Prims.of_int (324)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (325)) - (Prims.of_int (4)) - (Prims.of_int (341)) - (Prims.of_int (13))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match ((ci.p_ty), (ci.exp_ty)) with - | (FStar_Pervasives_Native.Some - p_ty, - FStar_Pervasives_Native.Some - e_ty) -> - Obj.magic - (Obj.repr - (let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - get_rawest_type - p_ty)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (327)) - (Prims.of_int (18)) - (Prims.of_int (327)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (327)) - (Prims.of_int (41)) - (Prims.of_int (340)) - (Prims.of_int (41))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun p_rty -> - let uu___7 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - get_rawest_type - e_ty)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (328)) - (Prims.of_int (18)) - (Prims.of_int (328)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (328)) - (Prims.of_int (41)) - (Prims.of_int (340)) - (Prims.of_int (41))))) - (Obj.magic - uu___7) - (fun uu___8 - -> - (fun - e_rty -> - let uu___8 - = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_AscribedT - ((ci.term), - p_rty, - FStar_Pervasives_Native.None, - false)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (335)) - (Prims.of_int (22)) - (Prims.of_int (335)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (335)) - (Prims.of_int (69)) - (Prims.of_int (340)) - (Prims.of_int (41))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - ascr_term - -> - let uu___9 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - [ - (p_rty, - FStarC_Reflection_V1_Data.Q_Implicit); - (ascr_term, - FStarC_Reflection_V1_Data.Q_Explicit); - (e_rty, - FStarC_Reflection_V1_Data.Q_Explicit)])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (336)) - (Prims.of_int (28)) - (Prims.of_int (336)) - (Prims.of_int (95))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (336)) - (Prims.of_int (98)) - (Prims.of_int (340)) - (Prims.of_int (41))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - has_type_params - -> - let uu___10 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - FStar_Reflection_V1_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "has_type"]))) - has_type_params)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (337)) - (Prims.of_int (22)) - (Prims.of_int (337)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (337)) - (Prims.of_int (59)) - (Prims.of_int (340)) - (Prims.of_int (41))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - type_cast - -> - let uu___11 - = - FStar_InteractiveHelpers_Base.opt_mk_app_norm - ge.FStar_InteractiveHelpers_Base.env - e_ty.FStar_InteractiveHelpers_ExploreTerm.refin - [ci.term] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (339)) - (Prims.of_int (27)) - (Prims.of_int (339)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (340)) - (Prims.of_int (6)) - (Prims.of_int (340)) - (Prims.of_int (41))))) - (Obj.magic - uu___11) - (fun - inst_opt_refin - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - FStar_InteractiveHelpers_Base.opt_cons - inst_opt_refin - [type_cast])))) - uu___11))) - uu___10))) - uu___9))) - uu___8))) - uu___7))) - | uu___6 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> [])))) - uu___5))) uu___3))) uu___1) -let (cast_info_list_to_propositions : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - cast_info Prims.list -> - (FStar_InteractiveHelpers_Propositions.proposition Prims.list, - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge -> - fun ls -> - let uu___ = - FStar_Tactics_Util.map (cast_info_to_propositions dbg ge) ls in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (348)) (Prims.of_int (12)) - (Prims.of_int (348)) (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (349)) (Prims.of_int (2)) - (Prims.of_int (349)) (Prims.of_int (13))))) - (Obj.magic uu___) - (fun lsl1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStar_List_Tot_Base.flatten lsl1)) -type pre_post_type = - | PP_Unknown - | PP_Pure - | PP_State of FStarC_Reflection_Types.term -let (uu___is_PP_Unknown : pre_post_type -> Prims.bool) = - fun projectee -> match projectee with | PP_Unknown -> true | uu___ -> false -let (uu___is_PP_Pure : pre_post_type -> Prims.bool) = - fun projectee -> match projectee with | PP_Pure -> true | uu___ -> false -let (uu___is_PP_State : pre_post_type -> Prims.bool) = - fun projectee -> - match projectee with | PP_State state_type -> true | uu___ -> false -let (__proj__PP_State__item__state_type : - pre_post_type -> FStarC_Reflection_Types.term) = - fun projectee -> match projectee with | PP_State state_type -> state_type -let (compute_pre_type : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (pre_post_type, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun pre -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg "[> compute_pre_type" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (367)) (Prims.of_int (2)) - (Prims.of_int (367)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (368)) (Prims.of_int (2)) - (Prims.of_int (385)) (Prims.of_int (16))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - FStar_InteractiveHelpers_ExploreTerm.safe_tc e pre in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (368)) (Prims.of_int (8)) - (Prims.of_int (368)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (368)) (Prims.of_int (2)) - (Prims.of_int (385)) (Prims.of_int (16))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStar_Pervasives_Native.None -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "safe_tc failed" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (370)) - (Prims.of_int (4)) - (Prims.of_int (370)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (371)) - (Prims.of_int (4)) - (Prims.of_int (371)) - (Prims.of_int (14))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> PP_Unknown))) - | FStar_Pervasives_Native.Some ty -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "safe_tc succeeded" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (373)) - (Prims.of_int (4)) - (Prims.of_int (373)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (373)) - (Prims.of_int (38)) - (Prims.of_int (385)) - (Prims.of_int (16))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - FStar_Tactics_V1_SyntaxHelpers.collect_arr_bs - ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (374)) - (Prims.of_int (17)) - (Prims.of_int (374)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (373)) - (Prims.of_int (38)) - (Prims.of_int (385)) - (Prims.of_int (16))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - match uu___7 with - | (brs, c) -> - let uu___8 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - (Prims.strcat - "num binders: " - (Prims.string_of_int - (FStar_List_Tot_Base.length - brs))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (375)) - (Prims.of_int (4)) - (Prims.of_int (375)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (376)) - (Prims.of_int (4)) - (Prims.of_int (385)) - (Prims.of_int (16))))) - (Obj.magic - uu___8) - (fun uu___9 -> - (fun uu___9 - -> - match - (brs, - (FStar_InteractiveHelpers_ExploreTerm.is_total_or_gtotal - c)) - with - | - ([], - true) -> - let uu___10 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "PP_Pure" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (378)) - (Prims.of_int (6)) - (Prims.of_int (378)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (379)) - (Prims.of_int (6)) - (Prims.of_int (379)) - (Prims.of_int (13))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - PP_Pure))) - | - (b::[], - true) -> - let uu___10 - = - let uu___11 - = - let uu___12 - = - FStarC_Tactics_V1_Builtins.term_to_string - (FStar_Reflection_V1_Derived.type_of_binder - b) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (381)) - (Prims.of_int (35)) - (Prims.of_int (381)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - Prims.strcat - "PP_State " - uu___13)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (381)) - (Prims.of_int (20)) - (Prims.of_int (381)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (381)) - (Prims.of_int (6)) - (Prims.of_int (381)) - (Prims.of_int (71))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___12)) - uu___12) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (381)) - (Prims.of_int (6)) - (Prims.of_int (381)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (382)) - (Prims.of_int (6)) - (Prims.of_int (382)) - (Prims.of_int (33))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - PP_State - (FStar_Reflection_V1_Derived.type_of_binder - b)))) - | - uu___10 - -> - let uu___11 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "PP_Unknown" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (384)) - (Prims.of_int (6)) - (Prims.of_int (384)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (385)) - (Prims.of_int (6)) - (Prims.of_int (385)) - (Prims.of_int (16))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - PP_Unknown)))) - uu___9))) - uu___7))) uu___5))) - uu___3))) uu___1) -let (opt_remove_refin : - FStarC_Reflection_Types.typ -> - (FStarC_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) - = - fun ty -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (389)) (Prims.of_int (8)) (Prims.of_int (389)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (389)) (Prims.of_int (2)) (Prims.of_int (391)) - (Prims.of_int (11))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_Refine (uu___3, sort, uu___4) -> - sort - | uu___3 -> ty)) -let (compute_post_type : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - (pre_post_type, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun ret_type -> - fun post -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> compute_post_type" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (395)) (Prims.of_int (2)) - (Prims.of_int (395)) (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (395)) (Prims.of_int (39)) - (Prims.of_int (443)) (Prims.of_int (16))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - fun uu___3 -> - (fun uu___3 -> - fun c -> - match FStar_InteractiveHelpers_ExploreTerm.get_total_or_gtotal_ret_type - c - with - | FStar_Pervasives_Native.Some ret_ty -> - Obj.magic - (Obj.repr - (let uu___4 = - FStarC_Tactics_V1_Builtins.inspect - ret_ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (398)) - (Prims.of_int (26)) - (Prims.of_int (398)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (398)) - (Prims.of_int (21)) - (Prims.of_int (398)) - (Prims.of_int (42))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_Pervasives_Native.Some - uu___5)))) - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Pervasives_Native.None)))) - uu___4 uu___3)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (397)) (Prims.of_int (4)) - (Prims.of_int (399)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (401)) (Prims.of_int (2)) - (Prims.of_int (443)) (Prims.of_int (16))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun get_tot_ret_type -> - let uu___3 = - FStar_InteractiveHelpers_ExploreTerm.safe_tc e - post in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (401)) - (Prims.of_int (8)) - (Prims.of_int (401)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (401)) - (Prims.of_int (2)) - (Prims.of_int (443)) - (Prims.of_int (16))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | FStar_Pervasives_Native.None -> - let uu___5 = - FStar_InteractiveHelpers_Base.print_dbg - dbg "safe_tc failed" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (403)) - (Prims.of_int (4)) - (Prims.of_int (403)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (404)) - (Prims.of_int (4)) - (Prims.of_int (404)) - (Prims.of_int (14))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - PP_Unknown))) - | FStar_Pervasives_Native.Some ty -> - let uu___5 = - FStar_InteractiveHelpers_Base.print_dbg - dbg "safe_tc succeeded" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (406)) - (Prims.of_int (4)) - (Prims.of_int (406)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (406)) - (Prims.of_int (38)) - (Prims.of_int (443)) - (Prims.of_int (16))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - FStar_Tactics_V1_SyntaxHelpers.collect_arr_bs - ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (407)) - (Prims.of_int (17)) - (Prims.of_int (407)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (406)) - (Prims.of_int (38)) - (Prims.of_int (443)) - (Prims.of_int (16))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - match uu___8 - with - | (brs, c) - -> - let uu___9 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - (Prims.strcat - "num binders: " - (Prims.string_of_int - (FStar_List_Tot_Base.length - brs))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (408)) - (Prims.of_int (4)) - (Prims.of_int (408)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (409)) - (Prims.of_int (4)) - (Prims.of_int (443)) - (Prims.of_int (16))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - match - (brs, - (FStar_InteractiveHelpers_ExploreTerm.is_total_or_gtotal - c)) - with - | - (r::[], - true) -> - let uu___11 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "PP_Pure" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (412)) - (Prims.of_int (6)) - (Prims.of_int (412)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (413)) - (Prims.of_int (6)) - (Prims.of_int (413)) - (Prims.of_int (13))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - PP_Pure))) - | - (s1::r::s2::[], - true) -> - let uu___11 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - FStar_Reflection_V1_Derived.type_of_binder - r)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (416)) - (Prims.of_int (17)) - (Prims.of_int (416)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (416)) - (Prims.of_int (36)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun r_ty - -> - let uu___12 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - FStar_Reflection_V1_Derived.type_of_binder - s1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (417)) - (Prims.of_int (18)) - (Prims.of_int (417)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (417)) - (Prims.of_int (38)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - s1_ty -> - let uu___13 - = - opt_remove_refin - (FStar_Reflection_V1_Derived.type_of_binder - s2) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (421)) - (Prims.of_int (18)) - (Prims.of_int (421)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (421)) - (Prims.of_int (57)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - s2_ty -> - let uu___14 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - term_eq - ret_type - r_ty)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (422)) - (Prims.of_int (24)) - (Prims.of_int (422)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (422)) - (Prims.of_int (48)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - ret_type_eq - -> - let uu___15 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - term_eq - s1_ty - s2_ty)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (423)) - (Prims.of_int (26)) - (Prims.of_int (423)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (424)) - (Prims.of_int (6)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - state_type_eq - -> - let uu___16 - = - let uu___17 - = - let uu___18 - = - let uu___19 - = - FStarC_Tactics_V1_Builtins.term_to_string - ret_type in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (424)) - (Prims.of_int (50)) - (Prims.of_int (424)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (424)) - (Prims.of_int (50)) - (Prims.of_int (425)) - (Prims.of_int (58))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - (fun - uu___20 - -> - let uu___21 - = - let uu___22 - = - FStarC_Tactics_V1_Builtins.term_to_string - r_ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (425)) - (Prims.of_int (39)) - (Prims.of_int (425)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___22) - (fun - uu___23 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___24 - -> - Prims.strcat - "\n-- binder: " - uu___23)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (425)) - (Prims.of_int (21)) - (Prims.of_int (425)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___21) - (fun - uu___22 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___23 - -> - Prims.strcat - uu___20 - uu___22)))) - uu___20) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (424)) - (Prims.of_int (50)) - (Prims.of_int (425)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - Prims.strcat - "- ret type:\n-- target: " - uu___19)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (424)) - (Prims.of_int (20)) - (Prims.of_int (425)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (424)) - (Prims.of_int (6)) - (Prims.of_int (425)) - (Prims.of_int (59))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - (fun - uu___18 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___18)) - uu___18) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (424)) - (Prims.of_int (6)) - (Prims.of_int (425)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (426)) - (Prims.of_int (6)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - let uu___18 - = - let uu___19 - = - let uu___20 - = - let uu___21 - = - FStarC_Tactics_V1_Builtins.term_to_string - s1_ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (426)) - (Prims.of_int (54)) - (Prims.of_int (426)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (426)) - (Prims.of_int (54)) - (Prims.of_int (427)) - (Prims.of_int (60))))) - (Obj.magic - uu___21) - (fun - uu___22 - -> - (fun - uu___22 - -> - let uu___23 - = - let uu___24 - = - FStarC_Tactics_V1_Builtins.term_to_string - s2_ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (427)) - (Prims.of_int (40)) - (Prims.of_int (427)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___24) - (fun - uu___25 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___26 - -> - Prims.strcat - "\n-- binder2: " - uu___25)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (427)) - (Prims.of_int (21)) - (Prims.of_int (427)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___23) - (fun - uu___24 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___25 - -> - Prims.strcat - uu___22 - uu___24)))) - uu___22) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (426)) - (Prims.of_int (54)) - (Prims.of_int (427)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___22 - -> - Prims.strcat - "- state types:\n-- binder1: " - uu___21)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (426)) - (Prims.of_int (20)) - (Prims.of_int (427)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (426)) - (Prims.of_int (6)) - (Prims.of_int (427)) - (Prims.of_int (61))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - (fun - uu___20 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___20)) - uu___20) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (426)) - (Prims.of_int (6)) - (Prims.of_int (427)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (428)) - (Prims.of_int (6)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - uu___19 - -> - let uu___20 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - (Prims.strcat - "- ret type equality: " - (Prims.string_of_bool - ret_type_eq)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (428)) - (Prims.of_int (6)) - (Prims.of_int (428)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (429)) - (Prims.of_int (6)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - (fun - uu___21 - -> - let uu___22 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - (Prims.strcat - "- state types equality: " - (Prims.string_of_bool - state_type_eq)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (429)) - (Prims.of_int (6)) - (Prims.of_int (429)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (430)) - (Prims.of_int (6)) - (Prims.of_int (440)) - (Prims.of_int (11))))) - (Obj.magic - uu___22) - (fun - uu___23 - -> - (fun - uu___23 - -> - if - ret_type_eq - && - state_type_eq - then - let uu___24 - = - let uu___25 - = - let uu___26 - = - FStarC_Tactics_V1_Builtins.term_to_string - (FStar_Reflection_V1_Derived.type_of_binder - s1) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (433)) - (Prims.of_int (36)) - (Prims.of_int (433)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___26) - (fun - uu___27 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___28 - -> - Prims.strcat - "PP_State" - uu___27)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (433)) - (Prims.of_int (22)) - (Prims.of_int (433)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (433)) - (Prims.of_int (8)) - (Prims.of_int (433)) - (Prims.of_int (71))))) - (Obj.magic - uu___25) - (fun - uu___26 - -> - (fun - uu___26 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___26)) - uu___26) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (433)) - (Prims.of_int (8)) - (Prims.of_int (433)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (434)) - (Prims.of_int (8)) - (Prims.of_int (434)) - (Prims.of_int (36))))) - (Obj.magic - uu___24) - (fun - uu___25 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___26 - -> - PP_State - (FStar_Reflection_V1_Derived.type_of_binder - s1)))) - else - (let uu___25 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "PP_Unknown" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (438)) - (Prims.of_int (8)) - (Prims.of_int (438)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (439)) - (Prims.of_int (8)) - (Prims.of_int (439)) - (Prims.of_int (18))))) - (Obj.magic - uu___25) - (fun - uu___26 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___27 - -> - PP_Unknown))))) - uu___23))) - uu___21))) - uu___19))) - uu___17))) - uu___16))) - uu___15))) - uu___14))) - uu___13))) - uu___12)) - | - uu___11 - -> - let uu___12 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "PP_Unknown" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (442)) - (Prims.of_int (6)) - (Prims.of_int (442)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (443)) - (Prims.of_int (6)) - (Prims.of_int (443)) - (Prims.of_int (16))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - PP_Unknown)))) - uu___10))) - uu___8))) - uu___6))) uu___4))) - uu___3))) uu___1) -let (check_pre_post_type : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - (pre_post_type, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun pre -> - fun ret_type -> - fun post -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> check_pre_post_type" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (447)) (Prims.of_int (2)) - (Prims.of_int (447)) (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (448)) (Prims.of_int (2)) - (Prims.of_int (457)) (Prims.of_int (14))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - let uu___3 = compute_pre_type dbg e pre in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (448)) (Prims.of_int (8)) - (Prims.of_int (448)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (448)) (Prims.of_int (8)) - (Prims.of_int (448)) (Prims.of_int (73))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = - compute_post_type dbg e ret_type post in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (448)) - (Prims.of_int (36)) - (Prims.of_int (448)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (448)) - (Prims.of_int (8)) - (Prims.of_int (448)) - (Prims.of_int (73))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> (uu___4, uu___6))))) - uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (448)) (Prims.of_int (8)) - (Prims.of_int (448)) (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (448)) (Prims.of_int (2)) - (Prims.of_int (457)) (Prims.of_int (14))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (PP_Pure, PP_Pure) -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg - dbg "PP_Pure, PP_Pure" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (450)) - (Prims.of_int (4)) - (Prims.of_int (450)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (451)) - (Prims.of_int (4)) - (Prims.of_int (451)) - (Prims.of_int (11))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> PP_Pure))) - | (PP_State ty1, PP_State ty2) -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg - dbg "PP_State, PP_State" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (453)) - (Prims.of_int (4)) - (Prims.of_int (453)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (454)) - (Prims.of_int (4)) - (Prims.of_int (454)) - (Prims.of_int (56))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - if term_eq ty1 ty2 - then PP_State ty1 - else PP_Unknown))) - | uu___4 -> - let uu___5 = - FStar_InteractiveHelpers_Base.print_dbg - dbg "_, _" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (456)) - (Prims.of_int (4)) - (Prims.of_int (456)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (457)) - (Prims.of_int (4)) - (Prims.of_int (457)) - (Prims.of_int (14))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> PP_Unknown)))) - uu___3))) uu___1) -let (check_opt_pre_post_type : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - (pre_post_type FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun opt_pre -> - fun ret_type -> - fun opt_post -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> check_opt_pre_post_type" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (461)) (Prims.of_int (2)) - (Prims.of_int (461)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (462)) (Prims.of_int (2)) - (Prims.of_int (474)) (Prims.of_int (8))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match (opt_pre, opt_post) with - | (FStar_Pervasives_Native.Some pre, - FStar_Pervasives_Native.Some post) -> - let uu___2 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "Some pre, Some post" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (464)) (Prims.of_int (4)) - (Prims.of_int (464)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (465)) (Prims.of_int (4)) - (Prims.of_int (465)) - (Prims.of_int (54))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - check_pre_post_type dbg e pre ret_type - post in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (465)) - (Prims.of_int (9)) - (Prims.of_int (465)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (465)) - (Prims.of_int (4)) - (Prims.of_int (465)) - (Prims.of_int (54))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_Pervasives_Native.Some - uu___5)))) uu___3)) - | (FStar_Pervasives_Native.Some pre, - FStar_Pervasives_Native.None) -> - let uu___2 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "Some pre, None" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (467)) (Prims.of_int (4)) - (Prims.of_int (467)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (468)) (Prims.of_int (4)) - (Prims.of_int (468)) - (Prims.of_int (37))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = compute_pre_type dbg e pre in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (468)) - (Prims.of_int (9)) - (Prims.of_int (468)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (468)) - (Prims.of_int (4)) - (Prims.of_int (468)) - (Prims.of_int (37))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_Pervasives_Native.Some - uu___5)))) uu___3)) - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.Some post) -> - let uu___2 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "None, Some post" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (470)) (Prims.of_int (4)) - (Prims.of_int (470)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (471)) (Prims.of_int (4)) - (Prims.of_int (471)) - (Prims.of_int (48))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - compute_post_type dbg e ret_type post in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (471)) - (Prims.of_int (9)) - (Prims.of_int (471)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (471)) - (Prims.of_int (4)) - (Prims.of_int (471)) - (Prims.of_int (48))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_Pervasives_Native.Some - uu___5)))) uu___3)) - | (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None) -> - let uu___2 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "None, None" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (473)) (Prims.of_int (4)) - (Prims.of_int (473)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (474)) (Prims.of_int (4)) - (Prims.of_int (474)) (Prims.of_int (8))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> FStar_Pervasives_Native.None)))) - uu___1) -let rec (_introduce_variables_for_abs : - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.typ -> - ((FStarC_Reflection_Types.term Prims.list * - FStarC_Reflection_Types.binder Prims.list * - FStar_InteractiveHelpers_Base.genv), - unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun ty -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (478)) (Prims.of_int (8)) (Prims.of_int (478)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (478)) (Prims.of_int (2)) (Prims.of_int (489)) - (Prims.of_int (18))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_Arrow (b, c) -> - Obj.magic - (Obj.repr - (let uu___2 = - let uu___3 = - let uu___4 = - FStar_Tactics_V1_Derived.name_of_binder b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (480)) - (Prims.of_int (52)) - (Prims.of_int (480)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat "__" uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (480)) (Prims.of_int (44)) - (Prims.of_int (480)) (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (480)) (Prims.of_int (18)) - (Prims.of_int (480)) (Prims.of_int (88))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.genv_push_fresh_binder - ge uu___4 - (FStar_Reflection_V1_Derived.type_of_binder - b))) uu___4) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (480)) (Prims.of_int (18)) - (Prims.of_int (480)) (Prims.of_int (88))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (479)) (Prims.of_int (19)) - (Prims.of_int (488)) (Prims.of_int (7))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (ge1, b1) -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_Reflection_V1_Derived.bv_of_binder - b1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (481)) - (Prims.of_int (14)) - (Prims.of_int (481)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (481)) - (Prims.of_int (32)) - (Prims.of_int (488)) - (Prims.of_int (7))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun bv1 -> - let uu___5 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - bv1) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (482)) - (Prims.of_int (13)) - (Prims.of_int (482)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (483)) - (Prims.of_int (10)) - (Prims.of_int (487)) - (Prims.of_int (29))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun v1 -> - match FStar_InteractiveHelpers_ExploreTerm.get_total_or_gtotal_ret_type - c - with - | FStar_Pervasives_Native.Some - ty1 -> - Obj.magic - (Obj.repr - (let uu___6 - = - _introduce_variables_for_abs - ge1 ty1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (485)) - (Prims.of_int (24)) - (Prims.of_int (485)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (484)) - (Prims.of_int (17)) - (Prims.of_int (486)) - (Prims.of_int (29))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - match uu___7 - with - | - (vl, bl, - ge2) -> - ((v1 :: - vl), (b1 - :: bl), - ge2))))) - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - ([v1], - [b1], - ge1))))) - uu___6))) uu___5))) - uu___3))) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> ([], [], ge))))) uu___1) -let (introduce_variables_for_abs : - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - ((FStarC_Reflection_Types.term Prims.list * - FStarC_Reflection_Types.binder Prims.list * - FStar_InteractiveHelpers_Base.genv), - unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun tm -> - let uu___ = - FStar_InteractiveHelpers_ExploreTerm.safe_tc - ge.FStar_InteractiveHelpers_Base.env tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (493)) (Prims.of_int (8)) (Prims.of_int (493)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (493)) (Prims.of_int (2)) (Prims.of_int (495)) - (Prims.of_int (22))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.Some ty -> - Obj.magic (Obj.repr (_introduce_variables_for_abs ge ty)) - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> ([], [], ge))))) uu___1) -let (introduce_variables_for_opt_abs : - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - ((FStarC_Reflection_Types.term Prims.list * - FStarC_Reflection_Types.binder Prims.list * - FStar_InteractiveHelpers_Base.genv), - unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___1 -> - fun uu___ -> - (fun ge -> - fun opt_tm -> - match opt_tm with - | FStar_Pervasives_Native.Some tm -> - Obj.magic (Obj.repr (introduce_variables_for_abs ge tm)) - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> ([], [], ge))))) uu___1 uu___ -let (effect_type_is_stateful : - FStar_InteractiveHelpers_ExploreTerm.effect_type -> Prims.bool) = - fun etype -> - match etype with - | FStar_InteractiveHelpers_ExploreTerm.E_Total -> false - | FStar_InteractiveHelpers_ExploreTerm.E_GTotal -> false - | FStar_InteractiveHelpers_ExploreTerm.E_Lemma -> false - | FStar_InteractiveHelpers_ExploreTerm.E_PURE -> false - | FStar_InteractiveHelpers_ExploreTerm.E_Pure -> false - | FStar_InteractiveHelpers_ExploreTerm.E_Stack -> true - | FStar_InteractiveHelpers_ExploreTerm.E_ST -> true - | FStar_InteractiveHelpers_ExploreTerm.E_Unknown -> true -let (is_st_get : - Prims.bool -> - FStarC_Reflection_Types.term -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun t -> - let uu___ = - let uu___1 = - let uu___2 = FStarC_Tactics_V1_Builtins.term_to_string t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (511)) (Prims.of_int (37)) - (Prims.of_int (511)) (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat "[> is_st_get:\n" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (511)) (Prims.of_int (16)) - (Prims.of_int (511)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (511)) (Prims.of_int (2)) - (Prims.of_int (511)) (Prims.of_int (54))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___2)) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (511)) (Prims.of_int (2)) (Prims.of_int (511)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (512)) (Prims.of_int (2)) (Prims.of_int (525)) - (Prims.of_int (9))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = FStarC_Tactics_V1_Builtins.inspect t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (512)) (Prims.of_int (8)) - (Prims.of_int (512)) (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (512)) (Prims.of_int (2)) - (Prims.of_int (525)) (Prims.of_int (9))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStarC_Reflection_V1_Data.Tv_App (hd, (a, qual)) - -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "-> Is Tv_App" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (514)) - (Prims.of_int (4)) - (Prims.of_int (514)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (515)) - (Prims.of_int (10)) - (Prims.of_int (521)) - (Prims.of_int (11))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - FStarC_Tactics_V1_Builtins.inspect - hd in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (515)) - (Prims.of_int (16)) - (Prims.of_int (515)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (515)) - (Prims.of_int (10)) - (Prims.of_int (521)) - (Prims.of_int (11))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - match uu___7 with - | FStarC_Reflection_V1_Data.Tv_FVar - fv -> - let uu___8 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - (Prims.strcat - "-> Head is Tv_FVar: " - (FStar_Reflection_V1_Derived.fv_to_string - fv)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (517)) - (Prims.of_int (6)) - (Prims.of_int (517)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (518)) - (Prims.of_int (6)) - (Prims.of_int (518)) - (Prims.of_int (56))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 - -> - FStar_InteractiveHelpers_Base.fv_eq_name - fv - ["FStar"; - "HyperStack"; - "ST"; - "get"]))) - | uu___8 -> - let uu___9 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "-> Head is not Tv_FVar" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (520)) - (Prims.of_int (6)) - (Prims.of_int (520)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (521)) - (Prims.of_int (6)) - (Prims.of_int (521)) - (Prims.of_int (11))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 - -> false)))) - uu___7))) uu___5)) - | uu___4 -> - let uu___5 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "-> Is not Tv_App" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (524)) - (Prims.of_int (4)) - (Prims.of_int (524)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (525)) - (Prims.of_int (4)) - (Prims.of_int (525)) - (Prims.of_int (9))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> false)))) uu___3))) - uu___1) -let (is_let_st_get : - Prims.bool -> - FStarC_Reflection_V1_Data.term_view -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) - FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun t -> - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = FStarC_Tactics_V1_Builtins.pack t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (527)) (Prims.of_int (23)) - (Prims.of_int (527)) (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (528)) (Prims.of_int (41)) - (Prims.of_int (528)) (Prims.of_int (57))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.term_to_string uu___4)) - uu___4) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (528)) (Prims.of_int (41)) - (Prims.of_int (528)) (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat "[> is_let_st_get:\n" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (528)) (Prims.of_int (16)) - (Prims.of_int (528)) (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (528)) (Prims.of_int (2)) - (Prims.of_int (528)) (Prims.of_int (58))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___2)) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (528)) (Prims.of_int (2)) (Prims.of_int (528)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (529)) (Prims.of_int (2)) (Prims.of_int (535)) - (Prims.of_int (8))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match t with - | FStarC_Reflection_V1_Data.Tv_Let - (recf, attrs, bv, ty, def, body) -> - let uu___2 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "The term is a let expression" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (531)) (Prims.of_int (4)) - (Prims.of_int (531)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (532)) (Prims.of_int (4)) - (Prims.of_int (532)) (Prims.of_int (53))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = is_st_get dbg def in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (532)) - (Prims.of_int (7)) - (Prims.of_int (532)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (532)) - (Prims.of_int (4)) - (Prims.of_int (532)) - (Prims.of_int (53))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - if uu___5 - then - FStar_Pervasives_Native.Some - (bv, ty) - else FStar_Pervasives_Native.None)))) - uu___3)) - | uu___2 -> - let uu___3 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "The term is not a let expression" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (534)) (Prims.of_int (4)) - (Prims.of_int (534)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (535)) (Prims.of_int (4)) - (Prims.of_int (535)) (Prims.of_int (8))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> FStar_Pervasives_Native.None)))) - uu___1) -let (term_has_effectful_comp : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (Prims.bool FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun tm -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> term_has_effectful_comp" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (547)) (Prims.of_int (2)) - (Prims.of_int (547)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (547)) (Prims.of_int (45)) - (Prims.of_int (555)) (Prims.of_int (8))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = compute_effect_info dbg e tm in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (548)) (Prims.of_int (18)) - (Prims.of_int (548)) (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (549)) (Prims.of_int (2)) - (Prims.of_int (555)) (Prims.of_int (8))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun einfo_opt -> - match einfo_opt with - | FStar_Pervasives_Native.Some einfo -> - let uu___3 = - FStar_InteractiveHelpers_Base.print_dbg dbg - (Prims.strcat "Effect type: " - (FStar_InteractiveHelpers_ExploreTerm.effect_type_to_string - einfo.ei_type)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (551)) - (Prims.of_int (4)) - (Prims.of_int (551)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (552)) - (Prims.of_int (4)) - (Prims.of_int (552)) - (Prims.of_int (50))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_Pervasives_Native.Some - (Prims.op_Negation - (FStar_InteractiveHelpers_ExploreTerm.effect_type_is_pure - einfo.ei_type))))) - | FStar_Pervasives_Native.None -> - let uu___3 = - FStar_InteractiveHelpers_Base.print_dbg dbg - "Could not compute effect info" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (554)) - (Prims.of_int (4)) - (Prims.of_int (554)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (555)) - (Prims.of_int (4)) - (Prims.of_int (555)) - (Prims.of_int (8))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_Pervasives_Native.None)))) - uu___3))) uu___1) -let (related_term_is_effectul : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_V1_Data.term_view -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge -> - fun tv -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun tm -> - let uu___2 = - term_has_effectful_comp dbg - ge.FStar_InteractiveHelpers_Base.env tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (567)) (Prims.of_int (4)) - (Prims.of_int (567)) (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (567)) (Prims.of_int (4)) - (Prims.of_int (567)) (Prims.of_int (55))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - uu___3 <> (FStar_Pervasives_Native.Some false))))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (567)) (Prims.of_int (4)) - (Prims.of_int (567)) (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (569)) (Prims.of_int (2)) - (Prims.of_int (591)) (Prims.of_int (45))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun is_effectful -> - match tv with - | FStarC_Reflection_V1_Data.Tv_Var uu___1 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> false))) - | FStarC_Reflection_V1_Data.Tv_BVar uu___1 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> false))) - | FStarC_Reflection_V1_Data.Tv_FVar uu___1 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> false))) - | FStarC_Reflection_V1_Data.Tv_App (hd, (a, qual)) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> false))) - | FStarC_Reflection_V1_Data.Tv_Abs (br, body) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> false))) - | FStarC_Reflection_V1_Data.Tv_Arrow (br, c0) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> false))) - | FStarC_Reflection_V1_Data.Tv_Type uu___1 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> false))) - | FStarC_Reflection_V1_Data.Tv_Refine (bv, sort, ref) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> false))) - | FStarC_Reflection_V1_Data.Tv_Const uu___1 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> false))) - | FStarC_Reflection_V1_Data.Tv_Uvar (uu___1, uu___2) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> false))) - | FStarC_Reflection_V1_Data.Tv_Let - (recf, attrs, bv, ty, def, body) -> - Obj.magic (Obj.repr (is_effectful def)) - | FStarC_Reflection_V1_Data.Tv_Match - (scrutinee, _ret_opt, branches) -> - Obj.magic (Obj.repr (is_effectful scrutinee)) - | FStarC_Reflection_V1_Data.Tv_AscribedT (e, ty, tac, uu___1) - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> false))) - | FStarC_Reflection_V1_Data.Tv_AscribedC (e, c, tac, uu___1) - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> false))) - | uu___1 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> true)))) uu___1) -let rec (find_mem_in_related : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) - FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun dbg -> - fun ge -> - fun tms -> - match tms with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.None))) - | tv::tms' -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - FStarC_Tactics_V1_Builtins.pack tv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (608)) - (Prims.of_int (4)) - (Prims.of_int (608)) - (Prims.of_int (6))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (609)) - (Prims.of_int (49)) - (Prims.of_int (609)) - (Prims.of_int (66))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.term_to_string - uu___4)) uu___4) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (609)) - (Prims.of_int (49)) - (Prims.of_int (609)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat - "[> find_mem_in_related:\n" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (609)) - (Prims.of_int (18)) - (Prims.of_int (609)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (609)) (Prims.of_int (4)) - (Prims.of_int (609)) - (Prims.of_int (67))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (609)) (Prims.of_int (4)) - (Prims.of_int (609)) (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (610)) (Prims.of_int (4)) - (Prims.of_int (626)) (Prims.of_int (11))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = is_let_st_get dbg tv in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (610)) - (Prims.of_int (10)) - (Prims.of_int (610)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (610)) - (Prims.of_int (4)) - (Prims.of_int (626)) - (Prims.of_int (11))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStar_Pervasives_Native.Some - bvt -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Term is of the form `let x = FStar.HyperStack.ST.get ()`: success" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (612)) - (Prims.of_int (6)) - (Prims.of_int (612)) - (Prims.of_int (87))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (613)) - (Prims.of_int (6)) - (Prims.of_int (613)) - (Prims.of_int (14))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_Pervasives_Native.Some - bvt))) - | FStar_Pervasives_Native.None -> - let uu___4 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Term is not of the form `let x = FStar.HyperStack.ST.get ()`: continuing" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (615)) - (Prims.of_int (6)) - (Prims.of_int (615)) - (Prims.of_int (94))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (616)) - (Prims.of_int (6)) - (Prims.of_int (626)) - (Prims.of_int (11))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - related_term_is_effectul - dbg ge tv in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (616)) - (Prims.of_int (9)) - (Prims.of_int (616)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (616)) - (Prims.of_int (6)) - (Prims.of_int (626)) - (Prims.of_int (11))))) - (Obj.magic - uu___6) - (fun uu___7 - -> - (fun - uu___7 -> - if uu___7 - then - let uu___8 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Term is effectful: stopping here" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (619)) - (Prims.of_int (8)) - (Prims.of_int (619)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (620)) - (Prims.of_int (8)) - (Prims.of_int (620)) - (Prims.of_int (12))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - FStar_Pervasives_Native.None))) - else - (let uu___9 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Term is not effectful: continuing" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (624)) - (Prims.of_int (8)) - (Prims.of_int (624)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (625)) - (Prims.of_int (8)) - (Prims.of_int (625)) - (Prims.of_int (39))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - Obj.magic - (find_mem_in_related - dbg ge - tms')) - uu___10)))) - uu___7))) - uu___5))) uu___3))) - uu___1)))) uu___2 uu___1 uu___ -let rec (find_mem_in_children : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - ((FStar_InteractiveHelpers_Base.genv * FStarC_Reflection_Types.bv - FStar_Pervasives_Native.option), - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge -> - fun child -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect child in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (639)) (Prims.of_int (8)) - (Prims.of_int (639)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (639)) (Prims.of_int (2)) - (Prims.of_int (646)) (Prims.of_int (17))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_Let - (recf, attrs, bv, ty, def, body) -> - Obj.magic - (Obj.repr - (let uu___2 = is_st_get dbg def in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (641)) (Prims.of_int (7)) - (Prims.of_int (641)) (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (641)) (Prims.of_int (4)) - (Prims.of_int (645)) (Prims.of_int (39))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - if uu___3 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - (ge, - (FStar_Pervasives_Native.Some - bv))))) - else - Obj.magic - (Obj.repr - (let uu___5 = - let uu___6 = - term_has_effectful_comp dbg - ge.FStar_InteractiveHelpers_Base.env - def in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (642)) - (Prims.of_int (12)) - (Prims.of_int (642)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (642)) - (Prims.of_int (12)) - (Prims.of_int (642)) - (Prims.of_int (64))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - uu___7 <> - (FStar_Pervasives_Native.Some - false))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (642)) - (Prims.of_int (12)) - (Prims.of_int (642)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (642)) - (Prims.of_int (9)) - (Prims.of_int (645)) - (Prims.of_int (39))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - if uu___6 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - (ge, - FStar_Pervasives_Native.None)))) - else - Obj.magic - (Obj.repr - (let uu___8 = - FStar_InteractiveHelpers_Base.genv_push_bv - ge bv ty false - FStar_Pervasives_Native.None in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (644)) - (Prims.of_int (16)) - (Prims.of_int (644)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (645)) - (Prims.of_int (6)) - (Prims.of_int (645)) - (Prims.of_int (39))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun ge1 -> - Obj.magic - ( - find_mem_in_children - dbg ge1 - body)) - uu___9)))) - uu___6)))) uu___3))) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> (ge, FStar_Pervasives_Native.None))))) - uu___1) -let (pre_post_to_propositions : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStar_InteractiveHelpers_ExploreTerm.effect_type -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.binder FStar_Pervasives_Native.option -> - FStar_InteractiveHelpers_ExploreTerm.type_info -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option - -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - ((FStar_InteractiveHelpers_Base.genv * - FStar_InteractiveHelpers_Propositions.proposition - FStar_Pervasives_Native.option * - FStar_InteractiveHelpers_Propositions.proposition - FStar_Pervasives_Native.option), - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge0 -> - fun etype -> - fun v -> - fun ret_abs_binder -> - fun ret_type -> - fun opt_pre -> - fun opt_post -> - fun parents -> - fun children -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> pre_post_to_propositions: begin" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (664)) (Prims.of_int (2)) - (Prims.of_int (664)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (665)) (Prims.of_int (2)) - (Prims.of_int (742)) (Prims.of_int (26))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - let uu___3 = - let uu___4 = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - opt_pre in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (665)) - (Prims.of_int (44)) - (Prims.of_int (665)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat - "- uninstantiated pre: " uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (665)) - (Prims.of_int (16)) - (Prims.of_int (665)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (665)) - (Prims.of_int (2)) - (Prims.of_int (665)) - (Prims.of_int (84))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___4)) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (665)) - (Prims.of_int (2)) - (Prims.of_int (665)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (666)) - (Prims.of_int (2)) - (Prims.of_int (742)) - (Prims.of_int (26))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - let uu___5 = - let uu___6 = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - opt_post in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (666)) - (Prims.of_int (45)) - (Prims.of_int (666)) - (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat - "- uninstantiated post: " - uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (666)) - (Prims.of_int (16)) - (Prims.of_int (666)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (666)) - (Prims.of_int (2)) - (Prims.of_int (666)) - (Prims.of_int (86))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___6)) uu___6) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (666)) - (Prims.of_int (2)) - (Prims.of_int (666)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (666)) - (Prims.of_int (87)) - (Prims.of_int (742)) - (Prims.of_int (26))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - match ret_abs_binder - with - | FStar_Pervasives_Native.None - -> [] - | FStar_Pervasives_Native.Some - b -> - [b])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (667)) - (Prims.of_int (12)) - (Prims.of_int (667)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (667)) - (Prims.of_int (69)) - (Prims.of_int (742)) - (Prims.of_int (26))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun brs -> - let uu___7 = - match etype - with - | FStar_InteractiveHelpers_ExploreTerm.E_Lemma - -> - let uu___8 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "E_Lemma" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (672)) - (Prims.of_int (6)) - (Prims.of_int (672)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (673)) - (Prims.of_int (6)) - (Prims.of_int (673)) - (Prims.of_int (34))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (ge0, - ([], []), - ([ - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - FStarC_Reflection_V2_Data.C_Unit)], - [])))) - | FStar_InteractiveHelpers_ExploreTerm.E_Total - -> - let uu___8 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "E_Total/E_GTotal" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (675)) - (Prims.of_int (6)) - (Prims.of_int (675)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (676)) - (Prims.of_int (6)) - (Prims.of_int (676)) - (Prims.of_int (29))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (ge0, - ([], []), - ([], [])))) - | FStar_InteractiveHelpers_ExploreTerm.E_GTotal - -> - let uu___8 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "E_Total/E_GTotal" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (675)) - (Prims.of_int (6)) - (Prims.of_int (675)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (676)) - (Prims.of_int (6)) - (Prims.of_int (676)) - (Prims.of_int (29))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (ge0, - ([], []), - ([], [])))) - | FStar_InteractiveHelpers_ExploreTerm.E_PURE - -> - let uu___8 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "E_PURE/E_Pure" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (678)) - (Prims.of_int (6)) - (Prims.of_int (678)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (679)) - (Prims.of_int (6)) - (Prims.of_int (679)) - (Prims.of_int (31))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (ge0, - ([], []), - ([v], - brs)))) - | FStar_InteractiveHelpers_ExploreTerm.E_Pure - -> - let uu___8 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "E_PURE/E_Pure" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (678)) - (Prims.of_int (6)) - (Prims.of_int (678)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (679)) - (Prims.of_int (6)) - (Prims.of_int (679)) - (Prims.of_int (31))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (ge0, - ([], []), - ([v], - brs)))) - | FStar_InteractiveHelpers_ExploreTerm.E_Stack - -> - let uu___8 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "E_Stack/E_ST" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (681)) - (Prims.of_int (6)) - (Prims.of_int (681)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (683)) - (Prims.of_int (6)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - let uu___10 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Looking for the initial state in the context" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (683)) - (Prims.of_int (6)) - (Prims.of_int (683)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (683)) - (Prims.of_int (67)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - let uu___12 - = - find_mem_in_related - dbg ge0 - parents in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (684)) - (Prims.of_int (19)) - (Prims.of_int (684)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (685)) - (Prims.of_int (6)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - b1_opt -> - let uu___13 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Looking for the final state in the context" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (685)) - (Prims.of_int (6)) - (Prims.of_int (685)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (685)) - (Prims.of_int (65)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - uu___14 - -> - let uu___15 - = - find_mem_in_related - dbg ge0 - children in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (686)) - (Prims.of_int (19)) - (Prims.of_int (686)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (686)) - (Prims.of_int (58)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - b2_opt -> - let uu___16 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - fun - opt_bvt - -> - fun - basename - -> - fun ge -> - match opt_bvt - with - | - FStar_Pervasives_Native.Some - (bv, ty) - -> - let uu___18 - = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - bv) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (690)) - (Prims.of_int (27)) - (Prims.of_int (690)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (690)) - (Prims.of_int (27)) - (Prims.of_int (690)) - (Prims.of_int (64))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - (uu___19, - (FStar_Reflection_V1_Derived.mk_binder - bv ty), - ge))) - | - FStar_Pervasives_Native.None - -> - FStar_InteractiveHelpers_Base.genv_push_fresh_var - ge - basename - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Monotonic"; - "HyperStack"; - "mem"]))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (689)) - (Prims.of_int (8)) - (Prims.of_int (691)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (692)) - (Prims.of_int (8)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - opt_push_fresh_state - -> - let uu___17 - = - opt_push_fresh_state - b1_opt - "__h0_" - ge0 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (693)) - (Prims.of_int (24)) - (Prims.of_int (693)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (692)) - (Prims.of_int (8)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - (fun - uu___18 - -> - match uu___18 - with - | - (h1, b1, - ge1) -> - let uu___19 - = - opt_push_fresh_state - b2_opt - "__h1_" - ge1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (694)) - (Prims.of_int (24)) - (Prims.of_int (694)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (693)) - (Prims.of_int (66)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___21 - -> - match uu___20 - with - | - (h2, b2, - ge2) -> - (ge2, - ([h1], - [b1]), - ([h1; - v; - h2], - (FStar_List_Tot_Base.flatten - [ - [b1]; - brs; - [b2]]))))))) - uu___18))) - uu___17))) - uu___16))) - uu___14))) - uu___13))) - uu___11))) - uu___9) - | FStar_InteractiveHelpers_ExploreTerm.E_ST - -> - let uu___8 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "E_Stack/E_ST" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (681)) - (Prims.of_int (6)) - (Prims.of_int (681)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (683)) - (Prims.of_int (6)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - let uu___10 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Looking for the initial state in the context" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (683)) - (Prims.of_int (6)) - (Prims.of_int (683)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (683)) - (Prims.of_int (67)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - let uu___12 - = - find_mem_in_related - dbg ge0 - parents in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (684)) - (Prims.of_int (19)) - (Prims.of_int (684)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (685)) - (Prims.of_int (6)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - b1_opt -> - let uu___13 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Looking for the final state in the context" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (685)) - (Prims.of_int (6)) - (Prims.of_int (685)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (685)) - (Prims.of_int (65)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - uu___14 - -> - let uu___15 - = - find_mem_in_related - dbg ge0 - children in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (686)) - (Prims.of_int (19)) - (Prims.of_int (686)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (686)) - (Prims.of_int (58)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - b2_opt -> - let uu___16 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - fun - opt_bvt - -> - fun - basename - -> - fun ge -> - match opt_bvt - with - | - FStar_Pervasives_Native.Some - (bv, ty) - -> - let uu___18 - = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - bv) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (690)) - (Prims.of_int (27)) - (Prims.of_int (690)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (690)) - (Prims.of_int (27)) - (Prims.of_int (690)) - (Prims.of_int (64))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - (uu___19, - (FStar_Reflection_V1_Derived.mk_binder - bv ty), - ge))) - | - FStar_Pervasives_Native.None - -> - FStar_InteractiveHelpers_Base.genv_push_fresh_var - ge - basename - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Monotonic"; - "HyperStack"; - "mem"]))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (689)) - (Prims.of_int (8)) - (Prims.of_int (691)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (692)) - (Prims.of_int (8)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - opt_push_fresh_state - -> - let uu___17 - = - opt_push_fresh_state - b1_opt - "__h0_" - ge0 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (693)) - (Prims.of_int (24)) - (Prims.of_int (693)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (692)) - (Prims.of_int (8)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - (fun - uu___18 - -> - match uu___18 - with - | - (h1, b1, - ge1) -> - let uu___19 - = - opt_push_fresh_state - b2_opt - "__h1_" - ge1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (694)) - (Prims.of_int (24)) - (Prims.of_int (694)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (693)) - (Prims.of_int (66)) - (Prims.of_int (695)) - (Prims.of_int (76))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___21 - -> - match uu___20 - with - | - (h2, b2, - ge2) -> - (ge2, - ([h1], - [b1]), - ([h1; - v; - h2], - (FStar_List_Tot_Base.flatten - [ - [b1]; - brs; - [b2]]))))))) - uu___18))) - uu___17))) - uu___16))) - uu___14))) - uu___13))) - uu___11))) - uu___9) - | FStar_InteractiveHelpers_ExploreTerm.E_Unknown - -> - let uu___8 - = - check_opt_pre_post_type - dbg - ge0.FStar_InteractiveHelpers_Base.env - opt_pre - ret_type.FStar_InteractiveHelpers_ExploreTerm.ty - opt_post in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (703)) - (Prims.of_int (20)) - (Prims.of_int (703)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (704)) - (Prims.of_int (12)) - (Prims.of_int (723)) - (Prims.of_int (31))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - pp_type - -> - match pp_type - with - | - FStar_Pervasives_Native.Some - (PP_Pure) - -> - let uu___9 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "PP_Pure" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (706)) - (Prims.of_int (8)) - (Prims.of_int (706)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (708)) - (Prims.of_int (8)) - (Prims.of_int (708)) - (Prims.of_int (33))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - (ge0, - ([], []), - ([v], - brs))))) - | - FStar_Pervasives_Native.Some - (PP_State - state_type) - -> - let uu___9 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "PP_State" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (710)) - (Prims.of_int (8)) - (Prims.of_int (710)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (710)) - (Prims.of_int (33)) - (Prims.of_int (713)) - (Prims.of_int (78))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - let uu___11 - = - FStar_InteractiveHelpers_Base.genv_push_two_fresh_vars - ge0 "__s" - state_type in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (712)) - (Prims.of_int (34)) - (Prims.of_int (712)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (710)) - (Prims.of_int (33)) - (Prims.of_int (713)) - (Prims.of_int (78))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - match uu___12 - with - | - (s1, b1, - s2, b2, - ge1) -> - (ge1, - ([s1], - [b1]), - ([s1; - v; - s2], - (FStar_List_Tot_Base.flatten - [ - [b1]; - brs; - [b2]]))))))) - uu___10)) - | - FStar_Pervasives_Native.Some - (PP_Unknown) - -> - let uu___9 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "PP_Unknown" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (715)) - (Prims.of_int (8)) - (Prims.of_int (715)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (715)) - (Prims.of_int (35)) - (Prims.of_int (719)) - (Prims.of_int (67))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - let uu___11 - = - introduce_variables_for_opt_abs - ge0 - opt_pre in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (717)) - (Prims.of_int (43)) - (Prims.of_int (717)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (715)) - (Prims.of_int (35)) - (Prims.of_int (719)) - (Prims.of_int (67))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - match uu___12 - with - | - (pre_values, - pre_binders, - ge1) -> - let uu___13 - = - introduce_variables_for_opt_abs - ge1 - opt_post in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (718)) - (Prims.of_int (45)) - (Prims.of_int (718)) - (Prims.of_int (89))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (717)) - (Prims.of_int (89)) - (Prims.of_int (719)) - (Prims.of_int (67))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - match uu___14 - with - | - (post_values, - post_binders, - ge11) -> - (ge11, - (pre_values, - pre_binders), - (post_values, - post_binders)))))) - uu___12))) - uu___10)) - | - uu___9 -> - let uu___10 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "No pre and no post" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (721)) - (Prims.of_int (8)) - (Prims.of_int (721)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (723)) - (Prims.of_int (8)) - (Prims.of_int (723)) - (Prims.of_int (31))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (ge0, - ([], []), - ([], [])))))) - uu___9) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (670)) - (Prims.of_int (4)) - (Prims.of_int (724)) - (Prims.of_int (9))))) - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (667)) - (Prims.of_int (69)) - (Prims.of_int (742)) - (Prims.of_int (26))))) - ( - Obj.magic - uu___7) - ( - fun - uu___8 -> - (fun - uu___8 -> - match uu___8 - with - | - (ge3, - (pre_values, - pre_binders), - (post_values, - post_binders)) - -> - let uu___9 - = - FStar_InteractiveHelpers_Base.opt_mk_app_norm - ge3.FStar_InteractiveHelpers_Base.env - opt_pre - pre_values in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (728)) - (Prims.of_int (17)) - (Prims.of_int (728)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (728)) - (Prims.of_int (62)) - (Prims.of_int (742)) - (Prims.of_int (26))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - pre_prop - -> - let uu___10 - = - FStar_Tactics_V1_Derived.try_with - (fun - uu___11 - -> - match () - with - | - () -> - FStar_InteractiveHelpers_Base.opt_mk_app_norm - ge3.FStar_InteractiveHelpers_Base.env - opt_post - post_values) - (fun - uu___11 - -> - let uu___12 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Dropping a postcondition because of incoherent typing" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (737)) - (Prims.of_int (6)) - (Prims.of_int (737)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (738)) - (Prims.of_int (6)) - (Prims.of_int (738)) - (Prims.of_int (10))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - FStar_Pervasives_Native.None))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (734)) - (Prims.of_int (4)) - (Prims.of_int (738)) - (Prims.of_int (10))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (741)) - (Prims.of_int (2)) - (Prims.of_int (742)) - (Prims.of_int (26))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - post_prop - -> - let uu___11 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "[> pre_post_to_propositions: end" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (741)) - (Prims.of_int (2)) - (Prims.of_int (741)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (742)) - (Prims.of_int (2)) - (Prims.of_int (742)) - (Prims.of_int (26))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - (ge3, - pre_prop, - post_prop))))) - uu___11))) - uu___10))) - uu___8))) - uu___7))) - uu___5))) uu___3))) uu___1) -let (eterm_info_to_assertions : - Prims.bool -> - Prims.bool -> - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - Prims.bool -> - Prims.bool -> - eterm_info -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option - -> - FStar_InteractiveHelpers_ExploreTerm.typ_or_comp - FStar_Pervasives_Native.option -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - ((FStar_InteractiveHelpers_Base.genv * - FStar_InteractiveHelpers_Propositions.assertions), - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun with_gpre -> - fun with_gpost -> - fun ge -> - fun t -> - fun is_let -> - fun is_assert -> - fun info -> - fun bind_var -> - fun opt_c -> - fun parents -> - fun children -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> eterm_info_to_assertions" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (766)) (Prims.of_int (2)) - (Prims.of_int (766)) (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (766)) (Prims.of_int (46)) - (Prims.of_int (962)) (Prims.of_int (7))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> info.einfo)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (771)) - (Prims.of_int (14)) - (Prims.of_int (771)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (771)) - (Prims.of_int (27)) - (Prims.of_int (962)) - (Prims.of_int (7))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun einfo -> - let uu___3 = - match bind_var with - | FStar_Pervasives_Native.Some - v -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - (ge, v, - FStar_Pervasives_Native.None)))) - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (if - effect_type_is_stateful - einfo.ei_type - then - Obj.repr - (let uu___4 = - FStar_InteractiveHelpers_ExploreTerm.is_unit_type - (einfo.ei_ret_type).FStar_InteractiveHelpers_ExploreTerm.ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (782)) - (Prims.of_int (11)) - (Prims.of_int (782)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (782)) - (Prims.of_int (8)) - (Prims.of_int (788)) - (Prims.of_int (53))))) - (Obj.magic - uu___4) - (fun uu___5 - -> - (fun - uu___5 -> - if uu___5 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - (ge, - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - FStarC_Reflection_V2_Data.C_Unit)), - FStar_Pervasives_Native.None)))) - else - Obj.magic - (Obj.repr - (let uu___7 - = - FStar_InteractiveHelpers_Base.fresh_binder - ge.FStar_InteractiveHelpers_Base.env - "__ret" - (einfo.ei_ret_type).FStar_InteractiveHelpers_ExploreTerm.ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (785)) - (Prims.of_int (18)) - (Prims.of_int (785)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (785)) - (Prims.of_int (69)) - (Prims.of_int (788)) - (Prims.of_int (53))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun b -> - let uu___8 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - FStar_Reflection_V1_Derived.bv_of_binder - b)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (786)) - (Prims.of_int (19)) - (Prims.of_int (786)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (786)) - (Prims.of_int (36)) - (Prims.of_int (788)) - (Prims.of_int (53))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun bv - -> - let uu___9 - = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - bv) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (787)) - (Prims.of_int (19)) - (Prims.of_int (787)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (788)) - (Prims.of_int (10)) - (Prims.of_int (788)) - (Prims.of_int (53))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun tm - -> - let uu___10 - = - FStar_InteractiveHelpers_Base.genv_push_binder - ge b true - FStar_Pervasives_Native.None in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (788)) - (Prims.of_int (10)) - (Prims.of_int (788)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (788)) - (Prims.of_int (10)) - (Prims.of_int (788)) - (Prims.of_int (53))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (uu___11, - tm, - (FStar_Pervasives_Native.Some - b)))))) - uu___10))) - uu___9))) - uu___8)))) - uu___5)) - else - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 - -> - (ge, t, - FStar_Pervasives_Native.None))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (773)) - (Prims.of_int (4)) - (Prims.of_int (789)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (771)) - (Prims.of_int (27)) - (Prims.of_int (962)) - (Prims.of_int (7))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | (ge0, v, opt_b) -> - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - v)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (792)) - (Prims.of_int (7)) - (Prims.of_int (962)) - (Prims.of_int (7))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (792)) - (Prims.of_int (7)) - (Prims.of_int (962)) - (Prims.of_int (7))))) - (Obj.magic - uu___5) - (fun uu___6 - -> - (fun v1 - -> - let uu___6 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "> Instantiating local pre/post" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (792)) - (Prims.of_int (7)) - (Prims.of_int (792)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (792)) - (Prims.of_int (54)) - (Prims.of_int (962)) - (Prims.of_int (7))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun - uu___7 -> - let uu___8 - = - pre_post_to_propositions - dbg ge0 - einfo.ei_type - v1 opt_b - einfo.ei_ret_type - einfo.ei_pre - einfo.ei_post - parents - children in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (794)) - (Prims.of_int (4)) - (Prims.of_int (795)) - (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (792)) - (Prims.of_int (54)) - (Prims.of_int (962)) - (Prims.of_int (7))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - match uu___9 - with - | - (ge1, - pre_prop, - post_prop) - -> - let uu___10 - = - let uu___11 - = - let uu___12 - = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - pre_prop in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (796)) - (Prims.of_int (34)) - (Prims.of_int (796)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - Prims.strcat - "- pre prop: " - uu___13)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (796)) - (Prims.of_int (16)) - (Prims.of_int (796)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (796)) - (Prims.of_int (2)) - (Prims.of_int (796)) - (Prims.of_int (75))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___12)) - uu___12) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (796)) - (Prims.of_int (2)) - (Prims.of_int (796)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (797)) - (Prims.of_int (2)) - (Prims.of_int (962)) - (Prims.of_int (7))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - let uu___12 - = - let uu___13 - = - let uu___14 - = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - post_prop in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (797)) - (Prims.of_int (35)) - (Prims.of_int (797)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - Prims.strcat - "- post prop: " - uu___15)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (797)) - (Prims.of_int (16)) - (Prims.of_int (797)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (797)) - (Prims.of_int (2)) - (Prims.of_int (797)) - (Prims.of_int (77))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - uu___14 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___14)) - uu___14) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (797)) - (Prims.of_int (2)) - (Prims.of_int (797)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (801)) - (Prims.of_int (2)) - (Prims.of_int (962)) - (Prims.of_int (7))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - if - is_assert - then - let uu___14 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "The term is an assert: only keep the postcondition" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (803)) - (Prims.of_int (4)) - (Prims.of_int (803)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (804)) - (Prims.of_int (4)) - (Prims.of_int (804)) - (Prims.of_int (53))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - (ge1, - { - FStar_InteractiveHelpers_Propositions.pres - = - (FStar_InteractiveHelpers_Base.opt_cons - post_prop - []); - FStar_InteractiveHelpers_Propositions.posts - = [] - })))) - else - (let uu___15 - = - let uu___16 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - with_gpre - || - ((Prims.op_Negation - is_let) - && - with_gpost))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (812)) - (Prims.of_int (29)) - (Prims.of_int (812)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (813)) - (Prims.of_int (12)) - (Prims.of_int (934)) - (Prims.of_int (31))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - with_goal - -> - match - (opt_c, - with_goal) - with - | - (FStar_Pervasives_Native.Some - c, true) - -> - Obj.magic - (Obj.repr - (let uu___17 - = - typ_or_comp_to_effect_info - dbg ge1 c in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (815)) - (Prims.of_int (17)) - (Prims.of_int (815)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (816)) - (Prims.of_int (8)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - (fun ei - -> - let uu___18 - = - let uu___19 - = - let uu___20 - = - effect_info_to_string - ei in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (816)) - (Prims.of_int (45)) - (Prims.of_int (816)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___22 - -> - Prims.strcat - "- target effect: " - uu___21)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (816)) - (Prims.of_int (22)) - (Prims.of_int (816)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (816)) - (Prims.of_int (8)) - (Prims.of_int (816)) - (Prims.of_int (70))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - (fun - uu___20 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___20)) - uu___20) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (816)) - (Prims.of_int (8)) - (Prims.of_int (816)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (817)) - (Prims.of_int (8)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - uu___19 - -> - let uu___20 - = - let uu___21 - = - let uu___22 - = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - ei.ei_pre in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (817)) - (Prims.of_int (50)) - (Prims.of_int (817)) - (Prims.of_int (91))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___22) - (fun - uu___23 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___24 - -> - Prims.strcat - "- global unfilt. pre: " - uu___23)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (817)) - (Prims.of_int (22)) - (Prims.of_int (817)) - (Prims.of_int (92))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (817)) - (Prims.of_int (8)) - (Prims.of_int (817)) - (Prims.of_int (92))))) - (Obj.magic - uu___21) - (fun - uu___22 - -> - (fun - uu___22 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___22)) - uu___22) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (817)) - (Prims.of_int (8)) - (Prims.of_int (817)) - (Prims.of_int (92))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (818)) - (Prims.of_int (8)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - (fun - uu___21 - -> - let uu___22 - = - let uu___23 - = - let uu___24 - = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - ei.ei_post in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (818)) - (Prims.of_int (51)) - (Prims.of_int (818)) - (Prims.of_int (93))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___24) - (fun - uu___25 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___26 - -> - Prims.strcat - "- global unfilt. post: " - uu___25)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (818)) - (Prims.of_int (22)) - (Prims.of_int (818)) - (Prims.of_int (94))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (818)) - (Prims.of_int (8)) - (Prims.of_int (818)) - (Prims.of_int (94))))) - (Obj.magic - uu___23) - (fun - uu___24 - -> - (fun - uu___24 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___24)) - uu___24) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (818)) - (Prims.of_int (8)) - (Prims.of_int (818)) - (Prims.of_int (94))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (818)) - (Prims.of_int (95)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___22) - (fun - uu___23 - -> - (fun - uu___23 - -> - let uu___24 - = - if - with_gpre - then - let uu___25 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Generating assertions from the global parameters' types" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (825)) - (Prims.of_int (12)) - (Prims.of_int (825)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (826)) - (Prims.of_int (12)) - (Prims.of_int (857)) - (Prims.of_int (34))))) - (Obj.magic - uu___25) - (fun - uu___26 - -> - (fun - uu___26 - -> - let uu___27 - = - let uu___28 - = - let uu___29 - = - FStar_InteractiveHelpers_Base.genv_to_string - ge1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (826)) - (Prims.of_int (47)) - (Prims.of_int (826)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___29) - (fun - uu___30 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___31 - -> - Prims.strcat - "Current genv:\n" - uu___30)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (826)) - (Prims.of_int (26)) - (Prims.of_int (826)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (826)) - (Prims.of_int (12)) - (Prims.of_int (826)) - (Prims.of_int (66))))) - (Obj.magic - uu___28) - (fun - uu___29 - -> - (fun - uu___29 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___29)) - uu___29) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (826)) - (Prims.of_int (12)) - (Prims.of_int (826)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (826)) - (Prims.of_int (67)) - (Prims.of_int (857)) - (Prims.of_int (34))))) - (Obj.magic - uu___27) - (fun - uu___28 - -> - (fun - uu___28 - -> - let uu___29 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___30 - -> - FStar_List_Tot_Base.rev - (FStar_List_Tot_Base.map - (fun x -> - (x, - (FStar_Reflection_V1_Derived.type_of_binder - x))) - (FStar_InteractiveHelpers_ExploreTerm.params_of_typ_or_comp - c)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (831)) - (Prims.of_int (14)) - (Prims.of_int (831)) - (Prims.of_int (91))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (832)) - (Prims.of_int (12)) - (Prims.of_int (857)) - (Prims.of_int (34))))) - (Obj.magic - uu___29) - (fun - uu___30 - -> - (fun - params -> - let uu___30 - = - FStar_Tactics_Util.iteri - (fun i -> - fun - uu___31 - -> - match uu___31 - with - | - (b, - uu___32) - -> - let uu___33 - = - let uu___34 - = - let uu___35 - = - let uu___36 - = - FStar_Tactics_V1_Derived.binder_to_string - b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (833)) - (Prims.of_int (47)) - (Prims.of_int (833)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___36) - (fun - uu___37 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___38 - -> - Prims.strcat - ": " - uu___37)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (833)) - (Prims.of_int (40)) - (Prims.of_int (833)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___35) - (fun - uu___36 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___37 - -> - Prims.strcat - (Prims.string_of_int - i) - uu___36)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (832)) - (Prims.of_int (72)) - (Prims.of_int (833)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___34) - (fun - uu___35 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___36 - -> - Prims.strcat - "Global parameter " - uu___35)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (832)) - (Prims.of_int (49)) - (Prims.of_int (833)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (832)) - (Prims.of_int (35)) - (Prims.of_int (833)) - (Prims.of_int (66))))) - (Obj.magic - uu___33) - (fun - uu___34 - -> - (fun - uu___34 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___34)) - uu___34)) - params in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (832)) - (Prims.of_int (12)) - (Prims.of_int (833)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (833)) - (Prims.of_int (75)) - (Prims.of_int (857)) - (Prims.of_int (34))))) - (Obj.magic - uu___30) - (fun - uu___31 - -> - (fun - uu___31 - -> - let uu___32 - = - FStar_Tactics_Util.filter - (fun - uu___33 - -> - (fun - uu___33 - -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___34 - -> - match uu___33 - with - | - (b, - uu___35) - -> - Prims.op_Negation - (FStar_InteractiveHelpers_Base.binder_is_shadowed - ge1 b)))) - uu___33) - params in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (835)) - (Prims.of_int (25)) - (Prims.of_int (835)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (835)) - (Prims.of_int (87)) - (Prims.of_int (857)) - (Prims.of_int (34))))) - (Obj.magic - uu___32) - (fun - uu___33 - -> - (fun - params1 - -> - let uu___33 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___34 - -> - fun x -> - let uu___35 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___36 - -> x)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (838)) - (Prims.of_int (26)) - (Prims.of_int (838)) - (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (837)) - (Prims.of_int (71)) - (Prims.of_int (854)) - (Prims.of_int (22))))) - (Obj.magic - uu___35) - (fun - uu___36 - -> - (fun - uu___36 - -> - match uu___36 - with - | - (b, ty) - -> - let uu___37 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___38 - -> - FStar_Reflection_V1_Derived.bv_of_binder - b)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (839)) - (Prims.of_int (23)) - (Prims.of_int (839)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (840)) - (Prims.of_int (14)) - (Prims.of_int (854)) - (Prims.of_int (22))))) - (Obj.magic - uu___37) - (fun - uu___38 - -> - (fun bv - -> - let uu___38 - = - let uu___39 - = - let uu___40 - = - FStar_Tactics_V1_Derived.binder_to_string - b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (840)) - (Prims.of_int (79)) - (Prims.of_int (840)) - (Prims.of_int (97))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___40) - (fun - uu___41 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___42 - -> - Prims.strcat - "Generating assertions from global parameter: " - uu___41)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (840)) - (Prims.of_int (28)) - (Prims.of_int (840)) - (Prims.of_int (98))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (840)) - (Prims.of_int (14)) - (Prims.of_int (840)) - (Prims.of_int (98))))) - (Obj.magic - uu___39) - (fun - uu___40 - -> - (fun - uu___40 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___40)) - uu___40) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (840)) - (Prims.of_int (14)) - (Prims.of_int (840)) - (Prims.of_int (98))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (840)) - (Prims.of_int (99)) - (Prims.of_int (854)) - (Prims.of_int (22))))) - (Obj.magic - uu___38) - (fun - uu___39 - -> - (fun - uu___39 - -> - let uu___40 - = - FStar_InteractiveHelpers_ExploreTerm.get_type_info_from_type - ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (841)) - (Prims.of_int (26)) - (Prims.of_int (841)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (841)) - (Prims.of_int (55)) - (Prims.of_int (854)) - (Prims.of_int (22))))) - (Obj.magic - uu___40) - (fun - uu___41 - -> - (fun - tinfo -> - let uu___41 - = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - bv) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (842)) - (Prims.of_int (22)) - (Prims.of_int (842)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (842)) - (Prims.of_int (41)) - (Prims.of_int (854)) - (Prims.of_int (22))))) - (Obj.magic - uu___41) - (fun - uu___42 - -> - (fun v2 - -> - let uu___42 - = - mk_has_type - v2 - tinfo.FStar_InteractiveHelpers_ExploreTerm.ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (843)) - (Prims.of_int (23)) - (Prims.of_int (843)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (843)) - (Prims.of_int (48)) - (Prims.of_int (854)) - (Prims.of_int (22))))) - (Obj.magic - uu___42) - (fun - uu___43 - -> - (fun p1 - -> - let uu___43 - = - match - tinfo.FStar_InteractiveHelpers_ExploreTerm.refin - with - | - FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___44 - -> []))) - | - FStar_Pervasives_Native.Some - r -> - Obj.magic - (Obj.repr - (let uu___44 - = - FStar_InteractiveHelpers_Base.mk_app_norm - ge1.FStar_InteractiveHelpers_Base.env - r [v2] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (847)) - (Prims.of_int (25)) - (Prims.of_int (847)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (850)) - (Prims.of_int (16)) - (Prims.of_int (852)) - (Prims.of_int (76))))) - (Obj.magic - uu___44) - (fun - uu___45 - -> - (fun p2 - -> - let uu___45 - = - FStar_InteractiveHelpers_ExploreTerm.term_has_shadowed_variables - ge1 p2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (850)) - (Prims.of_int (19)) - (Prims.of_int (850)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (850)) - (Prims.of_int (16)) - (Prims.of_int (852)) - (Prims.of_int (76))))) - (Obj.magic - uu___45) - (fun - uu___46 - -> - (fun - uu___46 - -> - if - uu___46 - then - let uu___47 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Discarding type refinement because of shadowed variables" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (851)) - (Prims.of_int (27)) - (Prims.of_int (851)) - (Prims.of_int (99))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (851)) - (Prims.of_int (101)) - (Prims.of_int (851)) - (Prims.of_int (103))))) - (Obj.magic - uu___47) - (fun - uu___48 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___49 - -> []))) - else - (let uu___48 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Keeping type refinement" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (852)) - (Prims.of_int (27)) - (Prims.of_int (852)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (852)) - (Prims.of_int (68)) - (Prims.of_int (852)) - (Prims.of_int (72))))) - (Obj.magic - uu___48) - (fun - uu___49 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___50 - -> [p2]))))) - uu___46))) - uu___45))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (844)) - (Prims.of_int (23)) - (Prims.of_int (852)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (854)) - (Prims.of_int (14)) - (Prims.of_int (854)) - (Prims.of_int (22))))) - (Obj.magic - uu___43) - (fun pl - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___44 - -> p1 :: - pl)))) - uu___43))) - uu___42))) - uu___41))) - uu___39))) - uu___38))) - uu___36))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (837)) - (Prims.of_int (71)) - (Prims.of_int (854)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (855)) - (Prims.of_int (14)) - (Prims.of_int (857)) - (Prims.of_int (34))))) - (Obj.magic - uu___33) - (fun - uu___34 - -> - (fun - param_to_props - -> - let uu___34 - = - FStar_Tactics_Util.map - param_to_props - params1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (856)) - (Prims.of_int (24)) - (Prims.of_int (856)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (857)) - (Prims.of_int (12)) - (Prims.of_int (857)) - (Prims.of_int (34))))) - (Obj.magic - uu___34) - (fun - props -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___35 - -> - FStar_List_Tot_Base.flatten - props)))) - uu___34))) - uu___33))) - uu___31))) - uu___30))) - uu___28))) - uu___26) - else - (let uu___26 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Ignoring the global parameters' types" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (861)) - (Prims.of_int (12)) - (Prims.of_int (861)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (862)) - (Prims.of_int (12)) - (Prims.of_int (862)) - (Prims.of_int (14))))) - (Obj.magic - uu___26) - (fun - uu___27 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___28 - -> []))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (822)) - (Prims.of_int (10)) - (Prims.of_int (864)) - (Prims.of_int (13))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (865)) - (Prims.of_int (10)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___24) - (fun - uu___25 - -> - (fun - gparams_props - -> - let uu___25 - = - match - ((ei.ei_pre), - with_gpre) - with - | - (FStar_Pervasives_Native.Some - pre, - true) -> - Obj.magic - (Obj.repr - (let uu___26 - = - FStar_InteractiveHelpers_ExploreTerm.term_has_shadowed_variables - ge1 pre in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (872)) - (Prims.of_int (15)) - (Prims.of_int (872)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (872)) - (Prims.of_int (12)) - (Prims.of_int (877)) - (Prims.of_int (26))))) - (Obj.magic - uu___26) - (fun - uu___27 - -> - (fun - uu___27 - -> - if - uu___27 - then - Obj.magic - (Obj.repr - (let uu___28 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Dropping the global precondition because of shadowed variables" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (874)) - (Prims.of_int (14)) - (Prims.of_int (874)) - (Prims.of_int (92))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (875)) - (Prims.of_int (14)) - (Prims.of_int (875)) - (Prims.of_int (18))))) - (Obj.magic - uu___28) - (fun - uu___29 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___30 - -> - FStar_Pervasives_Native.None)))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___29 - -> - ei.ei_pre)))) - uu___27))) - | - uu___26 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___27 - -> - FStar_Pervasives_Native.None))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (870)) - (Prims.of_int (10)) - (Prims.of_int (878)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (879)) - (Prims.of_int (10)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___25) - (fun - uu___26 - -> - (fun gpre - -> - let uu___26 - = - if - Prims.op_Negation - with_gpost - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___27 - -> - (FStar_Pervasives_Native.None, - [])))) - else - Obj.magic - (Obj.repr - (if - is_let - then - let uu___28 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Dropping the global postcondition and return type because we are studying a let expression" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (886)) - (Prims.of_int (12)) - (Prims.of_int (886)) - (Prims.of_int (118))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (887)) - (Prims.of_int (12)) - (Prims.of_int (887)) - (Prims.of_int (20))))) - (Obj.magic - uu___28) - (fun - uu___29 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___30 - -> - (FStar_Pervasives_Native.None, - []))) - else - FStar_Tactics_V1_Derived.try_with - (fun - uu___29 - -> - match () - with - | - () -> - let uu___30 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "> Generating propositions from the global type cast" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (898)) - (Prims.of_int (14)) - (Prims.of_int (898)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (899)) - (Prims.of_int (14)) - (Prims.of_int (906)) - (Prims.of_int (50))))) - (Obj.magic - uu___30) - (fun - uu___31 - -> - (fun - uu___31 - -> - let uu___32 - = - let uu___33 - = - let uu___34 - = - FStar_InteractiveHelpers_ExploreTerm.type_info_to_string - einfo.ei_ret_type in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (899)) - (Prims.of_int (48)) - (Prims.of_int (899)) - (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___34) - (fun - uu___35 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___36 - -> - Prims.strcat - "- known type: " - uu___35)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (899)) - (Prims.of_int (28)) - (Prims.of_int (899)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (899)) - (Prims.of_int (14)) - (Prims.of_int (899)) - (Prims.of_int (86))))) - (Obj.magic - uu___33) - (fun - uu___34 - -> - (fun - uu___34 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___34)) - uu___34) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (899)) - (Prims.of_int (14)) - (Prims.of_int (899)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (900)) - (Prims.of_int (14)) - (Prims.of_int (906)) - (Prims.of_int (50))))) - (Obj.magic - uu___32) - (fun - uu___33 - -> - (fun - uu___33 - -> - let uu___34 - = - let uu___35 - = - let uu___36 - = - FStar_InteractiveHelpers_ExploreTerm.type_info_to_string - ei.ei_ret_type in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (900)) - (Prims.of_int (48)) - (Prims.of_int (900)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___36) - (fun - uu___37 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___38 - -> - Prims.strcat - "- exp. type : " - uu___37)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (900)) - (Prims.of_int (28)) - (Prims.of_int (900)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (900)) - (Prims.of_int (14)) - (Prims.of_int (900)) - (Prims.of_int (83))))) - (Obj.magic - uu___35) - (fun - uu___36 - -> - (fun - uu___36 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___36)) - uu___36) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (900)) - (Prims.of_int (14)) - (Prims.of_int (900)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (900)) - (Prims.of_int (84)) - (Prims.of_int (906)) - (Prims.of_int (50))))) - (Obj.magic - uu___34) - (fun - uu___35 - -> - (fun - uu___35 - -> - let uu___36 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___37 - -> - mk_cast_info - v1 - (FStar_Pervasives_Native.Some - (einfo.ei_ret_type)) - (FStar_Pervasives_Native.Some - (ei.ei_ret_type)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (901)) - (Prims.of_int (26)) - (Prims.of_int (901)) - (Prims.of_int (87))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (902)) - (Prims.of_int (14)) - (Prims.of_int (906)) - (Prims.of_int (50))))) - (Obj.magic - uu___36) - (fun - uu___37 - -> - (fun - gcast -> - let uu___37 - = - let uu___38 - = - cast_info_to_string - gcast in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (902)) - (Prims.of_int (28)) - (Prims.of_int (902)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (902)) - (Prims.of_int (14)) - (Prims.of_int (902)) - (Prims.of_int (55))))) - (Obj.magic - uu___38) - (fun - uu___39 - -> - (fun - uu___39 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___39)) - uu___39) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (902)) - (Prims.of_int (14)) - (Prims.of_int (902)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (902)) - (Prims.of_int (56)) - (Prims.of_int (906)) - (Prims.of_int (50))))) - (Obj.magic - uu___37) - (fun - uu___38 - -> - (fun - uu___38 - -> - let uu___39 - = - cast_info_to_propositions - dbg ge1 - gcast in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (903)) - (Prims.of_int (32)) - (Prims.of_int (903)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (904)) - (Prims.of_int (14)) - (Prims.of_int (906)) - (Prims.of_int (50))))) - (Obj.magic - uu___39) - (fun - uu___40 - -> - (fun - gcast_props - -> - let uu___40 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "> Propositions for global type cast:" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (904)) - (Prims.of_int (14)) - (Prims.of_int (904)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (905)) - (Prims.of_int (14)) - (Prims.of_int (906)) - (Prims.of_int (50))))) - (Obj.magic - uu___40) - (fun - uu___41 - -> - (fun - uu___41 - -> - let uu___42 - = - let uu___43 - = - FStar_InteractiveHelpers_Base.list_to_string - FStarC_Tactics_V1_Builtins.term_to_string - gcast_props in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (905)) - (Prims.of_int (28)) - (Prims.of_int (905)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (905)) - (Prims.of_int (14)) - (Prims.of_int (905)) - (Prims.of_int (71))))) - (Obj.magic - uu___43) - (fun - uu___44 - -> - (fun - uu___44 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___44)) - uu___44) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (905)) - (Prims.of_int (14)) - (Prims.of_int (905)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (906)) - (Prims.of_int (14)) - (Prims.of_int (906)) - (Prims.of_int (50))))) - (Obj.magic - uu___42) - (fun - uu___43 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___44 - -> - ((ei.ei_post), - (FStar_List_Tot_Base.rev - gcast_props)))))) - uu___41))) - uu___40))) - uu___38))) - uu___37))) - uu___35))) - uu___33))) - uu___31)) - (fun - uu___29 - -> - let uu___30 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Dropping the global postcondition and return type because of incoherent typing" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (909)) - (Prims.of_int (14)) - (Prims.of_int (909)) - (Prims.of_int (108))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (910)) - (Prims.of_int (14)) - (Prims.of_int (910)) - (Prims.of_int (22))))) - (Obj.magic - uu___30) - (fun - uu___31 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___32 - -> - (FStar_Pervasives_Native.None, - [])))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (883)) - (Prims.of_int (10)) - (Prims.of_int (910)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (879)) - (Prims.of_int (10)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___26) - (fun - uu___27 - -> - (fun - uu___27 - -> - match uu___27 - with - | - (gpost, - gcast_props) - -> - let uu___28 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "> Instantiating global pre/post" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (914)) - (Prims.of_int (8)) - (Prims.of_int (914)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (914)) - (Prims.of_int (56)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___28) - (fun - uu___29 - -> - (fun - uu___29 - -> - let uu___30 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___31 - -> - if is_let - then - FStar_List_Tot_Base.rev - children - else - if - effect_type_is_stateful - einfo.ei_type - then - FStar_List_Tot_Base.rev - children - else - parents)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (921)) - (Prims.of_int (10)) - (Prims.of_int (923)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (924)) - (Prims.of_int (10)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___30) - (fun - uu___31 - -> - (fun - gchildren - -> - let uu___31 - = - pre_post_to_propositions - dbg ge1 - ei.ei_type - v1 opt_b - einfo.ei_ret_type - gpre - gpost - (FStar_List_Tot_Base.rev - parents) - gchildren in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (926)) - (Prims.of_int (10)) - (Prims.of_int (927)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (924)) - (Prims.of_int (10)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___31) - (fun - uu___32 - -> - (fun - uu___32 - -> - match uu___32 - with - | - (ge2, - gpre_prop, - gpost_prop) - -> - let uu___33 - = - let uu___34 - = - let uu___35 - = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - gpre_prop in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (929)) - (Prims.of_int (47)) - (Prims.of_int (929)) - (Prims.of_int (88))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___35) - (fun - uu___36 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___37 - -> - Prims.strcat - "- global pre prop: " - uu___36)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (929)) - (Prims.of_int (22)) - (Prims.of_int (929)) - (Prims.of_int (89))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (929)) - (Prims.of_int (8)) - (Prims.of_int (929)) - (Prims.of_int (89))))) - (Obj.magic - uu___34) - (fun - uu___35 - -> - (fun - uu___35 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___35)) - uu___35) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (929)) - (Prims.of_int (8)) - (Prims.of_int (929)) - (Prims.of_int (89))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (930)) - (Prims.of_int (8)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___33) - (fun - uu___34 - -> - (fun - uu___34 - -> - let uu___35 - = - let uu___36 - = - let uu___37 - = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - gpost_prop in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (930)) - (Prims.of_int (48)) - (Prims.of_int (930)) - (Prims.of_int (90))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___37) - (fun - uu___38 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___39 - -> - Prims.strcat - "- global post prop: " - uu___38)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (930)) - (Prims.of_int (22)) - (Prims.of_int (930)) - (Prims.of_int (91))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (930)) - (Prims.of_int (8)) - (Prims.of_int (930)) - (Prims.of_int (91))))) - (Obj.magic - uu___36) - (fun - uu___37 - -> - (fun - uu___37 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___37)) - uu___37) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (930)) - (Prims.of_int (8)) - (Prims.of_int (930)) - (Prims.of_int (91))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (932)) - (Prims.of_int (8)) - (Prims.of_int (932)) - (Prims.of_int (62))))) - (Obj.magic - uu___35) - (fun - uu___36 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___37 - -> - (ge2, - gparams_props, - gpre_prop, - gcast_props, - gpost_prop))))) - uu___34))) - uu___32))) - uu___31))) - uu___29))) - uu___27))) - uu___26))) - uu___25))) - uu___23))) - uu___21))) - uu___19))) - uu___18))) - | - (uu___17, - uu___18) - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - (ge1, [], - FStar_Pervasives_Native.None, - [], - FStar_Pervasives_Native.None))))) - uu___17) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (808)) - (Prims.of_int (64)) - (Prims.of_int (935)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (806)) - (Prims.of_int (12)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - match uu___16 - with - | - (ge2, - gparams_props, - gpre_prop, - gcast_props, - gpost_prop) - -> - let uu___17 - = - cast_info_list_to_propositions - dbg ge2 - info.parameters in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (939)) - (Prims.of_int (23)) - (Prims.of_int (939)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (939)) - (Prims.of_int (80)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - (fun - params_props - -> - let uu___18 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - if - FStar_InteractiveHelpers_ExploreTerm.uu___is_E_Lemma - einfo.ei_type - then - ([], []) - else - ([v1], - ((match opt_b - with - | FStar_Pervasives_Native.Some - b -> - [b] - | FStar_Pervasives_Native.None - -> []))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (942)) - (Prims.of_int (6)) - (Prims.of_int (943)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (939)) - (Prims.of_int (80)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - uu___19 - -> - match uu___19 - with - | - (ret_values, - ret_binders) - -> - let uu___20 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___21 - -> - ret_values)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (943)) - (Prims.of_int (66)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (943)) - (Prims.of_int (66)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - (fun - ret_values1 - -> - let uu___21 - = - match ret_values1 - with - | - v2::[] -> - Obj.magic - (Obj.repr - (let uu___22 - = - mk_has_type - v2 - (einfo.ei_ret_type).FStar_InteractiveHelpers_ExploreTerm.ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (946)) - (Prims.of_int (20)) - (Prims.of_int (946)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (946)) - (Prims.of_int (15)) - (Prims.of_int (946)) - (Prims.of_int (56))))) - (Obj.magic - uu___22) - (fun - uu___23 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___24 - -> - FStar_Pervasives_Native.Some - uu___23)))) - | - uu___22 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___23 - -> - FStar_Pervasives_Native.None))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (945)) - (Prims.of_int (6)) - (Prims.of_int (947)) - (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (948)) - (Prims.of_int (6)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___21) - (fun - uu___22 - -> - (fun - ret_has_type_prop - -> - let uu___22 - = - FStar_InteractiveHelpers_Base.opt_mk_app_norm - ge2.FStar_InteractiveHelpers_Base.env - (get_opt_refinment - einfo.ei_ret_type) - ret_values1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (949)) - (Prims.of_int (25)) - (Prims.of_int (949)) - (Prims.of_int (97))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (949)) - (Prims.of_int (100)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___22) - (fun - uu___23 - -> - (fun - ret_refin_prop - -> - let uu___23 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___24 - -> - FStar_InteractiveHelpers_Base.opt_cons - gpre_prop - (FStar_List_Tot_Base.append - params_props - (FStar_InteractiveHelpers_Base.opt_cons - pre_prop - [])))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (951)) - (Prims.of_int (15)) - (Prims.of_int (951)) - (Prims.of_int (87))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (951)) - (Prims.of_int (90)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___23) - (fun - uu___24 - -> - (fun pres - -> - let uu___24 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___25 - -> - FStar_List_Tot_Base.append - gparams_props - pres)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (952)) - (Prims.of_int (15)) - (Prims.of_int (952)) - (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (952)) - (Prims.of_int (43)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___24) - (fun - uu___25 - -> - (fun - pres1 -> - let uu___25 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___26 - -> - FStar_InteractiveHelpers_Base.opt_cons - ret_has_type_prop - (FStar_InteractiveHelpers_Base.opt_cons - ret_refin_prop - (FStar_InteractiveHelpers_Base.opt_cons - post_prop - (FStar_List_Tot_Base.append - gcast_props - (FStar_InteractiveHelpers_Base.opt_cons - gpost_prop - [])))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (953)) - (Prims.of_int (16)) - (Prims.of_int (955)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (957)) - (Prims.of_int (4)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___25) - (fun - uu___26 - -> - (fun - posts -> - let uu___26 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "- generated pres:" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (957)) - (Prims.of_int (4)) - (Prims.of_int (957)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (958)) - (Prims.of_int (4)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___26) - (fun - uu___27 - -> - (fun - uu___27 - -> - let uu___28 - = - if dbg - then - Obj.magic - (Obj.repr - (FStar_Tactics_Util.iter - (fun x -> - let uu___29 - = - FStarC_Tactics_V1_Builtins.term_to_string - x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (958)) - (Prims.of_int (37)) - (Prims.of_int (958)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (958)) - (Prims.of_int (31)) - (Prims.of_int (958)) - (Prims.of_int (55))))) - (Obj.magic - uu___29) - (fun - uu___30 - -> - (fun - uu___30 - -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print - uu___30)) - uu___30)) - pres1)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___30 - -> ()))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (958)) - (Prims.of_int (4)) - (Prims.of_int (958)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (959)) - (Prims.of_int (4)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___28) - (fun - uu___29 - -> - (fun - uu___29 - -> - let uu___30 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "- generated posts:" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (959)) - (Prims.of_int (4)) - (Prims.of_int (959)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (960)) - (Prims.of_int (4)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___30) - (fun - uu___31 - -> - (fun - uu___31 - -> - let uu___32 - = - if dbg - then - Obj.magic - (Obj.repr - (FStar_Tactics_Util.iter - (fun x -> - let uu___33 - = - FStarC_Tactics_V1_Builtins.term_to_string - x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (960)) - (Prims.of_int (37)) - (Prims.of_int (960)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (960)) - (Prims.of_int (31)) - (Prims.of_int (960)) - (Prims.of_int (55))))) - (Obj.magic - uu___33) - (fun - uu___34 - -> - (fun - uu___34 - -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print - uu___34)) - uu___34)) - posts)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___34 - -> ()))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (960)) - (Prims.of_int (4)) - (Prims.of_int (960)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Effectful.fst" - (Prims.of_int (961)) - (Prims.of_int (4)) - (Prims.of_int (961)) - (Prims.of_int (39))))) - (Obj.magic - uu___32) - (fun - uu___33 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___34 - -> - (ge2, - { - FStar_InteractiveHelpers_Propositions.pres - = pres1; - FStar_InteractiveHelpers_Propositions.posts - = posts - }))))) - uu___31))) - uu___29))) - uu___27))) - uu___26))) - uu___25))) - uu___24))) - uu___23))) - uu___22))) - uu___21))) - uu___19))) - uu___18))) - uu___16)))) - uu___13))) - uu___11))) - uu___9))) - uu___7))) - uu___6))) - uu___4))) uu___3))) - uu___1) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_ExploreTerm.ml b/stage0/fstar-lib/generated/FStar_InteractiveHelpers_ExploreTerm.ml deleted file mode 100644 index caab76b8fe4..00000000000 --- a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_ExploreTerm.ml +++ /dev/null @@ -1,5659 +0,0 @@ -open Prims -let (pure_effect_qn : Prims.string) = "Prims.PURE" -let (pure_hoare_effect_qn : Prims.string) = "Prims.Pure" -let (stack_effect_qn : Prims.string) = "FStar.HyperStack.ST.Stack" -let (st_effect_qn : Prims.string) = "FStar.HyperStack.ST.ST" -let (comp_qualifier : - FStarC_Reflection_Types.comp -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - (fun c -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - match FStarC_Reflection_V1_Builtins.inspect_comp c with - | FStarC_Reflection_V1_Data.C_Total uu___1 -> "C_Total" - | FStarC_Reflection_V1_Data.C_GTotal uu___1 -> "C_GTotal" - | FStarC_Reflection_V1_Data.C_Lemma (uu___1, uu___2, uu___3) - -> "C_Lemma" - | FStarC_Reflection_V1_Data.C_Eff - (uu___1, uu___2, uu___3, uu___4, uu___5) -> "C_Eff"))) - uu___ -type effect_type = - | E_Total - | E_GTotal - | E_Lemma - | E_PURE - | E_Pure - | E_Stack - | E_ST - | E_Unknown -let (uu___is_E_Total : effect_type -> Prims.bool) = - fun projectee -> match projectee with | E_Total -> true | uu___ -> false -let (uu___is_E_GTotal : effect_type -> Prims.bool) = - fun projectee -> match projectee with | E_GTotal -> true | uu___ -> false -let (uu___is_E_Lemma : effect_type -> Prims.bool) = - fun projectee -> match projectee with | E_Lemma -> true | uu___ -> false -let (uu___is_E_PURE : effect_type -> Prims.bool) = - fun projectee -> match projectee with | E_PURE -> true | uu___ -> false -let (uu___is_E_Pure : effect_type -> Prims.bool) = - fun projectee -> match projectee with | E_Pure -> true | uu___ -> false -let (uu___is_E_Stack : effect_type -> Prims.bool) = - fun projectee -> match projectee with | E_Stack -> true | uu___ -> false -let (uu___is_E_ST : effect_type -> Prims.bool) = - fun projectee -> match projectee with | E_ST -> true | uu___ -> false -let (uu___is_E_Unknown : effect_type -> Prims.bool) = - fun projectee -> match projectee with | E_Unknown -> true | uu___ -> false -let (effect_type_to_string : effect_type -> Prims.string) = - fun ety -> - match ety with - | E_Total -> "E_Total" - | E_GTotal -> "E_GTotal" - | E_Lemma -> "E_Lemma" - | E_PURE -> "E_PURE" - | E_Pure -> "E_Pure" - | E_Stack -> "E_Stack" - | E_ST -> "E_ST" - | E_Unknown -> "E_Unknown" -let (effect_name_to_type : FStarC_Reflection_Types.name -> effect_type) = - fun ename -> - let ename1 = FStar_Reflection_V1_Derived.flatten_name ename in - if ename1 = pure_effect_qn - then E_PURE - else - if ename1 = pure_hoare_effect_qn - then E_Pure - else - if ename1 = stack_effect_qn - then E_Stack - else if ename1 = st_effect_qn then E_ST else E_Unknown -let (effect_type_is_pure : effect_type -> Prims.bool) = - fun etype -> - match etype with - | E_Total -> true - | E_GTotal -> true - | E_Lemma -> true - | E_PURE -> true - | E_Pure -> true - | E_Stack -> false - | E_ST -> false - | E_Unknown -> false -type type_info = - { - ty: FStarC_Reflection_Types.typ ; - refin: FStarC_Reflection_Types.term FStar_Pervasives_Native.option } -let (__proj__Mktype_info__item__ty : - type_info -> FStarC_Reflection_Types.typ) = - fun projectee -> match projectee with | { ty; refin;_} -> ty -let (__proj__Mktype_info__item__refin : - type_info -> FStarC_Reflection_Types.term FStar_Pervasives_Native.option) = - fun projectee -> match projectee with | { ty; refin;_} -> refin -let (mk_type_info : - FStarC_Reflection_Types.typ -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> type_info) - = fun uu___ -> fun uu___1 -> { ty = uu___; refin = uu___1 } -let (type_info_to_string : - type_info -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun info -> - let uu___ = - let uu___1 = FStarC_Tactics_V1_Builtins.term_to_string info.ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (84)) (Prims.of_int (2)) (Prims.of_int (84)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (84)) (Prims.of_int (2)) (Prims.of_int (85)) - (Prims.of_int (50))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - let uu___4 = - let uu___5 = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string info.refin in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (85)) (Prims.of_int (2)) - (Prims.of_int (85)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> Prims.strcat uu___6 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (85)) (Prims.of_int (2)) - (Prims.of_int (85)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat ") (" uu___5)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (84)) (Prims.of_int (27)) - (Prims.of_int (85)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat uu___2 uu___4)))) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (84)) (Prims.of_int (2)) (Prims.of_int (85)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "Mktype_info (" uu___1)) -let (unit_type_info : type_info) = - mk_type_info - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv ["Prims"; "unit"]))) - FStar_Pervasives_Native.None -let (safe_tc : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - FStar_Tactics_V1_Derived.try_with - (fun uu___ -> - match () with - | () -> - let uu___1 = FStarC_Tactics_V1_Builtins.tc e t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (91)) (Prims.of_int (11)) - (Prims.of_int (91)) (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (91)) (Prims.of_int (6)) - (Prims.of_int (91)) (Prims.of_int (19))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> FStar_Pervasives_Native.Some uu___2))) - (fun uu___ -> - (fun uu___ -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStar_Pervasives_Native.None))) uu___) -let (safe_tcc : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.comp FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - FStar_Tactics_V1_Derived.try_with - (fun uu___ -> - match () with - | () -> - let uu___1 = FStarC_Tactics_V1_Builtins.tcc e t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (95)) (Prims.of_int (11)) - (Prims.of_int (95)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (95)) (Prims.of_int (6)) - (Prims.of_int (95)) (Prims.of_int (20))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> FStar_Pervasives_Native.Some uu___2))) - (fun uu___ -> - (fun uu___ -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStar_Pervasives_Native.None))) uu___) -let (get_type_info_from_type : - FStarC_Reflection_Types.typ -> - (type_info, unit) FStar_Tactics_Effect.tac_repr) - = - fun ty -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (98)) (Prims.of_int (8)) (Prims.of_int (98)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (98)) (Prims.of_int (2)) (Prims.of_int (107)) - (Prims.of_int (24))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_Refine (bv, sort, refin) -> - let uu___2 = - FStar_InteractiveHelpers_Base.prettify_term false sort in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (100)) (Prims.of_int (19)) - (Prims.of_int (100)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (100)) (Prims.of_int (47)) - (Prims.of_int (104)) (Prims.of_int (38))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun raw_type -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Reflection_V1_Derived.mk_binder bv - sort)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (101)) - (Prims.of_int (21)) - (Prims.of_int (101)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (101)) - (Prims.of_int (41)) - (Prims.of_int (104)) - (Prims.of_int (38))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun b -> - let uu___4 = - FStar_InteractiveHelpers_Base.prettify_term - false refin in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (102)) - (Prims.of_int (16)) - (Prims.of_int (102)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (102)) - (Prims.of_int (44)) - (Prims.of_int (104)) - (Prims.of_int (38))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun refin1 -> - let uu___5 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Abs - (b, refin1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (103)) - (Prims.of_int (16)) - (Prims.of_int (103)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (104)) - (Prims.of_int (4)) - (Prims.of_int (104)) - (Prims.of_int (38))))) - (Obj.magic uu___5) - (fun refin2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - mk_type_info - raw_type - (FStar_Pervasives_Native.Some - refin2))))) - uu___5))) uu___4))) uu___3)) - | uu___2 -> - let uu___3 = - FStar_InteractiveHelpers_Base.prettify_term false ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (106)) (Prims.of_int (13)) - (Prims.of_int (106)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (107)) (Prims.of_int (4)) - (Prims.of_int (107)) (Prims.of_int (24))))) - (Obj.magic uu___3) - (fun ty1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - mk_type_info ty1 FStar_Pervasives_Native.None)))) - uu___1) -let (get_type_info : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (type_info FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun t -> - let uu___ = safe_tc e t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (111)) (Prims.of_int (8)) (Prims.of_int (111)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (111)) (Prims.of_int (2)) (Prims.of_int (113)) - (Prims.of_int (48))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> FStar_Pervasives_Native.None))) - | FStar_Pervasives_Native.Some ty -> - Obj.magic - (Obj.repr - (let uu___2 = get_type_info_from_type ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (113)) (Prims.of_int (20)) - (Prims.of_int (113)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (113)) (Prims.of_int (15)) - (Prims.of_int (113)) (Prims.of_int (48))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Pervasives_Native.Some uu___3))))) - uu___1) -let (get_total_or_gtotal_ret_type : - FStarC_Reflection_Types.comp -> - FStarC_Reflection_Types.typ FStar_Pervasives_Native.option) - = - fun c -> - match FStarC_Reflection_V1_Builtins.inspect_comp c with - | FStarC_Reflection_V1_Data.C_Total ret_ty -> - FStar_Pervasives_Native.Some ret_ty - | FStarC_Reflection_V1_Data.C_GTotal ret_ty -> - FStar_Pervasives_Native.Some ret_ty - | uu___ -> FStar_Pervasives_Native.None -let (get_comp_ret_type : - FStarC_Reflection_Types.comp -> FStarC_Reflection_Types.typ) = - fun c -> - match FStarC_Reflection_V1_Builtins.inspect_comp c with - | FStarC_Reflection_V1_Data.C_Total ret_ty -> ret_ty - | FStarC_Reflection_V1_Data.C_GTotal ret_ty -> ret_ty - | FStarC_Reflection_V1_Data.C_Eff (uu___, uu___1, ret_ty, uu___2, uu___3) - -> ret_ty - | FStarC_Reflection_V1_Data.C_Lemma (uu___, uu___1, uu___2) -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv ["Prims"; "unit"])) -let (is_total_or_gtotal : FStarC_Reflection_Types.comp -> Prims.bool) = - fun c -> - FStar_Pervasives_Native.uu___is_Some (get_total_or_gtotal_ret_type c) -let (is_unit_type : - FStarC_Reflection_Types.typ -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun ty -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (135)) (Prims.of_int (8)) (Prims.of_int (135)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (135)) (Prims.of_int (2)) (Prims.of_int (137)) - (Prims.of_int (14))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_FVar fv -> - FStar_InteractiveHelpers_Base.fv_eq_name fv - FStar_Reflection_Const.unit_lid - | uu___3 -> false)) -type typ_or_comp = - | TC_Typ of FStarC_Reflection_Types.typ * FStarC_Reflection_Types.binder - Prims.list * Prims.nat - | TC_Comp of FStarC_Reflection_Types.comp * FStarC_Reflection_Types.binder - Prims.list * Prims.nat -let (uu___is_TC_Typ : typ_or_comp -> Prims.bool) = - fun projectee -> - match projectee with - | TC_Typ (v, pl, num_unflushed) -> true - | uu___ -> false -let (__proj__TC_Typ__item__v : typ_or_comp -> FStarC_Reflection_Types.typ) = - fun projectee -> match projectee with | TC_Typ (v, pl, num_unflushed) -> v -let (__proj__TC_Typ__item__pl : - typ_or_comp -> FStarC_Reflection_Types.binder Prims.list) = - fun projectee -> match projectee with | TC_Typ (v, pl, num_unflushed) -> pl -let (__proj__TC_Typ__item__num_unflushed : typ_or_comp -> Prims.nat) = - fun projectee -> - match projectee with | TC_Typ (v, pl, num_unflushed) -> num_unflushed -let (uu___is_TC_Comp : typ_or_comp -> Prims.bool) = - fun projectee -> - match projectee with - | TC_Comp (v, pl, num_unflushed) -> true - | uu___ -> false -let (__proj__TC_Comp__item__v : typ_or_comp -> FStarC_Reflection_Types.comp) - = - fun projectee -> match projectee with | TC_Comp (v, pl, num_unflushed) -> v -let (__proj__TC_Comp__item__pl : - typ_or_comp -> FStarC_Reflection_Types.binder Prims.list) = - fun projectee -> - match projectee with | TC_Comp (v, pl, num_unflushed) -> pl -let (__proj__TC_Comp__item__num_unflushed : typ_or_comp -> Prims.nat) = - fun projectee -> - match projectee with | TC_Comp (v, pl, num_unflushed) -> num_unflushed -let (typ_or_comp_to_string : - typ_or_comp -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun tyc -> - match tyc with - | TC_Typ (v, pl, num_unflushed) -> - let uu___ = - let uu___1 = FStarC_Tactics_V1_Builtins.term_to_string v in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (163)) (Prims.of_int (17)) - (Prims.of_int (163)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (163)) (Prims.of_int (17)) - (Prims.of_int (164)) (Prims.of_int (37))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - let uu___4 = - let uu___5 = - FStar_InteractiveHelpers_Base.list_to_string - (fun b -> FStar_Tactics_V1_Derived.name_of_binder b) - pl in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (163)) (Prims.of_int (43)) - (Prims.of_int (163)) (Prims.of_int (88))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat uu___6 - (Prims.strcat " " - (Prims.string_of_int num_unflushed)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (163)) (Prims.of_int (43)) - (Prims.of_int (164)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat ") " uu___5)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (163)) (Prims.of_int (36)) - (Prims.of_int (164)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat uu___2 uu___4)))) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (163)) (Prims.of_int (17)) - (Prims.of_int (164)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "TC_Typ (" uu___1)) - | TC_Comp (c, pl, num_unflushed) -> - let uu___ = - let uu___1 = FStar_InteractiveHelpers_Base.acomp_to_string c in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (166)) (Prims.of_int (18)) - (Prims.of_int (166)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (166)) (Prims.of_int (18)) - (Prims.of_int (167)) (Prims.of_int (37))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - let uu___4 = - let uu___5 = - FStar_InteractiveHelpers_Base.list_to_string - (fun b -> FStar_Tactics_V1_Derived.name_of_binder b) - pl in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (166)) (Prims.of_int (45)) - (Prims.of_int (166)) (Prims.of_int (90))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat uu___6 - (Prims.strcat " " - (Prims.string_of_int num_unflushed)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (166)) (Prims.of_int (45)) - (Prims.of_int (167)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat ") " uu___5)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (166)) (Prims.of_int (38)) - (Prims.of_int (167)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat uu___2 uu___4)))) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (166)) (Prims.of_int (18)) - (Prims.of_int (167)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> Prims.strcat "TC_Comp (" uu___1)) -let (params_of_typ_or_comp : - typ_or_comp -> FStarC_Reflection_Types.binder Prims.list) = - fun c -> - match c with - | TC_Typ (uu___, pl, uu___1) -> pl - | TC_Comp (uu___, pl, uu___1) -> pl -let (num_unflushed_of_typ_or_comp : typ_or_comp -> Prims.nat) = - fun c -> - match c with - | TC_Typ (uu___, uu___1, n) -> n - | TC_Comp (uu___, uu___1, n) -> n -let (safe_typ_or_comp : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (typ_or_comp FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun t -> - let uu___ = safe_tcc e t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (183)) (Prims.of_int (8)) - (Prims.of_int (183)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (183)) (Prims.of_int (2)) - (Prims.of_int (193)) (Prims.of_int (25))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.None -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - FStarC_Tactics_V1_Builtins.term_to_string t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (186)) - (Prims.of_int (33)) - (Prims.of_int (186)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat uu___7 "\n-comp: None")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (186)) (Prims.of_int (33)) - (Prims.of_int (187)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat "\n-term: " uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (186)) (Prims.of_int (19)) - (Prims.of_int (187)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat "[> safe_typ_or_comp:" uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (185)) (Prims.of_int (18)) - (Prims.of_int (187)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (185)) (Prims.of_int (4)) - (Prims.of_int (187)) (Prims.of_int (35))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg - uu___4)) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (185)) (Prims.of_int (4)) - (Prims.of_int (187)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (188)) (Prims.of_int (4)) - (Prims.of_int (188)) (Prims.of_int (8))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> FStar_Pervasives_Native.None))) - | FStar_Pervasives_Native.Some c -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - FStarC_Tactics_V1_Builtins.term_to_string t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (191)) - (Prims.of_int (33)) - (Prims.of_int (191)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (191)) - (Prims.of_int (33)) - (Prims.of_int (192)) - (Prims.of_int (50))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - let uu___8 = - let uu___9 = - FStar_InteractiveHelpers_Base.acomp_to_string - c in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (192)) - (Prims.of_int (33)) - (Prims.of_int (192)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> - Prims.strcat "\n-comp: " - uu___10)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (192)) - (Prims.of_int (19)) - (Prims.of_int (192)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - Prims.strcat uu___7 uu___9)))) - uu___7) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (191)) (Prims.of_int (33)) - (Prims.of_int (192)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat "\n-term: " uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (191)) (Prims.of_int (19)) - (Prims.of_int (192)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat "[> safe_typ_or_comp:" uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (190)) (Prims.of_int (18)) - (Prims.of_int (192)) (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (190)) (Prims.of_int (4)) - (Prims.of_int (192)) (Prims.of_int (51))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg - uu___4)) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (190)) (Prims.of_int (4)) - (Prims.of_int (192)) (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (193)) (Prims.of_int (4)) - (Prims.of_int (193)) (Prims.of_int (25))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Pervasives_Native.Some - (TC_Comp (c, [], Prims.int_zero)))))) - uu___1) -let (subst_bv_in_comp : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.bv -> - FStarC_Reflection_Types.typ -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.comp -> - (FStarC_Reflection_Types.comp, unit) - FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun b -> - fun sort -> - fun t -> - fun c -> - FStar_InteractiveHelpers_Base.apply_subst_in_comp e c - [((b, sort), t)] -let (subst_binder_in_comp : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.binder -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.comp -> - (FStarC_Reflection_Types.comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun b -> - fun t -> - fun c -> - let uu___ = FStar_Tactics_V1_Derived.binder_sort b in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (201)) (Prims.of_int (38)) - (Prims.of_int (201)) (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (201)) (Prims.of_int (2)) - (Prims.of_int (201)) (Prims.of_int (57))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (subst_bv_in_comp e - (FStar_Reflection_V1_Derived.bv_of_binder b) uu___1 t - c)) uu___1) -let rec (unfold_until_arrow : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.typ -> - (FStarC_Reflection_Types.typ, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun ty0 -> - let uu___ = - let uu___1 = FStarC_Tactics_V1_Builtins.inspect ty0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (207)) (Prims.of_int (15)) - (Prims.of_int (207)) (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (207)) (Prims.of_int (5)) - (Prims.of_int (207)) (Prims.of_int (28))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Reflection_V1_Data.uu___is_Tv_Arrow uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (207)) (Prims.of_int (5)) (Prims.of_int (207)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (207)) (Prims.of_int (2)) (Prims.of_int (251)) - (Prims.of_int (7))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - if uu___1 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ty0))) - else - Obj.magic - (Obj.repr - (let uu___3 = - FStarC_Tactics_V1_Builtins.norm_term_env e [] ty0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (211)) (Prims.of_int (13)) - (Prims.of_int (211)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (211)) (Prims.of_int (38)) - (Prims.of_int (250)) (Prims.of_int (75))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun ty -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - fun fv -> - let uu___6 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_FVar - fv) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (214)) - (Prims.of_int (15)) - (Prims.of_int (214)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (214)) - (Prims.of_int (35)) - (Prims.of_int (224)) - (Prims.of_int (9))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun ty1 -> - let uu___7 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - FStar_Reflection_V1_Derived.flatten_name - (FStarC_Reflection_V1_Builtins.inspect_fv - fv))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (215)) - (Prims.of_int (16)) - (Prims.of_int (215)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (215)) - (Prims.of_int (47)) - (Prims.of_int (224)) - (Prims.of_int (9))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun fvn -> - let uu___8 = - FStarC_Tactics_V1_Builtins.norm_term_env - e - [FStar_Pervasives.delta_only - [fvn]] - ty1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (217)) - (Prims.of_int (16)) - (Prims.of_int (217)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (219)) - (Prims.of_int (12)) - (Prims.of_int (223)) - (Prims.of_int (16))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - (fun ty' - -> - let uu___9 - = - FStarC_Tactics_V1_Builtins.inspect - ty' in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (219)) - (Prims.of_int (18)) - (Prims.of_int (219)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (219)) - (Prims.of_int (12)) - (Prims.of_int (223)) - (Prims.of_int (16))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - match uu___10 - with - | - FStarC_Reflection_V1_Data.Tv_FVar - fv' -> - Obj.magic - (Obj.repr - (if - (FStar_Reflection_V1_Derived.flatten_name - (FStarC_Reflection_V1_Builtins.inspect_fv - fv')) = - fvn - then - Obj.repr - (let uu___11 - = - let uu___12 - = - FStarC_Tactics_V1_Builtins.term_to_string - ty0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (222)) - (Prims.of_int (63)) - (Prims.of_int (222)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - Prims.strcat - "unfold_until_arrow: could not unfold: " - uu___13)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (222)) - (Prims.of_int (19)) - (Prims.of_int (222)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (222)) - (Prims.of_int (13)) - (Prims.of_int (222)) - (Prims.of_int (82))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___12)) - uu___12)) - else - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> ty')))) - | - uu___11 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> ty')))) - uu___10))) - uu___9))) - uu___8))) uu___7))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (213)) - (Prims.of_int (40)) - (Prims.of_int (224)) - (Prims.of_int (9))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (227)) - (Prims.of_int (4)) - (Prims.of_int (250)) - (Prims.of_int (75))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun unfold_fv -> - let uu___5 = - FStarC_Tactics_V1_Builtins.inspect - ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (227)) - (Prims.of_int (10)) - (Prims.of_int (227)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (227)) - (Prims.of_int (4)) - (Prims.of_int (250)) - (Prims.of_int (75))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 with - | FStarC_Reflection_V1_Data.Tv_Arrow - (uu___7, uu___8) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___9 - -> ty))) - | FStarC_Reflection_V1_Data.Tv_FVar - fv -> - Obj.magic - (Obj.repr - (let uu___7 = - unfold_fv fv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (231)) - (Prims.of_int (16)) - (Prims.of_int (231)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (232)) - (Prims.of_int (6)) - (Prims.of_int (232)) - (Prims.of_int (30))))) - (Obj.magic - uu___7) - (fun uu___8 - -> - (fun ty' - -> - Obj.magic - (unfold_until_arrow - e ty')) - uu___8))) - | FStarC_Reflection_V1_Data.Tv_App - (uu___7, uu___8) -> - Obj.magic - (Obj.repr - (let uu___9 = - FStar_Tactics_V1_SyntaxHelpers.collect_app - ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (235)) - (Prims.of_int (21)) - (Prims.of_int (235)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (233)) - (Prims.of_int (19)) - (Prims.of_int (242)) - (Prims.of_int (9))))) - (Obj.magic - uu___9) - (fun uu___10 - -> - (fun - uu___10 - -> - match uu___10 - with - | - (hd, - args) -> - let uu___11 - = - FStarC_Tactics_V1_Builtins.inspect - hd in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (236)) - (Prims.of_int (18)) - (Prims.of_int (236)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (236)) - (Prims.of_int (12)) - (Prims.of_int (241)) - (Prims.of_int (82))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - match uu___12 - with - | - FStarC_Reflection_V1_Data.Tv_FVar - fv -> - let uu___13 - = - unfold_fv - fv in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (238)) - (Prims.of_int (18)) - (Prims.of_int (238)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (238)) - (Prims.of_int (33)) - (Prims.of_int (240)) - (Prims.of_int (32))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun hd' - -> - let uu___14 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - FStar_Reflection_V1_Derived.mk_app - hd' args)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (239)) - (Prims.of_int (18)) - (Prims.of_int (239)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (240)) - (Prims.of_int (8)) - (Prims.of_int (240)) - (Prims.of_int (32))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun ty' - -> - Obj.magic - (unfold_until_arrow - e ty')) - uu___15))) - uu___14)) - | - uu___13 - -> - let uu___14 - = - let uu___15 - = - FStarC_Tactics_V1_Builtins.term_to_string - ty0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (241)) - (Prims.of_int (63)) - (Prims.of_int (241)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - Prims.strcat - "unfold_until_arrow: could not unfold: " - uu___16)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (241)) - (Prims.of_int (19)) - (Prims.of_int (241)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (241)) - (Prims.of_int (13)) - (Prims.of_int (241)) - (Prims.of_int (82))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___15)) - uu___15))) - uu___12))) - uu___10))) - | FStarC_Reflection_V1_Data.Tv_Refine - (bv, sort, ref) -> - Obj.magic - (Obj.repr - (unfold_until_arrow - e sort)) - | FStarC_Reflection_V1_Data.Tv_AscribedT - (body, uu___7, - uu___8, uu___9) - -> - Obj.magic - (Obj.repr - (unfold_until_arrow - e body)) - | FStarC_Reflection_V1_Data.Tv_AscribedC - (body, uu___7, - uu___8, uu___9) - -> - Obj.magic - (Obj.repr - (unfold_until_arrow - e body)) - | uu___7 -> - Obj.magic - (Obj.repr - (let uu___8 = - let uu___9 = - FStarC_Tactics_V1_Builtins.term_to_string - ty0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (250)) - (Prims.of_int (56)) - (Prims.of_int (250)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Prims.strcat - "unfold_until_arrow: could not unfold: " - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (250)) - (Prims.of_int (12)) - (Prims.of_int (250)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (250)) - (Prims.of_int (6)) - (Prims.of_int (250)) - (Prims.of_int (75))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - (fun - uu___9 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___9)) - uu___9)))) - uu___6))) uu___5))) uu___4)))) - uu___1) -let (inst_comp_once : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.comp -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun c -> - fun t -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> get_comp_ret_type c)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (256)) (Prims.of_int (11)) - (Prims.of_int (256)) (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (256)) (Prims.of_int (33)) - (Prims.of_int (263)) (Prims.of_int (5))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun ty -> - let uu___1 = unfold_until_arrow e ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (257)) (Prims.of_int (12)) - (Prims.of_int (257)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (258)) (Prims.of_int (8)) - (Prims.of_int (262)) (Prims.of_int (46))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun ty' -> - let uu___2 = - FStarC_Tactics_V1_Builtins.inspect ty' in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (258)) - (Prims.of_int (14)) - (Prims.of_int (258)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (258)) - (Prims.of_int (8)) - (Prims.of_int (262)) - (Prims.of_int (46))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStarC_Reflection_V1_Data.Tv_Arrow - (b1, c1) -> - Obj.magic - (subst_binder_in_comp e b1 t c1) - | uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - "inst_comp_once: inconsistent state")) - uu___3))) uu___2))) uu___1) -let rec (inst_comp : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.comp -> - FStarC_Reflection_Types.term Prims.list -> - (FStarC_Reflection_Types.comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun e -> - fun c -> - fun tl -> - match tl with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> c))) - | t::tl' -> - Obj.magic - (Obj.repr - (let uu___ = - FStar_Tactics_V1_Derived.try_with - (fun uu___1 -> - match () with | () -> inst_comp_once e c t) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_InteractiveHelpers_Base.MetaAnalysis - msg -> - Obj.magic - (Obj.repr - (FStar_InteractiveHelpers_Base.mfail_doc - (FStar_List_Tot_Base.op_At - [FStar_Pprint.arbitrary_string - "inst_comp: error"] msg))) - | err -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.raise err))) - uu___1) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (270)) (Prims.of_int (13)) - (Prims.of_int (272)) (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (274)) (Prims.of_int (4)) - (Prims.of_int (274)) (Prims.of_int (22))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun c' -> Obj.magic (inst_comp e c' tl')) - uu___1)))) uu___2 uu___1 uu___ -let (_abs_update_typ : - FStarC_Reflection_Types.binder -> - FStarC_Reflection_Types.typ -> - FStarC_Reflection_Types.binder Prims.list -> - FStarC_Reflection_Types.env -> - (typ_or_comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun b -> - fun ty -> - fun pl -> - fun e -> - FStar_Tactics_V1_Derived.try_with - (fun uu___ -> - match () with - | () -> - let uu___1 = unfold_until_arrow e ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (289)) (Prims.of_int (14)) - (Prims.of_int (289)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (290)) (Prims.of_int (10)) - (Prims.of_int (295)) (Prims.of_int (49))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun ty' -> - let uu___2 = - FStarC_Tactics_V1_Builtins.inspect ty' in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (290)) - (Prims.of_int (16)) - (Prims.of_int (290)) - (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (290)) - (Prims.of_int (10)) - (Prims.of_int (295)) - (Prims.of_int (49))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStarC_Reflection_V1_Data.Tv_Arrow - (b1, c1) -> - let uu___4 = - let uu___5 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - (FStar_Reflection_V1_Derived.bv_of_binder - b)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (292)) - (Prims.of_int (42)) - (Prims.of_int (292)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (292)) - (Prims.of_int (16)) - (Prims.of_int (292)) - (Prims.of_int (77))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (subst_binder_in_comp e - b1 uu___6 c1)) - uu___6) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (292)) - (Prims.of_int (16)) - (Prims.of_int (292)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (293)) - (Prims.of_int (6)) - (Prims.of_int (293)) - (Prims.of_int (29))))) - (Obj.magic uu___4) - (fun c1' -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - TC_Comp - (c1', (b :: pl), - Prims.int_zero)))) - | uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - "_abs_update_typ: inconsistent state")) - uu___3))) uu___2)) - (fun uu___ -> - (fun uu___ -> - match uu___ with - | FStar_InteractiveHelpers_Base.MetaAnalysis msg -> - Obj.magic - (Obj.repr - (let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStarC_Tactics_V1_Builtins.term_to_string - ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (300)) - (Prims.of_int (62)) - (Prims.of_int (300)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat - "_abs_update_typ: could not find an arrow in " - uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (300)) - (Prims.of_int (12)) - (Prims.of_int (300)) - (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (300)) - (Prims.of_int (7)) - (Prims.of_int (300)) - (Prims.of_int (80))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStarC_Errors_Msg.text uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (300)) - (Prims.of_int (7)) - (Prims.of_int (300)) - (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (300)) - (Prims.of_int (6)) - (Prims.of_int (300)) - (Prims.of_int (81))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> [uu___4])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (300)) - (Prims.of_int (6)) - (Prims.of_int (300)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (299)) - (Prims.of_int (14)) - (Prims.of_int (302)) - (Prims.of_int (5))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_List_Tot_Base.op_At uu___3 msg)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (299)) - (Prims.of_int (14)) - (Prims.of_int (302)) - (Prims.of_int (5))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (299)) - (Prims.of_int (4)) - (Prims.of_int (302)) - (Prims.of_int (5))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail_doc - uu___2)) uu___2))) - | err -> - Obj.magic (Obj.repr (FStar_Tactics_Effect.raise err))) - uu___) -let (abs_update_typ_or_comp : - FStarC_Reflection_Types.binder -> - typ_or_comp -> - FStarC_Reflection_Types.env -> - (typ_or_comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun b -> - fun c -> - fun e -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - match c with - | TC_Typ (v, pl, n) -> - TC_Typ (v, (b :: pl), (n + Prims.int_one)) - | TC_Comp (v, pl, n) -> - TC_Comp (v, (b :: pl), (n + Prims.int_one))))) - uu___2 uu___1 uu___ -let (abs_update_opt_typ_or_comp : - FStarC_Reflection_Types.binder -> - typ_or_comp FStar_Pervasives_Native.option -> - FStarC_Reflection_Types.env -> - (typ_or_comp FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun b -> - fun opt_c -> - fun e -> - match opt_c with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.None))) - | FStar_Pervasives_Native.Some c -> - Obj.magic - (Obj.repr - (FStar_Tactics_V1_Derived.try_with - (fun uu___ -> - match () with - | () -> - let uu___1 = abs_update_typ_or_comp b c e in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (324)) - (Prims.of_int (14)) - (Prims.of_int (324)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (325)) - (Prims.of_int (6)) - (Prims.of_int (325)) - (Prims.of_int (12))))) - (Obj.magic uu___1) - (fun c1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Pervasives_Native.Some c1))) - (fun uu___ -> - (fun uu___ -> - match uu___ with - | FStar_InteractiveHelpers_Base.MetaAnalysis - msg -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Pervasives_Native.None)) - | err -> - Obj.magic - (FStar_Tactics_Effect.raise err)) - uu___)))) uu___2 uu___1 uu___ -let rec (_flush_typ_or_comp_comp : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.binder Prims.list -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) * - FStarC_Reflection_Types.term) Prims.list -> - FStarC_Reflection_Types.comp -> - (FStarC_Reflection_Types.comp, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun rem -> - fun inst -> - fun c -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun c1 -> - fun inst1 -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> FStar_List_Tot_Base.rev inst1)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (342)) (Prims.of_int (15)) - (Prims.of_int (342)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (343)) (Prims.of_int (4)) - (Prims.of_int (343)) (Prims.of_int (32))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun inst2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.apply_subst_in_comp - e c1 inst2)) uu___3))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (341)) (Prims.of_int (20)) - (Prims.of_int (343)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (345)) (Prims.of_int (2)) - (Prims.of_int (362)) (Prims.of_int (86))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun flush -> - match rem with - | [] -> Obj.magic (flush c inst) - | b::rem' -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> get_comp_ret_type c)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (351)) - (Prims.of_int (13)) - (Prims.of_int (351)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (351)) - (Prims.of_int (35)) - (Prims.of_int (362)) - (Prims.of_int (86))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun ty -> - let uu___2 = - let uu___3 = - let uu___4 = - FStarC_Tactics_V1_Builtins.inspect - ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (353)) - (Prims.of_int (19)) - (Prims.of_int (353)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (353)) - (Prims.of_int (9)) - (Prims.of_int (353)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStarC_Reflection_V1_Data.uu___is_Tv_Arrow - uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (353)) - (Prims.of_int (9)) - (Prims.of_int (353)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (353)) - (Prims.of_int (6)) - (Prims.of_int (354)) - (Prims.of_int (47))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - if uu___4 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - (ty, inst)))) - else - Obj.magic - (Obj.repr - (let uu___6 = - let uu___7 = - flush c inst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (354)) - (Prims.of_int (29)) - (Prims.of_int (354)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (354)) - (Prims.of_int (11)) - (Prims.of_int (354)) - (Prims.of_int (43))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - get_comp_ret_type - uu___8)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (354)) - (Prims.of_int (11)) - (Prims.of_int (354)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (354)) - (Prims.of_int (11)) - (Prims.of_int (354)) - (Prims.of_int (47))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (uu___7, [])))))) - uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (353)) - (Prims.of_int (6)) - (Prims.of_int (354)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (351)) - (Prims.of_int (35)) - (Prims.of_int (362)) - (Prims.of_int (86))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (ty1, inst') -> - let uu___4 = - FStarC_Tactics_V1_Builtins.inspect - ty1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (356)) - (Prims.of_int (10)) - (Prims.of_int (356)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (356)) - (Prims.of_int (4)) - (Prims.of_int (362)) - (Prims.of_int (86))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 - with - | FStarC_Reflection_V1_Data.Tv_Arrow - (b', c') -> - let uu___6 = - let uu___7 - = - let uu___8 - = - let uu___9 - = - FStar_Tactics_V1_Derived.binder_sort - b' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (61)) - (Prims.of_int (358)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (43)) - (Prims.of_int (358)) - (Prims.of_int (76))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - ((FStar_Reflection_V1_Derived.bv_of_binder - b'), - uu___10))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (43)) - (Prims.of_int (358)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (42)) - (Prims.of_int (358)) - (Prims.of_int (109))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - let uu___10 - = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - (FStar_Reflection_V1_Derived.bv_of_binder - b)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (78)) - (Prims.of_int (358)) - (Prims.of_int (108))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (42)) - (Prims.of_int (358)) - (Prims.of_int (109))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (uu___9, - uu___11))))) - uu___9) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (42)) - (Prims.of_int (358)) - (Prims.of_int (109))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (41)) - (Prims.of_int (358)) - (Prims.of_int (116))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - uu___8 :: - inst)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (41)) - (Prims.of_int (358)) - (Prims.of_int (116))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (358)) - (Prims.of_int (6)) - (Prims.of_int (358)) - (Prims.of_int (119))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun - uu___7 -> - Obj.magic - (_flush_typ_or_comp_comp - dbg e - rem' - uu___7 c')) - uu___7)) - | uu___6 -> - let uu___7 = - let uu___8 - = - let uu___9 - = - let uu___10 - = - FStar_InteractiveHelpers_Base.acomp_to_string - c in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (361)) - (Prims.of_int (27)) - (Prims.of_int (361)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (361)) - (Prims.of_int (27)) - (Prims.of_int (362)) - (Prims.of_int (85))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - let uu___12 - = - let uu___13 - = - FStar_InteractiveHelpers_Base.list_to_string - (fun b1 - -> - FStar_Tactics_V1_Derived.name_of_binder - b1) rem in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (362)) - (Prims.of_int (39)) - (Prims.of_int (362)) - (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - Prims.strcat - "\n-remaning binders: " - uu___14)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (362)) - (Prims.of_int (13)) - (Prims.of_int (362)) - (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - Prims.strcat - uu___11 - uu___13)))) - uu___11) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (361)) - (Prims.of_int (27)) - (Prims.of_int (362)) - (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Prims.strcat - "\n-comp: " - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (361)) - (Prims.of_int (13)) - (Prims.of_int (362)) - (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - Prims.strcat - "_flush_typ_or_comp: inconsistent state" - uu___9)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (360)) - (Prims.of_int (12)) - (Prims.of_int (362)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (360)) - (Prims.of_int (6)) - (Prims.of_int (362)) - (Prims.of_int (86))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___8)) - uu___8))) - uu___5))) uu___3))) - uu___2))) uu___1) -let (flush_typ_or_comp : - Prims.bool -> - FStarC_Reflection_Types.env -> - typ_or_comp -> (typ_or_comp, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun tyc -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun pl -> - fun n -> - fun c -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStar_List_Tot_Base.splitAt n pl)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (366)) (Prims.of_int (17)) - (Prims.of_int (366)) (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (365)) (Prims.of_int (88)) - (Prims.of_int (369)) (Prims.of_int (18))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (pl', uu___4) -> - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_List_Tot_Base.rev pl')) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (367)) - (Prims.of_int (14)) - (Prims.of_int (367)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (367)) - (Prims.of_int (33)) - (Prims.of_int (369)) - (Prims.of_int (18))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun pl'1 -> - let uu___6 = - _flush_typ_or_comp_comp dbg - e pl'1 [] c in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (368)) - (Prims.of_int (12)) - (Prims.of_int (368)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (369)) - (Prims.of_int (4)) - (Prims.of_int (369)) - (Prims.of_int (18))))) - (Obj.magic uu___6) - (fun c1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - TC_Comp - (c1, pl, - Prims.int_zero))))) - uu___6))) uu___3))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (365)) (Prims.of_int (88)) - (Prims.of_int (369)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (371)) (Prims.of_int (2)) - (Prims.of_int (379)) (Prims.of_int (25))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun flush_comp -> - Obj.magic - (FStar_Tactics_V1_Derived.try_with - (fun uu___1 -> - match () with - | () -> - (match tyc with - | TC_Typ (ty, pl, n) -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStarC_Reflection_V1_Builtins.pack_comp - (FStarC_Reflection_V1_Data.C_Total - ty))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (373)) - (Prims.of_int (12)) - (Prims.of_int (373)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (374)) - (Prims.of_int (4)) - (Prims.of_int (374)) - (Prims.of_int (21))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun c -> Obj.magic (flush_comp pl n c)) - uu___3) - | TC_Comp (c, pl, n) -> flush_comp pl n c)) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_InteractiveHelpers_Base.MetaAnalysis msg - -> - Obj.magic - (Obj.repr - (let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - typ_or_comp_to_string tyc in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (61)) - (Prims.of_int (378)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat - "flush_typ_or_comp failed on: " - uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (26)) - (Prims.of_int (378)) - (Prims.of_int (87))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (21)) - (Prims.of_int (378)) - (Prims.of_int (87))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - FStarC_Errors_Msg.text - uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (21)) - (Prims.of_int (378)) - (Prims.of_int (87))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (20)) - (Prims.of_int (378)) - (Prims.of_int (88))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> [uu___5])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (20)) - (Prims.of_int (378)) - (Prims.of_int (88))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (19)) - (Prims.of_int (378)) - (Prims.of_int (96))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_List_Tot_Base.op_At - uu___4 msg)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (19)) - (Prims.of_int (378)) - (Prims.of_int (96))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (378)) - (Prims.of_int (9)) - (Prims.of_int (378)) - (Prims.of_int (96))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail_doc - uu___3)) uu___3))) - | err -> - Obj.magic - (Obj.repr (FStar_Tactics_Effect.raise err))) - uu___1))) uu___1) -let (safe_arg_typ_or_comp : - Prims.bool -> - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (typ_or_comp FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun e -> - fun hd -> - let uu___ = - let uu___1 = - let uu___2 = FStarC_Tactics_V1_Builtins.term_to_string hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (386)) (Prims.of_int (44)) - (Prims.of_int (386)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat "safe_arg_typ_or_comp: " uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (386)) (Prims.of_int (16)) - (Prims.of_int (386)) (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (386)) (Prims.of_int (2)) - (Prims.of_int (386)) (Prims.of_int (62))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___2)) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (386)) (Prims.of_int (2)) - (Prims.of_int (386)) (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (387)) (Prims.of_int (2)) - (Prims.of_int (407)) (Prims.of_int (15))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = safe_tc e hd in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (387)) (Prims.of_int (8)) - (Prims.of_int (387)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (387)) (Prims.of_int (2)) - (Prims.of_int (407)) (Prims.of_int (15))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Pervasives_Native.None))) - | FStar_Pervasives_Native.Some ty -> - Obj.magic - (Obj.repr - (let uu___4 = - let uu___5 = - let uu___6 = - FStarC_Tactics_V1_Builtins.term_to_string - ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (390)) - (Prims.of_int (33)) - (Prims.of_int (390)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat "hd type: " - uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (390)) - (Prims.of_int (18)) - (Prims.of_int (390)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (390)) - (Prims.of_int (4)) - (Prims.of_int (390)) - (Prims.of_int (51))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___6)) uu___6) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (390)) - (Prims.of_int (4)) - (Prims.of_int (390)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (390)) - (Prims.of_int (52)) - (Prims.of_int (407)) - (Prims.of_int (15))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = - FStarC_Tactics_V1_Builtins.inspect - ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (392)) - (Prims.of_int (19)) - (Prims.of_int (392)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (392)) - (Prims.of_int (9)) - (Prims.of_int (392)) - (Prims.of_int (31))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - FStarC_Reflection_V1_Data.uu___is_Tv_Arrow - uu___9)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (392)) - (Prims.of_int (9)) - (Prims.of_int (392)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (392)) - (Prims.of_int (6)) - (Prims.of_int (403)) - (Prims.of_int (11))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - if uu___8 - then - let uu___9 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "no need to unfold the type" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (394)) - (Prims.of_int (8)) - (Prims.of_int (394)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (389)) - (Prims.of_int (9)) - (Prims.of_int (389)) - (Prims.of_int (11))))) - (Obj.magic - uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> ty))) - else - (let uu___10 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "need to unfold the type" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (399)) - (Prims.of_int (8)) - (Prims.of_int (399)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (399)) - (Prims.of_int (48)) - (Prims.of_int (402)) - (Prims.of_int (10))))) - (Obj.magic - uu___10) - (fun uu___11 - -> - (fun - uu___11 - -> - let uu___12 - = - unfold_until_arrow - e ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (400)) - (Prims.of_int (17)) - (Prims.of_int (400)) - (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (401)) - (Prims.of_int (8)) - (Prims.of_int (402)) - (Prims.of_int (10))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun ty1 - -> - let uu___13 - = - let uu___14 - = - let uu___15 - = - FStarC_Tactics_V1_Builtins.term_to_string - ty1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (401)) - (Prims.of_int (49)) - (Prims.of_int (401)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - Prims.strcat - "result of unfolding : " - uu___16)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (401)) - (Prims.of_int (22)) - (Prims.of_int (401)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (401)) - (Prims.of_int (8)) - (Prims.of_int (401)) - (Prims.of_int (67))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___15)) - uu___15) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (401)) - (Prims.of_int (8)) - (Prims.of_int (401)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (400)) - (Prims.of_int (12)) - (Prims.of_int (400)) - (Prims.of_int (14))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> ty1)))) - uu___13))) - uu___11)))) - uu___8) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (392)) - (Prims.of_int (6)) - (Prims.of_int (403)) - (Prims.of_int (11))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (405)) - (Prims.of_int (4)) - (Prims.of_int (407)) - (Prims.of_int (15))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun ty1 -> - let uu___7 = - FStarC_Tactics_V1_Builtins.inspect - ty1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (405)) - (Prims.of_int (10)) - (Prims.of_int (405)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (405)) - (Prims.of_int (4)) - (Prims.of_int (407)) - (Prims.of_int (15))))) - (Obj.magic - uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 - -> - match uu___8 - with - | - FStarC_Reflection_V1_Data.Tv_Arrow - (b, c) -> - FStar_Pervasives_Native.Some - (TC_Typ - ((FStar_Reflection_V1_Derived.type_of_binder - b), [], - Prims.int_zero)) - | - uu___10 - -> - FStar_Pervasives_Native.None)))) - uu___7))) uu___5)))) - uu___3))) uu___1) -let (convert_ctrl_flag : - FStarC_Tactics_Types.ctrl_flag -> FStarC_Tactics_Types.ctrl_flag) = - fun flag -> - match flag with - | FStarC_Tactics_Types.Continue -> FStarC_Tactics_Types.Continue - | FStarC_Tactics_Types.Skip -> FStarC_Tactics_Types.Continue - | FStarC_Tactics_Types.Abort -> FStarC_Tactics_Types.Abort -type 'a explorer = - 'a -> - FStar_InteractiveHelpers_Base.genv -> - (FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_V1_Data.term_view) Prims.list -> - typ_or_comp FStar_Pervasives_Native.option -> - FStarC_Reflection_V1_Data.term_view -> - (('a * FStarC_Tactics_Types.ctrl_flag), unit) - FStar_Tactics_Effect.tac_repr -let bind_expl : - 'a . - 'a -> - ('a -> - (('a * FStarC_Tactics_Types.ctrl_flag), unit) - FStar_Tactics_Effect.tac_repr) - -> - ('a -> - (('a * FStarC_Tactics_Types.ctrl_flag), unit) - FStar_Tactics_Effect.tac_repr) - -> - (('a * FStarC_Tactics_Types.ctrl_flag), unit) - FStar_Tactics_Effect.tac_repr - = - fun x -> - fun f1 -> - fun f2 -> - let uu___ = f1 x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (438)) (Prims.of_int (18)) - (Prims.of_int (438)) (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (437)) (Prims.of_int (92)) - (Prims.of_int (441)) (Prims.of_int (34))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (x1, flag1) -> - if flag1 = FStarC_Tactics_Types.Continue - then Obj.magic (Obj.repr (f2 x1)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> (x1, (convert_ctrl_flag flag1)))))) - uu___1) -let rec (explore_term : - Prims.bool -> - Prims.bool -> - unit -> - Obj.t explorer -> - Obj.t -> - FStar_InteractiveHelpers_Base.genv -> - (FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_V1_Data.term_view) Prims.list -> - typ_or_comp FStar_Pervasives_Native.option -> - FStarC_Reflection_Types.term -> - ((Obj.t * FStarC_Tactics_Types.ctrl_flag), unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun dfs -> - fun a -> - fun f -> - fun x -> - fun ge0 -> - fun pl0 -> - fun c0 -> - fun t0 -> - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - FStar_InteractiveHelpers_Base.term_construct t0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) (Prims.of_int (39)) - (Prims.of_int (470)) (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) (Prims.of_int (39)) - (Prims.of_int (470)) (Prims.of_int (84))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = - let uu___6 = - FStarC_Tactics_V1_Builtins.term_to_string - t0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) - (Prims.of_int (67)) - (Prims.of_int (470)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat ":\n" uu___7)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) - (Prims.of_int (59)) - (Prims.of_int (470)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat uu___4 uu___6)))) - uu___4) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) (Prims.of_int (39)) - (Prims.of_int (470)) (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat "[> explore_term: " uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) (Prims.of_int (16)) - (Prims.of_int (470)) (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) (Prims.of_int (2)) - (Prims.of_int (470)) (Prims.of_int (85))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg - uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) (Prims.of_int (2)) - (Prims.of_int (470)) (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (470)) (Prims.of_int (86)) - (Prims.of_int (550)) (Prims.of_int (33))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - FStarC_Tactics_V1_Builtins.inspect t0 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (471)) - (Prims.of_int (12)) - (Prims.of_int (471)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (471)) - (Prims.of_int (25)) - (Prims.of_int (550)) - (Prims.of_int (33))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun tv0 -> - let uu___3 = f x ge0 pl0 c0 tv0 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (472)) - (Prims.of_int (17)) - (Prims.of_int (472)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (471)) - (Prims.of_int (25)) - (Prims.of_int (550)) - (Prims.of_int (33))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | (x0, flag) -> - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (ge0, tv0) :: - pl0)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (473)) - (Prims.of_int (12)) - (Prims.of_int (473)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (474)) - (Prims.of_int (2)) - (Prims.of_int (550)) - (Prims.of_int (33))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun pl1 -> - if - flag = - FStarC_Tactics_Types.Continue - then - Obj.magic - (Obj.repr - (match tv0 - with - | - FStarC_Reflection_V1_Data.Tv_Var - uu___6 -> - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - (x0, - FStarC_Tactics_Types.Continue))) - | - FStarC_Reflection_V1_Data.Tv_BVar - uu___6 -> - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - (x0, - FStarC_Tactics_Types.Continue))) - | - FStarC_Reflection_V1_Data.Tv_FVar - uu___6 -> - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - (x0, - FStarC_Tactics_Types.Continue))) - | - FStarC_Reflection_V1_Data.Tv_App - (hd, - (a1, - qual)) -> - Obj.repr - (let uu___6 - = - safe_arg_typ_or_comp - dbg - ge0.FStar_InteractiveHelpers_Base.env - hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (481)) - (Prims.of_int (16)) - (Prims.of_int (481)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (482)) - (Prims.of_int (6)) - (Prims.of_int (489)) - (Prims.of_int (38))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun a_c - -> - let uu___7 - = - let uu___8 - = - let uu___9 - = - FStar_InteractiveHelpers_Base.option_to_string - typ_or_comp_to_string - a_c in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (483)) - (Prims.of_int (21)) - (Prims.of_int (483)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Prims.strcat - "Tv_App: updated target typ_or_comp to:\n" - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (482)) - (Prims.of_int (20)) - (Prims.of_int (483)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (482)) - (Prims.of_int (6)) - (Prims.of_int (483)) - (Prims.of_int (64))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___9)) - uu___9) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (482)) - (Prims.of_int (6)) - (Prims.of_int (483)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (483)) - (Prims.of_int (65)) - (Prims.of_int (489)) - (Prims.of_int (38))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - let uu___9 - = - explore_term - dbg dfs - () f x0 - ge0 pl1 - a_c a1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (484)) - (Prims.of_int (22)) - (Prims.of_int (484)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (483)) - (Prims.of_int (65)) - (Prims.of_int (489)) - (Prims.of_int (38))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - match uu___10 - with - | - (x1, - flag1) -> - if - flag1 = - FStarC_Tactics_Types.Continue - then - Obj.magic - (Obj.repr - (explore_term - dbg dfs - () f x1 - ge0 pl1 - FStar_Pervasives_Native.None - hd)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (x1, - (convert_ctrl_flag - flag1)))))) - uu___10))) - uu___8))) - uu___7)) - | - FStarC_Reflection_V1_Data.Tv_Abs - (br, - body) -> - Obj.repr - (let uu___6 - = - FStar_InteractiveHelpers_Base.genv_push_binder - ge0 br - false - FStar_Pervasives_Native.None in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (491)) - (Prims.of_int (16)) - (Prims.of_int (491)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (491)) - (Prims.of_int (53)) - (Prims.of_int (493)) - (Prims.of_int (47))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun ge1 - -> - let uu___7 - = - abs_update_opt_typ_or_comp - br c0 - ge1.FStar_InteractiveHelpers_Base.env in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (492)) - (Prims.of_int (15)) - (Prims.of_int (492)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (493)) - (Prims.of_int (6)) - (Prims.of_int (493)) - (Prims.of_int (47))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun c1 - -> - Obj.magic - (explore_term - dbg dfs - () f x0 - ge1 pl1 - c1 body)) - uu___8))) - uu___7)) - | - FStarC_Reflection_V1_Data.Tv_Arrow - (br, c01) - -> - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - (x0, - FStarC_Tactics_Types.Continue))) - | - FStarC_Reflection_V1_Data.Tv_Type - uu___6 -> - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - (x0, - FStarC_Tactics_Types.Continue))) - | - FStarC_Reflection_V1_Data.Tv_Refine - (bv, - sort, - ref) -> - Obj.repr - (let uu___6 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - FStarC_Reflection_V1_Builtins.inspect_bv - bv)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (497)) - (Prims.of_int (16)) - (Prims.of_int (497)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (497)) - (Prims.of_int (32)) - (Prims.of_int (502)) - (Prims.of_int (38))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun bvv - -> - let uu___7 - = - explore_term - dbg dfs - () f x0 - ge0 pl1 - FStar_Pervasives_Native.None - sort in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (498)) - (Prims.of_int (22)) - (Prims.of_int (498)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (497)) - (Prims.of_int (32)) - (Prims.of_int (502)) - (Prims.of_int (38))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - match uu___8 - with - | - (x1, - flag1) -> - if - flag1 = - FStarC_Tactics_Types.Continue - then - Obj.magic - (Obj.repr - (let uu___9 - = - FStar_InteractiveHelpers_Base.genv_push_bv - ge0 bv - sort - false - FStar_Pervasives_Native.None in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (500)) - (Prims.of_int (18)) - (Prims.of_int (500)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (501)) - (Prims.of_int (8)) - (Prims.of_int (501)) - (Prims.of_int (50))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun ge1 - -> - Obj.magic - (explore_term - dbg dfs - () f x1 - ge1 pl1 - FStar_Pervasives_Native.None - ref)) - uu___10))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (x1, - (convert_ctrl_flag - flag1)))))) - uu___8))) - uu___7)) - | - FStarC_Reflection_V1_Data.Tv_Const - uu___6 -> - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - (x0, - FStarC_Tactics_Types.Continue))) - | - FStarC_Reflection_V1_Data.Tv_Uvar - (uu___6, - uu___7) - -> - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - (x0, - FStarC_Tactics_Types.Continue))) - | - FStarC_Reflection_V1_Data.Tv_Let - (recf, - attrs, - bv, ty, - def, - body) -> - Obj.repr - (let uu___6 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - FStar_Pervasives_Native.Some - (TC_Typ - (ty, [], - Prims.int_zero)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (509)) - (Prims.of_int (18)) - (Prims.of_int (509)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (509)) - (Prims.of_int (42)) - (Prims.of_int (516)) - (Prims.of_int (30))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun - def_c -> - let uu___7 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - fun x1 -> - explore_term - dbg dfs - () f x1 - ge0 pl1 - def_c def)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (510)) - (Prims.of_int (26)) - (Prims.of_int (510)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (510)) - (Prims.of_int (71)) - (Prims.of_int (516)) - (Prims.of_int (30))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - explore_def - -> - let uu___8 - = - FStar_InteractiveHelpers_Base.genv_push_bv - ge0 bv ty - false - (FStar_Pervasives_Native.Some - def) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (512)) - (Prims.of_int (16)) - (Prims.of_int (512)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (512)) - (Prims.of_int (58)) - (Prims.of_int (516)) - (Prims.of_int (30))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun ge1 - -> - let uu___9 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - fun x1 -> - explore_term - dbg dfs - () f x1 - ge1 pl1 - c0 body)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (513)) - (Prims.of_int (27)) - (Prims.of_int (513)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (513)) - (Prims.of_int (70)) - (Prims.of_int (516)) - (Prims.of_int (30))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - explore_next - -> - let uu___10 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - if dfs - then - (explore_next, - explore_def) - else - (explore_def, - explore_next))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (515)) - (Prims.of_int (25)) - (Prims.of_int (515)) - (Prims.of_int (93))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (513)) - (Prims.of_int (70)) - (Prims.of_int (516)) - (Prims.of_int (30))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - match uu___11 - with - | - (expl1, - expl2) -> - Obj.magic - (bind_expl - x0 expl1 - expl2)) - uu___11))) - uu___10))) - uu___9))) - uu___8))) - uu___7)) - | - FStarC_Reflection_V1_Data.Tv_Match - (scrutinee, - _ret_opt, - branches) - -> - Obj.repr - (let uu___6 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - fun - x_flag -> - fun br -> - let uu___8 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - x_flag)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (520)) - (Prims.of_int (23)) - (Prims.of_int (520)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (519)) - (Prims.of_int (86)) - (Prims.of_int (530)) - (Prims.of_int (21))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - match uu___9 - with - | - (x01, - flag1) -> - if - flag1 = - FStarC_Tactics_Types.Continue - then - Obj.magic - (Obj.repr - (let uu___10 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> br)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (522)) - (Prims.of_int (33)) - (Prims.of_int (522)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (521)) - (Prims.of_int (31)) - (Prims.of_int (528)) - (Prims.of_int (42))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - match uu___11 - with - | - (pat, - branch_body) - -> - let uu___12 - = - explore_pattern - dbg dfs - () f x01 - ge0 pat in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (524)) - (Prims.of_int (31)) - (Prims.of_int (524)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (522)) - (Prims.of_int (38)) - (Prims.of_int (528)) - (Prims.of_int (42))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - match uu___13 - with - | - (ge1, x1, - flag11) - -> - if - flag11 = - FStarC_Tactics_Types.Continue - then - Obj.magic - (Obj.repr - (explore_term - dbg dfs - () f x1 - ge1 pl1 - c0 - branch_body)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - (x1, - (convert_ctrl_flag - flag11)))))) - uu___13))) - uu___11))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - (x01, - flag1))))) - uu___9))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (519)) - (Prims.of_int (86)) - (Prims.of_int (530)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (531)) - (Prims.of_int (8)) - (Prims.of_int (536)) - (Prims.of_int (42))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun - explore_branch - -> - let uu___7 - = - safe_typ_or_comp - dbg - ge0.FStar_InteractiveHelpers_Base.env - scrutinee in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (533)) - (Prims.of_int (20)) - (Prims.of_int (533)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (533)) - (Prims.of_int (61)) - (Prims.of_int (536)) - (Prims.of_int (42))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - scrut_c - -> - let uu___8 - = - explore_term - dbg dfs - () f x0 - ge0 pl1 - scrut_c - scrutinee in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (534)) - (Prims.of_int (15)) - (Prims.of_int (534)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (536)) - (Prims.of_int (6)) - (Prims.of_int (536)) - (Prims.of_int (42))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun x1 - -> - Obj.magic - (FStar_Tactics_Util.fold_left - explore_branch - x1 - branches)) - uu___9))) - uu___8))) - uu___7)) - | - FStarC_Reflection_V1_Data.Tv_AscribedT - (e, ty, - tac, - uu___6) - -> - Obj.repr - (let uu___7 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - FStar_Pervasives_Native.Some - (TC_Typ - (ty, [], - Prims.int_zero)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (538)) - (Prims.of_int (15)) - (Prims.of_int (538)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (538)) - (Prims.of_int (39)) - (Prims.of_int (542)) - (Prims.of_int (37))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun c1 - -> - let uu___8 - = - explore_term - dbg dfs - () f x0 - ge0 pl1 - FStar_Pervasives_Native.None - ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (539)) - (Prims.of_int (21)) - (Prims.of_int (539)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (538)) - (Prims.of_int (39)) - (Prims.of_int (542)) - (Prims.of_int (37))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - match uu___9 - with - | - (x1, - flag1) -> - if - flag1 = - FStarC_Tactics_Types.Continue - then - Obj.magic - (Obj.repr - (explore_term - dbg dfs - () f x1 - ge0 pl1 - c1 e)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - (x1, - (convert_ctrl_flag - flag1)))))) - uu___9))) - uu___8)) - | - FStarC_Reflection_V1_Data.Tv_AscribedC - (e, c1, - tac, - uu___6) - -> - Obj.repr - (explore_term - dbg dfs - () f x0 - ge0 pl1 - (FStar_Pervasives_Native.Some - (TC_Comp - (c1, [], - Prims.int_zero))) - e) - | - uu___6 -> - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - (x0, - FStarC_Tactics_Types.Continue))))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - (x0, - (convert_ctrl_flag - flag)))))) - uu___6))) - uu___4))) uu___3))) uu___1) -and (explore_pattern : - Prims.bool -> - Prims.bool -> - unit -> - Obj.t explorer -> - Obj.t -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_V1_Data.pattern -> - ((FStar_InteractiveHelpers_Base.genv * Obj.t * - FStarC_Tactics_Types.ctrl_flag), - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun dfs -> - fun a -> - fun f -> - fun x -> - fun ge0 -> - fun pat -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> explore_pattern:" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (553)) (Prims.of_int (2)) - (Prims.of_int (553)) (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (554)) (Prims.of_int (2)) - (Prims.of_int (570)) (Prims.of_int (38))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match pat with - | FStarC_Reflection_V1_Data.Pat_Constant uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (ge0, x, - FStarC_Tactics_Types.Continue)))) - | FStarC_Reflection_V1_Data.Pat_Cons - (fv, us, patterns) -> - Obj.magic - (Obj.repr - (let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun ge_x_flag -> - fun pat1 -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - ge_x_flag)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (558)) - (Prims.of_int (25)) - (Prims.of_int (558)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (557)) - (Prims.of_int (35)) - (Prims.of_int (564)) - (Prims.of_int (20))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | (ge01, x1, flag) -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - pat1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (559)) - (Prims.of_int (20)) - (Prims.of_int (559)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (558)) - (Prims.of_int (37)) - (Prims.of_int (564)) - (Prims.of_int (20))))) - (Obj.magic - uu___6) - (fun uu___7 - -> - (fun - uu___7 -> - match uu___7 - with - | - (pat11, - uu___8) - -> - if - flag = - FStarC_Tactics_Types.Continue - then - Obj.magic - (Obj.repr - (explore_pattern - dbg dfs - () f x1 - ge01 - pat11)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (ge01, - x1, flag))))) - uu___7))) - uu___5))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (557)) - (Prims.of_int (35)) - (Prims.of_int (564)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (566)) - (Prims.of_int (4)) - (Prims.of_int (566)) - (Prims.of_int (53))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun explore_pat -> - Obj.magic - (FStar_Tactics_Util.fold_left - explore_pat - (ge0, x, - FStarC_Tactics_Types.Continue) - patterns)) uu___3))) - | FStarC_Reflection_V1_Data.Pat_Var (bv, st) -> - Obj.magic - (Obj.repr - (let uu___2 = - let uu___3 = - FStarC_Tactics_Unseal.unseal st in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (568)) - (Prims.of_int (34)) - (Prims.of_int (568)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (568)) - (Prims.of_int (14)) - (Prims.of_int (568)) - (Prims.of_int (56))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.genv_push_bv - ge0 bv uu___4 false - FStar_Pervasives_Native.None)) - uu___4) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (568)) - (Prims.of_int (14)) - (Prims.of_int (568)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (569)) - (Prims.of_int (4)) - (Prims.of_int (569)) - (Prims.of_int (20))))) - (Obj.magic uu___2) - (fun ge1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (ge1, x, - FStarC_Tactics_Types.Continue))))) - | FStarC_Reflection_V1_Data.Pat_Dot_Term uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (ge0, x, - FStarC_Tactics_Types.Continue))))) - uu___1) -let (free_in : - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.bv Prims.list, unit) - FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun bv1 -> - fun bv2 -> - let uu___2 = FStar_Tactics_V1_Derived.name_of_bv bv1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (577)) (Prims.of_int (4)) - (Prims.of_int (577)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (577)) (Prims.of_int (4)) - (Prims.of_int (577)) (Prims.of_int (35))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - FStar_Tactics_V1_Derived.name_of_bv bv2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (577)) - (Prims.of_int (21)) - (Prims.of_int (577)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (577)) - (Prims.of_int (4)) - (Prims.of_int (577)) - (Prims.of_int (35))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> uu___3 = uu___5)))) uu___3))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (577)) (Prims.of_int (4)) (Prims.of_int (577)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (578)) (Prims.of_int (4)) (Prims.of_int (596)) - (Prims.of_int (75))))) (Obj.magic uu___) - (fun uu___1 -> - (fun same_name -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - fun uu___6 -> - fun uu___5 -> - fun uu___4 -> - fun uu___3 -> - fun uu___2 -> - (fun uu___2 -> - fun fl -> - fun ge -> - fun pl -> - fun c -> - fun tv -> - match tv with - | FStarC_Reflection_V1_Data.Tv_Var - bv -> - Obj.magic - (Obj.repr - (let uu___3 = - let uu___4 = - FStar_Tactics_V1_Derived.name_of_bv - bv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (585)) - (Prims.of_int (40)) - (Prims.of_int (585)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (585)) - (Prims.of_int (18)) - (Prims.of_int (585)) - (Prims.of_int (55))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStar_InteractiveHelpers_Base.genv_get_from_name - ge uu___5)) - uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (585)) - (Prims.of_int (18)) - (Prims.of_int (585)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (585)) - (Prims.of_int (12)) - (Prims.of_int (590)) - (Prims.of_int (30))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 - with - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (let uu___5 - = - let uu___6 - = - FStar_Tactics_Util.tryFind - (same_name - bv) fl in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (588)) - (Prims.of_int (21)) - (Prims.of_int (588)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (588)) - (Prims.of_int (18)) - (Prims.of_int (588)) - (Prims.of_int (76))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - if uu___7 - then fl - else bv - :: fl)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (588)) - (Prims.of_int (18)) - (Prims.of_int (588)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (589)) - (Prims.of_int (8)) - (Prims.of_int (589)) - (Prims.of_int (21))))) - (Obj.magic - uu___5) - (fun fl' - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - (fl', - FStarC_Tactics_Types.Continue))))) - | FStar_Pervasives_Native.Some - uu___5 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - (fl, - FStarC_Tactics_Types.Continue))))) - uu___4))) - | FStarC_Reflection_V1_Data.Tv_BVar - bv -> - Obj.magic - (Obj.repr - (let uu___3 = - let uu___4 = - FStar_Tactics_V1_Derived.name_of_bv - bv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (585)) - (Prims.of_int (40)) - (Prims.of_int (585)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (585)) - (Prims.of_int (18)) - (Prims.of_int (585)) - (Prims.of_int (55))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStar_InteractiveHelpers_Base.genv_get_from_name - ge uu___5)) - uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (585)) - (Prims.of_int (18)) - (Prims.of_int (585)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (585)) - (Prims.of_int (12)) - (Prims.of_int (590)) - (Prims.of_int (30))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 - with - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (let uu___5 - = - let uu___6 - = - FStar_Tactics_Util.tryFind - (same_name - bv) fl in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (588)) - (Prims.of_int (21)) - (Prims.of_int (588)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (588)) - (Prims.of_int (18)) - (Prims.of_int (588)) - (Prims.of_int (76))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - if uu___7 - then fl - else bv - :: fl)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (588)) - (Prims.of_int (18)) - (Prims.of_int (588)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (589)) - (Prims.of_int (8)) - (Prims.of_int (589)) - (Prims.of_int (21))))) - (Obj.magic - uu___5) - (fun fl' - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - (fl', - FStarC_Tactics_Types.Continue))))) - | FStar_Pervasives_Native.Some - uu___5 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - (fl, - FStarC_Tactics_Types.Continue))))) - uu___4))) - | uu___3 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - (fl, - FStarC_Tactics_Types.Continue))))) - uu___7 uu___6 uu___5 uu___4 uu___3 uu___2)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (582)) (Prims.of_int (4)) - (Prims.of_int (592)) (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (593)) (Prims.of_int (4)) - (Prims.of_int (596)) (Prims.of_int (75))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun update_free -> - let uu___2 = FStarC_Tactics_V1_Builtins.top_env () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (594)) (Prims.of_int (10)) - (Prims.of_int (594)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (594)) (Prims.of_int (23)) - (Prims.of_int (596)) (Prims.of_int (75))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun e -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_InteractiveHelpers_Base.mk_genv - e [] [])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (595)) - (Prims.of_int (11)) - (Prims.of_int (595)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (596)) - (Prims.of_int (2)) - (Prims.of_int (596)) - (Prims.of_int (75))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun ge -> - let uu___4 = - let uu___5 = - Obj.magic - (explore_term false false - () - (Obj.magic update_free) - (Obj.magic []) ge [] - FStar_Pervasives_Native.None - t) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (596)) - (Prims.of_int (20)) - (Prims.of_int (596)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (596)) - (Prims.of_int (15)) - (Prims.of_int (596)) - (Prims.of_int (75))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - FStar_Pervasives_Native.fst - uu___6)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (596)) - (Prims.of_int (15)) - (Prims.of_int (596)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (596)) - (Prims.of_int (2)) - (Prims.of_int (596)) - (Prims.of_int (75))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_List_Tot_Base.rev - uu___5)))) uu___4))) - uu___3))) uu___2))) uu___1) -let (abs_free_in : - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - ((FStarC_Reflection_Types.bv * FStarC_Reflection_Types.typ) Prims.list, - unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun t -> - let uu___ = free_in t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (602)) (Prims.of_int (12)) - (Prims.of_int (602)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (602)) (Prims.of_int (24)) - (Prims.of_int (610)) (Prims.of_int (9))))) (Obj.magic uu___) - (fun fvl -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_List_Tot_Base.concatMap - (fun uu___2 -> - match uu___2 with - | (bv, ty) -> - if - FStar_Pervasives_Native.uu___is_Some - (FStar_List_Tot_Base.find - (FStar_InteractiveHelpers_Base.bv_eq bv) fvl) - then [(bv, ty)] - else []) - (FStar_List_Tot_Base.rev - (FStar_InteractiveHelpers_Base.genv_abstract_bvs ge)))) -let (shadowed_free_in : - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.bv Prims.list, unit) - FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun t -> - let uu___ = free_in t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (615)) (Prims.of_int (12)) - (Prims.of_int (615)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (616)) (Prims.of_int (2)) (Prims.of_int (616)) - (Prims.of_int (54))))) (Obj.magic uu___) - (fun fvl -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_List_Tot_Base.filter - (fun bv -> - FStar_InteractiveHelpers_Base.bv_is_shadowed ge bv) fvl)) -let (term_has_shadowed_variables : - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun t -> - let uu___ = free_in t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (621)) (Prims.of_int (12)) - (Prims.of_int (621)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.ExploreTerm.fst" - (Prims.of_int (622)) (Prims.of_int (2)) (Prims.of_int (622)) - (Prims.of_int (50))))) (Obj.magic uu___) - (fun fvl -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Pervasives_Native.uu___is_Some - (FStar_List_Tot_Base.tryFind - (FStar_InteractiveHelpers_Base.bv_is_shadowed ge) fvl))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Output.ml b/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Output.ml deleted file mode 100644 index 85c4a1636a7..00000000000 --- a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Output.ml +++ /dev/null @@ -1,2013 +0,0 @@ -open Prims -let rec _split_subst_at_bv : - 'a 'b . - FStarC_Reflection_Types.bv -> - ((FStarC_Reflection_Types.bv * 'a) * 'b) Prims.list -> - (((FStarC_Reflection_Types.bv * 'a) * 'b) Prims.list * - ((FStarC_Reflection_Types.bv * 'a) * 'b) Prims.list) - = - fun x -> - fun subst -> - match subst with - | [] -> ([], []) - | ((src, ty), tgt)::subst' -> - if FStar_InteractiveHelpers_Base.bv_eq x src - then ([], subst') - else - (let uu___1 = _split_subst_at_bv x subst' in - match uu___1 with | (s1, s2) -> ((((src, ty), tgt) :: s1), s2)) -let (subst_shadowed_with_abs_in_assertions : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.bv FStar_Pervasives_Native.option -> - FStar_InteractiveHelpers_Propositions.assertions -> - ((FStar_InteractiveHelpers_Base.genv * - FStar_InteractiveHelpers_Propositions.assertions), - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge -> - fun shadowed_bv -> - fun es -> - let uu___ = - let uu___1 = - let uu___2 = FStar_InteractiveHelpers_Base.genv_to_string ge in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (44)) (Prims.of_int (62)) - (Prims.of_int (44)) (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat - "subst_shadowed_with_abs_in_assertions:\n" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (44)) (Prims.of_int (16)) - (Prims.of_int (44)) (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (44)) (Prims.of_int (2)) - (Prims.of_int (44)) (Prims.of_int (80))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___2)) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (44)) (Prims.of_int (2)) - (Prims.of_int (44)) (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (44)) (Prims.of_int (81)) - (Prims.of_int (73)) (Prims.of_int (31))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - FStar_InteractiveHelpers_Base.generate_shadowed_subst ge in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (46)) (Prims.of_int (19)) - (Prims.of_int (46)) (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (44)) (Prims.of_int (81)) - (Prims.of_int (73)) (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (ge1, subst) -> - let uu___4 = - FStar_Tactics_Util.map - (fun uu___5 -> - match uu___5 with - | (src, ty, tgt) -> - let uu___6 = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - tgt) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (47)) - (Prims.of_int (57)) - (Prims.of_int (47)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (47)) - (Prims.of_int (46)) - (Prims.of_int (47)) - (Prims.of_int (74))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - ((src, ty), uu___7)))) - subst in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (47)) - (Prims.of_int (19)) - (Prims.of_int (47)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (47)) - (Prims.of_int (84)) - (Prims.of_int (73)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun post_subst -> - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - if - FStar_Pervasives_Native.uu___is_Some - shadowed_bv - then - FStar_Pervasives_Native.fst - (_split_subst_at_bv - (FStar_Pervasives_Native.__proj__Some__item__v - shadowed_bv) - post_subst) - else post_subst)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (54)) - (Prims.of_int (4)) - (Prims.of_int (55)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (56)) - (Prims.of_int (4)) - (Prims.of_int (73)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun pre_subst -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - fun subst1 - -> - let uu___8 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - fun - uu___10 - -> - match uu___10 - with - | - ((x, ty), - y) -> - let uu___11 - = - let uu___12 - = - FStar_InteractiveHelpers_Base.abv_to_string - x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (59)) - (Prims.of_int (12)) - (Prims.of_int (59)) - (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (59)) - (Prims.of_int (12)) - (Prims.of_int (59)) - (Prims.of_int (63))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - let uu___14 - = - let uu___15 - = - let uu___16 - = - FStarC_Tactics_V1_Builtins.term_to_string - y in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (59)) - (Prims.of_int (39)) - (Prims.of_int (59)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> - Prims.strcat - uu___17 - ")\n")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (59)) - (Prims.of_int (39)) - (Prims.of_int (59)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - Prims.strcat - " -> " - uu___16)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (59)) - (Prims.of_int (30)) - (Prims.of_int (59)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - Prims.strcat - uu___13 - uu___15)))) - uu___13) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (59)) - (Prims.of_int (12)) - (Prims.of_int (59)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - Prims.strcat - "(" - uu___12)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (59)) - (Prims.of_int (6)) - (Prims.of_int (59)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (60)) - (Prims.of_int (6)) - (Prims.of_int (62)) - (Prims.of_int (48))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - to_string - -> - let uu___9 - = - FStar_Tactics_Util.map - to_string - subst1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (61)) - (Prims.of_int (14)) - (Prims.of_int (61)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (62)) - (Prims.of_int (4)) - (Prims.of_int (62)) - (Prims.of_int (48))))) - (Obj.magic - uu___9) - (fun str - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - FStar_List_Tot_Base.fold_left - (fun x -> - fun y -> - Prims.strcat - x y) "" - str)))) - uu___9))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (57)) - (Prims.of_int (42)) - (Prims.of_int (62)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (64)) - (Prims.of_int (2)) - (Prims.of_int (73)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun - subst_to_string - -> - let uu___7 - = - if dbg - then - Obj.magic - (Obj.repr - (let uu___8 - = - let uu___9 - = - let uu___10 - = - subst_to_string - pre_subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (66)) - (Prims.of_int (38)) - (Prims.of_int (66)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - Prims.strcat - "- pre_subst:\n" - uu___11)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (66)) - (Prims.of_int (18)) - (Prims.of_int (66)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (66)) - (Prims.of_int (4)) - (Prims.of_int (66)) - (Prims.of_int (64))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___10)) - uu___10) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (66)) - (Prims.of_int (4)) - (Prims.of_int (66)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (67)) - (Prims.of_int (4)) - (Prims.of_int (67)) - (Prims.of_int (66))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - let uu___10 - = - let uu___11 - = - subst_to_string - post_subst in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (67)) - (Prims.of_int (39)) - (Prims.of_int (67)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - Prims.strcat - "- post_subst:\n" - uu___12)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (67)) - (Prims.of_int (18)) - (Prims.of_int (67)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (67)) - (Prims.of_int (4)) - (Prims.of_int (67)) - (Prims.of_int (66))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___11)) - uu___11))) - uu___9))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - ()))) in - Obj.magic - ( - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (64)) - (Prims.of_int (2)) - (Prims.of_int (68)) - (Prims.of_int (7))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (68)) - (Prims.of_int (8)) - (Prims.of_int (73)) - (Prims.of_int (31))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - let uu___9 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - fun s -> - FStar_Tactics_Util.map - (fun t -> - FStar_InteractiveHelpers_Base.apply_subst - ge1.FStar_InteractiveHelpers_Base.env - t s))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (70)) - (Prims.of_int (14)) - (Prims.of_int (70)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (70)) - (Prims.of_int (66)) - (Prims.of_int (73)) - (Prims.of_int (31))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - apply -> - let uu___10 - = - apply - pre_subst - es.FStar_InteractiveHelpers_Propositions.pres in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (71)) - (Prims.of_int (13)) - (Prims.of_int (71)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (71)) - (Prims.of_int (39)) - (Prims.of_int (73)) - (Prims.of_int (31))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun pres - -> - let uu___11 - = - apply - post_subst - es.FStar_InteractiveHelpers_Propositions.posts in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (72)) - (Prims.of_int (14)) - (Prims.of_int (72)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (73)) - (Prims.of_int (2)) - (Prims.of_int (73)) - (Prims.of_int (31))))) - (Obj.magic - uu___11) - (fun - posts -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (ge1, - (FStar_InteractiveHelpers_Propositions.mk_assertions - pres - posts)))))) - uu___11))) - uu___10))) - uu___8))) - uu___7))) - uu___6))) uu___5))) - uu___3))) uu___1) -let (string_to_printout : Prims.string -> Prims.string -> Prims.string) = - fun prefix -> - fun data -> - Prims.strcat prefix (Prims.strcat ":\n" (Prims.strcat data "\n")) -let (term_to_printout : - FStar_InteractiveHelpers_Base.genv -> - Prims.string -> - FStarC_Reflection_Types.term -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun prefix -> - fun t -> - let uu___ = FStar_InteractiveHelpers_ExploreTerm.abs_free_in ge t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (87)) (Prims.of_int (12)) - (Prims.of_int (87)) (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (87)) (Prims.of_int (31)) - (Prims.of_int (92)) (Prims.of_int (46))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun abs -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_List_Tot_Base.map - (fun uu___3 -> - match uu___3 with - | (bv, t1) -> - FStar_Reflection_V1_Derived.mk_binder bv - t1) abs)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (88)) (Prims.of_int (20)) - (Prims.of_int (88)) (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (88)) (Prims.of_int (71)) - (Prims.of_int (92)) (Prims.of_int (46))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun abs_binders -> - let uu___2 = - FStar_Tactics_Util.map - (fun uu___3 -> - match uu___3 with - | (bv, uu___4) -> - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var bv)) - abs in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (89)) - (Prims.of_int (18)) - (Prims.of_int (89)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (89)) - (Prims.of_int (62)) - (Prims.of_int (92)) - (Prims.of_int (46))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun abs_terms -> - let uu___3 = - FStar_Tactics_V1_Derived.mk_abs - abs_binders t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (90)) - (Prims.of_int (10)) - (Prims.of_int (90)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (90)) - (Prims.of_int (33)) - (Prims.of_int (92)) - (Prims.of_int (46))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun t1 -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_Reflection_V1_Derived.mk_e_app - t1 abs_terms)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (91)) - (Prims.of_int (10)) - (Prims.of_int (91)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (92)) - (Prims.of_int (2)) - (Prims.of_int (92)) - (Prims.of_int (46))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun t2 -> - let uu___5 = - FStarC_Tactics_V1_Builtins.term_to_string - t2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (92)) - (Prims.of_int (28)) - (Prims.of_int (92)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (92)) - (Prims.of_int (2)) - (Prims.of_int (92)) - (Prims.of_int (46))))) - (Obj.magic - uu___5) - (fun uu___6 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - string_to_printout - prefix - uu___6)))) - uu___5))) uu___4))) - uu___3))) uu___2))) uu___1) -let (opt_term_to_printout : - FStar_InteractiveHelpers_Base.genv -> - Prims.string -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun ge -> - fun prefix -> - fun t -> - match t with - | FStar_Pervasives_Native.Some t' -> - Obj.magic (Obj.repr (term_to_printout ge prefix t')) - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> string_to_printout prefix "")))) - uu___2 uu___1 uu___ -let (proposition_to_printout : - FStar_InteractiveHelpers_Base.genv -> - Prims.string -> - FStar_InteractiveHelpers_Propositions.proposition -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = fun ge -> fun prefix -> fun p -> term_to_printout ge prefix p -let (propositions_to_printout : - FStar_InteractiveHelpers_Base.genv -> - Prims.string -> - FStar_InteractiveHelpers_Propositions.proposition Prims.list -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun ge -> - fun prefix -> - fun pl -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun i -> - fun p -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat prefix - (Prims.strcat ":prop" - (Prims.string_of_int i)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (104)) (Prims.of_int (18)) - (Prims.of_int (104)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (105)) (Prims.of_int (4)) - (Prims.of_int (105)) (Prims.of_int (40))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun prefix' -> - Obj.magic - (proposition_to_printout ge prefix' p)) - uu___3))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (103)) (Prims.of_int (28)) - (Prims.of_int (105)) (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (106)) (Prims.of_int (4)) - (Prims.of_int (113)) (Prims.of_int (5))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun prop_to_printout -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - string_to_printout (Prims.strcat prefix ":num") - (Prims.string_of_int - (FStar_List_Tot_Base.length pl)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (107)) (Prims.of_int (12)) - (Prims.of_int (107)) (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (107)) (Prims.of_int (88)) - (Prims.of_int (113)) (Prims.of_int (5))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun str -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun s_i -> - fun p -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> s_i)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (109)) - (Prims.of_int (15)) - (Prims.of_int (109)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (108)) - (Prims.of_int (46)) - (Prims.of_int (110)) - (Prims.of_int (33))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | (s, i) -> - let uu___6 = - let uu___7 = - prop_to_printout i p in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (110)) - (Prims.of_int (8)) - (Prims.of_int (110)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat - s uu___8)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (110)) - (Prims.of_int (4)) - (Prims.of_int (110)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (110)) - (Prims.of_int (4)) - (Prims.of_int (110)) - (Prims.of_int (33))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (uu___7, - ( - i + - Prims.int_one)))))) - uu___5))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (108)) - (Prims.of_int (46)) - (Prims.of_int (110)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (111)) - (Prims.of_int (4)) - (Prims.of_int (113)) - (Prims.of_int (5))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun concat_prop -> - let uu___3 = - FStar_Tactics_Util.fold_left - concat_prop (str, Prims.int_zero) - pl in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (112)) - (Prims.of_int (15)) - (Prims.of_int (112)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (111)) - (Prims.of_int (4)) - (Prims.of_int (113)) - (Prims.of_int (5))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - match uu___4 with - | (str1, uu___6) -> str1)))) - uu___3))) uu___2))) uu___1) -let (error_message_to_printout : - Prims.string -> Prims.string FStar_Pervasives_Native.option -> Prims.string) - = - fun prefix -> - fun message -> - let msg = - match message with - | FStar_Pervasives_Native.Some msg1 -> msg1 - | uu___ -> "" in - string_to_printout (Prims.strcat prefix ":error") msg -type export_result = - | ESuccess of FStar_InteractiveHelpers_Base.genv * - FStar_InteractiveHelpers_Propositions.assertions - | EFailure of Prims.string -let (uu___is_ESuccess : export_result -> Prims.bool) = - fun projectee -> - match projectee with | ESuccess (ge, a) -> true | uu___ -> false -let (__proj__ESuccess__item__ge : - export_result -> FStar_InteractiveHelpers_Base.genv) = - fun projectee -> match projectee with | ESuccess (ge, a) -> ge -let (__proj__ESuccess__item__a : - export_result -> FStar_InteractiveHelpers_Propositions.assertions) = - fun projectee -> match projectee with | ESuccess (ge, a) -> a -let (uu___is_EFailure : export_result -> Prims.bool) = - fun projectee -> - match projectee with | EFailure err -> true | uu___ -> false -let (__proj__EFailure__item__err : export_result -> Prims.string) = - fun projectee -> match projectee with | EFailure err -> err -let (result_to_printout : - Prims.string -> - export_result -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun prefix -> - fun res -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> Prims.strcat prefix ":BEGIN\n")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (126)) (Prims.of_int (12)) - (Prims.of_int (126)) (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (126)) (Prims.of_int (34)) - (Prims.of_int (142)) (Prims.of_int (50))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun str -> - let uu___1 = - match res with - | ESuccess (ge, a) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - (FStar_Pervasives_Native.None, ge, - (a.FStar_InteractiveHelpers_Propositions.pres), - (a.FStar_InteractiveHelpers_Propositions.posts))))) - | EFailure err -> - Obj.magic - (Obj.repr - (let uu___2 = - let uu___3 = - FStarC_Tactics_V1_Builtins.top_env () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (134)) - (Prims.of_int (28)) - (Prims.of_int (134)) - (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (134)) - (Prims.of_int (15)) - (Prims.of_int (134)) - (Prims.of_int (40))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_InteractiveHelpers_Base.mk_init_genv - uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (134)) (Prims.of_int (15)) - (Prims.of_int (134)) (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (135)) (Prims.of_int (6)) - (Prims.of_int (135)) (Prims.of_int (26))))) - (Obj.magic uu___2) - (fun ge -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - ((FStar_Pervasives_Native.Some err), ge, - [], []))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (131)) (Prims.of_int (4)) - (Prims.of_int (135)) (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (126)) (Prims.of_int (34)) - (Prims.of_int (142)) (Prims.of_int (50))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - match uu___2 with - | (err, ge, pres, posts) -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat str - (error_message_to_printout prefix - err))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (138)) - (Prims.of_int (12)) - (Prims.of_int (138)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (138)) - (Prims.of_int (57)) - (Prims.of_int (142)) - (Prims.of_int (50))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun str1 -> - let uu___4 = - let uu___5 = - propositions_to_printout ge - (Prims.strcat prefix ":pres") - pres in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (140)) - (Prims.of_int (18)) - (Prims.of_int (140)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat str1 uu___6)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (140)) - (Prims.of_int (12)) - (Prims.of_int (140)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (140)) - (Prims.of_int (72)) - (Prims.of_int (142)) - (Prims.of_int (50))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun str2 -> - let uu___5 = - let uu___6 = - propositions_to_printout - ge - (Prims.strcat prefix - ":posts") posts in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (141)) - (Prims.of_int (18)) - (Prims.of_int (141)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat - str2 uu___7)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (141)) - (Prims.of_int (12)) - (Prims.of_int (141)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun str3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat - str3 - (Prims.strcat - prefix - ":END\n%FIH:FSTAR_META:END%"))))) - uu___5))) uu___4))) uu___2))) - uu___1) -let (printout_result : - Prims.string -> export_result -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun prefix -> - fun res -> - let uu___ = result_to_printout prefix res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (146)) (Prims.of_int (8)) (Prims.of_int (146)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (146)) (Prims.of_int (2)) (Prims.of_int (146)) - (Prims.of_int (39))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> Obj.magic (FStarC_Tactics_V1_Builtins.print uu___1)) - uu___1) -let (printout_success : - FStar_InteractiveHelpers_Base.genv -> - FStar_InteractiveHelpers_Propositions.assertions -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = fun ge -> fun a -> printout_result "ainfo" (ESuccess (ge, a)) -let (printout_failure : - FStarC_Errors_Msg.error_message -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun err -> - printout_result "ainfo" (EFailure (FStarC_Errors_Msg.rendermsg err)) -let (_debug_print_var : - Prims.string -> - FStarC_Reflection_Types.term -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun name -> - fun t -> - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStarC_Tactics_V1_Builtins.term_to_string t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (157)) (Prims.of_int (46)) - (Prims.of_int (157)) (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat ": " uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (157)) (Prims.of_int (39)) - (Prims.of_int (157)) (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat name uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (157)) (Prims.of_int (32)) - (Prims.of_int (157)) (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat "_debug_print_var: " uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (157)) (Prims.of_int (8)) - (Prims.of_int (157)) (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (157)) (Prims.of_int (2)) - (Prims.of_int (157)) (Prims.of_int (63))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic (FStarC_Tactics_V1_Builtins.print uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (157)) (Prims.of_int (2)) (Prims.of_int (157)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (158)) (Prims.of_int (2)) (Prims.of_int (170)) - (Prims.of_int (33))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - let uu___3 = - let uu___4 = FStarC_Tactics_V1_Builtins.top_env () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (158)) (Prims.of_int (22)) - (Prims.of_int (158)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (158)) (Prims.of_int (14)) - (Prims.of_int (158)) (Prims.of_int (36))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStar_InteractiveHelpers_ExploreTerm.safe_tc - uu___5 t)) uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (158)) (Prims.of_int (14)) - (Prims.of_int (158)) (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (158)) (Prims.of_int (8)) - (Prims.of_int (160)) (Prims.of_int (11))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | FStar_Pervasives_Native.Some ty -> - Obj.magic - (Obj.repr - (let uu___5 = - let uu___6 = - FStarC_Tactics_V1_Builtins.term_to_string - ty in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (159)) - (Prims.of_int (33)) - (Prims.of_int (159)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat "type: " uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (159)) - (Prims.of_int (21)) - (Prims.of_int (159)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (159)) - (Prims.of_int (15)) - (Prims.of_int (159)) - (Prims.of_int (51))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print - uu___6)) uu___6))) - | uu___5 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> ())))) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (158)) (Prims.of_int (8)) - (Prims.of_int (160)) (Prims.of_int (11))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (162)) (Prims.of_int (2)) - (Prims.of_int (170)) (Prims.of_int (33))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - let uu___5 = - let uu___6 = - FStar_InteractiveHelpers_Base.term_construct t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (162)) - (Prims.of_int (25)) - (Prims.of_int (162)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat "qualifier: " uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (162)) (Prims.of_int (8)) - (Prims.of_int (162)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (162)) (Prims.of_int (2)) - (Prims.of_int (162)) - (Prims.of_int (42))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print uu___6)) - uu___6) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (162)) - (Prims.of_int (2)) - (Prims.of_int (162)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (163)) - (Prims.of_int (2)) - (Prims.of_int (170)) - (Prims.of_int (33))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - let uu___7 = - FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (163)) - (Prims.of_int (14)) - (Prims.of_int (163)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (163)) - (Prims.of_int (8)) - (Prims.of_int (168)) - (Prims.of_int (11))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - match uu___8 with - | FStarC_Reflection_V1_Data.Tv_Var - bv -> - Obj.magic - (Obj.repr - (let uu___9 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___10 - -> - FStarC_Reflection_V1_Builtins.inspect_bv - bv)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (165)) - (Prims.of_int (22)) - (Prims.of_int (165)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (166)) - (Prims.of_int (4)) - (Prims.of_int (167)) - (Prims.of_int (52))))) - (Obj.magic uu___9) - (fun uu___10 -> - (fun b -> - let uu___10 = - let uu___11 - = - let uu___12 - = - FStar_Tactics_V1_Derived.name_of_bv - bv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (166)) - (Prims.of_int (32)) - (Prims.of_int (166)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - Prims.strcat - uu___13 - (Prims.strcat - "; index: " - (Prims.string_of_int - b.FStarC_Reflection_V1_Data.bv_index)))) in - FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (166)) - (Prims.of_int (32)) - (Prims.of_int (167)) - (Prims.of_int (51))))) - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - ( - Obj.magic - uu___11) - ( - fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - Prims.strcat - "Tv_Var: ppname: " - uu___12)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (166)) - (Prims.of_int (10)) - (Prims.of_int (167)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (166)) - (Prims.of_int (4)) - (Prims.of_int (167)) - (Prims.of_int (52))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print - uu___11)) - uu___11))) - uu___10))) - | uu___9 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> ())))) - uu___8) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (163)) - (Prims.of_int (8)) - (Prims.of_int (168)) - (Prims.of_int (11))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (170)) - (Prims.of_int (2)) - (Prims.of_int (170)) - (Prims.of_int (33))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print - "end of _debug_print_var")) - uu___7))) uu___5))) uu___3))) - uu___1) -let magic_witness : 'a . unit -> 'a = - fun uu___ -> - failwith - "Not yet implemented: FStar.InteractiveHelpers.Output.magic_witness" -let (tadmit_no_warning : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - FStar_Tactics_V1_Derived.apply - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "InteractiveHelpers"; "Output"; "magic_witness"]))) -let (pp_tac : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStar_Tactics_V1_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (184)) (Prims.of_int (47)) - (Prims.of_int (184)) (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (184)) (Prims.of_int (31)) - (Prims.of_int (184)) (Prims.of_int (61))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.term_to_string uu___5)) - uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (184)) (Prims.of_int (31)) - (Prims.of_int (184)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat "post-processing: " uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (184)) (Prims.of_int (8)) (Prims.of_int (184)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (184)) (Prims.of_int (2)) (Prims.of_int (184)) - (Prims.of_int (62))))) (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> Obj.magic (FStarC_Tactics_V1_Builtins.print uu___3)) - uu___3) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (184)) (Prims.of_int (2)) (Prims.of_int (184)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (185)) (Prims.of_int (2)) (Prims.of_int (186)) - (Prims.of_int (9))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = FStarC_Tactics_V1_Builtins.dump "" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (185)) (Prims.of_int (2)) - (Prims.of_int (185)) (Prims.of_int (9))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Output.fst" - (Prims.of_int (186)) (Prims.of_int (2)) - (Prims.of_int (186)) (Prims.of_int (9))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic (FStar_Tactics_V1_Derived.trefl ())) uu___4))) - uu___2) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_PostProcess.ml b/stage0/fstar-lib/generated/FStar_InteractiveHelpers_PostProcess.ml deleted file mode 100644 index 888dce77f92..00000000000 --- a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_PostProcess.ml +++ /dev/null @@ -1,8988 +0,0 @@ -open Prims -type meta_info = unit -let (focus_on_term : meta_info) = - Obj.magic - (fun uu___ -> - failwith - "Not yet implemented: FStar.InteractiveHelpers.PostProcess.focus_on_term") -let (end_proof : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - FStarC_Tactics_V1_Builtins.tadmit_t - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const FStarC_Reflection_V2_Data.C_Unit)) -let (unsquash_equality : - FStarC_Reflection_Types.term -> - ((FStarC_Reflection_Types.term * FStarC_Reflection_Types.term) - FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = FStar_Reflection_V1_Formula.term_as_formula t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (27)) (Prims.of_int (14)) (Prims.of_int (27)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (27)) (Prims.of_int (8)) (Prims.of_int (29)) - (Prims.of_int (13))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | FStar_Reflection_V1_Formula.Comp - (FStar_Reflection_V1_Formula.Eq uu___3, l, r) -> - FStar_Pervasives_Native.Some (l, r) - | uu___3 -> FStar_Pervasives_Native.None)) -let (pp_explore : - Prims.bool -> - Prims.bool -> - unit -> - Obj.t FStar_InteractiveHelpers_ExploreTerm.explorer -> - Obj.t -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun dfs -> - fun a -> - fun f -> - fun x -> - let uu___ = FStar_Tactics_V1_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (38)) (Prims.of_int (10)) - (Prims.of_int (38)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (38)) (Prims.of_int (24)) - (Prims.of_int (49)) (Prims.of_int (5))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun g -> - let uu___1 = FStar_Tactics_V1_Derived.cur_env () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (39)) (Prims.of_int (10)) - (Prims.of_int (39)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (40)) (Prims.of_int (2)) - (Prims.of_int (49)) (Prims.of_int (5))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun e -> - let uu___2 = - let uu___3 = - let uu___4 = - FStarC_Tactics_V1_Builtins.term_to_string - g in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (40)) - (Prims.of_int (38)) - (Prims.of_int (40)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat "[> pp_explore:\n" - uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (40)) - (Prims.of_int (16)) - (Prims.of_int (40)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (40)) - (Prims.of_int (2)) - (Prims.of_int (40)) - (Prims.of_int (55))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___4)) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (40)) - (Prims.of_int (2)) - (Prims.of_int (40)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (41)) - (Prims.of_int (8)) - (Prims.of_int (48)) - (Prims.of_int (52))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = unsquash_equality g in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (41)) - (Prims.of_int (14)) - (Prims.of_int (41)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (41)) - (Prims.of_int (8)) - (Prims.of_int (48)) - (Prims.of_int (52))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | FStar_Pervasives_Native.Some - (l, uu___6) -> - let uu___7 = - FStar_InteractiveHelpers_ExploreTerm.safe_typ_or_comp - dbg e l in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (43)) - (Prims.of_int (12)) - (Prims.of_int (43)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - ( - FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (43)) - (Prims.of_int (39)) - (Prims.of_int (47)) - (Prims.of_int (16))))) - (Obj.magic - uu___7) - (fun uu___8 -> - (fun c -> - let uu___8 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - FStar_InteractiveHelpers_Base.mk_genv - e [] [])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (44)) - (Prims.of_int (13)) - (Prims.of_int (44)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (45)) - (Prims.of_int (4)) - (Prims.of_int (47)) - (Prims.of_int (16))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun ge - -> - let uu___9 - = - let uu___10 - = - let uu___11 - = - FStarC_Tactics_V1_Builtins.term_to_string - l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (45)) - (Prims.of_int (51)) - (Prims.of_int (45)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - Prims.strcat - "[> About to explore term:\n" - uu___12)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (45)) - (Prims.of_int (18)) - (Prims.of_int (45)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (45)) - (Prims.of_int (4)) - (Prims.of_int (45)) - (Prims.of_int (68))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___11)) - uu___11) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (45)) - (Prims.of_int (4)) - (Prims.of_int (45)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (45)) - (Prims.of_int (69)) - (Prims.of_int (47)) - (Prims.of_int (16))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - let uu___11 - = - FStar_InteractiveHelpers_ExploreTerm.explore_term - dbg dfs - () f x ge - [] c l in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (46)) - (Prims.of_int (12)) - (Prims.of_int (46)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (47)) - (Prims.of_int (4)) - (Prims.of_int (47)) - (Prims.of_int (16))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun x1 - -> - Obj.magic - (end_proof - ())) - uu___12))) - uu___10))) - uu___9))) - uu___8)) - | uu___6 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - "pp_explore: not a squashed equality")) - uu___5))) uu___3))) - uu___2))) uu___1) -let (pp_explore_print_goal : - unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - (fun uu___2 -> - fun uu___3 -> - fun uu___4 -> - fun uu___5 -> - fun uu___6 -> - fun uu___7 -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - ((), FStarC_Tactics_Types.Continue)))) - uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (57)) (Prims.of_int (4)) (Prims.of_int (57)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (59)) (Prims.of_int (2)) (Prims.of_int (59)) - (Prims.of_int (28))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun f -> - Obj.magic (pp_explore true false () (Obj.magic f) (Obj.repr ()))) - uu___2) -let (is_focus_on_term : - FStarC_Reflection_Types.term -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - (fun t -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Reflection_V1_Derived.is_fvar t - "FStar.InteractiveHelpers.PostProcess.focus_on_term"))) - uu___ -let (term_is_assert_or_assume : - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (70)) (Prims.of_int (8)) (Prims.of_int (70)) - (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (70)) (Prims.of_int (2)) (Prims.of_int (75)) - (Prims.of_int (13))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_App - (hd, (a, FStarC_Reflection_V1_Data.Q_Explicit)) -> - if - FStar_Reflection_V1_Derived.is_any_fvar a - ["Prims._assert"; - "FStar.Pervasives.assert_norm"; - "Prims._assume"] - then FStar_Pervasives_Native.Some a - else FStar_Pervasives_Native.None - | uu___3 -> FStar_Pervasives_Native.None)) -let (is_focused_term : - FStarC_Reflection_V1_Data.term_view -> - (FStarC_Reflection_Types.term FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - (fun tv -> - match tv with - | FStarC_Reflection_V1_Data.Tv_Let - (recf, attrs, uu___, uu___1, def, body) -> - Obj.magic - (Obj.repr - (let uu___2 = is_focus_on_term def in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (83)) (Prims.of_int (7)) - (Prims.of_int (83)) (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (83)) (Prims.of_int (4)) - (Prims.of_int (83)) (Prims.of_int (52))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - if uu___3 - then FStar_Pervasives_Native.Some body - else FStar_Pervasives_Native.None)))) - | uu___ -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> FStar_Pervasives_Native.None)))) uu___ -type 'a exploration_result = - { - ge: FStar_InteractiveHelpers_Base.genv ; - parents: - (FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_V1_Data.term_view) Prims.list - ; - tgt_comp: - FStar_InteractiveHelpers_ExploreTerm.typ_or_comp - FStar_Pervasives_Native.option - ; - res: 'a } -let __proj__Mkexploration_result__item__ge : - 'a . 'a exploration_result -> FStar_InteractiveHelpers_Base.genv = - fun projectee -> - match projectee with | { ge; parents; tgt_comp; res;_} -> ge -let __proj__Mkexploration_result__item__parents : - 'a . - 'a exploration_result -> - (FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_V1_Data.term_view) Prims.list - = - fun projectee -> - match projectee with | { ge; parents; tgt_comp; res;_} -> parents -let __proj__Mkexploration_result__item__tgt_comp : - 'a . - 'a exploration_result -> - FStar_InteractiveHelpers_ExploreTerm.typ_or_comp - FStar_Pervasives_Native.option - = - fun projectee -> - match projectee with | { ge; parents; tgt_comp; res;_} -> tgt_comp -let __proj__Mkexploration_result__item__res : - 'a . 'a exploration_result -> 'a = - fun projectee -> - match projectee with | { ge; parents; tgt_comp; res;_} -> res -let mk_exploration_result : - 'uuuuu . - unit -> - FStar_InteractiveHelpers_Base.genv -> - (FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_V1_Data.term_view) Prims.list -> - FStar_InteractiveHelpers_ExploreTerm.typ_or_comp - FStar_Pervasives_Native.option -> - 'uuuuu -> 'uuuuu exploration_result - = - fun uu___ -> - fun uu___1 -> - fun uu___2 -> - fun uu___3 -> - fun uu___4 -> - { ge = uu___1; parents = uu___2; tgt_comp = uu___3; res = uu___4 - } -type 'a pred_explorer = - FStar_InteractiveHelpers_Base.genv -> - (FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_V1_Data.term_view) Prims.list -> - FStar_InteractiveHelpers_ExploreTerm.typ_or_comp - FStar_Pervasives_Native.option -> - FStarC_Reflection_V1_Data.term_view -> - ('a FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr -let find_predicated_term_explorer : - 'a . - 'a pred_explorer -> - Prims.bool -> - 'a exploration_result FStar_Pervasives_Native.option - FStar_InteractiveHelpers_ExploreTerm.explorer - = - fun pred -> - fun dbg -> - fun acc -> - fun ge -> - fun pl -> - fun opt_c -> - fun t -> - let uu___ = - if FStar_Pervasives_Native.uu___is_Some acc - then - Obj.magic - (Obj.repr - (FStar_InteractiveHelpers_Base.mfail - "find_focused_term_explorer: non empty accumulator")) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> ()))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (102)) (Prims.of_int (2)) - (Prims.of_int (102)) (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (103)) (Prims.of_int (2)) - (Prims.of_int (109)) (Prims.of_int (26))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - if dbg - then - Obj.magic - (Obj.repr - (let uu___3 = - let uu___4 = - let uu___5 = - FStar_InteractiveHelpers_Base.term_view_construct - t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (105)) - (Prims.of_int (47)) - (Prims.of_int (105)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (105)) - (Prims.of_int (47)) - (Prims.of_int (105)) - (Prims.of_int (95))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = - FStarC_Tactics_V1_Builtins.pack - t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (101)) - (Prims.of_int (62)) - (Prims.of_int (101)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (105)) - (Prims.of_int (79)) - (Prims.of_int (105)) - (Prims.of_int (95))))) - (Obj.magic uu___9) - (fun uu___10 -> - (fun uu___10 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.term_to_string - uu___10)) - uu___10) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (105)) - (Prims.of_int (79)) - (Prims.of_int (105)) - (Prims.of_int (95))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - Prims.strcat ":\n" - uu___9)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (105)) - (Prims.of_int (71)) - (Prims.of_int (105)) - (Prims.of_int (95))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat - uu___6 uu___8)))) - uu___6) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (105)) - (Prims.of_int (47)) - (Prims.of_int (105)) - (Prims.of_int (95))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat - "[> find_focused_term_explorer: " - uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (105)) - (Prims.of_int (10)) - (Prims.of_int (105)) - (Prims.of_int (96))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (105)) - (Prims.of_int (4)) - (Prims.of_int (105)) - (Prims.of_int (96))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStarC_Tactics_V1_Builtins.print - uu___4)) uu___4))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> ()))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (103)) (Prims.of_int (2)) - (Prims.of_int (106)) (Prims.of_int (7))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (107)) (Prims.of_int (2)) - (Prims.of_int (109)) - (Prims.of_int (26))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = pred ge pl opt_c t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (107)) - (Prims.of_int (8)) - (Prims.of_int (107)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (107)) - (Prims.of_int (2)) - (Prims.of_int (109)) - (Prims.of_int (26))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - match uu___5 with - | FStar_Pervasives_Native.Some - ft -> - ((FStar_Pervasives_Native.Some - ((mk_exploration_result - ()) ge pl opt_c - ft)), - FStarC_Tactics_Types.Abort) - | FStar_Pervasives_Native.None - -> - (FStar_Pervasives_Native.None, - FStarC_Tactics_Types.Continue))))) - uu___3))) uu___1) -let find_predicated_term : - 'a . - 'a pred_explorer -> - Prims.bool -> - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - (FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_V1_Data.term_view) Prims.list -> - FStar_InteractiveHelpers_ExploreTerm.typ_or_comp - FStar_Pervasives_Native.option -> - FStarC_Reflection_Types.term -> - ('a exploration_result FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr - = - fun pred -> - fun dbg -> - fun dfs -> - fun ge -> - fun pl -> - fun opt_c -> - fun t -> - let uu___ = - Obj.magic - (FStar_InteractiveHelpers_ExploreTerm.explore_term dbg - dfs () - (Obj.magic (find_predicated_term_explorer pred dbg)) - (Obj.magic FStar_Pervasives_Native.None) ge pl opt_c t) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (116)) (Prims.of_int (6)) - (Prims.of_int (118)) (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (116)) (Prims.of_int (2)) - (Prims.of_int (118)) (Prims.of_int (39))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> FStar_Pervasives_Native.fst uu___1)) -let (_is_focused_term_explorer : FStarC_Reflection_Types.term pred_explorer) - = fun ge -> fun pl -> fun opt_c -> fun tv -> is_focused_term tv -let (find_focused_term : - Prims.bool -> - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - (FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_V1_Data.term_view) Prims.list -> - FStar_InteractiveHelpers_ExploreTerm.typ_or_comp - FStar_Pervasives_Native.option -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term exploration_result - FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun dfs -> - fun ge -> - fun pl -> - fun opt_c -> - fun t -> - find_predicated_term _is_focused_term_explorer dbg dfs ge pl - opt_c t -let (find_focused_term_in_current_goal : - Prims.bool -> - (FStarC_Reflection_Types.term exploration_result, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - let uu___ = FStar_Tactics_V1_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (132)) (Prims.of_int (10)) (Prims.of_int (132)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (132)) (Prims.of_int (24)) (Prims.of_int (149)) - (Prims.of_int (5))))) (Obj.magic uu___) - (fun uu___1 -> - (fun g -> - let uu___1 = FStar_Tactics_V1_Derived.cur_env () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (133)) (Prims.of_int (10)) - (Prims.of_int (133)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (134)) (Prims.of_int (2)) - (Prims.of_int (149)) (Prims.of_int (5))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun e -> - let uu___2 = - let uu___3 = - let uu___4 = - FStarC_Tactics_V1_Builtins.term_to_string g in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (134)) - (Prims.of_int (63)) - (Prims.of_int (134)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat - "[> find_focused_assert_in_current_goal:\n" - uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (134)) (Prims.of_int (16)) - (Prims.of_int (134)) (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (134)) (Prims.of_int (2)) - (Prims.of_int (134)) (Prims.of_int (80))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___4)) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (134)) (Prims.of_int (2)) - (Prims.of_int (134)) (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (135)) (Prims.of_int (8)) - (Prims.of_int (148)) (Prims.of_int (75))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = unsquash_equality g in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (135)) - (Prims.of_int (14)) - (Prims.of_int (135)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (135)) - (Prims.of_int (8)) - (Prims.of_int (148)) - (Prims.of_int (75))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | FStar_Pervasives_Native.Some - (l, uu___6) -> - let uu___7 = - FStar_InteractiveHelpers_ExploreTerm.safe_typ_or_comp - dbg e l in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (137)) - (Prims.of_int (12)) - (Prims.of_int (137)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (137)) - (Prims.of_int (39)) - (Prims.of_int (147)) - (Prims.of_int (7))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun c -> - let uu___8 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - FStar_InteractiveHelpers_Base.mk_genv - e [] [])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (138)) - (Prims.of_int (13)) - (Prims.of_int (138)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (139)) - (Prims.of_int (4)) - (Prims.of_int (147)) - (Prims.of_int (7))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - (fun ge - -> - let uu___9 - = - let uu___10 - = - let uu___11 - = - FStarC_Tactics_V1_Builtins.term_to_string - l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (139)) - (Prims.of_int (51)) - (Prims.of_int (139)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - Prims.strcat - "[> About to explore term:\n" - uu___12)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (139)) - (Prims.of_int (18)) - (Prims.of_int (139)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (139)) - (Prims.of_int (4)) - (Prims.of_int (139)) - (Prims.of_int (68))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___11)) - uu___11) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (139)) - (Prims.of_int (4)) - (Prims.of_int (139)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (140)) - (Prims.of_int (10)) - (Prims.of_int (146)) - (Prims.of_int (32))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - let uu___11 - = - find_focused_term - dbg true - ge [] c l in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (140)) - (Prims.of_int (16)) - (Prims.of_int (140)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (140)) - (Prims.of_int (10)) - (Prims.of_int (146)) - (Prims.of_int (32))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - match uu___12 - with - | - FStar_Pervasives_Native.Some - res -> - let uu___13 - = - let uu___14 - = - let uu___15 - = - FStarC_Tactics_V1_Builtins.term_to_string - res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (142)) - (Prims.of_int (50)) - (Prims.of_int (142)) - (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - Prims.strcat - "[> Found focused term:\n" - uu___16)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (142)) - (Prims.of_int (20)) - (Prims.of_int (142)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (142)) - (Prims.of_int (6)) - (Prims.of_int (142)) - (Prims.of_int (73))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___15)) - uu___15) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (142)) - (Prims.of_int (6)) - (Prims.of_int (142)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (141)) - (Prims.of_int (11)) - (Prims.of_int (141)) - (Prims.of_int (14))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> res))) - | - FStar_Pervasives_Native.None - -> - let uu___13 - = - let uu___14 - = - FStarC_Tactics_V1_Builtins.term_to_string - g in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (146)) - (Prims.of_int (15)) - (Prims.of_int (146)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - Prims.strcat - "find_focused_term_in_current_goal: could not find a focused term in the current goal: " - uu___15)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (145)) - (Prims.of_int (12)) - (Prims.of_int (146)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (145)) - (Prims.of_int (6)) - (Prims.of_int (146)) - (Prims.of_int (32))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - uu___14 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___14)) - uu___14))) - uu___12))) - uu___10))) - uu___9))) - uu___8)) - | uu___6 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - "find_focused_term_in_current_goal: not a squashed equality")) - uu___5))) uu___3))) uu___2))) - uu___1) -let (find_focused_assert_in_current_goal : - Prims.bool -> - (FStarC_Reflection_Types.term exploration_result, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> find_focused_assert_in_current_goal" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (154)) (Prims.of_int (2)) (Prims.of_int (154)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (154)) (Prims.of_int (59)) (Prims.of_int (168)) - (Prims.of_int (5))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = find_focused_term_in_current_goal dbg in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (155)) (Prims.of_int (12)) - (Prims.of_int (155)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (156)) (Prims.of_int (2)) - (Prims.of_int (168)) (Prims.of_int (5))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun res -> - let uu___3 = - let uu___4 = - let uu___5 = - FStarC_Tactics_V1_Builtins.term_to_string - res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (156)) - (Prims.of_int (46)) - (Prims.of_int (156)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat "[> Found focused term:\n" - uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (156)) (Prims.of_int (16)) - (Prims.of_int (156)) (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (156)) (Prims.of_int (2)) - (Prims.of_int (156)) (Prims.of_int (69))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___5)) uu___5) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (156)) (Prims.of_int (2)) - (Prims.of_int (156)) (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (156)) (Prims.of_int (70)) - (Prims.of_int (168)) (Prims.of_int (5))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = - let uu___6 = - FStarC_Tactics_V1_Builtins.inspect - res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (159)) - (Prims.of_int (10)) - (Prims.of_int (159)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (159)) - (Prims.of_int (4)) - (Prims.of_int (163)) - (Prims.of_int (14))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - match uu___7 with - | FStarC_Reflection_V1_Data.Tv_Let - (uu___8, uu___9, bv0, ty, - fterm, uu___10) - -> - Obj.magic - (Obj.repr - (let uu___11 = - FStar_InteractiveHelpers_Base.genv_push_bv - res.ge bv0 ty false - FStar_Pervasives_Native.None in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (161)) - (Prims.of_int (16)) - (Prims.of_int (161)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (162)) - (Prims.of_int (6)) - (Prims.of_int (162)) - (Prims.of_int (42))))) - (Obj.magic uu___11) - (fun ge' -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___12 -> - { - ge = ge'; - parents = - ( - res.parents); - tgt_comp = - ( - res.tgt_comp); - res = fterm - })))) - | uu___8 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> res)))) - uu___7) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (159)) - (Prims.of_int (4)) - (Prims.of_int (163)) - (Prims.of_int (14))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (165)) - (Prims.of_int (8)) - (Prims.of_int (167)) - (Prims.of_int (38))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun res' -> - let uu___6 = - term_is_assert_or_assume - res'.res in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (165)) - (Prims.of_int (14)) - (Prims.of_int (165)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (165)) - (Prims.of_int (8)) - (Prims.of_int (167)) - (Prims.of_int (38))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - match uu___7 with - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (let uu___8 - = - let uu___9 - = - FStarC_Tactics_V1_Builtins.term_to_string - res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (166)) - (Prims.of_int (121)) - (Prims.of_int (166)) - (Prims.of_int (143))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Prims.strcat - "find_focused_assert_in_current_goal: the found focused term is not an assertion or an assumption:" - uu___10)) in - FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (166)) - (Prims.of_int (18)) - (Prims.of_int (166)) - (Prims.of_int (144))))) - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (166)) - (Prims.of_int (12)) - (Prims.of_int (166)) - (Prims.of_int (144))))) - ( - Obj.magic - uu___8) - ( - fun - uu___9 -> - (fun - uu___9 -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___9)) - uu___9))) - | FStar_Pervasives_Native.Some - tm -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - ( - fun - uu___8 -> - { - ge = - (res'.ge); - parents = - (res'.parents); - tgt_comp - = - (res'.tgt_comp); - res = tm - })))) - uu___7))) uu___6))) - uu___4))) uu___3))) uu___1) -let (analyze_effectful_term : - Prims.bool -> - Prims.bool -> - Prims.bool -> - FStarC_Reflection_Types.term exploration_result -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun with_gpre -> - fun with_gpost -> - fun res -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> res.ge)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (184)) (Prims.of_int (11)) - (Prims.of_int (184)) (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (184)) (Prims.of_int (20)) - (Prims.of_int (241)) (Prims.of_int (30))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun ge -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> res.tgt_comp)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (185)) (Prims.of_int (14)) - (Prims.of_int (185)) (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (185)) (Prims.of_int (29)) - (Prims.of_int (241)) (Prims.of_int (30))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun opt_c -> - let uu___2 = - let uu___3 = - FStarC_Tactics_V1_Builtins.inspect res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (188)) - (Prims.of_int (16)) - (Prims.of_int (188)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (188)) - (Prims.of_int (10)) - (Prims.of_int (215)) - (Prims.of_int (82))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | FStarC_Reflection_V1_Data.Tv_Let - (uu___5, uu___6, bv0, ty, fterm, - uu___7) - -> - let uu___8 = - let uu___9 = - let uu___10 = - FStarC_Tactics_V1_Builtins.term_to_string - fterm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (195)) - (Prims.of_int (42)) - (Prims.of_int (195)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___10) - (fun uu___11 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___12 -> - Prims.strcat - "Restraining to: " - uu___11)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (195)) - (Prims.of_int (20)) - (Prims.of_int (195)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (195)) - (Prims.of_int (6)) - (Prims.of_int (195)) - (Prims.of_int (63))))) - (Obj.magic uu___9) - (fun uu___10 -> - (fun uu___10 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___10)) - uu___10) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (195)) - (Prims.of_int (6)) - (Prims.of_int (195)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (195)) - (Prims.of_int (64)) - (Prims.of_int (214)) - (Prims.of_int (69))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun uu___9 -> - let uu___10 = - let uu___11 = - let uu___12 = - FStar_Tactics_V1_Derived.name_of_bv - bv0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (197)) - (Prims.of_int (36)) - (Prims.of_int (197)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (197)) - (Prims.of_int (14)) - (Prims.of_int (197)) - (Prims.of_int (52))))) - (Obj.magic - uu___12) - (fun uu___13 -> - (fun uu___13 - -> - Obj.magic - ( - FStar_InteractiveHelpers_Base.genv_get_from_name - ge - uu___13)) - uu___13) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (197)) - (Prims.of_int (14)) - (Prims.of_int (197)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (197)) - (Prims.of_int (8)) - (Prims.of_int (199)) - (Prims.of_int (41))))) - (Obj.magic uu___11) - (fun uu___12 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___13 - -> - match uu___12 - with - | FStar_Pervasives_Native.None - -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some - (sbv, - uu___14) - -> - FStar_Pervasives_Native.Some - (FStar_Pervasives_Native.fst - sbv))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (197)) - (Prims.of_int (8)) - (Prims.of_int (199)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (200)) - (Prims.of_int (8)) - (Prims.of_int (214)) - (Prims.of_int (69))))) - (Obj.magic uu___10) - (fun uu___11 -> - (fun - shadowed_bv - -> - let uu___11 - = - FStar_InteractiveHelpers_Base.genv_push_bv - ge bv0 ty - false - FStar_Pervasives_Native.None in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (201)) - (Prims.of_int (16)) - (Prims.of_int (201)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (201)) - (Prims.of_int (52)) - (Prims.of_int (214)) - (Prims.of_int (69))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun ge1 - -> - let uu___12 - = - let uu___13 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - FStarC_Reflection_V1_Builtins.inspect_bv - bv0)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (207)) - (Prims.of_int (19)) - (Prims.of_int (207)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (207)) - (Prims.of_int (36)) - (Prims.of_int (211)) - (Prims.of_int (21))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun bvv0 - -> - let uu___14 - = - let uu___15 - = - let uu___16 - = - FStar_InteractiveHelpers_Base.abv_to_string - bv0 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (208)) - (Prims.of_int (59)) - (Prims.of_int (208)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> - Prims.strcat - "Variable bound in let: " - uu___17)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (208)) - (Prims.of_int (30)) - (Prims.of_int (208)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (208)) - (Prims.of_int (16)) - (Prims.of_int (208)) - (Prims.of_int (77))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___16)) - uu___16) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (208)) - (Prims.of_int (16)) - (Prims.of_int (208)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (209)) - (Prims.of_int (8)) - (Prims.of_int (211)) - (Prims.of_int (21))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - let uu___16 - = - let uu___17 - = - FStarC_Tactics_Unseal.unseal - bvv0.FStarC_Reflection_V1_Data.bv_ppname in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (209)) - (Prims.of_int (11)) - (Prims.of_int (209)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (209)) - (Prims.of_int (11)) - (Prims.of_int (209)) - (Prims.of_int (42))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - uu___18 = - "uu___")) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (209)) - (Prims.of_int (11)) - (Prims.of_int (209)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (209)) - (Prims.of_int (8)) - (Prims.of_int (211)) - (Prims.of_int (21))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - if - uu___17 - then - Obj.magic - (Obj.repr - (FStar_InteractiveHelpers_Base.genv_push_fresh_bv - ge1 "ret" - ty)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - (ge1, - bv0))))) - uu___17))) - uu___15))) - uu___14) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (206)) - (Prims.of_int (27)) - (Prims.of_int (211)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (201)) - (Prims.of_int (52)) - (Prims.of_int (214)) - (Prims.of_int (69))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - match uu___13 - with - | - (ge2, - bv1) -> - let uu___14 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> bv1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (212)) - (Prims.of_int (8)) - (Prims.of_int (214)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (212)) - (Prims.of_int (8)) - (Prims.of_int (214)) - (Prims.of_int (69))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun bv11 - -> - let uu___15 - = - FStar_InteractiveHelpers_Effectful.compute_eterm_info - dbg - ge2.FStar_InteractiveHelpers_Base.env - fterm in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (213)) - (Prims.of_int (17)) - (Prims.of_int (213)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (214)) - (Prims.of_int (6)) - (Prims.of_int (214)) - (Prims.of_int (69))))) - (Obj.magic - uu___15) - (fun info - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - (ge2, - fterm, - info, - (FStar_Pervasives_Native.Some - bv11), - shadowed_bv, - true))))) - uu___15))) - uu___13))) - uu___12))) - uu___11))) - uu___9)) - | uu___5 -> - let uu___6 = - FStar_InteractiveHelpers_Effectful.compute_eterm_info - dbg - ge.FStar_InteractiveHelpers_Base.env - res.res in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (215)) - (Prims.of_int (25)) - (Prims.of_int (215)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (215)) - (Prims.of_int (11)) - (Prims.of_int (215)) - (Prims.of_int (82))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (ge, (res.res), - uu___7, - FStar_Pervasives_Native.None, - FStar_Pervasives_Native.None, - false))))) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (188)) - (Prims.of_int (10)) - (Prims.of_int (215)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (185)) - (Prims.of_int (29)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (ge1, studied_term, info, ret_bv, - shadowed_bv, is_let) -> - let uu___4 = - let uu___5 = - let uu___6 = - FStar_InteractiveHelpers_Base.term_construct - studied_term in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (218)) - (Prims.of_int (51)) - (Prims.of_int (218)) - (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat - "[> Focused term constructor: " - uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (218)) - (Prims.of_int (16)) - (Prims.of_int (218)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (218)) - (Prims.of_int (2)) - (Prims.of_int (218)) - (Prims.of_int (79))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___6)) - uu___6) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (218)) - (Prims.of_int (2)) - (Prims.of_int (218)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (219)) - (Prims.of_int (2)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = - FStar_InteractiveHelpers_Base.genv_to_string - ge1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (219)) - (Prims.of_int (75)) - (Prims.of_int (219)) - (Prims.of_int (93))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - Prims.strcat - "[> Environment information (after effect analysis):\n" - uu___9)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (219)) - (Prims.of_int (16)) - (Prims.of_int (219)) - (Prims.of_int (94))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (219)) - (Prims.of_int (2)) - (Prims.of_int (219)) - (Prims.of_int (94))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___8)) - uu___8) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (219)) - (Prims.of_int (2)) - (Prims.of_int (219)) - (Prims.of_int (94))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (219)) - (Prims.of_int (95)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - let uu___8 - = - let uu___9 - = - term_is_assert_or_assume - studied_term in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (223)) - (Prims.of_int (24)) - (Prims.of_int (223)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (223)) - (Prims.of_int (18)) - (Prims.of_int (223)) - (Prims.of_int (63))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - FStar_Pervasives_Native.uu___is_Some - uu___10)) in - Obj.magic - ( - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (223)) - (Prims.of_int (18)) - (Prims.of_int (223)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (223)) - (Prims.of_int (66)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - is_assert - -> - let uu___9 - = - FStar_InteractiveHelpers_Base.opt_tapply - (fun x -> - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - x)) - ret_bv in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (226)) - (Prims.of_int (16)) - (Prims.of_int (226)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (226)) - (Prims.of_int (63)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - ret_arg - -> - let uu___10 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - FStar_List_Tot_Base.map - FStar_Pervasives_Native.snd - res.parents)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (227)) - (Prims.of_int (16)) - (Prims.of_int (227)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (227)) - (Prims.of_int (47)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - parents - -> - let uu___11 - = - FStar_InteractiveHelpers_Effectful.eterm_info_to_assertions - dbg - with_gpre - with_gpost - ge1 - studied_term - is_let - is_assert - info - ret_arg - opt_c - parents - [] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (229)) - (Prims.of_int (4)) - (Prims.of_int (230)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (227)) - (Prims.of_int (47)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - match uu___12 - with - | - (ge2, - asserts) - -> - let uu___13 - = - FStar_InteractiveHelpers_Propositions.simp_filter_assertions - ge2.FStar_InteractiveHelpers_Base.env - FStar_InteractiveHelpers_Propositions.simpl_norm_steps - asserts in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (232)) - (Prims.of_int (16)) - (Prims.of_int (232)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (232)) - (Prims.of_int (74)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - asserts1 - -> - let uu___14 - = - FStar_InteractiveHelpers_Output.subst_shadowed_with_abs_in_assertions - dbg ge2 - shadowed_bv - asserts1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (234)) - (Prims.of_int (21)) - (Prims.of_int (234)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (232)) - (Prims.of_int (74)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - match uu___15 - with - | - (ge3, - asserts2) - -> - let uu___16 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - if is_let - then - asserts2 - else - FStar_InteractiveHelpers_Propositions.mk_assertions - (FStar_List_Tot_Base.append - asserts2.FStar_InteractiveHelpers_Propositions.pres - asserts2.FStar_InteractiveHelpers_Propositions.posts) - [])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (237)) - (Prims.of_int (4)) - (Prims.of_int (238)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (241)) - (Prims.of_int (2)) - (Prims.of_int (241)) - (Prims.of_int (30))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - asserts3 - -> - Obj.magic - (FStar_InteractiveHelpers_Output.printout_success - ge3 - asserts3)) - uu___17))) - uu___15))) - uu___14))) - uu___12))) - uu___11))) - uu___10))) - uu___9))) - uu___7))) - uu___5))) uu___3))) - uu___2))) uu___1) -let (pp_analyze_effectful_term : - Prims.bool -> - Prims.bool -> - Prims.bool -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun with_gpre -> - fun with_gpost -> - fun uu___ -> - FStar_Tactics_V1_Derived.try_with - (fun uu___1 -> - match () with - | () -> - let uu___2 = find_focused_term_in_current_goal dbg in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (247)) (Prims.of_int (14)) - (Prims.of_int (247)) (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (248)) (Prims.of_int (4)) - (Prims.of_int (249)) (Prims.of_int (16))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun res -> - let uu___3 = - analyze_effectful_term dbg with_gpre with_gpost - res in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (248)) - (Prims.of_int (4)) - (Prims.of_int (248)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (249)) - (Prims.of_int (4)) - (Prims.of_int (249)) - (Prims.of_int (16))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> Obj.magic (end_proof ())) - uu___4))) uu___3)) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_InteractiveHelpers_Base.MetaAnalysis msg -> - Obj.magic - (Obj.repr - (let uu___2 = - FStar_InteractiveHelpers_Output.printout_failure - msg in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (250)) - (Prims.of_int (29)) - (Prims.of_int (250)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (250)) - (Prims.of_int (51)) - (Prims.of_int (250)) - (Prims.of_int (63))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> Obj.magic (end_proof ())) - uu___3))) - | err -> - Obj.magic (Obj.repr (FStar_Tactics_Effect.raise err))) - uu___1) -let _ = - FStarC_Tactics_Native.register_tactic - "FStar.InteractiveHelpers.PostProcess.pp_analyze_effectful_term" - (Prims.of_int (5)) - (fun psc -> - fun ncb -> - fun us -> - fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_4 - "FStar.InteractiveHelpers.PostProcess.pp_analyze_effectful_term (plugin)" - (FStarC_Tactics_Native.from_tactic_4 pp_analyze_effectful_term) - FStarC_Syntax_Embeddings.e_bool - FStarC_Syntax_Embeddings.e_bool - FStarC_Syntax_Embeddings.e_bool - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) -let (remove_b2t : - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (266)) (Prims.of_int (8)) (Prims.of_int (266)) - (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (266)) (Prims.of_int (2)) (Prims.of_int (273)) - (Prims.of_int (10))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_App - (hd, (a, FStarC_Reflection_V1_Data.Q_Explicit)) -> - Obj.magic - (Obj.repr - (let uu___2 = FStarC_Tactics_V1_Builtins.inspect hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (268)) (Prims.of_int (16)) - (Prims.of_int (268)) (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (268)) (Prims.of_int (10)) - (Prims.of_int (271)) (Prims.of_int (12))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - match uu___3 with - | FStarC_Reflection_V1_Data.Tv_FVar fv -> - if - FStar_InteractiveHelpers_Base.fv_eq_name - fv FStar_Reflection_Const.b2t_qn - then a - else t - | uu___5 -> t)))) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> t)))) - uu___1) -let (is_conjunction : - FStarC_Reflection_Types.term -> - ((FStarC_Reflection_Types.term * FStarC_Reflection_Types.term) - FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = remove_b2t t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (279)) (Prims.of_int (10)) (Prims.of_int (279)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (279)) (Prims.of_int (25)) (Prims.of_int (290)) - (Prims.of_int (13))))) (Obj.magic uu___) - (fun uu___1 -> - (fun t1 -> - let uu___1 = FStar_Tactics_V1_SyntaxHelpers.collect_app t1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (280)) (Prims.of_int (19)) - (Prims.of_int (280)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (279)) (Prims.of_int (25)) - (Prims.of_int (290)) (Prims.of_int (13))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - match uu___2 with - | (hd, params) -> - (match params with - | (x, FStarC_Reflection_V1_Data.Q_Explicit):: - (y, FStarC_Reflection_V1_Data.Q_Explicit)::[] - -> - Obj.magic - (Obj.repr - (let uu___3 = - FStarC_Tactics_V1_Builtins.inspect hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (283)) - (Prims.of_int (16)) - (Prims.of_int (283)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (283)) - (Prims.of_int (10)) - (Prims.of_int (288)) - (Prims.of_int (15))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - match uu___4 with - | FStarC_Reflection_V1_Data.Tv_FVar - fv -> - if - ((FStarC_Reflection_V1_Builtins.inspect_fv - fv) - = - FStar_Reflection_Const.and_qn) - || - ((FStarC_Reflection_V1_Builtins.inspect_fv - fv) - = - ["Prims"; - "op_AmpAmp"]) - then - FStar_Pervasives_Native.Some - (x, y) - else - FStar_Pervasives_Native.None - | uu___6 -> - FStar_Pervasives_Native.None)))) - | uu___3 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Pervasives_Native.None))))) - uu___2))) uu___1) -let rec (_split_conjunctions : - FStarC_Reflection_Types.term Prims.list -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term Prims.list, unit) - FStar_Tactics_Effect.tac_repr) - = - fun ls -> - fun t -> - let uu___ = is_conjunction t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (295)) (Prims.of_int (8)) (Prims.of_int (295)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (295)) (Prims.of_int (2)) (Prims.of_int (300)) - (Prims.of_int (7))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> t :: ls))) - | FStar_Pervasives_Native.Some (l, r) -> - Obj.magic - (Obj.repr - (let uu___2 = _split_conjunctions ls r in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (298)) (Prims.of_int (14)) - (Prims.of_int (298)) (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (298)) (Prims.of_int (41)) - (Prims.of_int (300)) (Prims.of_int (7))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun ls1 -> - let uu___3 = _split_conjunctions ls1 l in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (299)) - (Prims.of_int (14)) - (Prims.of_int (299)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (299)) - (Prims.of_int (8)) - (Prims.of_int (299)) - (Prims.of_int (11))))) - (Obj.magic uu___3) - (fun ls2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> ls2)))) uu___3)))) - uu___1) -let (split_conjunctions : - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term Prims.list, unit) - FStar_Tactics_Effect.tac_repr) - = fun t -> _split_conjunctions [] t -let (split_conjunctions_under_match : - Prims.bool -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term Prims.list, unit) - FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun t -> - let uu___ = remove_b2t t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (314)) (Prims.of_int (11)) - (Prims.of_int (314)) (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (315)) (Prims.of_int (2)) (Prims.of_int (322)) - (Prims.of_int (7))))) (Obj.magic uu___) - (fun uu___1 -> - (fun t1 -> - let uu___1 = - let uu___2 = - let uu___3 = - FStar_InteractiveHelpers_Base.term_construct t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (315)) (Prims.of_int (57)) - (Prims.of_int (315)) (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - Prims.strcat - "[> split_conjunctions_under_match: " uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (315)) (Prims.of_int (16)) - (Prims.of_int (315)) (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (315)) (Prims.of_int (2)) - (Prims.of_int (315)) (Prims.of_int (75))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___3)) - uu___3) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (315)) (Prims.of_int (2)) - (Prims.of_int (315)) (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (316)) (Prims.of_int (2)) - (Prims.of_int (322)) (Prims.of_int (7))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = FStarC_Tactics_V1_Builtins.inspect t1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (316)) - (Prims.of_int (8)) - (Prims.of_int (316)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (316)) - (Prims.of_int (2)) - (Prims.of_int (322)) - (Prims.of_int (7))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | FStarC_Reflection_V1_Data.Tv_Match - (scrut, ret_opt, (pat, br)::[]) -> - Obj.magic - (Obj.repr - (let uu___5 = - split_conjunctions br in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (318)) - (Prims.of_int (13)) - (Prims.of_int (318)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (319)) - (Prims.of_int (4)) - (Prims.of_int (319)) - (Prims.of_int (62))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun tl -> - Obj.magic - (FStar_Tactics_Util.map - (fun x -> - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Match - (scrut, - ret_opt, - [ - (pat, x)]))) - tl)) uu___6))) - | uu___5 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> [t])))) uu___4))) - uu___2))) uu___1) -let (split_assert_conjs : - Prims.bool -> - FStarC_Reflection_Types.term exploration_result -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun res -> - let uu___ = - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> res.ge)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (326)) (Prims.of_int (12)) - (Prims.of_int (326)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (326)) (Prims.of_int (21)) - (Prims.of_int (341)) (Prims.of_int (30))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun ge0 -> - let uu___1 = - FStarC_Tactics_V1_Builtins.norm_term_env - ge0.FStar_InteractiveHelpers_Base.env - FStar_InteractiveHelpers_Propositions.simpl_norm_steps - res.res in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (328)) (Prims.of_int (10)) - (Prims.of_int (328)) (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (328)) (Prims.of_int (59)) - (Prims.of_int (341)) (Prims.of_int (30))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun t -> - let uu___2 = split_conjunctions t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (330)) - (Prims.of_int (14)) - (Prims.of_int (330)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (330)) - (Prims.of_int (37)) - (Prims.of_int (341)) - (Prims.of_int (30))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun conjs -> - let uu___3 = - if - (FStar_List_Tot_Base.length conjs) = - Prims.int_one - then - Obj.magic - (Obj.repr - (split_conjunctions_under_match - dbg t)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> conjs))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (336)) - (Prims.of_int (4)) - (Prims.of_int (337)) - (Prims.of_int (14))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (338)) - (Prims.of_int (4)) - (Prims.of_int (341)) - (Prims.of_int (30))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun conjs1 -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_InteractiveHelpers_Propositions.mk_assertions - conjs1 [])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (339)) - (Prims.of_int (16)) - (Prims.of_int (339)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (341)) - (Prims.of_int (2)) - (Prims.of_int (341)) - (Prims.of_int (30))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun asserts -> - Obj.magic - (FStar_InteractiveHelpers_Output.printout_success - ge0 asserts)) - uu___5))) uu___4))) - uu___3))) uu___2))) uu___1) -let (pp_split_assert_conjs : - Prims.bool -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun dbg -> - fun uu___ -> - FStar_Tactics_V1_Derived.try_with - (fun uu___1 -> - match () with - | () -> - let uu___2 = find_focused_assert_in_current_goal dbg in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (347)) (Prims.of_int (14)) - (Prims.of_int (347)) (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (348)) (Prims.of_int (4)) - (Prims.of_int (349)) (Prims.of_int (16))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun res -> - let uu___3 = split_assert_conjs dbg res in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (348)) (Prims.of_int (4)) - (Prims.of_int (348)) (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (349)) (Prims.of_int (4)) - (Prims.of_int (349)) (Prims.of_int (16))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> Obj.magic (end_proof ())) - uu___4))) uu___3)) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_InteractiveHelpers_Base.MetaAnalysis msg -> - Obj.magic - (Obj.repr - (let uu___2 = - FStar_InteractiveHelpers_Output.printout_failure - msg in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (350)) (Prims.of_int (29)) - (Prims.of_int (350)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (350)) (Prims.of_int (51)) - (Prims.of_int (350)) (Prims.of_int (63))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> Obj.magic (end_proof ())) uu___3))) - | err -> Obj.magic (Obj.repr (FStar_Tactics_Effect.raise err))) - uu___1) -let _ = - FStarC_Tactics_Native.register_tactic - "FStar.InteractiveHelpers.PostProcess.pp_split_assert_conjs" - (Prims.of_int (3)) - (fun psc -> - fun ncb -> - fun us -> - fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 - "FStar.InteractiveHelpers.PostProcess.pp_split_assert_conjs (plugin)" - (FStarC_Tactics_Native.from_tactic_2 pp_split_assert_conjs) - FStarC_Syntax_Embeddings.e_bool - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) -type eq_kind = - | Eq_Dec of FStarC_Reflection_Types.typ - | Eq_Undec of FStarC_Reflection_Types.typ - | Eq_Hetero of FStarC_Reflection_Types.typ * FStarC_Reflection_Types.typ -let (uu___is_Eq_Dec : eq_kind -> Prims.bool) = - fun projectee -> match projectee with | Eq_Dec _0 -> true | uu___ -> false -let (__proj__Eq_Dec__item___0 : eq_kind -> FStarC_Reflection_Types.typ) = - fun projectee -> match projectee with | Eq_Dec _0 -> _0 -let (uu___is_Eq_Undec : eq_kind -> Prims.bool) = - fun projectee -> - match projectee with | Eq_Undec _0 -> true | uu___ -> false -let (__proj__Eq_Undec__item___0 : eq_kind -> FStarC_Reflection_Types.typ) = - fun projectee -> match projectee with | Eq_Undec _0 -> _0 -let (uu___is_Eq_Hetero : eq_kind -> Prims.bool) = - fun projectee -> - match projectee with | Eq_Hetero (_0, _1) -> true | uu___ -> false -let (__proj__Eq_Hetero__item___0 : eq_kind -> FStarC_Reflection_Types.typ) = - fun projectee -> match projectee with | Eq_Hetero (_0, _1) -> _0 -let (__proj__Eq_Hetero__item___1 : eq_kind -> FStarC_Reflection_Types.typ) = - fun projectee -> match projectee with | Eq_Hetero (_0, _1) -> _1 -let (is_eq : - Prims.bool -> - FStarC_Reflection_Types.term -> - ((eq_kind * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term) FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun t -> - let uu___ = remove_b2t t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (371)) (Prims.of_int (10)) - (Prims.of_int (371)) (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (372)) (Prims.of_int (2)) (Prims.of_int (391)) - (Prims.of_int (13))))) (Obj.magic uu___) - (fun uu___1 -> - (fun t1 -> - let uu___1 = - let uu___2 = - let uu___3 = FStarC_Tactics_V1_Builtins.term_to_string t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (372)) (Prims.of_int (32)) - (Prims.of_int (372)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat "[> is_eq: " uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (372)) (Prims.of_int (16)) - (Prims.of_int (372)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (372)) (Prims.of_int (2)) - (Prims.of_int (372)) (Prims.of_int (49))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___3)) - uu___3) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (372)) (Prims.of_int (2)) - (Prims.of_int (372)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (372)) (Prims.of_int (50)) - (Prims.of_int (391)) (Prims.of_int (13))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - FStar_Tactics_V1_SyntaxHelpers.collect_app t1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (373)) - (Prims.of_int (19)) - (Prims.of_int (373)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (372)) - (Prims.of_int (50)) - (Prims.of_int (391)) - (Prims.of_int (13))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | (hd, params) -> - let uu___5 = - let uu___6 = - let uu___7 = - FStarC_Tactics_V1_Builtins.term_to_string - hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (374)) - (Prims.of_int (29)) - (Prims.of_int (374)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat "- hd:\n" - uu___8)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (374)) - (Prims.of_int (16)) - (Prims.of_int (374)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (374)) - (Prims.of_int (2)) - (Prims.of_int (374)) - (Prims.of_int (47))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___7)) uu___7) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (374)) - (Prims.of_int (2)) - (Prims.of_int (374)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (375)) - (Prims.of_int (2)) - (Prims.of_int (391)) - (Prims.of_int (13))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = - FStar_InteractiveHelpers_Base.list_to_string - (fun uu___10 -> - match uu___10 - with - | (x, y) -> - FStarC_Tactics_V1_Builtins.term_to_string - x) params in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (375)) - (Prims.of_int (37)) - (Prims.of_int (375)) - (Prims.of_int (91))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> - Prims.strcat - "- parameters:\n" - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (375)) - (Prims.of_int (16)) - (Prims.of_int (375)) - (Prims.of_int (92))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (375)) - (Prims.of_int (2)) - (Prims.of_int (375)) - (Prims.of_int (92))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun uu___9 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___9)) - uu___9) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (375)) - (Prims.of_int (2)) - (Prims.of_int (375)) - (Prims.of_int (92))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (376)) - (Prims.of_int (2)) - (Prims.of_int (391)) - (Prims.of_int (13))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - let uu___9 = - FStarC_Tactics_V1_Builtins.inspect - hd in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (376)) - (Prims.of_int (8)) - (Prims.of_int (376)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (376)) - (Prims.of_int (2)) - (Prims.of_int (391)) - (Prims.of_int (13))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - match uu___10 - with - | - FStarC_Reflection_V1_Data.Tv_FVar - fv -> - (match params - with - | - (a, - FStarC_Reflection_V1_Data.Q_Implicit):: - (x, - FStarC_Reflection_V1_Data.Q_Explicit):: - (y, - FStarC_Reflection_V1_Data.Q_Explicit)::[] - -> - if - FStar_Reflection_V1_Derived.is_any_fvar - a - ["Prims.op_Equality"; - "Prims.equals"; - "Prims.op_Equals"] - then - FStar_Pervasives_Native.Some - ((Eq_Dec - a), x, y) - else - if - FStar_Reflection_V1_Derived.is_any_fvar - a - ["Prims.eq2"; - "Prims.op_Equals_Equals"] - then - FStar_Pervasives_Native.Some - ((Eq_Undec - a), x, y) - else - FStar_Pervasives_Native.None - | - (a, - FStarC_Reflection_V1_Data.Q_Implicit):: - (b, - FStarC_Reflection_V1_Data.Q_Implicit):: - (x, - FStarC_Reflection_V1_Data.Q_Explicit):: - (y, - FStarC_Reflection_V1_Data.Q_Explicit)::[] - -> - if - FStar_Reflection_V1_Derived.is_fvar - a - "Prims.op_Equals_Equals_Equals" - then - FStar_Pervasives_Native.Some - ((Eq_Hetero - (a, b)), - x, y) - else - FStar_Pervasives_Native.None - | - uu___12 - -> - FStar_Pervasives_Native.None) - | - uu___12 - -> - FStar_Pervasives_Native.None)))) - uu___8))) uu___6))) - uu___4))) uu___2))) uu___1) -let (mk_eq : - eq_kind -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = - fun k -> - fun t1 -> - fun t2 -> - match k with - | Eq_Dec ty -> - FStar_Reflection_V1_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "op_Equality"]))) - [(ty, FStarC_Reflection_V1_Data.Q_Implicit); - (t1, FStarC_Reflection_V1_Data.Q_Explicit); - (t2, FStarC_Reflection_V1_Data.Q_Explicit)] - | Eq_Undec ty -> - FStar_Reflection_V1_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv ["Prims"; "eq2"]))) - [(ty, FStarC_Reflection_V1_Data.Q_Implicit); - (t1, FStarC_Reflection_V1_Data.Q_Explicit); - (t2, FStarC_Reflection_V1_Data.Q_Explicit)] - | Eq_Hetero (ty1, ty2) -> - FStar_Reflection_V1_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "op_Equals_Equals_Equals"]))) - [(ty1, FStarC_Reflection_V1_Data.Q_Implicit); - (ty2, FStarC_Reflection_V1_Data.Q_Implicit); - (t1, FStarC_Reflection_V1_Data.Q_Explicit); - (t2, FStarC_Reflection_V1_Data.Q_Explicit)] -let (formula_construct : - FStar_Reflection_V1_Formula.formula -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - (fun f -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - match f with - | FStar_Reflection_V1_Formula.True_ -> "True_" - | FStar_Reflection_V1_Formula.False_ -> "False_" - | FStar_Reflection_V1_Formula.Comp (uu___1, uu___2, uu___3) -> - "Comp" - | FStar_Reflection_V1_Formula.And (uu___1, uu___2) -> "And" - | FStar_Reflection_V1_Formula.Or (uu___1, uu___2) -> "Or" - | FStar_Reflection_V1_Formula.Not uu___1 -> "Not" - | FStar_Reflection_V1_Formula.Implies (uu___1, uu___2) -> - "Implies" - | FStar_Reflection_V1_Formula.Iff (uu___1, uu___2) -> "Iff" - | FStar_Reflection_V1_Formula.Forall (uu___1, uu___2, uu___3) - -> "Forall" - | FStar_Reflection_V1_Formula.Exists (uu___1, uu___2, uu___3) - -> "Exists" - | FStar_Reflection_V1_Formula.App (uu___1, uu___2) -> "Apply" - | FStar_Reflection_V1_Formula.Name uu___1 -> "Name" - | FStar_Reflection_V1_Formula.FV uu___1 -> "FV" - | FStar_Reflection_V1_Formula.IntLit uu___1 -> "IntLit" - | FStar_Reflection_V1_Formula.F_Unknown -> "F_Unknown"))) - uu___ -let (is_equality_for_term : - Prims.bool -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun tm -> - fun p -> - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStarC_Tactics_V1_Builtins.term_to_string tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (428)) (Prims.of_int (32)) - (Prims.of_int (428)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (428)) (Prims.of_int (32)) - (Prims.of_int (429)) (Prims.of_int (48))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - let uu___7 = - FStarC_Tactics_V1_Builtins.term_to_string p in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (429)) (Prims.of_int (32)) - (Prims.of_int (429)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat "\n- prop: " uu___8)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (429)) - (Prims.of_int (17)) - (Prims.of_int (429)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> Prims.strcat uu___5 uu___7)))) - uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (428)) (Prims.of_int (32)) - (Prims.of_int (429)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat "\n- term: " uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (428)) (Prims.of_int (17)) - (Prims.of_int (429)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat "[> is_equality_for_term:" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (427)) (Prims.of_int (16)) - (Prims.of_int (429)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (427)) (Prims.of_int (2)) - (Prims.of_int (429)) (Prims.of_int (49))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___2)) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (427)) (Prims.of_int (2)) - (Prims.of_int (429)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (429)) (Prims.of_int (50)) - (Prims.of_int (453)) (Prims.of_int (8))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - let uu___3 = FStarC_Tactics_V1_Builtins.inspect tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (433)) (Prims.of_int (10)) - (Prims.of_int (433)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (433)) (Prims.of_int (4)) - (Prims.of_int (436)) (Prims.of_int (38))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - fun uu___5 -> - (fun uu___5 -> - match uu___4 with - | FStarC_Reflection_V1_Data.Tv_Var bv -> - Obj.magic - (Obj.repr - (fun tm' -> - let uu___6 = - FStarC_Tactics_V1_Builtins.inspect - tm' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (435)) - (Prims.of_int (24)) - (Prims.of_int (435)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (435)) - (Prims.of_int (18)) - (Prims.of_int (435)) - (Prims.of_int (82))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - match uu___7 with - | FStarC_Reflection_V1_Data.Tv_Var - bv' -> - FStar_InteractiveHelpers_Base.bv_eq - bv bv' - | uu___9 -> false)))) - | uu___6 -> - Obj.magic - (Obj.repr - (fun tm' -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - FStar_InteractiveHelpers_Effectful.term_eq - tm tm')))) uu___6 uu___5)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (433)) (Prims.of_int (4)) - (Prims.of_int (436)) (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (438)) (Prims.of_int (2)) - (Prims.of_int (453)) (Prims.of_int (8))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun check_eq -> - let uu___3 = is_eq dbg p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (438)) - (Prims.of_int (8)) - (Prims.of_int (438)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (438)) - (Prims.of_int (2)) - (Prims.of_int (453)) - (Prims.of_int (8))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | FStar_Pervasives_Native.Some - (ekind, l, r) -> - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - FStarC_Tactics_V1_Builtins.term_to_string - l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (442)) - (Prims.of_int (36)) - (Prims.of_int (442)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (442)) - (Prims.of_int (36)) - (Prims.of_int (442)) - (Prims.of_int (79))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun uu___9 -> - let uu___10 = - let uu___11 = - FStarC_Tactics_V1_Builtins.term_to_string - r in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (442)) - (Prims.of_int (63)) - (Prims.of_int (442)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___11) - (fun uu___12 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___13 - -> - Prims.strcat - " = " - uu___12)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (442)) - (Prims.of_int (55)) - (Prims.of_int (442)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___10) - (fun uu___11 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - Prims.strcat - uu___9 - uu___11)))) - uu___9) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (442)) - (Prims.of_int (36)) - (Prims.of_int (442)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat - "Term is eq: " - uu___8)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (442)) - (Prims.of_int (18)) - (Prims.of_int (442)) - (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (442)) - (Prims.of_int (4)) - (Prims.of_int (442)) - (Prims.of_int (80))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___7)) uu___7) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (442)) - (Prims.of_int (4)) - (Prims.of_int (442)) - (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (443)) - (Prims.of_int (4)) - (Prims.of_int (450)) - (Prims.of_int (13))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - if - uu___is_Eq_Hetero - ekind - then - let uu___7 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "Ignoring heterogeneous equality" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (445)) - (Prims.of_int (6)) - (Prims.of_int (445)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (446)) - (Prims.of_int (6)) - (Prims.of_int (446)) - (Prims.of_int (10))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 - -> - FStar_Pervasives_Native.None))) - else - (let uu___8 = - check_eq l in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (448)) - (Prims.of_int (12)) - (Prims.of_int (448)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (448)) - (Prims.of_int (9)) - (Prims.of_int (450)) - (Prims.of_int (13))))) - (Obj.magic - uu___8) - (fun uu___9 -> - (fun uu___9 - -> - if uu___9 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - FStar_Pervasives_Native.Some - r))) - else - Obj.magic - (Obj.repr - (let uu___11 - = - check_eq - r in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (449)) - (Prims.of_int (12)) - (Prims.of_int (449)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (449)) - (Prims.of_int (9)) - (Prims.of_int (450)) - (Prims.of_int (13))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - if - uu___12 - then - FStar_Pervasives_Native.Some - l - else - FStar_Pervasives_Native.None))))) - uu___9)))) - uu___6)) - | uu___5 -> - let uu___6 = - FStar_InteractiveHelpers_Base.print_dbg - dbg "Term is not eq" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (452)) - (Prims.of_int (4)) - (Prims.of_int (452)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (453)) - (Prims.of_int (4)) - (Prims.of_int (453)) - (Prims.of_int (8))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - FStar_Pervasives_Native.None)))) - uu___4))) uu___3))) uu___1) -let (find_subequality : - Prims.bool -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term FStar_Pervasives_Native.option, - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun tm -> - fun p -> - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStarC_Tactics_V1_Builtins.term_to_string tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (458)) (Prims.of_int (33)) - (Prims.of_int (458)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (458)) (Prims.of_int (33)) - (Prims.of_int (459)) (Prims.of_int (49))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - let uu___7 = - FStarC_Tactics_V1_Builtins.term_to_string p in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (459)) (Prims.of_int (33)) - (Prims.of_int (459)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat "\n- props: " uu___8)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (459)) - (Prims.of_int (17)) - (Prims.of_int (459)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> Prims.strcat uu___5 uu___7)))) - uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (458)) (Prims.of_int (33)) - (Prims.of_int (459)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat "\n- ter : " uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (458)) (Prims.of_int (17)) - (Prims.of_int (459)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat "[> find_subequality:" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (457)) (Prims.of_int (16)) - (Prims.of_int (459)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (457)) (Prims.of_int (2)) - (Prims.of_int (459)) (Prims.of_int (50))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___2)) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (457)) (Prims.of_int (2)) - (Prims.of_int (459)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (459)) (Prims.of_int (51)) - (Prims.of_int (462)) (Prims.of_int (49))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = split_conjunctions p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (460)) (Prims.of_int (18)) - (Prims.of_int (460)) (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (461)) (Prims.of_int (2)) - (Prims.of_int (462)) (Prims.of_int (49))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun conjuncts -> - let uu___3 = - let uu___4 = - let uu___5 = - FStar_InteractiveHelpers_Base.list_to_string - FStarC_Tactics_V1_Builtins.term_to_string - conjuncts in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (461)) - (Prims.of_int (34)) - (Prims.of_int (461)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - Prims.strcat "Conjuncts:\n" uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (461)) - (Prims.of_int (16)) - (Prims.of_int (461)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (461)) - (Prims.of_int (2)) - (Prims.of_int (461)) - (Prims.of_int (74))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___5)) uu___5) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (461)) - (Prims.of_int (2)) - (Prims.of_int (461)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (462)) - (Prims.of_int (2)) - (Prims.of_int (462)) - (Prims.of_int (49))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_Tactics_Util.tryPick - (is_equality_for_term dbg tm) - conjuncts)) uu___4))) uu___3))) - uu___1) -let (find_equality_from_post : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.bv -> - FStarC_Reflection_Types.typ -> - FStarC_Reflection_Types.term -> - FStar_InteractiveHelpers_Effectful.effect_info -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - ((FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_Types.term - FStar_Pervasives_Native.option), - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge0 -> - fun tm -> - fun let_bv -> - fun let_bvty -> - fun ret_value -> - fun einfo -> - fun parents -> - fun children -> - let uu___ = - FStar_InteractiveHelpers_Base.print_dbg dbg - "[> find_equality_from_post" in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (469)) (Prims.of_int (2)) - (Prims.of_int (469)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (469)) (Prims.of_int (45)) - (Prims.of_int (487)) (Prims.of_int (27))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - FStar_InteractiveHelpers_ExploreTerm.get_type_info_from_type - let_bvty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (470)) - (Prims.of_int (14)) - (Prims.of_int (470)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (470)) - (Prims.of_int (49)) - (Prims.of_int (487)) - (Prims.of_int (27))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun tinfo -> - let uu___3 = - FStar_InteractiveHelpers_Effectful.pre_post_to_propositions - dbg ge0 - einfo.FStar_InteractiveHelpers_Effectful.ei_type - ret_value - (FStar_Pervasives_Native.Some - (FStar_Reflection_V1_Derived.mk_binder - let_bv let_bvty)) tinfo - einfo.FStar_InteractiveHelpers_Effectful.ei_pre - einfo.FStar_InteractiveHelpers_Effectful.ei_post - parents children in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (473)) - (Prims.of_int (4)) - (Prims.of_int (474)) - (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (470)) - (Prims.of_int (49)) - (Prims.of_int (487)) - (Prims.of_int (27))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | (ge1, uu___5, post_prop) - -> - let uu___6 = - let uu___7 = - let uu___8 = - FStar_InteractiveHelpers_Base.option_to_string - FStarC_Tactics_V1_Builtins.term_to_string - post_prop in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (476)) - (Prims.of_int (37)) - (Prims.of_int (476)) - (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 - -> - Prims.strcat - "Computed post: " - uu___9)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (476)) - (Prims.of_int (16)) - (Prims.of_int (476)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (476)) - (Prims.of_int (2)) - (Prims.of_int (476)) - (Prims.of_int (79))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___8)) - uu___8) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (476)) - (Prims.of_int (2)) - (Prims.of_int (476)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (476)) - (Prims.of_int (80)) - (Prims.of_int (487)) - (Prims.of_int (27))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - let uu___8 = - match post_prop - with - | - FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - FStar_Pervasives_Native.None))) - | - FStar_Pervasives_Native.Some - p -> - Obj.magic - (Obj.repr - (find_subequality - dbg tm p)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (479)) - (Prims.of_int (4)) - (Prims.of_int (481)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (485)) - (Prims.of_int (2)) - (Prims.of_int (487)) - (Prims.of_int (27))))) - (Obj.magic - uu___8) - (fun res - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - match res - with - | - FStar_Pervasives_Native.None - -> - (ge0, - FStar_Pervasives_Native.None) - | - FStar_Pervasives_Native.Some - tm1 -> - (ge1, - (FStar_Pervasives_Native.Some - tm1)))))) - uu___7))) - uu___4))) uu___3))) uu___1) -let rec (find_context_equality_aux : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.bv FStar_Pervasives_Native.option -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - ((FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_Types.term FStar_Pervasives_Native.option), - unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___5 -> - fun uu___4 -> - fun uu___3 -> - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun dbg -> - fun ge0 -> - fun tm -> - fun opt_bv -> - fun parents -> - fun children -> - match parents with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - (ge0, FStar_Pervasives_Native.None)))) - | tv::parents' -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - FStarC_Tactics_V1_Builtins.term_to_string - tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (507)) - (Prims.of_int (34)) - (Prims.of_int (507)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (507)) - (Prims.of_int (34)) - (Prims.of_int (508)) - (Prims.of_int (51))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - FStarC_Tactics_V1_Builtins.pack - tv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (505)) - (Prims.of_int (4)) - (Prims.of_int (505)) - (Prims.of_int (6))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (508)) - (Prims.of_int (34)) - (Prims.of_int (508)) - (Prims.of_int (51))))) - (Obj.magic - uu___9) - (fun uu___10 -> - (fun uu___10 - -> - Obj.magic - (FStarC_Tactics_V1_Builtins.term_to_string - uu___10)) - uu___10) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (508)) - (Prims.of_int (34)) - (Prims.of_int (508)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 - -> - Prims.strcat - "- parent: " - uu___9)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (508)) - (Prims.of_int (19)) - (Prims.of_int (508)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat - "\n" - uu___8)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (507)) - (Prims.of_int (54)) - (Prims.of_int (508)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat - uu___5 - uu___7)))) - uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (507)) - (Prims.of_int (34)) - (Prims.of_int (508)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - Prims.strcat - "- term : " uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (507)) - (Prims.of_int (19)) - (Prims.of_int (508)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat - "[> find_context_equality:\n" - uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (506)) - (Prims.of_int (18)) - (Prims.of_int (508)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (506)) - (Prims.of_int (4)) - (Prims.of_int (508)) - (Prims.of_int (52))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (506)) - (Prims.of_int (4)) - (Prims.of_int (508)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (510)) - (Prims.of_int (4)) - (Prims.of_int (533)) - (Prims.of_int (79))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match tv with - | FStarC_Reflection_V1_Data.Tv_Let - (uu___2, uu___3, bv', ty, - def, uu___4) - -> - let uu___5 = - FStar_InteractiveHelpers_Base.print_dbg - dbg "Is Tv_Let" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (512)) - (Prims.of_int (6)) - (Prims.of_int (512)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (512)) - (Prims.of_int (32)) - (Prims.of_int (532)) - (Prims.of_int (11))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - FStar_InteractiveHelpers_Effectful.compute_eterm_info - dbg - ge0.FStar_InteractiveHelpers_Base.env - def in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (513)) - (Prims.of_int (20)) - (Prims.of_int (513)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (513)) - (Prims.of_int (57)) - (Prims.of_int (532)) - (Prims.of_int (11))))) - (Obj.magic - uu___7) - (fun uu___8 - -> - (fun - tm_info - -> - let uu___8 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - tm_info.FStar_InteractiveHelpers_Effectful.einfo)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (514)) - (Prims.of_int (18)) - (Prims.of_int (514)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (514)) - (Prims.of_int (34)) - (Prims.of_int (532)) - (Prims.of_int (11))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - einfo -> - let uu___9 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - match opt_bv - with - | - FStar_Pervasives_Native.Some - tm_bv -> - FStar_InteractiveHelpers_Base.bv_eq - tm_bv bv' - | - FStar_Pervasives_Native.None - -> false)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (521)) - (Prims.of_int (8)) - (Prims.of_int (523)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (525)) - (Prims.of_int (6)) - (Prims.of_int (532)) - (Prims.of_int (11))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - let_bv_is_tm - -> - if - let_bv_is_tm - && - (FStar_InteractiveHelpers_ExploreTerm.effect_type_is_pure - einfo.FStar_InteractiveHelpers_Effectful.ei_type) - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (ge0, - (FStar_Pervasives_Native.Some - def))))) - else - Obj.magic - (Obj.repr - (let uu___11 - = - FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Var - bv') in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (527)) - (Prims.of_int (24)) - (Prims.of_int (527)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (528)) - (Prims.of_int (14)) - (Prims.of_int (531)) - (Prims.of_int (90))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - ret_value - -> - let uu___12 - = - find_equality_from_post - dbg ge0 - tm bv' ty - ret_value - einfo - parents - children in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (528)) - (Prims.of_int (20)) - (Prims.of_int (529)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (528)) - (Prims.of_int (14)) - (Prims.of_int (531)) - (Prims.of_int (90))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - match uu___13 - with - | - (ge1, - FStar_Pervasives_Native.Some - p) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - (ge1, - (FStar_Pervasives_Native.Some - p))))) - | - (uu___14, - FStar_Pervasives_Native.None) - -> - Obj.magic - (Obj.repr - (find_context_equality_aux - dbg ge0 - tm opt_bv - parents' - (tv :: - children)))) - uu___13))) - uu___12)))) - uu___10))) - uu___9))) - uu___8))) - uu___6)) - | uu___2 -> - Obj.magic - (find_context_equality_aux - dbg ge0 tm opt_bv - parents' (tv :: - children))) uu___1)))) - uu___5 uu___4 uu___3 uu___2 uu___1 uu___ -let (find_context_equality : - Prims.bool -> - FStar_InteractiveHelpers_Base.genv -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - FStarC_Reflection_V1_Data.term_view Prims.list -> - ((FStar_InteractiveHelpers_Base.genv * - FStarC_Reflection_Types.term FStar_Pervasives_Native.option), - unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ge0 -> - fun tm -> - fun parents -> - fun children -> - let uu___ = - let uu___1 = FStarC_Tactics_V1_Builtins.inspect tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (537)) (Prims.of_int (10)) - (Prims.of_int (537)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (537)) (Prims.of_int (4)) - (Prims.of_int (539)) (Prims.of_int (15))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - match uu___2 with - | FStarC_Reflection_V1_Data.Tv_Var bv -> - FStar_Pervasives_Native.Some bv - | uu___4 -> FStar_Pervasives_Native.None)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (537)) (Prims.of_int (4)) - (Prims.of_int (539)) (Prims.of_int (15))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (541)) (Prims.of_int (2)) - (Prims.of_int (541)) (Prims.of_int (62))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun opt_bv -> - Obj.magic - (find_context_equality_aux dbg ge0 tm opt_bv parents - children)) uu___1) -let rec (replace_term_in : - Prims.bool -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___3 -> - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun dbg -> - fun from_term -> - fun to_term -> - fun tm -> - if FStar_InteractiveHelpers_Effectful.term_eq from_term tm - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> to_term))) - else - Obj.magic - (Obj.repr - (let uu___1 = FStarC_Tactics_V1_Builtins.inspect tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (547)) (Prims.of_int (8)) - (Prims.of_int (547)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (547)) (Prims.of_int (2)) - (Prims.of_int (590)) (Prims.of_int (6))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - match uu___2 with - | FStarC_Reflection_V1_Data.Tv_Var uu___3 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> tm))) - | FStarC_Reflection_V1_Data.Tv_BVar uu___3 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> tm))) - | FStarC_Reflection_V1_Data.Tv_FVar uu___3 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> tm))) - | FStarC_Reflection_V1_Data.Tv_App - (hd, (a, qual)) -> - Obj.magic - (Obj.repr - (let uu___3 = - replace_term_in dbg from_term - to_term a in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (550)) - (Prims.of_int (13)) - (Prims.of_int (550)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (550)) - (Prims.of_int (55)) - (Prims.of_int (552)) - (Prims.of_int (32))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun a' -> - let uu___4 = - replace_term_in dbg - from_term to_term hd in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (551)) - (Prims.of_int (14)) - (Prims.of_int (551)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (552)) - (Prims.of_int (4)) - (Prims.of_int (552)) - (Prims.of_int (32))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun hd' -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_App - (hd', - (a', - qual))))) - uu___5))) - uu___4))) - | FStarC_Reflection_V1_Data.Tv_Abs - (br, body) -> - Obj.magic - (Obj.repr - (let uu___3 = - replace_term_in dbg from_term - to_term body in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (554)) - (Prims.of_int (16)) - (Prims.of_int (554)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (555)) - (Prims.of_int (4)) - (Prims.of_int (555)) - (Prims.of_int (26))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun body' -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Abs - (br, body')))) - uu___4))) - | FStarC_Reflection_V1_Data.Tv_Arrow - (br, c0) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> tm))) - | FStarC_Reflection_V1_Data.Tv_Type uu___3 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> tm))) - | FStarC_Reflection_V1_Data.Tv_Refine - (bv, sort, ref) -> - Obj.magic - (Obj.repr - (let uu___3 = - replace_term_in dbg from_term - to_term sort in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (559)) - (Prims.of_int (16)) - (Prims.of_int (559)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (559)) - (Prims.of_int (61)) - (Prims.of_int (561)) - (Prims.of_int (34))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun sort' -> - let uu___4 = - replace_term_in dbg - from_term to_term - ref in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (560)) - (Prims.of_int (15)) - (Prims.of_int (560)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (561)) - (Prims.of_int (4)) - (Prims.of_int (561)) - (Prims.of_int (34))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun ref' -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Refine - (bv, - sort', - ref')))) - uu___5))) - uu___4))) - | FStarC_Reflection_V1_Data.Tv_Const - uu___3 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> tm))) - | FStarC_Reflection_V1_Data.Tv_Uvar - (uu___3, uu___4) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> tm))) - | FStarC_Reflection_V1_Data.Tv_Let - (recf, attrs, bv, ty, def, body) -> - Obj.magic - (Obj.repr - (let uu___3 = - replace_term_in dbg from_term - to_term def in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (567)) - (Prims.of_int (15)) - (Prims.of_int (567)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (567)) - (Prims.of_int (59)) - (Prims.of_int (569)) - (Prims.of_int (45))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun def' -> - let uu___4 = - replace_term_in dbg - from_term to_term - body in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (568)) - (Prims.of_int (16)) - (Prims.of_int (568)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (569)) - (Prims.of_int (4)) - (Prims.of_int (569)) - (Prims.of_int (45))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun body' -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Let - (recf, - attrs, - bv, ty, - def', - body')))) - uu___5))) - uu___4))) - | FStarC_Reflection_V1_Data.Tv_Match - (scrutinee, ret_opt, branches) -> - Obj.magic - (Obj.repr - (let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - fun br -> - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 - -> br)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (574)) - (Prims.of_int (22)) - (Prims.of_int (574)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (572)) - (Prims.of_int (51)) - (Prims.of_int (576)) - (Prims.of_int (18))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 - with - | (pat, - body) -> - let uu___7 - = - replace_term_in - dbg - from_term - to_term - body in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (575)) - (Prims.of_int (18)) - (Prims.of_int (575)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (576)) - (Prims.of_int (6)) - (Prims.of_int (576)) - (Prims.of_int (18))))) - (Obj.magic - uu___7) - (fun - body' -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - (pat, - body'))))) - uu___6))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (572)) - (Prims.of_int (51)) - (Prims.of_int (576)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (577)) - (Prims.of_int (6)) - (Prims.of_int (580)) - (Prims.of_int (48))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun explore_branch -> - let uu___4 = - replace_term_in dbg - from_term to_term - scrutinee in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (578)) - (Prims.of_int (21)) - (Prims.of_int (578)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (578)) - (Prims.of_int (71)) - (Prims.of_int (580)) - (Prims.of_int (48))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun scrutinee' - -> - let uu___5 = - FStar_Tactics_Util.map - explore_branch - branches in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (579)) - (Prims.of_int (20)) - (Prims.of_int (579)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (580)) - (Prims.of_int (4)) - (Prims.of_int (580)) - (Prims.of_int (48))))) - (Obj.magic - uu___5) - (fun - uu___6 -> - (fun - branches' - -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_Match - (scrutinee', - ret_opt, - branches')))) - uu___6))) - uu___5))) - uu___4))) - | FStarC_Reflection_V1_Data.Tv_AscribedT - (e, ty, tac, use_eq) -> - Obj.magic - (Obj.repr - (let uu___3 = - replace_term_in dbg from_term - to_term e in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (582)) - (Prims.of_int (13)) - (Prims.of_int (582)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (582)) - (Prims.of_int (55)) - (Prims.of_int (584)) - (Prims.of_int (41))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun e' -> - let uu___4 = - replace_term_in dbg - from_term to_term ty in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (583)) - (Prims.of_int (14)) - (Prims.of_int (583)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (584)) - (Prims.of_int (4)) - (Prims.of_int (584)) - (Prims.of_int (41))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun ty' -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_AscribedT - (e', ty', - tac, - use_eq)))) - uu___5))) - uu___4))) - | FStarC_Reflection_V1_Data.Tv_AscribedC - (e, c, tac, use_eq) -> - Obj.magic - (Obj.repr - (let uu___3 = - replace_term_in dbg from_term - to_term e in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (586)) - (Prims.of_int (13)) - (Prims.of_int (586)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (587)) - (Prims.of_int (4)) - (Prims.of_int (587)) - (Prims.of_int (39))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun e' -> - Obj.magic - (FStarC_Tactics_V1_Builtins.pack - (FStarC_Reflection_V1_Data.Tv_AscribedC - (e', c, tac, - use_eq)))) - uu___4))) - | uu___3 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> tm)))) uu___2)))) - uu___3 uu___2 uu___1 uu___ -let rec (strip_implicit_parameters : - FStarC_Reflection_Types.term -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun tm -> - let uu___ = FStarC_Tactics_V1_Builtins.inspect tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (594)) (Prims.of_int (8)) (Prims.of_int (594)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (594)) (Prims.of_int (2)) (Prims.of_int (597)) - (Prims.of_int (11))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStarC_Reflection_V1_Data.Tv_App (hd, (a, qualif)) -> - Obj.magic - (Obj.repr - (if FStarC_Reflection_V1_Data.uu___is_Q_Implicit qualif - then Obj.repr (strip_implicit_parameters hd) - else - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> tm)))) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> tm)))) - uu___1) -let (unfold_in_assert_or_assume : - Prims.bool -> - FStarC_Reflection_Types.term exploration_result -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun dbg -> - fun ares -> - let uu___ = - let uu___1 = - let uu___2 = FStarC_Tactics_V1_Builtins.term_to_string ares.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (601)) (Prims.of_int (54)) - (Prims.of_int (601)) (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat "[> unfold_in_assert_or_assume:\n" uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (601)) (Prims.of_int (16)) - (Prims.of_int (601)) (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (601)) (Prims.of_int (2)) - (Prims.of_int (601)) (Prims.of_int (78))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg dbg uu___2)) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (601)) (Prims.of_int (2)) (Prims.of_int (601)) - (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (601)) (Prims.of_int (79)) - (Prims.of_int (735)) (Prims.of_int (30))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun t -> - find_focused_term dbg false ares.ge ares.parents - ares.tgt_comp t)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (605)) (Prims.of_int (4)) - (Prims.of_int (605)) (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (606)) (Prims.of_int (4)) - (Prims.of_int (735)) (Prims.of_int (30))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun find_focused_in_term -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - fun uu___5 -> - let uu___6 = - find_focused_in_term ares.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (608)) - (Prims.of_int (10)) - (Prims.of_int (608)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (608)) - (Prims.of_int (4)) - (Prims.of_int (611)) - (Prims.of_int (93))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - match uu___7 with - | FStar_Pervasives_Native.Some - res -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - ((ares.res), res, - (fun uu___9 -> - (fun x -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - x))) - uu___9), - true)))) - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (FStar_InteractiveHelpers_Base.mfail - "unfold_in_assert_or_assume: could not find a focused term in the assert"))) - uu___7))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (608)) - (Prims.of_int (4)) - (Prims.of_int (611)) - (Prims.of_int (93))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (612)) - (Prims.of_int (4)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun find_in_whole_term -> - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - FStarC_Tactics_V1_Builtins.term_to_string - ares.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (622)) - (Prims.of_int (43)) - (Prims.of_int (622)) - (Prims.of_int (66))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat - "Assertion: " uu___8)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (622)) - (Prims.of_int (26)) - (Prims.of_int (622)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (622)) - (Prims.of_int (12)) - (Prims.of_int (622)) - (Prims.of_int (67))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg uu___7)) uu___7) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (622)) - (Prims.of_int (12)) - (Prims.of_int (622)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (623)) - (Prims.of_int (4)) - (Prims.of_int (649)) - (Prims.of_int (27))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = is_eq dbg ares.res in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (623)) - (Prims.of_int (10)) - (Prims.of_int (623)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (623)) - (Prims.of_int (4)) - (Prims.of_int (649)) - (Prims.of_int (27))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - match uu___8 with - | FStar_Pervasives_Native.Some - (kd, l, r) -> - let uu___9 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "The assertion is an equality" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (625)) - (Prims.of_int (6)) - (Prims.of_int (625)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (626)) - (Prims.of_int (12)) - (Prims.of_int (645)) - (Prims.of_int (11))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - let uu___11 - = - find_focused_in_term - l in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (626)) - (Prims.of_int (18)) - (Prims.of_int (626)) - (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (626)) - (Prims.of_int (12)) - (Prims.of_int (645)) - (Prims.of_int (11))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - match uu___12 - with - | - FStar_Pervasives_Native.Some - res -> - let uu___13 - = - let uu___14 - = - let uu___15 - = - let uu___16 - = - let uu___17 - = - FStarC_Tactics_V1_Builtins.term_to_string - l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (629)) - (Prims.of_int (41)) - (Prims.of_int (629)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (629)) - (Prims.of_int (41)) - (Prims.of_int (631)) - (Prims.of_int (63))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - (fun - uu___18 - -> - let uu___19 - = - let uu___20 - = - let uu___21 - = - FStarC_Tactics_V1_Builtins.term_to_string - r in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (630)) - (Prims.of_int (41)) - (Prims.of_int (630)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (630)) - (Prims.of_int (41)) - (Prims.of_int (631)) - (Prims.of_int (63))))) - (Obj.magic - uu___21) - (fun - uu___22 - -> - (fun - uu___22 - -> - let uu___23 - = - let uu___24 - = - FStarC_Tactics_V1_Builtins.term_to_string - res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (631)) - (Prims.of_int (41)) - (Prims.of_int (631)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___24) - (fun - uu___25 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___26 - -> - Prims.strcat - "\n- focused: " - uu___25)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (631)) - (Prims.of_int (23)) - (Prims.of_int (631)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___23) - (fun - uu___24 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___25 - -> - Prims.strcat - uu___22 - uu___24)))) - uu___22) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (630)) - (Prims.of_int (41)) - (Prims.of_int (631)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___22 - -> - Prims.strcat - "\n- right : " - uu___21)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (630)) - (Prims.of_int (23)) - (Prims.of_int (631)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___21 - -> - Prims.strcat - uu___18 - uu___20)))) - uu___18) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (629)) - (Prims.of_int (41)) - (Prims.of_int (631)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> - Prims.strcat - "\n- left : " - uu___17)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (629)) - (Prims.of_int (23)) - (Prims.of_int (631)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - Prims.strcat - "Found focused term in left operand:" - uu___16)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (628)) - (Prims.of_int (22)) - (Prims.of_int (631)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (628)) - (Prims.of_int (8)) - (Prims.of_int (631)) - (Prims.of_int (64))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___15)) - uu___15) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (628)) - (Prims.of_int (8)) - (Prims.of_int (631)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (633)) - (Prims.of_int (8)) - (Prims.of_int (633)) - (Prims.of_int (29))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - (l, res, - (fun - uu___16 - -> - (fun t -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - mk_eq kd - t r))) - uu___16), - true)))) - | - FStar_Pervasives_Native.None - -> - let uu___13 - = - find_focused_in_term - r in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (635)) - (Prims.of_int (20)) - (Prims.of_int (635)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (635)) - (Prims.of_int (14)) - (Prims.of_int (644)) - (Prims.of_int (89))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - uu___14 - -> - match uu___14 - with - | - FStar_Pervasives_Native.Some - res -> - let uu___15 - = - let uu___16 - = - let uu___17 - = - let uu___18 - = - let uu___19 - = - FStarC_Tactics_V1_Builtins.term_to_string - l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (638)) - (Prims.of_int (35)) - (Prims.of_int (638)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (638)) - (Prims.of_int (35)) - (Prims.of_int (640)) - (Prims.of_int (57))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - (fun - uu___20 - -> - let uu___21 - = - let uu___22 - = - let uu___23 - = - FStarC_Tactics_V1_Builtins.term_to_string - r in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (639)) - (Prims.of_int (35)) - (Prims.of_int (639)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (639)) - (Prims.of_int (35)) - (Prims.of_int (640)) - (Prims.of_int (57))))) - (Obj.magic - uu___23) - (fun - uu___24 - -> - (fun - uu___24 - -> - let uu___25 - = - let uu___26 - = - FStarC_Tactics_V1_Builtins.term_to_string - res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (640)) - (Prims.of_int (35)) - (Prims.of_int (640)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___26) - (fun - uu___27 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___28 - -> - Prims.strcat - "\n- focused: " - uu___27)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (640)) - (Prims.of_int (17)) - (Prims.of_int (640)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___25) - (fun - uu___26 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___27 - -> - Prims.strcat - uu___24 - uu___26)))) - uu___24) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (639)) - (Prims.of_int (35)) - (Prims.of_int (640)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___22) - (fun - uu___23 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___24 - -> - Prims.strcat - "\n- right : " - uu___23)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (639)) - (Prims.of_int (17)) - (Prims.of_int (640)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___21) - (fun - uu___22 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___23 - -> - Prims.strcat - uu___20 - uu___22)))) - uu___20) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (638)) - (Prims.of_int (35)) - (Prims.of_int (640)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - Prims.strcat - "\n- left : " - uu___19)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (638)) - (Prims.of_int (17)) - (Prims.of_int (640)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - Prims.strcat - "Found focused term in right operand:" - uu___18)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (637)) - (Prims.of_int (24)) - (Prims.of_int (640)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (637)) - (Prims.of_int (10)) - (Prims.of_int (640)) - (Prims.of_int (58))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___17)) - uu___17) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (637)) - (Prims.of_int (10)) - (Prims.of_int (640)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (642)) - (Prims.of_int (10)) - (Prims.of_int (642)) - (Prims.of_int (32))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - (r, res, - (fun - uu___18 - -> - (fun t -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> - mk_eq kd - l t))) - uu___18), - false)))) - | - FStar_Pervasives_Native.None - -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - "unfold_in_assert_or_assume: could not find a focused term in the assert")) - uu___14))) - uu___12))) - uu___10)) - | FStar_Pervasives_Native.None - -> - let uu___9 = - FStar_InteractiveHelpers_Base.print_dbg - dbg - "The assertion is not an equality" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (648)) - (Prims.of_int (6)) - (Prims.of_int (648)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (649)) - (Prims.of_int (6)) - (Prims.of_int (649)) - (Prims.of_int (27))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - Obj.magic - (find_in_whole_term - ())) - uu___10))) - uu___8))) uu___6) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (621)) - (Prims.of_int (69)) - (Prims.of_int (649)) - (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (612)) - (Prims.of_int (4)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | (subterm, unf_res, rebuild, - insert_before) -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - rebuild)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (651)) - (Prims.of_int (2)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (651)) - (Prims.of_int (2)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun rebuild1 -> - let uu___7 = - let uu___8 = - let uu___9 - = - let uu___10 - = - let uu___11 - = - FStarC_Tactics_V1_Builtins.term_to_string - subterm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (652)) - (Prims.of_int (33)) - (Prims.of_int (652)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (652)) - (Prims.of_int (33)) - (Prims.of_int (653)) - (Prims.of_int (64))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - let uu___13 - = - let uu___14 - = - let uu___15 - = - FStarC_Tactics_V1_Builtins.term_to_string - unf_res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (653)) - (Prims.of_int (38)) - (Prims.of_int (653)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - Prims.strcat - "- focused term: " - uu___16)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (653)) - (Prims.of_int (17)) - (Prims.of_int (653)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - Prims.strcat - "\n" - uu___15)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (652)) - (Prims.of_int (58)) - (Prims.of_int (653)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - Prims.strcat - uu___12 - uu___14)))) - uu___12) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (652)) - (Prims.of_int (33)) - (Prims.of_int (653)) - (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - Prims.strcat - "- subterm: " - uu___11)) in - FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (652)) - (Prims.of_int (17)) - (Prims.of_int (653)) - (Prims.of_int (64))))) - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - ( - Obj.magic - uu___9) - ( - fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Prims.strcat - "Found subterm in assertion/assumption:\n" - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (651)) - (Prims.of_int (16)) - (Prims.of_int (653)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (651)) - (Prims.of_int (2)) - (Prims.of_int (653)) - (Prims.of_int (65))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - (fun - uu___9 -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___9)) - uu___9) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (651)) - (Prims.of_int (2)) - (Prims.of_int (653)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (653)) - (Prims.of_int (66)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - let uu___9 - = - FStarC_Tactics_V1_Builtins.inspect - unf_res.res in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (655)) - (Prims.of_int (17)) - (Prims.of_int (655)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (655)) - (Prims.of_int (39)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - res_view - -> - let uu___10 - = - match res_view - with - | - FStarC_Reflection_V1_Data.Tv_FVar - fv -> - let uu___11 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - (Prims.strcat - "The focused term is a top identifier: " - (FStar_Reflection_V1_Derived.fv_to_string - fv)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (659)) - (Prims.of_int (6)) - (Prims.of_int (659)) - (Prims.of_int (80))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (659)) - (Prims.of_int (81)) - (Prims.of_int (664)) - (Prims.of_int (28))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - let uu___13 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - FStar_Reflection_V1_Derived.flatten_name - (FStarC_Reflection_V1_Builtins.inspect_fv - fv))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (661)) - (Prims.of_int (18)) - (Prims.of_int (661)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (661)) - (Prims.of_int (49)) - (Prims.of_int (664)) - (Prims.of_int (28))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - fname -> - let uu___14 - = - FStarC_Tactics_V1_Builtins.norm_term_env - (ares.ge).FStar_InteractiveHelpers_Base.env - [ - FStar_Pervasives.delta_only - [fname]; - FStar_Pervasives.zeta] - subterm in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (662)) - (Prims.of_int (21)) - (Prims.of_int (662)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (663)) - (Prims.of_int (6)) - (Prims.of_int (664)) - (Prims.of_int (28))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - subterm' - -> - let uu___15 - = - let uu___16 - = - let uu___17 - = - FStarC_Tactics_V1_Builtins.term_to_string - subterm' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (663)) - (Prims.of_int (46)) - (Prims.of_int (663)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - Prims.strcat - "Normalized subterm: " - uu___18)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (663)) - (Prims.of_int (20)) - (Prims.of_int (663)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (663)) - (Prims.of_int (6)) - (Prims.of_int (663)) - (Prims.of_int (70))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___17)) - uu___17) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (663)) - (Prims.of_int (6)) - (Prims.of_int (663)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (664)) - (Prims.of_int (6)) - (Prims.of_int (664)) - (Prims.of_int (28))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - ((ares.ge), - (FStar_Pervasives_Native.Some - subterm')))))) - uu___15))) - uu___14))) - uu___12) - | - uu___11 - -> - let uu___12 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - FStar_List_Tot_Base.map - FStar_Pervasives_Native.snd - ares.parents)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (669)) - (Prims.of_int (20)) - (Prims.of_int (669)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (669)) - (Prims.of_int (52)) - (Prims.of_int (696)) - (Prims.of_int (19))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - parents - -> - let uu___13 - = - match res_view - with - | - FStarC_Reflection_V1_Data.Tv_Var - bv -> - let uu___14 - = - let uu___15 - = - let uu___16 - = - FStar_Tactics_V1_Derived.bv_to_string - bv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (673)) - (Prims.of_int (68)) - (Prims.of_int (673)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> - Prims.strcat - "The focused term is a local variable: " - uu___17)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (673)) - (Prims.of_int (24)) - (Prims.of_int (673)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (673)) - (Prims.of_int (10)) - (Prims.of_int (673)) - (Prims.of_int (84))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___16)) - uu___16) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (673)) - (Prims.of_int (10)) - (Prims.of_int (673)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (675)) - (Prims.of_int (10)) - (Prims.of_int (677)) - (Prims.of_int (39))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - let uu___16 - = - if - Prims.op_Negation - (FStar_Pervasives_Native.uu___is_Some - (FStar_InteractiveHelpers_Base.genv_get - ares.ge - bv)) - then - Obj.magic - (Obj.repr - (FStar_InteractiveHelpers_Base.mfail - "unfold_in_assert_or_assume: can't unfold a variable locally introduced in an assertion")) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> ()))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (675)) - (Prims.of_int (10)) - (Prims.of_int (676)) - (Prims.of_int (106))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (677)) - (Prims.of_int (10)) - (Prims.of_int (677)) - (Prims.of_int (39))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> - FStar_Pervasives_Native.Some - (bv, - (FStarC_Reflection_V2_Builtins.pack_ln - FStarC_Reflection_V2_Data.Tv_Unknown)))))) - uu___15) - | - uu___14 - -> - let uu___15 - = - let uu___16 - = - let uu___17 - = - FStarC_Tactics_V1_Builtins.term_to_string - unf_res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (679)) - (Prims.of_int (69)) - (Prims.of_int (679)) - (Prims.of_int (95))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - Prims.strcat - "The focused term is an arbitrary term: " - uu___18)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (679)) - (Prims.of_int (24)) - (Prims.of_int (679)) - (Prims.of_int (96))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (679)) - (Prims.of_int (10)) - (Prims.of_int (679)) - (Prims.of_int (96))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___17)) - uu___17) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (679)) - (Prims.of_int (10)) - (Prims.of_int (679)) - (Prims.of_int (96))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (680)) - (Prims.of_int (10)) - (Prims.of_int (680)) - (Prims.of_int (14))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - FStar_Pervasives_Native.None)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (671)) - (Prims.of_int (8)) - (Prims.of_int (680)) - (Prims.of_int (14))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (681)) - (Prims.of_int (8)) - (Prims.of_int (696)) - (Prims.of_int (19))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - opt_bvty - -> - let uu___14 - = - find_context_equality - dbg - ares.ge - unf_res.res - parents - [] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (682)) - (Prims.of_int (23)) - (Prims.of_int (682)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (681)) - (Prims.of_int (8)) - (Prims.of_int (696)) - (Prims.of_int (19))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - match uu___15 - with - | - (ge1, - eq_tm) -> - let uu___16 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - match eq_tm - with - | - FStar_Pervasives_Native.Some - eq_tm1 -> - FStar_Pervasives_Native.Some - eq_tm1 - | - uu___18 - -> - FStar_Pervasives_Native.None)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (685)) - (Prims.of_int (8)) - (Prims.of_int (687)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (688)) - (Prims.of_int (8)) - (Prims.of_int (696)) - (Prims.of_int (19))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - opt_eq_tm - -> - let uu___17 - = - match - (opt_bvty, - opt_eq_tm) - with - | - (FStar_Pervasives_Native.Some - bvty, - FStar_Pervasives_Native.Some - eq_tm1) - -> - Obj.magic - (Obj.repr - (let uu___18 - = - FStar_InteractiveHelpers_Base.apply_subst - ge1.FStar_InteractiveHelpers_Base.env - subterm - [ - (bvty, - eq_tm1)] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (692)) - (Prims.of_int (40)) - (Prims.of_int (692)) - (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (692)) - (Prims.of_int (35)) - (Prims.of_int (692)) - (Prims.of_int (85))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - FStar_Pervasives_Native.Some - uu___19)))) - | - (FStar_Pervasives_Native.None, - FStar_Pervasives_Native.Some - eq_tm1) - -> - Obj.magic - (Obj.repr - (let uu___18 - = - replace_term_in - dbg - unf_res.res - eq_tm1 - subterm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (693)) - (Prims.of_int (35)) - (Prims.of_int (693)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (693)) - (Prims.of_int (30)) - (Prims.of_int (693)) - (Prims.of_int (82))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - FStar_Pervasives_Native.Some - uu___19)))) - | - uu___18 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - FStar_Pervasives_Native.None))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (691)) - (Prims.of_int (8)) - (Prims.of_int (694)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (696)) - (Prims.of_int (6)) - (Prims.of_int (696)) - (Prims.of_int (19))))) - (Obj.magic - uu___17) - (fun - subterm' - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> - (ge1, - subterm'))))) - uu___17))) - uu___15))) - uu___14))) - uu___13) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (657)) - (Prims.of_int (4)) - (Prims.of_int (696)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (655)) - (Prims.of_int (39)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - match uu___11 - with - | - (ge1, - opt_unf_tm) - -> - let uu___12 - = - match opt_unf_tm - with - | - FStar_Pervasives_Native.Some - unf_tm -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - (ge1, - unf_tm)))) - | - FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (let uu___13 - = - let uu___14 - = - strip_implicit_parameters - unf_res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (710)) - (Prims.of_int (26)) - (Prims.of_int (710)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (710)) - (Prims.of_int (18)) - (Prims.of_int (710)) - (Prims.of_int (65))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (FStarC_Tactics_V1_Builtins.inspect - uu___15)) - uu___15) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (710)) - (Prims.of_int (18)) - (Prims.of_int (710)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (710)) - (Prims.of_int (12)) - (Prims.of_int (722)) - (Prims.of_int (42))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - uu___14 - -> - match uu___14 - with - | - FStarC_Reflection_V1_Data.Tv_FVar - fv -> - let uu___15 - = - FStar_InteractiveHelpers_Base.print_dbg - dbg - (Prims.strcat - "The focused term is a top identifier with implicit parameters: " - (FStar_Reflection_V1_Derived.fv_to_string - fv)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (712)) - (Prims.of_int (8)) - (Prims.of_int (713)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (713)) - (Prims.of_int (42)) - (Prims.of_int (718)) - (Prims.of_int (21))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - let uu___17 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> - FStar_Reflection_V1_Derived.flatten_name - (FStarC_Reflection_V1_Builtins.inspect_fv - fv))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (715)) - (Prims.of_int (20)) - (Prims.of_int (715)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (715)) - (Prims.of_int (51)) - (Prims.of_int (718)) - (Prims.of_int (21))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - (fun - fname -> - let uu___18 - = - FStarC_Tactics_V1_Builtins.norm_term_env - ge1.FStar_InteractiveHelpers_Base.env - [ - FStar_Pervasives.delta_only - [fname]; - FStar_Pervasives.zeta] - subterm in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (716)) - (Prims.of_int (23)) - (Prims.of_int (716)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (717)) - (Prims.of_int (8)) - (Prims.of_int (718)) - (Prims.of_int (21))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - subterm' - -> - let uu___19 - = - let uu___20 - = - let uu___21 - = - FStarC_Tactics_V1_Builtins.term_to_string - subterm' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (717)) - (Prims.of_int (48)) - (Prims.of_int (717)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___21) - (fun - uu___22 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___23 - -> - Prims.strcat - "Normalized subterm: " - uu___22)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (717)) - (Prims.of_int (22)) - (Prims.of_int (717)) - (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (717)) - (Prims.of_int (8)) - (Prims.of_int (717)) - (Prims.of_int (72))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - (fun - uu___21 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___21)) - uu___21) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (717)) - (Prims.of_int (8)) - (Prims.of_int (717)) - (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (718)) - (Prims.of_int (8)) - (Prims.of_int (718)) - (Prims.of_int (21))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___21 - -> - (ge1, - subterm'))))) - uu___19))) - uu___18))) - uu___16)) - | - uu___15 - -> - let uu___16 - = - let uu___17 - = - let uu___18 - = - FStarC_Tactics_V1_Builtins.term_to_string - unf_res.res in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (722)) - (Prims.of_int (15)) - (Prims.of_int (722)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - Prims.strcat - "couldn't find equalities with which to rewrite: " - uu___19)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (721)) - (Prims.of_int (15)) - (Prims.of_int (722)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - Prims.strcat - "unfold_in_assert_or_assume: " - uu___18)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (720)) - (Prims.of_int (14)) - (Prims.of_int (722)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (720)) - (Prims.of_int (8)) - (Prims.of_int (722)) - (Prims.of_int (42))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.mfail - uu___17)) - uu___17))) - uu___14))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (707)) - (Prims.of_int (4)) - (Prims.of_int (723)) - (Prims.of_int (9))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (697)) - (Prims.of_int (4)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - match uu___13 - with - | - (ge2, - unf_tm) - -> - let uu___14 - = - rebuild1 - unf_tm in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (726)) - (Prims.of_int (21)) - (Prims.of_int (726)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (726)) - (Prims.of_int (38)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - final_assert - -> - let uu___15 - = - FStar_InteractiveHelpers_Base.prettify_term - dbg - final_assert in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (727)) - (Prims.of_int (21)) - (Prims.of_int (727)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (728)) - (Prims.of_int (2)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - final_assert1 - -> - let uu___16 - = - let uu___17 - = - let uu___18 - = - FStarC_Tactics_V1_Builtins.term_to_string - final_assert1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (728)) - (Prims.of_int (43)) - (Prims.of_int (728)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> - Prims.strcat - "-> Final assertion:\n" - uu___19)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (728)) - (Prims.of_int (16)) - (Prims.of_int (728)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (728)) - (Prims.of_int (2)) - (Prims.of_int (728)) - (Prims.of_int (71))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - (fun - uu___18 - -> - Obj.magic - (FStar_InteractiveHelpers_Base.print_dbg - dbg - uu___18)) - uu___18) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (728)) - (Prims.of_int (2)) - (Prims.of_int (728)) - (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (728)) - (Prims.of_int (72)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - let uu___18 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> - if - insert_before - then - FStar_InteractiveHelpers_Propositions.mk_assertions - [final_assert1] - [] - else - FStar_InteractiveHelpers_Propositions.mk_assertions - [] - [final_assert1])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (730)) - (Prims.of_int (4)) - (Prims.of_int (730)) - (Prims.of_int (94))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (731)) - (Prims.of_int (4)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - asserts - -> - let uu___19 - = - FStar_InteractiveHelpers_Output.subst_shadowed_with_abs_in_assertions - dbg ge2 - FStar_Pervasives_Native.None - asserts in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (733)) - (Prims.of_int (21)) - (Prims.of_int (733)) - (Prims.of_int (79))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (731)) - (Prims.of_int (4)) - (Prims.of_int (735)) - (Prims.of_int (30))))) - (Obj.magic - uu___19) - (fun - uu___20 - -> - (fun - uu___20 - -> - match uu___20 - with - | - (ge3, - asserts1) - -> - Obj.magic - (FStar_InteractiveHelpers_Output.printout_success - ge3 - asserts1)) - uu___20))) - uu___19))) - uu___17))) - uu___16))) - uu___15))) - uu___13))) - uu___11))) - uu___10))) - uu___8))) - uu___7))) uu___5))) - uu___4))) uu___3))) uu___1) -let (pp_unfold_in_assert_or_assume : - Prims.bool -> unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun dbg -> - fun uu___ -> - FStar_Tactics_V1_Derived.try_with - (fun uu___1 -> - match () with - | () -> - let uu___2 = find_focused_assert_in_current_goal dbg in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (741)) (Prims.of_int (14)) - (Prims.of_int (741)) (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (742)) (Prims.of_int (4)) - (Prims.of_int (743)) (Prims.of_int (16))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun res -> - let uu___3 = unfold_in_assert_or_assume dbg res in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (742)) (Prims.of_int (4)) - (Prims.of_int (742)) (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (743)) (Prims.of_int (4)) - (Prims.of_int (743)) (Prims.of_int (16))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> Obj.magic (end_proof ())) - uu___4))) uu___3)) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_InteractiveHelpers_Base.MetaAnalysis msg -> - Obj.magic - (Obj.repr - (let uu___2 = - FStar_InteractiveHelpers_Output.printout_failure - msg in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (744)) (Prims.of_int (29)) - (Prims.of_int (744)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.PostProcess.fst" - (Prims.of_int (744)) (Prims.of_int (51)) - (Prims.of_int (744)) (Prims.of_int (63))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> Obj.magic (end_proof ())) uu___3))) - | err -> Obj.magic (Obj.repr (FStar_Tactics_Effect.raise err))) - uu___1) -let _ = - FStarC_Tactics_Native.register_tactic - "FStar.InteractiveHelpers.PostProcess.pp_unfold_in_assert_or_assume" - (Prims.of_int (3)) - (fun psc -> - fun ncb -> - fun us -> - fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_2 - "FStar.InteractiveHelpers.PostProcess.pp_unfold_in_assert_or_assume (plugin)" - (FStarC_Tactics_Native.from_tactic_2 - pp_unfold_in_assert_or_assume) - FStarC_Syntax_Embeddings.e_bool - FStarC_Syntax_Embeddings.e_unit - FStarC_Syntax_Embeddings.e_unit psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Propositions.ml b/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Propositions.ml deleted file mode 100644 index eed21506c41..00000000000 --- a/stage0/fstar-lib/generated/FStar_InteractiveHelpers_Propositions.ml +++ /dev/null @@ -1,253 +0,0 @@ -open Prims -type proposition = FStarC_Reflection_Types.term -let (term_eq : - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) - = FStar_Reflection_TermEq_Simple.term_eq -let (proposition_to_string : - proposition -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun p -> FStarC_Tactics_V1_Builtins.term_to_string p -let _ = - FStarC_Tactics_Native.register_tactic - "FStar.InteractiveHelpers.Propositions.proposition_to_string" - (Prims.of_int (2)) - (fun psc -> - fun ncb -> - fun us -> - fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 - "FStar.InteractiveHelpers.Propositions.proposition_to_string (plugin)" - (FStarC_Tactics_Native.from_tactic_1 proposition_to_string) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_string psc ncb us args) -type assertions = - { - pres: proposition Prims.list ; - posts: proposition Prims.list } -let rec __knot_e_assertions _ = - FStarC_Syntax_Embeddings_Base.mk_extracted_embedding - "FStar.InteractiveHelpers.Propositions.assertions" - (fun tm_0 -> - match tm_0 with - | ("FStar.InteractiveHelpers.Propositions.Mkassertions", - pres_2::posts_3::[]) -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) pres_2) - (fun pres_2 -> - FStarC_Compiler_Util.bind_opt - (FStarC_Syntax_Embeddings_Base.extracted_unembed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) posts_3) - (fun posts_3 -> - FStar_Pervasives_Native.Some - { pres = pres_2; posts = posts_3 })) - | _ -> FStar_Pervasives_Native.None) - (fun tm_4 -> - match tm_4 with - | { pres = pres_6; posts = posts_7;_} -> - FStarC_Syntax_Util.mk_app - (FStarC_Syntax_Syntax.tdataconstr - (FStarC_Ident.lid_of_str - "FStar.InteractiveHelpers.Propositions.Mkassertions")) - [((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) pres_6), - FStar_Pervasives_Native.None); - ((FStarC_Syntax_Embeddings_Base.extracted_embed - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) posts_7), - FStar_Pervasives_Native.None)]) -let e_assertions = __knot_e_assertions () -let (__proj__Mkassertions__item__pres : assertions -> proposition Prims.list) - = fun projectee -> match projectee with | { pres; posts;_} -> pres -let (__proj__Mkassertions__item__posts : - assertions -> proposition Prims.list) = - fun projectee -> match projectee with | { pres; posts;_} -> posts -let (mk_assertions : - proposition Prims.list -> proposition Prims.list -> assertions) = - fun pres -> fun posts -> { pres; posts } -let (simpl_norm_steps : FStar_Pervasives.norm_step Prims.list) = - [FStar_Pervasives.primops; - FStar_Pervasives.simplify; - FStar_Pervasives.iota] -let (is_trivial_proposition : - proposition -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - (fun p -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - term_eq - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "l_True"]))) p))) uu___ -let _ = - FStarC_Tactics_Native.register_tactic - "FStar.InteractiveHelpers.Propositions.is_trivial_proposition" - (Prims.of_int (2)) - (fun psc -> - fun ncb -> - fun us -> - fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_1 - "FStar.InteractiveHelpers.Propositions.is_trivial_proposition (plugin)" - (FStarC_Tactics_Native.from_tactic_1 is_trivial_proposition) - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_bool psc ncb us args) -let (simp_filter_proposition : - FStarC_Reflection_Types.env -> - FStar_Pervasives.norm_step Prims.list -> - proposition -> - (proposition Prims.list, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun steps -> - fun p -> - let uu___ = FStarC_Tactics_V1_Builtins.norm_term_env e steps p in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Propositions.fst" - (Prims.of_int (31)) (Prims.of_int (14)) - (Prims.of_int (31)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Propositions.fst" - (Prims.of_int (33)) (Prims.of_int (2)) (Prims.of_int (34)) - (Prims.of_int (14))))) (Obj.magic uu___) - (fun prop1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - if - term_eq - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "l_True"]))) prop1 - then [] - else [prop1])) -let _ = - FStarC_Tactics_Native.register_tactic - "FStar.InteractiveHelpers.Propositions.simp_filter_proposition" - (Prims.of_int (4)) - (fun psc -> - fun ncb -> - fun us -> - fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 - "FStar.InteractiveHelpers.Propositions.simp_filter_proposition (plugin)" - (FStarC_Tactics_Native.from_tactic_3 simp_filter_proposition) - FStarC_Reflection_V2_Embeddings.e_env - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_norm_step) - FStarC_Reflection_V2_Embeddings.e_term - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) psc ncb us args) -let (simp_filter_propositions : - FStarC_Reflection_Types.env -> - FStar_Pervasives.norm_step Prims.list -> - proposition Prims.list -> - (proposition Prims.list, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun steps -> - fun pl -> - let uu___ = - FStar_Tactics_Util.map (simp_filter_proposition e steps) pl in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Propositions.fst" - (Prims.of_int (38)) (Prims.of_int (19)) - (Prims.of_int (38)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Propositions.fst" - (Prims.of_int (38)) (Prims.of_int (2)) (Prims.of_int (38)) - (Prims.of_int (61))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> FStar_List_Tot_Base.flatten uu___1)) -let _ = - FStarC_Tactics_Native.register_tactic - "FStar.InteractiveHelpers.Propositions.simp_filter_propositions" - (Prims.of_int (4)) - (fun psc -> - fun ncb -> - fun us -> - fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 - "FStar.InteractiveHelpers.Propositions.simp_filter_propositions (plugin)" - (FStarC_Tactics_Native.from_tactic_3 simp_filter_propositions) - FStarC_Reflection_V2_Embeddings.e_env - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_norm_step) - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) - (FStarC_Syntax_Embeddings.e_list - FStarC_Reflection_V2_Embeddings.e_term) psc ncb us args) -let (simp_filter_assertions : - FStarC_Reflection_Types.env -> - FStar_Pervasives.norm_step Prims.list -> - assertions -> (assertions, unit) FStar_Tactics_Effect.tac_repr) - = - fun e -> - fun steps -> - fun a -> - let uu___ = simp_filter_propositions e steps a.pres in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Propositions.fst" - (Prims.of_int (42)) (Prims.of_int (13)) - (Prims.of_int (42)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Propositions.fst" - (Prims.of_int (42)) (Prims.of_int (55)) - (Prims.of_int (44)) (Prims.of_int (26))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun pres -> - let uu___1 = simp_filter_propositions e steps a.posts in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Propositions.fst" - (Prims.of_int (43)) (Prims.of_int (14)) - (Prims.of_int (43)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.InteractiveHelpers.Propositions.fst" - (Prims.of_int (44)) (Prims.of_int (2)) - (Prims.of_int (44)) (Prims.of_int (26))))) - (Obj.magic uu___1) - (fun posts -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> mk_assertions pres posts)))) uu___1) -let _ = - FStarC_Tactics_Native.register_tactic - "FStar.InteractiveHelpers.Propositions.simp_filter_assertions" - (Prims.of_int (4)) - (fun psc -> - fun ncb -> - fun us -> - fun args -> - FStarC_Tactics_InterpFuns.mk_tactic_interpretation_3 - "FStar.InteractiveHelpers.Propositions.simp_filter_assertions (plugin)" - (FStarC_Tactics_Native.from_tactic_3 simp_filter_assertions) - FStarC_Reflection_V2_Embeddings.e_env - (FStarC_Syntax_Embeddings.e_list - FStarC_Syntax_Embeddings.e_norm_step) e_assertions - e_assertions psc ncb us args) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_LexicographicOrdering.ml b/stage0/fstar-lib/generated/FStar_LexicographicOrdering.ml deleted file mode 100644 index 0f2fcadb455..00000000000 --- a/stage0/fstar-lib/generated/FStar_LexicographicOrdering.ml +++ /dev/null @@ -1,211 +0,0 @@ -open Prims -type ('a, 'b, 'rua, 'rub, 'dummyV0, 'dummyV1) lex_t = - | Left_lex of 'a * 'a * 'b * 'b * 'rua - | Right_lex of 'a * 'b * 'b * 'rub -let uu___is_Left_lex : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> - ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> Prims.bool - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with - | Left_lex (x1, x2, y1, y2, _4) -> true - | uu___2 -> false -let __proj__Left_lex__item__x1 : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'a - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | Left_lex (x1, x2, y1, y2, _4) -> x1 -let __proj__Left_lex__item__x2 : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'a - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | Left_lex (x1, x2, y1, y2, _4) -> x2 -let __proj__Left_lex__item__y1 : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'b - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | Left_lex (x1, x2, y1, y2, _4) -> y1 -let __proj__Left_lex__item__y2 : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'b - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | Left_lex (x1, x2, y1, y2, _4) -> y2 -let __proj__Left_lex__item___4 : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> - ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'rua - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | Left_lex (x1, x2, y1, y2, _4) -> _4 -let uu___is_Right_lex : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> - ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> Prims.bool - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with - | Right_lex (x, y1, y2, _3) -> true - | uu___2 -> false -let __proj__Right_lex__item__x : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'a - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Right_lex (x, y1, y2, _3) -> x -let __proj__Right_lex__item__y1 : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'b - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Right_lex (x, y1, y2, _3) -> y1 -let __proj__Right_lex__item__y2 : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'b - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Right_lex (x, y1, y2, _3) -> y2 -let __proj__Right_lex__item___3 : - 'a 'b 'rua 'rub . - ('a, 'b) Prims.dtuple2 -> - ('a, 'b) Prims.dtuple2 -> - ('a, 'b, 'rua, 'rub, unit, unit) lex_t -> 'rub - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Right_lex (x, y1, y2, _3) -> _3 - -type ('a, 'b, 'rua, 'rub, 'uuuuu, 'uuuuu1) lex_aux = Obj.t -type ('a, 'b, 'rua, 'rub, 'wfua, 'wfub, 'uuuuu, 'uuuuu1) lex = Obj.t -let tuple_to_dep_tuple : 'a 'b . ('a * 'b) -> ('a, 'b) Prims.dtuple2 = - fun x -> - Prims.Mkdtuple2 - ((FStar_Pervasives_Native.fst x), (FStar_Pervasives_Native.snd x)) -type ('a, 'b, 'rua, 'rub, 'x, 'y) lex_t_non_dep = - ('a, 'b, 'rua, 'rub, unit, unit) lex_t - -type ('a, 'b, 'rua, 'rub, 'dummyV0, 'dummyV1) sym = - | Left_sym of 'a * 'a * 'b * 'rua - | Right_sym of 'a * 'b * 'b * 'rub -let uu___is_Left_sym : - 'a 'b 'rua 'rub . - ('a * 'b) -> - ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> Prims.bool - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with - | Left_sym (x1, x2, y, _3) -> true - | uu___2 -> false -let __proj__Left_sym__item__x1 : - 'a 'b 'rua 'rub . - ('a * 'b) -> ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> 'a - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Left_sym (x1, x2, y, _3) -> x1 -let __proj__Left_sym__item__x2 : - 'a 'b 'rua 'rub . - ('a * 'b) -> ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> 'a - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Left_sym (x1, x2, y, _3) -> x2 -let __proj__Left_sym__item__y : - 'a 'b 'rua 'rub . - ('a * 'b) -> ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> 'b - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Left_sym (x1, x2, y, _3) -> y -let __proj__Left_sym__item___3 : - 'a 'b 'rua 'rub . - ('a * 'b) -> ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> 'rua - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Left_sym (x1, x2, y, _3) -> _3 -let uu___is_Right_sym : - 'a 'b 'rua 'rub . - ('a * 'b) -> - ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> Prims.bool - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with - | Right_sym (x, y1, y2, _3) -> true - | uu___2 -> false -let __proj__Right_sym__item__x : - 'a 'b 'rua 'rub . - ('a * 'b) -> ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> 'a - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Right_sym (x, y1, y2, _3) -> x -let __proj__Right_sym__item__y1 : - 'a 'b 'rua 'rub . - ('a * 'b) -> ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> 'b - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Right_sym (x, y1, y2, _3) -> y1 -let __proj__Right_sym__item__y2 : - 'a 'b 'rua 'rub . - ('a * 'b) -> ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> 'b - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Right_sym (x, y1, y2, _3) -> y2 -let __proj__Right_sym__item___3 : - 'a 'b 'rua 'rub . - ('a * 'b) -> ('a * 'b) -> ('a, 'b, 'rua, 'rub, unit, unit) sym -> 'rub - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Right_sym (x, y1, y2, _3) -> _3 -let sym_sub_lex : - 'a 'b 'rua 'rub . - ('a * 'b) -> - ('a * 'b) -> - ('a, 'b, 'rua, 'rub, unit, unit) sym -> - ('a, 'b, 'rua, 'rub, unit, unit) lex_t_non_dep - = - fun t1 -> - fun t2 -> - fun p -> - match p with - | Left_sym (x1, x2, y, p1) -> Left_lex (x1, x2, y, y, p1) - | Right_sym (x, y1, y2, p1) -> Right_lex (x, y1, y2, p1) diff --git a/stage0/fstar-lib/generated/FStar_List_Pure_Base.ml b/stage0/fstar-lib/generated/FStar_List_Pure_Base.ml deleted file mode 100644 index c97efd71845..00000000000 --- a/stage0/fstar-lib/generated/FStar_List_Pure_Base.ml +++ /dev/null @@ -1,34 +0,0 @@ -open Prims -let rec map2 : - 'a1 'a2 'b . - ('a1 -> 'a2 -> 'b) -> 'a1 Prims.list -> 'a2 Prims.list -> 'b Prims.list - = - fun f -> - fun l1 -> - fun l2 -> - match (l1, l2) with - | ([], []) -> [] - | (x1::xs1, x2::xs2) -> (f x1 x2) :: (map2 f xs1 xs2) -let rec map3 : - 'a1 'a2 'a3 'b . - ('a1 -> 'a2 -> 'a3 -> 'b) -> - 'a1 Prims.list -> 'a2 Prims.list -> 'a3 Prims.list -> 'b Prims.list - = - fun f -> - fun l1 -> - fun l2 -> - fun l3 -> - match (l1, l2, l3) with - | ([], [], []) -> [] - | (x1::xs1, x2::xs2, x3::xs3) -> (f x1 x2 x3) :: - (map3 f xs1 xs2 xs3) -let zip : - 'a1 'a2 . 'a1 Prims.list -> 'a2 Prims.list -> ('a1 * 'a2) Prims.list = - fun l1 -> fun l2 -> map2 (fun x -> fun y -> (x, y)) l1 l2 -let zip3 : - 'a1 'a2 'a3 . - 'a1 Prims.list -> - 'a2 Prims.list -> 'a3 Prims.list -> ('a1 * 'a2 * 'a3) Prims.list - = - fun l1 -> - fun l2 -> fun l3 -> map3 (fun x -> fun y -> fun z -> (x, y, z)) l1 l2 l3 \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_MRef.ml b/stage0/fstar-lib/generated/FStar_MRef.ml deleted file mode 100644 index da6bd9cfc0f..00000000000 --- a/stage0/fstar-lib/generated/FStar_MRef.ml +++ /dev/null @@ -1,13 +0,0 @@ -open Prims -type ('uuuuu, 'p, 'rel) stable = unit -type ('a, 'b, 'r, 'p, 'h) p_pred = unit -type ('uuuuu, 'uuuuu1, 'r, 'p) token = unit FStar_ST.witnessed -let witness_token : - 'uuuuu 'uuuuu1 . ('uuuuu, 'uuuuu1) FStar_ST.mref -> unit -> unit = - fun m -> fun p -> FStar_ST.gst_recall (); FStar_ST.gst_witness () -let recall_token : - 'uuuuu 'uuuuu1 . ('uuuuu, 'uuuuu1) FStar_ST.mref -> unit -> unit = - fun m -> fun p -> FStar_ST.gst_recall () -type ('a, 'rel) spred = unit -let recall : 'p . unit -> unit = fun uu___ -> FStar_ST.gst_recall () -let witness : 'p . unit -> unit = fun uu___ -> FStar_ST.gst_witness () \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Map.ml b/stage0/fstar-lib/generated/FStar_Map.ml deleted file mode 100644 index 4d2d4931b02..00000000000 --- a/stage0/fstar-lib/generated/FStar_Map.ml +++ /dev/null @@ -1,78 +0,0 @@ -open Prims -type ('key, 'value) t = - { - mappings: ('key, 'value) FStar_FunctionalExtensionality.restricted_t ; - domain: 'key FStar_Set.set } -let __proj__Mkt__item__mappings : - 'key 'value . - ('key, 'value) t -> - ('key, 'value) FStar_FunctionalExtensionality.restricted_t - = fun projectee -> match projectee with | { mappings; domain;_} -> mappings -let __proj__Mkt__item__domain : - 'key 'value . ('key, 'value) t -> 'key FStar_Set.set = - fun projectee -> match projectee with | { mappings; domain;_} -> domain -let sel : 'key 'value . ('key, 'value) t -> 'key -> 'value = - fun m -> fun k -> m.mappings k -let upd : - 'key 'value . ('key, 'value) t -> 'key -> 'value -> ('key, 'value) t = - fun m -> - fun k -> - fun v -> - { - mappings = - (FStar_FunctionalExtensionality.on_domain - (fun x -> if x = k then v else m.mappings x)); - domain = (FStar_Set.union m.domain (FStar_Set.singleton k)) - } -let const : 'key 'value . 'value -> ('key, 'value) t = - fun v -> - { - mappings = (FStar_FunctionalExtensionality.on_domain (fun uu___ -> v)); - domain = (FStar_Set.complement (FStar_Set.empty ())) - } -let domain : 'key 'value . ('key, 'value) t -> 'key FStar_Set.set = - fun m -> m.domain -let contains : 'key 'value . ('key, 'value) t -> 'key -> Prims.bool = - fun m -> fun k -> FStar_Set.mem k m.domain -let concat : - 'key 'value . ('key, 'value) t -> ('key, 'value) t -> ('key, 'value) t = - fun m1 -> - fun m2 -> - { - mappings = - (FStar_FunctionalExtensionality.on_domain - (fun x -> - if FStar_Set.mem x m2.domain - then m2.mappings x - else m1.mappings x)); - domain = (FStar_Set.union m1.domain m2.domain) - } -let map_val : - 'uuuuu 'uuuuu1 . - ('uuuuu -> 'uuuuu1) -> unit -> (Obj.t, 'uuuuu) t -> (Obj.t, 'uuuuu1) t - = - fun f -> - fun key -> - fun m -> - { - mappings = - (FStar_FunctionalExtensionality.on_domain - (fun x -> f (m.mappings x))); - domain = (m.domain) - } -let restrict : - 'key 'value . 'key FStar_Set.set -> ('key, 'value) t -> ('key, 'value) t = - fun s -> - fun m -> - { mappings = (m.mappings); domain = (FStar_Set.intersect s m.domain) } -let const_on : 'key 'value . 'key FStar_Set.set -> 'value -> ('key, 'value) t - = fun dom -> fun v -> restrict dom (const v) -let map_literal : 'k 'v . ('k -> 'v) -> ('k, 'v) t = - fun f -> - { - mappings = (FStar_FunctionalExtensionality.on_domain f); - domain = (FStar_Set.complement (FStar_Set.empty ())) - } -type ('key, 'value, 'm1, 'm2) disjoint_dom = unit -type ('key, 'value, 'm, 'dom) has_dom = unit -type ('key, 'value, 'm1, 'm2) equal = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_MarkovsPrinciple.ml b/stage0/fstar-lib/generated/FStar_MarkovsPrinciple.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_MarkovsPrinciple.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Math_Euclid.ml b/stage0/fstar-lib/generated/FStar_Math_Euclid.ml deleted file mode 100644 index 937a4fc95fa..00000000000 --- a/stage0/fstar-lib/generated/FStar_Math_Euclid.ml +++ /dev/null @@ -1,57 +0,0 @@ -open Prims -type ('a, 'b) divides = unit -type ('a, 'b, 'd) is_gcd = unit -let rec (egcd : - Prims.int -> - Prims.int -> - Prims.int -> - Prims.int -> - Prims.int -> - Prims.int -> - Prims.int -> Prims.int -> (Prims.int * Prims.int * Prims.int)) - = - fun a -> - fun b -> - fun u1 -> - fun u2 -> - fun u3 -> - fun v1 -> - fun v2 -> - fun v3 -> - if v3 = Prims.int_zero - then (u1, u2, u3) - else - (let q = u3 / v3 in - let uu___1 = (v1, (u1 - (q * v1))) in - match uu___1 with - | (u11, v11) -> - let uu___2 = (v2, (u2 - (q * v2))) in - (match uu___2 with - | (u21, v21) -> - let u3' = u3 in - let v3' = v3 in - let uu___3 = (v3, (u3 - (q * v3))) in - (match uu___3 with - | (u31, v31) -> - let r = egcd a b u11 u21 u31 v11 v21 v31 in - r))) -let (euclid_gcd : - Prims.int -> Prims.int -> (Prims.int * Prims.int * Prims.int)) = - fun a -> - fun b -> - if b >= Prims.int_zero - then - egcd a b Prims.int_one Prims.int_zero a Prims.int_zero Prims.int_one - b - else - (let res = - egcd a b Prims.int_one Prims.int_zero a Prims.int_zero - (Prims.of_int (-1)) (- b) in - let uu___1 = res in match uu___1 with | (uu___2, uu___3, d) -> res) -type 'p is_prime = unit -let (bezout_prime : Prims.int -> Prims.pos -> (Prims.int * Prims.int)) = - fun p -> - fun a -> - let uu___ = euclid_gcd p a in - match uu___ with - | (r, s, d) -> if d = Prims.int_one then (r, s) else ((- r), (- s)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Math_Fermat.ml b/stage0/fstar-lib/generated/FStar_Math_Fermat.ml deleted file mode 100644 index 17543d91c86..00000000000 --- a/stage0/fstar-lib/generated/FStar_Math_Fermat.ml +++ /dev/null @@ -1,27 +0,0 @@ -open Prims -let rec (pow : Prims.int -> Prims.nat -> Prims.int) = - fun a -> - fun k -> - if k = Prims.int_zero - then Prims.int_one - else a * (pow a (k - Prims.int_one)) -let rec (binomial : Prims.nat -> Prims.nat -> Prims.nat) = - fun n -> - fun k -> - match (n, k) with - | (uu___, uu___1) when uu___1 = Prims.int_zero -> Prims.int_one - | (uu___, uu___1) when uu___ = Prims.int_zero -> Prims.int_zero - | (uu___, uu___1) -> - (binomial (n - Prims.int_one) k) + - (binomial (n - Prims.int_one) (k - Prims.int_one)) -let rec (factorial : Prims.nat -> Prims.pos) = - fun uu___ -> - match uu___ with - | uu___1 when uu___1 = Prims.int_zero -> Prims.int_one - | n -> n * (factorial (n - Prims.int_one)) -let (op_Bang : Prims.nat -> Prims.pos) = fun n -> factorial n -let rec (sum : - Prims.nat -> Prims.nat -> (Prims.nat -> Prims.int) -> Prims.int) = - fun a -> - fun b -> - fun f -> if a = b then f a else (f a) + (sum (a + Prims.int_one) b f) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Math_Lemmas.ml b/stage0/fstar-lib/generated/FStar_Math_Lemmas.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Math_Lemmas.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Matrix.ml b/stage0/fstar-lib/generated/FStar_Matrix.ml deleted file mode 100644 index 229e623faae..00000000000 --- a/stage0/fstar-lib/generated/FStar_Matrix.ml +++ /dev/null @@ -1,303 +0,0 @@ -open Prims -type ('c, 'm, 'n) matrix_generator = - unit FStar_IntegerIntervals.under -> - unit FStar_IntegerIntervals.under -> 'c -type ('c, 'm, 'n) matrix = 'c FStar_Seq_Base.seq -let (get_ij : - Prims.pos -> - Prims.pos -> - unit FStar_IntegerIntervals.under -> - unit FStar_IntegerIntervals.under -> - unit FStar_IntegerIntervals.under) - = fun m -> fun n -> fun i -> fun j -> (i * n) + j -let (get_i : - Prims.pos -> - Prims.pos -> - unit FStar_IntegerIntervals.under -> unit FStar_IntegerIntervals.under) - = fun m -> fun n -> fun ij -> ij / n -let (get_j : - Prims.pos -> - Prims.pos -> - unit FStar_IntegerIntervals.under -> unit FStar_IntegerIntervals.under) - = fun m -> fun n -> fun ij -> ij mod n -let (transpose_ji : - Prims.pos -> - Prims.pos -> - unit FStar_IntegerIntervals.under -> unit FStar_IntegerIntervals.under) - = fun m -> fun n -> fun ij -> ((get_j m n ij) * m) + (get_i m n ij) -let seq_of_matrix : - 'c . - Prims.pos -> - Prims.pos -> ('c, unit, unit) matrix -> 'c FStar_Seq_Base.seq - = fun m -> fun n -> fun mx -> mx -let ijth : - 'c . - Prims.pos -> - Prims.pos -> - ('c, unit, unit) matrix -> - unit FStar_IntegerIntervals.under -> - unit FStar_IntegerIntervals.under -> 'c - = - fun m -> - fun n -> - fun mx -> fun i -> fun j -> FStar_Seq_Base.index mx (get_ij m n i j) -let matrix_of_seq : - 'c . - Prims.pos -> - Prims.pos -> 'c FStar_Seq_Base.seq -> ('c, unit, unit) matrix - = fun m -> fun n -> fun s -> s -type ('c, 'm, 'n, 'gen) matrix_of = ('c, unit, unit) matrix -let foldm : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - Prims.pos -> - Prims.pos -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit, unit) matrix -> 'c - = - fun eq -> - fun m -> - fun n -> fun cm -> fun mx -> FStar_Seq_Permutation.foldm_snoc eq cm mx -let init : - 'c . - Prims.pos -> - Prims.pos -> - ('c, unit, unit) matrix_generator -> ('c, unit, unit, unit) matrix_of - = - fun m -> - fun n -> - fun generator -> - let mn = m * n in - let generator_ij ij = generator (get_i m n ij) (get_j m n ij) in - let flat_indices = FStar_IntegerIntervals.indices_seq mn in - let result = FStar_Seq_Properties.map_seq generator_ij flat_indices in - result -let matrix_seq : - 'c . - Prims.pos -> - Prims.pos -> ('c, unit, unit) matrix_generator -> 'c FStar_Seq_Base.seq - = fun m -> fun n -> fun gen -> init m n gen -let transposed_matrix_gen : - 'c . - Prims.pos -> - Prims.pos -> - ('c, unit, unit) matrix_generator -> - ('c, unit, unit) matrix_generator - = fun m -> fun n -> fun generator -> fun j -> fun i -> generator i j -type ('c, 'm, 'n, 'eq, 'ma, 'mb) matrix_eq_fun = - ('c, unit, unit, unit) FStar_Seq_Equiv.eq_of_seq -let matrix_equiv : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - Prims.pos -> - Prims.pos -> - ('c, unit, unit) matrix FStar_Algebra_CommMonoid_Equiv.equiv - = - fun eq -> - fun m -> fun n -> FStar_Algebra_CommMonoid_Equiv.EQ ((), (), (), ()) -let matrix_add_generator : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - Prims.pos -> - Prims.pos -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit, unit) matrix -> - ('c, unit, unit) matrix -> ('c, unit, unit) matrix_generator - = - fun eq -> - fun m -> - fun n -> - fun add -> - fun ma -> - fun mb -> - fun i -> - fun j -> - FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__mult eq - add (ijth m n ma i j) (ijth m n mb i j) -let matrix_add : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - Prims.pos -> - Prims.pos -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit, unit) matrix -> - ('c, unit, unit) matrix -> ('c, unit, unit, unit) matrix_of - = - fun eq -> - fun m -> - fun n -> - fun add -> - fun ma -> - fun mb -> init m n (matrix_add_generator eq m n add ma mb) -let matrix_add_zero : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - Prims.pos -> Prims.pos -> ('c, unit, unit) matrix - = - fun eq -> - fun add -> - fun m -> - fun n -> - matrix_of_seq m n - (FStar_Seq_Base.create (m * n) - (FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__unit eq add)) -let matrix_add_comm_monoid : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - Prims.pos -> - Prims.pos -> - (('c, unit, unit) matrix, unit) FStar_Algebra_CommMonoid_Equiv.cm - = - fun eq -> - fun add -> - fun m -> - fun n -> - FStar_Algebra_CommMonoid_Equiv.CM - ((matrix_add_zero eq add m n), (matrix_add eq m n add), (), (), - (), ()) -let col : - 'c . - Prims.pos -> - Prims.pos -> - ('c, unit, unit) matrix -> - unit FStar_IntegerIntervals.under -> 'c FStar_Seq_Base.seq - = - fun m -> - fun n -> - fun mx -> fun j -> FStar_Seq_Base.init m (fun i -> ijth m n mx i j) -let row : - 'c . - Prims.pos -> - Prims.pos -> - ('c, unit, unit) matrix -> - unit FStar_IntegerIntervals.under -> 'c FStar_Seq_Base.seq - = - fun m -> - fun n -> - fun mx -> fun i -> FStar_Seq_Base.init n (fun j -> ijth m n mx i j) -let seq_op_const : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - 'c FStar_Seq_Base.seq -> 'c -> 'c FStar_Seq_Base.seq - = - fun eq -> - fun cm -> - fun s -> - fun const -> - FStar_Seq_Base.init (FStar_Seq_Base.length s) - (fun i -> - FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__mult eq cm - (FStar_Seq_Base.index s i) const) -let const_op_seq : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - 'c -> 'c FStar_Seq_Base.seq -> 'c FStar_Seq_Base.seq - = - fun eq -> - fun cm -> - fun const -> - fun s -> - FStar_Seq_Base.init (FStar_Seq_Base.length s) - (fun i -> - FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__mult eq cm - const (FStar_Seq_Base.index s i)) -let seq_of_products : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - 'c FStar_Seq_Base.seq -> - 'c FStar_Seq_Base.seq -> 'c FStar_Seq_Base.seq - = - fun eq -> - fun mul -> - fun s -> - fun t -> - FStar_Seq_Base.init (FStar_Seq_Base.length s) - (fun i -> - FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__mult eq mul - (FStar_Seq_Base.index s i) (FStar_Seq_Base.index t i)) -let dot : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - 'c FStar_Seq_Base.seq -> 'c FStar_Seq_Base.seq -> 'c - = - fun eq -> - fun add -> - fun mul -> - fun s -> - fun t -> - FStar_Seq_Permutation.foldm_snoc eq add - (seq_of_products eq mul s t) -let matrix_mul_gen : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - Prims.pos -> - Prims.pos -> - Prims.pos -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit, unit) matrix -> - ('c, unit, unit) matrix -> - unit FStar_IntegerIntervals.under -> - unit FStar_IntegerIntervals.under -> 'c - = - fun eq -> - fun m -> - fun n -> - fun p -> - fun add -> - fun mul -> - fun mx -> - fun my -> - fun i -> - fun k -> dot eq add mul (row m n mx i) (col n p my k) -let matrix_mul : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - Prims.pos -> - Prims.pos -> - Prims.pos -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit, unit) matrix -> - ('c, unit, unit) matrix -> ('c, unit, unit) matrix - = - fun eq -> - fun m -> - fun n -> - fun p -> - fun add -> - fun mul -> - fun mx -> - fun my -> init m p (matrix_mul_gen eq m n p add mul mx my) -type ('c, 'eq, 'mul, 'add) is_left_distributive = unit -type ('c, 'eq, 'mul, 'add) is_right_distributive = unit -type ('c, 'eq, 'mul, 'add) is_fully_distributive = unit -type ('c, 'eq, 'z, 'op) is_absorber = unit -let matrix_mul_unit : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - Prims.pos -> ('c, unit, unit) matrix - = - fun eq -> - fun add -> - fun mul -> - fun m -> - init m m - (fun i -> - fun j -> - if i = j - then - FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__unit eq - mul - else - FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__unit eq - add) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Modifies.ml b/stage0/fstar-lib/generated/FStar_Modifies.ml deleted file mode 100644 index 1a285f0137d..00000000000 --- a/stage0/fstar-lib/generated/FStar_Modifies.ml +++ /dev/null @@ -1,24 +0,0 @@ -open Prims -type loc_aux = - | LocBuffer of unit * Obj.t FStar_Buffer.buffer -let (uu___is_LocBuffer : loc_aux -> Prims.bool) = fun projectee -> true -let (__proj__LocBuffer__item__b : loc_aux -> unit FStar_Buffer.buffer) = - fun uu___ -> - (fun projectee -> match projectee with | LocBuffer (t, b) -> Obj.magic b) - uu___ -type ('l, 'r, 'n) loc_aux_in_addr = Obj.t -type ('r, 'n) aloc = loc_aux -type ('a, 's, 'b) loc_aux_includes_buffer = Obj.t -type ('s1, 's2) loc_aux_includes = Obj.t -type ('l, 't, 'p) loc_aux_disjoint_buffer = Obj.t -type ('l1, 'l2) loc_aux_disjoint = Obj.t -type ('l, 'h1, 'h2) loc_aux_preserved = Obj.t -type loc = unit - -type ('s1, 's2) loc_includes = unit -type ('s1, 's2) loc_disjoint = unit -type ('s, 'h1, 'h2) modifies = unit - - -type ('h, 'ra) does_not_contain_addr = unit -type ('uuuuu, 'uuuuu1) cloc_aloc = (unit, unit) aloc diff --git a/stage0/fstar-lib/generated/FStar_ModifiesGen.ml b/stage0/fstar-lib/generated/FStar_ModifiesGen.ml deleted file mode 100644 index f1efad99b7b..00000000000 --- a/stage0/fstar-lib/generated/FStar_ModifiesGen.ml +++ /dev/null @@ -1,121 +0,0 @@ -open Prims -type aloc_t = unit -type ('al, 'c) aloc = - | ALoc of unit * Prims.nat * 'al FStar_Pervasives_Native.option -let uu___is_ALoc : 'al . unit -> ('al, unit) aloc -> Prims.bool = - fun c -> fun projectee -> true - -let __proj__ALoc__item__addr : 'al . unit -> ('al, unit) aloc -> Prims.nat = - fun c -> - fun projectee -> match projectee with | ALoc (region, addr, loc) -> addr -let __proj__ALoc__item__loc : - 'al . unit -> ('al, unit) aloc -> 'al FStar_Pervasives_Native.option = - fun c -> - fun projectee -> match projectee with | ALoc (region, addr, loc) -> loc -type ('a, 'b) i_restricted_g_t = unit -type 'regions addrs_dom = unit -type ('regions, 'regionulivenessutags, 'r) non_live_addrs_codom = unit -type ('regions, 'regionulivenessutags, 'nonuliveuaddrs, - 'r) live_addrs_codom = unit -type ('aloc1, 'c) loc = unit - - -type ('t, 'tu, 'p, 'f1, 'f2) fun_set_equal = unit -type ('al, 'c, 's1, 's2) loc_equal = Obj.t -type ('al, 'c, 'b0, 'b) aloc_includes = unit -type ('al, 'c, 's, 'b) loc_aux_includes_buffer = unit -type ('al, 'c, 's1, 's2) loc_aux_includes = unit -type ('al, 'c, 's1, 's2) loc_includes' = unit -type ('al, 'c, 's1, 's2) loc_includes = unit -type ('al, 'c, 'b1, 'b2) aloc_disjoint = Obj.t -type ('al, 'c, 'l1, 'l2) loc_aux_disjoint = unit -type ('al, 'c, 'l1, 'l2) loc_disjoint_region_liveness_tags = unit -type ('al, 'c, 'l1, 'l2) loc_disjoint_addrs = unit -type ('al, 'c, 'l1, 'l2) loc_disjoint_aux = unit -type ('al, 'c, 'l1, 'l2) loc_disjoint = unit -type ('al, 'c, 's, 'h1, 'h2) modifies_preserves_livenesses = unit -type ('al, 'c, 's, 'h1, 'h2) modifies_preserves_mreferences = unit -type ('al, 'c, 's, 'h1, 'h2) modifies_preserves_alocs = unit -type ('al, 'c, 's, 'h1, 'h2) modifies_preserves_regions = unit -type ('al, 'c, 's, 'h1, 'h2) modifies_preserves_not_unused_in = unit -type ('al, 'c, 's, 'h1, 'h2) modifies = unit -type ('h, 'ra) does_not_contain_addr = unit -type ('al, 'r, 'n) cls_union_aloc = - | ALOC_FALSE of 'al - | ALOC_TRUE of 'al -let uu___is_ALOC_FALSE : - 'al . unit -> Prims.nat -> ('al, unit, unit) cls_union_aloc -> Prims.bool = - fun r -> - fun n -> - fun projectee -> - match projectee with | ALOC_FALSE _0 -> true | uu___ -> false -let __proj__ALOC_FALSE__item___0 : - 'al . unit -> Prims.nat -> ('al, unit, unit) cls_union_aloc -> 'al = - fun r -> - fun n -> fun projectee -> match projectee with | ALOC_FALSE _0 -> _0 -let uu___is_ALOC_TRUE : - 'al . unit -> Prims.nat -> ('al, unit, unit) cls_union_aloc -> Prims.bool = - fun r -> - fun n -> - fun projectee -> - match projectee with | ALOC_TRUE _0 -> true | uu___ -> false -let __proj__ALOC_TRUE__item___0 : - 'al . unit -> Prims.nat -> ('al, unit, unit) cls_union_aloc -> 'al = - fun r -> - fun n -> fun projectee -> match projectee with | ALOC_TRUE _0 -> _0 -let bool_of_cls_union_aloc : - 'al . unit -> Prims.nat -> ('al, unit, unit) cls_union_aloc -> Prims.bool = - fun r -> - fun n -> - fun l -> - match l with | ALOC_FALSE uu___ -> false | ALOC_TRUE uu___ -> true -let aloc_of_cls_union_aloc : - 'al . unit -> Prims.nat -> ('al, unit, unit) cls_union_aloc -> 'al = - fun r -> - fun n -> fun l -> match l with | ALOC_FALSE x -> x | ALOC_TRUE x -> x -let make_cls_union_aloc : - 'al . - Prims.bool -> - unit -> Prims.nat -> 'al -> ('al, unit, unit) cls_union_aloc - = - fun b -> fun r -> fun n -> fun l -> if b then ALOC_TRUE l else ALOC_FALSE l -type ('al, 'c, 'r, 'a, 'larger, 'smaller) cls_union_aloc_includes = unit -type ('al, 'c, 'r, 'a, 'larger, 'smaller) cls_union_aloc_disjoint = unit -type ('al, 'c, 'r, 'a, 'x, 'h, 'hu) cls_union_aloc_preserved = Obj.t -type ('uuuuu, 'uuuuu1, 'uuuuu2) aloc_union = - ('uuuuu, unit, unit) cls_union_aloc - - -type ('al, 'r, 'n) raise_aloc = 'al FStar_Universe.raise_t -let downgrade_aloc : - 'al . unit -> (('al, unit, unit) raise_aloc, unit) aloc -> ('al, unit) aloc - = - fun c -> - fun a -> - let uu___ = a in - match uu___ with - | ALoc (region, addr, x) -> - ALoc - ((), addr, - (if FStar_Pervasives_Native.uu___is_None x - then FStar_Pervasives_Native.None - else - FStar_Pervasives_Native.Some - (FStar_Universe.downgrade_val - (FStar_Pervasives_Native.__proj__Some__item__v x)))) -let upgrade_aloc : - 'al . unit -> ('al, unit) aloc -> (('al, unit, unit) raise_aloc, unit) aloc - = - fun c -> - fun a -> - let uu___ = a in - match uu___ with - | ALoc (region, addr, x) -> - ALoc - ((), addr, - (if FStar_Pervasives_Native.uu___is_None x - then FStar_Pervasives_Native.None - else - FStar_Pervasives_Native.Some - (FStar_Universe.raise_val - (FStar_Pervasives_Native.__proj__Some__item__v x)))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Monotonic_DependentMap.ml b/stage0/fstar-lib/generated/FStar_Monotonic_DependentMap.ml deleted file mode 100644 index fc7cb1ec7ca..00000000000 --- a/stage0/fstar-lib/generated/FStar_Monotonic_DependentMap.ml +++ /dev/null @@ -1,88 +0,0 @@ -open Prims -type ('a, 'b, 'x) opt = 'b FStar_Pervasives_Native.option -type ('a, 'b) partial_dependent_map = - ('a, ('a, 'b, unit) opt) FStar_DependentMap.t -let empty_partial_dependent_map : - 'a 'b . unit -> ('a, 'b) partial_dependent_map = - fun uu___ -> - FStar_DependentMap.create (fun x -> FStar_Pervasives_Native.None) -type ('a, 'b) map = ('a, 'b) Prims.dtuple2 Prims.list -let empty : 'a 'b . unit -> ('a, 'b) map = fun uu___ -> [] -let rec sel : 'a 'b . ('a, 'b) map -> 'a -> 'b FStar_Pervasives_Native.option - = - fun r -> - fun x -> - match r with - | [] -> FStar_Pervasives_Native.None - | (Prims.Mkdtuple2 (x', y))::tl -> - if x = x' then FStar_Pervasives_Native.Some y else sel tl x -let upd : 'a 'b . ('a, 'b) map -> 'a -> 'b -> ('a, 'b) map = - fun r -> fun x -> fun v -> (Prims.Mkdtuple2 (x, v)) :: r -type ('a, 'b, 'inv) imap = ('a, 'b) map -type ('a, 'b, 'inv, 'm1, 'm2) grows' = unit -type ('a, 'b, 'inv, 'uuuuu, 'uuuuu1) grows = unit -type ('r, 'a, 'b, 'inv) t = - (unit, ('a, 'b, 'inv) imap, unit) FStar_HyperStack_ST.m_rref -type ('a, 'b, 'inv, 'r, 't1, 'x, 'h) defined = unit -type ('a, 'b, 'inv, 'r, 't1, 'x, 'h) fresh = unit -type ('a, 'b, 'inv, 'r, 't1, 'x, 'y, 'h) contains = unit -let alloc : 'a 'b 'inv . unit -> unit -> (unit, 'a, 'b, 'inv) t = - fun r -> fun uu___ -> FStar_HyperStack_ST.ralloc () [] -let extend : 'a 'b 'inv . unit -> (unit, 'a, 'b, 'inv) t -> 'a -> 'b -> unit - = - fun r -> - fun t1 -> - fun x -> - fun y -> - FStar_HyperStack_ST.recall t1; - (let cur = FStar_HyperStack_ST.op_Bang t1 in - FStar_HyperStack_ST.op_Colon_Equals t1 (upd cur x y); - FStar_HyperStack_ST.mr_witness () () () (Obj.magic t1) ()) -let lookup : - 'a 'b 'inv . - unit -> (unit, 'a, 'b, 'inv) t -> 'a -> 'b FStar_Pervasives_Native.option - = - fun r -> - fun t1 -> - fun x -> - let m = FStar_HyperStack_ST.op_Bang t1 in - let y = sel m x in - match y with - | FStar_Pervasives_Native.None -> y - | FStar_Pervasives_Native.Some b1 -> - (FStar_HyperStack_ST.mr_witness () () () (Obj.magic t1) (); y) -type ('a, 'b, 'inv, 'r, 't1, 'h, 'pred) forall_t = unit -let f_opt : - 'a 'b 'c . - ('a -> 'b -> 'c) -> - 'a -> - 'b FStar_Pervasives_Native.option -> - 'c FStar_Pervasives_Native.option - = - fun f -> - fun x -> - fun y -> - match y with - | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some y1 -> - FStar_Pervasives_Native.Some (f x y1) -let rec mmap_f : 'a 'b 'c . ('a, 'b) map -> ('a -> 'b -> 'c) -> ('a, 'c) map - = - fun m -> - fun f -> - match m with - | [] -> [] - | (Prims.Mkdtuple2 (x, y))::tl -> (Prims.Mkdtuple2 (x, (f x y))) :: - (mmap_f tl f) -let map_f : - 'a 'b 'c 'inv 'invu . - unit -> - unit -> - (unit, 'a, 'b, 'inv) t -> ('a -> 'b -> 'c) -> (unit, 'a, 'c, 'invu) t - = - fun r -> - fun r' -> - fun t1 -> - fun f -> - let m = FStar_HyperStack_ST.op_Bang t1 in - FStar_HyperStack_ST.ralloc () (mmap_f m f) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Monotonic_HyperHeap.ml b/stage0/fstar-lib/generated/FStar_Monotonic_HyperHeap.ml deleted file mode 100644 index 7c10adf3024..00000000000 --- a/stage0/fstar-lib/generated/FStar_Monotonic_HyperHeap.ml +++ /dev/null @@ -1,16 +0,0 @@ -open Prims -type rid = unit -type hmap = (unit, FStar_Monotonic_Heap.heap) FStar_Map.t - - - -let (mod_set : unit FStar_Set.set -> unit FStar_Set.set) = - fun uu___ -> Prims.magic () -type ('s, 'm0, 'm1) modifies = unit -type ('s, 'm0, 'm1) modifies_just = unit -type ('r, 'm0, 'm1) modifies_one = unit -type ('s, 'm0, 'm1) equal_on = unit -type ('s1, 's2) disjoint_regions = unit -type ('r, 'n, 'c, 'freeable, 's) extend_post = unit - - diff --git a/stage0/fstar-lib/generated/FStar_Monotonic_HyperStack.ml b/stage0/fstar-lib/generated/FStar_Monotonic_HyperStack.ml deleted file mode 100644 index b6d1e73fff4..00000000000 --- a/stage0/fstar-lib/generated/FStar_Monotonic_HyperStack.ml +++ /dev/null @@ -1,209 +0,0 @@ -open Prims -let (is_in : unit -> FStar_Monotonic_HyperHeap.hmap -> Prims.bool) = - fun r -> fun h -> FStar_Map.contains h () -let (is_heap_color : Prims.int -> Prims.bool) = fun c -> c <= Prims.int_zero -type sid = unit -type 'm map_invariant_predicate = unit -type 'h downward_closed_predicate = unit -type ('tip, 'h) tip_top_predicate = unit -type ('h, 'n) rid_ctr_pred_predicate = unit -type 'm map_invariant = unit -type 'h downward_closed = unit -type ('tip, 'h) tip_top = unit -type ('h, 'n) rid_ctr_pred = unit -type ('tip, 'h) is_tip = unit -type ('h, 'ctr, 'tip) is_wf_with_ctr_and_tip = unit -type mem' = - | HS of Prims.int * FStar_Monotonic_HyperHeap.hmap * unit -let (uu___is_HS : mem' -> Prims.bool) = fun projectee -> true -let (__proj__HS__item__rid_ctr : mem' -> Prims.int) = - fun projectee -> match projectee with | HS (rid_ctr, h, tip) -> rid_ctr -let (__proj__HS__item__h : mem' -> FStar_Monotonic_HyperHeap.hmap) = - fun projectee -> match projectee with | HS (rid_ctr, h, tip) -> h - -let (mk_mem : Prims.int -> FStar_Monotonic_HyperHeap.hmap -> unit -> mem') = - fun rid_ctr -> fun h -> fun tip -> HS (rid_ctr, h, ()) -let (get_hmap : mem' -> FStar_Monotonic_HyperHeap.hmap) = - fun m -> __proj__HS__item__h m -let (get_rid_ctr : mem' -> Prims.int) = fun m -> __proj__HS__item__rid_ctr m - -type mem = mem' -let (empty_mem : mem) = - let empty_map = - FStar_Map.restrict (FStar_Set.empty ()) - (FStar_Map.const FStar_Monotonic_Heap.emp) in - let h = FStar_Map.upd empty_map () FStar_Monotonic_Heap.emp in - mk_mem Prims.int_one h () -type 'm poppable = unit -let remove_elt : 'a . 'a FStar_Set.set -> 'a -> 'a FStar_Set.set = - fun s -> - fun x -> - FStar_Set.intersect s (FStar_Set.complement (FStar_Set.singleton x)) -type ('m0, 'm1) popped = unit -let (pop : mem -> mem) = - fun m0 -> - let uu___ = ((get_hmap m0), (), (get_rid_ctr m0)) in - match uu___ with - | (h0, tip0, rid_ctr0) -> - let dom = remove_elt (FStar_Map.domain h0) () in - let h1 = FStar_Map.restrict dom h0 in mk_mem rid_ctr0 h1 () -type ('a, 'rel) mreference' = - | MkRef of unit * ('a, 'rel) FStar_Monotonic_Heap.mref -let uu___is_MkRef : 'a 'rel . ('a, 'rel) mreference' -> Prims.bool = - fun projectee -> true - -let __proj__MkRef__item__ref : - 'a 'rel . ('a, 'rel) mreference' -> ('a, 'rel) FStar_Monotonic_Heap.mref = - fun projectee -> match projectee with | MkRef (frame, ref) -> ref -type ('a, 'rel) mreference = ('a, 'rel) mreference' - -let mk_mreference : - 'a 'rel . - unit -> ('a, 'rel) FStar_Monotonic_Heap.mref -> ('a, 'rel) mreference - = fun id -> fun r -> MkRef ((), r) -let as_ref : - 'uuuuu 'uuuuu1 . - ('uuuuu, 'uuuuu1) mreference -> - ('uuuuu, 'uuuuu1) FStar_Monotonic_Heap.mref - = fun x -> __proj__MkRef__item__ref x -type ('a, 'rel) mstackref = ('a, 'rel) mreference -type ('a, 'rel) mref = ('a, 'rel) mreference -type ('a, 'rel) mmmstackref = ('a, 'rel) mreference -type ('a, 'rel) mmmref = ('a, 'rel) mreference -type ('i, 'a, 'rel) s_mref = ('a, 'rel) mreference -let (live_region : mem -> unit -> Prims.bool) = - fun m -> fun i -> FStar_Map.contains (get_hmap m) () -type ('a, 'rel, 'm, 's) contains = unit -type ('a, 'rel, 'r, 'm) unused_in = unit -type ('a, 'rel, 'm, 'r) contains_ref_in_its_region = - ('a, 'rel, unit, unit) FStar_Monotonic_Heap.contains -type ('a, 'rel, 'r, 'm0, 'm1) fresh_ref = unit -type ('i, 'm0, 'm1) fresh_region = unit -let alloc : - 'a 'rel . unit -> 'a -> Prims.bool -> mem -> (('a, 'rel) mreference * mem) - = - fun id -> - fun init -> - fun mm -> - fun m -> - let uu___ = ((get_hmap m), (get_rid_ctr m), ()) in - match uu___ with - | (h, rid_ctr, tip) -> - let uu___1 = - FStar_Monotonic_Heap.alloc (FStar_Map.sel h ()) init mm in - (match uu___1 with - | (r, id_h) -> - let h1 = FStar_Map.upd h () id_h in - ((mk_mreference () r), (mk_mem rid_ctr h1 ()))) -let free : 'a 'rel . ('a, 'rel) mreference -> mem -> mem = - fun r -> - fun m -> - let uu___ = ((get_hmap m), (get_rid_ctr m), ()) in - match uu___ with - | (h, rid_ctr, tip) -> - let i_h = FStar_Map.sel h () in - let i_h1 = FStar_Monotonic_Heap.free_mm i_h (as_ref r) in - let h1 = FStar_Map.upd h () i_h1 in mk_mem rid_ctr h1 () -let upd_tot : 'a 'rel . mem -> ('a, 'rel) mreference -> 'a -> mem = - fun m -> - fun r -> - fun v -> - let uu___ = ((get_hmap m), (get_rid_ctr m), ()) in - match uu___ with - | (h, rid_ctr, tip) -> - let i_h = FStar_Map.sel h () in - let i_h1 = FStar_Monotonic_Heap.upd_tot i_h (as_ref r) v in - let h1 = FStar_Map.upd h () i_h1 in mk_mem rid_ctr h1 () -let sel_tot : 'a 'rel . mem -> ('a, 'rel) mreference -> 'a = - fun m -> - fun r -> - FStar_Monotonic_Heap.sel_tot (FStar_Map.sel (get_hmap m) ()) (as_ref r) -type ('m0, 'm1) fresh_frame = unit -let (hs_push_frame : mem -> mem) = - fun m -> - let uu___ = ((get_hmap m), (get_rid_ctr m), ()) in - match uu___ with - | (h, rid_ctr, tip) -> - let h1 = FStar_Map.upd h () FStar_Monotonic_Heap.emp in - mk_mem (rid_ctr + Prims.int_one) h1 () -let (new_eternal_region : - mem -> unit -> Prims.int FStar_Pervasives_Native.option -> (unit * mem)) = - fun m -> - fun parent -> - fun c -> - let uu___ = ((get_hmap m), (get_rid_ctr m), ()) in - match uu___ with - | (h, rid_ctr, tip) -> - let h1 = FStar_Map.upd h () FStar_Monotonic_Heap.emp in - ((), (mk_mem (rid_ctr + Prims.int_one) h1 ())) -let (new_freeable_heap_region : mem -> unit -> (unit * mem)) = - fun m -> - fun parent -> - let uu___ = ((get_hmap m), (get_rid_ctr m), ()) in - match uu___ with - | (h, rid_ctr, tip) -> - let h1 = FStar_Map.upd h () FStar_Monotonic_Heap.emp in - ((), (mk_mem (rid_ctr + Prims.int_one) h1 ())) -let (free_heap_region : mem -> unit -> mem) = - fun m0 -> - fun r -> - let uu___ = ((get_hmap m0), (get_rid_ctr m0)) in - match uu___ with - | (h0, rid_ctr0) -> - let dom = remove_elt (FStar_Map.domain h0) () in - let h1 = FStar_Map.restrict dom h0 in mk_mem (get_rid_ctr m0) h1 () -type ('s, 'm0, 'm1) modifies = unit -type ('s, 'm0, 'm1) modifies_transitively = unit -type 'm0 heap_only = unit -let (top_frame : mem -> FStar_Monotonic_Heap.heap) = - fun m -> FStar_Map.sel (get_hmap m) () -type ('id, 'h0, 'h1) modifies_one = unit -type ('id, 's, 'h0, 'h1) modifies_ref = unit -type some_ref = - | Ref of unit * unit * (Obj.t, Obj.t) mreference -let (uu___is_Ref : some_ref -> Prims.bool) = fun projectee -> true -let (__proj__Ref__item___2 : some_ref -> (unit, unit) mreference) = - fun uu___ -> - (fun projectee -> match projectee with | Ref (a, rel, _2) -> Obj.magic _2) - uu___ -type some_refs = some_ref Prims.list -let rec (regions_of_some_refs : some_refs -> unit FStar_Set.set) = - fun rs -> - match rs with - | [] -> FStar_Set.empty () - | (Ref (uu___, uu___1, r))::tl -> - FStar_Set.union (FStar_Set.singleton ()) (regions_of_some_refs tl) -type ('i, 'rs, 'h0, 'h1) modifies_some_refs = Obj.t -let (norm_steps : FStar_Pervasives.norm_step Prims.list) = - [FStar_Pervasives.iota; - FStar_Pervasives.zeta; - FStar_Pervasives.delta; - FStar_Pervasives.delta_only - ["FStar.Monotonic.HyperStack.regions_of_some_refs"; - "FStar.Monotonic.HyperStack.refs_in_region"; - "FStar.Monotonic.HyperStack.modifies_some_refs"]; - FStar_Pervasives.primops] -type ('rs, 'h0, 'h1) mods = unit -type aref = - | ARef of unit * FStar_Monotonic_Heap.aref -let (uu___is_ARef : aref -> Prims.bool) = fun projectee -> true - -let (__proj__ARef__item__aref_aref : aref -> FStar_Monotonic_Heap.aref) = - fun projectee -> - match projectee with | ARef (aref_region, aref_aref) -> aref_aref -let (dummy_aref : aref) = ARef ((), FStar_Monotonic_Heap.dummy_aref) -let aref_of : 'uuuuu 'uuuuu1 . ('uuuuu, 'uuuuu1) mreference -> aref = - fun r -> ARef ((), (FStar_Monotonic_Heap.aref_of (as_ref r))) -type ('a, 'h) aref_unused_in = unit -type ('h, 'a, 'v, 'rel) aref_live_at = unit -let (reference_of : mem -> aref -> unit -> unit -> (Obj.t, Obj.t) mreference) - = - fun h -> - fun a -> - fun v -> - fun rel -> - MkRef - ((), - (FStar_Monotonic_Heap.ref_of - (FStar_Map.sel (__proj__HS__item__h h) ()) - (__proj__ARef__item__aref_aref a) () ())) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Monotonic_Map.ml b/stage0/fstar-lib/generated/FStar_Monotonic_Map.ml deleted file mode 100644 index 3e920ce17eb..00000000000 --- a/stage0/fstar-lib/generated/FStar_Monotonic_Map.ml +++ /dev/null @@ -1,60 +0,0 @@ -open Prims -type ('a, 'b) map' = 'a -> 'b FStar_Pervasives_Native.option -type ('a, 'b, 'inv) map = ('a, 'b) map' -let upd : 'a 'b . ('a, 'b) map' -> 'a -> 'b -> ('a, 'b) map' = - fun m -> - fun x -> - fun y -> fun z -> if x = z then FStar_Pervasives_Native.Some y else m z -let sel : 'a 'b . ('a, 'b) map' -> 'a -> 'b FStar_Pervasives_Native.option = - fun m -> fun x -> m x -type ('a, 'b, 'inv, 'm1, 'm2) grows_aux = unit -type ('a, 'b, 'inv, 'uuuuu, 'uuuuu1) grows = unit -type ('r, 'a, 'b, 'inv) t = - (unit, ('a, 'b, 'inv) map, unit) FStar_HyperStack_ST.m_rref -let empty_map : 'a 'b . ('a, 'b) map' = fun x -> FStar_Pervasives_Native.None -type rid = unit -let (alloc : unit -> unit -> unit -> unit -> (unit, Obj.t, Obj.t, Obj.t) t) = - fun r -> - fun a -> fun b -> fun inv -> FStar_HyperStack_ST.ralloc () empty_map -type ('r, 'a, 'b, 'inv, 'm, 'x, 'h) defined = unit -type ('r, 'a, 'b, 'inv, 'm, 'x, 'y, 'h) contains = unit -type ('r, 'a, 'b, 'inv, 'm, 'x, 'h) fresh = unit -let (extend : - unit -> - unit -> - unit -> unit -> (unit, Obj.t, Obj.t, Obj.t) t -> Obj.t -> Obj.t -> unit) - = - fun r -> - fun a -> - fun b -> - fun inv -> - fun m -> - fun x -> - fun y -> - FStar_HyperStack_ST.recall m; - (let cur = FStar_HyperStack_ST.op_Bang m in - FStar_HyperStack_ST.op_Colon_Equals m (upd cur x y); - FStar_HyperStack_ST.mr_witness () () () (Obj.magic m) (); - FStar_HyperStack_ST.mr_witness () () () (Obj.magic m) ()) -let (lookup : - unit -> - unit -> - unit -> - unit -> - (unit, Obj.t, Obj.t, Obj.t) t -> - Obj.t -> Obj.t FStar_Pervasives_Native.option) - = - fun r -> - fun a -> - fun b -> - fun inv -> - fun m -> - fun x -> - let y = - let uu___ = FStar_HyperStack_ST.op_Bang m in sel uu___ x in - match y with - | FStar_Pervasives_Native.None -> y - | FStar_Pervasives_Native.Some b1 -> - (FStar_HyperStack_ST.mr_witness () () () (Obj.magic m) (); - FStar_HyperStack_ST.mr_witness () () () (Obj.magic m) (); - y) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Monotonic_Seq.ml b/stage0/fstar-lib/generated/FStar_Monotonic_Seq.ml deleted file mode 100644 index 0a74422fc2d..00000000000 --- a/stage0/fstar-lib/generated/FStar_Monotonic_Seq.ml +++ /dev/null @@ -1,164 +0,0 @@ -open Prims -type ('a, 's1, 's2) grows_aux = unit -type ('a, 'uuuuu, 'uuuuu1) grows = unit -type rid = unit -let snoc : 'a . 'a FStar_Seq_Base.seq -> 'a -> 'a FStar_Seq_Base.seq = - fun s -> - fun x -> FStar_Seq_Base.append s (FStar_Seq_Base.create Prims.int_one x) -let alloc_mref_seq : - 'a . - unit -> - 'a FStar_Seq_Base.seq -> - (unit, 'a FStar_Seq_Base.seq, ('a, unit, unit) grows) - FStar_HyperStack_ST.m_rref - = fun r -> fun init -> FStar_HyperStack_ST.ralloc () init -type ('a, 'i, 'n, 'x, 'r, 'h) at_least = unit -let write_at_end : - 'a . - unit -> - (unit, 'a FStar_Seq_Base.seq, ('a, unit, unit) grows) - FStar_HyperStack_ST.m_rref -> 'a -> unit - = - fun i -> - fun r -> - fun x -> - FStar_HyperStack_ST.recall r; - (let s0 = FStar_HyperStack_ST.op_Bang r in - let n = FStar_Seq_Base.length s0 in - FStar_HyperStack_ST.op_Colon_Equals r - (FStar_Seq_Properties.snoc s0 x); - FStar_HyperStack_ST.mr_witness () () () (Obj.magic r) ()) -type ('a, 'p, 's1, 's2) grows_p = unit -type ('r, 'a, 'p) i_seq = - (unit, 'a FStar_Seq_Base.seq, unit) FStar_HyperStack_ST.m_rref -let alloc_mref_iseq : - 'a 'p . unit -> 'a FStar_Seq_Base.seq -> (unit, 'a, 'p) i_seq = - fun r -> fun init -> FStar_HyperStack_ST.ralloc () init -type ('r, 'a, 'p, 'n, 'x, 'm, 'h) i_at_least = unit -type ('r, 'a, 'p, 'x, 'is, 'h) int_at_most = unit -let i_read : 'a 'p . unit -> (unit, 'a, 'p) i_seq -> 'a FStar_Seq_Base.seq = - fun r -> fun m -> FStar_HyperStack_ST.op_Bang m -type ('r, 'a, 'p, 'm, 'h) i_contains = unit -let i_write_at_end : 'a 'p . unit -> (unit, 'a, 'p) i_seq -> 'a -> unit = - fun rgn -> - fun r -> - fun x -> - FStar_HyperStack_ST.recall r; - (let s0 = FStar_HyperStack_ST.op_Bang r in - let n = FStar_Seq_Base.length s0 in - FStar_HyperStack_ST.op_Colon_Equals r - (FStar_Seq_Properties.snoc s0 x); - FStar_HyperStack_ST.mr_witness () () () (Obj.magic r) ()) -type 's invariant = unit -let (test0 : - unit -> - (unit, Prims.nat FStar_Seq_Base.seq, (Prims.nat, unit, unit) grows) - FStar_HyperStack_ST.m_rref -> Prims.nat -> unit) - = - fun r -> - fun a -> - fun k -> - let h0 = FStar_HyperStack_ST.get () in - FStar_HyperStack_ST.mr_witness () () () (Obj.magic a) () -let (itest : - unit -> (unit, Prims.nat, unit invariant) i_seq -> Prims.nat -> unit) = - fun r -> - fun a -> - fun k -> - let h0 = FStar_HyperStack_ST.get () in - FStar_HyperStack_ST.mr_witness () () () (Obj.magic a) () -let un_snoc : 'a . 'a FStar_Seq_Base.seq -> ('a FStar_Seq_Base.seq * 'a) = - fun s -> - let last = (FStar_Seq_Base.length s) - Prims.int_one in - ((FStar_Seq_Base.slice s Prims.int_zero last), - (FStar_Seq_Base.index s last)) -let rec map : - 'a 'b . ('a -> 'b) -> 'a FStar_Seq_Base.seq -> 'b FStar_Seq_Base.seq = - fun f -> - fun s -> - if (FStar_Seq_Base.length s) = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let uu___1 = un_snoc s in - match uu___1 with - | (prefix, last) -> - FStar_Seq_Properties.snoc (map f prefix) (f last)) -let op_At : - 'uuuuu . - 'uuuuu FStar_Seq_Base.seq -> - 'uuuuu FStar_Seq_Base.seq -> 'uuuuu FStar_Seq_Base.seq - = fun s1 -> fun s2 -> FStar_Seq_Base.append s1 s2 -type ('a, 'b, 'i, 'r, 'f, 'bs, 'h) map_prefix = unit -type ('a, 'b, 'i, 'r, 'f, 'n, 'v, 'h) map_has_at_index = unit -let rec collect : - 'a 'b . - ('a -> 'b FStar_Seq_Base.seq) -> - 'a FStar_Seq_Base.seq -> 'b FStar_Seq_Base.seq - = - fun f -> - fun s -> - if (FStar_Seq_Base.length s) = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let uu___1 = un_snoc s in - match uu___1 with - | (prefix, last) -> - FStar_Seq_Base.append (collect f prefix) (f last)) -type ('a, 'b, 'i, 'r, 'f, 'bs, 'h) collect_prefix = unit -type ('a, 'b, 'i, 'r, 'f, 'n, 'v, 'h) collect_has_at_index = unit -type ('i, 'a) log_t = - (unit, 'a FStar_Seq_Base.seq, unit) FStar_HyperStack_ST.m_rref -type ('x, 'y) increases = unit -type ('l, 'a, 'x, 'log, 'h) at_most_log_len = unit -type ('l, 'a, 'i, 'log, 'max) seqn_val = Prims.nat -type ('l, 'a, 'i, 'log, 'max) seqn = - (unit, (unit, 'a, unit, unit, unit) seqn_val, unit) - FStar_HyperStack_ST.m_rref -let new_seqn : - 'a . - unit -> - Prims.nat -> - unit -> - Prims.nat -> (unit, 'a) log_t -> (unit, 'a, unit, unit, unit) seqn - = - fun l -> - fun max -> - fun i -> - fun init -> - fun log -> - FStar_HyperStack_ST.recall log; - FStar_HyperStack_ST.recall_region (); - FStar_HyperStack_ST.mr_witness () () () (Obj.magic log) (); - FStar_HyperStack_ST.ralloc () init -let increment_seqn : - 'a . - unit -> - Prims.nat -> - unit -> (unit, 'a) log_t -> (unit, 'a, unit, unit, unit) seqn -> unit - = - fun l -> - fun max -> - fun i -> - fun log -> - fun c -> - FStar_HyperStack_ST.recall c; - FStar_HyperStack_ST.recall log; - (let n = - let uu___2 = FStar_HyperStack_ST.op_Bang c in - uu___2 + Prims.int_one in - FStar_HyperStack_ST.mr_witness () () () (Obj.magic log) (); - FStar_HyperStack_ST.op_Colon_Equals c n) -let testify_seqn : - 'a . - unit -> - unit -> - (unit, 'a) log_t -> - Prims.nat -> (unit, 'a, unit, unit, unit) seqn -> unit - = - fun i -> - fun l -> - fun log -> - fun max -> - fun ctr -> - let n = FStar_HyperStack_ST.op_Bang ctr in - FStar_HyperStack_ST.testify () \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_OrdMap.ml b/stage0/fstar-lib/generated/FStar_OrdMap.ml deleted file mode 100644 index 62fdd5a8d88..00000000000 --- a/stage0/fstar-lib/generated/FStar_OrdMap.ml +++ /dev/null @@ -1,114 +0,0 @@ -open Prims -type ('a, 'f) total_order = unit -type 'a cmp = 'a -> 'a -> Prims.bool -type ('k, 'v, 'f, 'd) map_t = - ('k, 'v FStar_Pervasives_Native.option) - FStar_FunctionalExtensionality.restricted_t -type ('k, 'v, 'f) ordmap = - | Mk_map of ('k, unit) FStar_OrdSet.ordset * ('k, 'v, unit, unit) map_t -let uu___is_Mk_map : - 'k 'v . 'k FStar_OrdSet.cmp -> ('k, 'v, unit) ordmap -> Prims.bool = - fun f -> fun projectee -> true -let __proj__Mk_map__item__d : - 'k 'v . - 'k FStar_OrdSet.cmp -> - ('k, 'v, unit) ordmap -> ('k, unit) FStar_OrdSet.ordset - = fun f -> fun projectee -> match projectee with | Mk_map (d, m) -> d -let __proj__Mk_map__item__m : - 'k 'v . - 'k FStar_OrdSet.cmp -> - ('k, 'v, unit) ordmap -> ('k, 'v, unit, unit) map_t - = fun f -> fun projectee -> match projectee with | Mk_map (d, m) -> m -let empty : 'k 'v . 'k FStar_OrdSet.cmp -> ('k, 'v, unit) ordmap = - fun f -> - let d = FStar_OrdSet.empty f in - let g = - FStar_FunctionalExtensionality.on_domain - (fun x -> FStar_Pervasives_Native.None) in - Mk_map (d, g) -let const_on : - 'k 'v . - 'k FStar_OrdSet.cmp -> - ('k, unit) FStar_OrdSet.ordset -> 'v -> ('k, 'v, unit) ordmap - = - fun f -> - fun d -> - fun x -> - let g = - FStar_FunctionalExtensionality.on_domain - (fun y -> - if FStar_OrdSet.mem f y d - then FStar_Pervasives_Native.Some x - else FStar_Pervasives_Native.None) in - Mk_map (d, g) -let select : - 'k 'v . - 'k FStar_OrdSet.cmp -> - 'k -> ('k, 'v, unit) ordmap -> 'v FStar_Pervasives_Native.option - = fun f -> fun x -> fun m -> __proj__Mk_map__item__m f m x -let insert : - 'a . - 'a FStar_OrdSet.cmp -> - 'a -> ('a, unit) FStar_OrdSet.ordset -> ('a, unit) FStar_OrdSet.ordset - = - fun f -> - fun x -> fun s -> FStar_OrdSet.union f (FStar_OrdSet.singleton f x) s -let update : - 'k 'v . - 'k FStar_OrdSet.cmp -> - 'k -> 'v -> ('k, 'v, unit) ordmap -> ('k, 'v, unit) ordmap - = - fun f -> - fun x -> - fun y -> - fun m -> - let s' = insert f x (__proj__Mk_map__item__d f m) in - let g' = - FStar_FunctionalExtensionality.on_domain - (fun x' -> - if x' = x - then FStar_Pervasives_Native.Some y - else __proj__Mk_map__item__m f m x') in - Mk_map (s', g') -let contains : - 'k 'v . 'k FStar_OrdSet.cmp -> 'k -> ('k, 'v, unit) ordmap -> Prims.bool = - fun f -> - fun x -> fun m -> FStar_OrdSet.mem f x (__proj__Mk_map__item__d f m) -let dom : - 'k 'v . - 'k FStar_OrdSet.cmp -> - ('k, 'v, unit) ordmap -> ('k, unit) FStar_OrdSet.ordset - = fun f -> fun m -> __proj__Mk_map__item__d f m -let remove : - 'k 'v . - 'k FStar_OrdSet.cmp -> - 'k -> ('k, 'v, unit) ordmap -> ('k, 'v, unit) ordmap - = - fun f -> - fun x -> - fun m -> - let s' = FStar_OrdSet.remove f x (__proj__Mk_map__item__d f m) in - let g' = - FStar_FunctionalExtensionality.on_domain - (fun x' -> - if x' = x - then FStar_Pervasives_Native.None - else __proj__Mk_map__item__m f m x') in - Mk_map (s', g') -let choose : - 'k 'v . - 'k FStar_OrdSet.cmp -> - ('k, 'v, unit) ordmap -> ('k * 'v) FStar_Pervasives_Native.option - = - fun f -> - fun m -> - match FStar_OrdSet.choose f (__proj__Mk_map__item__d f m) with - | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some x -> - FStar_Pervasives_Native.Some - (x, - (FStar_Pervasives_Native.__proj__Some__item__v - (__proj__Mk_map__item__m f m x))) -let size : 'k 'v . 'k FStar_OrdSet.cmp -> ('k, 'v, unit) ordmap -> Prims.nat - = fun f -> fun m -> FStar_OrdSet.size f (__proj__Mk_map__item__d f m) -type ('k, 'v, 'f, 'm1, 'm2) equal = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_OrdMapProps.ml b/stage0/fstar-lib/generated/FStar_OrdMapProps.ml deleted file mode 100644 index 88a02402dbd..00000000000 --- a/stage0/fstar-lib/generated/FStar_OrdMapProps.ml +++ /dev/null @@ -1,18 +0,0 @@ -open Prims -let rec fold : - 'k 'v 't . - 'k FStar_OrdMap.cmp -> - ('k -> 'v -> 't -> 't) -> - ('k, 'v, unit) FStar_OrdMap.ordmap -> 't -> 't - = - fun f -> - fun g -> - fun m -> - fun a -> - if (FStar_OrdMap.size f m) = Prims.int_zero - then a - else - (let uu___1 = FStar_OrdMap.choose f m in - match uu___1 with - | FStar_Pervasives_Native.Some (k1, v1) -> - fold f g (FStar_OrdMap.remove f k1 m) (g k1 v1 a)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_OrdSet.ml b/stage0/fstar-lib/generated/FStar_OrdSet.ml deleted file mode 100644 index ecfa4bf5294..00000000000 --- a/stage0/fstar-lib/generated/FStar_OrdSet.ml +++ /dev/null @@ -1,301 +0,0 @@ -open Prims -type ('a, 'f) total_order = unit -type 'a cmp = 'a -> 'a -> Prims.bool -let rec sorted : 'a . 'a cmp -> 'a Prims.list -> Prims.bool = - fun f -> - fun l -> - match l with - | [] -> true - | x::[] -> true - | x::y::tl -> ((f x y) && (x <> y)) && (sorted f (y :: tl)) -type ('a, 'f) ordset = 'a Prims.list -let empty : 'uuuuu . 'uuuuu cmp -> ('uuuuu, unit) ordset = fun uu___ -> [] -let tail : 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset = - fun f -> fun s -> Prims.__proj__Cons__item__tl s -let head : 'uuuuu . 'uuuuu cmp -> ('uuuuu, unit) ordset -> 'uuuuu = - fun uu___ -> fun s -> Prims.__proj__Cons__item__hd s -let mem : - 'uuuuu . 'uuuuu cmp -> 'uuuuu -> ('uuuuu, unit) ordset -> Prims.bool = - fun uu___ -> fun x -> fun s -> FStar_List_Tot_Base.mem x s -let mem_of : 'a . 'a cmp -> ('a, unit) ordset -> 'a -> Prims.bool = - fun f -> fun s -> fun x -> mem f x s -let rec last_direct : 'a . 'a cmp -> ('a, unit) ordset -> 'a = - fun f -> - fun s -> match s with | x::[] -> x | h::g::t -> last_direct f (tail f s) -let last_lib : 'a . 'a cmp -> ('a, unit) ordset -> 'a = - fun f -> - fun s -> FStar_Pervasives_Native.snd (FStar_List_Tot_Base.unsnoc s) -let last : 'a . 'a cmp -> ('a, unit) ordset -> 'a = - fun f -> fun s -> last_lib f s -let rec liat_direct : 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset = - fun f -> - fun s -> - match s with | x::[] -> [] | h::g::t -> h :: (liat_direct f (g :: t)) -let liat_lib : 'a . 'a cmp -> ('a, unit) ordset -> 'a Prims.list = - fun f -> - fun s -> FStar_Pervasives_Native.fst (FStar_List_Tot_Base.unsnoc s) -let liat : 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset = - fun f -> fun s -> liat_lib f s -let unsnoc : 'a . 'a cmp -> ('a, unit) ordset -> (('a, unit) ordset * 'a) = - fun f -> - fun s -> - let l = FStar_List_Tot_Base.unsnoc s in - ((FStar_Pervasives_Native.fst l), (FStar_Pervasives_Native.snd l)) -let as_list : 'a . 'a cmp -> ('a, unit) ordset -> 'a Prims.list = - fun f -> fun s -> s -let rec insert' : - 'uuuuu . - 'uuuuu cmp -> 'uuuuu -> ('uuuuu, unit) ordset -> ('uuuuu, unit) ordset - = - fun f -> - fun x -> - fun s -> - match s with - | [] -> [x] - | hd::tl -> - if x = hd - then hd :: tl - else if f x hd then x :: hd :: tl else hd :: (insert' f x tl) -let rec distinct' : 'a . 'a cmp -> 'a Prims.list -> ('a, unit) ordset = - fun f -> - fun l -> match l with | [] -> [] | x::t -> insert' f x (distinct' f t) -let distinct : 'a . 'a cmp -> 'a Prims.list -> ('a, unit) ordset = - fun f -> fun l -> distinct' f l -let rec union : - 'uuuuu . - 'uuuuu cmp -> - ('uuuuu, unit) ordset -> ('uuuuu, unit) ordset -> ('uuuuu, unit) ordset - = - fun uu___ -> - fun s1 -> - fun s2 -> - match s1 with - | [] -> s2 - | hd::tl -> union uu___ tl (insert' uu___ hd s2) -let rec remove' : 'a . 'a cmp -> 'a -> ('a, unit) ordset -> ('a, unit) ordset - = - fun f -> - fun x -> - fun s -> - match s with - | [] -> [] - | hd::tl -> - let tl1 = tl in if x = hd then tl1 else hd :: (remove' f x tl1) -let size' : 'a . 'a cmp -> ('a, unit) ordset -> Prims.nat = - fun f -> fun s -> FStar_List_Tot_Base.length s -let rec subset' : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> Prims.bool = - fun f -> - fun s1 -> - fun s2 -> - match (s1, s2) with - | ([], uu___) -> true - | (hd::tl, hd'::tl') -> - if (f hd hd') && (hd = hd') - then subset' f tl tl' - else - if (f hd hd') && (Prims.op_Negation (hd = hd')) - then false - else subset' f s1 tl' - | (uu___, uu___1) -> false -let rec remove_until_greater_than : - 'a . 'a cmp -> 'a -> ('a, unit) ordset -> (('a, unit) ordset * Prims.bool) - = - fun f -> - fun x -> - fun s -> - match s with - | [] -> ([], false) - | h::t -> - let t1 = t in - if h = x - then (t1, true) - else - if f x h then (s, false) else remove_until_greater_than f x t1 -let rec smart_intersect : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> ('a, unit) ordset - = - fun f -> - fun s1 -> - fun s2 -> - match s1 with - | [] -> [] - | h1::t1 -> - let t11 = t1 in - (match s2 with - | [] -> [] - | h2::t2 -> - let t21 = t2 in - if h1 = h2 - then h1 :: (smart_intersect f t11 t21) - else - if f h1 h2 - then - (let uu___1 = remove_until_greater_than f h2 t11 in - match uu___1 with - | (skip1, found) -> - let subresult = smart_intersect f skip1 t21 in - if found then h2 :: subresult else subresult) - else - (let uu___2 = remove_until_greater_than f h1 t21 in - match uu___2 with - | (skip2, found) -> - let subresult = smart_intersect f t11 skip2 in - if found then h1 :: subresult else subresult)) -let intersect : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> ('a, unit) ordset - = fun f -> fun s1 -> fun s2 -> smart_intersect f s1 s2 -let choose : - 'a . 'a cmp -> ('a, unit) ordset -> 'a FStar_Pervasives_Native.option = - fun f -> - fun s -> - match s with - | [] -> FStar_Pervasives_Native.None - | x::uu___ -> FStar_Pervasives_Native.Some x -let remove : 'a . 'a cmp -> 'a -> ('a, unit) ordset -> ('a, unit) ordset = - fun f -> fun x -> fun s -> remove' f x s -let size : 'a . 'a cmp -> ('a, unit) ordset -> Prims.nat = - fun f -> fun s -> size' f s -let subset : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> Prims.bool = - fun f -> fun s1 -> fun s2 -> subset' f s1 s2 -let superset : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> Prims.bool = - fun f -> fun s1 -> fun s2 -> subset f s2 s1 -let singleton : 'a . 'a cmp -> 'a -> ('a, unit) ordset = - fun f -> fun x -> [x] -let rec smart_minus : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> ('a, unit) ordset - = - fun f -> - fun p -> - fun q -> - match p with - | [] -> [] - | ph::pt -> - let pt1 = pt in - (match q with - | [] -> p - | qh::qt -> - let qt1 = qt in - let uu___ = remove_until_greater_than f ph q in - (match uu___ with - | (q_after_ph, found) -> - if found - then - let result = smart_minus f pt1 q_after_ph in result - else ph :: (smart_minus f pt1 q_after_ph))) -let (ncmp : Prims.nat -> Prims.nat -> Prims.bool) = fun x -> fun y -> x <= y -let minus : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> ('a, unit) ordset - = fun f -> fun s1 -> fun s2 -> smart_minus f s1 s2 -let strict_subset : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> Prims.bool = - fun f -> fun s1 -> fun s2 -> (s1 <> s2) && (subset f s1 s2) -let strict_superset : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> Prims.bool = - fun f -> fun s1 -> fun s2 -> strict_subset f s2 s1 -let disjoint : - 'a . 'a cmp -> ('a, unit) ordset -> ('a, unit) ordset -> Prims.bool = - fun f -> fun s1 -> fun s2 -> (intersect f s1 s2) = (empty f) -type ('a, 'f, 's1, 's2) equal = unit -let fold : - 'a 'acc . - 'a cmp -> ('acc -> 'a -> 'acc) -> 'acc -> ('a, unit) ordset -> 'acc - = - fun f -> - fun g -> fun init -> fun s -> FStar_List_Tot_Base.fold_left g init s -let rec map_internal : - 'a 'b . - 'a cmp -> 'b cmp -> ('a -> 'b) -> ('a, unit) ordset -> ('b, unit) ordset - = - fun fa -> - fun fb -> - fun g -> - fun sa -> - match sa with - | [] -> [] - | x::xs -> - let y = g x in - let ys = map_internal fa fb g xs in - if - (Prims.op_Negation (Prims.uu___is_Cons ys)) || - ((Prims.__proj__Cons__item__hd ys) <> y) - then y :: ys - else ys -let map : - 'a 'b . - 'a cmp -> 'b cmp -> ('a -> 'b) -> ('a, unit) ordset -> ('b, unit) ordset - = fun fa -> fun fb -> fun g -> fun sa -> map_internal fa fb g sa -type 'a condition = 'a -> Prims.bool -let inv : 'a . 'a condition -> 'a condition = - fun c -> fun x -> Prims.op_Negation (c x) -let rec count : 'a . 'a cmp -> ('a, unit) ordset -> 'a condition -> Prims.nat - = - fun f -> - fun s -> - fun c -> - match s with - | [] -> Prims.int_zero - | h::t -> if c h then Prims.int_one + (count f t c) else count f t c -let rec all : 'a . 'a cmp -> ('a, unit) ordset -> 'a condition -> Prims.bool - = - fun f -> - fun s -> - fun c -> match s with | [] -> true | h::t -> (c h) && (all f t c) -let rec any : 'a . 'a cmp -> ('a, unit) ordset -> 'a condition -> Prims.bool - = - fun f -> - fun s -> - fun c -> match s with | [] -> false | h::t -> (c h) || (any f t c) -let rec find_first : - 'a . - 'a cmp -> - ('a, unit) ordset -> 'a condition -> 'a FStar_Pervasives_Native.option - = - fun f -> - fun s -> - fun c -> - match s with - | [] -> FStar_Pervasives_Native.None - | h::t -> - let t1 = t in - if c h then FStar_Pervasives_Native.Some h else find_first f t1 c -let rec find_last' : - 'a . - 'a cmp -> - ('a, unit) ordset -> 'a condition -> 'a FStar_Pervasives_Native.option - = - fun f -> - fun s -> - fun c -> - if s = (empty f) - then FStar_Pervasives_Native.None - else - (let uu___1 = unsnoc f s in - match uu___1 with - | (liat1, last1) -> - if c last1 - then FStar_Pervasives_Native.Some last1 - else find_last' f liat1 c) -let find_last : - 'a . - 'a cmp -> - ('a, unit) ordset -> 'a condition -> 'a FStar_Pervasives_Native.option - = fun f -> fun s -> fun c -> find_last' f s c -let rec where : - 'a . 'a cmp -> ('a, unit) ordset -> 'a condition -> ('a, unit) ordset = - fun f -> - fun s -> - fun c -> - match s with - | [] -> [] - | h::[] -> if c h then [h] else [] - | h::t -> - let t1 = t in if c h then h :: (where f t1 c) else where f t1 c -let rec as_set : 'a . 'a cmp -> ('a, unit) ordset -> 'a FStar_Set.set = - fun f -> - fun s -> - match s with - | [] -> FStar_Set.empty () - | hd::tl -> FStar_Set.union (FStar_Set.singleton hd) (as_set f tl) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_OrdSetProps.ml b/stage0/fstar-lib/generated/FStar_OrdSetProps.ml deleted file mode 100644 index f1e4f79f279..00000000000 --- a/stage0/fstar-lib/generated/FStar_OrdSetProps.ml +++ /dev/null @@ -1,32 +0,0 @@ -open Prims -let rec fold : - 'a 'b . - 'a FStar_OrdSet.cmp -> - ('a -> 'b -> 'b) -> ('a, unit) FStar_OrdSet.ordset -> 'b -> 'b - = - fun f -> - fun g -> - fun s -> - fun x -> - if s = (FStar_OrdSet.empty f) - then x - else - (let uu___1 = FStar_OrdSet.choose f s in - match uu___1 with - | FStar_Pervasives_Native.Some e -> - let a_rest = fold f g (FStar_OrdSet.remove f e s) x in - g e a_rest) -let insert : - 'a . - 'a FStar_OrdSet.cmp -> - 'a -> ('a, unit) FStar_OrdSet.ordset -> ('a, unit) FStar_OrdSet.ordset - = - fun f -> - fun x -> fun s -> FStar_OrdSet.union f (FStar_OrdSet.singleton f x) s -let union' : - 'a . - 'a FStar_OrdSet.cmp -> - ('a, unit) FStar_OrdSet.ordset -> - ('a, unit) FStar_OrdSet.ordset -> ('a, unit) FStar_OrdSet.ordset - = - fun f -> fun s1 -> fun s2 -> fold f (fun e -> fun s -> insert f e s) s1 s2 \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_PCM.ml b/stage0/fstar-lib/generated/FStar_PCM.ml deleted file mode 100644 index 737e6694a0c..00000000000 --- a/stage0/fstar-lib/generated/FStar_PCM.ml +++ /dev/null @@ -1,65 +0,0 @@ -open Prims -type 'a symrel = unit -type 'a pcm' = { - composable: unit ; - op: 'a -> 'a -> 'a ; - one: 'a } -let __proj__Mkpcm'__item__op : 'a . 'a pcm' -> 'a -> 'a -> 'a = - fun projectee -> match projectee with | { composable; op; one;_} -> op -let __proj__Mkpcm'__item__one : 'a . 'a pcm' -> 'a = - fun projectee -> match projectee with | { composable; op; one;_} -> one -type ('a, 'p) lem_commutative = unit -type ('a, 'p) lem_assoc_l = unit -type ('a, 'p) lem_assoc_r = unit -type ('a, 'p) lem_is_unit = unit -type 'a pcm = - { - p: 'a pcm' ; - comm: unit ; - assoc: unit ; - assoc_r: unit ; - is_unit: unit ; - refine: unit } -let __proj__Mkpcm__item__p : 'a . 'a pcm -> 'a pcm' = - fun projectee -> - match projectee with | { p; comm; assoc; assoc_r; is_unit; refine;_} -> p - - - - -type ('a, 'p, 'x, 'y) composable = Obj.t -let op : 'a . 'a pcm -> 'a -> 'a -> 'a = - fun p -> fun x -> fun y -> (p.p).op x y -type ('a, 'pcm1, 'x, 'y) compatible = unit -type ('a, 'p, 'x, 'y) joinable = unit -type ('a, 'p, 'x, 'v, 'y) frame_compatible = unit -type ('a, 'p, 'x, 'y) frame_preserving_upd = 'a -> 'a -type ('a, 'pcm1, 'x, 'y) frame_preserving = unit -let frame_preserving_val_to_fp_upd : - 'a . 'a pcm -> unit -> 'a -> ('a, unit, unit, unit) frame_preserving_upd = - fun p -> fun x -> fun v -> fun uu___ -> v -type ('a, 'p, 'x) exclusive = unit -let no_op_is_frame_preserving : - 'a . 'a pcm -> 'a -> ('a, unit, unit, unit) frame_preserving_upd = - fun p -> fun x -> fun v -> v -let compose_frame_preserving_updates : - 'a . - 'a pcm -> - 'a -> - 'a -> - 'a -> - ('a, unit, unit, unit) frame_preserving_upd -> - ('a, unit, unit, unit) frame_preserving_upd -> - ('a, unit, unit, unit) frame_preserving_upd - = fun p -> fun x -> fun y -> fun z -> fun f -> fun g -> fun v -> g (f v) -let frame_preserving_subframe : - 'a . - 'a pcm -> - 'a -> - 'a -> - 'a -> - ('a, unit, unit, unit) frame_preserving_upd -> - ('a, unit, unit, unit) frame_preserving_upd - = - fun p -> - fun x -> fun y -> fun subframe -> fun f -> fun v -> let w = f v in w \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Parse.ml b/stage0/fstar-lib/generated/FStar_Parse.ml deleted file mode 100644 index 453f055e90a..00000000000 --- a/stage0/fstar-lib/generated/FStar_Parse.ml +++ /dev/null @@ -1,7 +0,0 @@ -open Prims -let (bool_of_string : - Prims.string -> Prims.bool FStar_Pervasives_Native.option) = - fun uu___ -> failwith "Not yet implemented: FStar.Parse.bool_of_string" -let (int_of_string : - Prims.string -> Prims.int FStar_Pervasives_Native.option) = - fun uu___ -> failwith "Not yet implemented: FStar.Parse.int_of_string" \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_PartialMap.ml b/stage0/fstar-lib/generated/FStar_PartialMap.ml deleted file mode 100644 index e874ba53c4e..00000000000 --- a/stage0/fstar-lib/generated/FStar_PartialMap.ml +++ /dev/null @@ -1,28 +0,0 @@ -open Prims -type ('k, 'v) t = - ('k, 'v FStar_Pervasives_Native.option) - FStar_FunctionalExtensionality.restricted_t -let empty : 'uuuuu 'uuuuu1 . unit -> ('uuuuu, 'uuuuu1) t = - fun uu___ -> - FStar_FunctionalExtensionality.on_domain - (fun uu___1 -> FStar_Pervasives_Native.None) -let literal : 'k 'v . ('k -> 'v FStar_Pervasives_Native.option) -> ('k, 'v) t - = fun f -> FStar_FunctionalExtensionality.on_domain (fun x -> f x) -let sel : 'k 'v . ('k, 'v) t -> 'k -> 'v FStar_Pervasives_Native.option = - fun m -> fun x -> m x -let upd : 'k 'v . ('k, 'v) t -> 'k -> 'v -> ('k, 'v) t = - fun m -> - fun x -> - fun y -> - FStar_FunctionalExtensionality.on_domain - (fun x1 -> if x1 = x then FStar_Pervasives_Native.Some y else m x1) -let remove : 'k 'v . ('k, 'v) t -> 'k -> ('k, 'v) t = - fun m -> - fun x -> - FStar_FunctionalExtensionality.on_domain - (fun x1 -> if x1 = x then FStar_Pervasives_Native.None else m x1) -let contains : 'k 'v . ('k, 'v) t -> 'k -> Prims.bool = - fun m -> fun x -> FStar_Pervasives_Native.uu___is_Some (sel m x) -let const : 'k 'v . 'v -> ('k, 'v) t = - fun y -> literal (fun x -> FStar_Pervasives_Native.Some y) -type ('k, 'v, 'm1, 'm2) equal = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_PropositionalExtensionality.ml b/stage0/fstar-lib/generated/FStar_PropositionalExtensionality.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_PropositionalExtensionality.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_PtrdiffT.ml b/stage0/fstar-lib/generated/FStar_PtrdiffT.ml deleted file mode 100644 index 45945e4417f..00000000000 --- a/stage0/fstar-lib/generated/FStar_PtrdiffT.ml +++ /dev/null @@ -1,19 +0,0 @@ -open Prims -type t = FStar_Int64.t -type 'x fits = unit -let (v : t -> Prims.int) = fun x -> FStar_Int64.v x -let (int_to_t : Prims.int -> t) = fun x -> FStar_Int64.int_to_t x -let (ptrdifft_to_sizet : t -> FStar_SizeT.t) = - fun x -> FStar_SizeT.Sz (FStar_Int_Cast.int64_to_uint64 x) -let (add : t -> t -> t) = fun x -> fun y -> FStar_Int64.add x y -let (div : t -> t -> t) = fun x -> fun y -> FStar_Int64.div x y -let (rem : t -> t -> t) = fun x -> fun y -> FStar_Int64.rem x y -let (gt : t -> t -> Prims.bool) = fun x -> fun y -> FStar_Int64.gt x y -let (gte : t -> t -> Prims.bool) = fun x -> fun y -> FStar_Int64.gte x y -let (lt : t -> t -> Prims.bool) = fun x -> fun y -> FStar_Int64.lt x y -let (lte : t -> t -> Prims.bool) = fun x -> fun y -> FStar_Int64.lte x y -let (op_Plus_Hat : t -> t -> t) = add -let (op_Greater_Hat : t -> t -> Prims.bool) = gt -let (op_Greater_Equals_Hat : t -> t -> Prims.bool) = gte -let (op_Less_Hat : t -> t -> Prims.bool) = lt -let (op_Less_Equals_Hat : t -> t -> Prims.bool) = lte \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Pure_BreakVC.ml b/stage0/fstar-lib/generated/FStar_Pure_BreakVC.ml deleted file mode 100644 index f87b83d85f5..00000000000 --- a/stage0/fstar-lib/generated/FStar_Pure_BreakVC.ml +++ /dev/null @@ -1,23 +0,0 @@ -open Prims -type 'p break_wp' = unit FStar_Pervasives.spinoff -let (post : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = - FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.delta_fully - ["FStar.Pure.BreakVC.mono_lem"; "FStar.Pure.BreakVC.break_wp'"]] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Pure.BreakVC.fsti" - (Prims.of_int (12)) (Prims.of_int (2)) (Prims.of_int (12)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Pure.BreakVC.fsti" - (Prims.of_int (13)) (Prims.of_int (2)) (Prims.of_int (13)) - (Prims.of_int (9))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> Obj.magic (FStar_Tactics_V2_Derived.trefl ())) uu___2) -type 'p break_wp = unit FStar_Pervasives.spinoff -type ('p, 'q) op_Equals_Equals_Greater_Greater = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Real_Old.ml b/stage0/fstar-lib/generated/FStar_Real_Old.ml deleted file mode 100644 index 364b9563deb..00000000000 --- a/stage0/fstar-lib/generated/FStar_Real_Old.ml +++ /dev/null @@ -1,6 +0,0 @@ -open Prims -type real = unit - - - - diff --git a/stage0/fstar-lib/generated/FStar_Ref.ml b/stage0/fstar-lib/generated/FStar_Ref.ml deleted file mode 100644 index 662a4eb82e7..00000000000 --- a/stage0/fstar-lib/generated/FStar_Ref.ml +++ /dev/null @@ -1,16 +0,0 @@ -open Prims -type ('a, 'h, 'r) contains = - ('a, unit, unit, unit) FStar_Monotonic_Heap.contains -type ('a, 'r, 'h) unused_in = - ('a, unit, unit, unit) FStar_Monotonic_Heap.unused_in -type ('a, 'r, 'h0, 'h1) fresh = unit -let recall : 'uuuuu . 'uuuuu FStar_ST.ref -> unit = - fun r -> FStar_ST.recall r -let alloc : 'uuuuu . 'uuuuu -> 'uuuuu FStar_ST.ref = - fun init -> FStar_ST.alloc init -let read : 'uuuuu . 'uuuuu FStar_ST.ref -> 'uuuuu = fun r -> FStar_ST.read r -let write : 'uuuuu . 'uuuuu FStar_ST.ref -> 'uuuuu -> unit = - fun r -> fun v -> FStar_ST.write r v -let op_Bang : 'uuuuu . 'uuuuu FStar_ST.ref -> 'uuuuu = fun r -> read r -let op_Colon_Equals : 'uuuuu . 'uuuuu FStar_ST.ref -> 'uuuuu -> unit = - fun r -> fun v -> write r v \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_RefinementExtensionality.ml b/stage0/fstar-lib/generated/FStar_RefinementExtensionality.ml deleted file mode 100644 index 868c3b1fd91..00000000000 --- a/stage0/fstar-lib/generated/FStar_RefinementExtensionality.ml +++ /dev/null @@ -1,5 +0,0 @@ -open Prims -type 'x ref1 = unit -type 'x ref2 = unit -type ty1 = Prims.int -type ty2 = Prims.int \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection.ml b/stage0/fstar-lib/generated/FStar_Reflection.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Reflection.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_Formula.ml b/stage0/fstar-lib/generated/FStar_Reflection_Formula.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Reflection_Formula.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_TermEq_Simple.ml b/stage0/fstar-lib/generated/FStar_Reflection_TermEq_Simple.ml deleted file mode 100644 index 5336054f1dd..00000000000 --- a/stage0/fstar-lib/generated/FStar_Reflection_TermEq_Simple.ml +++ /dev/null @@ -1,64 +0,0 @@ -open Prims -let (term_eq : - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) - = FStar_Reflection_TermEq.term_eq -let _ = - FStarC_Tactics_Native.register_plugin - "FStar.Reflection.TermEq.Simple.term_eq" (Prims.of_int (2)) - (fun _psc -> - fun cb -> - fun us -> - fun args -> - FStarC_Syntax_Embeddings.debug_wrap - "FStar.Reflection.TermEq.Simple.term_eq" - (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Reflection_V2_Embeddings.e_term - FStarC_Syntax_Embeddings.e_bool term_eq - (FStarC_Ident.lid_of_str - "FStar.Reflection.TermEq.Simple.term_eq") cb us) args)) - (fun cb -> - fun us -> - fun args -> - FStarC_Syntax_Embeddings.debug_wrap - "FStar.Reflection.TermEq.Simple.term_eq" - (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_term - FStarC_Reflection_V2_NBEEmbeddings.e_term - FStarC_TypeChecker_NBETerm.e_bool term_eq - (FStarC_Ident.lid_of_str - "FStar.Reflection.TermEq.Simple.term_eq") cb us) args)) -let (univ_eq : - FStarC_Reflection_Types.universe -> - FStarC_Reflection_Types.universe -> Prims.bool) - = FStar_Reflection_TermEq.univ_eq -let _ = - FStarC_Tactics_Native.register_plugin - "FStar.Reflection.TermEq.Simple.univ_eq" (Prims.of_int (2)) - (fun _psc -> - fun cb -> - fun us -> - fun args -> - FStarC_Syntax_Embeddings.debug_wrap - "FStar.Reflection.TermEq.Simple.univ_eq" - (fun _ -> - (FStarC_Syntax_Embeddings.arrow_as_prim_step_2 - FStarC_Reflection_V2_Embeddings.e_universe - FStarC_Reflection_V2_Embeddings.e_universe - FStarC_Syntax_Embeddings.e_bool univ_eq - (FStarC_Ident.lid_of_str - "FStar.Reflection.TermEq.Simple.univ_eq") cb us) args)) - (fun cb -> - fun us -> - fun args -> - FStarC_Syntax_Embeddings.debug_wrap - "FStar.Reflection.TermEq.Simple.univ_eq" - (fun _ -> - (FStarC_TypeChecker_NBETerm.arrow_as_prim_step_2 - FStarC_Reflection_V2_NBEEmbeddings.e_universe - FStarC_Reflection_V2_NBEEmbeddings.e_universe - FStarC_TypeChecker_NBETerm.e_bool univ_eq - (FStarC_Ident.lid_of_str - "FStar.Reflection.TermEq.Simple.univ_eq") cb us) args)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_Typing.ml b/stage0/fstar-lib/generated/FStar_Reflection_Typing.ml deleted file mode 100644 index ebc953b6738..00000000000 --- a/stage0/fstar-lib/generated/FStar_Reflection_Typing.ml +++ /dev/null @@ -1,1829 +0,0 @@ -open Prims -let rec fold_left_dec : 'a 'b . 'a -> 'b Prims.list -> ('a -> 'b -> 'a) -> 'a - = - fun acc -> - fun l -> - fun f -> - match l with | [] -> acc | x::xs -> fold_left_dec (f acc x) xs f -let rec map_dec : 'a 'b . 'a Prims.list -> ('a -> 'b) -> 'b Prims.list = - fun l -> - fun f -> match l with | [] -> [] | x::xs -> (f x) :: (map_dec xs f) -type ('a, 'b, 'f, 'xs, 'ys) zip2prop = Obj.t -let (lookup_bvar : - FStarC_Reflection_Types.env -> - Prims.int -> FStarC_Reflection_Types.term FStar_Pervasives_Native.option) - = fun e -> fun x -> Prims.magic () -let (lookup_fvar_uinst : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.fv -> - FStarC_Reflection_Types.universe Prims.list -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option) - = fun e -> fun x -> fun us -> Prims.magic () -let (lookup_fvar : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.fv -> - FStarC_Reflection_Types.term FStar_Pervasives_Native.option) - = fun e -> fun x -> lookup_fvar_uinst e x [] -type pp_name_t = (Prims.string, unit) FStar_Sealed_Inhabited.sealed -let (pp_name_default : pp_name_t) = FStar_Sealed_Inhabited.seal "x" "x" -let (seal_pp_name : Prims.string -> pp_name_t) = - fun x -> FStar_Sealed_Inhabited.seal "x" x -let (tun : FStarC_Reflection_Types.term) = - FStarC_Reflection_V2_Builtins.pack_ln FStarC_Reflection_V2_Data.Tv_Unknown -type sort_t = - (FStarC_Reflection_Types.term, unit) FStar_Sealed_Inhabited.sealed -let (sort_default : sort_t) = FStar_Sealed_Inhabited.seal tun tun -let (seal_sort : FStarC_Reflection_Types.term -> sort_t) = - fun x -> FStar_Sealed_Inhabited.seal tun x -let (mk_binder : - pp_name_t -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.aqualv -> FStarC_Reflection_Types.binder) - = - fun pp_name -> - fun ty -> - fun q -> - FStarC_Reflection_V2_Builtins.pack_binder - { - FStarC_Reflection_V2_Data.sort2 = ty; - FStarC_Reflection_V2_Data.qual = q; - FStarC_Reflection_V2_Data.attrs = []; - FStarC_Reflection_V2_Data.ppname2 = pp_name - } -let (mk_simple_binder : - pp_name_t -> - FStarC_Reflection_Types.term -> FStarC_Reflection_V2_Data.simple_binder) - = - fun pp_name -> - fun ty -> - FStarC_Reflection_V2_Builtins.pack_binder - { - FStarC_Reflection_V2_Data.sort2 = ty; - FStarC_Reflection_V2_Data.qual = - FStarC_Reflection_V2_Data.Q_Explicit; - FStarC_Reflection_V2_Data.attrs = []; - FStarC_Reflection_V2_Data.ppname2 = pp_name - } -let (extend_env : - FStarC_Reflection_Types.env -> - FStarC_Reflection_V2_Data.var -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.env) - = - fun e -> - fun x -> - fun ty -> - FStar_Reflection_V2_Derived.push_binding e - { - FStarC_Reflection_V2_Data.uniq1 = x; - FStarC_Reflection_V2_Data.sort3 = ty; - FStarC_Reflection_V2_Data.ppname3 = (seal_pp_name "x") - } -let (bv_index : FStarC_Reflection_Types.bv -> FStarC_Reflection_V2_Data.var) - = - fun x -> - (FStarC_Reflection_V2_Builtins.inspect_bv x).FStarC_Reflection_V2_Data.index -let (namedv_uniq : - FStarC_Reflection_Types.namedv -> FStarC_Reflection_V2_Data.var) = - fun x -> - (FStarC_Reflection_V2_Builtins.inspect_namedv x).FStarC_Reflection_V2_Data.uniq -let (binder_sort : - FStarC_Reflection_Types.binder -> FStarC_Reflection_Types.typ) = - fun b -> - (FStarC_Reflection_V2_Builtins.inspect_binder b).FStarC_Reflection_V2_Data.sort2 -let (binder_qual : - FStarC_Reflection_Types.binder -> FStarC_Reflection_V2_Data.aqualv) = - fun b -> - let uu___ = FStarC_Reflection_V2_Builtins.inspect_binder b in - match uu___ with - | { FStarC_Reflection_V2_Data.sort2 = uu___1; - FStarC_Reflection_V2_Data.qual = q; - FStarC_Reflection_V2_Data.attrs = uu___2; - FStarC_Reflection_V2_Data.ppname2 = uu___3;_} -> q -type subst_elt = - | DT of Prims.nat * FStarC_Reflection_Types.term - | NT of FStarC_Reflection_V2_Data.var * FStarC_Reflection_Types.term - | ND of FStarC_Reflection_V2_Data.var * Prims.nat -let (uu___is_DT : subst_elt -> Prims.bool) = - fun projectee -> - match projectee with | DT (_0, _1) -> true | uu___ -> false -let (__proj__DT__item___0 : subst_elt -> Prims.nat) = - fun projectee -> match projectee with | DT (_0, _1) -> _0 -let (__proj__DT__item___1 : subst_elt -> FStarC_Reflection_Types.term) = - fun projectee -> match projectee with | DT (_0, _1) -> _1 -let (uu___is_NT : subst_elt -> Prims.bool) = - fun projectee -> - match projectee with | NT (_0, _1) -> true | uu___ -> false -let (__proj__NT__item___0 : subst_elt -> FStarC_Reflection_V2_Data.var) = - fun projectee -> match projectee with | NT (_0, _1) -> _0 -let (__proj__NT__item___1 : subst_elt -> FStarC_Reflection_Types.term) = - fun projectee -> match projectee with | NT (_0, _1) -> _1 -let (uu___is_ND : subst_elt -> Prims.bool) = - fun projectee -> - match projectee with | ND (_0, _1) -> true | uu___ -> false -let (__proj__ND__item___0 : subst_elt -> FStarC_Reflection_V2_Data.var) = - fun projectee -> match projectee with | ND (_0, _1) -> _0 -let (__proj__ND__item___1 : subst_elt -> Prims.nat) = - fun projectee -> match projectee with | ND (_0, _1) -> _1 -let (shift_subst_elt : Prims.nat -> subst_elt -> subst_elt) = - fun n -> - fun uu___ -> - match uu___ with - | DT (i, t) -> DT ((i + n), t) - | NT (x, t) -> NT (x, t) - | ND (x, i) -> ND (x, (i + n)) -type subst = subst_elt Prims.list -let (shift_subst_n : - Prims.nat -> subst_elt Prims.list -> subst_elt Prims.list) = - fun n -> FStar_List_Tot_Base.map (shift_subst_elt n) -let (shift_subst : subst_elt Prims.list -> subst_elt Prims.list) = - shift_subst_n Prims.int_one -let (maybe_uniq_of_term : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.var FStar_Pervasives_Native.option) - = - fun x -> - match FStarC_Reflection_V2_Builtins.inspect_ln x with - | FStarC_Reflection_V2_Data.Tv_Var namedv -> - FStar_Pervasives_Native.Some (namedv_uniq namedv) - | uu___ -> FStar_Pervasives_Native.None -let rec (find_matching_subst_elt_bv : - subst -> - FStarC_Reflection_Types.bv -> subst_elt FStar_Pervasives_Native.option) - = - fun s -> - fun bv -> - match s with - | [] -> FStar_Pervasives_Native.None - | (DT (j, t))::ss -> - if j = (bv_index bv) - then FStar_Pervasives_Native.Some (DT (j, t)) - else find_matching_subst_elt_bv ss bv - | uu___::ss -> find_matching_subst_elt_bv ss bv -let (subst_db : - FStarC_Reflection_Types.bv -> subst -> FStarC_Reflection_Types.term) = - fun bv -> - fun s -> - match find_matching_subst_elt_bv s bv with - | FStar_Pervasives_Native.Some (DT (uu___, t)) -> - (match maybe_uniq_of_term t with - | FStar_Pervasives_Native.None -> t - | FStar_Pervasives_Native.Some k -> - let v = - FStarC_Reflection_V2_Builtins.pack_namedv - { - FStarC_Reflection_V2_Data.uniq = k; - FStarC_Reflection_V2_Data.sort = - ((FStarC_Reflection_V2_Builtins.inspect_bv bv).FStarC_Reflection_V2_Data.sort1); - FStarC_Reflection_V2_Data.ppname = - ((FStarC_Reflection_V2_Builtins.inspect_bv bv).FStarC_Reflection_V2_Data.ppname1) - } in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Var v)) - | uu___ -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_BVar bv) -let rec (find_matching_subst_elt_var : - subst -> - FStarC_Reflection_Types.namedv -> - subst_elt FStar_Pervasives_Native.option) - = - fun s -> - fun v -> - match s with - | [] -> FStar_Pervasives_Native.None - | (NT (y, uu___))::rest -> - if y = (namedv_uniq v) - then FStar_Pervasives_Native.Some (FStar_List_Tot_Base.hd s) - else find_matching_subst_elt_var rest v - | (ND (y, uu___))::rest -> - if y = (namedv_uniq v) - then FStar_Pervasives_Native.Some (FStar_List_Tot_Base.hd s) - else find_matching_subst_elt_var rest v - | uu___::rest -> find_matching_subst_elt_var rest v -let (subst_var : - FStarC_Reflection_Types.namedv -> subst -> FStarC_Reflection_Types.term) = - fun v -> - fun s -> - match find_matching_subst_elt_var s v with - | FStar_Pervasives_Native.Some (NT (uu___, t)) -> - (match maybe_uniq_of_term t with - | FStar_Pervasives_Native.None -> t - | FStar_Pervasives_Native.Some k -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Var - (FStarC_Reflection_V2_Builtins.pack_namedv - (let uu___1 = - FStarC_Reflection_V2_Builtins.inspect_namedv v in - { - FStarC_Reflection_V2_Data.uniq = k; - FStarC_Reflection_V2_Data.sort = - (uu___1.FStarC_Reflection_V2_Data.sort); - FStarC_Reflection_V2_Data.ppname = - (uu___1.FStarC_Reflection_V2_Data.ppname) - })))) - | FStar_Pervasives_Native.Some (ND (uu___, i)) -> - let bv = - FStarC_Reflection_V2_Builtins.pack_bv - { - FStarC_Reflection_V2_Data.index = i; - FStarC_Reflection_V2_Data.sort1 = - ((FStarC_Reflection_V2_Builtins.inspect_namedv v).FStarC_Reflection_V2_Data.sort); - FStarC_Reflection_V2_Data.ppname1 = - ((FStarC_Reflection_V2_Builtins.inspect_namedv v).FStarC_Reflection_V2_Data.ppname) - } in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_BVar bv) - | uu___ -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Var v) -let (make_bv : Prims.nat -> FStarC_Reflection_V2_Data.bv_view) = - fun n -> - { - FStarC_Reflection_V2_Data.index = n; - FStarC_Reflection_V2_Data.sort1 = sort_default; - FStarC_Reflection_V2_Data.ppname1 = pp_name_default - } -let (make_bv_with_name : - pp_name_t -> Prims.nat -> FStarC_Reflection_V2_Data.bv_view) = - fun s -> - fun n -> - { - FStarC_Reflection_V2_Data.index = n; - FStarC_Reflection_V2_Data.sort1 = sort_default; - FStarC_Reflection_V2_Data.ppname1 = s - } -let (var_as_bv : Prims.nat -> FStarC_Reflection_Types.bv) = - fun v -> FStarC_Reflection_V2_Builtins.pack_bv (make_bv v) -let (make_namedv : Prims.nat -> FStarC_Reflection_V2_Data.namedv_view) = - fun n -> - { - FStarC_Reflection_V2_Data.uniq = n; - FStarC_Reflection_V2_Data.sort = sort_default; - FStarC_Reflection_V2_Data.ppname = pp_name_default - } -let (make_namedv_with_name : - pp_name_t -> Prims.nat -> FStarC_Reflection_V2_Data.namedv_view) = - fun s -> - fun n -> - { - FStarC_Reflection_V2_Data.uniq = n; - FStarC_Reflection_V2_Data.sort = sort_default; - FStarC_Reflection_V2_Data.ppname = s - } -let (var_as_namedv : Prims.nat -> FStarC_Reflection_Types.namedv) = - fun v -> - FStarC_Reflection_V2_Builtins.pack_namedv - { - FStarC_Reflection_V2_Data.uniq = v; - FStarC_Reflection_V2_Data.sort = sort_default; - FStarC_Reflection_V2_Data.ppname = pp_name_default - } -let (var_as_term : - FStarC_Reflection_V2_Data.var -> FStarC_Reflection_Types.term) = - fun v -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Var (var_as_namedv v)) -let (binder_of_t_q : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.aqualv -> FStarC_Reflection_Types.binder) - = fun t -> fun q -> mk_binder pp_name_default t q -let (mk_abs : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.aqualv -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = - fun ty -> - fun qual -> - fun t -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Abs ((binder_of_t_q ty qual), t)) -let (mk_total : FStarC_Reflection_Types.typ -> FStarC_Reflection_Types.comp) - = - fun t -> - FStarC_Reflection_V2_Builtins.pack_comp - (FStarC_Reflection_V2_Data.C_Total t) -let (mk_ghost : FStarC_Reflection_Types.typ -> FStarC_Reflection_Types.comp) - = - fun t -> - FStarC_Reflection_V2_Builtins.pack_comp - (FStarC_Reflection_V2_Data.C_GTotal t) -let (mk_arrow : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.aqualv -> - FStarC_Reflection_Types.typ -> FStarC_Reflection_Types.term) - = - fun ty -> - fun qual -> - fun t -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Arrow - ((binder_of_t_q ty qual), (mk_total t))) -let (mk_ghost_arrow : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.aqualv -> - FStarC_Reflection_Types.typ -> FStarC_Reflection_Types.term) - = - fun ty -> - fun qual -> - fun t -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Arrow - ((binder_of_t_q ty qual), (mk_ghost t))) -let (bound_var : Prims.nat -> FStarC_Reflection_Types.term) = - fun i -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_BVar - (FStarC_Reflection_V2_Builtins.pack_bv (make_bv i))) -let (mk_let : - pp_name_t -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = - fun ppname -> - fun e1 -> - fun t1 -> - fun e2 -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Let - (false, [], (mk_simple_binder ppname t1), e1, e2)) -let (open_with_var_elt : - FStarC_Reflection_V2_Data.var -> Prims.nat -> subst_elt) = - fun x -> - fun i -> - DT - (i, - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Var (var_as_namedv x)))) -let (open_with_var : FStarC_Reflection_V2_Data.var -> Prims.nat -> subst) = - fun x -> fun i -> [open_with_var_elt x i] -let (subst_ctx_uvar_and_subst : - FStarC_Reflection_Types.ctx_uvar_and_subst -> - subst -> FStarC_Reflection_Types.ctx_uvar_and_subst) - = fun uu___ -> fun uu___1 -> Prims.magic () -let rec (binder_offset_patterns : - (FStarC_Reflection_V2_Data.pattern * Prims.bool) Prims.list -> Prims.nat) = - fun ps -> - match ps with - | [] -> Prims.int_zero - | (p, b)::ps1 -> - let n = binder_offset_pattern p in - let m = binder_offset_patterns ps1 in n + m -and (binder_offset_pattern : FStarC_Reflection_V2_Data.pattern -> Prims.nat) - = - fun p -> - match p with - | FStarC_Reflection_V2_Data.Pat_Constant uu___ -> Prims.int_zero - | FStarC_Reflection_V2_Data.Pat_Dot_Term uu___ -> Prims.int_zero - | FStarC_Reflection_V2_Data.Pat_Var (uu___, uu___1) -> Prims.int_one - | FStarC_Reflection_V2_Data.Pat_Cons (head, univs, subpats) -> - binder_offset_patterns subpats -let rec (subst_term : - FStarC_Reflection_Types.term -> subst -> FStarC_Reflection_Types.term) = - fun t -> - fun ss -> - match FStarC_Reflection_V2_Builtins.inspect_ln t with - | FStarC_Reflection_V2_Data.Tv_UInst (uu___, uu___1) -> t - | FStarC_Reflection_V2_Data.Tv_FVar uu___ -> t - | FStarC_Reflection_V2_Data.Tv_Type uu___ -> t - | FStarC_Reflection_V2_Data.Tv_Const uu___ -> t - | FStarC_Reflection_V2_Data.Tv_Unsupp -> t - | FStarC_Reflection_V2_Data.Tv_Unknown -> t - | FStarC_Reflection_V2_Data.Tv_Var x -> subst_var x ss - | FStarC_Reflection_V2_Data.Tv_BVar j -> subst_db j ss - | FStarC_Reflection_V2_Data.Tv_App (hd, argv) -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((subst_term hd ss), - ((subst_term (FStar_Pervasives_Native.fst argv) ss), - (FStar_Pervasives_Native.snd argv)))) - | FStarC_Reflection_V2_Data.Tv_Abs (b, body) -> - let b' = subst_binder b ss in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Abs - (b', (subst_term body (shift_subst ss)))) - | FStarC_Reflection_V2_Data.Tv_Arrow (b, c) -> - let b' = subst_binder b ss in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Arrow - (b', (subst_comp c (shift_subst ss)))) - | FStarC_Reflection_V2_Data.Tv_Refine (b, f) -> - let b1 = subst_binder b ss in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Refine - (b1, (subst_term f (shift_subst ss)))) - | FStarC_Reflection_V2_Data.Tv_Uvar (j, c) -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Uvar - (j, (subst_ctx_uvar_and_subst c ss))) - | FStarC_Reflection_V2_Data.Tv_Let (recf, attrs, b, def, body) -> - let b1 = subst_binder b ss in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Let - (recf, (subst_terms attrs ss), b1, - (if recf - then subst_term def (shift_subst ss) - else subst_term def ss), - (subst_term body (shift_subst ss)))) - | FStarC_Reflection_V2_Data.Tv_Match (scr, ret, brs) -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Match - ((subst_term scr ss), - (match ret with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some m -> - FStar_Pervasives_Native.Some (subst_match_returns m ss)), - (subst_branches brs ss))) - | FStarC_Reflection_V2_Data.Tv_AscribedT (e, t1, tac, b) -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_AscribedT - ((subst_term e ss), (subst_term t1 ss), - (match tac with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some tac1 -> - FStar_Pervasives_Native.Some (subst_term tac1 ss)), b)) - | FStarC_Reflection_V2_Data.Tv_AscribedC (e, c, tac, b) -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_AscribedC - ((subst_term e ss), (subst_comp c ss), - (match tac with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some tac1 -> - FStar_Pervasives_Native.Some (subst_term tac1 ss)), b)) -and (subst_binder : - FStarC_Reflection_Types.binder -> subst -> FStarC_Reflection_Types.binder) - = - fun b -> - fun ss -> - let bndr = FStarC_Reflection_V2_Builtins.inspect_binder b in - FStarC_Reflection_V2_Builtins.pack_binder - { - FStarC_Reflection_V2_Data.sort2 = - (subst_term bndr.FStarC_Reflection_V2_Data.sort2 ss); - FStarC_Reflection_V2_Data.qual = - (bndr.FStarC_Reflection_V2_Data.qual); - FStarC_Reflection_V2_Data.attrs = - (subst_terms bndr.FStarC_Reflection_V2_Data.attrs ss); - FStarC_Reflection_V2_Data.ppname2 = - (bndr.FStarC_Reflection_V2_Data.ppname2) - } -and (subst_comp : - FStarC_Reflection_Types.comp -> subst -> FStarC_Reflection_Types.comp) = - fun c -> - fun ss -> - match FStarC_Reflection_V2_Builtins.inspect_comp c with - | FStarC_Reflection_V2_Data.C_Total t -> - FStarC_Reflection_V2_Builtins.pack_comp - (FStarC_Reflection_V2_Data.C_Total (subst_term t ss)) - | FStarC_Reflection_V2_Data.C_GTotal t -> - FStarC_Reflection_V2_Builtins.pack_comp - (FStarC_Reflection_V2_Data.C_GTotal (subst_term t ss)) - | FStarC_Reflection_V2_Data.C_Lemma (pre, post, pats) -> - FStarC_Reflection_V2_Builtins.pack_comp - (FStarC_Reflection_V2_Data.C_Lemma - ((subst_term pre ss), (subst_term post ss), - (subst_term pats ss))) - | FStarC_Reflection_V2_Data.C_Eff (us, eff_name, res, args, decrs) -> - FStarC_Reflection_V2_Builtins.pack_comp - (FStarC_Reflection_V2_Data.C_Eff - (us, eff_name, (subst_term res ss), (subst_args args ss), - (subst_terms decrs ss))) -and (subst_terms : - FStarC_Reflection_Types.term Prims.list -> - subst -> FStarC_Reflection_Types.term Prims.list) - = - fun ts -> - fun ss -> - match ts with - | [] -> [] - | t::ts1 -> (subst_term t ss) :: (subst_terms ts1 ss) -and (subst_args : - FStarC_Reflection_V2_Data.argv Prims.list -> - subst -> FStarC_Reflection_V2_Data.argv Prims.list) - = - fun ts -> - fun ss -> - match ts with - | [] -> [] - | (t, q)::ts1 -> ((subst_term t ss), q) :: (subst_args ts1 ss) -and (subst_patterns : - (FStarC_Reflection_V2_Data.pattern * Prims.bool) Prims.list -> - subst -> (FStarC_Reflection_V2_Data.pattern * Prims.bool) Prims.list) - = - fun ps -> - fun ss -> - match ps with - | [] -> ps - | (p, b)::ps1 -> - let n = binder_offset_pattern p in - let p1 = subst_pattern p ss in - let ps2 = subst_patterns ps1 (shift_subst_n n ss) in (p1, b) :: ps2 -and (subst_pattern : - FStarC_Reflection_V2_Data.pattern -> - subst -> FStarC_Reflection_V2_Data.pattern) - = - fun p -> - fun ss -> - match p with - | FStarC_Reflection_V2_Data.Pat_Constant uu___ -> p - | FStarC_Reflection_V2_Data.Pat_Cons (fv, us, pats) -> - let pats1 = subst_patterns pats ss in - FStarC_Reflection_V2_Data.Pat_Cons (fv, us, pats1) - | FStarC_Reflection_V2_Data.Pat_Var (bv, s) -> - FStarC_Reflection_V2_Data.Pat_Var (bv, s) - | FStarC_Reflection_V2_Data.Pat_Dot_Term topt -> - FStarC_Reflection_V2_Data.Pat_Dot_Term - ((match topt with - | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some t -> - FStar_Pervasives_Native.Some (subst_term t ss))) -and (subst_branch : - FStarC_Reflection_V2_Data.branch -> - subst -> FStarC_Reflection_V2_Data.branch) - = - fun br -> - fun ss -> - let uu___ = br in - match uu___ with - | (p, t) -> - let p1 = subst_pattern p ss in - let j = binder_offset_pattern p1 in - let t1 = subst_term t (shift_subst_n j ss) in (p1, t1) -and (subst_branches : - FStarC_Reflection_V2_Data.branch Prims.list -> - subst -> FStarC_Reflection_V2_Data.branch Prims.list) - = - fun brs -> - fun ss -> - match brs with - | [] -> [] - | br::brs1 -> (subst_branch br ss) :: (subst_branches brs1 ss) -and (subst_match_returns : - FStarC_Syntax_Syntax.match_returns_ascription -> - subst -> FStarC_Syntax_Syntax.match_returns_ascription) - = - fun m -> - fun ss -> - let uu___ = m in - match uu___ with - | (b, (ret, as_, eq)) -> - let b1 = subst_binder b ss in - let ret1 = - match ret with - | FStar_Pervasives.Inl t -> - FStar_Pervasives.Inl (subst_term t (shift_subst ss)) - | FStar_Pervasives.Inr c -> - FStar_Pervasives.Inr (subst_comp c (shift_subst ss)) in - let as_1 = - match as_ with - | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some t -> - FStar_Pervasives_Native.Some (subst_term t (shift_subst ss)) in - (b1, (ret1, as_1, eq)) -let (open_with : - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = fun t -> fun v -> FStar_Reflection_Typing_Builtins.open_with t v -let (open_term : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.var -> FStarC_Reflection_Types.term) - = fun t -> fun v -> FStar_Reflection_Typing_Builtins.open_term t v -let (close_term : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.var -> FStarC_Reflection_Types.term) - = fun t -> fun v -> FStar_Reflection_Typing_Builtins.close_term t v -let (rename : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.var -> - FStarC_Reflection_V2_Data.var -> FStarC_Reflection_Types.term) - = fun t -> fun x -> fun y -> FStar_Reflection_Typing_Builtins.rename t x y -let (constant_as_term : - FStarC_Reflection_V2_Data.vconst -> FStarC_Reflection_Types.term) = - fun v -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const v) -let (unit_exp : FStarC_Reflection_Types.term) = - constant_as_term FStarC_Reflection_V2_Data.C_Unit -let (unit_fv : FStarC_Reflection_Types.fv) = - FStarC_Reflection_V2_Builtins.pack_fv FStar_Reflection_Const.unit_lid -let (unit_ty : FStarC_Reflection_Types.term) = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar unit_fv) -let (bool_fv : FStarC_Reflection_Types.fv) = - FStarC_Reflection_V2_Builtins.pack_fv FStar_Reflection_Const.bool_lid -let (bool_ty : FStarC_Reflection_Types.term) = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar bool_fv) -let (u_zero : FStarC_Reflection_Types.universe) = - FStarC_Reflection_V2_Builtins.pack_universe - FStarC_Reflection_V2_Data.Uv_Zero -let (u_max : - FStarC_Reflection_Types.universe -> - FStarC_Reflection_Types.universe -> FStarC_Reflection_Types.universe) - = - fun u1 -> - fun u2 -> - FStarC_Reflection_V2_Builtins.pack_universe - (FStarC_Reflection_V2_Data.Uv_Max [u1; u2]) -let (u_succ : - FStarC_Reflection_Types.universe -> FStarC_Reflection_Types.universe) = - fun u -> - FStarC_Reflection_V2_Builtins.pack_universe - (FStarC_Reflection_V2_Data.Uv_Succ u) -let (tm_type : - FStarC_Reflection_Types.universe -> FStarC_Reflection_Types.term) = - fun u -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Type u) -let (tm_prop : FStarC_Reflection_Types.term) = - let prop_fv = - FStarC_Reflection_V2_Builtins.pack_fv FStar_Reflection_Const.prop_qn in - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar prop_fv) -let (eqtype_lid : FStarC_Reflection_Types.name) = ["Prims"; "eqtype"] -let (true_bool : FStarC_Reflection_Types.term) = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const FStarC_Reflection_V2_Data.C_True) -let (false_bool : FStarC_Reflection_Types.term) = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const FStarC_Reflection_V2_Data.C_False) -let (eq2 : - FStarC_Reflection_Types.universe -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = - fun u -> - fun t -> - fun v0 -> - fun v1 -> - let eq21 = - FStarC_Reflection_V2_Builtins.pack_fv - FStar_Reflection_Const.eq2_qn in - let eq22 = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_UInst (eq21, [u])) in - let h = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - (eq22, (t, FStarC_Reflection_V2_Data.Q_Implicit))) in - let h1 = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - (h, (v0, FStarC_Reflection_V2_Data.Q_Explicit))) in - let h2 = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - (h1, (v1, FStarC_Reflection_V2_Data.Q_Explicit))) in - h2 -let (b2t_lid : FStarC_Reflection_Types.name) = ["Prims"; "b2t"] -let (b2t_fv : FStarC_Reflection_Types.fv) = - FStarC_Reflection_V2_Builtins.pack_fv b2t_lid -let (b2t_ty : FStarC_Reflection_Types.term) = - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Arrow - ((mk_binder (FStar_Sealed.seal "x") bool_ty - FStarC_Reflection_V2_Data.Q_Explicit), - (mk_total (tm_type u_zero)))) -let rec (freevars : - FStarC_Reflection_Types.term -> FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun e -> - match FStarC_Reflection_V2_Builtins.inspect_ln e with - | FStarC_Reflection_V2_Data.Tv_Uvar (uu___, uu___1) -> - FStar_Set.complement (FStar_Set.empty ()) - | FStarC_Reflection_V2_Data.Tv_UInst (uu___, uu___1) -> - FStar_Set.empty () - | FStarC_Reflection_V2_Data.Tv_FVar uu___ -> FStar_Set.empty () - | FStarC_Reflection_V2_Data.Tv_Type uu___ -> FStar_Set.empty () - | FStarC_Reflection_V2_Data.Tv_Const uu___ -> FStar_Set.empty () - | FStarC_Reflection_V2_Data.Tv_Unknown -> FStar_Set.empty () - | FStarC_Reflection_V2_Data.Tv_Unsupp -> FStar_Set.empty () - | FStarC_Reflection_V2_Data.Tv_BVar uu___ -> FStar_Set.empty () - | FStarC_Reflection_V2_Data.Tv_Var x -> - FStar_Set.singleton (namedv_uniq x) - | FStarC_Reflection_V2_Data.Tv_App (e1, (e2, uu___)) -> - FStar_Set.union (freevars e1) (freevars e2) - | FStarC_Reflection_V2_Data.Tv_Abs (b, body) -> - FStar_Set.union (freevars_binder b) (freevars body) - | FStarC_Reflection_V2_Data.Tv_Arrow (b, c) -> - FStar_Set.union (freevars_binder b) (freevars_comp c) - | FStarC_Reflection_V2_Data.Tv_Refine (b, f) -> - FStar_Set.union (freevars (binder_sort b)) (freevars f) - | FStarC_Reflection_V2_Data.Tv_Let (recf, attrs, b, def, body) -> - FStar_Set.union - (FStar_Set.union - (FStar_Set.union (freevars_terms attrs) - (freevars (binder_sort b))) (freevars def)) (freevars body) - | FStarC_Reflection_V2_Data.Tv_Match (scr, ret, brs) -> - FStar_Set.union - (FStar_Set.union (freevars scr) - (freevars_opt ret freevars_match_returns)) - (freevars_branches brs) - | FStarC_Reflection_V2_Data.Tv_AscribedT (e1, t, tac, b) -> - FStar_Set.union (FStar_Set.union (freevars e1) (freevars t)) - (freevars_opt tac freevars) - | FStarC_Reflection_V2_Data.Tv_AscribedC (e1, c, tac, b) -> - FStar_Set.union (FStar_Set.union (freevars e1) (freevars_comp c)) - (freevars_opt tac freevars) -and freevars_opt : - 'a . - 'a FStar_Pervasives_Native.option -> - ('a -> FStarC_Reflection_V2_Data.var FStar_Set.set) -> - FStarC_Reflection_V2_Data.var FStar_Set.set - = - fun o -> - fun f -> - match o with - | FStar_Pervasives_Native.None -> FStar_Set.empty () - | FStar_Pervasives_Native.Some x -> f x -and (freevars_comp : - FStarC_Reflection_Types.comp -> FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun c -> - match FStarC_Reflection_V2_Builtins.inspect_comp c with - | FStarC_Reflection_V2_Data.C_Total t -> freevars t - | FStarC_Reflection_V2_Data.C_GTotal t -> freevars t - | FStarC_Reflection_V2_Data.C_Lemma (pre, post, pats) -> - FStar_Set.union (FStar_Set.union (freevars pre) (freevars post)) - (freevars pats) - | FStarC_Reflection_V2_Data.C_Eff (us, eff_name, res, args, decrs) -> - FStar_Set.union (FStar_Set.union (freevars res) (freevars_args args)) - (freevars_terms decrs) -and (freevars_args : - FStarC_Reflection_V2_Data.argv Prims.list -> - FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun ts -> - match ts with - | [] -> FStar_Set.empty () - | (t, q)::ts1 -> FStar_Set.union (freevars t) (freevars_args ts1) -and (freevars_terms : - FStarC_Reflection_Types.term Prims.list -> - FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun ts -> - match ts with - | [] -> FStar_Set.empty () - | t::ts1 -> FStar_Set.union (freevars t) (freevars_terms ts1) -and (freevars_binder : - FStarC_Reflection_Types.binder -> - FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun b -> - let bndr = FStarC_Reflection_V2_Builtins.inspect_binder b in - FStar_Set.union (freevars bndr.FStarC_Reflection_V2_Data.sort2) - (freevars_terms bndr.FStarC_Reflection_V2_Data.attrs) -and (freevars_pattern : - FStarC_Reflection_V2_Data.pattern -> - FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun p -> - match p with - | FStarC_Reflection_V2_Data.Pat_Constant uu___ -> FStar_Set.empty () - | FStarC_Reflection_V2_Data.Pat_Cons (head, univs, subpats) -> - freevars_patterns subpats - | FStarC_Reflection_V2_Data.Pat_Var (bv, s) -> FStar_Set.empty () - | FStarC_Reflection_V2_Data.Pat_Dot_Term topt -> - freevars_opt topt freevars -and (freevars_patterns : - (FStarC_Reflection_V2_Data.pattern * Prims.bool) Prims.list -> - FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun ps -> - match ps with - | [] -> FStar_Set.empty () - | (p, b)::ps1 -> - FStar_Set.union (freevars_pattern p) (freevars_patterns ps1) -and (freevars_branch : - FStarC_Reflection_V2_Data.branch -> - FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun br -> - let uu___ = br in - match uu___ with - | (p, t) -> FStar_Set.union (freevars_pattern p) (freevars t) -and (freevars_branches : - FStarC_Reflection_V2_Data.branch Prims.list -> - FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun brs -> - match brs with - | [] -> FStar_Set.empty () - | hd::tl -> FStar_Set.union (freevars_branch hd) (freevars_branches tl) -and (freevars_match_returns : - FStarC_Syntax_Syntax.match_returns_ascription -> - FStarC_Reflection_V2_Data.var FStar_Set.set) - = - fun m -> - let uu___ = m in - match uu___ with - | (b, (ret, as_, eq)) -> - let b1 = freevars_binder b in - let ret1 = - match ret with - | FStar_Pervasives.Inl t -> freevars t - | FStar_Pervasives.Inr c -> freevars_comp c in - let as_1 = freevars_opt as_ freevars in - FStar_Set.union (FStar_Set.union b1 ret1) as_1 -let rec (ln' : FStarC_Reflection_Types.term -> Prims.int -> Prims.bool) = - fun e -> - fun n -> - match FStarC_Reflection_V2_Builtins.inspect_ln e with - | FStarC_Reflection_V2_Data.Tv_UInst (uu___, uu___1) -> true - | FStarC_Reflection_V2_Data.Tv_FVar uu___ -> true - | FStarC_Reflection_V2_Data.Tv_Type uu___ -> true - | FStarC_Reflection_V2_Data.Tv_Const uu___ -> true - | FStarC_Reflection_V2_Data.Tv_Unknown -> true - | FStarC_Reflection_V2_Data.Tv_Unsupp -> true - | FStarC_Reflection_V2_Data.Tv_Var uu___ -> true - | FStarC_Reflection_V2_Data.Tv_BVar m -> (bv_index m) <= n - | FStarC_Reflection_V2_Data.Tv_App (e1, (e2, uu___)) -> - (ln' e1 n) && (ln' e2 n) - | FStarC_Reflection_V2_Data.Tv_Abs (b, body) -> - (ln'_binder b n) && (ln' body (n + Prims.int_one)) - | FStarC_Reflection_V2_Data.Tv_Arrow (b, c) -> - (ln'_binder b n) && (ln'_comp c (n + Prims.int_one)) - | FStarC_Reflection_V2_Data.Tv_Refine (b, f) -> - (ln'_binder b n) && (ln' f (n + Prims.int_one)) - | FStarC_Reflection_V2_Data.Tv_Uvar (uu___, uu___1) -> false - | FStarC_Reflection_V2_Data.Tv_Let (recf, attrs, b, def, body) -> - (((ln'_terms attrs n) && (ln'_binder b n)) && - (if recf then ln' def (n + Prims.int_one) else ln' def n)) - && (ln' body (n + Prims.int_one)) - | FStarC_Reflection_V2_Data.Tv_Match (scr, ret, brs) -> - ((ln' scr n) && - (match ret with - | FStar_Pervasives_Native.None -> true - | FStar_Pervasives_Native.Some m -> ln'_match_returns m n)) - && (ln'_branches brs n) - | FStarC_Reflection_V2_Data.Tv_AscribedT (e1, t, tac, b) -> - ((ln' e1 n) && (ln' t n)) && - ((match tac with - | FStar_Pervasives_Native.None -> true - | FStar_Pervasives_Native.Some tac1 -> ln' tac1 n)) - | FStarC_Reflection_V2_Data.Tv_AscribedC (e1, c, tac, b) -> - ((ln' e1 n) && (ln'_comp c n)) && - ((match tac with - | FStar_Pervasives_Native.None -> true - | FStar_Pervasives_Native.Some tac1 -> ln' tac1 n)) -and (ln'_comp : FStarC_Reflection_Types.comp -> Prims.int -> Prims.bool) = - fun c -> - fun i -> - match FStarC_Reflection_V2_Builtins.inspect_comp c with - | FStarC_Reflection_V2_Data.C_Total t -> ln' t i - | FStarC_Reflection_V2_Data.C_GTotal t -> ln' t i - | FStarC_Reflection_V2_Data.C_Lemma (pre, post, pats) -> - ((ln' pre i) && (ln' post i)) && (ln' pats i) - | FStarC_Reflection_V2_Data.C_Eff (us, eff_name, res, args, decrs) -> - ((ln' res i) && (ln'_args args i)) && (ln'_terms decrs i) -and (ln'_args : - FStarC_Reflection_V2_Data.argv Prims.list -> Prims.int -> Prims.bool) = - fun ts -> - fun i -> - match ts with - | [] -> true - | (t, q)::ts1 -> (ln' t i) && (ln'_args ts1 i) -and (ln'_binder : FStarC_Reflection_Types.binder -> Prims.int -> Prims.bool) - = - fun b -> - fun n -> - let bndr = FStarC_Reflection_V2_Builtins.inspect_binder b in - (ln' bndr.FStarC_Reflection_V2_Data.sort2 n) && - (ln'_terms bndr.FStarC_Reflection_V2_Data.attrs n) -and (ln'_terms : - FStarC_Reflection_Types.term Prims.list -> Prims.int -> Prims.bool) = - fun ts -> - fun n -> - match ts with | [] -> true | t::ts1 -> (ln' t n) && (ln'_terms ts1 n) -and (ln'_patterns : - (FStarC_Reflection_V2_Data.pattern * Prims.bool) Prims.list -> - Prims.int -> Prims.bool) - = - fun ps -> - fun i -> - match ps with - | [] -> true - | (p, b)::ps1 -> - let b0 = ln'_pattern p i in - let n = binder_offset_pattern p in - let b1 = ln'_patterns ps1 (i + n) in b0 && b1 -and (ln'_pattern : - FStarC_Reflection_V2_Data.pattern -> Prims.int -> Prims.bool) = - fun p -> - fun i -> - match p with - | FStarC_Reflection_V2_Data.Pat_Constant uu___ -> true - | FStarC_Reflection_V2_Data.Pat_Cons (head, univs, subpats) -> - ln'_patterns subpats i - | FStarC_Reflection_V2_Data.Pat_Var (bv, s) -> true - | FStarC_Reflection_V2_Data.Pat_Dot_Term topt -> - (match topt with - | FStar_Pervasives_Native.None -> true - | FStar_Pervasives_Native.Some t -> ln' t i) -and (ln'_branch : - FStarC_Reflection_V2_Data.branch -> Prims.int -> Prims.bool) = - fun br -> - fun i -> - let uu___ = br in - match uu___ with - | (p, t) -> - let b = ln'_pattern p i in - let j = binder_offset_pattern p in - let b' = ln' t (i + j) in b && b' -and (ln'_branches : - FStarC_Reflection_V2_Data.branch Prims.list -> Prims.int -> Prims.bool) = - fun brs -> - fun i -> - match brs with - | [] -> true - | br::brs1 -> (ln'_branch br i) && (ln'_branches brs1 i) -and (ln'_match_returns : - FStarC_Syntax_Syntax.match_returns_ascription -> Prims.int -> Prims.bool) = - fun m -> - fun i -> - let uu___ = m in - match uu___ with - | (b, (ret, as_, eq)) -> - let b1 = ln'_binder b i in - let ret1 = - match ret with - | FStar_Pervasives.Inl t -> ln' t (i + Prims.int_one) - | FStar_Pervasives.Inr c -> ln'_comp c (i + Prims.int_one) in - let as_1 = - match as_ with - | FStar_Pervasives_Native.None -> true - | FStar_Pervasives_Native.Some t -> ln' t (i + Prims.int_one) in - (b1 && ret1) && as_1 -let (ln : FStarC_Reflection_Types.term -> Prims.bool) = - fun t -> ln' t (Prims.of_int (-1)) -let (ln_comp : FStarC_Reflection_Types.comp -> Prims.bool) = - fun c -> ln'_comp c (Prims.of_int (-1)) -type term_ctxt = - | Ctxt_hole - | Ctxt_app_head of term_ctxt * FStarC_Reflection_V2_Data.argv - | Ctxt_app_arg of FStarC_Reflection_Types.term * - FStarC_Reflection_V2_Data.aqualv * term_ctxt -let uu___is_Ctxt_hole uu___ = - match uu___ with | Ctxt_hole _ -> true | _ -> false -let uu___is_Ctxt_app_head uu___ = - match uu___ with | Ctxt_app_head _ -> true | _ -> false -let uu___is_Ctxt_app_arg uu___ = - match uu___ with | Ctxt_app_arg _ -> true | _ -> false -let rec (apply_term_ctxt : - term_ctxt -> FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = - fun e -> - fun t -> - match e with - | Ctxt_hole -> t - | Ctxt_app_head (e1, arg) -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App ((apply_term_ctxt e1 t), arg)) - | Ctxt_app_arg (hd, q, e1) -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - (hd, ((apply_term_ctxt e1 t), q))) -type ('dummyV0, 'dummyV1) constant_typing = - | CT_Unit - | CT_True - | CT_False -let (uu___is_CT_Unit : - FStarC_Reflection_V2_Data.vconst -> - FStarC_Reflection_Types.term -> - (unit, unit) constant_typing -> Prims.bool) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | CT_Unit -> true | uu___2 -> false -let (uu___is_CT_True : - FStarC_Reflection_V2_Data.vconst -> - FStarC_Reflection_Types.term -> - (unit, unit) constant_typing -> Prims.bool) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | CT_True -> true | uu___2 -> false -let (uu___is_CT_False : - FStarC_Reflection_V2_Data.vconst -> - FStarC_Reflection_Types.term -> - (unit, unit) constant_typing -> Prims.bool) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | CT_False -> true | uu___2 -> false -type ('dummyV0, 'dummyV1) univ_eq = - | UN_Refl of FStarC_Reflection_Types.universe - | UN_MaxCongL of FStarC_Reflection_Types.universe * - FStarC_Reflection_Types.universe * FStarC_Reflection_Types.universe * - (unit, unit) univ_eq - | UN_MaxCongR of FStarC_Reflection_Types.universe * - FStarC_Reflection_Types.universe * FStarC_Reflection_Types.universe * - (unit, unit) univ_eq - | UN_MaxComm of FStarC_Reflection_Types.universe * - FStarC_Reflection_Types.universe - | UN_MaxLeq of FStarC_Reflection_Types.universe * - FStarC_Reflection_Types.universe * (unit, unit) univ_leq -and ('dummyV0, 'dummyV1) univ_leq = - | UNLEQ_Refl of FStarC_Reflection_Types.universe - | UNLEQ_Succ of FStarC_Reflection_Types.universe * - FStarC_Reflection_Types.universe * (unit, unit) univ_leq - | UNLEQ_Max of FStarC_Reflection_Types.universe * - FStarC_Reflection_Types.universe -let uu___is_UN_Refl uu___1 uu___ uu___2 = - match uu___2 with | UN_Refl _ -> true | _ -> false -let uu___is_UN_MaxCongL uu___1 uu___ uu___2 = - match uu___2 with | UN_MaxCongL _ -> true | _ -> false -let uu___is_UN_MaxCongR uu___1 uu___ uu___2 = - match uu___2 with | UN_MaxCongR _ -> true | _ -> false -let uu___is_UN_MaxComm uu___1 uu___ uu___2 = - match uu___2 with | UN_MaxComm _ -> true | _ -> false -let uu___is_UN_MaxLeq uu___1 uu___ uu___2 = - match uu___2 with | UN_MaxLeq _ -> true | _ -> false -let uu___is_UNLEQ_Refl uu___1 uu___ uu___2 = - match uu___2 with | UNLEQ_Refl _ -> true | _ -> false -let uu___is_UNLEQ_Succ uu___1 uu___ uu___2 = - match uu___2 with | UNLEQ_Succ _ -> true | _ -> false -let uu___is_UNLEQ_Max uu___1 uu___ uu___2 = - match uu___2 with | UNLEQ_Max _ -> true | _ -> false -let (mk_if : - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = - fun scrutinee -> - fun then_ -> - fun else_ -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Match - (scrutinee, FStar_Pervasives_Native.None, - [((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_True), then_); - ((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_False), else_)])) -type comp_typ = - (FStarC_TypeChecker_Core.tot_or_ghost * FStarC_Reflection_Types.typ) -let (close_comp_typ' : - comp_typ -> - FStarC_Reflection_V2_Data.var -> - Prims.nat -> - (FStarC_TypeChecker_Core.tot_or_ghost * FStarC_Reflection_Types.term)) - = - fun c -> - fun x -> - fun i -> - ((FStar_Pervasives_Native.fst c), - (subst_term (FStar_Pervasives_Native.snd c) [ND (x, i)])) -let (close_comp_typ : - comp_typ -> - FStarC_Reflection_V2_Data.var -> - (FStarC_TypeChecker_Core.tot_or_ghost * FStarC_Reflection_Types.term)) - = fun c -> fun x -> close_comp_typ' c x Prims.int_zero -let (open_comp_typ' : - comp_typ -> - FStarC_Reflection_V2_Data.var -> - Prims.nat -> - (FStarC_TypeChecker_Core.tot_or_ghost * FStarC_Reflection_Types.term)) - = - fun c -> - fun x -> - fun i -> - ((FStar_Pervasives_Native.fst c), - (subst_term (FStar_Pervasives_Native.snd c) (open_with_var x i))) -let (open_comp_typ : - comp_typ -> - FStarC_Reflection_V2_Data.var -> - (FStarC_TypeChecker_Core.tot_or_ghost * FStarC_Reflection_Types.term)) - = fun c -> fun x -> open_comp_typ' c x Prims.int_zero -let (freevars_comp_typ : - comp_typ -> FStarC_Reflection_V2_Data.var FStar_Set.set) = - fun c -> freevars (FStar_Pervasives_Native.snd c) -let (mk_comp : comp_typ -> FStarC_Reflection_Types.comp) = - fun c -> - match FStar_Pervasives_Native.fst c with - | FStarC_TypeChecker_Core.E_Total -> - mk_total (FStar_Pervasives_Native.snd c) - | FStarC_TypeChecker_Core.E_Ghost -> - mk_ghost (FStar_Pervasives_Native.snd c) -let (mk_arrow_ct : - FStarC_Reflection_Types.term -> - FStarC_Reflection_V2_Data.aqualv -> - comp_typ -> FStarC_Reflection_Types.term) - = - fun ty -> - fun qual -> - fun c -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Arrow - ((binder_of_t_q ty qual), (mk_comp c))) -type relation = - | R_Eq - | R_Sub -let (uu___is_R_Eq : relation -> Prims.bool) = - fun projectee -> match projectee with | R_Eq -> true | uu___ -> false -let (uu___is_R_Sub : relation -> Prims.bool) = - fun projectee -> match projectee with | R_Sub -> true | uu___ -> false -type binding = (FStarC_Reflection_V2_Data.var * FStarC_Reflection_Types.term) -type bindings = binding Prims.list -let rename_bindings : - 'uuuuu . - ('uuuuu * FStarC_Reflection_Types.term) Prims.list -> - FStarC_Reflection_V2_Data.var -> - FStarC_Reflection_V2_Data.var -> - ('uuuuu * FStarC_Reflection_Types.term) Prims.list - = - fun bs -> - fun x -> - fun y -> - FStar_List_Tot_Base.map - (fun uu___ -> match uu___ with | (v, t) -> (v, (rename t x y))) bs -let rec (extend_env_l : - FStarC_Reflection_Types.env -> bindings -> FStarC_Reflection_Types.env) = - fun g -> - fun bs -> - match bs with - | [] -> g - | (x, t)::bs1 -> extend_env (extend_env_l g bs1) x t -let (is_non_informative_name : FStarC_Reflection_Types.name -> Prims.bool) = - fun l -> - ((l = FStar_Reflection_Const.unit_lid) || - (l = FStar_Reflection_Const.squash_qn)) - || (l = ["FStar"; "Ghost"; "erased"]) -let (is_non_informative_fv : FStarC_Reflection_Types.fv -> Prims.bool) = - fun f -> - is_non_informative_name (FStarC_Reflection_V2_Builtins.inspect_fv f) -let rec (__close_term_vs : - Prims.nat -> - FStarC_Reflection_V2_Data.var Prims.list -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = - fun i -> - fun vs -> - fun t -> - match vs with - | [] -> t - | v::vs1 -> - subst_term (__close_term_vs (i + Prims.int_one) vs1 t) - [ND (v, i)] -let (close_term_vs : - FStarC_Reflection_V2_Data.var Prims.list -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = fun vs -> fun t -> __close_term_vs Prims.int_zero vs t -let (close_term_bs : - binding Prims.list -> - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term) - = - fun bs -> - fun t -> - close_term_vs (FStar_List_Tot_Base.map FStar_Pervasives_Native.fst bs) - t -let (bindings_to_refl_bindings : - binding Prims.list -> FStarC_Reflection_V2_Data.binding Prims.list) = - fun bs -> - FStar_List_Tot_Base.map - (fun uu___ -> - match uu___ with - | (v, ty) -> - { - FStarC_Reflection_V2_Data.uniq1 = v; - FStarC_Reflection_V2_Data.sort3 = ty; - FStarC_Reflection_V2_Data.ppname3 = pp_name_default - }) bs -let (refl_bindings_to_bindings : - FStarC_Reflection_V2_Data.binding Prims.list -> binding Prims.list) = - fun bs -> - FStar_List_Tot_Base.map - (fun b -> - ((b.FStarC_Reflection_V2_Data.uniq1), - (b.FStarC_Reflection_V2_Data.sort3))) bs -type ('dummyV0, 'dummyV1) non_informative = - | Non_informative_type of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.universe - | Non_informative_fv of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.fv - | Non_informative_uinst of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.fv * FStarC_Reflection_Types.universe Prims.list - | Non_informative_app of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.term * FStarC_Reflection_V2_Data.argv * (unit, - unit) non_informative - | Non_informative_total_arrow of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.term * FStarC_Reflection_V2_Data.aqualv * - FStarC_Reflection_Types.term * (unit, unit) non_informative - | Non_informative_ghost_arrow of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.term * FStarC_Reflection_V2_Data.aqualv * - FStarC_Reflection_Types.term - | Non_informative_token of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.typ * unit -let uu___is_Non_informative_type uu___1 uu___ uu___2 = - match uu___2 with | Non_informative_type _ -> true | _ -> false -let uu___is_Non_informative_fv uu___1 uu___ uu___2 = - match uu___2 with | Non_informative_fv _ -> true | _ -> false -let uu___is_Non_informative_uinst uu___1 uu___ uu___2 = - match uu___2 with | Non_informative_uinst _ -> true | _ -> false -let uu___is_Non_informative_app uu___1 uu___ uu___2 = - match uu___2 with | Non_informative_app _ -> true | _ -> false -let uu___is_Non_informative_total_arrow uu___1 uu___ uu___2 = - match uu___2 with | Non_informative_total_arrow _ -> true | _ -> false -let uu___is_Non_informative_ghost_arrow uu___1 uu___ uu___2 = - match uu___2 with | Non_informative_ghost_arrow _ -> true | _ -> false -let uu___is_Non_informative_token uu___1 uu___ uu___2 = - match uu___2 with | Non_informative_token _ -> true | _ -> false -type ('bnds, 'pat, 'uuuuu) bindings_ok_for_pat = Obj.t -type ('g, 'bs, 'br) bindings_ok_for_branch = Obj.t -type ('g, 'bss, 'brs) bindings_ok_for_branch_N = Obj.t -let (binding_to_namedv : - FStarC_Reflection_V2_Data.binding -> FStarC_Reflection_Types.namedv) = - fun b -> - FStarC_Reflection_V2_Builtins.pack_namedv - { - FStarC_Reflection_V2_Data.uniq = (b.FStarC_Reflection_V2_Data.uniq1); - FStarC_Reflection_V2_Data.sort = - (FStar_Sealed.seal b.FStarC_Reflection_V2_Data.sort3); - FStarC_Reflection_V2_Data.ppname = - (b.FStarC_Reflection_V2_Data.ppname3) - } -let rec (elaborate_pat : - FStarC_Reflection_V2_Data.pattern -> - FStarC_Reflection_V2_Data.binding Prims.list -> - (FStarC_Reflection_Types.term * FStarC_Reflection_V2_Data.binding - Prims.list) FStar_Pervasives_Native.option) - = - fun p -> - fun bs -> - match (p, bs) with - | (FStarC_Reflection_V2_Data.Pat_Constant c, uu___) -> - FStar_Pervasives_Native.Some - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const c)), bs) - | (FStarC_Reflection_V2_Data.Pat_Cons (fv, univs, subpats), bs1) -> - let head = - match univs with - | FStar_Pervasives_Native.Some univs1 -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_UInst (fv, univs1)) - | FStar_Pervasives_Native.None -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar fv) in - fold_left_dec (FStar_Pervasives_Native.Some (head, bs1)) subpats - (fun st -> - fun pi -> - let uu___ = pi in - match uu___ with - | (p1, i) -> - (match st with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some (head1, bs2) -> - (match elaborate_pat p1 bs2 with - | FStar_Pervasives_Native.None -> - FStar_Pervasives_Native.None - | FStar_Pervasives_Native.Some (t, bs') -> - FStar_Pervasives_Native.Some - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - (head1, - (t, - (if i - then - FStarC_Reflection_V2_Data.Q_Implicit - else - FStarC_Reflection_V2_Data.Q_Explicit))))), - bs')))) - | (FStarC_Reflection_V2_Data.Pat_Var (uu___, uu___1), b::bs1) -> - FStar_Pervasives_Native.Some - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Var (binding_to_namedv b))), - bs1) - | (FStarC_Reflection_V2_Data.Pat_Dot_Term (FStar_Pervasives_Native.Some - t), uu___) -> FStar_Pervasives_Native.Some (t, bs) - | (FStarC_Reflection_V2_Data.Pat_Dot_Term - (FStar_Pervasives_Native.None), uu___) -> - FStar_Pervasives_Native.None - | uu___ -> FStar_Pervasives_Native.None -type ('dummyV0, 'dummyV1, 'dummyV2) typing = - | T_Token of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - comp_typ * unit - | T_Var of FStarC_Reflection_Types.env * FStarC_Reflection_Types.namedv - | T_FVar of FStarC_Reflection_Types.env * FStarC_Reflection_Types.fv - | T_UInst of FStarC_Reflection_Types.env * FStarC_Reflection_Types.fv * - FStarC_Reflection_Types.universe Prims.list - | T_Const of FStarC_Reflection_Types.env * FStarC_Reflection_V2_Data.vconst - * FStarC_Reflection_Types.term * (unit, unit) constant_typing - | T_Abs of FStarC_Reflection_Types.env * FStarC_Reflection_V2_Data.var * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * comp_typ * - FStarC_Reflection_Types.universe * pp_name_t * - FStarC_Reflection_V2_Data.aqualv * FStarC_TypeChecker_Core.tot_or_ghost * - (unit, unit, unit) typing * (unit, unit, unit) typing - | T_App of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.binder * - FStarC_Reflection_Types.term * FStarC_TypeChecker_Core.tot_or_ghost * - (unit, unit, unit) typing * (unit, unit, unit) typing - | T_Let of FStarC_Reflection_Types.env * FStarC_Reflection_V2_Data.var * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.typ * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.typ * - FStarC_TypeChecker_Core.tot_or_ghost * pp_name_t * (unit, unit, unit) - typing * (unit, unit, unit) typing - | T_Arrow of FStarC_Reflection_Types.env * FStarC_Reflection_V2_Data.var * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.universe * FStarC_Reflection_Types.universe * - pp_name_t * FStarC_Reflection_V2_Data.aqualv * - FStarC_TypeChecker_Core.tot_or_ghost * FStarC_TypeChecker_Core.tot_or_ghost - * FStarC_TypeChecker_Core.tot_or_ghost * (unit, unit, unit) typing * ( - unit, unit, unit) typing - | T_Refine of FStarC_Reflection_Types.env * FStarC_Reflection_V2_Data.var * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.universe * FStarC_Reflection_Types.universe * - FStarC_TypeChecker_Core.tot_or_ghost * FStarC_TypeChecker_Core.tot_or_ghost - * (unit, unit, unit) typing * (unit, unit, unit) typing - | T_PropIrrelevance of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * - FStarC_TypeChecker_Core.tot_or_ghost * FStarC_TypeChecker_Core.tot_or_ghost - * (unit, unit, unit) typing * (unit, unit, unit) typing - | T_Sub of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - comp_typ * comp_typ * (unit, unit, unit) typing * (unit, unit, unit, - unit) related_comp - | T_If of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.universe * - FStarC_Reflection_V2_Data.var * FStarC_TypeChecker_Core.tot_or_ghost * - FStarC_TypeChecker_Core.tot_or_ghost * (unit, unit, unit) typing * ( - unit, unit, unit) typing * (unit, unit, unit) typing * (unit, unit, - unit) typing - | T_Match of FStarC_Reflection_Types.env * FStarC_Reflection_Types.universe - * FStarC_Reflection_Types.typ * FStarC_Reflection_Types.term * - FStarC_TypeChecker_Core.tot_or_ghost * (unit, unit, unit) typing * - FStarC_TypeChecker_Core.tot_or_ghost * (unit, unit, unit) typing * - FStarC_Reflection_V2_Data.branch Prims.list * comp_typ * - FStarC_Reflection_V2_Data.binding Prims.list Prims.list * (unit, unit, - unit, unit, unit) match_is_complete * (unit, unit, unit, unit, unit, - unit, unit) branches_typing -and ('dummyV0, 'dummyV1, 'dummyV2, 'dummyV3) related = - | Rel_refl of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - relation - | Rel_sym of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * (unit, unit, unit, unit) related - | Rel_trans of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * relation * - (unit, unit, unit, unit) related * (unit, unit, unit, unit) related - | Rel_univ of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.universe * FStarC_Reflection_Types.universe * - (unit, unit) univ_eq - | Rel_beta of FStarC_Reflection_Types.env * FStarC_Reflection_Types.typ * - FStarC_Reflection_V2_Data.aqualv * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term - | Rel_eq_token of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * unit - | Rel_subtyping_token of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * unit - | Rel_equiv of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * relation * (unit, unit, unit, unit) related - - | Rel_arrow of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * FStarC_Reflection_V2_Data.aqualv * comp_typ - * comp_typ * relation * FStarC_Reflection_V2_Data.var * (unit, unit, - unit, unit) related * (unit, unit, unit, unit) related_comp - | Rel_abs of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * FStarC_Reflection_V2_Data.aqualv * - FStarC_Reflection_Types.term * FStarC_Reflection_Types.term * - FStarC_Reflection_V2_Data.var * (unit, unit, unit, unit) related * ( - unit, unit, unit, unit) related - | Rel_ctxt of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * term_ctxt * (unit, unit, unit, unit) related -and ('dummyV0, 'dummyV1, 'dummyV2, 'dummyV3) related_comp = - | Relc_typ of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.term * FStarC_TypeChecker_Core.tot_or_ghost * - relation * (unit, unit, unit, unit) related - | Relc_total_ghost of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.term - | Relc_ghost_total of FStarC_Reflection_Types.env * - FStarC_Reflection_Types.term * (unit, unit) non_informative -and ('g, 'scuu, 'scuty, 'sc, 'rty, 'dummyV0, 'dummyV1) branches_typing = - | BT_Nil - | BT_S of FStarC_Reflection_V2_Data.branch * - FStarC_Reflection_V2_Data.binding Prims.list * (unit, unit, unit, unit, - unit, unit, unit) branch_typing * FStarC_Reflection_V2_Data.branch - Prims.list * FStarC_Reflection_V2_Data.binding Prims.list Prims.list * - (unit, unit, unit, unit, unit, unit, unit) branches_typing -and ('g, 'scuu, 'scuty, 'sc, 'rty, 'dummyV0, 'dummyV1) branch_typing = - | BO of FStarC_Reflection_V2_Data.pattern * - FStarC_Reflection_V2_Data.binding Prims.list * - FStarC_Reflection_V2_Data.var * FStarC_Reflection_Types.term * unit * - (unit, unit, unit) typing -and ('dummyV0, 'dummyV1, 'dummyV2, 'dummyV3, 'dummyV4) match_is_complete = - | MC_Tok of FStarC_Reflection_Types.env * FStarC_Reflection_Types.term * - FStarC_Reflection_Types.typ * FStarC_Reflection_V2_Data.pattern Prims.list - * FStarC_Reflection_V2_Data.binding Prims.list Prims.list * unit -let uu___is_T_Token uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Token _ -> true | _ -> false -let uu___is_T_Var uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Var _ -> true | _ -> false -let uu___is_T_FVar uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_FVar _ -> true | _ -> false -let uu___is_T_UInst uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_UInst _ -> true | _ -> false -let uu___is_T_Const uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Const _ -> true | _ -> false -let uu___is_T_Abs uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Abs _ -> true | _ -> false -let uu___is_T_App uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_App _ -> true | _ -> false -let uu___is_T_Let uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Let _ -> true | _ -> false -let uu___is_T_Arrow uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Arrow _ -> true | _ -> false -let uu___is_T_Refine uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Refine _ -> true | _ -> false -let uu___is_T_PropIrrelevance uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_PropIrrelevance _ -> true | _ -> false -let uu___is_T_Sub uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Sub _ -> true | _ -> false -let uu___is_T_If uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_If _ -> true | _ -> false -let uu___is_T_Match uu___2 uu___1 uu___ uu___3 = - match uu___3 with | T_Match _ -> true | _ -> false -let uu___is_Rel_refl uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_refl _ -> true | _ -> false -let uu___is_Rel_sym uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_sym _ -> true | _ -> false -let uu___is_Rel_trans uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_trans _ -> true | _ -> false -let uu___is_Rel_univ uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_univ _ -> true | _ -> false -let uu___is_Rel_beta uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_beta _ -> true | _ -> false -let uu___is_Rel_eq_token uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_eq_token _ -> true | _ -> false -let uu___is_Rel_subtyping_token uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_subtyping_token _ -> true | _ -> false -let uu___is_Rel_equiv uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_equiv _ -> true | _ -> false -let uu___is_Rel_arrow uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_arrow _ -> true | _ -> false -let uu___is_Rel_abs uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_abs _ -> true | _ -> false -let uu___is_Rel_ctxt uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Rel_ctxt _ -> true | _ -> false -let uu___is_Relc_typ uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Relc_typ _ -> true | _ -> false -let uu___is_Relc_total_ghost uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Relc_total_ghost _ -> true | _ -> false -let uu___is_Relc_ghost_total uu___3 uu___2 uu___1 uu___ uu___4 = - match uu___4 with | Relc_ghost_total _ -> true | _ -> false -let uu___is_BT_Nil uu___6 uu___5 uu___4 uu___3 uu___2 uu___1 uu___ uu___7 = - match uu___7 with | BT_Nil _ -> true | _ -> false -let uu___is_BT_S uu___6 uu___5 uu___4 uu___3 uu___2 uu___1 uu___ uu___7 = - match uu___7 with | BT_S _ -> true | _ -> false -let uu___is_BO uu___6 uu___5 uu___4 uu___3 uu___2 uu___1 uu___ uu___7 = - match uu___7 with | BO _ -> true | _ -> false -let uu___is_MC_Tok uu___4 uu___3 uu___2 uu___1 uu___ uu___5 = - match uu___5 with | MC_Tok _ -> true | _ -> false -type ('g, 't1, 't2) sub_typing = (unit, unit, unit, unit) related -type ('g, 'c1, 'c2) sub_comp = (unit, unit, unit, unit) related_comp -type ('g, 't1, 't2) equiv = (unit, unit, unit, unit) related -type ('g, 'e, 't) tot_typing = (unit, unit, unit) typing -type ('g, 'e, 't) ghost_typing = (unit, unit, unit) typing -let (subtyping_token_renaming : - FStarC_Reflection_Types.env -> - bindings -> - bindings -> - FStarC_Reflection_V2_Data.var -> - FStarC_Reflection_V2_Data.var -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - (unit, unit, unit) FStarC_Tactics_Types.subtyping_token -> - (unit, unit, unit) FStarC_Tactics_Types.subtyping_token) - = - fun g -> - fun bs0 -> - fun bs1 -> - fun x -> - fun y -> fun t -> fun t0 -> fun t1 -> fun d -> Prims.magic () -let (subtyping_token_weakening : - FStarC_Reflection_Types.env -> - bindings -> - bindings -> - FStarC_Reflection_V2_Data.var -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - (unit, unit, unit) FStarC_Tactics_Types.subtyping_token -> - (unit, unit, unit) FStarC_Tactics_Types.subtyping_token) - = - fun g -> - fun bs0 -> - fun bs1 -> - fun x -> fun t -> fun t0 -> fun t1 -> fun d -> Prims.magic () -let (simplify_umax : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.universe -> - (unit, unit, unit) typing -> (unit, unit, unit) typing) - = - fun g -> - fun t -> - fun u -> - fun d -> - let ue = UN_MaxLeq (u, u, (UNLEQ_Refl u)) in - let du = Rel_univ (g, (u_max u u), u, ue) in - let du1 = - Rel_equiv (g, (tm_type (u_max u u)), (tm_type u), R_Sub, du) in - T_Sub - (g, t, (FStarC_TypeChecker_Core.E_Total, (tm_type (u_max u u))), - (FStarC_TypeChecker_Core.E_Total, (tm_type u)), d, - (Relc_typ - (g, (tm_type (u_max u u)), (tm_type u), - FStarC_TypeChecker_Core.E_Total, R_Sub, du1))) -let (equiv_arrow : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.typ -> - FStarC_Reflection_V2_Data.aqualv -> - FStarC_Reflection_V2_Data.var -> - (unit, unit, unit) equiv -> (unit, unit, unit) equiv) - = - fun g -> - fun e1 -> - fun e2 -> - fun ty -> - fun q -> - fun x -> - fun eq -> - let c1 = (FStarC_TypeChecker_Core.E_Total, e1) in - let c2 = (FStarC_TypeChecker_Core.E_Total, e2) in - Rel_arrow - (g, ty, ty, q, c1, c2, R_Eq, x, (Rel_refl (g, ty, R_Eq)), - (Relc_typ - ((extend_env g x ty), - (subst_term e1 (open_with_var x Prims.int_zero)), - (subst_term e2 (open_with_var x Prims.int_zero)), - (FStar_Pervasives_Native.fst c1), R_Eq, eq))) -let (equiv_abs_close : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.typ -> - FStarC_Reflection_V2_Data.aqualv -> - FStarC_Reflection_V2_Data.var -> - (unit, unit, unit) equiv -> (unit, unit, unit) equiv) - = - fun g -> - fun e1 -> - fun e2 -> - fun ty -> - fun q -> - fun x -> - fun eq -> - let eq1 = eq in - Rel_abs - (g, ty, ty, q, (subst_term e1 [ND (x, Prims.int_zero)]), - (subst_term e2 [ND (x, Prims.int_zero)]), x, - (Rel_refl (g, ty, R_Eq)), eq1) -type 'g fstar_env_fvs = unit -type fstar_env = FStarC_Reflection_Types.env -type fstar_top_env = fstar_env -type ('dummyV0, 'dummyV1) sigelt_typing = - | ST_Let of FStarC_Reflection_Types.env * FStarC_Reflection_Types.fv * - FStarC_Reflection_Types.typ * FStarC_Reflection_Types.term * unit - | ST_Let_Opaque of FStarC_Reflection_Types.env * FStarC_Reflection_Types.fv - * FStarC_Reflection_Types.typ * unit -let (uu___is_ST_Let : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> Prims.bool) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with - | ST_Let (g, fv, ty, tm, _4) -> true - | uu___2 -> false -let (__proj__ST_Let__item__g : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> FStarC_Reflection_Types.env) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | ST_Let (g, fv, ty, tm, _4) -> g -let (__proj__ST_Let__item__fv : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> FStarC_Reflection_Types.fv) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | ST_Let (g, fv, ty, tm, _4) -> fv -let (__proj__ST_Let__item__ty : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> FStarC_Reflection_Types.typ) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | ST_Let (g, fv, ty, tm, _4) -> ty -let (__proj__ST_Let__item__tm : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> FStarC_Reflection_Types.term) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | ST_Let (g, fv, ty, tm, _4) -> tm -let (uu___is_ST_Let_Opaque : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> Prims.bool) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with - | ST_Let_Opaque (g, fv, ty, _3) -> true - | uu___2 -> false -let (__proj__ST_Let_Opaque__item__g : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> FStarC_Reflection_Types.env) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | ST_Let_Opaque (g, fv, ty, _3) -> g -let (__proj__ST_Let_Opaque__item__fv : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> FStarC_Reflection_Types.fv) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | ST_Let_Opaque (g, fv, ty, _3) -> fv -let (__proj__ST_Let_Opaque__item__ty : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.sigelt -> - (unit, unit) sigelt_typing -> FStarC_Reflection_Types.typ) - = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | ST_Let_Opaque (g, fv, ty, _3) -> ty -type blob = (Prims.string * FStarC_Reflection_Types.term) -type ('s, 't) sigelt_has_type = Obj.t -type ('g, 't) sigelt_for = - (Prims.bool * FStarC_Reflection_Types.sigelt * blob - FStar_Pervasives_Native.option) -type ('g, 't) dsl_tac_result_t = - ((unit, unit) sigelt_for Prims.list * (unit, unit) sigelt_for * (unit, - unit) sigelt_for Prims.list) -type dsl_tac_t = - (fstar_top_env * FStarC_Reflection_Types.typ - FStar_Pervasives_Native.option) -> - ((unit, unit) dsl_tac_result_t, unit) FStar_Tactics_Effect.tac_repr -let (if_complete_match : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - (unit, unit, unit, unit, unit) - FStarC_Tactics_V2_Builtins.match_complete_token) - = fun g -> fun t -> Prims.magic () -let (mkif : - fstar_env -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.universe -> - FStarC_Reflection_V2_Data.var -> - FStarC_TypeChecker_Core.tot_or_ghost -> - FStarC_TypeChecker_Core.tot_or_ghost -> - (unit, unit, unit) typing -> - (unit, unit, unit) typing -> - (unit, unit, unit) typing -> - (unit, unit, unit) typing -> - (unit, unit, unit) typing) - = - fun g -> - fun scrutinee -> - fun then_ -> - fun else_ -> - fun ty -> - fun u_ty -> - fun hyp -> - fun eff -> - fun ty_eff -> - fun ts -> - fun tt -> - fun te -> - fun tr -> - let brt = - ((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_True), then_) in - let bre = - ((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_False), else_) in - let brty uu___ = - BT_S - (((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_True), - then_), [], - (BO - ((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_True), - [], hyp, then_, (), tt)), - [((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_False), - else_)], [[]], - (BT_S - (((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_False), - else_), [], - (BO - ((FStarC_Reflection_V2_Data.Pat_Constant - FStarC_Reflection_V2_Data.C_False), - [], hyp, else_, (), te)), [], [], - BT_Nil))) in - T_Match - (g, u_zero, bool_ty, scrutinee, - FStarC_TypeChecker_Core.E_Total, - (T_FVar (g, bool_fv)), eff, ts, [brt; bre], - (eff, ty), [[]; []], - (MC_Tok - (g, scrutinee, bool_ty, - (FStar_List_Tot_Base.map - FStar_Pervasives_Native.fst - [brt; bre]), [[]; []], ())), - (brty ())) -let (mk_checked_let : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.name -> - Prims.string -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.typ -> (unit, unit) sigelt_for) - = - fun g -> - fun cur_module -> - fun nm -> - fun tm -> - fun ty -> - let fv = - FStarC_Reflection_V2_Builtins.pack_fv - (FStar_List_Tot_Base.op_At cur_module [nm]) in - let lb = - FStarC_Reflection_V2_Builtins.pack_lb - { - FStarC_Reflection_V2_Data.lb_fv = fv; - FStarC_Reflection_V2_Data.lb_us = []; - FStarC_Reflection_V2_Data.lb_typ = ty; - FStarC_Reflection_V2_Data.lb_def = tm - } in - let se = - FStarC_Reflection_V2_Builtins.pack_sigelt - (FStarC_Reflection_V2_Data.Sg_Let (false, [lb])) in - let pf = ST_Let (g, fv, ty, tm, ()) in - (true, se, FStar_Pervasives_Native.None) -let (mk_unchecked_let : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.name -> - Prims.string -> - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.typ -> - (Prims.bool * FStarC_Reflection_Types.sigelt * blob - FStar_Pervasives_Native.option)) - = - fun g -> - fun cur_module -> - fun nm -> - fun tm -> - fun ty -> - let fv = - FStarC_Reflection_V2_Builtins.pack_fv - (FStar_List_Tot_Base.op_At cur_module [nm]) in - let lb = - FStarC_Reflection_V2_Builtins.pack_lb - { - FStarC_Reflection_V2_Data.lb_fv = fv; - FStarC_Reflection_V2_Data.lb_us = []; - FStarC_Reflection_V2_Data.lb_typ = ty; - FStarC_Reflection_V2_Data.lb_def = tm - } in - let se = - FStarC_Reflection_V2_Builtins.pack_sigelt - (FStarC_Reflection_V2_Data.Sg_Let (false, [lb])) in - (false, se, FStar_Pervasives_Native.None) -let (typing_to_token : - FStarC_Reflection_Types.env -> - FStarC_Reflection_Types.term -> - comp_typ -> - (unit, unit, unit) typing -> - (unit, unit, unit) FStarC_Tactics_Types.typing_token) - = fun g -> fun e -> fun c -> fun uu___ -> Prims.magic () \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V1.ml b/stage0/fstar-lib/generated/FStar_Reflection_V1.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Reflection_V1.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Reflection_V2.ml b/stage0/fstar-lib/generated/FStar_Reflection_V2.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Reflection_V2.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_ReflexiveTransitiveClosure.ml b/stage0/fstar-lib/generated/FStar_ReflexiveTransitiveClosure.ml deleted file mode 100644 index aad2f3b148b..00000000000 --- a/stage0/fstar-lib/generated/FStar_ReflexiveTransitiveClosure.ml +++ /dev/null @@ -1,115 +0,0 @@ -open Prims -type 'a binrel = unit -type 'a predicate = unit -type ('a, 'rel) reflexive = unit -type ('a, 'rel) transitive = unit -type ('a, 'rel) preorder_rel = unit -type 'a preorder = unit -type ('a, 'p, 'rel) stable = unit -type ('a, 'r, 'dummyV0, 'dummyV1) _closure = - | Refl of 'a - | Step of 'a * 'a * unit - | Closure of 'a * 'a * 'a * ('a, 'r, unit, unit) _closure * ('a, 'r, - unit, unit) _closure -let uu___is_Refl : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> Prims.bool = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | Refl x -> true | uu___2 -> false -let __proj__Refl__item__x : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> 'a = - fun uu___ -> - fun uu___1 -> fun projectee -> match projectee with | Refl x -> x -let uu___is_Step : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> Prims.bool = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with | Step (x, y, _2) -> true | uu___2 -> false -let __proj__Step__item__x : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> 'a = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Step (x, y, _2) -> x -let __proj__Step__item__y : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> 'a = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Step (x, y, _2) -> y -let uu___is_Closure : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> Prims.bool = - fun uu___ -> - fun uu___1 -> - fun projectee -> - match projectee with - | Closure (x, y, z, _3, _4) -> true - | uu___2 -> false -let __proj__Closure__item__x : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> 'a = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Closure (x, y, z, _3, _4) -> x -let __proj__Closure__item__y : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> 'a = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Closure (x, y, z, _3, _4) -> y -let __proj__Closure__item__z : - 'a 'r . 'a -> 'a -> ('a, 'r, unit, unit) _closure -> 'a = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Closure (x, y, z, _3, _4) -> z -let __proj__Closure__item___3 : - 'a 'r . - 'a -> - 'a -> ('a, 'r, unit, unit) _closure -> ('a, 'r, unit, unit) _closure - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Closure (x, y, z, _3, _4) -> _3 -let __proj__Closure__item___4 : - 'a 'r . - 'a -> - 'a -> ('a, 'r, unit, unit) _closure -> ('a, 'r, unit, unit) _closure - = - fun uu___ -> - fun uu___1 -> - fun projectee -> match projectee with | Closure (x, y, z, _3, _4) -> _4 -type ('a, 'r, 'x, 'y) _closure0 = unit -type ('a, 'r, 'uuuuu, 'uuuuu1) closure = unit -let rec closure_one_aux : - 'a 'r . - 'a -> - 'a -> - ('a, 'r, unit, unit) _closure -> - (unit, - ('a, unit, ('a, 'r, unit, unit) _closure) - FStar_Pervasives.dtuple3) - FStar_Pervasives.either - = - fun x -> - fun y -> - fun xy -> - match xy with - | Refl uu___ -> FStar_Pervasives.Inl () - | Step (uu___, uu___1, pr) -> - FStar_Pervasives.Inr - (FStar_Pervasives.Mkdtuple3 (y, (), (Refl y))) - | Closure (x1, i, y1, xi, iy) -> - (match closure_one_aux i y1 iy with - | FStar_Pervasives.Inl uu___ -> closure_one_aux x1 y1 xi - | FStar_Pervasives.Inr (FStar_Pervasives.Mkdtuple3 - (z, r_i_z, c_z_y)) -> - let c_z_y1 = c_z_y in - (match closure_one_aux x1 i xi with - | FStar_Pervasives.Inl uu___ -> - FStar_Pervasives.Inr - (FStar_Pervasives.Mkdtuple3 (z, (), c_z_y1)) - | FStar_Pervasives.Inr (FStar_Pervasives.Mkdtuple3 - (w, r_x_w, c_w_i)) -> - let step = Step (i, z, ()) in - let c_i_y = Closure (i, z, y1, step, c_z_y1) in - let c_w_y = Closure (w, i, y1, c_w_i, c_i_y) in - FStar_Pervasives.Inr - (FStar_Pervasives.Mkdtuple3 (w, (), c_w_y)))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Seq.ml b/stage0/fstar-lib/generated/FStar_Seq.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Seq.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Seq_Equiv.ml b/stage0/fstar-lib/generated/FStar_Seq_Equiv.ml deleted file mode 100644 index 9491e556421..00000000000 --- a/stage0/fstar-lib/generated/FStar_Seq_Equiv.ml +++ /dev/null @@ -1,7 +0,0 @@ -open Prims -type ('c, 'eq, 's1, 's2) eq_of_seq = Obj.t -let seq_equiv : - 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - 'c FStar_Seq_Base.seq FStar_Algebra_CommMonoid_Equiv.equiv - = fun eq -> FStar_Algebra_CommMonoid_Equiv.EQ ((), (), (), ()) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Seq_Permutation.ml b/stage0/fstar-lib/generated/FStar_Seq_Permutation.ml deleted file mode 100644 index 443de270dea..00000000000 --- a/stage0/fstar-lib/generated/FStar_Seq_Permutation.ml +++ /dev/null @@ -1,120 +0,0 @@ -open Prims -type ('a, 's) index_fun = - unit FStar_IntegerIntervals.under -> unit FStar_IntegerIntervals.under -type ('a, 's0, 's1, 'f) is_permutation = unit -type ('a, 's0, 's1) seqperm = ('a, unit) index_fun -let rec find : - 'a . - 'a -> - 'a FStar_Seq_Base.seq -> - ('a FStar_Seq_Base.seq * 'a FStar_Seq_Base.seq) - = - fun x -> - fun s -> - if (FStar_Seq_Properties.head s) = x - then ((FStar_Seq_Base.empty ()), (FStar_Seq_Properties.tail s)) - else - (let uu___1 = find x (FStar_Seq_Properties.tail s) in - match uu___1 with - | (pfx, sfx) -> - ((FStar_Seq_Base.cons (FStar_Seq_Properties.head s) pfx), sfx)) -let adapt_index_fun : - 'a . - 'a FStar_Seq_Base.seq -> - ('a, unit) index_fun -> Prims.nat -> ('a, unit) index_fun - = - fun s -> - fun f -> - fun n -> - fun i -> - if i = Prims.int_zero - then n - else - if (f (i - Prims.int_one)) < n - then f (i - Prims.int_one) - else (f (i - Prims.int_one)) + Prims.int_one -let rec permutation_from_equal_counts : - 'a . - 'a FStar_Seq_Base.seq -> - 'a FStar_Seq_Base.seq -> ('a, unit, unit) seqperm - = - fun s0 -> - fun s1 -> - if (FStar_Seq_Base.length s0) = Prims.int_zero - then let f i = i in f - else - (let uu___1 = find (FStar_Seq_Properties.head s0) s1 in - match uu___1 with - | (pfx, sfx) -> - let s1' = FStar_Seq_Base.append pfx sfx in - let f' = - permutation_from_equal_counts (FStar_Seq_Properties.tail s0) - s1' in - let n = FStar_Seq_Base.length pfx in - let f = adapt_index_fun s0 f' n in f) -let foldm_snoc : - 'a . - 'a FStar_Algebra_CommMonoid_Equiv.equiv -> - ('a, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - 'a FStar_Seq_Base.seq -> 'a - = - fun eq -> - fun m -> - fun s -> - FStar_Seq_Properties.foldr_snoc - (FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__mult eq m) s - (FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__unit eq m) -let remove_i : - 'a . 'a FStar_Seq_Base.seq -> Prims.nat -> ('a * 'a FStar_Seq_Base.seq) = - fun s -> - fun i -> - let uu___ = FStar_Seq_Properties.split s i in - match uu___ with - | (s0, s1) -> - ((FStar_Seq_Properties.head s1), - (FStar_Seq_Base.append s0 (FStar_Seq_Properties.tail s1))) -let shift_perm' : - 'a . - 'a FStar_Seq_Base.seq -> - 'a FStar_Seq_Base.seq -> - unit -> ('a, unit, unit) seqperm -> ('a, unit, unit) seqperm - = - fun s0 -> - fun s1 -> - fun uu___ -> - fun p -> - let uu___1 = FStar_Seq_Properties.un_snoc s0 in - match uu___1 with - | (s0', last) -> - let n = FStar_Seq_Base.length s0' in - let p' i = if (p i) < (p n) then p i else (p i) - Prims.int_one in - let uu___2 = remove_i s1 (p n) in - (match uu___2 with | (uu___3, s1') -> p') -let shift_perm : - 'a . - 'a FStar_Seq_Base.seq -> - 'a FStar_Seq_Base.seq -> - unit -> ('a, unit, unit) seqperm -> ('a, unit, unit) seqperm - = fun s0 -> fun s1 -> fun uu___ -> fun p -> shift_perm' s0 s1 () p -let init_func_from_expr : - 'c . - Prims.int -> - unit FStar_IntegerIntervals.not_less_than -> - ((unit, unit) FStar_IntegerIntervals.ifrom_ito -> 'c) -> - (unit, unit) FStar_IntegerIntervals.ifrom_ito -> - (unit, unit) FStar_IntegerIntervals.ifrom_ito -> - unit FStar_IntegerIntervals.under -> 'c - = fun n0 -> fun nk -> fun expr -> fun a -> fun b -> fun i -> expr (n0 + i) -let func_sum : - 'a 'c . - 'c FStar_Algebra_CommMonoid_Equiv.equiv -> - ('c, unit) FStar_Algebra_CommMonoid_Equiv.cm -> - ('a -> 'c) -> ('a -> 'c) -> 'a -> 'c - = - fun eq -> - fun cm -> - fun f -> - fun g -> - fun x -> - FStar_Algebra_CommMonoid_Equiv.__proj__CM__item__mult eq cm ( - f x) (g x) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Seq_Sorted.ml b/stage0/fstar-lib/generated/FStar_Seq_Sorted.ml deleted file mode 100644 index 2777fba5300..00000000000 --- a/stage0/fstar-lib/generated/FStar_Seq_Sorted.ml +++ /dev/null @@ -1,2 +0,0 @@ -open Prims -type ('a, 'f, 's) sorted_pred = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Sequence.ml b/stage0/fstar-lib/generated/FStar_Sequence.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Sequence.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Sequence_Ambient.ml b/stage0/fstar-lib/generated/FStar_Sequence_Ambient.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Sequence_Ambient.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Sequence_Base.ml b/stage0/fstar-lib/generated/FStar_Sequence_Base.ml deleted file mode 100644 index 10868b19335..00000000000 --- a/stage0/fstar-lib/generated/FStar_Sequence_Base.ml +++ /dev/null @@ -1,93 +0,0 @@ -open Prims -type 'ty seq = 'ty Prims.list -let length : 'ty . 'ty seq -> Prims.nat = - fun uu___ -> (Obj.magic FStar_List_Tot_Base.length) uu___ -let empty : 'ty . unit -> 'ty seq = - fun uu___ -> (fun uu___ -> Obj.magic []) uu___ -let singleton : 'ty . 'ty -> 'ty seq = - fun uu___ -> (fun v -> Obj.magic [v]) uu___ -let index : 'ty . 'ty seq -> Prims.nat -> 'ty = - fun s -> fun i -> FStar_List_Tot_Base.index (Obj.magic s) i -let op_Dollar_At : 'uuuuu . unit -> 'uuuuu seq -> Prims.nat -> 'uuuuu = - fun uu___ -> index -let build : 'ty . 'ty seq -> 'ty -> 'ty seq = - fun uu___1 -> - fun uu___ -> - (fun s -> - fun v -> Obj.magic (FStar_List_Tot_Base.append (Obj.magic s) [v])) - uu___1 uu___ -let op_Dollar_Colon_Colon : - 'uuuuu . unit -> 'uuuuu seq -> 'uuuuu -> 'uuuuu seq = fun uu___ -> build -let append : 'ty . 'ty seq -> 'ty seq -> 'ty seq = - fun uu___1 -> - fun uu___ -> (Obj.magic FStar_List_Tot_Base.append) uu___1 uu___ -let op_Dollar_Plus : 'uuuuu . unit -> 'uuuuu seq -> 'uuuuu seq -> 'uuuuu seq - = fun uu___ -> append -let update : 'ty . 'ty seq -> Prims.nat -> 'ty -> 'ty seq = - fun s -> - fun i -> - fun v -> - let uu___ = FStar_List_Tot_Base.split3 (Obj.magic s) i in - match uu___ with - | (s1, uu___1, s2) -> - append (Obj.magic s1) (append (Obj.magic [v]) (Obj.magic s2)) -type ('ty, 's, 'v) contains = Obj.t -let take : 'ty . 'ty seq -> Prims.nat -> 'ty seq = - fun uu___1 -> - fun uu___ -> - (fun s -> - fun howMany -> - let uu___ = FStar_List_Tot_Base.splitAt howMany (Obj.magic s) in - match uu___ with | (result, uu___1) -> Obj.magic result) uu___1 - uu___ -let drop : 'ty . 'ty seq -> Prims.nat -> 'ty seq = - fun uu___1 -> - fun uu___ -> - (fun s -> - fun howMany -> - let uu___ = FStar_List_Tot_Base.splitAt howMany (Obj.magic s) in - match uu___ with | (uu___1, result) -> Obj.magic result) uu___1 - uu___ -type ('ty, 's0, 's1) equal = unit -type ('uuuuu, 's0, 's1) op_Dollar_Equals_Equals = unit -type ('ty, 's0, 's1) is_prefix = unit -type ('uuuuu, 's0, 's1) op_Dollar_Less_Equals = unit -let rank : 'ty . 'ty -> 'ty = fun v -> v -type length_of_empty_is_zero_fact = unit -type length_zero_implies_empty_fact = unit -type singleton_length_one_fact = unit -type build_increments_length_fact = unit -type 'uuuuu index_into_build_fact = unit -type append_sums_lengths_fact = unit -type 'uuuuu index_into_singleton_fact = unit -type 'uuuuu index_after_append_fact = unit -type update_maintains_length_fact = unit -type update_then_index_fact = unit -type contains_iff_exists_index_fact = unit -type empty_doesnt_contain_anything_fact = unit -type build_contains_equiv_fact = unit -type take_contains_equiv_exists_fact = unit -type drop_contains_equiv_exists_fact = unit -type equal_def_fact = unit -type extensionality_fact = unit -type is_prefix_def_fact = unit -type take_length_fact = unit -type 'uuuuu index_into_take_fact = unit -type drop_length_fact = unit -type 'uuuuu index_into_drop_fact = unit -type 'uuuuu drop_index_offset_fact = unit -type 'uuuuu append_then_take_or_drop_fact = unit -type 'uuuuu take_commutes_with_in_range_update_fact = unit -type 'uuuuu take_ignores_out_of_range_update_fact = unit -type 'uuuuu drop_commutes_with_in_range_update_fact = unit -type 'uuuuu drop_ignores_out_of_range_update_fact = unit -type 'uuuuu drop_commutes_with_build_fact = unit -type rank_def_fact = unit -type element_ranks_less_fact = unit -type drop_ranks_less_fact = unit -type take_ranks_less_fact = unit -type append_take_drop_ranks_less_fact = unit -type drop_zero_fact = unit -type take_zero_fact = unit -type 'uuuuu drop_then_drop_fact = unit -type all_seq_facts = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Sequence_Permutation.ml b/stage0/fstar-lib/generated/FStar_Sequence_Permutation.ml deleted file mode 100644 index 7f0cbe6ebd3..00000000000 --- a/stage0/fstar-lib/generated/FStar_Sequence_Permutation.ml +++ /dev/null @@ -1,89 +0,0 @@ -open Prims -type 'n nat_at_most = Prims.nat -type ('a, 's) index_fun = unit nat_at_most -> unit nat_at_most -type ('a, 's0, 's1, 'f) is_permutation = unit -type ('a, 's0, 's1) seqperm = ('a, unit) index_fun -let rec find : - 'a . - 'a -> - 'a FStar_Sequence_Base.seq -> - ('a FStar_Sequence_Base.seq * 'a FStar_Sequence_Base.seq) - = - fun x -> - fun s -> - if (FStar_Sequence_Util.head s) = x - then ((FStar_Sequence_Base.empty ()), (FStar_Sequence_Util.tail s)) - else - (let uu___1 = find x (FStar_Sequence_Util.tail s) in - match uu___1 with - | (pfx, sfx) -> - ((FStar_Sequence_Util.cons (FStar_Sequence_Util.head s) pfx), - sfx)) -let rec permutation_from_equal_counts : - 'a . - 'a FStar_Sequence_Base.seq -> - 'a FStar_Sequence_Base.seq -> ('a, unit, unit) seqperm - = - fun s0 -> - fun s1 -> - if (FStar_Sequence_Base.length s0) = Prims.int_zero - then let f i = i in f - else - (let uu___1 = find (FStar_Sequence_Util.head s0) s1 in - match uu___1 with - | (pfx, sfx) -> - let s1' = FStar_Sequence_Base.append pfx sfx in - let f' = - permutation_from_equal_counts (FStar_Sequence_Util.tail s0) - s1' in - let n = FStar_Sequence_Base.length pfx in - let f i = - if i = Prims.int_zero - then n - else - if (f' (i - Prims.int_one)) < n - then f' (i - Prims.int_one) - else (f' (i - Prims.int_one)) + Prims.int_one in - f) -let foldm_back : - 'a . 'a FStar_Algebra_CommMonoid.cm -> 'a FStar_Sequence_Base.seq -> 'a = - fun m -> - fun s -> - FStar_Sequence_Util.fold_back - (FStar_Algebra_CommMonoid.__proj__CM__item__mult m) s - (FStar_Algebra_CommMonoid.__proj__CM__item__unit m) -let remove_i : - 'a . - 'a FStar_Sequence_Base.seq -> - Prims.nat -> ('a * 'a FStar_Sequence_Base.seq) - = - fun s -> - fun i -> - let uu___ = FStar_Sequence_Util.split s i in - match uu___ with - | (s0, s1) -> - ((FStar_Sequence_Util.head s1), - (FStar_Sequence_Base.append s0 (FStar_Sequence_Util.tail s1))) -let shift_perm' : - 'a . - 'a FStar_Sequence_Base.seq -> - 'a FStar_Sequence_Base.seq -> - unit -> ('a, unit, unit) seqperm -> ('a, unit, unit) seqperm - = - fun s0 -> - fun s1 -> - fun uu___ -> - fun p -> - let uu___1 = FStar_Sequence_Util.un_build s0 in - match uu___1 with - | (s0', last) -> - let n = FStar_Sequence_Base.length s0' in - let p' i = if (p i) < (p n) then p i else (p i) - Prims.int_one in - let uu___2 = remove_i s1 (p n) in - (match uu___2 with | (uu___3, s1') -> p') -let shift_perm : - 'a . - 'a FStar_Sequence_Base.seq -> - 'a FStar_Sequence_Base.seq -> - unit -> ('a, unit, unit) seqperm -> ('a, unit, unit) seqperm - = fun s0 -> fun s1 -> fun uu___ -> fun p -> shift_perm' s0 s1 () p \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Sequence_Seq.ml b/stage0/fstar-lib/generated/FStar_Sequence_Seq.ml deleted file mode 100644 index 6d78f4506e3..00000000000 --- a/stage0/fstar-lib/generated/FStar_Sequence_Seq.ml +++ /dev/null @@ -1,25 +0,0 @@ -open Prims -let rec sequence_of_seq : - 'a . 'a FStar_Seq_Base.seq -> 'a FStar_Sequence_Base.seq = - fun s -> - if (FStar_Seq_Base.length s) = Prims.int_zero - then FStar_Sequence_Base.empty () - else - (let uu___1 = FStar_Seq_Properties.un_snoc s in - match uu___1 with - | (prefix, last) -> - (FStar_Sequence_Base.op_Dollar_Colon_Colon ()) - (sequence_of_seq prefix) last) -let rec seq_of_sequence : - 'a . 'a FStar_Sequence_Base.seq -> 'a FStar_Seq_Base.seq = - fun s -> - if (FStar_Sequence_Base.length s) = Prims.int_zero - then FStar_Seq_Base.empty () - else - (let prefix = - FStar_Sequence_Base.take s - ((FStar_Sequence_Base.length s) - Prims.int_one) in - FStar_Seq_Properties.snoc (seq_of_sequence prefix) - ((FStar_Sequence_Base.op_Dollar_At ()) s - ((FStar_Sequence_Base.length s) - Prims.int_one))) -type ('a, 's, 'su) related = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Sequence_Util.ml b/stage0/fstar-lib/generated/FStar_Sequence_Util.ml deleted file mode 100644 index aeb20c05d8a..00000000000 --- a/stage0/fstar-lib/generated/FStar_Sequence_Util.ml +++ /dev/null @@ -1,58 +0,0 @@ -open Prims -let slice : - 'ty . - 'ty FStar_Sequence_Base.seq -> - Prims.nat -> Prims.nat -> 'ty FStar_Sequence_Base.seq - = - fun s -> - fun i -> - fun j -> FStar_Sequence_Base.drop (FStar_Sequence_Base.take s j) i -let cons : - 'a . 'a -> 'a FStar_Sequence_Base.seq -> 'a FStar_Sequence_Base.seq = - fun x -> - fun s -> FStar_Sequence_Base.append (FStar_Sequence_Base.singleton x) s -let head : 'a . 'a FStar_Sequence_Base.seq -> 'a = - fun s -> (FStar_Sequence_Base.op_Dollar_At ()) s Prims.int_zero -let tail : 'a . 'a FStar_Sequence_Base.seq -> 'a FStar_Sequence_Base.seq = - fun s -> FStar_Sequence_Base.drop s Prims.int_one -let un_build : - 'a . 'a FStar_Sequence_Base.seq -> ('a FStar_Sequence_Base.seq * 'a) = - fun s -> - ((FStar_Sequence_Base.take s - ((FStar_Sequence_Base.length s) - Prims.int_one)), - ((FStar_Sequence_Base.op_Dollar_At ()) s - ((FStar_Sequence_Base.length s) - Prims.int_one))) -let split : - 'a . - 'a FStar_Sequence_Base.seq -> - Prims.nat -> ('a FStar_Sequence_Base.seq * 'a FStar_Sequence_Base.seq) - = - fun s -> - fun i -> ((FStar_Sequence_Base.take s i), (FStar_Sequence_Base.drop s i)) -let rec count_matches : - 'a . ('a -> Prims.bool) -> 'a FStar_Sequence_Base.seq -> Prims.nat = - fun f -> - fun s -> - if (FStar_Sequence_Base.length s) = Prims.int_zero - then Prims.int_zero - else - if f (head s) - then Prims.int_one + (count_matches f (tail s)) - else count_matches f (tail s) -let count : 'a . 'a -> 'a FStar_Sequence_Base.seq -> Prims.nat = - fun x -> fun s -> count_matches (fun y -> x = y) s -let rec fold_back : - 'a 'b . ('b -> 'a -> 'a) -> 'b FStar_Sequence_Base.seq -> 'a -> 'a = - fun f -> - fun s -> - fun init -> - if (FStar_Sequence_Base.length s) = Prims.int_zero - then init - else - (let last = - (FStar_Sequence_Base.op_Dollar_At ()) s - ((FStar_Sequence_Base.length s) - Prims.int_one) in - let s1 = - FStar_Sequence_Base.take s - ((FStar_Sequence_Base.length s) - Prims.int_one) in - f last (fold_back f s1 init)) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_SizeT.ml b/stage0/fstar-lib/generated/FStar_SizeT.ml deleted file mode 100644 index a5100368e68..00000000000 --- a/stage0/fstar-lib/generated/FStar_SizeT.ml +++ /dev/null @@ -1,63 +0,0 @@ -open Prims -type t = - | Sz of FStar_UInt64.t -let (uu___is_Sz : t -> Prims.bool) = fun projectee -> true -let (__proj__Sz__item__x : t -> FStar_UInt64.t) = - fun projectee -> match projectee with | Sz x -> x -type 'x fits = unit -let (v : t -> Prims.nat) = fun x -> FStar_UInt64.v (__proj__Sz__item__x x) -let (uint_to_t : Prims.nat -> t) = fun x -> Sz (FStar_UInt64.uint_to_t x) -type fits_u32 = unit -type fits_u64 = unit -let (uint16_to_sizet : FStar_UInt16.t -> t) = - fun x -> uint_to_t (FStar_UInt16.v x) -let (uint32_to_sizet : FStar_UInt32.t -> t) = - fun x -> uint_to_t (FStar_UInt32.v x) -let (uint64_to_sizet : FStar_UInt64.t -> t) = - fun x -> uint_to_t (FStar_UInt64.v x) -let (sizet_to_uint32 : t -> FStar_UInt32.t) = - fun x -> FStar_Int_Cast.uint64_to_uint32 (__proj__Sz__item__x x) -let (sizet_to_uint64 : t -> FStar_UInt64.t) = fun x -> __proj__Sz__item__x x -let (add : t -> t -> t) = - fun x -> - fun y -> - Sz (FStar_UInt64.add (__proj__Sz__item__x x) (__proj__Sz__item__x y)) -let (sub : t -> t -> t) = - fun x -> - fun y -> - Sz (FStar_UInt64.sub (__proj__Sz__item__x x) (__proj__Sz__item__x y)) -let (mul : t -> t -> t) = - fun x -> - fun y -> - Sz (FStar_UInt64.mul (__proj__Sz__item__x x) (__proj__Sz__item__x y)) -let (div : t -> t -> t) = - fun x -> - fun y -> - let res_n = - FStar_UInt64.div (__proj__Sz__item__x x) (__proj__Sz__item__x y) in - let res = Sz res_n in res -let (rem : t -> t -> t) = - fun x -> - fun y -> - Sz (FStar_UInt64.rem (__proj__Sz__item__x x) (__proj__Sz__item__x y)) -let (gt : t -> t -> Prims.bool) = - fun x -> - fun y -> FStar_UInt64.gt (__proj__Sz__item__x x) (__proj__Sz__item__x y) -let (gte : t -> t -> Prims.bool) = - fun x -> - fun y -> FStar_UInt64.gte (__proj__Sz__item__x x) (__proj__Sz__item__x y) -let (lt : t -> t -> Prims.bool) = - fun x -> - fun y -> FStar_UInt64.lt (__proj__Sz__item__x x) (__proj__Sz__item__x y) -let (lte : t -> t -> Prims.bool) = - fun x -> - fun y -> FStar_UInt64.lte (__proj__Sz__item__x x) (__proj__Sz__item__x y) -let (op_Plus_Hat : t -> t -> t) = add -let (op_Subtraction_Hat : t -> t -> t) = sub -let (op_Star_Hat : t -> t -> t) = mul -let (op_Percent_Hat : t -> t -> t) = rem -let (op_Greater_Hat : t -> t -> Prims.bool) = gt -let (op_Greater_Equals_Hat : t -> t -> Prims.bool) = gte -let (op_Less_Hat : t -> t -> Prims.bool) = lt -let (op_Less_Equals_Hat : t -> t -> Prims.bool) = lte -let (__uint_to_t : Prims.int -> t) = fun x -> uint_to_t x \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Squash.ml b/stage0/fstar-lib/generated/FStar_Squash.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Squash.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_SquashProperties.ml b/stage0/fstar-lib/generated/FStar_SquashProperties.ml deleted file mode 100644 index 141fc597d5b..00000000000 --- a/stage0/fstar-lib/generated/FStar_SquashProperties.ml +++ /dev/null @@ -1,16 +0,0 @@ -open Prims -let bool_of_or : 'p 'q . ('p, 'q) Prims.sum -> Prims.bool = - fun t -> - match t with | Prims.Left uu___ -> true | Prims.Right uu___ -> false -type 'p pow = unit -type ('a, 'b) retract = - | MkR of unit * unit * unit -let uu___is_MkR : 'a 'b . ('a, 'b) retract -> Prims.bool = - fun projectee -> true -type ('a, 'b) retract_cond = - | MkC of unit * unit * unit -let uu___is_MkC : 'a 'b . ('a, 'b) retract_cond -> Prims.bool = - fun projectee -> true -let false_elim : 'a . unit -> 'a = - fun uu___ -> (fun f -> Obj.magic (failwith "unreachable")) uu___ -type u = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_StrongExcludedMiddle.ml b/stage0/fstar-lib/generated/FStar_StrongExcludedMiddle.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_StrongExcludedMiddle.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Arith.ml b/stage0/fstar-lib/generated/FStar_Tactics_Arith.ml deleted file mode 100644 index bb9726f0acc..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_Arith.ml +++ /dev/null @@ -1,222 +0,0 @@ -open Prims -let (is_arith_goal : - unit -> (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = FStar_Tactics_V2_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (24)) (Prims.of_int (12)) (Prims.of_int (24)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (25)) (Prims.of_int (4)) (Prims.of_int (27)) - (Prims.of_int (16))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun g -> - let uu___2 = - FStar_Reflection_V2_Arith.run_tm - (FStar_Reflection_V2_Arith.is_arith_prop g) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (25)) (Prims.of_int (10)) - (Prims.of_int (25)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (25)) (Prims.of_int (4)) - (Prims.of_int (27)) (Prims.of_int (16))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - match uu___3 with - | FStar_Pervasives.Inr uu___5 -> true - | uu___5 -> false)))) uu___2) -let rec (split_arith : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = is_arith_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (31)) (Prims.of_int (7)) (Prims.of_int (31)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (31)) (Prims.of_int (4)) (Prims.of_int (52)) - (Prims.of_int (7))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - if uu___2 - then - let uu___3 = FStarC_Tactics_V2_Builtins.prune "" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (33)) (Prims.of_int (8)) - (Prims.of_int (33)) (Prims.of_int (16))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (34)) (Prims.of_int (8)) - (Prims.of_int (35)) (Prims.of_int (14))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = - FStarC_Tactics_V2_Builtins.addns "Prims" in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Arith.fst" - (Prims.of_int (34)) (Prims.of_int (8)) - (Prims.of_int (34)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Arith.fst" - (Prims.of_int (35)) (Prims.of_int (8)) - (Prims.of_int (35)) - (Prims.of_int (14))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (FStar_Tactics_V2_Derived.smt ())) - uu___6))) uu___4)) - else - (let uu___4 = FStar_Tactics_V2_Derived.cur_goal () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (38)) (Prims.of_int (16)) - (Prims.of_int (38)) (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Arith.fst" - (Prims.of_int (39)) (Prims.of_int (8)) - (Prims.of_int (51)) (Prims.of_int (14))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun g -> - let uu___5 = - FStar_Reflection_V2_Formula.term_as_formula g in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Arith.fst" - (Prims.of_int (39)) - (Prims.of_int (14)) - (Prims.of_int (39)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Arith.fst" - (Prims.of_int (39)) - (Prims.of_int (8)) - (Prims.of_int (51)) - (Prims.of_int (14))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 with - | FStar_Reflection_V2_Formula.True_ -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.trivial - ())) - | FStar_Reflection_V2_Formula.And - (l, r) -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.seq - FStar_Tactics_V1_Logic.split - split_arith)) - | FStar_Reflection_V2_Formula.Implies - (p, q) -> - Obj.magic - (Obj.repr - (let uu___7 = - FStar_Tactics_V2_Logic.implies_intro - () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Arith.fst" - (Prims.of_int (45)) - (Prims.of_int (20)) - (Prims.of_int (45)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Arith.fst" - (Prims.of_int (46)) - (Prims.of_int (12)) - (Prims.of_int (46)) - (Prims.of_int (36))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - split_arith - FStar_Tactics_V2_Logic.l_revert)) - uu___8))) - | FStar_Reflection_V2_Formula.Forall - (_x, _sort, _p) -> - Obj.magic - (Obj.repr - (let uu___7 = - FStar_Tactics_V2_Logic.forall_intros - () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Arith.fst" - (Prims.of_int (48)) - (Prims.of_int (21)) - (Prims.of_int (48)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Arith.fst" - (Prims.of_int (49)) - (Prims.of_int (12)) - (Prims.of_int (49)) - (Prims.of_int (55))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun bs -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - split_arith - (fun uu___8 -> - FStar_Tactics_V2_Logic.l_revert_all - bs))) uu___8))) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> ())))) uu___6))) - uu___5)))) uu___2) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_BV_Lemmas.ml b/stage0/fstar-lib/generated/FStar_Tactics_BV_Lemmas.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_BV_Lemmas.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_BreakVC.ml b/stage0/fstar-lib/generated/FStar_Tactics_BreakVC.ml deleted file mode 100644 index f5cfccf40a3..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_BreakVC.ml +++ /dev/null @@ -1,31 +0,0 @@ -open Prims -type ('ps, 'p) break_wp' = unit FStar_Pervasives.spinoff -let (post : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = - FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.delta_fully - ["FStar.Tactics.BreakVC.mono_lem"; - "FStar.Tactics.BreakVC.break_wp'"]] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.BreakVC.fsti" - (Prims.of_int (13)) (Prims.of_int (2)) (Prims.of_int (13)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.BreakVC.fsti" - (Prims.of_int (14)) (Prims.of_int (2)) (Prims.of_int (14)) - (Prims.of_int (9))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> Obj.magic (FStar_Tactics_V2_Derived.trefl ())) uu___2) -type ('ps, 'p) break_wp = unit FStar_Pervasives.spinoff -type ('p, 'q) op_Equals_Equals_Greater_Greater = unit -let (break_vc : - unit -> (unit, unit FStar_Pervasives.spinoff) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - (fun uu___ -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ()))) - uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoid.ml b/stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoid.ml deleted file mode 100644 index 8bbd798af29..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoid.ml +++ /dev/null @@ -1,2732 +0,0 @@ -open Prims -let (term_eq : - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) - = FStar_Reflection_TermEq_Simple.term_eq -let (dump : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun m -> - let uu___ = FStarC_Tactics_V2_Builtins.debugging () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (35)) (Prims.of_int (24)) (Prims.of_int (35)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (35)) (Prims.of_int (21)) (Prims.of_int (35)) - (Prims.of_int (48))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - if uu___1 - then Obj.magic (Obj.repr (FStarC_Tactics_V2_Builtins.dump m)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())))) - uu___1) -type var = Prims.nat -type exp = - | Unit - | Var of var - | Mult of exp * exp -let (uu___is_Unit : exp -> Prims.bool) = - fun projectee -> match projectee with | Unit -> true | uu___ -> false -let (uu___is_Var : exp -> Prims.bool) = - fun projectee -> match projectee with | Var _0 -> true | uu___ -> false -let (__proj__Var__item___0 : exp -> var) = - fun projectee -> match projectee with | Var _0 -> _0 -let (uu___is_Mult : exp -> Prims.bool) = - fun projectee -> - match projectee with | Mult (_0, _1) -> true | uu___ -> false -let (__proj__Mult__item___0 : exp -> exp) = - fun projectee -> match projectee with | Mult (_0, _1) -> _0 -let (__proj__Mult__item___1 : exp -> exp) = - fun projectee -> match projectee with | Mult (_0, _1) -> _1 -let rec (exp_to_string : exp -> Prims.string) = - fun e -> - match e with - | Unit -> "Unit" - | Var x -> Prims.strcat "Var " (Prims.string_of_int x) - | Mult (e1, e2) -> - Prims.strcat "Mult (" - (Prims.strcat (exp_to_string e1) - (Prims.strcat ") (" (Prims.strcat (exp_to_string e2) ")"))) -type ('a, 'b) vmap = ((var * ('a * 'b)) Prims.list * ('a * 'b)) -let const : 'a 'b . 'a -> 'b -> ('a, 'b) vmap = - fun xa -> fun xb -> ([], (xa, xb)) -let select : 'a 'b . var -> ('a, 'b) vmap -> 'a = - fun x -> - fun vm -> - match FStar_List_Tot_Base.assoc x (FStar_Pervasives_Native.fst vm) with - | FStar_Pervasives_Native.Some (a1, uu___) -> a1 - | uu___ -> FStar_Pervasives_Native.fst (FStar_Pervasives_Native.snd vm) -let select_extra : 'a 'b . var -> ('a, 'b) vmap -> 'b = - fun x -> - fun vm -> - match FStar_List_Tot_Base.assoc x (FStar_Pervasives_Native.fst vm) with - | FStar_Pervasives_Native.Some (uu___, b1) -> b1 - | uu___ -> FStar_Pervasives_Native.snd (FStar_Pervasives_Native.snd vm) -let update : 'a 'b . var -> 'a -> 'b -> ('a, 'b) vmap -> ('a, 'b) vmap = - fun x -> - fun xa -> - fun xb -> - fun vm -> - (((x, (xa, xb)) :: (FStar_Pervasives_Native.fst vm)), - (FStar_Pervasives_Native.snd vm)) -let rec mdenote : - 'a 'b . 'a FStar_Algebra_CommMonoid.cm -> ('a, 'b) vmap -> exp -> 'a = - fun m -> - fun vm -> - fun e -> - match e with - | Unit -> FStar_Algebra_CommMonoid.__proj__CM__item__unit m - | Var x -> select x vm - | Mult (e1, e2) -> - FStar_Algebra_CommMonoid.__proj__CM__item__mult m - (mdenote m vm e1) (mdenote m vm e2) -let rec xsdenote : - 'a 'b . - 'a FStar_Algebra_CommMonoid.cm -> ('a, 'b) vmap -> var Prims.list -> 'a - = - fun m -> - fun vm -> - fun xs -> - match xs with - | [] -> FStar_Algebra_CommMonoid.__proj__CM__item__unit m - | x::[] -> select x vm - | x::xs' -> - FStar_Algebra_CommMonoid.__proj__CM__item__mult m (select x vm) - (xsdenote m vm xs') -let rec (flatten : exp -> var Prims.list) = - fun e -> - match e with - | Unit -> [] - | Var x -> [x] - | Mult (e1, e2) -> FStar_List_Tot_Base.op_At (flatten e1) (flatten e2) -type 'b permute = - unit -> (Obj.t, 'b) vmap -> var Prims.list -> var Prims.list -type ('b, 'p) permute_correct = unit -type ('b, 'p) permute_via_swaps = unit - -let (sort : unit permute) = - fun a -> - fun vm -> - FStar_List_Tot_Base.sortWith (FStar_List_Tot_Base.compare_of_bool (<)) -let sortWith : 'b . (Prims.nat -> Prims.nat -> Prims.int) -> 'b permute = - fun f -> fun a -> fun vm -> FStar_List_Tot_Base.sortWith f - - -let canon : 'a 'b . ('a, 'b) vmap -> 'b permute -> exp -> var Prims.list = - fun vm -> fun p -> fun e -> p () (Obj.magic vm) (flatten e) -let rec (where_aux : - Prims.nat -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term Prims.list -> - (Prims.nat FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun n -> - fun x -> - fun xs -> - match xs with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.None))) - | x'::xs' -> - Obj.magic - (Obj.repr - (let uu___ = - FStarC_Tactics_V2_Builtins.term_eq_old x x' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (239)) (Prims.of_int (18)) - (Prims.of_int (239)) (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (239)) (Prims.of_int (15)) - (Prims.of_int (239)) (Prims.of_int (73))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - if uu___1 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Pervasives_Native.Some n))) - else - Obj.magic - (Obj.repr - (where_aux (n + Prims.int_one) x xs'))) - uu___1)))) uu___2 uu___1 uu___ -let (where : - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term Prims.list -> - (Prims.nat FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = where_aux Prims.int_zero -let rec reification_aux : - 'a 'b . - (FStar_Tactics_NamedView.term -> ('a, unit) FStar_Tactics_Effect.tac_repr) - -> - FStar_Tactics_NamedView.term Prims.list -> - ('a, 'b) vmap -> - (FStar_Tactics_NamedView.term -> - ('b, unit) FStar_Tactics_Effect.tac_repr) - -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - ((exp * FStar_Tactics_NamedView.term Prims.list * ( - 'a, 'b) vmap), - unit) FStar_Tactics_Effect.tac_repr - = - fun unquotea -> - fun ts -> - fun vm -> - fun f -> - fun mult -> - fun unit -> - fun t -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Derived_Lemmas.collect_app_ref - t)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (246)) (Prims.of_int (15)) - (Prims.of_int (246)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (245)) (Prims.of_int (61)) - (Prims.of_int (263)) (Prims.of_int (21))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (hd, tl) -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun t1 -> - fun ts1 -> - fun vm1 -> - let uu___4 = where t1 ts1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (248)) - (Prims.of_int (10)) - (Prims.of_int (248)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (248)) - (Prims.of_int (4)) - (Prims.of_int (251)) - (Prims.of_int (62))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | FStar_Pervasives_Native.Some - v -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 - -> - ((Var v), - ts1, vm1)))) - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - FStar_List_Tot_Base.length - ts1)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (250)) - (Prims.of_int (27)) - (Prims.of_int (250)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (250)) - (Prims.of_int (39)) - (Prims.of_int (251)) - (Prims.of_int (62))))) - (Obj.magic - uu___6) - (fun uu___7 - -> - (fun - vfresh -> - let uu___7 - = - unquotea - t1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (250)) - (Prims.of_int (48)) - (Prims.of_int (250)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (251)) - (Prims.of_int (14)) - (Prims.of_int (251)) - (Prims.of_int (62))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun z -> - let uu___8 - = - let uu___9 - = f t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (251)) - (Prims.of_int (53)) - (Prims.of_int (251)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (251)) - (Prims.of_int (37)) - (Prims.of_int (251)) - (Prims.of_int (61))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - update - vfresh z - uu___10 - vm1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (251)) - (Prims.of_int (37)) - (Prims.of_int (251)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (251)) - (Prims.of_int (14)) - (Prims.of_int (251)) - (Prims.of_int (62))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - ((Var - vfresh), - (FStar_List_Tot_Base.op_At - ts1 - [t1]), - uu___9))))) - uu___8))) - uu___7)))) - uu___5))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (248)) - (Prims.of_int (4)) - (Prims.of_int (251)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (253)) - (Prims.of_int (2)) - (Prims.of_int (263)) - (Prims.of_int (21))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun fvar -> - let uu___3 = - let uu___4 = - FStar_Tactics_NamedView.inspect hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (253)) - (Prims.of_int (8)) - (Prims.of_int (253)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (253)) - (Prims.of_int (8)) - (Prims.of_int (253)) - (Prims.of_int (33))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (uu___5, - (FStar_List_Tot_Base.list_unref - tl)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (253)) - (Prims.of_int (8)) - (Prims.of_int (253)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (253)) - (Prims.of_int (2)) - (Prims.of_int (263)) - (Prims.of_int (21))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | (FStar_Tactics_NamedView.Tv_FVar - fv, - (t1, - FStarC_Reflection_V2_Data.Q_Explicit):: - (t2, - FStarC_Reflection_V2_Data.Q_Explicit)::[]) - -> - let uu___5 = - FStarC_Tactics_V2_Builtins.term_eq_old - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar - fv)) mult in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (255)) - (Prims.of_int (7)) - (Prims.of_int (255)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (255)) - (Prims.of_int (4)) - (Prims.of_int (259)) - (Prims.of_int (21))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - if uu___6 - then - let uu___7 - = - reification_aux - unquotea - ts vm f - mult unit - t1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (256)) - (Prims.of_int (27)) - (Prims.of_int (256)) - (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (256)) - (Prims.of_int (9)) - (Prims.of_int (258)) - (Prims.of_int (31))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - match uu___8 - with - | - (e1, ts1, - vm1) -> - let uu___9 - = - reification_aux - unquotea - ts1 vm1 f - mult unit - t2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (257)) - (Prims.of_int (27)) - (Prims.of_int (257)) - (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (256)) - (Prims.of_int (75)) - (Prims.of_int (258)) - (Prims.of_int (30))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - match uu___10 - with - | - (e2, ts2, - vm2) -> - ((Mult - (e1, e2)), - ts2, vm2))))) - uu___8)) - else - Obj.magic - (fvar t - ts vm)) - uu___6)) - | (uu___5, uu___6) -> - let uu___7 = - FStarC_Tactics_V2_Builtins.term_eq_old - t unit in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (261)) - (Prims.of_int (7)) - (Prims.of_int (261)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (261)) - (Prims.of_int (4)) - (Prims.of_int (263)) - (Prims.of_int (21))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - if uu___8 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - (Unit, - ts, vm)))) - else - Obj.magic - (Obj.repr - (fvar t - ts vm))) - uu___8))) - uu___4))) uu___3))) uu___1) -let reification : - 'b . - (FStar_Tactics_NamedView.term -> ('b, unit) FStar_Tactics_Effect.tac_repr) - -> - 'b -> - unit -> - (FStar_Tactics_NamedView.term -> - (Obj.t, unit) FStar_Tactics_Effect.tac_repr) - -> - (Obj.t -> - (FStar_Tactics_NamedView.term, unit) - FStar_Tactics_Effect.tac_repr) - -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - Obj.t -> - FStar_Tactics_NamedView.term Prims.list -> - ((exp Prims.list * (Obj.t, 'b) vmap), unit) - FStar_Tactics_Effect.tac_repr - = - fun f -> - fun def -> - fun a -> - fun unquotea -> - fun quotea -> - fun tmult -> - fun tunit -> - fun munit -> - fun ts -> - let uu___ = - FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota] tmult in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (270)) (Prims.of_int (20)) - (Prims.of_int (270)) (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (270)) (Prims.of_int (56)) - (Prims.of_int (282)) (Prims.of_int (30))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun tmult1 -> - let uu___1 = - FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota] tunit in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (271)) - (Prims.of_int (20)) - (Prims.of_int (271)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (271)) - (Prims.of_int (56)) - (Prims.of_int (282)) - (Prims.of_int (30))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun tunit1 -> - let uu___2 = - FStar_Tactics_Util.map - (FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota]) ts in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (272)) - (Prims.of_int (13)) - (Prims.of_int (272)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (272)) - (Prims.of_int (65)) - (Prims.of_int (282)) - (Prims.of_int (30))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun ts1 -> - let uu___3 = - FStar_Tactics_Util.fold_left - (fun uu___4 -> - fun t -> - match uu___4 with - | (es, vs, vm) -> - let uu___5 = - reification_aux - unquotea - vs vm f - tmult1 - tunit1 t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (279)) - (Prims.of_int (24)) - (Prims.of_int (279)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (278)) - (Prims.of_int (26)) - (Prims.of_int (280)) - (Prims.of_int (24))))) - (Obj.magic - uu___5) - (fun uu___6 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - match uu___6 - with - | - (e, vs1, - vm1) -> - ((e :: - es), vs1, - vm1)))) - ([], [], - (const munit def)) - ts1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (277)) - (Prims.of_int (4)) - (Prims.of_int (281)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (272)) - (Prims.of_int (65)) - (Prims.of_int (282)) - (Prims.of_int (30))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - match uu___4 - with - | (es, uu___6, - vm) -> - ((FStar_List_Tot_Base.rev - es), vm))))) - uu___3))) uu___2))) uu___1) -let rec (term_mem : - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term Prims.list -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___1 -> - fun uu___ -> - (fun x -> - fun uu___ -> - match uu___ with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> false))) - | hd::tl -> - Obj.magic - (Obj.repr - (let uu___1 = FStarC_Tactics_V2_Builtins.term_eq_old hd x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (287)) (Prims.of_int (17)) - (Prims.of_int (287)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (287)) (Prims.of_int (14)) - (Prims.of_int (287)) (Prims.of_int (62))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - if uu___2 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> true))) - else Obj.magic (Obj.repr (term_mem x tl))) - uu___2)))) uu___1 uu___ -let (unfold_topdown : - FStar_Tactics_NamedView.term Prims.list -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun ts -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun s -> - let uu___2 = term_mem s ts in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (291)) (Prims.of_int (5)) - (Prims.of_int (291)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (291)) (Prims.of_int (4)) - (Prims.of_int (291)) (Prims.of_int (22))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> (uu___3, Prims.int_zero))))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (291)) (Prims.of_int (4)) (Prims.of_int (291)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (292)) (Prims.of_int (4)) (Prims.of_int (297)) - (Prims.of_int (40))))) (Obj.magic uu___) - (fun uu___1 -> - (fun should_rewrite -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - fun uu___3 -> - let uu___4 = - FStarC_Tactics_V2_Builtins.norm - [FStar_Pervasives.delta] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (294)) (Prims.of_int (4)) - (Prims.of_int (294)) (Prims.of_int (16))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (295)) (Prims.of_int (4)) - (Prims.of_int (295)) (Prims.of_int (11))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic (FStar_Tactics_V2_Derived.trefl ())) - uu___5))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (294)) (Prims.of_int (4)) - (Prims.of_int (295)) (Prims.of_int (11))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (297)) (Prims.of_int (2)) - (Prims.of_int (297)) (Prims.of_int (40))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun rewrite -> - Obj.magic - (FStar_Tactics_V2_Derived.topdown_rewrite - should_rewrite rewrite)) uu___2))) uu___1) -let rec quote_list : - 'a . - FStar_Tactics_NamedView.term -> - ('a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - -> - 'a Prims.list -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun ta -> - fun quotea -> - fun xs -> - match xs with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "Nil"]))) - [(ta, FStarC_Reflection_V2_Data.Q_Implicit)]))) - | x::xs' -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = quotea x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (304)) - (Prims.of_int (31)) - (Prims.of_int (304)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (304)) - (Prims.of_int (30)) - (Prims.of_int (304)) - (Prims.of_int (52))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - (uu___4, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (304)) - (Prims.of_int (30)) - (Prims.of_int (304)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (303)) - (Prims.of_int (29)) - (Prims.of_int (305)) - (Prims.of_int (69))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - let uu___5 = - let uu___6 = - quote_list ta quotea xs' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (305)) - (Prims.of_int (31)) - (Prims.of_int (305)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (305)) - (Prims.of_int (30)) - (Prims.of_int (305)) - (Prims.of_int (68))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (uu___7, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (305)) - (Prims.of_int (30)) - (Prims.of_int (305)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (303)) - (Prims.of_int (29)) - (Prims.of_int (305)) - (Prims.of_int (69))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> [uu___6])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (303)) - (Prims.of_int (29)) - (Prims.of_int (305)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (303)) - (Prims.of_int (29)) - (Prims.of_int (305)) - (Prims.of_int (69))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> uu___3 :: - uu___5)))) uu___3) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (303)) - (Prims.of_int (29)) - (Prims.of_int (305)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (303)) - (Prims.of_int (29)) - (Prims.of_int (305)) - (Prims.of_int (69))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (ta, - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (303)) (Prims.of_int (29)) - (Prims.of_int (305)) (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (303)) (Prims.of_int (14)) - (Prims.of_int (305)) (Prims.of_int (69))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "Cons"]))) uu___1))))) - uu___2 uu___1 uu___ -let quote_vm : - 'a 'b . - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - ('a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - -> - ('b -> - (FStar_Tactics_NamedView.term, unit) - FStar_Tactics_Effect.tac_repr) - -> - ('a, 'b) vmap -> - (FStar_Tactics_NamedView.term, unit) - FStar_Tactics_Effect.tac_repr - = - fun ta -> - fun tb -> - fun quotea -> - fun quoteb -> - fun vm -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun p -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - quotea (FStar_Pervasives_Native.fst p) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (311)) - (Prims.of_int (12)) - (Prims.of_int (311)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (311)) - (Prims.of_int (11)) - (Prims.of_int (311)) - (Prims.of_int (39))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (uu___7, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (311)) - (Prims.of_int (11)) - (Prims.of_int (311)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) - (Prims.of_int (23)) - (Prims.of_int (311)) - (Prims.of_int (70))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - let uu___7 = - let uu___8 = - let uu___9 = - quoteb - (FStar_Pervasives_Native.snd p) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (311)) - (Prims.of_int (42)) - (Prims.of_int (311)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (311)) - (Prims.of_int (41)) - (Prims.of_int (311)) - (Prims.of_int (69))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> - (uu___10, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (311)) - (Prims.of_int (41)) - (Prims.of_int (311)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) - (Prims.of_int (23)) - (Prims.of_int (311)) - (Prims.of_int (70))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> [uu___9])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) - (Prims.of_int (23)) - (Prims.of_int (311)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) - (Prims.of_int (23)) - (Prims.of_int (311)) - (Prims.of_int (70))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> uu___6 :: - uu___8)))) uu___6) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) - (Prims.of_int (23)) - (Prims.of_int (311)) - (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) - (Prims.of_int (23)) - (Prims.of_int (311)) - (Prims.of_int (70))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (tb, - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) (Prims.of_int (23)) - (Prims.of_int (311)) (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) (Prims.of_int (23)) - (Prims.of_int (311)) (Prims.of_int (70))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - (ta, - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) (Prims.of_int (23)) - (Prims.of_int (311)) (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) (Prims.of_int (4)) - (Prims.of_int (311)) (Prims.of_int (70))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Pervasives"; - "Native"; - "Mktuple2"]))) uu___3)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (310)) (Prims.of_int (4)) - (Prims.of_int (311)) (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (311)) (Prims.of_int (73)) - (Prims.of_int (325)) (Prims.of_int (63))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun quote_pair -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Pervasives"; - "Native"; - "tuple2"]))) [ta; tb])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (312)) (Prims.of_int (19)) - (Prims.of_int (312)) (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (312)) (Prims.of_int (48)) - (Prims.of_int (325)) (Prims.of_int (63))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun t_a_star_b -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun p -> - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - quote_pair - (FStar_Pervasives_Native.snd - p) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (316)) - (Prims.of_int (7)) - (Prims.of_int (316)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (316)) - (Prims.of_int (6)) - (Prims.of_int (316)) - (Prims.of_int (38))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> - (uu___10, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (316)) - (Prims.of_int (6)) - (Prims.of_int (316)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (23)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - [uu___9])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (23)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (23)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - ((FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Const - (FStarC_Reflection_V2_Data.C_Int - (FStar_Pervasives_Native.fst - p)))), - FStarC_Reflection_V2_Data.Q_Explicit) - :: uu___8)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (23)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (23)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (t_a_star_b, - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (23)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (23)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "nat"]))), - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (23)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (4)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Pervasives"; - "Native"; - "Mktuple2"]))) - uu___5)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (314)) - (Prims.of_int (4)) - (Prims.of_int (316)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (316)) - (Prims.of_int (42)) - (Prims.of_int (325)) - (Prims.of_int (63))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun quote_map_entry -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Pervasives"; - "Native"; - "tuple2"]))) - [FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "nat"])); - t_a_star_b])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (317)) - (Prims.of_int (16)) - (Prims.of_int (317)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (317)) - (Prims.of_int (58)) - (Prims.of_int (325)) - (Prims.of_int (63))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun tyentry -> - let uu___4 = - quote_list tyentry - quote_map_entry - (FStar_Pervasives_Native.fst - vm) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (318)) - (Prims.of_int (14)) - (Prims.of_int (318)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (318)) - (Prims.of_int (60)) - (Prims.of_int (325)) - (Prims.of_int (63))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun tlist -> - let uu___5 = - quote_pair - ( - FStar_Pervasives_Native.snd - vm) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (320)) - (Prims.of_int (14)) - (Prims.of_int (320)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (324)) - (Prims.of_int (2)) - (Prims.of_int (325)) - (Prims.of_int (63))))) - (Obj.magic - uu___5) - (fun - tpair -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___6 -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Pervasives"; - "Native"; - "Mktuple2"]))) - [ - ((FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "list"]))) - [tyentry]), - FStarC_Reflection_V2_Data.Q_Implicit); - (t_a_star_b, - FStarC_Reflection_V2_Data.Q_Implicit); - (tlist, - FStarC_Reflection_V2_Data.Q_Explicit); - (tpair, - FStarC_Reflection_V2_Data.Q_Explicit)])))) - uu___5))) - uu___4))) uu___3))) - uu___2))) uu___1) -let rec (quote_exp : - exp -> (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - (fun e -> - match e with - | Unit -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "CanonCommMonoid"; "Unit"]))))) - | Var x -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommMonoid"; - "Var"]))) - [FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Const - (FStarC_Reflection_V2_Data.C_Int x))]))) - | Mult (e1, e2) -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = quote_exp e1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (331)) (Prims.of_int (36)) - (Prims.of_int (331)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (331)) (Prims.of_int (35)) - (Prims.of_int (331)) (Prims.of_int (63))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - let uu___4 = quote_exp e2 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (331)) - (Prims.of_int (50)) - (Prims.of_int (331)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (331)) - (Prims.of_int (35)) - (Prims.of_int (331)) - (Prims.of_int (63))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> [uu___5])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (331)) - (Prims.of_int (35)) - (Prims.of_int (331)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (331)) - (Prims.of_int (35)) - (Prims.of_int (331)) - (Prims.of_int (63))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> uu___2 :: uu___4)))) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (331)) (Prims.of_int (35)) - (Prims.of_int (331)) (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (331)) (Prims.of_int (18)) - (Prims.of_int (331)) (Prims.of_int (63))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommMonoid"; - "Mult"]))) uu___1))))) uu___ -let canon_monoid_aux : - 'a 'b . - FStar_Tactics_NamedView.term -> - (FStar_Tactics_NamedView.term -> - ('a, unit) FStar_Tactics_Effect.tac_repr) - -> - ('a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - 'a -> - FStar_Tactics_NamedView.term -> - ('b -> - (FStar_Tactics_NamedView.term, unit) - FStar_Tactics_Effect.tac_repr) - -> - (FStar_Tactics_NamedView.term -> - ('b, unit) FStar_Tactics_Effect.tac_repr) - -> - 'b -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun ta -> - fun unquotea -> - fun quotea -> - fun tm -> - fun tmult -> - fun tunit -> - fun munit -> - fun tb -> - fun quoteb -> - fun f -> - fun def -> - fun tp -> - fun tpc -> - let uu___ = FStarC_Tactics_V2_Builtins.norm [] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (338)) - (Prims.of_int (2)) - (Prims.of_int (338)) - (Prims.of_int (9))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (339)) - (Prims.of_int (2)) - (Prims.of_int (415)) - (Prims.of_int (42))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - let uu___3 = - FStar_Tactics_V2_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (339)) - (Prims.of_int (24)) - (Prims.of_int (339)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (339)) - (Prims.of_int (8)) - (Prims.of_int (339)) - (Prims.of_int (37))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_Reflection_V2_Formula.term_as_formula - uu___4)) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (339)) - (Prims.of_int (8)) - (Prims.of_int (339)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (339)) - (Prims.of_int (2)) - (Prims.of_int (415)) - (Prims.of_int (42))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStar_Reflection_V2_Formula.Comp - (FStar_Reflection_V2_Formula.Eq - (FStar_Pervasives_Native.Some - t), t1, t2) - -> - Obj.magic - (Obj.repr - (let uu___4 = - FStarC_Tactics_V2_Builtins.term_eq_old - t ta in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (343)) - (Prims.of_int (9)) - (Prims.of_int (343)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (343)) - (Prims.of_int (6)) - (Prims.of_int (414)) - (Prims.of_int (69))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - if uu___5 - then - Obj.magic - (Obj.repr - (let uu___6 - = - Obj.magic - (reification - f def () - (fun - uu___7 -> - (Obj.magic - unquotea) - uu___7) - (fun - uu___7 -> - (Obj.magic - quotea) - uu___7) - tmult - tunit - (Obj.magic - munit) - [t1; t2]) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (344)) - (Prims.of_int (14)) - (Prims.of_int (344)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (344)) - (Prims.of_int (8)) - (Prims.of_int (413)) - (Prims.of_int (32))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun - uu___7 -> - match uu___7 - with - | - (r1::r2::[], - vm) -> - Obj.magic - (Obj.repr - (let uu___8 - = - quote_vm - ta tb - quotea - quoteb vm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (352)) - (Prims.of_int (20)) - (Prims.of_int (352)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (352)) - (Prims.of_int (54)) - (Prims.of_int (410)) - (Prims.of_int (36))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun tvm - -> - let uu___9 - = - quote_exp - r1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (353)) - (Prims.of_int (20)) - (Prims.of_int (353)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (353)) - (Prims.of_int (35)) - (Prims.of_int (410)) - (Prims.of_int (36))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun tr1 - -> - let uu___10 - = - quote_exp - r2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (354)) - (Prims.of_int (20)) - (Prims.of_int (354)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (354)) - (Prims.of_int (35)) - (Prims.of_int (410)) - (Prims.of_int (36))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun tr2 - -> - let uu___11 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "eq2"]))) - [ - (ta, - FStarC_Reflection_V2_Data.Q_Implicit); - ((FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommMonoid"; - "mdenote"]))) - [ - (ta, - FStarC_Reflection_V2_Data.Q_Implicit); - (tb, - FStarC_Reflection_V2_Data.Q_Implicit); - (tm, - FStarC_Reflection_V2_Data.Q_Explicit); - (tvm, - FStarC_Reflection_V2_Data.Q_Explicit); - (tr1, - FStarC_Reflection_V2_Data.Q_Explicit)]), - FStarC_Reflection_V2_Data.Q_Explicit); - ((FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommMonoid"; - "mdenote"]))) - [ - (ta, - FStarC_Reflection_V2_Data.Q_Implicit); - (tb, - FStarC_Reflection_V2_Data.Q_Implicit); - (tm, - FStarC_Reflection_V2_Data.Q_Explicit); - (tvm, - FStarC_Reflection_V2_Data.Q_Explicit); - (tr2, - FStarC_Reflection_V2_Data.Q_Explicit)]), - FStarC_Reflection_V2_Data.Q_Explicit)])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (355)) - (Prims.of_int (25)) - (Prims.of_int (360)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (361)) - (Prims.of_int (10)) - (Prims.of_int (410)) - (Prims.of_int (36))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun teq - -> - let uu___12 - = - FStar_Tactics_V2_Derived.change_sq - teq in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (361)) - (Prims.of_int (10)) - (Prims.of_int (361)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (369)) - (Prims.of_int (10)) - (Prims.of_int (410)) - (Prims.of_int (36))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - let uu___14 - = - FStar_Tactics_MApply0.mapply0 - (FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommMonoid"; - "monoid_reflect"]))) - [ - (ta, - FStarC_Reflection_V2_Data.Q_Implicit); - (tb, - FStarC_Reflection_V2_Data.Q_Implicit); - (tp, - FStarC_Reflection_V2_Data.Q_Explicit); - (tpc, - FStarC_Reflection_V2_Data.Q_Explicit)]) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (369)) - (Prims.of_int (10)) - (Prims.of_int (372)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (374)) - (Prims.of_int (10)) - (Prims.of_int (410)) - (Prims.of_int (36))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - let uu___16 - = - unfold_topdown - [ - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommMonoid"; - "canon"])); - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommMonoid"; - "xsdenote"])); - tp] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (374)) - (Prims.of_int (10)) - (Prims.of_int (374)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (378)) - (Prims.of_int (10)) - (Prims.of_int (410)) - (Prims.of_int (36))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - Obj.magic - (FStarC_Tactics_V2_Builtins.norm - [ - FStar_Pervasives.delta_only - ["FStar.Tactics.CanonCommMonoid.canon"; - "FStar.Tactics.CanonCommMonoid.xsdenote"; - "FStar.Tactics.CanonCommMonoid.flatten"; - "FStar.Tactics.CanonCommMonoid.select"; - "FStar.Tactics.CanonCommMonoid.select_extra"; - "FStar.Tactics.CanonCommMonoid.quote_list"; - "FStar.Tactics.CanonCommMonoid.quote_vm"; - "FStar.Tactics.CanonCommMonoid.quote_exp"; - "FStar.Tactics.CanonCommMonoid.const_compare"; - "FStar.Tactics.CanonCommMonoid.special_compare"; - "FStar.Pervasives.Native.fst"; - "FStar.Pervasives.Native.snd"; - "FStar.Pervasives.Native.__proj__Mktuple2__item___1"; - "FStar.Pervasives.Native.__proj__Mktuple2__item___2"; - "FStar.List.Tot.Base.assoc"; - "FStar.List.Tot.Base.op_At"; - "FStar.List.Tot.Base.append"; - "SL.AutoTactic.compare_b"; - "SL.AutoTactic.compare_v"; - "FStar.Order.int_of_order"; - "FStar.Reflection.V2.Compare.compare_term"; - "FStar.List.Tot.Base.sortWith"; - "FStar.List.Tot.Base.partition"; - "FStar.List.Tot.Base.bool_of_compare"; - "FStar.List.Tot.Base.compare_of_bool"]; - FStar_Pervasives.zeta; - FStar_Pervasives.iota; - FStar_Pervasives.primops])) - uu___17))) - uu___15))) - uu___13))) - uu___12))) - uu___11))) - uu___10))) - uu___9))) - | - uu___8 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Unexpected"))) - uu___7))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Goal should be an equality at the right monoid type"))) - uu___5))) - | uu___4 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Goal should be an equality"))) - uu___3))) uu___1) -let canon_monoid_with : - 'b . - (FStar_Tactics_NamedView.term -> ('b, unit) FStar_Tactics_Effect.tac_repr) - -> - 'b -> - 'b permute -> - unit -> - unit -> - Obj.t FStar_Algebra_CommMonoid.cm -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun f -> - fun def -> - fun p -> - fun pc -> - fun a -> - fun m -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___1)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (421)) (Prims.of_int (4)) - (Prims.of_int (421)) (Prims.of_int (13))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (420)) (Prims.of_int (2)) - (Prims.of_int (423)) (Prims.of_int (86))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___3)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (422)) (Prims.of_int (4)) - (Prims.of_int (422)) (Prims.of_int (13))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (420)) (Prims.of_int (2)) - (Prims.of_int (423)) (Prims.of_int (86))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___5)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (422)) - (Prims.of_int (14)) - (Prims.of_int (422)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (420)) - (Prims.of_int (2)) - (Prims.of_int (423)) - (Prims.of_int (86))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - (fun uu___7 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___7)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (422)) - (Prims.of_int (35)) - (Prims.of_int (422)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (420)) - (Prims.of_int (2)) - (Prims.of_int (423)) - (Prims.of_int (86))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - let uu___8 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - (fun uu___9 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___9)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (423)) - (Prims.of_int (4)) - (Prims.of_int (423)) - (Prims.of_int (13))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (420)) - (Prims.of_int (2)) - (Prims.of_int (423)) - (Prims.of_int (86))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun uu___9 -> - let uu___10 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - (fun - uu___11 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___11)) in - Obj.magic - ( - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (423)) - (Prims.of_int (43)) - (Prims.of_int (423)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (420)) - (Prims.of_int (2)) - (Prims.of_int (423)) - (Prims.of_int (86))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - let uu___12 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - (fun - uu___13 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___13)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (423)) - (Prims.of_int (53)) - (Prims.of_int (423)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (420)) - (Prims.of_int (2)) - (Prims.of_int (423)) - (Prims.of_int (86))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - Obj.magic - (canon_monoid_aux - uu___1 - FStarC_Tactics_V2_Builtins.unquote - (fun - uu___14 - -> - (fun x -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - (fun - uu___14 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___14))) - uu___14) - uu___3 - uu___5 - uu___7 - (FStar_Algebra_CommMonoid.__proj__CM__item__unit - m) uu___9 - (fun - uu___14 - -> - (fun x -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - (fun - uu___14 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___14))) - uu___14) - f def - uu___11 - uu___13)) - uu___13))) - uu___11))) - uu___9))) - uu___7))) uu___5))) - uu___3))) uu___1) -let canon_monoid : - 'a . - 'a FStar_Algebra_CommMonoid.cm -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun cm -> - canon_monoid_with - (fun uu___ -> - (fun uu___ -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> ()))) - uu___) () (fun a1 -> sort ()) () () (Obj.magic cm) -let (is_const : - FStar_Tactics_NamedView.term -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = FStar_Tactics_NamedView.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (441)) (Prims.of_int (45)) (Prims.of_int (441)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoid.fst" - (Prims.of_int (441)) (Prims.of_int (35)) (Prims.of_int (441)) - (Prims.of_int (56))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> FStar_Tactics_NamedView.uu___is_Tv_Const uu___1)) -let const_compare : 'a . ('a, Prims.bool) vmap -> var -> var -> Prims.int = - fun vm -> - fun x -> - fun y -> - match ((select_extra x vm), (select_extra y vm)) with - | (false, false) -> FStar_List_Tot_Base.compare_of_bool (<) x y - | (true, true) -> FStar_List_Tot_Base.compare_of_bool (<) x y - | (false, true) -> Prims.int_one - | (true, false) -> (Prims.of_int (-1)) -let const_last : - 'a . ('a, Prims.bool) vmap -> var Prims.list -> var Prims.list = - fun vm -> fun xs -> FStar_List_Tot_Base.sortWith (const_compare vm) xs -let canon_monoid_const : - 'a . - 'a FStar_Algebra_CommMonoid.cm -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun cm -> - canon_monoid_with is_const false (fun a1 -> const_last) () () - (Obj.magic cm) -let (is_special : - FStar_Tactics_NamedView.term Prims.list -> - FStar_Tactics_NamedView.term -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = fun ts -> fun t -> term_mem t ts -let special_compare : 'a . ('a, Prims.bool) vmap -> var -> var -> Prims.int = - fun vm -> - fun x -> - fun y -> - match ((select_extra x vm), (select_extra y vm)) with - | (false, false) -> Prims.int_zero - | (true, true) -> FStar_List_Tot_Base.compare_of_bool (<) x y - | (false, true) -> (Prims.of_int (-1)) - | (true, false) -> Prims.int_one -let special_first : - 'a . ('a, Prims.bool) vmap -> var Prims.list -> var Prims.list = - fun vm -> fun xs -> FStar_List_Tot_Base.sortWith (special_compare vm) xs - -let canon_monoid_special : - 'uuuuu . - FStar_Tactics_NamedView.term Prims.list -> - 'uuuuu FStar_Algebra_CommMonoid.cm -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun ts -> - Obj.magic - (canon_monoid_with (is_special ts) false (fun a -> special_first) - () ())) uu___1 uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoidSimple.ml b/stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoidSimple.ml deleted file mode 100644 index 3ffc6be99d4..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommMonoidSimple.ml +++ /dev/null @@ -1,1130 +0,0 @@ -open Prims -let (term_eq : - FStarC_Reflection_Types.term -> - FStarC_Reflection_Types.term -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = FStarC_Tactics_V2_Builtins.term_eq_old -let (dump : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun m -> - let uu___ = FStarC_Tactics_V2_Builtins.debugging () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (36)) (Prims.of_int (16)) (Prims.of_int (36)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (36)) (Prims.of_int (13)) (Prims.of_int (36)) - (Prims.of_int (40))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - if uu___1 - then Obj.magic (Obj.repr (FStarC_Tactics_V2_Builtins.dump m)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())))) - uu___1) -type atom = Prims.nat -type exp = - | Unit - | Mult of exp * exp - | Atom of atom -let (uu___is_Unit : exp -> Prims.bool) = - fun projectee -> match projectee with | Unit -> true | uu___ -> false -let (uu___is_Mult : exp -> Prims.bool) = - fun projectee -> - match projectee with | Mult (_0, _1) -> true | uu___ -> false -let (__proj__Mult__item___0 : exp -> exp) = - fun projectee -> match projectee with | Mult (_0, _1) -> _0 -let (__proj__Mult__item___1 : exp -> exp) = - fun projectee -> match projectee with | Mult (_0, _1) -> _1 -let (uu___is_Atom : exp -> Prims.bool) = - fun projectee -> match projectee with | Atom _0 -> true | uu___ -> false -let (__proj__Atom__item___0 : exp -> atom) = - fun projectee -> match projectee with | Atom _0 -> _0 -let rec (exp_to_string : exp -> Prims.string) = - fun e -> - match e with - | Unit -> "Unit" - | Atom x -> Prims.strcat "Atom " (Prims.string_of_int x) - | Mult (e1, e2) -> - Prims.strcat "Mult (" - (Prims.strcat (exp_to_string e1) - (Prims.strcat ") (" (Prims.strcat (exp_to_string e2) ")"))) -type 'a amap = ((atom * 'a) Prims.list * 'a) -let const : 'a . 'a -> 'a amap = fun xa -> ([], xa) -let select : 'a . atom -> 'a amap -> 'a = - fun x -> - fun am -> - match FStar_List_Tot_Base.assoc x (FStar_Pervasives_Native.fst am) with - | FStar_Pervasives_Native.Some a1 -> a1 - | uu___ -> FStar_Pervasives_Native.snd am -let update : 'a . atom -> 'a -> 'a amap -> 'a amap = - fun x -> - fun xa -> - fun am -> - (((x, xa) :: (FStar_Pervasives_Native.fst am)), - (FStar_Pervasives_Native.snd am)) -let rec mdenote : 'a . 'a FStar_Algebra_CommMonoid.cm -> 'a amap -> exp -> 'a - = - fun m -> - fun am -> - fun e -> - match e with - | Unit -> FStar_Algebra_CommMonoid.__proj__CM__item__unit m - | Atom x -> select x am - | Mult (e1, e2) -> - FStar_Algebra_CommMonoid.__proj__CM__item__mult m - (mdenote m am e1) (mdenote m am e2) -let rec xsdenote : - 'a . 'a FStar_Algebra_CommMonoid.cm -> 'a amap -> atom Prims.list -> 'a = - fun m -> - fun am -> - fun xs -> - match xs with - | [] -> FStar_Algebra_CommMonoid.__proj__CM__item__unit m - | x::[] -> select x am - | x::xs' -> - FStar_Algebra_CommMonoid.__proj__CM__item__mult m (select x am) - (xsdenote m am xs') -let rec (flatten : exp -> atom Prims.list) = - fun e -> - match e with - | Unit -> [] - | Atom x -> [x] - | Mult (e1, e2) -> FStar_List_Tot_Base.op_At (flatten e1) (flatten e2) -type permute = atom Prims.list -> atom Prims.list -type 'p permute_correct = unit -type 'p permute_via_swaps = unit - -let (sort : permute) = - FStar_List_Tot_Base.sortWith (FStar_List_Tot_Base.compare_of_bool (<)) - -let (canon : exp -> atom Prims.list) = fun e -> sort (flatten e) -let rec (where_aux : - Prims.nat -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term Prims.list -> - (Prims.nat FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun n -> - fun x -> - fun xs -> - match xs with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.None))) - | x'::xs' -> - Obj.magic - (Obj.repr - (let uu___ = term_eq x x' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (217)) (Prims.of_int (18)) - (Prims.of_int (217)) (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (217)) (Prims.of_int (15)) - (Prims.of_int (217)) (Prims.of_int (69))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - if uu___1 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Pervasives_Native.Some n))) - else - Obj.magic - (Obj.repr - (where_aux (n + Prims.int_one) x xs'))) - uu___1)))) uu___2 uu___1 uu___ -let (where : - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term Prims.list -> - (Prims.nat FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = where_aux Prims.int_zero -let rec reification_aux : - 'a . - FStar_Tactics_NamedView.term Prims.list -> - 'a amap -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - ((exp * FStar_Tactics_NamedView.term Prims.list * 'a amap), - unit) FStar_Tactics_Effect.tac_repr - = - fun ts -> - fun am -> - fun mult -> - fun unit -> - fun t -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Derived_Lemmas.collect_app_ref t)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (223)) (Prims.of_int (15)) - (Prims.of_int (223)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (222)) (Prims.of_int (79)) - (Prims.of_int (240)) (Prims.of_int (22))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (hd, tl) -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun t1 -> - fun ts1 -> - fun am1 -> - let uu___4 = where t1 ts1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (225)) - (Prims.of_int (10)) - (Prims.of_int (225)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (225)) - (Prims.of_int (4)) - (Prims.of_int (228)) - (Prims.of_int (57))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | FStar_Pervasives_Native.Some - v -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - ((Atom v), - ts1, am1)))) - | FStar_Pervasives_Native.None - -> - Obj.magic - (Obj.repr - (let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 - -> - FStar_List_Tot_Base.length - ts1)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (227)) - (Prims.of_int (27)) - (Prims.of_int (227)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (227)) - (Prims.of_int (39)) - (Prims.of_int (228)) - (Prims.of_int (57))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun vfresh -> - let uu___7 - = - FStarC_Tactics_V2_Builtins.unquote - t1 in - Obj.magic - ( - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (227)) - (Prims.of_int (48)) - (Prims.of_int (227)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (228)) - (Prims.of_int (14)) - (Prims.of_int (228)) - (Prims.of_int (57))))) - (Obj.magic - uu___7) - (fun z -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - ((Atom - vfresh), - (FStar_List_Tot_Base.op_At - ts1 - [t1]), - (update - vfresh z - am1)))))) - uu___7)))) - uu___5))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (225)) (Prims.of_int (4)) - (Prims.of_int (228)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (230)) (Prims.of_int (2)) - (Prims.of_int (240)) - (Prims.of_int (22))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun fatom -> - let uu___3 = - let uu___4 = - FStar_Tactics_NamedView.inspect hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (230)) - (Prims.of_int (8)) - (Prims.of_int (230)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (230)) - (Prims.of_int (8)) - (Prims.of_int (230)) - (Prims.of_int (33))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (uu___5, - (FStar_List_Tot_Base.list_unref - tl)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (230)) - (Prims.of_int (8)) - (Prims.of_int (230)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (230)) - (Prims.of_int (2)) - (Prims.of_int (240)) - (Prims.of_int (22))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | (FStar_Tactics_NamedView.Tv_FVar - fv, - (t1, - FStarC_Reflection_V2_Data.Q_Explicit):: - (t2, - FStarC_Reflection_V2_Data.Q_Explicit)::[]) - -> - let uu___5 = - term_eq - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar - fv)) mult in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (232)) - (Prims.of_int (7)) - (Prims.of_int (232)) - (Prims.of_int (39))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (232)) - (Prims.of_int (4)) - (Prims.of_int (236)) - (Prims.of_int (22))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - if uu___6 - then - let uu___7 = - reification_aux - ts am mult - unit t1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (233)) - (Prims.of_int (27)) - (Prims.of_int (233)) - (Prims.of_int (61))))) - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (233)) - (Prims.of_int (9)) - (Prims.of_int (235)) - (Prims.of_int (31))))) - ( - Obj.magic - uu___7) - ( - fun - uu___8 -> - (fun - uu___8 -> - match uu___8 - with - | - (e1, ts1, - am1) -> - let uu___9 - = - reification_aux - ts1 am1 - mult unit - t2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (234)) - (Prims.of_int (27)) - (Prims.of_int (234)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (233)) - (Prims.of_int (64)) - (Prims.of_int (235)) - (Prims.of_int (30))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - match uu___10 - with - | - (e2, ts2, - am2) -> - ((Mult - (e1, e2)), - ts2, am2))))) - uu___8)) - else - Obj.magic - (fatom t ts - am)) - uu___6)) - | (uu___5, uu___6) -> - let uu___7 = term_eq t unit in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (238)) - (Prims.of_int (7)) - (Prims.of_int (238)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (238)) - (Prims.of_int (4)) - (Prims.of_int (240)) - (Prims.of_int (22))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - if uu___8 - then - Obj.magic - (Obj.repr - ( - FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - (Unit, - ts, am)))) - else - Obj.magic - (Obj.repr - ( - fatom t - ts am))) - uu___8))) uu___4))) - uu___3))) uu___1) -let reification : - 'a . - 'a FStar_Algebra_CommMonoid.cm -> - FStar_Tactics_NamedView.term Prims.list -> - 'a amap -> - FStar_Tactics_NamedView.term -> - ((exp * FStar_Tactics_NamedView.term Prims.list * 'a amap), - unit) FStar_Tactics_Effect.tac_repr - = - fun m -> - fun ts -> - fun am -> - fun t -> - let uu___ = - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (244)) (Prims.of_int (41)) - (Prims.of_int (244)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (244)) (Prims.of_int (13)) - (Prims.of_int (244)) (Prims.of_int (61))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota] uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (244)) (Prims.of_int (13)) - (Prims.of_int (244)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (244)) (Prims.of_int (64)) - (Prims.of_int (247)) (Prims.of_int (35))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun mult -> - let uu___1 = - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (245)) (Prims.of_int (41)) - (Prims.of_int (245)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (245)) (Prims.of_int (13)) - (Prims.of_int (245)) (Prims.of_int (61))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota] uu___3)) uu___3) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (245)) (Prims.of_int (13)) - (Prims.of_int (245)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (245)) (Prims.of_int (64)) - (Prims.of_int (247)) (Prims.of_int (35))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun unit -> - let uu___2 = - FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota] t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (246)) - (Prims.of_int (13)) - (Prims.of_int (246)) - (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (247)) - (Prims.of_int (2)) - (Prims.of_int (247)) - (Prims.of_int (35))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun t1 -> - Obj.magic - (reification_aux ts am mult unit t1)) - uu___3))) uu___2))) uu___1) -let canon_monoid : - 'a . - 'a FStar_Algebra_CommMonoid.cm -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun m -> - let uu___ = FStarC_Tactics_V2_Builtins.norm [] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (250)) (Prims.of_int (2)) (Prims.of_int (250)) - (Prims.of_int (9))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (251)) (Prims.of_int (2)) (Prims.of_int (274)) - (Prims.of_int (42))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - let uu___3 = FStar_Tactics_V2_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (251)) (Prims.of_int (24)) - (Prims.of_int (251)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (251)) (Prims.of_int (8)) - (Prims.of_int (251)) (Prims.of_int (37))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (FStar_Reflection_V2_Formula.term_as_formula uu___4)) - uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (251)) (Prims.of_int (8)) - (Prims.of_int (251)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (251)) (Prims.of_int (2)) - (Prims.of_int (274)) (Prims.of_int (42))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStar_Reflection_V2_Formula.Comp - (FStar_Reflection_V2_Formula.Eq - (FStar_Pervasives_Native.Some t), t1, t2) - -> - Obj.magic - (Obj.repr - (let uu___4 = - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (255)) - (Prims.of_int (19)) - (Prims.of_int (255)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (255)) - (Prims.of_int (9)) - (Prims.of_int (255)) - (Prims.of_int (28))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic (term_eq t uu___6)) - uu___6) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (255)) - (Prims.of_int (9)) - (Prims.of_int (255)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (255)) - (Prims.of_int (6)) - (Prims.of_int (273)) - (Prims.of_int (69))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - if uu___5 - then - Obj.magic - (Obj.repr - (let uu___6 = - reification m [] - (const - (FStar_Algebra_CommMonoid.__proj__CM__item__unit - m)) t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (256)) - (Prims.of_int (27)) - (Prims.of_int (256)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (255)) - (Prims.of_int (33)) - (Prims.of_int (271)) - (Prims.of_int (22))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - match uu___7 with - | (r1, ts, am) -> - let uu___8 = - reification m - ts am t2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (257)) - (Prims.of_int (26)) - (Prims.of_int (257)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (256)) - (Prims.of_int (70)) - (Prims.of_int (271)) - (Prims.of_int (22))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - (fun - uu___9 -> - match uu___9 - with - | - (r2, - uu___10, - am1) -> - let uu___11 - = - let uu___12 - = - let uu___13 - = - let uu___14 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___15)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (258)) - (Prims.of_int (39)) - (Prims.of_int (258)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (258)) - (Prims.of_int (24)) - (Prims.of_int (258)) - (Prims.of_int (49))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (FStarC_Tactics_V2_Builtins.term_to_string - uu___15)) - uu___15) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (258)) - (Prims.of_int (24)) - (Prims.of_int (258)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - Prims.strcat - "am =" - uu___14)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (258)) - (Prims.of_int (14)) - (Prims.of_int (258)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (258)) - (Prims.of_int (9)) - (Prims.of_int (258)) - (Prims.of_int (50))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - Obj.magic - (dump - uu___13)) - uu___13) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (258)) - (Prims.of_int (9)) - (Prims.of_int (258)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (259)) - (Prims.of_int (8)) - (Prims.of_int (271)) - (Prims.of_int (22))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - let uu___13 - = - let uu___14 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___15)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (259)) - (Prims.of_int (18)) - (Prims.of_int (259)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (259)) - (Prims.of_int (8)) - (Prims.of_int (259)) - (Prims.of_int (62))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (FStar_Tactics_V2_Derived.change_sq - uu___15)) - uu___15) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (259)) - (Prims.of_int (8)) - (Prims.of_int (259)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (265)) - (Prims.of_int (8)) - (Prims.of_int (271)) - (Prims.of_int (22))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - uu___14 - -> - let uu___15 - = - FStar_Tactics_V2_Derived.apply - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommMonoidSimple"; - "monoid_reflect"]))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (265)) - (Prims.of_int (8)) - (Prims.of_int (265)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommMonoidSimple.fst" - (Prims.of_int (267)) - (Prims.of_int (8)) - (Prims.of_int (271)) - (Prims.of_int (22))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - Obj.magic - (FStarC_Tactics_V2_Builtins.norm - [ - FStar_Pervasives.delta_only - ["FStar.Tactics.CanonCommMonoidSimple.canon"; - "FStar.Tactics.CanonCommMonoidSimple.xsdenote"; - "FStar.Tactics.CanonCommMonoidSimple.flatten"; - "FStar.Tactics.CanonCommMonoidSimple.sort"; - "FStar.Tactics.CanonCommMonoidSimple.select"; - "FStar.List.Tot.Base.assoc"; - "FStar.Pervasives.Native.fst"; - "FStar.Pervasives.Native.__proj__Mktuple2__item___1"; - "FStar.List.Tot.Base.op_At"; - "FStar.List.Tot.Base.append"; - "FStar.List.Tot.Base.sortWith"; - "FStar.List.Tot.Base.partition"; - "FStar.List.Tot.Base.bool_of_compare"; - "FStar.List.Tot.Base.compare_of_bool"]; - FStar_Pervasives.primops])) - uu___16))) - uu___14))) - uu___12))) - uu___9))) - uu___7))) - else - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Goal should be an equality at the right monoid type"))) - uu___5))) - | uu___4 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Goal should be an equality"))) uu___3))) - uu___1) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommSemiring.ml b/stage0/fstar-lib/generated/FStar_Tactics_CanonCommSemiring.ml deleted file mode 100644 index 8a86d9a7be4..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_CanonCommSemiring.ml +++ /dev/null @@ -1,3116 +0,0 @@ -open Prims -let (term_eq : - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) - = FStar_Reflection_TermEq_Simple.term_eq -type ('a, 'cmuadd, 'cmumult) distribute_left_lemma = unit -type ('a, 'cmuadd, 'cmumult) distribute_right_lemma = unit -type ('a, 'cmuadd, 'cmumult) mult_zero_l_lemma = unit -type ('a, 'cmuadd, 'opp) add_opp_r_lemma = unit -type 'a cr = - | CR of 'a FStar_Algebra_CommMonoid.cm * 'a FStar_Algebra_CommMonoid.cm * - ('a -> 'a) * unit * unit * unit -let uu___is_CR : 'a . 'a cr -> Prims.bool = fun projectee -> true -let __proj__CR__item__cm_add : 'a . 'a cr -> 'a FStar_Algebra_CommMonoid.cm = - fun projectee -> - match projectee with - | CR (cm_add, cm_mult, opp, add_opp, distribute, mult_zero_l) -> cm_add -let __proj__CR__item__cm_mult : 'a . 'a cr -> 'a FStar_Algebra_CommMonoid.cm - = - fun projectee -> - match projectee with - | CR (cm_add, cm_mult, opp, add_opp, distribute, mult_zero_l) -> cm_mult -let __proj__CR__item__opp : 'a . 'a cr -> 'a -> 'a = - fun projectee -> - match projectee with - | CR (cm_add, cm_mult, opp, add_opp, distribute, mult_zero_l) -> opp - - - - -let norm_fully : 'a . 'a -> 'a = fun x -> x -type index = Prims.nat -type varlist = - | Nil_var - | Cons_var of index * varlist -let (uu___is_Nil_var : varlist -> Prims.bool) = - fun projectee -> match projectee with | Nil_var -> true | uu___ -> false -let (uu___is_Cons_var : varlist -> Prims.bool) = - fun projectee -> - match projectee with | Cons_var (_0, _1) -> true | uu___ -> false -let (__proj__Cons_var__item___0 : varlist -> index) = - fun projectee -> match projectee with | Cons_var (_0, _1) -> _0 -let (__proj__Cons_var__item___1 : varlist -> varlist) = - fun projectee -> match projectee with | Cons_var (_0, _1) -> _1 -type 'a canonical_sum = - | Nil_monom - | Cons_monom of 'a * varlist * 'a canonical_sum - | Cons_varlist of varlist * 'a canonical_sum -let uu___is_Nil_monom : 'a . 'a canonical_sum -> Prims.bool = - fun projectee -> match projectee with | Nil_monom -> true | uu___ -> false -let uu___is_Cons_monom : 'a . 'a canonical_sum -> Prims.bool = - fun projectee -> - match projectee with | Cons_monom (_0, _1, _2) -> true | uu___ -> false -let __proj__Cons_monom__item___0 : 'a . 'a canonical_sum -> 'a = - fun projectee -> match projectee with | Cons_monom (_0, _1, _2) -> _0 -let __proj__Cons_monom__item___1 : 'a . 'a canonical_sum -> varlist = - fun projectee -> match projectee with | Cons_monom (_0, _1, _2) -> _1 -let __proj__Cons_monom__item___2 : 'a . 'a canonical_sum -> 'a canonical_sum - = fun projectee -> match projectee with | Cons_monom (_0, _1, _2) -> _2 -let uu___is_Cons_varlist : 'a . 'a canonical_sum -> Prims.bool = - fun projectee -> - match projectee with | Cons_varlist (_0, _1) -> true | uu___ -> false -let __proj__Cons_varlist__item___0 : 'a . 'a canonical_sum -> varlist = - fun projectee -> match projectee with | Cons_varlist (_0, _1) -> _0 -let __proj__Cons_varlist__item___1 : - 'a . 'a canonical_sum -> 'a canonical_sum = - fun projectee -> match projectee with | Cons_varlist (_0, _1) -> _1 -let rec (varlist_lt : varlist -> varlist -> Prims.bool) = - fun x -> - fun y -> - match (x, y) with - | (Nil_var, Cons_var (uu___, uu___1)) -> true - | (Cons_var (i, xs), Cons_var (j, ys)) -> - if i < j then true else (i = j) && (varlist_lt xs ys) - | (uu___, uu___1) -> false -let rec (varlist_merge : varlist -> varlist -> varlist) = - fun l1 -> - fun l2 -> - match (l1, l2) with - | (uu___, Nil_var) -> l1 - | (Nil_var, uu___) -> l2 - | (Cons_var (v1, t1), Cons_var (v2, t2)) -> vm_aux v1 t1 l2 -and (vm_aux : index -> varlist -> varlist -> varlist) = - fun v1 -> - fun t1 -> - fun l2 -> - match l2 with - | Cons_var (v2, t2) -> - if v1 < v2 - then Cons_var (v1, (varlist_merge t1 l2)) - else Cons_var (v2, (vm_aux v1 t1 t2)) - | uu___ -> Cons_var (v1, t1) -let rec canonical_sum_merge : - 'a . 'a cr -> 'a canonical_sum -> 'a canonical_sum -> 'a canonical_sum = - fun r -> - fun s1 -> - fun s2 -> - let aplus = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_add r) in - let aone = - FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_mult r) in - match s1 with - | Cons_monom (c1, l1, t1) -> csm_aux r c1 l1 t1 s2 - | Cons_varlist (l1, t1) -> csm_aux r aone l1 t1 s2 - | Nil_monom -> s2 -and csm_aux : - 'a . - 'a cr -> - 'a -> - varlist -> 'a canonical_sum -> 'a canonical_sum -> 'a canonical_sum - = - fun r -> - fun c1 -> - fun l1 -> - fun t1 -> - fun s2 -> - let aplus = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_add r) in - let aone = - FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_mult r) in - match s2 with - | Cons_monom (c2, l2, t2) -> - if l1 = l2 - then - Cons_monom - ((aplus c1 c2), l1, (canonical_sum_merge r t1 t2)) - else - if varlist_lt l1 l2 - then Cons_monom (c1, l1, (canonical_sum_merge r t1 s2)) - else Cons_monom (c2, l2, (csm_aux r c1 l1 t1 t2)) - | Cons_varlist (l2, t2) -> - if l1 = l2 - then - Cons_monom - ((aplus c1 aone), l1, (canonical_sum_merge r t1 t2)) - else - if varlist_lt l1 l2 - then Cons_monom (c1, l1, (canonical_sum_merge r t1 s2)) - else Cons_varlist (l2, (csm_aux r c1 l1 t1 t2)) - | Nil_monom -> Cons_monom (c1, l1, t1) -let rec monom_insert : - 'a . 'a cr -> 'a -> varlist -> 'a canonical_sum -> 'a canonical_sum = - fun r -> - fun c1 -> - fun l1 -> - fun s2 -> - let aplus = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_add r) in - let aone = - FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_mult r) in - match s2 with - | Cons_monom (c2, l2, t2) -> - if l1 = l2 - then Cons_monom ((aplus c1 c2), l1, t2) - else - if varlist_lt l1 l2 - then Cons_monom (c1, l1, s2) - else Cons_monom (c2, l2, (monom_insert r c1 l1 t2)) - | Cons_varlist (l2, t2) -> - if l1 = l2 - then Cons_monom ((aplus c1 aone), l1, t2) - else - if varlist_lt l1 l2 - then Cons_monom (c1, l1, s2) - else Cons_varlist (l2, (monom_insert r c1 l1 t2)) - | Nil_monom -> - if c1 = aone - then Cons_varlist (l1, Nil_monom) - else Cons_monom (c1, l1, Nil_monom) -let varlist_insert : - 'a . 'a cr -> varlist -> 'a canonical_sum -> 'a canonical_sum = - fun r -> - fun l1 -> - fun s2 -> - let aone = - FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_mult r) in - monom_insert r aone l1 s2 -let rec canonical_sum_scalar : - 'a . 'a cr -> 'a -> 'a canonical_sum -> 'a canonical_sum = - fun r -> - fun c0 -> - fun s -> - let amult = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_mult r) in - match s with - | Cons_monom (c, l, t) -> - Cons_monom ((amult c0 c), l, (canonical_sum_scalar r c0 t)) - | Cons_varlist (l, t) -> - Cons_monom (c0, l, (canonical_sum_scalar r c0 t)) - | Nil_monom -> Nil_monom -let rec canonical_sum_scalar2 : - 'a . 'a cr -> varlist -> 'a canonical_sum -> 'a canonical_sum = - fun r -> - fun l0 -> - fun s -> - match s with - | Cons_monom (c, l, t) -> - monom_insert r c (varlist_merge l0 l) - (canonical_sum_scalar2 r l0 t) - | Cons_varlist (l, t) -> - varlist_insert r (varlist_merge l0 l) - (canonical_sum_scalar2 r l0 t) - | Nil_monom -> Nil_monom -let rec canonical_sum_scalar3 : - 'a . 'a cr -> 'a -> varlist -> 'a canonical_sum -> 'a canonical_sum = - fun r -> - fun c0 -> - fun l0 -> - fun s -> - let amult = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_mult r) in - match s with - | Cons_monom (c, l, t) -> - monom_insert r (amult c0 c) (varlist_merge l0 l) - (canonical_sum_scalar3 r c0 l0 t) - | Cons_varlist (l, t) -> - monom_insert r c0 (varlist_merge l0 l) - (canonical_sum_scalar3 r c0 l0 t) - | Nil_monom -> s -let rec canonical_sum_prod : - 'a . 'a cr -> 'a canonical_sum -> 'a canonical_sum -> 'a canonical_sum = - fun r -> - fun s1 -> - fun s2 -> - match s1 with - | Cons_monom (c1, l1, t1) -> - canonical_sum_merge r (canonical_sum_scalar3 r c1 l1 s2) - (canonical_sum_prod r t1 s2) - | Cons_varlist (l1, t1) -> - canonical_sum_merge r (canonical_sum_scalar2 r l1 s2) - (canonical_sum_prod r t1 s2) - | Nil_monom -> s1 -type 'a spolynomial = - | SPvar of index - | SPconst of 'a - | SPplus of 'a spolynomial * 'a spolynomial - | SPmult of 'a spolynomial * 'a spolynomial -let uu___is_SPvar : 'a . 'a spolynomial -> Prims.bool = - fun projectee -> match projectee with | SPvar _0 -> true | uu___ -> false -let __proj__SPvar__item___0 : 'a . 'a spolynomial -> index = - fun projectee -> match projectee with | SPvar _0 -> _0 -let uu___is_SPconst : 'a . 'a spolynomial -> Prims.bool = - fun projectee -> match projectee with | SPconst _0 -> true | uu___ -> false -let __proj__SPconst__item___0 : 'a . 'a spolynomial -> 'a = - fun projectee -> match projectee with | SPconst _0 -> _0 -let uu___is_SPplus : 'a . 'a spolynomial -> Prims.bool = - fun projectee -> - match projectee with | SPplus (_0, _1) -> true | uu___ -> false -let __proj__SPplus__item___0 : 'a . 'a spolynomial -> 'a spolynomial = - fun projectee -> match projectee with | SPplus (_0, _1) -> _0 -let __proj__SPplus__item___1 : 'a . 'a spolynomial -> 'a spolynomial = - fun projectee -> match projectee with | SPplus (_0, _1) -> _1 -let uu___is_SPmult : 'a . 'a spolynomial -> Prims.bool = - fun projectee -> - match projectee with | SPmult (_0, _1) -> true | uu___ -> false -let __proj__SPmult__item___0 : 'a . 'a spolynomial -> 'a spolynomial = - fun projectee -> match projectee with | SPmult (_0, _1) -> _0 -let __proj__SPmult__item___1 : 'a . 'a spolynomial -> 'a spolynomial = - fun projectee -> match projectee with | SPmult (_0, _1) -> _1 -let rec spolynomial_normalize : - 'a . 'a cr -> 'a spolynomial -> 'a canonical_sum = - fun r -> - fun p -> - match p with - | SPvar i -> Cons_varlist ((Cons_var (i, Nil_var)), Nil_monom) - | SPconst c -> Cons_monom (c, Nil_var, Nil_monom) - | SPplus (l, q) -> - canonical_sum_merge r (spolynomial_normalize r l) - (spolynomial_normalize r q) - | SPmult (l, q) -> - canonical_sum_prod r (spolynomial_normalize r l) - (spolynomial_normalize r q) -let rec canonical_sum_simplify : - 'a . 'a cr -> 'a canonical_sum -> 'a canonical_sum = - fun r -> - fun s -> - let azero = - FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_add r) in - let aone = - FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_mult r) in - let aplus = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_add r) in - match s with - | Cons_monom (c, l, t) -> - if c = azero - then canonical_sum_simplify r t - else - if c = aone - then Cons_varlist (l, (canonical_sum_simplify r t)) - else Cons_monom (c, l, (canonical_sum_simplify r t)) - | Cons_varlist (l, t) -> Cons_varlist (l, (canonical_sum_simplify r t)) - | Nil_monom -> s -let spolynomial_simplify : 'a . 'a cr -> 'a spolynomial -> 'a canonical_sum = - fun r -> fun p -> canonical_sum_simplify r (spolynomial_normalize r p) -type var = Prims.nat -type 'a vmap = ((var * 'a) Prims.list * 'a) -let update : 'a . var -> 'a -> 'a vmap -> 'a vmap = - fun x -> - fun xa -> - fun vm -> - let uu___ = vm in match uu___ with | (l, y) -> (((x, xa) :: l), y) -let rec quote_list : - 'a . - FStar_Tactics_NamedView.term -> - ('a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - -> - 'a Prims.list -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun ta -> - fun quotea -> - fun xs -> - match xs with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "Nil"]))) - [(ta, FStarC_Reflection_V2_Data.Q_Implicit)]))) - | x::xs' -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = quotea x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (397)) - (Prims.of_int (30)) - (Prims.of_int (397)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (397)) - (Prims.of_int (29)) - (Prims.of_int (397)) - (Prims.of_int (51))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - (uu___4, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (397)) - (Prims.of_int (29)) - (Prims.of_int (397)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (396)) - (Prims.of_int (29)) - (Prims.of_int (398)) - (Prims.of_int (68))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - let uu___5 = - let uu___6 = - quote_list ta quotea xs' in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (398)) - (Prims.of_int (30)) - (Prims.of_int (398)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (398)) - (Prims.of_int (29)) - (Prims.of_int (398)) - (Prims.of_int (67))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (uu___7, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (398)) - (Prims.of_int (29)) - (Prims.of_int (398)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (396)) - (Prims.of_int (29)) - (Prims.of_int (398)) - (Prims.of_int (68))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> [uu___6])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (396)) - (Prims.of_int (29)) - (Prims.of_int (398)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (396)) - (Prims.of_int (29)) - (Prims.of_int (398)) - (Prims.of_int (68))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> uu___3 :: - uu___5)))) uu___3) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (396)) - (Prims.of_int (29)) - (Prims.of_int (398)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (396)) - (Prims.of_int (29)) - (Prims.of_int (398)) - (Prims.of_int (68))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (ta, - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (396)) (Prims.of_int (29)) - (Prims.of_int (398)) (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (396)) (Prims.of_int (14)) - (Prims.of_int (398)) (Prims.of_int (68))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "Cons"]))) uu___1))))) - uu___2 uu___1 uu___ -let quote_vm : - 'a . - FStar_Tactics_NamedView.term -> - ('a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - -> - 'a vmap -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr - = - fun ta -> - fun quotea -> - fun vm -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun p -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - quotea (FStar_Pervasives_Native.snd p) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (405)) - (Prims.of_int (7)) - (Prims.of_int (405)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (405)) - (Prims.of_int (6)) - (Prims.of_int (405)) - (Prims.of_int (34))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - (uu___8, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (405)) - (Prims.of_int (6)) - (Prims.of_int (405)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) - (Prims.of_int (23)) - (Prims.of_int (405)) - (Prims.of_int (35))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> [uu___7])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (23)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (23)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - ((FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Const - (FStarC_Reflection_V2_Data.C_Int - (FStar_Pervasives_Native.fst p)))), - FStarC_Reflection_V2_Data.Q_Explicit) - :: uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (23)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (23)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (ta, FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (23)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (23)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "nat"]))), - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (23)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (4)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Pervasives"; - "Native"; - "Mktuple2"]))) uu___3)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (403)) (Prims.of_int (4)) - (Prims.of_int (405)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (405)) (Prims.of_int (38)) - (Prims.of_int (410)) (Prims.of_int (73))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun quote_map_entry -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Pervasives"; - "Native"; - "tuple2"]))) - [FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "nat"])); - ta])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (406)) (Prims.of_int (16)) - (Prims.of_int (406)) (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (406)) (Prims.of_int (50)) - (Prims.of_int (410)) (Prims.of_int (73))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun tyentry -> - let uu___2 = - quote_list tyentry quote_map_entry - (FStar_Pervasives_Native.fst vm) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (407)) - (Prims.of_int (14)) - (Prims.of_int (407)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (407)) - (Prims.of_int (60)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun tlist -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "list"]))) - [tyentry])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (408)) - (Prims.of_int (15)) - (Prims.of_int (408)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (2)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun tylist -> - let uu___4 = - let uu___5 = - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - quotea - (FStar_Pervasives_Native.snd - vm) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (410)) - (Prims.of_int (44)) - (Prims.of_int (410)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (410)) - (Prims.of_int (43)) - (Prims.of_int (410)) - (Prims.of_int (72))))) - (Obj.magic - uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - (uu___10, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (410)) - (Prims.of_int (43)) - (Prims.of_int (410)) - (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (21)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 - -> - [uu___9])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (21)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (21)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - (tlist, - FStarC_Reflection_V2_Data.Q_Explicit) - :: uu___8)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (21)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (21)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (ta, - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (21)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (21)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - (tylist, - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___6)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (21)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (409)) - (Prims.of_int (2)) - (Prims.of_int (410)) - (Prims.of_int (73))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Pervasives"; - "Native"; - "Mktuple2"]))) - uu___5)))) - uu___4))) uu___3))) uu___2))) - uu___1) -let interp_var : 'a . 'a vmap -> index -> 'a = - fun vm -> - fun i -> - match FStar_List_Tot_Base.assoc i (FStar_Pervasives_Native.fst vm) with - | FStar_Pervasives_Native.Some x -> x - | uu___ -> FStar_Pervasives_Native.snd vm -let rec ivl_aux : 'a . 'a cr -> 'a vmap -> index -> varlist -> 'a = - fun r -> - fun vm -> - fun x -> - fun t -> - let amult = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_mult r) in - match t with - | Nil_var -> interp_var vm x - | Cons_var (x', t') -> amult (interp_var vm x) (ivl_aux r vm x' t') -let interp_vl : 'a . 'a cr -> 'a vmap -> varlist -> 'a = - fun r -> - fun vm -> - fun l -> - let aone = - FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_mult r) in - match l with | Nil_var -> aone | Cons_var (x, t) -> ivl_aux r vm x t -let interp_m : 'a . 'a cr -> 'a vmap -> 'a -> varlist -> 'a = - fun r -> - fun vm -> - fun c -> - fun l -> - let amult = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_mult r) in - match l with - | Nil_var -> c - | Cons_var (x, t) -> amult c (ivl_aux r vm x t) -let rec ics_aux : 'a . 'a cr -> 'a vmap -> 'a -> 'a canonical_sum -> 'a = - fun r -> - fun vm -> - fun x -> - fun s -> - let aplus = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_add r) in - match s with - | Nil_monom -> x - | Cons_varlist (l, t) -> - aplus x (ics_aux r vm (interp_vl r vm l) t) - | Cons_monom (c, l, t) -> - aplus x (ics_aux r vm (interp_m r vm c l) t) -let interp_cs : 'a . 'a cr -> 'a vmap -> 'a canonical_sum -> 'a = - fun r -> - fun vm -> - fun s -> - let azero = - FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_add r) in - match s with - | Nil_monom -> azero - | Cons_varlist (l, t) -> ics_aux r vm (interp_vl r vm l) t - | Cons_monom (c, l, t) -> ics_aux r vm (interp_m r vm c l) t -let rec interp_sp : 'a . 'a cr -> 'a vmap -> 'a spolynomial -> 'a = - fun r -> - fun vm -> - fun p -> - let aplus = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_add r) in - let amult = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_mult r) in - match p with - | SPconst c -> c - | SPvar i -> interp_var vm i - | SPplus (p1, p2) -> aplus (interp_sp r vm p1) (interp_sp r vm p2) - | SPmult (p1, p2) -> amult (interp_sp r vm p1) (interp_sp r vm p2) -type 'a polynomial = - | Pvar of index - | Pconst of 'a - | Pplus of 'a polynomial * 'a polynomial - | Pmult of 'a polynomial * 'a polynomial - | Popp of 'a polynomial -let uu___is_Pvar : 'a . 'a polynomial -> Prims.bool = - fun projectee -> match projectee with | Pvar _0 -> true | uu___ -> false -let __proj__Pvar__item___0 : 'a . 'a polynomial -> index = - fun projectee -> match projectee with | Pvar _0 -> _0 -let uu___is_Pconst : 'a . 'a polynomial -> Prims.bool = - fun projectee -> match projectee with | Pconst _0 -> true | uu___ -> false -let __proj__Pconst__item___0 : 'a . 'a polynomial -> 'a = - fun projectee -> match projectee with | Pconst _0 -> _0 -let uu___is_Pplus : 'a . 'a polynomial -> Prims.bool = - fun projectee -> - match projectee with | Pplus (_0, _1) -> true | uu___ -> false -let __proj__Pplus__item___0 : 'a . 'a polynomial -> 'a polynomial = - fun projectee -> match projectee with | Pplus (_0, _1) -> _0 -let __proj__Pplus__item___1 : 'a . 'a polynomial -> 'a polynomial = - fun projectee -> match projectee with | Pplus (_0, _1) -> _1 -let uu___is_Pmult : 'a . 'a polynomial -> Prims.bool = - fun projectee -> - match projectee with | Pmult (_0, _1) -> true | uu___ -> false -let __proj__Pmult__item___0 : 'a . 'a polynomial -> 'a polynomial = - fun projectee -> match projectee with | Pmult (_0, _1) -> _0 -let __proj__Pmult__item___1 : 'a . 'a polynomial -> 'a polynomial = - fun projectee -> match projectee with | Pmult (_0, _1) -> _1 -let uu___is_Popp : 'a . 'a polynomial -> Prims.bool = - fun projectee -> match projectee with | Popp _0 -> true | uu___ -> false -let __proj__Popp__item___0 : 'a . 'a polynomial -> 'a polynomial = - fun projectee -> match projectee with | Popp _0 -> _0 -let rec polynomial_normalize : - 'a . 'a cr -> 'a polynomial -> 'a canonical_sum = - fun r -> - fun p -> - match p with - | Pvar i -> Cons_varlist ((Cons_var (i, Nil_var)), Nil_monom) - | Pconst c -> Cons_monom (c, Nil_var, Nil_monom) - | Pplus (l, q) -> - canonical_sum_merge r (polynomial_normalize r l) - (polynomial_normalize r q) - | Pmult (l, q) -> - canonical_sum_prod r (polynomial_normalize r l) - (polynomial_normalize r q) - | Popp p1 -> - canonical_sum_scalar3 r - (__proj__CR__item__opp r - (FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_mult r))) Nil_var - (polynomial_normalize r p1) -let polynomial_simplify : 'a . 'a cr -> 'a polynomial -> 'a canonical_sum = - fun r -> fun p -> canonical_sum_simplify r (polynomial_normalize r p) -let rec spolynomial_of : 'a . 'a cr -> 'a polynomial -> 'a spolynomial = - fun r -> - fun p -> - match p with - | Pvar i -> SPvar i - | Pconst c -> SPconst c - | Pplus (l, q) -> SPplus ((spolynomial_of r l), (spolynomial_of r q)) - | Pmult (l, q) -> SPmult ((spolynomial_of r l), (spolynomial_of r q)) - | Popp p1 -> - SPmult - ((SPconst - (__proj__CR__item__opp r - (FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_mult r)))), - (spolynomial_of r p1)) -let rec interp_p : 'a . 'a cr -> 'a vmap -> 'a polynomial -> 'a = - fun r -> - fun vm -> - fun p -> - let aplus = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_add r) in - let amult = - FStar_Algebra_CommMonoid.__proj__CM__item__mult - (__proj__CR__item__cm_mult r) in - match p with - | Pconst c -> c - | Pvar i -> interp_var vm i - | Pplus (p1, p2) -> aplus (interp_p r vm p1) (interp_p r vm p2) - | Pmult (p1, p2) -> amult (interp_p r vm p1) (interp_p r vm p2) - | Popp p1 -> __proj__CR__item__opp r (interp_p r vm p1) -let (ddump : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun m -> - let uu___ = FStarC_Tactics_V2_Builtins.debugging () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1512)) (Prims.of_int (17)) - (Prims.of_int (1512)) (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1512)) (Prims.of_int (14)) - (Prims.of_int (1512)) (Prims.of_int (41))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - if uu___1 - then Obj.magic (Obj.repr (FStarC_Tactics_V2_Builtins.dump m)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())))) - uu___1) -let rec (find_aux : - Prims.nat -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term Prims.list -> - (Prims.nat FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun n -> - fun x -> - fun xs -> - match xs with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.None))) - | x'::xs' -> - Obj.magic - (Obj.repr - (if term_eq x x' - then - Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> FStar_Pervasives_Native.Some n)) - else Obj.repr (find_aux (n + Prims.int_one) x xs')))) - uu___2 uu___1 uu___ -let (find : - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term Prims.list -> - (Prims.nat FStar_Pervasives_Native.option, unit) - FStar_Tactics_Effect.tac_repr) - = find_aux Prims.int_zero -let make_fvar : - 'a . - FStar_Tactics_NamedView.term -> - (FStar_Tactics_NamedView.term -> - ('a, unit) FStar_Tactics_Effect.tac_repr) - -> - FStar_Tactics_NamedView.term Prims.list -> - 'a vmap -> - (('a polynomial * FStar_Tactics_NamedView.term Prims.list * 'a - vmap), - unit) FStar_Tactics_Effect.tac_repr - = - fun t -> - fun unquotea -> - fun ts -> - fun vm -> - let uu___ = find t ts in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1527)) (Prims.of_int (8)) - (Prims.of_int (1527)) (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1527)) (Prims.of_int (2)) - (Prims.of_int (1532)) (Prims.of_int (47))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.Some v -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> ((Pvar v), ts, vm)))) - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStar_List_Tot_Base.length ts)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1530)) - (Prims.of_int (17)) - (Prims.of_int (1530)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1530)) - (Prims.of_int (29)) - (Prims.of_int (1532)) - (Prims.of_int (47))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun vfresh -> - let uu___3 = unquotea t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1531)) - (Prims.of_int (12)) - (Prims.of_int (1531)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1532)) - (Prims.of_int (4)) - (Prims.of_int (1532)) - (Prims.of_int (47))))) - (Obj.magic uu___3) - (fun z -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - ((Pvar vfresh), - (FStar_List_Tot_Base.op_At - ts [t]), - (update vfresh z vm)))))) - uu___3)))) uu___1) -let rec reification_aux : - 'a . - (FStar_Tactics_NamedView.term -> ('a, unit) FStar_Tactics_Effect.tac_repr) - -> - FStar_Tactics_NamedView.term Prims.list -> - 'a vmap -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - (('a polynomial * FStar_Tactics_NamedView.term Prims.list - * 'a vmap), - unit) FStar_Tactics_Effect.tac_repr - = - fun unquotea -> - fun ts -> - fun vm -> - fun add -> - fun opp -> - fun mone -> - fun mult -> - fun t -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Derived_Lemmas.collect_app_ref - t)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1537)) (Prims.of_int (15)) - (Prims.of_int (1537)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1535)) (Prims.of_int (157)) - (Prims.of_int (1559)) (Prims.of_int (38))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (hd, tl) -> - let uu___2 = - let uu___3 = - FStar_Tactics_NamedView.inspect hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1538)) - (Prims.of_int (8)) - (Prims.of_int (1538)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1538)) - (Prims.of_int (8)) - (Prims.of_int (1538)) - (Prims.of_int (33))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - (uu___4, - (FStar_List_Tot_Base.list_unref - tl)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1538)) - (Prims.of_int (8)) - (Prims.of_int (1538)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1538)) - (Prims.of_int (2)) - (Prims.of_int (1559)) - (Prims.of_int (38))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (FStar_Tactics_NamedView.Tv_FVar - fv, - (t1, uu___4)::(t2, uu___5)::[]) - -> - let uu___6 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - fun op -> - let uu___8 = - reification_aux - unquotea ts vm - add opp mone - mult t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1544)) - (Prims.of_int (25)) - (Prims.of_int (1544)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1543)) - (Prims.of_int (107)) - (Prims.of_int (1546)) - (Prims.of_int (24))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun uu___9 -> - match uu___9 - with - | (e1, ts1, - vm1) -> - let uu___10 - = - reification_aux - unquotea - ts1 vm1 - add opp - mone mult - t2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1545)) - (Prims.of_int (25)) - (Prims.of_int (1545)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1544)) - (Prims.of_int (79)) - (Prims.of_int (1546)) - (Prims.of_int (24))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - match uu___11 - with - | - (e2, ts2, - vm2) -> - ((op e1 - e2), ts2, - vm2))))) - uu___9))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1543)) - (Prims.of_int (107)) - (Prims.of_int (1546)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1548)) - (Prims.of_int (4)) - (Prims.of_int (1550)) - (Prims.of_int (30))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun binop -> - if - term_eq - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar - fv)) add - then - Obj.magic - (binop - (fun uu___7 -> - fun uu___8 - -> - Pplus - (uu___7, - uu___8))) - else - if - term_eq - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar - fv)) mult - then - Obj.magic - (binop - (fun uu___8 - -> - fun - uu___9 -> - Pmult - (uu___8, - uu___9))) - else - Obj.magic - (make_fvar t - unquotea ts - vm)) uu___7)) - | (FStar_Tactics_NamedView.Tv_FVar - fv, (t1, uu___4)::[]) -> - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - fun op -> - let uu___7 = - reification_aux - unquotea ts vm - add opp mone - mult t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1553)) - (Prims.of_int (24)) - (Prims.of_int (1553)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1552)) - (Prims.of_int (91)) - (Prims.of_int (1554)) - (Prims.of_int (20))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 - -> - match uu___8 - with - | - (e, ts1, - vm1) -> - ((op e), - ts1, vm1))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1552)) - (Prims.of_int (91)) - (Prims.of_int (1554)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1556)) - (Prims.of_int (4)) - (Prims.of_int (1557)) - (Prims.of_int (30))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun monop -> - if - term_eq - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar - fv)) opp - then - Obj.magic - (monop - (fun uu___6 -> - Popp uu___6)) - else - Obj.magic - (make_fvar t - unquotea ts vm)) - uu___6)) - | (FStar_Tactics_NamedView.Tv_Const - uu___4, []) -> - let uu___5 = - let uu___6 = unquotea t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1558)) - (Prims.of_int (29)) - (Prims.of_int (1558)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1558)) - (Prims.of_int (22)) - (Prims.of_int (1558)) - (Prims.of_int (41))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Pconst uu___7)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1558)) - (Prims.of_int (22)) - (Prims.of_int (1558)) - (Prims.of_int (41))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1558)) - (Prims.of_int (22)) - (Prims.of_int (1558)) - (Prims.of_int (49))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - (uu___6, ts, vm)))) - | (uu___4, uu___5) -> - Obj.magic - (make_fvar t unquotea ts vm)) - uu___3))) uu___1) -let (steps : FStar_Pervasives.norm_step Prims.list) = - [FStar_Pervasives.primops; - FStar_Pervasives.iota; - FStar_Pervasives.zeta; - FStar_Pervasives.delta_attr ["FStar.Tactics.CanonCommSemiring.canon_attr"]; - FStar_Pervasives.delta_only - ["FStar.Mul.op_Star"; - "FStar.Algebra.CommMonoid.int_plus_cm"; - "FStar.Algebra.CommMonoid.int_multiply_cm"; - "FStar.Algebra.CommMonoid.__proj__CM__item__mult"; - "FStar.Algebra.CommMonoid.__proj__CM__item__unit"; - "FStar.Tactics.CanonCommSemiring.__proj__CR__item__cm_add"; - "FStar.Tactics.CanonCommSemiring.__proj__CR__item__opp"; - "FStar.Tactics.CanonCommSemiring.__proj__CR__item__cm_mult"; - "FStar.List.Tot.Base.assoc"; - "FStar.Pervasives.Native.fst"; - "FStar.Pervasives.Native.snd"; - "FStar.Pervasives.Native.__proj__Mktuple2__item___1"; - "FStar.Pervasives.Native.__proj__Mktuple2__item___2"; - "FStar.List.Tot.Base.op_At"; - "FStar.List.Tot.Base.append"]] -let (canon_norm : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> FStarC_Tactics_V2_Builtins.norm steps -let reification : - 'a . - (FStar_Tactics_NamedView.term -> ('a, unit) FStar_Tactics_Effect.tac_repr) - -> - ('a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - 'a -> - FStar_Tactics_NamedView.term Prims.list -> - (('a polynomial Prims.list * 'a vmap), unit) - FStar_Tactics_Effect.tac_repr - = - fun unquotea -> - fun quotea -> - fun tadd -> - fun topp -> - fun tmone -> - fun tmult -> - fun munit -> - fun ts -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> tadd)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1597)) (Prims.of_int (13)) - (Prims.of_int (1597)) (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1597)) (Prims.of_int (20)) - (Prims.of_int (1609)) (Prims.of_int (31))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun add -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> topp)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1598)) - (Prims.of_int (13)) - (Prims.of_int (1598)) - (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1598)) - (Prims.of_int (20)) - (Prims.of_int (1609)) - (Prims.of_int (31))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun opp -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> tmone)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1599)) - (Prims.of_int (13)) - (Prims.of_int (1599)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1599)) - (Prims.of_int (21)) - (Prims.of_int (1609)) - (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun mone -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> tmult)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1600)) - (Prims.of_int (13)) - (Prims.of_int (1600)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1600)) - (Prims.of_int (21)) - (Prims.of_int (1609)) - (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun mult -> - let uu___4 = - FStar_Tactics_Util.map - (FStar_Tactics_V2_Derived.norm_term - steps) ts in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1601)) - (Prims.of_int (11)) - (Prims.of_int (1601)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1601)) - (Prims.of_int (51)) - (Prims.of_int (1609)) - (Prims.of_int (31))))) - (Obj.magic - uu___4) - (fun uu___5 - -> - (fun ts1 - -> - let uu___5 - = - FStar_Tactics_Util.fold_left - (fun - uu___6 -> - fun t -> - match uu___6 - with - | - (es, vs, - vm) -> - let uu___7 - = - reification_aux - unquotea - vs vm add - opp mone - mult t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1606)) - (Prims.of_int (26)) - (Prims.of_int (1606)) - (Prims.of_int (76))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1605)) - (Prims.of_int (28)) - (Prims.of_int (1607)) - (Prims.of_int (26))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - match uu___8 - with - | - (e, vs1, - vm1) -> - ((e :: - es), vs1, - vm1)))) - ([], [], - ([], - munit)) - ts1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1604)) - (Prims.of_int (4)) - (Prims.of_int (1608)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1601)) - (Prims.of_int (51)) - (Prims.of_int (1609)) - (Prims.of_int (31))))) - (Obj.magic - uu___5) - (fun - uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___7 -> - match uu___6 - with - | - (es, - uu___8, - vm) -> - ((FStar_List_Tot_Base.rev - es), vm))))) - uu___5))) - uu___4))) uu___3))) - uu___2))) uu___1) -let rec quote_polynomial : - 'a . - FStar_Tactics_NamedView.term -> - ('a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - -> - 'a polynomial -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun ta -> - fun quotea -> - fun e -> - match e with - | Pconst c -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = quotea c in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1614)) - (Prims.of_int (53)) - (Prims.of_int (1614)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1614)) - (Prims.of_int (52)) - (Prims.of_int (1614)) - (Prims.of_int (74))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - (uu___4, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1614)) - (Prims.of_int (52)) - (Prims.of_int (1614)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1614)) - (Prims.of_int (33)) - (Prims.of_int (1614)) - (Prims.of_int (75))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> [uu___3])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1614)) - (Prims.of_int (33)) - (Prims.of_int (1614)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1614)) - (Prims.of_int (33)) - (Prims.of_int (1614)) - (Prims.of_int (75))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (ta, - FStarC_Reflection_V2_Data.Q_Implicit) - :: uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1614)) (Prims.of_int (33)) - (Prims.of_int (1614)) (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1614)) (Prims.of_int (16)) - (Prims.of_int (1614)) (Prims.of_int (75))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommSemiring"; - "Pconst"]))) uu___1)))) - | Pvar x -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommSemiring"; - "Pvar"]))) - [FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Const - (FStarC_Reflection_V2_Data.C_Int x))]))) - | Pplus (e1, e2) -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = quote_polynomial ta quotea e1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1617)) - (Prims.of_int (23)) - (Prims.of_int (1617)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1617)) - (Prims.of_int (22)) - (Prims.of_int (1617)) - (Prims.of_int (84))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - let uu___4 = - quote_polynomial ta quotea e2 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1617)) - (Prims.of_int (54)) - (Prims.of_int (1617)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1617)) - (Prims.of_int (22)) - (Prims.of_int (1617)) - (Prims.of_int (84))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> [uu___5])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1617)) - (Prims.of_int (22)) - (Prims.of_int (1617)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1617)) - (Prims.of_int (22)) - (Prims.of_int (1617)) - (Prims.of_int (84))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> uu___2 :: uu___4)))) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1617)) (Prims.of_int (22)) - (Prims.of_int (1617)) (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1617)) (Prims.of_int (4)) - (Prims.of_int (1617)) (Prims.of_int (84))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommSemiring"; - "Pplus"]))) uu___1)))) - | Pmult (e1, e2) -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = quote_polynomial ta quotea e1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1619)) - (Prims.of_int (23)) - (Prims.of_int (1619)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1619)) - (Prims.of_int (22)) - (Prims.of_int (1619)) - (Prims.of_int (84))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - let uu___4 = - quote_polynomial ta quotea e2 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1619)) - (Prims.of_int (54)) - (Prims.of_int (1619)) - (Prims.of_int (83))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1619)) - (Prims.of_int (22)) - (Prims.of_int (1619)) - (Prims.of_int (84))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> [uu___5])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1619)) - (Prims.of_int (22)) - (Prims.of_int (1619)) - (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1619)) - (Prims.of_int (22)) - (Prims.of_int (1619)) - (Prims.of_int (84))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> uu___2 :: uu___4)))) - uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1619)) (Prims.of_int (22)) - (Prims.of_int (1619)) (Prims.of_int (84))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1619)) (Prims.of_int (4)) - (Prims.of_int (1619)) (Prims.of_int (84))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommSemiring"; - "Pmult"]))) uu___1)))) - | Popp e1 -> - Obj.magic - (Obj.repr - (let uu___ = - let uu___1 = quote_polynomial ta quotea e1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1620)) - (Prims.of_int (32)) - (Prims.of_int (1620)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1620)) - (Prims.of_int (31)) - (Prims.of_int (1620)) - (Prims.of_int (61))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> [uu___2])) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1620)) (Prims.of_int (31)) - (Prims.of_int (1620)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1620)) (Prims.of_int (14)) - (Prims.of_int (1620)) (Prims.of_int (61))))) - (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Reflection_V2_Derived.mk_e_app - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommSemiring"; - "Popp"]))) uu___1))))) uu___2 - uu___1 uu___ -let canon_semiring_aux : - 'a . - FStar_Tactics_NamedView.term -> - (FStar_Tactics_NamedView.term -> - ('a, unit) FStar_Tactics_Effect.tac_repr) - -> - ('a -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - 'a -> (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun ta -> - fun unquotea -> - fun quotea -> - fun tr -> - fun tadd -> - fun topp -> - fun tmone -> - fun tmult -> - fun munit -> - FStar_Tactics_V2_Derived.focus - (fun uu___ -> - let uu___1 = FStarC_Tactics_V2_Builtins.norm [] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1642)) (Prims.of_int (2)) - (Prims.of_int (1642)) (Prims.of_int (9))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1642)) (Prims.of_int (10)) - (Prims.of_int (1691)) (Prims.of_int (42))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - FStar_Tactics_V2_Derived.cur_goal () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1643)) - (Prims.of_int (10)) - (Prims.of_int (1643)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1644)) - (Prims.of_int (2)) - (Prims.of_int (1691)) - (Prims.of_int (42))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun g -> - let uu___4 = - FStar_Reflection_V2_Formula.term_as_formula - g in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1644)) - (Prims.of_int (8)) - (Prims.of_int (1644)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1644)) - (Prims.of_int (2)) - (Prims.of_int (1691)) - (Prims.of_int (42))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | FStar_Reflection_V2_Formula.Comp - (FStar_Reflection_V2_Formula.Eq - (FStar_Pervasives_Native.Some - t), t1, t2) - -> - Obj.magic - (Obj.repr - (let uu___6 = - FStar_Tactics_V2_Derived.tcut - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "squash"]))), - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "eq2"]))), - (ta, - FStarC_Reflection_V2_Data.Q_Implicit)))), - (t1, - FStarC_Reflection_V2_Data.Q_Explicit)))), - (t2, - FStarC_Reflection_V2_Data.Q_Explicit)))), - FStarC_Reflection_V2_Data.Q_Explicit)))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1649)) - (Prims.of_int (12)) - (Prims.of_int (1649)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1652)) - (Prims.of_int (4)) - (Prims.of_int (1690)) - (Prims.of_int (7))))) - (Obj.magic - uu___6) - (fun - uu___7 -> - (fun b -> - let uu___7 - = - FStar_Tactics_V2_Derived.try_with - (fun - uu___8 -> - match () - with - | - () -> - FStar_Tactics_V2_Derived.exact - (FStar_Tactics_V2_SyntaxCoercions.binding_to_term - b)) - (fun - uu___8 -> - FStar_Tactics_V2_Derived.smt - ()) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1653)) - (Prims.of_int (6)) - (Prims.of_int (1653)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1656)) - (Prims.of_int (4)) - (Prims.of_int (1689)) - (Prims.of_int (28))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - (fun - uu___8 -> - let uu___9 - = - reification - unquotea - quotea - tadd topp - tmone - tmult - munit - [t1; t2] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1656)) - (Prims.of_int (10)) - (Prims.of_int (1656)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1656)) - (Prims.of_int (4)) - (Prims.of_int (1689)) - (Prims.of_int (28))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - match uu___10 - with - | - (e1::e2::[], - vm) -> - Obj.magic - (Obj.repr - (let uu___11 - = - quote_vm - ta quotea - vm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1670)) - (Prims.of_int (16)) - (Prims.of_int (1670)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1670)) - (Prims.of_int (40)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun tvm - -> - let uu___12 - = - quote_polynomial - ta quotea - e1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1671)) - (Prims.of_int (16)) - (Prims.of_int (1671)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1671)) - (Prims.of_int (48)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun te1 - -> - let uu___13 - = - quote_polynomial - ta quotea - e2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1673)) - (Prims.of_int (16)) - (Prims.of_int (1673)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1675)) - (Prims.of_int (6)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun te2 - -> - let uu___14 - = - FStar_Tactics_MApply.mapply - FStar_Tactics_MApply.termable_term - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonCommSemiring"; - "semiring_reflect"]))), - (ta, - FStarC_Reflection_V2_Data.Q_Implicit)))), - (tr, - FStarC_Reflection_V2_Data.Q_Explicit)))), - (tvm, - FStarC_Reflection_V2_Data.Q_Explicit)))), - (te1, - FStarC_Reflection_V2_Data.Q_Explicit)))), - (te2, - FStarC_Reflection_V2_Data.Q_Explicit)))), - (t1, - FStarC_Reflection_V2_Data.Q_Explicit)))), - (t2, - FStarC_Reflection_V2_Data.Q_Explicit)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1675)) - (Prims.of_int (6)) - (Prims.of_int (1676)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1678)) - (Prims.of_int (6)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - let uu___16 - = - canon_norm - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1678)) - (Prims.of_int (6)) - (Prims.of_int (1678)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1680)) - (Prims.of_int (6)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - (fun - uu___17 - -> - let uu___18 - = - FStar_Tactics_V2_Derived.later - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1680)) - (Prims.of_int (6)) - (Prims.of_int (1680)) - (Prims.of_int (14))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1682)) - (Prims.of_int (6)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - uu___19 - -> - let uu___20 - = - canon_norm - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1682)) - (Prims.of_int (6)) - (Prims.of_int (1682)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1684)) - (Prims.of_int (6)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___20) - (fun - uu___21 - -> - (fun - uu___21 - -> - let uu___22 - = - FStar_Tactics_V2_Derived.trefl - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1684)) - (Prims.of_int (6)) - (Prims.of_int (1684)) - (Prims.of_int (14))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1686)) - (Prims.of_int (6)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___22) - (fun - uu___23 - -> - (fun - uu___23 - -> - let uu___24 - = - canon_norm - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1686)) - (Prims.of_int (6)) - (Prims.of_int (1686)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1688)) - (Prims.of_int (6)) - (Prims.of_int (1688)) - (Prims.of_int (14))))) - (Obj.magic - uu___24) - (fun - uu___25 - -> - (fun - uu___25 - -> - Obj.magic - (FStar_Tactics_V2_Derived.trefl - ())) - uu___25))) - uu___23))) - uu___21))) - uu___19))) - uu___17))) - uu___15))) - uu___14))) - uu___13))) - uu___12))) - | - uu___11 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Unexpected"))) - uu___10))) - uu___8))) - uu___7))) - | uu___6 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Goal should be an equality"))) - uu___5))) uu___4))) - uu___2)) -let canon_semiring : 'a . 'a cr -> (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun r -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (failwith "Cannot evaluate open quotation at runtime")) - uu___1)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1695)) (Prims.of_int (4)) (Prims.of_int (1695)) - (Prims.of_int (13))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1694)) (Prims.of_int (2)) (Prims.of_int (1700)) - (Prims.of_int (17))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___3)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1695)) (Prims.of_int (50)) - (Prims.of_int (1695)) (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1694)) (Prims.of_int (2)) - (Prims.of_int (1700)) (Prims.of_int (17))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - let uu___5 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1696)) (Prims.of_int (21)) - (Prims.of_int (1696)) (Prims.of_int (42))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1696)) (Prims.of_int (4)) - (Prims.of_int (1696)) (Prims.of_int (43))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (FStar_Tactics_V2_Derived.norm_term steps - uu___6)) uu___6) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1696)) (Prims.of_int (4)) - (Prims.of_int (1696)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1694)) (Prims.of_int (2)) - (Prims.of_int (1700)) - (Prims.of_int (17))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - let uu___7 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - (fun uu___8 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___8)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1697)) - (Prims.of_int (21)) - (Prims.of_int (1697)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1697)) - (Prims.of_int (4)) - (Prims.of_int (1697)) - (Prims.of_int (35))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - Obj.magic - (FStar_Tactics_V2_Derived.norm_term - steps uu___8)) uu___8) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1697)) - (Prims.of_int (4)) - (Prims.of_int (1697)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1694)) - (Prims.of_int (2)) - (Prims.of_int (1700)) - (Prims.of_int (17))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - let uu___8 = - let uu___9 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - (fun uu___10 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1698)) - (Prims.of_int (21)) - (Prims.of_int (1698)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1698)) - (Prims.of_int (4)) - (Prims.of_int (1698)) - (Prims.of_int (52))))) - (Obj.magic uu___9) - (fun uu___10 -> - (fun uu___10 -> - Obj.magic - (FStar_Tactics_V2_Derived.norm_term - steps uu___10)) - uu___10) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1698)) - (Prims.of_int (4)) - (Prims.of_int (1698)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1694)) - (Prims.of_int (2)) - (Prims.of_int (1700)) - (Prims.of_int (17))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun uu___9 -> - let uu___10 = - let uu___11 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___12)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1699)) - (Prims.of_int (21)) - (Prims.of_int (1699)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1699)) - (Prims.of_int (4)) - (Prims.of_int (1699)) - (Prims.of_int (44))))) - (Obj.magic - uu___11) - (fun uu___12 -> - (fun uu___12 - -> - Obj.magic - ( - FStar_Tactics_V2_Derived.norm_term - steps - uu___12)) - uu___12) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1699)) - (Prims.of_int (4)) - (Prims.of_int (1699)) - (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonCommSemiring.fst" - (Prims.of_int (1694)) - (Prims.of_int (2)) - (Prims.of_int (1700)) - (Prims.of_int (17))))) - (Obj.magic - uu___10) - (fun uu___11 -> - (fun uu___11 - -> - Obj.magic - (canon_semiring_aux - uu___1 - FStarC_Tactics_V2_Builtins.unquote - (fun - uu___12 - -> - (fun x -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___12))) - uu___12) - uu___3 - uu___5 - uu___7 - uu___9 - uu___11 - (FStar_Algebra_CommMonoid.__proj__CM__item__unit - (__proj__CR__item__cm_add - r)))) - uu___11))) - uu___9))) uu___7))) - uu___5))) uu___3))) uu___1) -let (int_cr : Prims.int cr) = - CR - (FStar_Algebra_CommMonoid.int_plus_cm, - FStar_Algebra_CommMonoid.int_multiply_cm, (~-), (), (), ()) -let (int_semiring : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> canon_semiring int_cr \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_CanonMonoid.ml b/stage0/fstar-lib/generated/FStar_Tactics_CanonMonoid.ml deleted file mode 100644 index 94e6da7a3bf..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_CanonMonoid.ml +++ /dev/null @@ -1,944 +0,0 @@ -open Prims -let (term_eq : - FStarC_Reflection_Types.term -> FStarC_Reflection_Types.term -> Prims.bool) - = FStar_Reflection_TermEq_Simple.term_eq -let (dump : Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun m -> - let uu___ = FStarC_Tactics_V2_Builtins.debugging () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (27)) (Prims.of_int (16)) (Prims.of_int (27)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (27)) (Prims.of_int (13)) (Prims.of_int (27)) - (Prims.of_int (40))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - if uu___1 - then Obj.magic (Obj.repr (FStarC_Tactics_V2_Builtins.dump m)) - else - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())))) - uu___1) -type 'a exp = - | Unit - | Var of 'a - | Mult of 'a exp * 'a exp -let uu___is_Unit : 'a . 'a exp -> Prims.bool = - fun projectee -> match projectee with | Unit -> true | uu___ -> false -let uu___is_Var : 'a . 'a exp -> Prims.bool = - fun projectee -> match projectee with | Var _0 -> true | uu___ -> false -let __proj__Var__item___0 : 'a . 'a exp -> 'a = - fun projectee -> match projectee with | Var _0 -> _0 -let uu___is_Mult : 'a . 'a exp -> Prims.bool = - fun projectee -> - match projectee with | Mult (_0, _1) -> true | uu___ -> false -let __proj__Mult__item___0 : 'a . 'a exp -> 'a exp = - fun projectee -> match projectee with | Mult (_0, _1) -> _0 -let __proj__Mult__item___1 : 'a . 'a exp -> 'a exp = - fun projectee -> match projectee with | Mult (_0, _1) -> _1 -let rec exp_to_string : 'a . ('a -> Prims.string) -> 'a exp -> Prims.string = - fun a_to_string -> - fun e -> - match e with - | Unit -> "Unit" - | Var x -> Prims.strcat "Var " (a_to_string x) - | Mult (e1, e2) -> - Prims.strcat "Mult (" - (Prims.strcat (exp_to_string a_to_string e1) - (Prims.strcat ") (" - (Prims.strcat (exp_to_string a_to_string e2) ")"))) -let rec mdenote : 'a . 'a FStar_Algebra_Monoid.monoid -> 'a exp -> 'a = - fun m -> - fun e -> - match e with - | Unit -> FStar_Algebra_Monoid.__proj__Monoid__item__unit m - | Var x -> x - | Mult (e1, e2) -> - FStar_Algebra_Monoid.__proj__Monoid__item__mult m (mdenote m e1) - (mdenote m e2) -let rec mldenote : 'a . 'a FStar_Algebra_Monoid.monoid -> 'a Prims.list -> 'a - = - fun m -> - fun xs -> - match xs with - | [] -> FStar_Algebra_Monoid.__proj__Monoid__item__unit m - | x::[] -> x - | x::xs' -> - FStar_Algebra_Monoid.__proj__Monoid__item__mult m x - (mldenote m xs') -let rec flatten : 'a . 'a exp -> 'a Prims.list = - fun e -> - match e with - | Unit -> [] - | Var x -> [x] - | Mult (e1, e2) -> FStar_List_Tot_Base.op_At (flatten e1) (flatten e2) -let rec reification_aux : - 'a . - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term -> - ('a exp, unit) FStar_Tactics_Effect.tac_repr - = - fun mult -> - fun unit -> - fun me -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_Reflection_V2_Derived_Lemmas.collect_app_ref me)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (87)) (Prims.of_int (15)) - (Prims.of_int (87)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (86)) (Prims.of_int (71)) - (Prims.of_int (97)) (Prims.of_int (25))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (hd, tl) -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> FStar_List_Tot_Base.list_unref tl)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (88)) (Prims.of_int (11)) - (Prims.of_int (88)) (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (89)) (Prims.of_int (2)) - (Prims.of_int (97)) (Prims.of_int (25))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun tl1 -> - let uu___3 = - let uu___4 = - FStar_Tactics_NamedView.inspect hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (89)) - (Prims.of_int (8)) - (Prims.of_int (89)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (89)) - (Prims.of_int (8)) - (Prims.of_int (89)) - (Prims.of_int (22))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> (uu___5, tl1))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (89)) - (Prims.of_int (8)) - (Prims.of_int (89)) - (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (89)) - (Prims.of_int (2)) - (Prims.of_int (97)) - (Prims.of_int (25))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | (FStar_Tactics_NamedView.Tv_FVar - fv, - (me1, - FStarC_Reflection_V2_Data.Q_Explicit):: - (me2, - FStarC_Reflection_V2_Data.Q_Explicit)::[]) - -> - let uu___5 = - FStarC_Tactics_V2_Builtins.term_eq_old - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_FVar - fv)) mult in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (91)) - (Prims.of_int (7)) - (Prims.of_int (91)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (91)) - (Prims.of_int (4)) - (Prims.of_int (93)) - (Prims.of_int (25))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - if uu___6 - then - let uu___7 = - reification_aux - mult unit me1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (92)) - (Prims.of_int (14)) - (Prims.of_int (92)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (92)) - (Prims.of_int (9)) - (Prims.of_int (92)) - (Prims.of_int (77))))) - (Obj.magic - uu___7) - (fun uu___8 - -> - (fun - uu___8 -> - let uu___9 - = - reification_aux - mult unit - me2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (92)) - (Prims.of_int (46)) - (Prims.of_int (92)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (92)) - (Prims.of_int (9)) - (Prims.of_int (92)) - (Prims.of_int (77))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Mult - (uu___8, - uu___10))))) - uu___8)) - else - (let uu___8 = - FStarC_Tactics_V2_Builtins.unquote - me in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (93)) - (Prims.of_int (13)) - (Prims.of_int (93)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (93)) - (Prims.of_int (9)) - (Prims.of_int (93)) - (Prims.of_int (25))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - Var - uu___9))))) - uu___6)) - | (uu___5, uu___6) -> - let uu___7 = - FStarC_Tactics_V2_Builtins.term_eq_old - me unit in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (95)) - (Prims.of_int (7)) - (Prims.of_int (95)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (95)) - (Prims.of_int (4)) - (Prims.of_int (97)) - (Prims.of_int (25))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - if uu___8 - then - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - Unit))) - else - Obj.magic - (Obj.repr - (let uu___10 - = - FStarC_Tactics_V2_Builtins.unquote - me in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (97)) - (Prims.of_int (13)) - (Prims.of_int (97)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (97)) - (Prims.of_int (9)) - (Prims.of_int (97)) - (Prims.of_int (25))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - Var - uu___11))))) - uu___8))) uu___4))) - uu___3))) uu___1) -let reification : - 'a . - 'a FStar_Algebra_Monoid.monoid -> - FStar_Tactics_NamedView.term -> - ('a exp, unit) FStar_Tactics_Effect.tac_repr - = - fun m -> - fun me -> - let uu___ = - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (failwith "Cannot evaluate open quotation at runtime")) - uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (100)) (Prims.of_int (43)) - (Prims.of_int (100)) (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (100)) (Prims.of_int (15)) - (Prims.of_int (100)) (Prims.of_int (67))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota] uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (100)) (Prims.of_int (15)) - (Prims.of_int (100)) (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (100)) (Prims.of_int (70)) - (Prims.of_int (106)) (Prims.of_int (32))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun mult -> - let uu___1 = - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (101)) (Prims.of_int (43)) - (Prims.of_int (101)) (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (101)) (Prims.of_int (15)) - (Prims.of_int (101)) (Prims.of_int (67))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - Obj.magic - (FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota] uu___3)) uu___3) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (101)) (Prims.of_int (15)) - (Prims.of_int (101)) (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (101)) (Prims.of_int (70)) - (Prims.of_int (106)) (Prims.of_int (32))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun unit -> - let uu___2 = - FStar_Tactics_V2_Derived.norm_term - [FStar_Pervasives.delta; - FStar_Pervasives.zeta; - FStar_Pervasives.iota] me in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (102)) - (Prims.of_int (15)) - (Prims.of_int (102)) - (Prims.of_int (45))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (106)) - (Prims.of_int (4)) - (Prims.of_int (106)) - (Prims.of_int (32))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun me1 -> - Obj.magic (reification_aux mult unit me1)) - uu___3))) uu___2))) uu___1) -let canon_monoid : - 'a . - 'a FStar_Algebra_Monoid.monoid -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun m -> - let uu___ = FStarC_Tactics_V2_Builtins.norm [] in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (109)) (Prims.of_int (2)) (Prims.of_int (109)) - (Prims.of_int (9))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (109)) (Prims.of_int (10)) (Prims.of_int (127)) - (Prims.of_int (42))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - let uu___2 = FStar_Tactics_V2_Derived.cur_goal () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (110)) (Prims.of_int (10)) - (Prims.of_int (110)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (111)) (Prims.of_int (2)) - (Prims.of_int (127)) (Prims.of_int (42))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun g -> - let uu___3 = - FStar_Reflection_V2_Formula.term_as_formula g in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (111)) (Prims.of_int (8)) - (Prims.of_int (111)) (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (111)) (Prims.of_int (2)) - (Prims.of_int (127)) (Prims.of_int (42))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | FStar_Reflection_V2_Formula.Comp - (FStar_Reflection_V2_Formula.Eq - (FStar_Pervasives_Native.Some t), me1, - me2) - -> - Obj.magic - (Obj.repr - (let uu___5 = - let uu___6 = - let uu___7 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> me2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (60)) - (Prims.of_int (116)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (19)) - (Prims.of_int (116)) - (Prims.of_int (67))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - let uu___9 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___10 - -> me1)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (52)) - (Prims.of_int (116)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (19)) - (Prims.of_int (116)) - (Prims.of_int (67))))) - (Obj.magic - uu___9) - (fun uu___10 -> - (fun uu___10 - -> - let uu___11 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___12)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (38)) - (Prims.of_int (116)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (19)) - (Prims.of_int (116)) - (Prims.of_int (67))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "squash"]))), - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_App - ((FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; - "eq2"]))), - (uu___12, - FStarC_Reflection_V2_Data.Q_Implicit)))), - (uu___10, - FStarC_Reflection_V2_Data.Q_Explicit)))), - (uu___8, - FStarC_Reflection_V2_Data.Q_Explicit)))), - FStarC_Reflection_V2_Data.Q_Explicit))))))) - uu___10))) - uu___8) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (19)) - (Prims.of_int (116)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (14)) - (Prims.of_int (116)) - (Prims.of_int (67))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - Obj.magic - (FStar_Tactics_V2_Derived.tcut - uu___7)) uu___7) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (116)) - (Prims.of_int (14)) - (Prims.of_int (116)) - (Prims.of_int (67))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (117)) - (Prims.of_int (6)) - (Prims.of_int (126)) - (Prims.of_int (49))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun b -> - let uu___6 = - FStar_Tactics_V2_Derived.smt - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (117)) - (Prims.of_int (6)) - (Prims.of_int (117)) - (Prims.of_int (12))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (117)) - (Prims.of_int (13)) - (Prims.of_int (126)) - (Prims.of_int (49))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - let uu___8 = - reification - m me1 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (119)) - (Prims.of_int (15)) - (Prims.of_int (119)) - (Prims.of_int (32))))) - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (119)) - (Prims.of_int (35)) - (Prims.of_int (126)) - (Prims.of_int (49))))) - ( - Obj.magic - uu___8) - ( - fun - uu___9 -> - (fun r1 - -> - let uu___9 - = - reification - m me2 in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (120)) - (Prims.of_int (15)) - (Prims.of_int (120)) - (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (121)) - (Prims.of_int (6)) - (Prims.of_int (126)) - (Prims.of_int (49))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun r2 - -> - let uu___10 - = - let uu___11 - = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___12)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (121)) - (Prims.of_int (16)) - (Prims.of_int (121)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (121)) - (Prims.of_int (6)) - (Prims.of_int (121)) - (Prims.of_int (62))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (FStar_Tactics_V2_Derived.change_sq - uu___12)) - uu___12) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (121)) - (Prims.of_int (6)) - (Prims.of_int (121)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (122)) - (Prims.of_int (6)) - (Prims.of_int (126)) - (Prims.of_int (49))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - let uu___12 - = - FStar_Tactics_V2_Derived.apply - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "CanonMonoid"; - "monoid_reflect"]))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (122)) - (Prims.of_int (6)) - (Prims.of_int (122)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.CanonMonoid.fst" - (Prims.of_int (123)) - (Prims.of_int (6)) - (Prims.of_int (126)) - (Prims.of_int (49))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - Obj.magic - (FStarC_Tactics_V2_Builtins.norm - [ - FStar_Pervasives.delta_only - ["FStar.Tactics.CanonMonoid.mldenote"; - "FStar.Tactics.CanonMonoid.flatten"; - "FStar.List.Tot.Base.op_At"; - "FStar.List.Tot.Base.append"]])) - uu___13))) - uu___11))) - uu___10))) - uu___9))) - uu___7))) - uu___6))) - | uu___5 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "Goal should be an equality"))) - uu___4))) uu___3))) uu___1) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Canon_Lemmas.ml b/stage0/fstar-lib/generated/FStar_Tactics_Canon_Lemmas.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_Canon_Lemmas.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Derived.ml b/stage0/fstar-lib/generated/FStar_Tactics_Derived.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_Derived.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Logic.ml b/stage0/fstar-lib/generated/FStar_Tactics_Logic.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_Logic.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_MApply.ml b/stage0/fstar-lib/generated/FStar_Tactics_MApply.ml deleted file mode 100644 index 02d0692605b..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_MApply.ml +++ /dev/null @@ -1,55 +0,0 @@ -open Prims -type 'a termable = - { - to_term: - 'a -> (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr } -let __proj__Mktermable__item__to_term : - 'a . - 'a termable -> - 'a -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr - = fun projectee -> match projectee with | { to_term;_} -> to_term -let to_term : - 'a . - 'a termable -> - 'a -> - (FStarC_Reflection_Types.term, unit) FStar_Tactics_Effect.tac_repr - = - fun projectee -> match projectee with | { to_term = to_term1;_} -> to_term1 -let (termable_term : FStarC_Reflection_Types.term termable) = - { - to_term = - (fun uu___ -> - (fun t -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> t))) - uu___) - } -let (termable_binding : FStarC_Reflection_V2_Data.binding termable) = - { - to_term = - (fun uu___ -> - (fun b -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Tactics_V2_SyntaxCoercions.binding_to_term b))) - uu___) - } -let mapply : - 'ty . 'ty termable -> 'ty -> (unit, unit) FStar_Tactics_Effect.tac_repr = - fun uu___ -> - fun x -> - let uu___1 = to_term uu___ x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.MApply.fsti" - (Prims.of_int (23)) (Prims.of_int (10)) (Prims.of_int (23)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.MApply.fsti" - (Prims.of_int (24)) (Prims.of_int (2)) (Prims.of_int (24)) - (Prims.of_int (11))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun t -> Obj.magic (FStar_Tactics_MApply0.mapply0 t)) uu___2) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_PatternMatching.ml b/stage0/fstar-lib/generated/FStar_Tactics_PatternMatching.ml deleted file mode 100644 index 49b6e9e45c1..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_PatternMatching.ml +++ /dev/null @@ -1,4766 +0,0 @@ -open Prims -let (fetch_eq_side : - unit -> - ((FStar_Tactics_NamedView.term * FStar_Tactics_NamedView.term), unit) - FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - let uu___1 = FStar_Tactics_V2_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (63)) (Prims.of_int (10)) (Prims.of_int (63)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (64)) (Prims.of_int (2)) (Prims.of_int (88)) - (Prims.of_int (39))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun g -> - let uu___2 = FStar_Tactics_NamedView.inspect g in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (64)) (Prims.of_int (8)) - (Prims.of_int (64)) (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (64)) (Prims.of_int (2)) - (Prims.of_int (88)) (Prims.of_int (39))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStar_Tactics_NamedView.Tv_App - (squash, (g1, uu___4)) -> - Obj.magic - (Obj.repr - (let uu___5 = - FStar_Tactics_NamedView.inspect squash in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (66)) - (Prims.of_int (11)) - (Prims.of_int (66)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (66)) - (Prims.of_int (4)) - (Prims.of_int (87)) - (Prims.of_int (51))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 with - | FStar_Tactics_NamedView.Tv_UInst - (squash1, uu___7) -> - Obj.magic - (Obj.repr - (if - (FStar_Reflection_V2_Derived.fv_to_string - squash1) - = - (FStar_Reflection_V2_Derived.flatten_name - FStar_Reflection_Const.squash_qn) - then - Obj.repr - (let uu___8 = - FStar_Tactics_NamedView.inspect - g1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (70)) - (Prims.of_int (16)) - (Prims.of_int (70)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (70)) - (Prims.of_int (9)) - (Prims.of_int (85)) - (Prims.of_int (48))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun uu___9 -> - match uu___9 - with - | FStar_Tactics_NamedView.Tv_App - (eq_type_x, - (y, - uu___10)) - -> - Obj.magic - (Obj.repr - (let uu___11 - = - FStar_Tactics_NamedView.inspect - eq_type_x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (72)) - (Prims.of_int (19)) - (Prims.of_int (72)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (72)) - (Prims.of_int (12)) - (Prims.of_int (84)) - (Prims.of_int (39))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - match uu___12 - with - | - FStar_Tactics_NamedView.Tv_App - (eq_type, - (x, - uu___13)) - -> - Obj.magic - (Obj.repr - (let uu___14 - = - FStar_Tactics_NamedView.inspect - eq_type in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (74)) - (Prims.of_int (22)) - (Prims.of_int (74)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (74)) - (Prims.of_int (15)) - (Prims.of_int (83)) - (Prims.of_int (42))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - match uu___15 - with - | - FStar_Tactics_NamedView.Tv_App - (eq, - (typ, - uu___16)) - -> - Obj.magic - (Obj.repr - (let uu___17 - = - FStar_Tactics_NamedView.inspect - eq in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (76)) - (Prims.of_int (25)) - (Prims.of_int (76)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (76)) - (Prims.of_int (18)) - (Prims.of_int (82)) - (Prims.of_int (55))))) - (Obj.magic - uu___17) - (fun - uu___18 - -> - match uu___18 - with - | - FStar_Tactics_NamedView.Tv_UInst - (eq1, - uu___19) - -> - if - (FStar_Reflection_V2_Derived.fv_to_string - eq1) = - (FStar_Reflection_V2_Derived.flatten_name - FStar_Reflection_Const.eq2_qn) - then - FStar_Tactics_Effect.lift_div_tac - (fun - uu___20 - -> (x, y)) - else - FStar_Tactics_V2_Derived.fail - "not an equality" - | - FStar_Tactics_NamedView.Tv_FVar - eq1 -> - if - (FStar_Reflection_V2_Derived.fv_to_string - eq1) = - (FStar_Reflection_V2_Derived.flatten_name - FStar_Reflection_Const.eq2_qn) - then - FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> (x, y)) - else - FStar_Tactics_V2_Derived.fail - "not an equality" - | - uu___19 - -> - FStar_Tactics_V2_Derived.fail - "not an app2 of fvar: "))) - | - uu___16 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an app3"))) - uu___15))) - | - uu___13 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an app2"))) - uu___12))) - | uu___10 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an app under squash"))) - uu___9)) - else - Obj.repr - (FStar_Tactics_V2_Derived.fail - "not a squash"))) - | FStar_Tactics_NamedView.Tv_FVar - squash1 -> - Obj.magic - (Obj.repr - (if - (FStar_Reflection_V2_Derived.fv_to_string - squash1) - = - (FStar_Reflection_V2_Derived.flatten_name - FStar_Reflection_Const.squash_qn) - then - Obj.repr - (let uu___7 = - FStar_Tactics_NamedView.inspect - g1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (70)) - (Prims.of_int (16)) - (Prims.of_int (70)) - (Prims.of_int (25))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (70)) - (Prims.of_int (9)) - (Prims.of_int (85)) - (Prims.of_int (48))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - match uu___8 - with - | FStar_Tactics_NamedView.Tv_App - (eq_type_x, - (y, - uu___9)) - -> - Obj.magic - (Obj.repr - (let uu___10 - = - FStar_Tactics_NamedView.inspect - eq_type_x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (72)) - (Prims.of_int (19)) - (Prims.of_int (72)) - (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (72)) - (Prims.of_int (12)) - (Prims.of_int (84)) - (Prims.of_int (39))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - match uu___11 - with - | - FStar_Tactics_NamedView.Tv_App - (eq_type, - (x, - uu___12)) - -> - Obj.magic - (Obj.repr - (let uu___13 - = - FStar_Tactics_NamedView.inspect - eq_type in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (74)) - (Prims.of_int (22)) - (Prims.of_int (74)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (74)) - (Prims.of_int (15)) - (Prims.of_int (83)) - (Prims.of_int (42))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - (fun - uu___14 - -> - match uu___14 - with - | - FStar_Tactics_NamedView.Tv_App - (eq, - (typ, - uu___15)) - -> - Obj.magic - (Obj.repr - (let uu___16 - = - FStar_Tactics_NamedView.inspect - eq in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (76)) - (Prims.of_int (25)) - (Prims.of_int (76)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (76)) - (Prims.of_int (18)) - (Prims.of_int (82)) - (Prims.of_int (55))))) - (Obj.magic - uu___16) - (fun - uu___17 - -> - match uu___17 - with - | - FStar_Tactics_NamedView.Tv_UInst - (eq1, - uu___18) - -> - if - (FStar_Reflection_V2_Derived.fv_to_string - eq1) = - (FStar_Reflection_V2_Derived.flatten_name - FStar_Reflection_Const.eq2_qn) - then - FStar_Tactics_Effect.lift_div_tac - (fun - uu___19 - -> (x, y)) - else - FStar_Tactics_V2_Derived.fail - "not an equality" - | - FStar_Tactics_NamedView.Tv_FVar - eq1 -> - if - (FStar_Reflection_V2_Derived.fv_to_string - eq1) = - (FStar_Reflection_V2_Derived.flatten_name - FStar_Reflection_Const.eq2_qn) - then - FStar_Tactics_Effect.lift_div_tac - (fun - uu___18 - -> (x, y)) - else - FStar_Tactics_V2_Derived.fail - "not an equality" - | - uu___18 - -> - FStar_Tactics_V2_Derived.fail - "not an app2 of fvar: "))) - | - uu___15 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an app3"))) - uu___14))) - | - uu___12 - -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an app2"))) - uu___11))) - | uu___9 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an app under squash"))) - uu___8)) - else - Obj.repr - (FStar_Tactics_V2_Derived.fail - "not a squash"))) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an app of fvar at top level"))) - uu___6))) - | uu___4 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "not an app at top level"))) uu___3))) - uu___2) -let mustfail : - 'a . - (unit -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> - Prims.string -> (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun t -> - fun message -> - let uu___ = FStar_Tactics_V2_Derived.trytac t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (130)) (Prims.of_int (10)) - (Prims.of_int (130)) (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (130)) (Prims.of_int (4)) (Prims.of_int (132)) - (Prims.of_int (16))))) (Obj.magic uu___) - (fun uu___1 -> - match uu___1 with - | FStar_Pervasives_Native.Some uu___2 -> - FStar_Tactics_V2_Derived.fail message - | FStar_Pervasives_Native.None -> - FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) -let (implies_intro' : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = FStar_Tactics_V2_Logic.implies_intro () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (138)) (Prims.of_int (10)) (Prims.of_int (138)) - (Prims.of_int (26))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (138)) (Prims.of_int (30)) (Prims.of_int (138)) - (Prims.of_int (32))))) (Obj.magic uu___1) - (fun uu___2 -> FStar_Tactics_Effect.lift_div_tac (fun uu___3 -> ())) -let repeat' : - 'a . - (unit -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun f -> - let uu___ = FStar_Tactics_V2_Derived.repeat f in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (141)) (Prims.of_int (10)) (Prims.of_int (141)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (141)) (Prims.of_int (22)) (Prims.of_int (141)) - (Prims.of_int (24))))) (Obj.magic uu___) - (fun uu___1 -> FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> ())) -let (and_elim' : - FStar_Tactics_NamedView.binding -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun h -> - let uu___ = - FStar_Tactics_V2_Logic.and_elim - (FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Var - (FStar_Tactics_V2_SyntaxCoercions.binding_to_namedv h))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (144)) (Prims.of_int (2)) (Prims.of_int (144)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (145)) (Prims.of_int (2)) (Prims.of_int (145)) - (Prims.of_int (9))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> Obj.magic (FStarC_Tactics_V2_Builtins.clear h)) - uu___1) -let exact_hyp : - 'a . - FStar_Tactics_NamedView.namedv -> - (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun h -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (failwith "Cannot evaluate open quotation at runtime")) - uu___1)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (149)) (Prims.of_int (11)) (Prims.of_int (149)) - (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (150)) (Prims.of_int (2)) (Prims.of_int (150)) - (Prims.of_int (53))))) (Obj.magic uu___) - (fun uu___1 -> - (fun hd -> - Obj.magic - (FStar_Tactics_V2_Derived.exact - (FStar_Reflection_V2_Derived.mk_app hd - [((FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Var h)), - FStarC_Reflection_V2_Data.Q_Explicit)]))) uu___1) -let (exact_hyp' : - FStar_Tactics_NamedView.namedv -> - (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun h -> - FStar_Tactics_V2_Derived.exact - (FStar_Tactics_NamedView.pack (FStar_Tactics_NamedView.Tv_Var h)) -type varname = Prims.string -type qn = Prims.string -type pattern = - | PVar of varname - | PQn of qn - | PType - | PApp of pattern * pattern -let (uu___is_PVar : pattern -> Prims.bool) = - fun projectee -> match projectee with | PVar name -> true | uu___ -> false -let (__proj__PVar__item__name : pattern -> varname) = - fun projectee -> match projectee with | PVar name -> name -let (uu___is_PQn : pattern -> Prims.bool) = - fun projectee -> match projectee with | PQn qn1 -> true | uu___ -> false -let (__proj__PQn__item__qn : pattern -> qn) = - fun projectee -> match projectee with | PQn qn1 -> qn1 -let (uu___is_PType : pattern -> Prims.bool) = - fun projectee -> match projectee with | PType -> true | uu___ -> false -let (uu___is_PApp : pattern -> Prims.bool) = - fun projectee -> - match projectee with | PApp (hd, arg) -> true | uu___ -> false -let (__proj__PApp__item__hd : pattern -> pattern) = - fun projectee -> match projectee with | PApp (hd, arg) -> hd -let (__proj__PApp__item__arg : pattern -> pattern) = - fun projectee -> match projectee with | PApp (hd, arg) -> arg -let (desc_of_pattern : pattern -> Prims.string) = - fun uu___ -> - match uu___ with - | PVar uu___1 -> "a variable" - | PQn qn1 -> Prims.strcat "a constant (" (Prims.strcat qn1 ")") - | PType -> "Type" - | PApp (uu___1, uu___2) -> "a function application" -let rec (string_of_pattern : pattern -> Prims.string) = - fun uu___ -> - match uu___ with - | PVar x -> Prims.strcat "?" x - | PQn qn1 -> qn1 - | PType -> "Type" - | PApp (l, r) -> - Prims.strcat "(" - (Prims.strcat (string_of_pattern l) - (Prims.strcat " " (Prims.strcat (string_of_pattern r) ")"))) -type match_exception = - | NameMismatch of (qn * qn) - | SimpleMismatch of (pattern * FStar_Tactics_NamedView.term) - | NonLinearMismatch of (varname * FStar_Tactics_NamedView.term * - FStar_Tactics_NamedView.term) - | UnsupportedTermInPattern of FStar_Tactics_NamedView.term - | IncorrectTypeInAbsPatBinder of FStarC_Reflection_Types.typ -let (uu___is_NameMismatch : match_exception -> Prims.bool) = - fun projectee -> - match projectee with | NameMismatch _0 -> true | uu___ -> false -let (__proj__NameMismatch__item___0 : match_exception -> (qn * qn)) = - fun projectee -> match projectee with | NameMismatch _0 -> _0 -let (uu___is_SimpleMismatch : match_exception -> Prims.bool) = - fun projectee -> - match projectee with | SimpleMismatch _0 -> true | uu___ -> false -let (__proj__SimpleMismatch__item___0 : - match_exception -> (pattern * FStar_Tactics_NamedView.term)) = - fun projectee -> match projectee with | SimpleMismatch _0 -> _0 -let (uu___is_NonLinearMismatch : match_exception -> Prims.bool) = - fun projectee -> - match projectee with | NonLinearMismatch _0 -> true | uu___ -> false -let (__proj__NonLinearMismatch__item___0 : - match_exception -> - (varname * FStar_Tactics_NamedView.term * FStar_Tactics_NamedView.term)) - = fun projectee -> match projectee with | NonLinearMismatch _0 -> _0 -let (uu___is_UnsupportedTermInPattern : match_exception -> Prims.bool) = - fun projectee -> - match projectee with - | UnsupportedTermInPattern _0 -> true - | uu___ -> false -let (__proj__UnsupportedTermInPattern__item___0 : - match_exception -> FStar_Tactics_NamedView.term) = - fun projectee -> match projectee with | UnsupportedTermInPattern _0 -> _0 -let (uu___is_IncorrectTypeInAbsPatBinder : match_exception -> Prims.bool) = - fun projectee -> - match projectee with - | IncorrectTypeInAbsPatBinder _0 -> true - | uu___ -> false -let (__proj__IncorrectTypeInAbsPatBinder__item___0 : - match_exception -> FStarC_Reflection_Types.typ) = - fun projectee -> - match projectee with | IncorrectTypeInAbsPatBinder _0 -> _0 -let (term_head : - FStar_Tactics_NamedView.term -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = FStar_Tactics_NamedView.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (203)) (Prims.of_int (8)) (Prims.of_int (203)) - (Prims.of_int (17))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (203)) (Prims.of_int (2)) (Prims.of_int (220)) - (Prims.of_int (28))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - match uu___1 with - | FStar_Tactics_NamedView.Tv_Var bv -> "Tv_Var" - | FStar_Tactics_NamedView.Tv_BVar fv -> "Tv_BVar" - | FStar_Tactics_NamedView.Tv_FVar fv -> "Tv_FVar" - | FStar_Tactics_NamedView.Tv_UInst (uu___3, uu___4) -> - "Tv_UInst" - | FStar_Tactics_NamedView.Tv_App (f, x) -> "Tv_App" - | FStar_Tactics_NamedView.Tv_Abs (x, t1) -> "Tv_Abs" - | FStar_Tactics_NamedView.Tv_Arrow (x, t1) -> "Tv_Arrow" - | FStar_Tactics_NamedView.Tv_Type uu___3 -> "Tv_Type" - | FStar_Tactics_NamedView.Tv_Refine (x, t1) -> "Tv_Refine" - | FStar_Tactics_NamedView.Tv_Const cst -> "Tv_Const" - | FStar_Tactics_NamedView.Tv_Uvar (i, t1) -> "Tv_Uvar" - | FStar_Tactics_NamedView.Tv_Let (r, attrs, b, t1, t2) -> - "Tv_Let" - | FStar_Tactics_NamedView.Tv_Match (t1, uu___3, branches) -> - "Tv_Match" - | FStar_Tactics_NamedView.Tv_AscribedT - (uu___3, uu___4, uu___5, uu___6) -> "Tv_AscribedT" - | FStar_Tactics_NamedView.Tv_AscribedC - (uu___3, uu___4, uu___5, uu___6) -> "Tv_AscribedC" - | FStar_Tactics_NamedView.Tv_Unknown -> "Tv_Unknown" - | FStar_Tactics_NamedView.Tv_Unsupp -> "Tv_Unsupp")) -let (string_of_match_exception : - match_exception -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - (fun uu___ -> - match uu___ with - | NameMismatch (qn1, qn2) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - Prims.strcat - "Match failure (name mismatch): expecting " - (Prims.strcat qn1 (Prims.strcat ", found " qn2))))) - | SimpleMismatch (pat, tm) -> - Obj.magic - (Obj.repr - (let uu___1 = - let uu___2 = - let uu___3 = - FStarC_Tactics_V2_Builtins.term_to_string tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (228)) (Prims.of_int (37)) - (Prims.of_int (228)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat ", got " uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (228)) (Prims.of_int (26)) - (Prims.of_int (228)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat (desc_of_pattern pat) uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (228)) (Prims.of_int (4)) - (Prims.of_int (228)) (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - "Match failure (sort mismatch): expecting " - uu___2)))) - | NonLinearMismatch (nm, t1, t2) -> - Obj.magic - (Obj.repr - (let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - FStarC_Tactics_V2_Builtins.term_to_string t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (231)) (Prims.of_int (30)) - (Prims.of_int (231)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (231)) (Prims.of_int (30)) - (Prims.of_int (232)) (Prims.of_int (33))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - let uu___7 = - FStarC_Tactics_V2_Builtins.term_to_string - t2 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (232)) - (Prims.of_int (14)) - (Prims.of_int (232)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - Prims.strcat " and " uu___8)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (232)) - (Prims.of_int (4)) - (Prims.of_int (232)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat uu___5 uu___7)))) - uu___5) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (231)) (Prims.of_int (30)) - (Prims.of_int (232)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - Prims.strcat " needs to match both " uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (231)) (Prims.of_int (4)) - (Prims.of_int (232)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat nm uu___3)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (230)) (Prims.of_int (54)) - (Prims.of_int (232)) (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - "Match failure (nonlinear mismatch): variable " - uu___2)))) - | UnsupportedTermInPattern tm -> - Obj.magic - (Obj.repr - (let uu___1 = - let uu___2 = FStarC_Tactics_V2_Builtins.term_to_string tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (235)) (Prims.of_int (4)) - (Prims.of_int (235)) (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (235)) (Prims.of_int (4)) - (Prims.of_int (235)) (Prims.of_int (49))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - let uu___5 = - let uu___6 = term_head tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (235)) - (Prims.of_int (31)) - (Prims.of_int (235)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> Prims.strcat uu___7 ")")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (235)) - (Prims.of_int (31)) - (Prims.of_int (235)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> Prims.strcat " (" uu___6)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (235)) - (Prims.of_int (24)) - (Prims.of_int (235)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat uu___3 uu___5)))) uu___3) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (235)) (Prims.of_int (4)) - (Prims.of_int (235)) (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - "Match failure (unsupported term in pattern): " - uu___2)))) - | IncorrectTypeInAbsPatBinder typ -> - Obj.magic - (Obj.repr - (let uu___1 = - let uu___2 = FStarC_Tactics_V2_Builtins.term_to_string typ in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (238)) (Prims.of_int (4)) - (Prims.of_int (238)) (Prims.of_int (22))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - Prims.strcat uu___3 - " (use one of ``var``, ``hyp \226\128\166``, or ``goal \226\128\166``)")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (238)) (Prims.of_int (4)) - (Prims.of_int (238)) (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - Prims.strcat - "Incorrect type in pattern-matching binder: " - uu___2))))) uu___ -type 'a match_res = - | Success of 'a - | Failure of match_exception -let uu___is_Success : 'a . 'a match_res -> Prims.bool = - fun projectee -> match projectee with | Success _0 -> true | uu___ -> false -let __proj__Success__item___0 : 'a . 'a match_res -> 'a = - fun projectee -> match projectee with | Success _0 -> _0 -let uu___is_Failure : 'a . 'a match_res -> Prims.bool = - fun projectee -> match projectee with | Failure _0 -> true | uu___ -> false -let __proj__Failure__item___0 : 'a . 'a match_res -> match_exception = - fun projectee -> match projectee with | Failure _0 -> _0 -let return : 'a . 'a -> 'a match_res = fun x -> Success x -let op_let_Question : - 'a 'b . - 'a match_res -> - ('a -> ('b match_res, unit) FStar_Tactics_Effect.tac_repr) -> - ('b match_res, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun f -> - fun g -> - match f with - | Success aa -> Obj.magic (Obj.repr (g aa)) - | Failure ex -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> Failure ex)))) uu___1 uu___ -let raise : 'a . match_exception -> 'a match_res = fun ex -> Failure ex -let lift_exn_tac : - 'a 'b . - ('a -> 'b match_res) -> 'a -> ('b, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun f -> - fun aa -> - match f aa with - | Success bb -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> bb))) - | Failure ex -> - Obj.magic - (Obj.repr - (let uu___ = string_of_match_exception ex in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (269)) (Prims.of_int (31)) - (Prims.of_int (269)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (269)) (Prims.of_int (18)) - (Prims.of_int (269)) (Prims.of_int (61))))) - (Obj.magic uu___) - (fun uu___1 -> FStar_Tactics_V1_Derived.fail uu___1)))) - uu___1 uu___ -let lift_exn_tactic : - 'a 'b . - ('a -> 'b match_res) -> 'a -> ('b, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun f -> - fun aa -> - match f aa with - | Success bb -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> bb))) - | Failure ex -> - Obj.magic - (Obj.repr - (let uu___ = string_of_match_exception ex in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (274)) (Prims.of_int (31)) - (Prims.of_int (274)) (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (274)) (Prims.of_int (18)) - (Prims.of_int (274)) (Prims.of_int (61))))) - (Obj.magic uu___) - (fun uu___1 -> FStar_Tactics_V1_Derived.fail uu___1)))) - uu___1 uu___ -type bindings = (varname * FStar_Tactics_NamedView.term) Prims.list -let (string_of_bindings : - bindings -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun bindings1 -> - let uu___ = - FStar_Tactics_Util.map - (fun uu___1 -> - match uu___1 with - | (nm, tm) -> - let uu___2 = - let uu___3 = - let uu___4 = FStarC_Tactics_V2_Builtins.term_to_string tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (286)) (Prims.of_int (47)) - (Prims.of_int (286)) (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat ": " uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (286)) (Prims.of_int (40)) - (Prims.of_int (286)) (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat nm uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (286)) (Prims.of_int (35)) - (Prims.of_int (286)) (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> Prims.strcat ">> " uu___3))) bindings1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (286)) (Prims.of_int (4)) (Prims.of_int (287)) - (Prims.of_int (27))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (285)) (Prims.of_int (2)) (Prims.of_int (287)) - (Prims.of_int (27))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> FStar_String.concat "\n" uu___1)) -let rec (interp_pattern_aux : - pattern -> - bindings -> - FStar_Tactics_NamedView.term -> - (bindings match_res, unit) FStar_Tactics_Effect.tac_repr) - = - fun pat -> - fun cur_bindings -> - fun tm -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun v -> - fun cur_bindings1 -> - fun tm1 -> - match FStar_List_Tot_Base.assoc v cur_bindings1 with - | FStar_Pervasives_Native.Some tm' -> - if FStar_Reflection_TermEq_Simple.term_eq tm1 tm' - then return cur_bindings1 - else raise (NonLinearMismatch (v, tm1, tm')) - | FStar_Pervasives_Native.None -> - return ((v, tm1) :: cur_bindings1))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (295)) (Prims.of_int (4)) - (Prims.of_int (298)) (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (298)) (Prims.of_int (49)) - (Prims.of_int (321)) (Prims.of_int (62))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun interp_var -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - fun qn1 -> - fun cur_bindings1 -> - fun tm1 -> - let uu___3 = - FStar_Tactics_NamedView.inspect tm1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (300)) - (Prims.of_int (10)) - (Prims.of_int (300)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (300)) - (Prims.of_int (4)) - (Prims.of_int (305)) - (Prims.of_int (43))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - match uu___4 with - | FStar_Tactics_NamedView.Tv_UInst - (fv, uu___6) -> - if - (FStar_Reflection_V2_Derived.fv_to_string - fv) - = qn1 - then return cur_bindings1 - else - raise - (NameMismatch - (qn1, - (FStar_Reflection_V2_Derived.fv_to_string - fv))) - | FStar_Tactics_NamedView.Tv_FVar - fv -> - if - (FStar_Reflection_V2_Derived.fv_to_string - fv) - = qn1 - then return cur_bindings1 - else - raise - (NameMismatch - (qn1, - (FStar_Reflection_V2_Derived.fv_to_string - fv))) - | uu___6 -> - raise - (SimpleMismatch (pat, tm1)))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (300)) (Prims.of_int (4)) - (Prims.of_int (305)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (305)) (Prims.of_int (46)) - (Prims.of_int (321)) (Prims.of_int (62))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun interp_qn -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - fun cur_bindings1 -> - fun tm1 -> - let uu___4 = - FStar_Tactics_NamedView.inspect - tm1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (307)) - (Prims.of_int (10)) - (Prims.of_int (307)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (307)) - (Prims.of_int (4)) - (Prims.of_int (309)) - (Prims.of_int (43))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - match uu___5 with - | FStar_Tactics_NamedView.Tv_Type - uu___7 -> - return cur_bindings1 - | uu___7 -> - raise - (SimpleMismatch - (pat, tm1)))))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (307)) - (Prims.of_int (4)) - (Prims.of_int (309)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (309)) - (Prims.of_int (46)) - (Prims.of_int (321)) - (Prims.of_int (62))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun interp_type -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - fun p_hd -> - fun p_arg -> - fun cur_bindings1 -> - fun tm1 -> - let uu___5 = - FStar_Tactics_NamedView.inspect - tm1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (311)) - (Prims.of_int (10)) - (Prims.of_int (311)) - (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (311)) - (Prims.of_int (4)) - (Prims.of_int (316)) - (Prims.of_int (43))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 - with - | FStar_Tactics_NamedView.Tv_App - (hd, - (arg, - uu___7)) - -> - Obj.magic - (Obj.repr - (let uu___8 - = - interp_pattern_aux - p_hd - cur_bindings1 - hd in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (313)) - (Prims.of_int (21)) - (Prims.of_int (313)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (313)) - (Prims.of_int (6)) - (Prims.of_int (315)) - (Prims.of_int (21))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - Obj.magic - (op_let_Question - uu___9 - (fun - with_hd - -> - let uu___10 - = - interp_pattern_aux - p_arg - with_hd - arg in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (314)) - (Prims.of_int (22)) - (Prims.of_int (314)) - (Prims.of_int (58))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (314)) - (Prims.of_int (6)) - (Prims.of_int (315)) - (Prims.of_int (21))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - Obj.magic - (op_let_Question - uu___11 - (fun - uu___12 - -> - (fun - with_arg - -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - return - with_arg))) - uu___12))) - uu___11)))) - uu___9))) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - raise - (SimpleMismatch - (pat, - tm1)))))) - uu___6))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (311)) - (Prims.of_int (4)) - (Prims.of_int (316)) - (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (317)) - (Prims.of_int (4)) - (Prims.of_int (321)) - (Prims.of_int (62))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun interp_app -> - match pat with - | PVar var -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - interp_var - var - cur_bindings - tm))) - | PQn qn1 -> - Obj.magic - (Obj.repr - (interp_qn qn1 - cur_bindings tm)) - | PType -> - Obj.magic - (Obj.repr - (interp_type - cur_bindings tm)) - | PApp (p_hd, p_arg) -> - Obj.magic - (Obj.repr - (interp_app p_hd - p_arg - cur_bindings tm))) - uu___4))) uu___3))) uu___2))) - uu___1) -let (interp_pattern : - pattern -> - FStar_Tactics_NamedView.term -> - (bindings match_res, unit) FStar_Tactics_Effect.tac_repr) - = - fun pat -> - fun tm -> - let uu___ = interp_pattern_aux pat [] tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (327)) (Prims.of_int (24)) - (Prims.of_int (327)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (327)) (Prims.of_int (4)) (Prims.of_int (328)) - (Prims.of_int (43))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (op_let_Question uu___1 - (fun uu___2 -> - (fun rev_bindings -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - return - (FStar_List_Tot_Base.rev rev_bindings)))) - uu___2))) uu___1) -let (match_term : - pattern -> - FStar_Tactics_NamedView.term -> - (bindings, unit) FStar_Tactics_Effect.tac_repr) - = - fun pat -> - fun tm -> - let uu___ = - let uu___1 = FStar_Tactics_V2_Derived.norm_term [] tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (334)) (Prims.of_int (29)) - (Prims.of_int (334)) (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (334)) (Prims.of_int (10)) - (Prims.of_int (334)) (Prims.of_int (46))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> Obj.magic (interp_pattern pat uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (334)) (Prims.of_int (10)) - (Prims.of_int (334)) (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (334)) (Prims.of_int (4)) (Prims.of_int (336)) - (Prims.of_int (63))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | Success bb -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> bb))) - | Failure ex -> - Obj.magic - (Obj.repr - (let uu___2 = string_of_match_exception ex in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (336)) (Prims.of_int (33)) - (Prims.of_int (336)) (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (336)) (Prims.of_int (20)) - (Prims.of_int (336)) (Prims.of_int (63))))) - (Obj.magic uu___2) - (fun uu___3 -> FStar_Tactics_V1_Derived.fail uu___3)))) - uu___1) -let debug : 'uuuuu . 'uuuuu -> (unit, unit) FStar_Tactics_Effect.tac_repr = - fun uu___ -> - (fun msg -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> ()))) uu___ -type absvar = FStar_Tactics_NamedView.binding -type hypothesis = FStar_Tactics_NamedView.binding -type matching_problem = - { - mp_vars: varname Prims.list ; - mp_hyps: (varname * pattern) Prims.list ; - mp_goal: pattern FStar_Pervasives_Native.option } -let (__proj__Mkmatching_problem__item__mp_vars : - matching_problem -> varname Prims.list) = - fun projectee -> - match projectee with | { mp_vars; mp_hyps; mp_goal;_} -> mp_vars -let (__proj__Mkmatching_problem__item__mp_hyps : - matching_problem -> (varname * pattern) Prims.list) = - fun projectee -> - match projectee with | { mp_vars; mp_hyps; mp_goal;_} -> mp_hyps -let (__proj__Mkmatching_problem__item__mp_goal : - matching_problem -> pattern FStar_Pervasives_Native.option) = - fun projectee -> - match projectee with | { mp_vars; mp_hyps; mp_goal;_} -> mp_goal -let (string_of_matching_problem : matching_problem -> Prims.string) = - fun mp -> - let vars = FStar_String.concat ", " mp.mp_vars in - let hyps = - FStar_String.concat "\n " - (FStar_List_Tot_Base.map - (fun uu___ -> - match uu___ with - | (nm, pat) -> - Prims.strcat nm (Prims.strcat ": " (string_of_pattern pat))) - mp.mp_hyps) in - let goal = - match mp.mp_goal with - | FStar_Pervasives_Native.None -> "_" - | FStar_Pervasives_Native.Some pat -> string_of_pattern pat in - Prims.strcat "\n{ vars: " - (Prims.strcat vars - (Prims.strcat "\n" - (Prims.strcat " hyps: " - (Prims.strcat hyps - (Prims.strcat "\n" - (Prims.strcat " goal: " (Prims.strcat goal " }"))))))) -type matching_solution = - { - ms_vars: (varname * FStar_Tactics_NamedView.term) Prims.list ; - ms_hyps: (varname * hypothesis) Prims.list } -let (__proj__Mkmatching_solution__item__ms_vars : - matching_solution -> (varname * FStar_Tactics_NamedView.term) Prims.list) = - fun projectee -> match projectee with | { ms_vars; ms_hyps;_} -> ms_vars -let (__proj__Mkmatching_solution__item__ms_hyps : - matching_solution -> (varname * hypothesis) Prims.list) = - fun projectee -> match projectee with | { ms_vars; ms_hyps;_} -> ms_hyps -let (string_of_matching_solution : - matching_solution -> (Prims.string, unit) FStar_Tactics_Effect.tac_repr) = - fun ms -> - let uu___ = - let uu___1 = - FStar_Tactics_Util.map - (fun uu___2 -> - match uu___2 with - | (varname1, tm) -> - let uu___3 = - let uu___4 = FStarC_Tactics_V2_Builtins.term_to_string tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (385)) (Prims.of_int (25)) - (Prims.of_int (385)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat ": " uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (385)) (Prims.of_int (18)) - (Prims.of_int (385)) (Prims.of_int (44))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> Prims.strcat varname1 uu___4))) - ms.ms_vars in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (384)) (Prims.of_int (6)) (Prims.of_int (385)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (383)) (Prims.of_int (4)) (Prims.of_int (385)) - (Prims.of_int (57))))) (Obj.magic uu___1) - (fun uu___2 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> FStar_String.concat "\n " uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (383)) (Prims.of_int (4)) (Prims.of_int (385)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (385)) (Prims.of_int (60)) (Prims.of_int (391)) - (Prims.of_int (26))))) (Obj.magic uu___) - (fun uu___1 -> - (fun vars -> - let uu___1 = - let uu___2 = - FStar_Tactics_Util.map - (fun uu___3 -> - match uu___3 with - | (nm, binding) -> - let uu___4 = - let uu___5 = - FStar_Tactics_V2_Derived.binding_to_string - binding in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (389)) - (Prims.of_int (20)) - (Prims.of_int (389)) - (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> Prims.strcat ": " uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (389)) (Prims.of_int (13)) - (Prims.of_int (389)) (Prims.of_int (47))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat nm uu___5))) - ms.ms_hyps in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (388)) (Prims.of_int (6)) - (Prims.of_int (389)) (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (387)) (Prims.of_int (4)) - (Prims.of_int (389)) (Prims.of_int (60))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> FStar_String.concat "\n " uu___3)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (387)) (Prims.of_int (4)) - (Prims.of_int (389)) (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" (Prims.of_int (611)) - (Prims.of_int (19)) (Prims.of_int (611)) - (Prims.of_int (31))))) (Obj.magic uu___1) - (fun hyps -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - Prims.strcat "\n{ vars: " - (Prims.strcat vars - (Prims.strcat "\n" - (Prims.strcat " hyps: " - (Prims.strcat hyps " }")))))))) uu___1) -let assoc_varname_fail : - 'b . - varname -> - (varname * 'b) Prims.list -> ('b, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun key -> - fun ls -> - match FStar_List_Tot_Base.assoc key ls with - | FStar_Pervasives_Native.None -> - Obj.magic - (FStar_Tactics_V2_Derived.fail - (Prims.strcat "Not found: " key)) - | FStar_Pervasives_Native.Some x -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> x))) - uu___1 uu___ -let ms_locate_hyp : - 'a . - matching_solution -> - varname -> (hypothesis, unit) FStar_Tactics_Effect.tac_repr - = fun solution -> fun name -> assoc_varname_fail name solution.ms_hyps -let ms_locate_var : - 'a . - matching_solution -> varname -> ('a, unit) FStar_Tactics_Effect.tac_repr - = - fun solution -> - fun name -> - let uu___ = assoc_varname_fail name solution.ms_vars in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (406)) (Prims.of_int (13)) - (Prims.of_int (406)) (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (406)) (Prims.of_int (2)) (Prims.of_int (406)) - (Prims.of_int (55))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - Obj.magic (FStarC_Tactics_V2_Builtins.unquote uu___1)) uu___1) -let ms_locate_unit : - 'uuuuu 'uuuuu1 'a . - 'uuuuu -> 'uuuuu1 -> (unit, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___1 -> - fun uu___ -> - (fun _solution -> - fun _binder_name -> - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___ -> ()))) - uu___1 uu___ -let rec solve_mp_for_single_hyp : - 'a . - varname -> - pattern -> - hypothesis Prims.list -> - (matching_solution -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> - matching_solution -> ('a, unit) FStar_Tactics_Effect.tac_repr - = - fun uu___4 -> - fun uu___3 -> - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun name -> - fun pat -> - fun hypotheses -> - fun body -> - fun part_sol -> - match hypotheses with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "No matching hypothesis")) - | h::hs -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.or_else - (fun uu___ -> - let uu___1 = - interp_pattern_aux pat - part_sol.ms_vars - (FStar_Tactics_V2_Derived.type_of_binding - h) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (446)) - (Prims.of_int (15)) - (Prims.of_int (446)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (446)) - (Prims.of_int (9)) - (Prims.of_int (451)) - (Prims.of_int (73))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - match uu___2 with - | Failure ex -> - let uu___3 = - let uu___4 = - string_of_match_exception - ex in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (448)) - (Prims.of_int (43)) - (Prims.of_int (448)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat - "Failed to match hyp: " - uu___5)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (448)) - (Prims.of_int (16)) - (Prims.of_int (448)) - (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (448)) - (Prims.of_int (11)) - (Prims.of_int (448)) - (Prims.of_int (74))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_V2_Derived.fail - uu___4)) - | Success bindings1 -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - (name, h) :: - (part_sol.ms_hyps))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (450)) - (Prims.of_int (25)) - (Prims.of_int (450)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (451)) - (Prims.of_int (11)) - (Prims.of_int (451)) - (Prims.of_int (73))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun ms_hyps -> - Obj.magic - (body - { - ms_vars = - bindings1; - ms_hyps - })) uu___4))) - uu___2)) - (fun uu___ -> - solve_mp_for_single_hyp name pat hs - body part_sol)))) uu___4 uu___3 - uu___2 uu___1 uu___ -let rec solve_mp_for_hyps : - 'a . - (varname * pattern) Prims.list -> - hypothesis Prims.list -> - (matching_solution -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> - matching_solution -> ('a, unit) FStar_Tactics_Effect.tac_repr - = - fun mp_hyps -> - fun hypotheses -> - fun body -> - fun partial_solution -> - match mp_hyps with - | [] -> body partial_solution - | (name, pat)::pats -> - solve_mp_for_single_hyp name pat hypotheses - (solve_mp_for_hyps pats hypotheses body) partial_solution -let solve_mp : - 'a . - matching_problem -> - hypothesis Prims.list -> - FStar_Tactics_NamedView.term -> - (matching_solution -> ('a, unit) FStar_Tactics_Effect.tac_repr) -> - ('a, unit) FStar_Tactics_Effect.tac_repr - = - fun problem -> - fun hypotheses -> - fun goal -> - fun body -> - let uu___ = - match problem.mp_goal with - | FStar_Pervasives_Native.None -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> { ms_vars = []; ms_hyps = [] }))) - | FStar_Pervasives_Native.Some pat -> - Obj.magic - (Obj.repr - (let uu___1 = interp_pattern pat goal in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (482)) (Prims.of_int (12)) - (Prims.of_int (482)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (482)) (Prims.of_int (6)) - (Prims.of_int (484)) (Prims.of_int (64))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - match uu___2 with - | Failure ex -> - Obj.magic - (Obj.repr - (let uu___3 = - let uu___4 = - string_of_match_exception ex in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (483)) - (Prims.of_int (55)) - (Prims.of_int (483)) - (Prims.of_int (85))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - Prims.strcat - "Failed to match goal: " - uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (483)) - (Prims.of_int (27)) - (Prims.of_int (483)) - (Prims.of_int (86))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (483)) - (Prims.of_int (22)) - (Prims.of_int (483)) - (Prims.of_int (86))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_V2_Derived.fail - uu___4))) - | Success bindings1 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - { - ms_vars = bindings1; - ms_hyps = [] - })))) uu___2))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (479)) (Prims.of_int (4)) - (Prims.of_int (484)) (Prims.of_int (64))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (485)) (Prims.of_int (2)) - (Prims.of_int (485)) (Prims.of_int (62))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun goal_ps -> - Obj.magic - (solve_mp_for_hyps problem.mp_hyps hypotheses body - goal_ps)) uu___1) -let (name_of_namedv : - FStar_Tactics_NamedView.namedv -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = - fun x -> - FStarC_Tactics_Unseal.unseal - (FStar_Tactics_NamedView.inspect_namedv x).FStarC_Reflection_V2_Data.ppname -let rec (pattern_of_term_ex : - FStarC_Reflection_Types.term -> - (pattern match_res, unit) FStar_Tactics_Effect.tac_repr) - = - fun tm -> - let uu___ = FStar_Tactics_NamedView.inspect tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (508)) (Prims.of_int (8)) (Prims.of_int (508)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (508)) (Prims.of_int (2)) (Prims.of_int (521)) - (Prims.of_int (44))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Tactics_NamedView.Tv_Var bv -> - Obj.magic - (Obj.repr - (let uu___2 = - let uu___3 = name_of_namedv bv in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (510)) (Prims.of_int (17)) - (Prims.of_int (510)) (Prims.of_int (36))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (510)) (Prims.of_int (11)) - (Prims.of_int (510)) (Prims.of_int (37))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> PVar uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (510)) (Prims.of_int (11)) - (Prims.of_int (510)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (510)) (Prims.of_int (4)) - (Prims.of_int (510)) (Prims.of_int (37))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> return uu___3)))) - | FStar_Tactics_NamedView.Tv_FVar fv -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - return - (PQn - (FStar_Reflection_V2_Derived.fv_to_string fv))))) - | FStar_Tactics_NamedView.Tv_UInst (fv, uu___2) -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - return - (PQn - (FStar_Reflection_V2_Derived.fv_to_string fv))))) - | FStar_Tactics_NamedView.Tv_Type uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> return PType))) - | FStar_Tactics_NamedView.Tv_App (f, (x, uu___2)) -> - Obj.magic - (Obj.repr - (let uu___3 = pattern_of_term_ex f in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (518)) (Prims.of_int (17)) - (Prims.of_int (518)) (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (518)) (Prims.of_int (5)) - (Prims.of_int (520)) (Prims.of_int (28))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (op_let_Question uu___4 - (fun fpat -> - let uu___5 = pattern_of_term_ex x in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (519)) - (Prims.of_int (17)) - (Prims.of_int (519)) - (Prims.of_int (37))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (519)) - (Prims.of_int (5)) - (Prims.of_int (520)) - (Prims.of_int (28))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (op_let_Question uu___6 - (fun uu___7 -> - (fun xpat -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> - return - (PApp - (fpat, - xpat))))) - uu___7))) uu___6)))) - uu___4))) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> raise (UnsupportedTermInPattern tm))))) - uu___1) -let (beta_reduce : - FStar_Tactics_NamedView.term -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - = fun tm -> FStar_Tactics_V2_Derived.norm_term [] tm -let (pattern_of_term : - FStarC_Reflection_Types.term -> - (pattern, unit) FStar_Tactics_Effect.tac_repr) - = - fun tm -> - let uu___ = pattern_of_term_ex tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (531)) (Prims.of_int (10)) (Prims.of_int (531)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (531)) (Prims.of_int (4)) (Prims.of_int (533)) - (Prims.of_int (63))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | Success bb -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> bb))) - | Failure ex -> - Obj.magic - (Obj.repr - (let uu___2 = string_of_match_exception ex in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (533)) (Prims.of_int (33)) - (Prims.of_int (533)) (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (533)) (Prims.of_int (20)) - (Prims.of_int (533)) (Prims.of_int (63))))) - (Obj.magic uu___2) - (fun uu___3 -> FStar_Tactics_V1_Derived.fail uu___3)))) - uu___1) -type 'a hyp = FStar_Tactics_NamedView.binding -type 'a pm_goal = unit -let (hyp_qn : Prims.string) = "FStar.Tactics.PatternMatching.hyp" -let (goal_qn : Prims.string) = "FStar.Tactics.PatternMatching.pm_goal" -type abspat_binder_kind = - | ABKVar of FStarC_Reflection_Types.typ - | ABKHyp - | ABKGoal -let (uu___is_ABKVar : abspat_binder_kind -> Prims.bool) = - fun projectee -> match projectee with | ABKVar _0 -> true | uu___ -> false -let (__proj__ABKVar__item___0 : - abspat_binder_kind -> FStarC_Reflection_Types.typ) = - fun projectee -> match projectee with | ABKVar _0 -> _0 -let (uu___is_ABKHyp : abspat_binder_kind -> Prims.bool) = - fun projectee -> match projectee with | ABKHyp -> true | uu___ -> false -let (uu___is_ABKGoal : abspat_binder_kind -> Prims.bool) = - fun projectee -> match projectee with | ABKGoal -> true | uu___ -> false -let (string_of_abspat_binder_kind : abspat_binder_kind -> Prims.string) = - fun uu___ -> - match uu___ with - | ABKVar uu___1 -> "varname" - | ABKHyp -> "hyp" - | ABKGoal -> "goal" -type abspat_argspec = { - asa_name: absvar ; - asa_kind: abspat_binder_kind } -let (__proj__Mkabspat_argspec__item__asa_name : abspat_argspec -> absvar) = - fun projectee -> match projectee with | { asa_name; asa_kind;_} -> asa_name -let (__proj__Mkabspat_argspec__item__asa_kind : - abspat_argspec -> abspat_binder_kind) = - fun projectee -> match projectee with | { asa_name; asa_kind;_} -> asa_kind -type abspat_continuation = - (abspat_argspec Prims.list * FStar_Tactics_NamedView.term) -let (type_of_named_binder : - FStar_Tactics_NamedView.binder -> FStar_Tactics_NamedView.term) = - fun nb -> nb.FStar_Tactics_NamedView.sort -let (classify_abspat_binder : - FStar_Tactics_NamedView.binder -> - ((abspat_binder_kind * FStar_Tactics_NamedView.term), unit) - FStar_Tactics_Effect.tac_repr) - = - fun b -> - let uu___ = - Obj.magic (FStar_Tactics_Effect.lift_div_tac (fun uu___1 -> "v")) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (588)) (Prims.of_int (16)) (Prims.of_int (588)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (588)) (Prims.of_int (22)) (Prims.of_int (600)) - (Prims.of_int (34))))) (Obj.magic uu___) - (fun uu___1 -> - (fun varname1 -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> PApp ((PQn hyp_qn), (PVar varname1)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (589)) (Prims.of_int (16)) - (Prims.of_int (589)) (Prims.of_int (48))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (589)) (Prims.of_int (51)) - (Prims.of_int (600)) (Prims.of_int (34))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun hyp_pat -> - let uu___2 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - PApp ((PQn goal_qn), (PVar varname1)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (590)) (Prims.of_int (17)) - (Prims.of_int (590)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (590)) (Prims.of_int (53)) - (Prims.of_int (600)) (Prims.of_int (34))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun goal_pat -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - type_of_named_binder b)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (592)) - (Prims.of_int (12)) - (Prims.of_int (592)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (593)) - (Prims.of_int (2)) - (Prims.of_int (600)) - (Prims.of_int (34))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun typ -> - let uu___4 = - interp_pattern hyp_pat typ in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (593)) - (Prims.of_int (8)) - (Prims.of_int (593)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (593)) - (Prims.of_int (2)) - (Prims.of_int (600)) - (Prims.of_int (34))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - match uu___5 with - | Success - ((uu___6, - hyp_typ)::[]) - -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - ( - fun - uu___7 -> - (ABKHyp, - hyp_typ)))) - | Success uu___6 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "classifiy_abspat_binder: impossible (1)")) - | Failure uu___6 -> - Obj.magic - (Obj.repr - (let uu___7 - = - interp_pattern - goal_pat - typ in - FStar_Tactics_Effect.tac_bind - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (597)) - (Prims.of_int (10)) - (Prims.of_int (597)) - (Prims.of_int (37))))) - ( - FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (597)) - (Prims.of_int (4)) - (Prims.of_int (600)) - (Prims.of_int (34))))) - ( - Obj.magic - uu___7) - ( - fun - uu___8 -> - match uu___8 - with - | - Success - ((uu___9, - goal_typ)::[]) - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (ABKGoal, - goal_typ)) - | - Success - uu___9 -> - FStar_Tactics_V2_Derived.fail - "classifiy_abspat_binder: impossible (2)" - | - Failure - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - ((ABKVar - typ), - typ)))))) - uu___5))) uu___4))) - uu___3))) uu___2))) uu___1) -let rec (binders_and_body_of_abs : - FStar_Tactics_NamedView.term -> - ((FStar_Tactics_NamedView.binder Prims.list * - FStar_Tactics_NamedView.term), - unit) FStar_Tactics_Effect.tac_repr) - = - fun tm -> - let uu___ = FStar_Tactics_NamedView.inspect tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (604)) (Prims.of_int (8)) (Prims.of_int (604)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (604)) (Prims.of_int (2)) (Prims.of_int (608)) - (Prims.of_int (15))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Tactics_NamedView.Tv_Abs (binder, tm1) -> - Obj.magic - (Obj.repr - (let uu___2 = binders_and_body_of_abs tm1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (606)) (Prims.of_int (24)) - (Prims.of_int (606)) (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (605)) (Prims.of_int (23)) - (Prims.of_int (607)) (Prims.of_int (27))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - match uu___3 with - | (binders, body) -> - ((binder :: binders), body))))) - | uu___2 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> ([], tm))))) uu___1) -let (cleanup_abspat : - FStar_Tactics_NamedView.term -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - = fun t -> FStar_Tactics_V2_Derived.norm_term [] t -let (name_of_named_binder : - FStar_Tactics_NamedView.binder -> - (Prims.string, unit) FStar_Tactics_Effect.tac_repr) - = fun nb -> FStarC_Tactics_Unseal.unseal nb.FStar_Tactics_NamedView.ppname -let (matching_problem_of_abs : - FStar_Tactics_NamedView.term -> - ((matching_problem * abspat_continuation), unit) - FStar_Tactics_Effect.tac_repr) - = - fun tm -> - let uu___ = - let uu___1 = cleanup_abspat tm in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (634)) (Prims.of_int (46)) - (Prims.of_int (634)) (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (634)) (Prims.of_int (22)) - (Prims.of_int (634)) (Prims.of_int (65))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> Obj.magic (binders_and_body_of_abs uu___2)) uu___2) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (634)) (Prims.of_int (22)) (Prims.of_int (634)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (632)) (Prims.of_int (52)) (Prims.of_int (673)) - (Prims.of_int (18))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | (binders, body) -> - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - FStar_Tactics_Util.map - (fun b -> name_of_named_binder b) binders in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (636)) (Prims.of_int (9)) - (Prims.of_int (636)) (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (635)) (Prims.of_int (27)) - (Prims.of_int (636)) (Prims.of_int (71))))) - (Obj.magic uu___5) - (fun uu___6 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___7 -> FStar_String.concat ", " uu___6)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (635)) (Prims.of_int (27)) - (Prims.of_int (636)) (Prims.of_int (71))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "Prims.fst" - (Prims.of_int (611)) (Prims.of_int (19)) - (Prims.of_int (611)) (Prims.of_int (31))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> Prims.strcat "Got binders: " uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (635)) (Prims.of_int (8)) - (Prims.of_int (636)) (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (635)) (Prims.of_int (2)) - (Prims.of_int (636)) (Prims.of_int (72))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> Obj.magic (debug uu___4)) uu___4) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (635)) (Prims.of_int (2)) - (Prims.of_int (636)) (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (636)) (Prims.of_int (73)) - (Prims.of_int (673)) (Prims.of_int (18))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - let uu___4 = - FStar_Tactics_Util.map - (fun binder -> - let uu___5 = name_of_named_binder binder in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (640)) - (Prims.of_int (22)) - (Prims.of_int (640)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (641)) - (Prims.of_int (8)) - (Prims.of_int (644)) - (Prims.of_int (43))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun bv_name -> - let uu___6 = - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - FStarC_Tactics_V2_Builtins.term_to_string - (type_of_named_binder - binder) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (642)) - (Prims.of_int (15)) - (Prims.of_int (642)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___10) - (fun uu___11 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___12 -> - Prims.strcat - "; type is " - uu___11)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (641)) - (Prims.of_int (42)) - (Prims.of_int (642)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> - Prims.strcat - bv_name uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (641)) - (Prims.of_int (32)) - (Prims.of_int (642)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 -> - Prims.strcat - "Got binder: " - uu___9)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (641)) - (Prims.of_int (14)) - (Prims.of_int (642)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (641)) - (Prims.of_int (8)) - (Prims.of_int (642)) - (Prims.of_int (60))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - Obj.magic (debug uu___8)) - uu___8) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (641)) - (Prims.of_int (8)) - (Prims.of_int (642)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (642)) - (Prims.of_int (61)) - (Prims.of_int (644)) - (Prims.of_int (43))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun uu___7 -> - let uu___8 = - classify_abspat_binder - binder in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (643)) - (Prims.of_int (31)) - (Prims.of_int (643)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (642)) - (Prims.of_int (61)) - (Prims.of_int (644)) - (Prims.of_int (43))))) - (Obj.magic uu___8) - (fun uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___10 - -> - match uu___9 - with - | (binder_kind, - typ) -> - (binder, - bv_name, - binder_kind, - typ))))) - uu___7))) uu___6)) - binders in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (639)) - (Prims.of_int (4)) - (Prims.of_int (645)) - (Prims.of_int (13))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (645)) - (Prims.of_int (16)) - (Prims.of_int (673)) - (Prims.of_int (18))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun classified_binders -> - let uu___5 = - FStar_Tactics_Util.fold_left - (fun problem -> - fun uu___6 -> - match uu___6 with - | (binder, bv_name, - binder_kind, typ) -> - let uu___7 = - let uu___8 = - let uu___9 = - let uu___10 = - name_of_named_binder - binder in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (650)) - (Prims.of_int (38)) - (Prims.of_int (650)) - (Prims.of_int (65))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (650)) - (Prims.of_int (38)) - (Prims.of_int (652)) - (Prims.of_int (51))))) - (Obj.magic uu___10) - (fun uu___11 -> - (fun uu___11 -> - let uu___12 - = - let uu___13 - = - let uu___14 - = - let uu___15 - = - FStarC_Tactics_V2_Builtins.term_to_string - typ in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (652)) - (Prims.of_int (33)) - (Prims.of_int (652)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___17 - -> - Prims.strcat - ", with type " - uu___16)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (652)) - (Prims.of_int (16)) - (Prims.of_int (652)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___16 - -> - Prims.strcat - (string_of_abspat_binder_kind - binder_kind) - uu___15)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (651)) - (Prims.of_int (37)) - (Prims.of_int (652)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___13) - (fun - uu___14 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___15 - -> - Prims.strcat - ", classified as " - uu___14)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (651)) - (Prims.of_int (16)) - (Prims.of_int (652)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___14 - -> - Prims.strcat - uu___11 - uu___13)))) - uu___11) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (650)) - (Prims.of_int (38)) - (Prims.of_int (652)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___9) - (fun uu___10 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___11 -> - Prims.strcat - "Compiling binder " - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (650)) - (Prims.of_int (15)) - (Prims.of_int (652)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (650)) - (Prims.of_int (9)) - (Prims.of_int (652)) - (Prims.of_int (52))))) - (Obj.magic uu___8) - (fun uu___9 -> - (fun uu___9 -> - Obj.magic - (debug uu___9)) - uu___9) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (650)) - (Prims.of_int (9)) - (Prims.of_int (652)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (653)) - (Prims.of_int (9)) - (Prims.of_int (657)) - (Prims.of_int (75))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - match binder_kind - with - | ABKVar uu___9 -> - Obj.magic - (Obj.repr - ( - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - { - mp_vars = - (bv_name - :: - (problem.mp_vars)); - mp_hyps = - (problem.mp_hyps); - mp_goal = - (problem.mp_goal) - }))) - | ABKHyp -> - Obj.magic - (Obj.repr - ( - let uu___9 - = - let uu___10 - = - let uu___11 - = - pattern_of_term - typ in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (655)) - (Prims.of_int (56)) - (Prims.of_int (655)) - (Prims.of_int (77))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (655)) - (Prims.of_int (46)) - (Prims.of_int (655)) - (Prims.of_int (78))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___13 - -> - (bv_name, - uu___12))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (655)) - (Prims.of_int (46)) - (Prims.of_int (655)) - (Prims.of_int (78))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (655)) - (Prims.of_int (46)) - (Prims.of_int (656)) - (Prims.of_int (63))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - uu___11 - :: - (problem.mp_hyps))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (655)) - (Prims.of_int (46)) - (Prims.of_int (656)) - (Prims.of_int (63))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (655)) - (Prims.of_int (23)) - (Prims.of_int (656)) - (Prims.of_int (63))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - { - mp_vars = - (problem.mp_vars); - mp_hyps = - uu___10; - mp_goal = - (problem.mp_goal) - })))) - | ABKGoal -> - Obj.magic - (Obj.repr - ( - let uu___9 - = - let uu___10 - = - pattern_of_term - typ in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (657)) - (Prims.of_int (52)) - (Prims.of_int (657)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (657)) - (Prims.of_int (47)) - (Prims.of_int (657)) - (Prims.of_int (73))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___12 - -> - FStar_Pervasives_Native.Some - uu___11)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (657)) - (Prims.of_int (47)) - (Prims.of_int (657)) - (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (657)) - (Prims.of_int (24)) - (Prims.of_int (657)) - (Prims.of_int (73))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - { - mp_vars = - (problem.mp_vars); - mp_hyps = - (problem.mp_hyps); - mp_goal = - uu___10 - }))))) - uu___8)) - { - mp_vars = []; - mp_hyps = []; - mp_goal = - FStar_Pervasives_Native.None - } classified_binders in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (648)) - (Prims.of_int (4)) - (Prims.of_int (659)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (659)) - (Prims.of_int (27)) - (Prims.of_int (673)) - (Prims.of_int (18))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun problem -> - let uu___6 = - let uu___7 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___9 -> - fun uu___8 -> - (fun uu___8 -> - fun xx -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - match xx - with - | - (binder, - xx1, - binder_kind, - yy) -> - { - asa_name - = - (FStar_Tactics_NamedView.binder_to_binding - binder); - asa_kind - = - binder_kind - }))) - uu___9 - uu___8)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (663)) - (Prims.of_int (4)) - (Prims.of_int (664)) - (Prims.of_int (69))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (665)) - (Prims.of_int (4)) - (Prims.of_int (665)) - (Prims.of_int (57))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun - abspat_argspec_of_binder - -> - let uu___8 = - FStar_Tactics_Util.map - abspat_argspec_of_binder - classified_binders in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (665)) - (Prims.of_int (5)) - (Prims.of_int (665)) - (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (665)) - (Prims.of_int (4)) - (Prims.of_int (665)) - (Prims.of_int (57))))) - (Obj.magic - uu___8) - (fun uu___9 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (uu___9, - tm))))) - uu___8) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (661)) - (Prims.of_int (20)) - (Prims.of_int (665)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (665)) - (Prims.of_int (60)) - (Prims.of_int (673)) - (Prims.of_int (18))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun continuation -> - let uu___7 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun - uu___8 -> - { - mp_vars = - (FStar_List_Tot_Base.rev - problem.mp_vars); - mp_hyps = - (FStar_List_Tot_Base.rev - problem.mp_hyps); - mp_goal = - (problem.mp_goal) - })) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (668)) - (Prims.of_int (6)) - (Prims.of_int (670)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - ( - Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (672)) - (Prims.of_int (2)) - (Prims.of_int (673)) - (Prims.of_int (18))))) - (Obj.magic - uu___7) - (fun uu___8 - -> - (fun mp - -> - let uu___8 - = - debug - (Prims.strcat - "Got matching problem: " - (string_of_matching_problem - mp)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (672)) - (Prims.of_int (2)) - (Prims.of_int (672)) - (Prims.of_int (68))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (673)) - (Prims.of_int (2)) - (Prims.of_int (673)) - (Prims.of_int (18))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___10 - -> - (mp, - continuation))))) - uu___8))) - uu___7))) uu___6))) - uu___5))) uu___3))) uu___1) -let (arg_type_of_binder_kind : - abspat_binder_kind -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - (fun binder_kind -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - match binder_kind with - | ABKVar typ -> typ - | ABKHyp -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "NamedView"; "binder"])) - | ABKGoal -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["Prims"; "unit"]))))) uu___ -let (locate_fn_of_binder_kind : - abspat_binder_kind -> FStarC_Reflection_Types.term) = - fun binder_kind -> - match binder_kind with - | ABKVar uu___ -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "PatternMatching"; "ms_locate_var"])) - | ABKHyp -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "PatternMatching"; "ms_locate_hyp"])) - | ABKGoal -> - FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "PatternMatching"; "ms_locate_unit"])) -let (abspat_arg_of_abspat_argspec : - FStarC_Reflection_Types.term -> - abspat_argspec -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun solution_term -> - fun argspec -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> locate_fn_of_binder_kind argspec.asa_kind)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (700)) (Prims.of_int (15)) - (Prims.of_int (700)) (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (700)) (Prims.of_int (59)) - (Prims.of_int (704)) (Prims.of_int (27))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun loc_fn -> - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - FStarC_Tactics_Unseal.unseal - (argspec.asa_name).FStarC_Reflection_V2_Data.ppname3 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (701)) (Prims.of_int (41)) - (Prims.of_int (701)) (Prims.of_int (73))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (701)) (Prims.of_int (31)) - (Prims.of_int (701)) (Prims.of_int (74))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - FStarC_Reflection_V2_Data.C_String uu___5)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (701)) (Prims.of_int (31)) - (Prims.of_int (701)) (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (701)) (Prims.of_int (21)) - (Prims.of_int (701)) (Prims.of_int (75))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_Tactics_NamedView.Tv_Const uu___4)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (701)) (Prims.of_int (21)) - (Prims.of_int (701)) (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "dummy" Prims.int_zero - Prims.int_zero Prims.int_zero Prims.int_zero))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> FStar_Tactics_NamedView.pack uu___3)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (701)) (Prims.of_int (16)) - (Prims.of_int (701)) (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (701)) (Prims.of_int (78)) - (Prims.of_int (704)) (Prims.of_int (27))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun name_tm -> - let uu___2 = - let uu___3 = - let uu___4 = - arg_type_of_binder_kind argspec.asa_kind in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (702)) - (Prims.of_int (22)) - (Prims.of_int (702)) - (Prims.of_int (62))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (702)) - (Prims.of_int (21)) - (Prims.of_int (702)) - (Prims.of_int (75))))) - (Obj.magic uu___4) - (fun uu___5 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> - (uu___5, - FStarC_Reflection_V2_Data.Q_Explicit))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (702)) - (Prims.of_int (21)) - (Prims.of_int (702)) - (Prims.of_int (75))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (702)) - (Prims.of_int (20)) - (Prims.of_int (703)) - (Prims.of_int (72))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - [uu___4; - (solution_term, - FStarC_Reflection_V2_Data.Q_Explicit); - (name_tm, - FStarC_Reflection_V2_Data.Q_Explicit)])) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (702)) - (Prims.of_int (20)) - (Prims.of_int (703)) - (Prims.of_int (72))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (704)) - (Prims.of_int (2)) - (Prims.of_int (704)) - (Prims.of_int (27))))) - (Obj.magic uu___2) - (fun locate_args -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___3 -> - FStar_Reflection_V2_Derived.mk_app - loc_fn locate_args)))) uu___2))) - uu___1) -let rec (hoist_and_apply : - FStar_Tactics_NamedView.term -> - FStar_Tactics_NamedView.term Prims.list -> - FStarC_Reflection_V2_Data.argv Prims.list -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___2 -> - fun uu___1 -> - fun uu___ -> - (fun head -> - fun arg_terms -> - fun hoisted_args -> - match arg_terms with - | [] -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___ -> - FStar_Reflection_V2_Derived.mk_app head - (FStar_List_Tot_Base.rev hoisted_args)))) - | arg_term::rest -> - Obj.magic - (Obj.repr - (let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - FStar_List_Tot_Base.length hoisted_args)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (715)) (Prims.of_int (12)) - (Prims.of_int (715)) (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (715)) (Prims.of_int (43)) - (Prims.of_int (725)) (Prims.of_int (132))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun n -> - let uu___1 = - let uu___2 = - FStarC_Tactics_V2_Builtins.fresh () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (720)) - (Prims.of_int (13)) - (Prims.of_int (720)) - (Prims.of_int (21))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (718)) - (Prims.of_int (6)) - (Prims.of_int (722)) - (Prims.of_int (18))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - { - FStar_Tactics_NamedView.uniq = - uu___3; - FStar_Tactics_NamedView.ppname - = - (FStar_Sealed.seal - (Prims.strcat "x" - (Prims.string_of_int n))); - FStar_Tactics_NamedView.sort = - (FStarC_Reflection_V2_Builtins.pack_ln - FStarC_Reflection_V2_Data.Tv_Unknown); - FStar_Tactics_NamedView.qual = - FStarC_Reflection_V2_Data.Q_Explicit; - FStar_Tactics_NamedView.attrs - = [] - })) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (718)) - (Prims.of_int (6)) - (Prims.of_int (722)) - (Prims.of_int (18))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (725)) - (Prims.of_int (4)) - (Prims.of_int (725)) - (Prims.of_int (132))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun nb -> - let uu___2 = - let uu___3 = - hoist_and_apply head rest - (((FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Var - (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv - nb))), - FStarC_Reflection_V2_Data.Q_Explicit) - :: hoisted_args) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (725)) - (Prims.of_int (38)) - (Prims.of_int (725)) - (Prims.of_int (131))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (725)) - (Prims.of_int (9)) - (Prims.of_int (725)) - (Prims.of_int (132))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStar_Tactics_NamedView.Tv_Let - (false, [], nb, - arg_term, uu___4))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (725)) - (Prims.of_int (9)) - (Prims.of_int (725)) - (Prims.of_int (132))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "dummy" - Prims.int_zero - Prims.int_zero - Prims.int_zero - Prims.int_zero))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Tactics_NamedView.pack - uu___3)))) uu___2))) - uu___1)))) uu___2 uu___1 uu___ -let (specialize_abspat_continuation' : - abspat_continuation -> - FStar_Tactics_NamedView.term -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun continuation -> - fun solution_term -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun argspec -> - abspat_arg_of_abspat_argspec solution_term argspec)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (731)) (Prims.of_int (4)) (Prims.of_int (731)) - (Prims.of_int (54))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (731)) (Prims.of_int (57)) - (Prims.of_int (733)) (Prims.of_int (52))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun mk_arg_term -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> continuation)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (732)) (Prims.of_int (23)) - (Prims.of_int (732)) (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (731)) (Prims.of_int (57)) - (Prims.of_int (733)) (Prims.of_int (52))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - match uu___2 with - | (argspecs, body) -> - let uu___3 = - FStar_Tactics_Util.map mk_arg_term argspecs in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (733)) - (Prims.of_int (23)) - (Prims.of_int (733)) - (Prims.of_int (49))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (733)) - (Prims.of_int (2)) - (Prims.of_int (733)) - (Prims.of_int (52))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (hoist_and_apply body uu___4 [])) - uu___4))) uu___2))) uu___1) -let (specialize_abspat_continuation : - abspat_continuation -> - (FStar_Tactics_NamedView.term, unit) FStar_Tactics_Effect.tac_repr) - = - fun continuation -> - let uu___ = - FStar_Tactics_V2_Derived.fresh_binder - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "PatternMatching"; "matching_solution"]))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (740)) (Prims.of_int (24)) (Prims.of_int (740)) - (Prims.of_int (57))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (740)) (Prims.of_int (60)) (Prims.of_int (747)) - (Prims.of_int (9))))) (Obj.magic uu___) - (fun uu___1 -> - (fun solution_binder -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Var - (FStar_Tactics_V2_SyntaxCoercions.binder_to_namedv - solution_binder)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (741)) (Prims.of_int (22)) - (Prims.of_int (741)) (Prims.of_int (70))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (741)) (Prims.of_int (73)) - (Prims.of_int (747)) (Prims.of_int (9))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun solution_term -> - let uu___2 = - specialize_abspat_continuation' continuation - solution_term in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (742)) (Prims.of_int (16)) - (Prims.of_int (742)) (Prims.of_int (74))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (742)) (Prims.of_int (77)) - (Prims.of_int (747)) (Prims.of_int (9))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun applied -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStar_Tactics_NamedView.pack - (FStar_Tactics_NamedView.Tv_Abs - (solution_binder, applied)))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (743)) - (Prims.of_int (16)) - (Prims.of_int (743)) - (Prims.of_int (53))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (744)) - (Prims.of_int (2)) - (Prims.of_int (747)) - (Prims.of_int (9))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun thunked -> - let uu___4 = - let uu___5 = - let uu___6 = - FStarC_Tactics_V2_Builtins.term_to_string - thunked in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (744)) - (Prims.of_int (31)) - (Prims.of_int (744)) - (Prims.of_int (55))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic uu___6) - (fun uu___7 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - Prims.strcat - "Specialized into " - uu___7)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (744)) - (Prims.of_int (8)) - (Prims.of_int (744)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (744)) - (Prims.of_int (2)) - (Prims.of_int (744)) - (Prims.of_int (56))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - Obj.magic - (debug uu___6)) - uu___6) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (744)) - (Prims.of_int (2)) - (Prims.of_int (744)) - (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (744)) - (Prims.of_int (57)) - (Prims.of_int (747)) - (Prims.of_int (9))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - let uu___6 = - beta_reduce thunked in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (745)) - (Prims.of_int (19)) - (Prims.of_int (745)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (746)) - (Prims.of_int (2)) - (Prims.of_int (747)) - (Prims.of_int (9))))) - (Obj.magic - uu___6) - (fun uu___7 -> - (fun - normalized - -> - let uu___7 - = - let uu___8 - = - let uu___9 - = - FStarC_Tactics_V2_Builtins.term_to_string - normalized in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (746)) - (Prims.of_int (33)) - (Prims.of_int (746)) - (Prims.of_int (60))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "Prims.fst" - (Prims.of_int (611)) - (Prims.of_int (19)) - (Prims.of_int (611)) - (Prims.of_int (31))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___11 - -> - Prims.strcat - "\226\128\166 which reduces to " - uu___10)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (746)) - (Prims.of_int (8)) - (Prims.of_int (746)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (746)) - (Prims.of_int (2)) - (Prims.of_int (746)) - (Prims.of_int (61))))) - (Obj.magic - uu___8) - (fun - uu___9 -> - (fun - uu___9 -> - Obj.magic - (debug - uu___9)) - uu___9) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (746)) - (Prims.of_int (2)) - (Prims.of_int (746)) - (Prims.of_int (61))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (743)) - (Prims.of_int (6)) - (Prims.of_int (743)) - (Prims.of_int (13))))) - (Obj.magic - uu___7) - (fun - uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun - uu___9 -> - thunked)))) - uu___7))) - uu___5))) uu___4))) - uu___3))) uu___2))) uu___1) -let interp_abspat_continuation : - 'a . - abspat_continuation -> - (matching_solution -> ('a, unit) FStar_Tactics_Effect.tac_repr, - unit) FStar_Tactics_Effect.tac_repr - = - fun continuation -> - let uu___ = specialize_abspat_continuation continuation in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (754)) (Prims.of_int (16)) (Prims.of_int (754)) - (Prims.of_int (59))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (755)) (Prims.of_int (2)) (Prims.of_int (755)) - (Prims.of_int (47))))) (Obj.magic uu___) - (fun uu___1 -> - (fun applied -> - Obj.magic (FStarC_Tactics_V2_Builtins.unquote applied)) uu___1) -let interp_abspat : - 'a . - 'a -> - ((matching_problem * abspat_continuation), unit) - FStar_Tactics_Effect.tac_repr - = - fun abspat -> - let uu___ = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - (fun uu___1 -> - Obj.magic - (failwith "Cannot evaluate open quotation at runtime")) - uu___1)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (765)) (Prims.of_int (26)) (Prims.of_int (765)) - (Prims.of_int (40))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (765)) (Prims.of_int (2)) (Prims.of_int (765)) - (Prims.of_int (40))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> Obj.magic (matching_problem_of_abs uu___1)) uu___1) -let match_abspat : - 'b 'a . - 'a -> - (abspat_continuation -> - (matching_solution -> ('b, unit) FStar_Tactics_Effect.tac_repr, - unit) FStar_Tactics_Effect.tac_repr) - -> ('b, unit) FStar_Tactics_Effect.tac_repr - = - fun abspat -> - fun k -> - let uu___ = FStar_Tactics_V2_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (773)) (Prims.of_int (13)) - (Prims.of_int (773)) (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (773)) (Prims.of_int (27)) - (Prims.of_int (776)) (Prims.of_int (51))))) - (Obj.magic uu___) - (fun uu___1 -> - (fun goal -> - let uu___1 = - let uu___2 = FStar_Tactics_V2_Derived.cur_env () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (774)) (Prims.of_int (31)) - (Prims.of_int (774)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (774)) (Prims.of_int (19)) - (Prims.of_int (774)) (Prims.of_int (43))))) - (Obj.magic uu___2) - (fun uu___3 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - FStarC_Reflection_V2_Builtins.vars_of_env uu___3)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (774)) (Prims.of_int (19)) - (Prims.of_int (774)) (Prims.of_int (43))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (774)) (Prims.of_int (46)) - (Prims.of_int (776)) (Prims.of_int (51))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun hypotheses -> - let uu___2 = interp_abspat abspat in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (775)) - (Prims.of_int (30)) - (Prims.of_int (775)) - (Prims.of_int (50))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (774)) - (Prims.of_int (46)) - (Prims.of_int (776)) - (Prims.of_int (51))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | (problem, continuation) -> - let uu___4 = k continuation in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (776)) - (Prims.of_int (35)) - (Prims.of_int (776)) - (Prims.of_int (51))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (776)) - (Prims.of_int (2)) - (Prims.of_int (776)) - (Prims.of_int (51))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun uu___5 -> - Obj.magic - (solve_mp problem - hypotheses goal - uu___5)) uu___5))) - uu___3))) uu___2))) uu___1) -let inspect_abspat_problem : - 'a . 'a -> (matching_problem, unit) FStar_Tactics_Effect.tac_repr = - fun abspat -> - let uu___ = interp_abspat abspat in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (780)) (Prims.of_int (6)) (Prims.of_int (780)) - (Prims.of_int (31))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (780)) (Prims.of_int (2)) (Prims.of_int (780)) - (Prims.of_int (31))))) (Obj.magic uu___) - (fun uu___1 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> FStar_Pervasives_Native.fst uu___1)) -let inspect_abspat_solution : - 'a . 'a -> (matching_solution, unit) FStar_Tactics_Effect.tac_repr = - fun abspat -> - match_abspat abspat - (fun uu___ -> - (fun uu___ -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - fun uu___1 -> - (fun uu___1 -> - fun solution -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> solution))) uu___2 uu___1))) - uu___) -let tpair : - 'a 'b . - 'a -> - ('b -> (('a * 'b), unit) FStar_Tactics_Effect.tac_repr, unit) - FStar_Tactics_Effect.tac_repr - = - fun uu___ -> - (fun x -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> - fun uu___ -> - (fun uu___ -> - fun y -> - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___1 -> (x, y)))) uu___1 uu___))) uu___ -let gpm : 'b 'a . 'a -> unit -> ('b, unit) FStar_Tactics_Effect.tac_repr = - fun abspat -> - fun uu___ -> - let uu___1 = match_abspat abspat tpair in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (804)) (Prims.of_int (31)) - (Prims.of_int (804)) (Prims.of_int (56))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (803)) (Prims.of_int (38)) - (Prims.of_int (805)) (Prims.of_int (52))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - match uu___2 with - | (continuation, solution) -> - let uu___3 = interp_abspat_continuation continuation in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (805)) (Prims.of_int (2)) - (Prims.of_int (805)) (Prims.of_int (52))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (805)) (Prims.of_int (2)) - (Prims.of_int (805)) (Prims.of_int (52))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> Obj.magic (uu___4 solution)) uu___4))) - uu___2) -let pm : 'b 'a . 'a -> ('b, unit) FStar_Tactics_Effect.tac_repr = - fun abspat -> match_abspat abspat interp_abspat_continuation -let fetch_eq_side' : - 'a . unit -> (FStar_Tactics_NamedView.term * FStar_Tactics_NamedView.term) - = - fun uu___ -> - (fun uu___ -> - Obj.magic - (gpm - (fun left -> - fun right -> - fun g -> - let uu___1 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___2 -> - (fun uu___2 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___2)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (828)) (Prims.of_int (10)) - (Prims.of_int (828)) (Prims.of_int (20))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (828)) (Prims.of_int (9)) - (Prims.of_int (828)) (Prims.of_int (34))))) - (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___4 -> - (fun uu___4 -> - Obj.magic - (failwith - "Cannot evaluate open quotation at runtime")) - uu___4)) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (828)) - (Prims.of_int (22)) - (Prims.of_int (828)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.PatternMatching.fst" - (Prims.of_int (828)) - (Prims.of_int (9)) - (Prims.of_int (828)) - (Prims.of_int (34))))) - (Obj.magic uu___3) - (fun uu___4 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> (uu___2, uu___4))))) - uu___2)) ())) uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_Simplifier.ml b/stage0/fstar-lib/generated/FStar_Tactics_Simplifier.ml deleted file mode 100644 index 149014091ab..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_Simplifier.ml +++ /dev/null @@ -1,1956 +0,0 @@ -open Prims -let (tiff : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "Simplifier"; "lem_iff_refl"]))) -let (step : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "Simplifier"; "lem_iff_trans"]))) -let (is_true : - FStar_Tactics_NamedView.term -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = FStar_Reflection_V2_Formula.term_as_formula' t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (159)) (Prims.of_int (16)) (Prims.of_int (159)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (159)) (Prims.of_int (10)) (Prims.of_int (172)) - (Prims.of_int (14))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Reflection_V2_Formula.True_ -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> true))) - | uu___2 -> - Obj.magic - (Obj.repr - (let uu___3 = FStar_Tactics_NamedView.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (161)) (Prims.of_int (23)) - (Prims.of_int (161)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (161)) (Prims.of_int (17)) - (Prims.of_int (171)) (Prims.of_int (23))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | FStar_Tactics_NamedView.Tv_App (l, r) -> - Obj.magic - (Obj.repr - (let uu___5 = - FStar_Tactics_NamedView.inspect l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (163)) - (Prims.of_int (24)) - (Prims.of_int (163)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (163)) - (Prims.of_int (18)) - (Prims.of_int (169)) - (Prims.of_int (24))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 with - | FStar_Tactics_NamedView.Tv_Abs - (b, t1) -> - Obj.magic - (Obj.repr - (let uu___7 = - FStar_Reflection_V2_Formula.term_as_formula' - t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (165)) - (Prims.of_int (28)) - (Prims.of_int (165)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (165)) - (Prims.of_int (22)) - (Prims.of_int (167)) - (Prims.of_int (28))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 - -> - match uu___8 - with - | - FStar_Reflection_V2_Formula.True_ - -> true - | - uu___10 - -> false)))) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - false)))) - uu___6))) - | uu___5 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> false)))) uu___4)))) - uu___1) -let (is_false : - FStar_Tactics_NamedView.term -> - (Prims.bool, unit) FStar_Tactics_Effect.tac_repr) - = - fun t -> - let uu___ = FStar_Reflection_V2_Formula.term_as_formula' t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (177)) (Prims.of_int (16)) (Prims.of_int (177)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (177)) (Prims.of_int (10)) (Prims.of_int (190)) - (Prims.of_int (14))))) (Obj.magic uu___) - (fun uu___1 -> - (fun uu___1 -> - match uu___1 with - | FStar_Reflection_V2_Formula.False_ -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac (fun uu___2 -> true))) - | uu___2 -> - Obj.magic - (Obj.repr - (let uu___3 = FStar_Tactics_NamedView.inspect t in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (179)) (Prims.of_int (23)) - (Prims.of_int (179)) (Prims.of_int (32))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (179)) (Prims.of_int (17)) - (Prims.of_int (189)) (Prims.of_int (23))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - match uu___4 with - | FStar_Tactics_NamedView.Tv_App (l, r) -> - Obj.magic - (Obj.repr - (let uu___5 = - FStar_Tactics_NamedView.inspect l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (181)) - (Prims.of_int (24)) - (Prims.of_int (181)) - (Prims.of_int (33))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (181)) - (Prims.of_int (18)) - (Prims.of_int (187)) - (Prims.of_int (24))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun uu___6 -> - match uu___6 with - | FStar_Tactics_NamedView.Tv_Abs - (b, t1) -> - Obj.magic - (Obj.repr - (let uu___7 = - FStar_Reflection_V2_Formula.term_as_formula' - t1 in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (183)) - (Prims.of_int (28)) - (Prims.of_int (183)) - (Prims.of_int (46))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (183)) - (Prims.of_int (22)) - (Prims.of_int (185)) - (Prims.of_int (28))))) - (Obj.magic uu___7) - (fun uu___8 -> - FStar_Tactics_Effect.lift_div_tac - (fun uu___9 - -> - match uu___8 - with - | - FStar_Reflection_V2_Formula.False_ - -> true - | - uu___10 - -> false)))) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___8 -> - false)))) - uu___6))) - | uu___5 -> - Obj.magic - (Obj.repr - (FStar_Tactics_Effect.lift_div_tac - (fun uu___6 -> false)))) uu___4)))) - uu___1) -let (inhabit : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = FStar_Tactics_V2_Derived.cur_goal () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (195)) (Prims.of_int (12)) (Prims.of_int (195)) - (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (196)) (Prims.of_int (4)) (Prims.of_int (203)) - (Prims.of_int (18))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun t -> - let uu___2 = FStar_Tactics_NamedView.inspect t in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (196)) (Prims.of_int (10)) - (Prims.of_int (196)) (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (196)) (Prims.of_int (4)) - (Prims.of_int (203)) (Prims.of_int (18))))) - (Obj.magic uu___2) - (fun uu___3 -> - (fun uu___3 -> - match uu___3 with - | FStar_Tactics_NamedView.Tv_FVar fv -> - Obj.magic - (Obj.repr - (let uu___4 = - Obj.magic - (FStar_Tactics_Effect.lift_div_tac - (fun uu___5 -> - FStarC_Reflection_V2_Builtins.inspect_fv - fv)) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (198)) - (Prims.of_int (17)) - (Prims.of_int (198)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (199)) - (Prims.of_int (13)) - (Prims.of_int (202)) - (Prims.of_int (20))))) - (Obj.magic uu___4) - (fun uu___5 -> - (fun qn -> - if - qn = - FStar_Reflection_Const.int_lid - then - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.exact - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - (FStarC_Reflection_V2_Data.C_Int - (Prims.of_int (42))))))) - else - Obj.magic - (Obj.repr - (if - qn = - FStar_Reflection_Const.bool_lid - then - Obj.repr - (FStar_Tactics_V2_Derived.exact - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - FStarC_Reflection_V2_Data.C_True))) - else - Obj.repr - (if - qn = - FStar_Reflection_Const.unit_lid - then - Obj.repr - (FStar_Tactics_V2_Derived.exact - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_Const - FStarC_Reflection_V2_Data.C_Unit))) - else - Obj.repr - (FStar_Tactics_V2_Derived.fail - ""))))) uu___5))) - | uu___4 -> - Obj.magic - (Obj.repr (FStar_Tactics_V2_Derived.fail ""))) - uu___3))) uu___2) -let rec (simplify_point : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) - = - fun uu___ -> - let uu___1 = recurse () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (209)) (Prims.of_int (4)) (Prims.of_int (209)) - (Prims.of_int (14))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (210)) (Prims.of_int (4)) (Prims.of_int (264)) - (Prims.of_int (81))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = FStarC_Tactics_V2_Builtins.norm [] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (210)) (Prims.of_int (4)) - (Prims.of_int (210)) (Prims.of_int (11))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (210)) (Prims.of_int (12)) - (Prims.of_int (264)) (Prims.of_int (81))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = FStar_Tactics_V2_Derived.cur_goal () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (211)) (Prims.of_int (12)) - (Prims.of_int (211)) (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (211)) (Prims.of_int (26)) - (Prims.of_int (264)) (Prims.of_int (81))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun g -> - let uu___6 = - FStar_Reflection_V2_Formula.term_as_formula - g in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (212)) - (Prims.of_int (12)) - (Prims.of_int (212)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (213)) - (Prims.of_int (4)) - (Prims.of_int (264)) - (Prims.of_int (81))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun f -> - match f with - | FStar_Reflection_V2_Formula.Iff - (l, r) -> - Obj.magic - (Obj.repr - (let uu___7 = - FStar_Reflection_V2_Formula.term_as_formula' - l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (215)) - (Prims.of_int (20)) - (Prims.of_int (215)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (215)) - (Prims.of_int (14)) - (Prims.of_int (262)) - (Prims.of_int (22))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - match uu___8 - with - | FStar_Reflection_V2_Formula.And - (p, q) -> - let uu___9 - = - is_true p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (217)) - (Prims.of_int (20)) - (Prims.of_int (217)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (217)) - (Prims.of_int (17)) - (Prims.of_int (221)) - (Prims.of_int (24))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - if - uu___10 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_true_and_p"])))) - else - (let uu___12 - = - is_true q in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (218)) - (Prims.of_int (20)) - (Prims.of_int (218)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (218)) - (Prims.of_int (17)) - (Prims.of_int (221)) - (Prims.of_int (24))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - if - uu___13 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_p_and_true"])))) - else - (let uu___15 - = - is_false - p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (219)) - (Prims.of_int (20)) - (Prims.of_int (219)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (219)) - (Prims.of_int (17)) - (Prims.of_int (221)) - (Prims.of_int (24))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - if - uu___16 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_false_and_p"])))) - else - (let uu___18 - = - is_false - q in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (220)) - (Prims.of_int (20)) - (Prims.of_int (220)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (220)) - (Prims.of_int (17)) - (Prims.of_int (221)) - (Prims.of_int (24))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - uu___19 - -> - if - uu___19 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_p_and_false"])))) - else - Obj.magic - (tiff ())) - uu___19)))) - uu___16)))) - uu___13)))) - uu___10)) - | FStar_Reflection_V2_Formula.Or - (p, q) -> - let uu___9 - = - is_true p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (224)) - (Prims.of_int (20)) - (Prims.of_int (224)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (224)) - (Prims.of_int (17)) - (Prims.of_int (228)) - (Prims.of_int (24))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - if - uu___10 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_true_or_p"])))) - else - (let uu___12 - = - is_true q in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (225)) - (Prims.of_int (20)) - (Prims.of_int (225)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (225)) - (Prims.of_int (17)) - (Prims.of_int (228)) - (Prims.of_int (24))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - if - uu___13 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_p_or_true"])))) - else - (let uu___15 - = - is_false - p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (226)) - (Prims.of_int (20)) - (Prims.of_int (226)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (226)) - (Prims.of_int (17)) - (Prims.of_int (228)) - (Prims.of_int (24))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - if - uu___16 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_false_or_p"])))) - else - (let uu___18 - = - is_false - q in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (227)) - (Prims.of_int (20)) - (Prims.of_int (227)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (227)) - (Prims.of_int (17)) - (Prims.of_int (228)) - (Prims.of_int (24))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - uu___19 - -> - if - uu___19 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_p_or_false"])))) - else - Obj.magic - (tiff ())) - uu___19)))) - uu___16)))) - uu___13)))) - uu___10)) - | FStar_Reflection_V2_Formula.Implies - (p, q) -> - let uu___9 - = - is_true p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (231)) - (Prims.of_int (20)) - (Prims.of_int (231)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (231)) - (Prims.of_int (17)) - (Prims.of_int (234)) - (Prims.of_int (24))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - if - uu___10 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_true_imp_p"])))) - else - (let uu___12 - = - is_true q in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (232)) - (Prims.of_int (20)) - (Prims.of_int (232)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (232)) - (Prims.of_int (17)) - (Prims.of_int (234)) - (Prims.of_int (24))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - if - uu___13 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_p_imp_true"])))) - else - (let uu___15 - = - is_false - p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (233)) - (Prims.of_int (20)) - (Prims.of_int (233)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (233)) - (Prims.of_int (17)) - (Prims.of_int (234)) - (Prims.of_int (24))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - if - uu___16 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_false_imp_p"])))) - else - Obj.magic - (tiff ())) - uu___16)))) - uu___13)))) - uu___10)) - | FStar_Reflection_V2_Formula.Forall - (_b, - _sort, p) - -> - let uu___9 - = - is_true p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (237)) - (Prims.of_int (20)) - (Prims.of_int (237)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (237)) - (Prims.of_int (17)) - (Prims.of_int (239)) - (Prims.of_int (24))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - if - uu___10 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_fa_true"])))) - else - (let uu___12 - = - is_false - p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (238)) - (Prims.of_int (20)) - (Prims.of_int (238)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (238)) - (Prims.of_int (17)) - (Prims.of_int (239)) - (Prims.of_int (24))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - if - uu___13 - then - Obj.magic - (FStar_Tactics_V2_Derived.or_else - (fun - uu___14 - -> - let uu___15 - = - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_fa_false"]))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (238)) - (Prims.of_int (55)) - (Prims.of_int (238)) - (Prims.of_int (82))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (238)) - (Prims.of_int (84)) - (Prims.of_int (238)) - (Prims.of_int (94))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - Obj.magic - (inhabit - ())) - uu___16)) - tiff) - else - Obj.magic - (tiff ())) - uu___13)))) - uu___10)) - | FStar_Reflection_V2_Formula.Exists - (_b, - _sort, p) - -> - let uu___9 - = - is_false - p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (242)) - (Prims.of_int (20)) - (Prims.of_int (242)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (242)) - (Prims.of_int (17)) - (Prims.of_int (244)) - (Prims.of_int (24))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - if - uu___10 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_ex_false"])))) - else - (let uu___12 - = - is_true p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (243)) - (Prims.of_int (20)) - (Prims.of_int (243)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (243)) - (Prims.of_int (17)) - (Prims.of_int (244)) - (Prims.of_int (24))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - if - uu___13 - then - Obj.magic - (FStar_Tactics_V2_Derived.or_else - (fun - uu___14 - -> - let uu___15 - = - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_ex_true"]))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (243)) - (Prims.of_int (55)) - (Prims.of_int (243)) - (Prims.of_int (81))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (243)) - (Prims.of_int (83)) - (Prims.of_int (243)) - (Prims.of_int (93))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - Obj.magic - (inhabit - ())) - uu___16)) - tiff) - else - Obj.magic - (tiff ())) - uu___13)))) - uu___10)) - | FStar_Reflection_V2_Formula.Not - p -> - let uu___9 - = - is_true p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (247)) - (Prims.of_int (20)) - (Prims.of_int (247)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (247)) - (Prims.of_int (17)) - (Prims.of_int (249)) - (Prims.of_int (24))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - if - uu___10 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_neg_true"])))) - else - (let uu___12 - = - is_false - p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (248)) - (Prims.of_int (20)) - (Prims.of_int (248)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (248)) - (Prims.of_int (17)) - (Prims.of_int (249)) - (Prims.of_int (24))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - if - uu___13 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_neg_false"])))) - else - Obj.magic - (tiff ())) - uu___13)))) - uu___10)) - | FStar_Reflection_V2_Formula.Iff - (p, q) -> - let uu___9 - = - step () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (254)) - (Prims.of_int (12)) - (Prims.of_int (254)) - (Prims.of_int (19))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (255)) - (Prims.of_int (17)) - (Prims.of_int (260)) - (Prims.of_int (29))))) - (Obj.magic - uu___9) - (fun - uu___10 - -> - (fun - uu___10 - -> - let uu___11 - = - let uu___12 - = - is_true p in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (255)) - (Prims.of_int (20)) - (Prims.of_int (255)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (255)) - (Prims.of_int (17)) - (Prims.of_int (259)) - (Prims.of_int (24))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - if - uu___13 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_true_iff_p"])))) - else - (let uu___15 - = - is_true q in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (256)) - (Prims.of_int (20)) - (Prims.of_int (256)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (256)) - (Prims.of_int (17)) - (Prims.of_int (259)) - (Prims.of_int (24))))) - (Obj.magic - uu___15) - (fun - uu___16 - -> - (fun - uu___16 - -> - if - uu___16 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_p_iff_true"])))) - else - (let uu___18 - = - is_false - p in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (257)) - (Prims.of_int (20)) - (Prims.of_int (257)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (257)) - (Prims.of_int (17)) - (Prims.of_int (259)) - (Prims.of_int (24))))) - (Obj.magic - uu___18) - (fun - uu___19 - -> - (fun - uu___19 - -> - if - uu___19 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_false_iff_p"])))) - else - (let uu___21 - = - is_false - q in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (258)) - (Prims.of_int (20)) - (Prims.of_int (258)) - (Prims.of_int (30))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (258)) - (Prims.of_int (17)) - (Prims.of_int (259)) - (Prims.of_int (24))))) - (Obj.magic - uu___21) - (fun - uu___22 - -> - (fun - uu___22 - -> - if - uu___22 - then - Obj.magic - (FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "lem_p_iff_false"])))) - else - Obj.magic - (tiff ())) - uu___22)))) - uu___19)))) - uu___16)))) - uu___13) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (255)) - (Prims.of_int (17)) - (Prims.of_int (259)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (260)) - (Prims.of_int (12)) - (Prims.of_int (260)) - (Prims.of_int (29))))) - (Obj.magic - uu___11) - (fun - uu___12 - -> - (fun - uu___12 - -> - Obj.magic - (simplify_point - ())) - uu___12))) - uu___10)) - | uu___9 -> - Obj.magic - (tiff ())) - uu___8))) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "simplify_point: failed precondition: goal should be `g <==> ?u`"))) - uu___7))) uu___6))) uu___4))) - uu___2) -and (recurse : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = step () in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (267)) (Prims.of_int (4)) (Prims.of_int (267)) - (Prims.of_int (11))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (268)) (Prims.of_int (4)) (Prims.of_int (302)) - (Prims.of_int (74))))) (Obj.magic uu___1) - (fun uu___2 -> - (fun uu___2 -> - let uu___3 = FStarC_Tactics_V2_Builtins.norm [] in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (268)) (Prims.of_int (4)) - (Prims.of_int (268)) (Prims.of_int (11))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (268)) (Prims.of_int (12)) - (Prims.of_int (302)) (Prims.of_int (74))))) - (Obj.magic uu___3) - (fun uu___4 -> - (fun uu___4 -> - let uu___5 = FStar_Tactics_V2_Derived.cur_goal () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (269)) (Prims.of_int (12)) - (Prims.of_int (269)) (Prims.of_int (23))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (269)) (Prims.of_int (26)) - (Prims.of_int (302)) (Prims.of_int (74))))) - (Obj.magic uu___5) - (fun uu___6 -> - (fun g -> - let uu___6 = - FStar_Reflection_V2_Formula.term_as_formula - g in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (270)) - (Prims.of_int (12)) - (Prims.of_int (270)) - (Prims.of_int (29))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (271)) - (Prims.of_int (4)) - (Prims.of_int (302)) - (Prims.of_int (74))))) - (Obj.magic uu___6) - (fun uu___7 -> - (fun f -> - match f with - | FStar_Reflection_V2_Formula.Iff - (l, r) -> - Obj.magic - (Obj.repr - (let uu___7 = - FStar_Reflection_V2_Formula.term_as_formula' - l in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (273)) - (Prims.of_int (20)) - (Prims.of_int (273)) - (Prims.of_int (38))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (273)) - (Prims.of_int (14)) - (Prims.of_int (300)) - (Prims.of_int (22))))) - (Obj.magic uu___7) - (fun uu___8 -> - (fun uu___8 -> - match uu___8 - with - | FStar_Reflection_V2_Formula.And - (uu___9, - uu___10) - -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - (fun - uu___11 - -> - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "and_cong"])))) - simplify_point) - | FStar_Reflection_V2_Formula.Or - (uu___9, - uu___10) - -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - (fun - uu___11 - -> - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "or_cong"])))) - simplify_point) - | FStar_Reflection_V2_Formula.Implies - (uu___9, - uu___10) - -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - (fun - uu___11 - -> - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "imp_cong"])))) - simplify_point) - | FStar_Reflection_V2_Formula.Forall - (uu___9, - uu___10, - uu___11) - -> - let uu___12 - = - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "fa_cong"]))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (284)) - (Prims.of_int (12)) - (Prims.of_int (284)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (284)) - (Prims.of_int (35)) - (Prims.of_int (286)) - (Prims.of_int (29))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - let uu___14 - = - FStarC_Tactics_V2_Builtins.intro - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (285)) - (Prims.of_int (20)) - (Prims.of_int (285)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (286)) - (Prims.of_int (12)) - (Prims.of_int (286)) - (Prims.of_int (29))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (simplify_point - ())) - uu___15))) - uu___13)) - | FStar_Reflection_V2_Formula.Exists - (uu___9, - uu___10, - uu___11) - -> - let uu___12 - = - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "ex_cong"]))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (289)) - (Prims.of_int (12)) - (Prims.of_int (289)) - (Prims.of_int (34))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (289)) - (Prims.of_int (35)) - (Prims.of_int (291)) - (Prims.of_int (29))))) - (Obj.magic - uu___12) - (fun - uu___13 - -> - (fun - uu___13 - -> - let uu___14 - = - FStarC_Tactics_V2_Builtins.intro - () in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (290)) - (Prims.of_int (20)) - (Prims.of_int (290)) - (Prims.of_int (28))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (291)) - (Prims.of_int (12)) - (Prims.of_int (291)) - (Prims.of_int (29))))) - (Obj.magic - uu___14) - (fun - uu___15 - -> - (fun - uu___15 - -> - Obj.magic - (simplify_point - ())) - uu___15))) - uu___13)) - | FStar_Reflection_V2_Formula.Not - uu___9 -> - let uu___10 - = - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "neg_cong"]))) in - Obj.magic - (FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (294)) - (Prims.of_int (12)) - (Prims.of_int (294)) - (Prims.of_int (35))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range - "FStar.Tactics.Simplifier.fst" - (Prims.of_int (295)) - (Prims.of_int (12)) - (Prims.of_int (295)) - (Prims.of_int (29))))) - (Obj.magic - uu___10) - (fun - uu___11 - -> - (fun - uu___11 - -> - Obj.magic - (simplify_point - ())) - uu___11)) - | FStar_Reflection_V2_Formula.Iff - (uu___9, - uu___10) - -> - Obj.magic - (FStar_Tactics_V2_Derived.seq - (fun - uu___11 - -> - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; - "Tactics"; - "Simplifier"; - "iff_cong"])))) - simplify_point) - | uu___9 -> - Obj.magic - (tiff ())) - uu___8))) - | uu___7 -> - Obj.magic - (Obj.repr - (FStar_Tactics_V2_Derived.fail - "recurse: failed precondition: goal should be `g <==> ?u`"))) - uu___7))) uu___6))) uu___4))) - uu___2) -let (simplify : unit -> (unit, unit) FStar_Tactics_Effect.tac_repr) = - fun uu___ -> - let uu___1 = - FStar_Tactics_V2_Derived.apply_lemma - (FStarC_Reflection_V2_Builtins.pack_ln - (FStarC_Reflection_V2_Data.Tv_FVar - (FStarC_Reflection_V2_Builtins.pack_fv - ["FStar"; "Tactics"; "Simplifier"; "equiv"]))) in - FStar_Tactics_Effect.tac_bind - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (308)) (Prims.of_int (4)) (Prims.of_int (308)) - (Prims.of_int (24))))) - (FStar_Sealed.seal - (Obj.magic - (FStar_Range.mk_range "FStar.Tactics.Simplifier.fst" - (Prims.of_int (309)) (Prims.of_int (4)) (Prims.of_int (309)) - (Prims.of_int (21))))) (Obj.magic uu___1) - (fun uu___2 -> (fun uu___2 -> Obj.magic (simplify_point ())) uu___2) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_SyntaxHelpers.ml b/stage0/fstar-lib/generated/FStar_Tactics_SyntaxHelpers.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_SyntaxHelpers.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Tactics_V1_Logic_Lemmas.ml b/stage0/fstar-lib/generated/FStar_Tactics_V1_Logic_Lemmas.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/FStar_Tactics_V1_Logic_Lemmas.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_UInt128.ml b/stage0/fstar-lib/generated/FStar_UInt128.ml deleted file mode 100644 index c1da8cedf7c..00000000000 --- a/stage0/fstar-lib/generated/FStar_UInt128.ml +++ /dev/null @@ -1,364 +0,0 @@ -open Prims -type ('a, 'b) fact1 = unit -type ('a, 'b) fact0 = unit -let (constant_time_carry : - FStar_UInt64.t -> FStar_UInt64.t -> FStar_UInt64.t) = - fun a -> - fun b -> - FStar_UInt64.shift_right - (FStar_UInt64.logxor a - (FStar_UInt64.logor (FStar_UInt64.logxor a b) - (FStar_UInt64.logxor (FStar_UInt64.sub_mod a b) b))) - (Stdint.Uint32.of_int (63)) -type uint128 = { - low: FStar_UInt64.t ; - high: FStar_UInt64.t } -let (__proj__Mkuint128__item__low : uint128 -> FStar_UInt64.t) = - fun projectee -> match projectee with | { low; high;_} -> low -let (__proj__Mkuint128__item__high : uint128 -> FStar_UInt64.t) = - fun projectee -> match projectee with | { low; high;_} -> high -type t = uint128 -let (v : t -> unit FStar_UInt.uint_t) = - fun x -> - (FStar_UInt64.v x.low) + - ((FStar_UInt64.v x.high) * (Prims.pow2 (Prims.of_int (64)))) -let (uint_to_t : unit FStar_UInt.uint_t -> t) = - fun x -> - { - low = (FStar_UInt64.uint_to_t (x mod (Prims.pow2 (Prims.of_int (64))))); - high = (FStar_UInt64.uint_to_t (x / (Prims.pow2 (Prims.of_int (64))))) - } -let (carry : FStar_UInt64.t -> FStar_UInt64.t -> FStar_UInt64.t) = - fun a -> fun b -> constant_time_carry a b -let (add : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.add_mod a.low b.low); - high = - (FStar_UInt64.add (FStar_UInt64.add a.high b.high) - (carry (FStar_UInt64.add_mod a.low b.low) b.low)) - } -let (add_underspec : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.add_mod a.low b.low); - high = - (FStar_UInt64.add_underspec - (FStar_UInt64.add_underspec a.high b.high) - (carry (FStar_UInt64.add_mod a.low b.low) b.low)) - } -let (add_mod : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.add_mod a.low b.low); - high = - (FStar_UInt64.add_mod (FStar_UInt64.add_mod a.high b.high) - (carry (FStar_UInt64.add_mod a.low b.low) b.low)) - } -let (sub : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.sub_mod a.low b.low); - high = - (FStar_UInt64.sub (FStar_UInt64.sub a.high b.high) - (carry a.low (FStar_UInt64.sub_mod a.low b.low))) - } -let (sub_underspec : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.sub_mod a.low b.low); - high = - (FStar_UInt64.sub_underspec - (FStar_UInt64.sub_underspec a.high b.high) - (carry a.low (FStar_UInt64.sub_mod a.low b.low))) - } -let (sub_mod_impl : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.sub_mod a.low b.low); - high = - (FStar_UInt64.sub_mod (FStar_UInt64.sub_mod a.high b.high) - (carry a.low (FStar_UInt64.sub_mod a.low b.low))) - } -let (sub_mod : t -> t -> t) = fun a -> fun b -> sub_mod_impl a b -let (append_uint : - Prims.nat -> - Prims.nat -> - unit FStar_UInt.uint_t -> - unit FStar_UInt.uint_t -> unit FStar_UInt.uint_t) - = - fun n1 -> fun n2 -> fun num1 -> fun num2 -> num1 + (num2 * (Prims.pow2 n1)) -let (vec128 : t -> unit FStar_BitVector.bv_t) = - fun a -> FStar_UInt.to_vec (Prims.of_int (128)) (v a) -let (vec64 : FStar_UInt64.t -> unit FStar_BitVector.bv_t) = - fun a -> FStar_UInt.to_vec (Prims.of_int (64)) (FStar_UInt64.v a) -let (logand : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.logand a.low b.low); - high = (FStar_UInt64.logand a.high b.high) - } -let (logxor : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.logxor a.low b.low); - high = (FStar_UInt64.logxor a.high b.high) - } -let (logor : t -> t -> t) = - fun a -> - fun b -> - { - low = (FStar_UInt64.logor a.low b.low); - high = (FStar_UInt64.logor a.high b.high) - } -let (lognot : t -> t) = - fun a -> - { low = (FStar_UInt64.lognot a.low); high = (FStar_UInt64.lognot a.high) - } -let (__uint_to_t : Prims.int -> t) = fun x -> uint_to_t x -let (u32_64 : FStar_UInt32.t) = FStar_UInt32.uint_to_t (Prims.of_int (64)) -let (add_u64_shift_left : - FStar_UInt64.t -> FStar_UInt64.t -> FStar_UInt32.t -> FStar_UInt64.t) = - fun hi -> - fun lo -> - fun s -> - FStar_UInt64.add (FStar_UInt64.shift_left hi s) - (FStar_UInt64.shift_right lo (FStar_UInt32.sub u32_64 s)) -let (add_u64_shift_left_respec : - FStar_UInt64.t -> FStar_UInt64.t -> FStar_UInt32.t -> FStar_UInt64.t) = - fun hi -> fun lo -> fun s -> add_u64_shift_left hi lo s -let (shift_left_small : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - if FStar_UInt32.eq s Stdint.Uint32.zero - then a - else - { - low = (FStar_UInt64.shift_left a.low s); - high = (add_u64_shift_left_respec a.high a.low s) - } -let (shift_left_large : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - { - low = (FStar_UInt64.uint_to_t Prims.int_zero); - high = (FStar_UInt64.shift_left a.low (FStar_UInt32.sub s u32_64)) - } -let (shift_left : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - if FStar_UInt32.lt s u32_64 - then shift_left_small a s - else shift_left_large a s -let (add_u64_shift_right : - FStar_UInt64.t -> FStar_UInt64.t -> FStar_UInt32.t -> FStar_UInt64.t) = - fun hi -> - fun lo -> - fun s -> - FStar_UInt64.add (FStar_UInt64.shift_right lo s) - (FStar_UInt64.shift_left hi (FStar_UInt32.sub u32_64 s)) -let (add_u64_shift_right_respec : - FStar_UInt64.t -> FStar_UInt64.t -> FStar_UInt32.t -> FStar_UInt64.t) = - fun hi -> fun lo -> fun s -> add_u64_shift_right hi lo s -let (shift_right_small : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - if FStar_UInt32.eq s Stdint.Uint32.zero - then a - else - { - low = (add_u64_shift_right_respec a.high a.low s); - high = (FStar_UInt64.shift_right a.high s) - } -let (shift_right_large : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - { - low = (FStar_UInt64.shift_right a.high (FStar_UInt32.sub s u32_64)); - high = (FStar_UInt64.uint_to_t Prims.int_zero) - } -let (shift_right : t -> FStar_UInt32.t -> t) = - fun a -> - fun s -> - if FStar_UInt32.lt s u32_64 - then shift_right_small a s - else shift_right_large a s -let (eq : t -> t -> Prims.bool) = - fun a -> - fun b -> (FStar_UInt64.eq a.low b.low) && (FStar_UInt64.eq a.high b.high) -let (gt : t -> t -> Prims.bool) = - fun a -> - fun b -> - (FStar_UInt64.gt a.high b.high) || - ((FStar_UInt64.eq a.high b.high) && (FStar_UInt64.gt a.low b.low)) -let (lt : t -> t -> Prims.bool) = - fun a -> - fun b -> - (FStar_UInt64.lt a.high b.high) || - ((FStar_UInt64.eq a.high b.high) && (FStar_UInt64.lt a.low b.low)) -let (gte : t -> t -> Prims.bool) = - fun a -> - fun b -> - (FStar_UInt64.gt a.high b.high) || - ((FStar_UInt64.eq a.high b.high) && (FStar_UInt64.gte a.low b.low)) -let (lte : t -> t -> Prims.bool) = - fun a -> - fun b -> - (FStar_UInt64.lt a.high b.high) || - ((FStar_UInt64.eq a.high b.high) && (FStar_UInt64.lte a.low b.low)) -let (eq_mask : t -> t -> t) = - fun a -> - fun b -> - { - low = - (FStar_UInt64.logand (FStar_UInt64.eq_mask a.low b.low) - (FStar_UInt64.eq_mask a.high b.high)); - high = - (FStar_UInt64.logand (FStar_UInt64.eq_mask a.low b.low) - (FStar_UInt64.eq_mask a.high b.high)) - } -let (gte_mask : t -> t -> t) = - fun a -> - fun b -> - { - low = - (FStar_UInt64.logor - (FStar_UInt64.logand (FStar_UInt64.gte_mask a.high b.high) - (FStar_UInt64.lognot (FStar_UInt64.eq_mask a.high b.high))) - (FStar_UInt64.logand (FStar_UInt64.eq_mask a.high b.high) - (FStar_UInt64.gte_mask a.low b.low))); - high = - (FStar_UInt64.logor - (FStar_UInt64.logand (FStar_UInt64.gte_mask a.high b.high) - (FStar_UInt64.lognot (FStar_UInt64.eq_mask a.high b.high))) - (FStar_UInt64.logand (FStar_UInt64.eq_mask a.high b.high) - (FStar_UInt64.gte_mask a.low b.low))) - } -let (uint64_to_uint128 : FStar_UInt64.t -> t) = - fun a -> { low = a; high = (FStar_UInt64.uint_to_t Prims.int_zero) } -let (uint128_to_uint64 : t -> FStar_UInt64.t) = fun a -> a.low -let (u64_l32_mask : FStar_UInt64.t) = - FStar_UInt64.uint_to_t (Prims.parse_int "0xffffffff") -let (u64_mod_32 : FStar_UInt64.t -> FStar_UInt64.t) = - fun a -> - FStar_UInt64.logand a - (FStar_UInt64.uint_to_t (Prims.parse_int "0xffffffff")) -let (u32_32 : FStar_UInt32.t) = FStar_UInt32.uint_to_t (Prims.of_int (32)) -let (u32_combine : FStar_UInt64.t -> FStar_UInt64.t -> FStar_UInt64.t) = - fun hi -> fun lo -> FStar_UInt64.add lo (FStar_UInt64.shift_left hi u32_32) -let (mul32 : FStar_UInt64.t -> FStar_UInt32.t -> t) = - fun x -> - fun y -> - { - low = - (u32_combine - (FStar_UInt64.add - (FStar_UInt64.mul (FStar_UInt64.shift_right x u32_32) - (FStar_Int_Cast.uint32_to_uint64 y)) - (FStar_UInt64.shift_right - (FStar_UInt64.mul (u64_mod_32 x) - (FStar_Int_Cast.uint32_to_uint64 y)) u32_32)) - (u64_mod_32 - (FStar_UInt64.mul (u64_mod_32 x) - (FStar_Int_Cast.uint32_to_uint64 y)))); - high = - (FStar_UInt64.shift_right - (FStar_UInt64.add - (FStar_UInt64.mul (FStar_UInt64.shift_right x u32_32) - (FStar_Int_Cast.uint32_to_uint64 y)) - (FStar_UInt64.shift_right - (FStar_UInt64.mul (u64_mod_32 x) - (FStar_Int_Cast.uint32_to_uint64 y)) u32_32)) u32_32) - } -let (l32 : unit FStar_UInt.uint_t -> unit FStar_UInt.uint_t) = - fun x -> x mod (Prims.pow2 (Prims.of_int (32))) -let (h32 : unit FStar_UInt.uint_t -> unit FStar_UInt.uint_t) = - fun x -> x / (Prims.pow2 (Prims.of_int (32))) -let (mul32_bound : - unit FStar_UInt.uint_t -> unit FStar_UInt.uint_t -> unit FStar_UInt.uint_t) - = fun x -> fun y -> x * y -let (pll : FStar_UInt64.t -> FStar_UInt64.t -> unit FStar_UInt.uint_t) = - fun x -> - fun y -> mul32_bound (l32 (FStar_UInt64.v x)) (l32 (FStar_UInt64.v y)) -let (plh : FStar_UInt64.t -> FStar_UInt64.t -> unit FStar_UInt.uint_t) = - fun x -> - fun y -> mul32_bound (l32 (FStar_UInt64.v x)) (h32 (FStar_UInt64.v y)) -let (phl : FStar_UInt64.t -> FStar_UInt64.t -> unit FStar_UInt.uint_t) = - fun x -> - fun y -> mul32_bound (h32 (FStar_UInt64.v x)) (l32 (FStar_UInt64.v y)) -let (phh : FStar_UInt64.t -> FStar_UInt64.t -> unit FStar_UInt.uint_t) = - fun x -> - fun y -> mul32_bound (h32 (FStar_UInt64.v x)) (h32 (FStar_UInt64.v y)) -let (pll_l : FStar_UInt64.t -> FStar_UInt64.t -> unit FStar_UInt.uint_t) = - fun x -> fun y -> l32 (pll x y) -let (pll_h : FStar_UInt64.t -> FStar_UInt64.t -> unit FStar_UInt.uint_t) = - fun x -> fun y -> h32 (pll x y) -let (mul_wide_low : FStar_UInt64.t -> FStar_UInt64.t -> Prims.int) = - fun x -> - fun y -> - ((((plh x y) + - (((phl x y) + (pll_h x y)) mod (Prims.pow2 (Prims.of_int (32))))) - * (Prims.pow2 (Prims.of_int (32)))) - mod (Prims.pow2 (Prims.of_int (64)))) - + (pll_l x y) -let (mul_wide_high : FStar_UInt64.t -> FStar_UInt64.t -> Prims.int) = - fun x -> - fun y -> - ((phh x y) + - (((phl x y) + (pll_h x y)) / (Prims.pow2 (Prims.of_int (32))))) - + - (((plh x y) + - (((phl x y) + (pll_h x y)) mod (Prims.pow2 (Prims.of_int (32))))) - / (Prims.pow2 (Prims.of_int (32)))) -let (u32_combine' : FStar_UInt64.t -> FStar_UInt64.t -> FStar_UInt64.t) = - fun hi -> fun lo -> FStar_UInt64.add lo (FStar_UInt64.shift_left hi u32_32) -let (mul_wide : FStar_UInt64.t -> FStar_UInt64.t -> t) = - fun x -> - fun y -> - { - low = - (u32_combine' - (FStar_UInt64.add - (FStar_UInt64.mul (u64_mod_32 x) - (FStar_UInt64.shift_right y u32_32)) - (u64_mod_32 - (FStar_UInt64.add - (FStar_UInt64.mul (FStar_UInt64.shift_right x u32_32) - (u64_mod_32 y)) - (FStar_UInt64.shift_right - (FStar_UInt64.mul (u64_mod_32 x) (u64_mod_32 y)) - u32_32)))) - (u64_mod_32 (FStar_UInt64.mul (u64_mod_32 x) (u64_mod_32 y)))); - high = - (FStar_UInt64.add_mod - (FStar_UInt64.add - (FStar_UInt64.mul (FStar_UInt64.shift_right x u32_32) - (FStar_UInt64.shift_right y u32_32)) - (FStar_UInt64.shift_right - (FStar_UInt64.add - (FStar_UInt64.mul (FStar_UInt64.shift_right x u32_32) - (u64_mod_32 y)) - (FStar_UInt64.shift_right - (FStar_UInt64.mul (u64_mod_32 x) (u64_mod_32 y)) - u32_32)) u32_32)) - (FStar_UInt64.shift_right - (FStar_UInt64.add - (FStar_UInt64.mul (u64_mod_32 x) - (FStar_UInt64.shift_right y u32_32)) - (u64_mod_32 - (FStar_UInt64.add - (FStar_UInt64.mul - (FStar_UInt64.shift_right x u32_32) - (u64_mod_32 y)) - (FStar_UInt64.shift_right - (FStar_UInt64.mul (u64_mod_32 x) (u64_mod_32 y)) - u32_32)))) u32_32)) - } \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_UInt16.ml b/stage0/fstar-lib/generated/FStar_UInt16.ml deleted file mode 100644 index 69409412af6..00000000000 --- a/stage0/fstar-lib/generated/FStar_UInt16.ml +++ /dev/null @@ -1,105 +0,0 @@ -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS IS AN AUTOGENERATED FILE! See ulib/ml/Makefile *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -(* This file is meant to be concatenated to FStar_Ints.ml.body *) -module M = Stdint.Uint16 -type uint16 = M.t -type t = M.t -let n = Prims.of_int 16 - -let uint_to_t x = M.of_string (Z.to_string x) -let __uint_to_t = uint_to_t -(* This .ml.body file is concatenated to every .ml.prefix file in this - * directory (ulib/ml/) to generate the OCaml realizations for machine - * integers, as they all pretty much share their definitions and are - * based on Stdint. *) - -let v (x:t) : Prims.int = Prims.parse_int (M.to_string x) - -let zero = M.zero -let one = M.one -let ones = M.pred M.zero - -(* Reexport add, plus aliases *) -let add = M.add -let add_underspec = M.add -let add_mod = M.add - -(* Reexport sub, plus aliases *) -let sub = M.sub -let sub_underspec = M.sub -let sub_mod = M.sub - -(* Reexport mul, plus aliases *) -let mul = M.mul -let mul_underspec = M.mul -let mul_mod = M.mul - -(* Conversions to Zarith's int *) -let to_int (x:t) : Z.t = Z.of_string (M.to_string x) -let of_int (x:Z.t) : t = M.of_string (Z.to_string x) - -(* Conversion to native ints; these are potentially unsafe and not part - * of the interface: they are meant to be called only from OCaml code - * that is doing the right thing *) -let of_native_int (x:int) : t = M.of_int x -let to_native_int (x:t) : int = M.to_int x - -(* Just reexport these *) -let div = M.div -let rem = M.rem -let logand = M.logand -let logxor = M.logxor -let logor = M.logor -let lognot = M.lognot -let to_string = M.to_string -let of_string = M.of_string - -let to_string_hex = M.to_string_hex - -let to_string_hex_pad i = - let s0 = M.to_string_hex i in - let len = (String.length s0 - 2) in - let s1 = String.sub s0 2 len in (* Remove leading "0x" *) - let zeroes = String.make ((Z.to_int n / 4) - len) '0' in - zeroes ^ s1 - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right n i = M.shift_right n (Stdint.Uint32.to_int i) -let shift_left n i = M.shift_left n (Stdint.Uint32.to_int i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/fstar-lib/generated/FStar_UInt32.ml b/stage0/fstar-lib/generated/FStar_UInt32.ml deleted file mode 100644 index d02cd18624f..00000000000 --- a/stage0/fstar-lib/generated/FStar_UInt32.ml +++ /dev/null @@ -1,105 +0,0 @@ -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS IS AN AUTOGENERATED FILE! See ulib/ml/Makefile *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -(* This file is meant to be concatenated to FStar_Ints.ml.body *) -module M = Stdint.Uint32 -type uint32 = M.t -type t = M.t -let n = Prims.of_int 32 - -let uint_to_t x = M.of_string (Z.to_string x) -let __uint_to_t = uint_to_t -(* This .ml.body file is concatenated to every .ml.prefix file in this - * directory (ulib/ml/) to generate the OCaml realizations for machine - * integers, as they all pretty much share their definitions and are - * based on Stdint. *) - -let v (x:t) : Prims.int = Prims.parse_int (M.to_string x) - -let zero = M.zero -let one = M.one -let ones = M.pred M.zero - -(* Reexport add, plus aliases *) -let add = M.add -let add_underspec = M.add -let add_mod = M.add - -(* Reexport sub, plus aliases *) -let sub = M.sub -let sub_underspec = M.sub -let sub_mod = M.sub - -(* Reexport mul, plus aliases *) -let mul = M.mul -let mul_underspec = M.mul -let mul_mod = M.mul - -(* Conversions to Zarith's int *) -let to_int (x:t) : Z.t = Z.of_string (M.to_string x) -let of_int (x:Z.t) : t = M.of_string (Z.to_string x) - -(* Conversion to native ints; these are potentially unsafe and not part - * of the interface: they are meant to be called only from OCaml code - * that is doing the right thing *) -let of_native_int (x:int) : t = M.of_int x -let to_native_int (x:t) : int = M.to_int x - -(* Just reexport these *) -let div = M.div -let rem = M.rem -let logand = M.logand -let logxor = M.logxor -let logor = M.logor -let lognot = M.lognot -let to_string = M.to_string -let of_string = M.of_string - -let to_string_hex = M.to_string_hex - -let to_string_hex_pad i = - let s0 = M.to_string_hex i in - let len = (String.length s0 - 2) in - let s1 = String.sub s0 2 len in (* Remove leading "0x" *) - let zeroes = String.make ((Z.to_int n / 4) - len) '0' in - zeroes ^ s1 - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right n i = M.shift_right n (Stdint.Uint32.to_int i) -let shift_left n i = M.shift_left n (Stdint.Uint32.to_int i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/fstar-lib/generated/FStar_UInt64.ml b/stage0/fstar-lib/generated/FStar_UInt64.ml deleted file mode 100644 index 8524657e0ae..00000000000 --- a/stage0/fstar-lib/generated/FStar_UInt64.ml +++ /dev/null @@ -1,105 +0,0 @@ -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS IS AN AUTOGENERATED FILE! See ulib/ml/Makefile *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -(* This file is meant to be concatenated to FStar_Ints.ml.body *) -module M = Stdint.Uint64 -type uint64 = M.t -type t = M.t -let n = Prims.of_int 64 - -let uint_to_t x = M.of_string (Z.to_string x) -let __uint_to_t = uint_to_t -(* This .ml.body file is concatenated to every .ml.prefix file in this - * directory (ulib/ml/) to generate the OCaml realizations for machine - * integers, as they all pretty much share their definitions and are - * based on Stdint. *) - -let v (x:t) : Prims.int = Prims.parse_int (M.to_string x) - -let zero = M.zero -let one = M.one -let ones = M.pred M.zero - -(* Reexport add, plus aliases *) -let add = M.add -let add_underspec = M.add -let add_mod = M.add - -(* Reexport sub, plus aliases *) -let sub = M.sub -let sub_underspec = M.sub -let sub_mod = M.sub - -(* Reexport mul, plus aliases *) -let mul = M.mul -let mul_underspec = M.mul -let mul_mod = M.mul - -(* Conversions to Zarith's int *) -let to_int (x:t) : Z.t = Z.of_string (M.to_string x) -let of_int (x:Z.t) : t = M.of_string (Z.to_string x) - -(* Conversion to native ints; these are potentially unsafe and not part - * of the interface: they are meant to be called only from OCaml code - * that is doing the right thing *) -let of_native_int (x:int) : t = M.of_int x -let to_native_int (x:t) : int = M.to_int x - -(* Just reexport these *) -let div = M.div -let rem = M.rem -let logand = M.logand -let logxor = M.logxor -let logor = M.logor -let lognot = M.lognot -let to_string = M.to_string -let of_string = M.of_string - -let to_string_hex = M.to_string_hex - -let to_string_hex_pad i = - let s0 = M.to_string_hex i in - let len = (String.length s0 - 2) in - let s1 = String.sub s0 2 len in (* Remove leading "0x" *) - let zeroes = String.make ((Z.to_int n / 4) - len) '0' in - zeroes ^ s1 - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right n i = M.shift_right n (Stdint.Uint32.to_int i) -let shift_left n i = M.shift_left n (Stdint.Uint32.to_int i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/fstar-lib/generated/FStar_Universe.ml b/stage0/fstar-lib/generated/FStar_Universe.ml deleted file mode 100644 index fd233781f5f..00000000000 --- a/stage0/fstar-lib/generated/FStar_Universe.ml +++ /dev/null @@ -1,14 +0,0 @@ -open Prims -type 'a raise0 = - | Ret of 'a -let uu___is_Ret : 'a . 'a raise0 -> Prims.bool = fun projectee -> true -let __proj__Ret__item___0 : 'a . 'a raise0 -> 'a = - fun projectee -> match projectee with | Ret _0 -> _0 -type 'a raise_t = 'a raise0 -let raise_val : 'a . 'a -> 'a raise_t = fun x -> Ret x -let downgrade_val : 'a . 'a raise_t -> 'a = - fun x -> match x with | Ret x0 -> x0 -let lift_dom : 'a 'b . ('a -> 'b) -> 'a raise_t -> 'b = - fun q -> fun v -> q (downgrade_val v) -let lift_codom : 'a 'b . ('a -> 'b) -> 'a -> 'b raise_t = - fun q -> fun v -> raise_val (q v) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_Universe_PCM.ml b/stage0/fstar-lib/generated/FStar_Universe_PCM.ml deleted file mode 100644 index 26b0afbab73..00000000000 --- a/stage0/fstar-lib/generated/FStar_Universe_PCM.ml +++ /dev/null @@ -1,40 +0,0 @@ -open Prims -let raise : 'a . 'a FStar_PCM.pcm -> 'a FStar_Universe.raise_t FStar_PCM.pcm - = - fun p -> - { - FStar_PCM.p = - { - FStar_PCM.composable = (); - FStar_PCM.op = - (fun x -> - fun y -> - FStar_Universe.raise_val - ((p.FStar_PCM.p).FStar_PCM.op - (FStar_Universe.downgrade_val x) - (FStar_Universe.downgrade_val y))); - FStar_PCM.one = - (FStar_Universe.raise_val (p.FStar_PCM.p).FStar_PCM.one) - }; - FStar_PCM.comm = (); - FStar_PCM.assoc = (); - FStar_PCM.assoc_r = (); - FStar_PCM.is_unit = (); - FStar_PCM.refine = () - } -let raise_frame_preserving_upd : - 'a . - 'a FStar_PCM.pcm -> - 'a -> - 'a -> - ('a, unit, unit, unit) FStar_PCM.frame_preserving_upd -> - ('a FStar_Universe.raise_t, unit, unit, unit) - FStar_PCM.frame_preserving_upd - = - fun p -> - fun x -> - fun y -> - fun f -> - fun v -> - let u = f (FStar_Universe.downgrade_val v) in - let v_new = FStar_Universe.raise_val u in v_new \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_WellFounded.ml b/stage0/fstar-lib/generated/FStar_WellFounded.ml deleted file mode 100644 index b6344029a88..00000000000 --- a/stage0/fstar-lib/generated/FStar_WellFounded.ml +++ /dev/null @@ -1,17 +0,0 @@ -open Prims -type 'a binrel = unit -type ('a, 'r) well_founded = unit -let rec fix_F : - 'aa 'r 'p . ('aa -> ('aa -> 'r -> 'p) -> 'p) -> 'aa -> unit -> 'p = - fun f -> fun x -> fun a -> f x (fun y -> fun h -> fix_F f y ()) -let fix : - 'aa 'r . - unit -> unit -> ('aa -> ('aa -> 'r -> Obj.t) -> Obj.t) -> 'aa -> Obj.t - = fun rwf -> fun p -> fun f -> fun x -> fix_F f x () -type ('a, 'rel) is_well_founded = unit -type 'a well_founded_relation = unit -type ('a, 'rel, 'f, 'uuuuu, 'uuuuu1) as_well_founded = 'rel - -type ('a, 'r, 'subur, 'subuw, 'ruwf, 'uuuuu, 'uuuuu1) subrelation_as_wf = - 'subur -type ('a, 'b, 'rub, 'f, 'x, 'y) inverse_image = 'rub diff --git a/stage0/fstar-lib/generated/FStar_WellFoundedRelation.ml b/stage0/fstar-lib/generated/FStar_WellFoundedRelation.ml deleted file mode 100644 index 4aa36833970..00000000000 --- a/stage0/fstar-lib/generated/FStar_WellFoundedRelation.ml +++ /dev/null @@ -1,154 +0,0 @@ -open Prims -type ('a, 'r, 'x) acc_classical = - | AccClassicalIntro of ('a -> ('a, 'r, unit) acc_classical) -let uu___is_AccClassicalIntro : - 'a 'r . 'a -> ('a, 'r, unit) acc_classical -> Prims.bool = - fun x -> fun projectee -> true -let __proj__AccClassicalIntro__item__access_smaller : - 'a 'r . - 'a -> ('a, 'r, unit) acc_classical -> 'a -> ('a, 'r, unit) acc_classical - = - fun x -> - fun projectee -> - match projectee with - | AccClassicalIntro access_smaller -> access_smaller -type 'a wfr_t = - { - relation: unit ; - decreaser: 'a -> ('a, Obj.t, unit) acc_classical ; - proof: unit } -let __proj__Mkwfr_t__item__decreaser : - 'a . 'a wfr_t -> 'a -> ('a, unit, unit) acc_classical = - fun uu___1 -> - fun uu___ -> - (fun projectee -> - match projectee with - | { relation; decreaser; proof;_} -> Obj.magic decreaser) uu___1 - uu___ -type ('a, 'x1, 'x2) default_relation = ('a, 'a, unit, unit) Prims.precedes -let rec default_decreaser : - 'a . 'a -> ('a, ('a, unit, unit) default_relation, unit) acc_classical = - fun x -> let smaller y = default_decreaser y in AccClassicalIntro smaller -let default_wfr : 'a . unit -> 'a wfr_t = - fun uu___ -> - { - relation = (); - decreaser = (fun uu___1 -> (Obj.magic default_decreaser) uu___1); - proof = () - } -type ('a, 'x1, 'x2) empty_relation = unit -let rec empty_decreaser : - 'a . 'a -> ('a, ('a, unit, unit) empty_relation, unit) acc_classical = - fun x -> let smaller y = empty_decreaser y in AccClassicalIntro smaller -let empty_wfr : 'a . unit -> 'a wfr_t = - fun uu___ -> - { - relation = (); - decreaser = (fun uu___1 -> (Obj.magic empty_decreaser) uu___1); - proof = () - } -type ('a, 'r, 'x1, 'x2) acc_relation = unit -let rec acc_decreaser : - 'a 'r . - unit -> 'a -> ('a, ('a, 'r, unit, unit) acc_relation, unit) acc_classical - = - fun f -> - fun x -> let smaller y = acc_decreaser () y in AccClassicalIntro smaller -let acc_to_wfr : 'a 'r . unit -> 'a wfr_t = - fun f -> - { - relation = (); - decreaser = (fun uu___ -> (Obj.magic (acc_decreaser ())) uu___); - proof = () - } -let rec subrelation_decreaser : - 'a 'r . 'a wfr_t -> 'a -> ('a, 'r, unit) acc_classical = - fun wfr -> - fun x -> - let smaller y = subrelation_decreaser wfr y in - AccClassicalIntro smaller -let subrelation_to_wfr : 'a 'r . 'a wfr_t -> 'a wfr_t = - fun wfr -> - { - relation = (); - decreaser = - (fun uu___ -> (Obj.magic (subrelation_decreaser wfr)) uu___); - proof = () - } -let rec inverse_image_decreaser : - 'a 'b 'r . ('a -> 'b) -> 'b wfr_t -> 'a -> ('a, 'r, unit) acc_classical = - fun f -> - fun wfr -> - fun x -> - let smaller y = inverse_image_decreaser f wfr y in - AccClassicalIntro smaller -let inverse_image_to_wfr : 'a 'b 'r . ('a -> 'b) -> 'b wfr_t -> 'a wfr_t = - fun f -> - fun wfr -> - { - relation = (); - decreaser = - (fun uu___ -> (Obj.magic (inverse_image_decreaser f wfr)) uu___); - proof = () - } -type ('a, 'b, 'wfrua, 'wfrub, 'xy1, 'xy2) lex_nondep_relation = Obj.t -let rec lex_nondep_decreaser : - 'a 'b . - 'a wfr_t -> - 'b wfr_t -> ('a * 'b) -> (('a * 'b), Obj.t, unit) acc_classical - = - fun wfr_a -> - fun wfr_b -> - fun xy -> - let smaller xy' = lex_nondep_decreaser wfr_a wfr_b xy' in - AccClassicalIntro smaller -let lex_nondep_wfr : 'a 'b . 'a wfr_t -> 'b wfr_t -> ('a * 'b) wfr_t = - fun wfr_a -> - fun wfr_b -> - { - relation = (); - decreaser = (lex_nondep_decreaser wfr_a wfr_b); - proof = () - } -type ('a, 'b, 'wfrua, 'autouwfrub, 'xy1, 'xy2) lex_dep_relation = Obj.t -let rec lex_dep_decreaser : - 'a 'b . - 'a wfr_t -> - ('a -> 'b wfr_t) -> - ('a, 'b) Prims.dtuple2 -> - (('a, 'b) Prims.dtuple2, Obj.t, unit) acc_classical - = - fun wfr_a -> - fun a_to_wfr_b -> - fun xy -> - let smaller xy' = lex_dep_decreaser wfr_a a_to_wfr_b xy' in - AccClassicalIntro smaller -let lex_dep_wfr : - 'a 'b . 'a wfr_t -> ('a -> 'b wfr_t) -> ('a, 'b) Prims.dtuple2 wfr_t = - fun wfr_a -> - fun a_to_wfr_b -> - { - relation = (); - decreaser = (lex_dep_decreaser wfr_a a_to_wfr_b); - proof = () - } -type ('x1, 'x2) bool_relation = unit -let (bool_wfr : Prims.bool wfr_t) = - inverse_image_to_wfr (fun b -> if b then Prims.int_one else Prims.int_zero) - (default_wfr ()) -type ('a, 'wfr, 'opt1, 'opt2) option_relation = unit -let option_wfr : 'a . 'a wfr_t -> 'a FStar_Pervasives_Native.option wfr_t = - fun wfr -> - let f opt = - match opt with - | FStar_Pervasives_Native.Some x -> - Prims.Mkdtuple2 (true, (Obj.magic x)) - | FStar_Pervasives_Native.None -> - Prims.Mkdtuple2 (false, (Obj.magic (FStar_Universe.raise_val ()))) in - let bool_to_wfr_a uu___ = - (fun b -> - if b - then Obj.magic (Obj.repr wfr) - else Obj.magic (Obj.repr (empty_wfr ()))) uu___ in - let wfr_bool_a = lex_dep_wfr bool_wfr bool_to_wfr_a in - inverse_image_to_wfr f wfr_bool_a \ No newline at end of file diff --git a/stage0/fstar-lib/generated/FStar_WellFounded_Util.ml b/stage0/fstar-lib/generated/FStar_WellFounded_Util.ml deleted file mode 100644 index 9d3fb961c6a..00000000000 --- a/stage0/fstar-lib/generated/FStar_WellFounded_Util.ml +++ /dev/null @@ -1,14 +0,0 @@ -open Prims -type top = (unit, Obj.t) Prims.dtuple2 -type ('a, 'r, 't0, 't1) lift_binrel = (unit, 'r) Prims.dtuple2 -let lower_binrel : - 'a 'r . top -> top -> ('a, 'r, unit, unit) lift_binrel -> 'r = - fun x -> fun y -> fun p -> FStar_Pervasives.dsnd p - -type ('a, 'r, 'wfur, 'uuuuu, 'uuuuu1) lift_binrel_as_well_founded_relation = - ('a, 'r, unit, unit) lift_binrel -type ('a, 'r, 't0, 't1) lift_binrel_squashed = unit -type ('a, 'r, 'x, 'y) squash_binrel = unit - -type ('a, 'r, 'wfur, 'uuuuu, - 'uuuuu1) lift_binrel_squashed_as_well_founded_relation = unit diff --git a/stage0/fstar-lib/generated/FStar_Witnessed_Core.ml b/stage0/fstar-lib/generated/FStar_Witnessed_Core.ml deleted file mode 100644 index 89e275c453a..00000000000 --- a/stage0/fstar-lib/generated/FStar_Witnessed_Core.ml +++ /dev/null @@ -1,4 +0,0 @@ -open Prims -type 'state s_predicate = unit -type ('state, 'rel, 'p) stable = unit -type ('state, 'rel, 'p) witnessed = unit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_Buffer.ml b/stage0/fstar-lib/generated/LowStar_Buffer.ml deleted file mode 100644 index 9059a9cc0cc..00000000000 --- a/stage0/fstar-lib/generated/LowStar_Buffer.ml +++ /dev/null @@ -1,90 +0,0 @@ -open Prims -type ('a, 'uuuuu, 'uuuuu1) trivial_preorder = unit -type 'a buffer = ('a, unit, unit) LowStar_Monotonic_Buffer.mbuffer -let null : 'a . unit -> 'a buffer = - fun uu___ -> LowStar_Monotonic_Buffer.mnull () -type 'a pointer = 'a buffer -type 'a pointer_or_null = 'a buffer -let sub : - 'a . - unit -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) LowStar_Monotonic_Buffer.mbuffer - -> - FStar_UInt32.t -> - unit -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.msub -let offset : - 'a . - unit -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) LowStar_Monotonic_Buffer.mbuffer - -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.moffset -type ('a, 'len) lbuffer = ('a, unit, unit) LowStar_Monotonic_Buffer.mbuffer -let gcmalloc : - 'a . - unit -> - unit -> - 'a -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.mgcmalloc -let malloc : - 'a . - unit -> - unit -> - 'a -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.mmalloc -let alloca : - 'a . - unit -> - 'a -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.malloca -let alloca_of_list : - 'a . - unit -> - 'a Prims.list -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.malloca_of_list -let gcmalloc_of_list : - 'a . - unit -> - unit -> - 'a Prims.list -> - ('a, ('a, unit, unit) trivial_preorder, - ('a, unit, unit) trivial_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.mgcmalloc_of_list -type ('a, 'l) assign_list_t = 'a buffer -> unit -let rec assign_list : 'a . 'a Prims.list -> 'a buffer -> unit = - fun l -> - fun b -> - match l with - | [] -> let h = FStar_HyperStack_ST.get () in () - | hd::tl -> - let b_hd = LowStar_Monotonic_Buffer.msub b Stdint.Uint32.zero () in - let b_tl = LowStar_Monotonic_Buffer.moffset b Stdint.Uint32.one in - let h = FStar_HyperStack_ST.get () in - ((let h1 = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' b_hd Stdint.Uint32.zero hd); - (let h0 = FStar_HyperStack_ST.get () in - assign_list tl b_tl; (let h1 = FStar_HyperStack_ST.get () in ()))) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_BufferOps.ml b/stage0/fstar-lib/generated/LowStar_BufferOps.ml deleted file mode 100644 index 5784af2f473..00000000000 --- a/stage0/fstar-lib/generated/LowStar_BufferOps.ml +++ /dev/null @@ -1,36 +0,0 @@ -open Prims -let op_Array_Access : - 'a 'rrel 'rel . - unit -> - ('a, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> 'a - = fun uu___ -> LowStar_Monotonic_Buffer.index -let op_Array_Assignment : - 'a 'rrel 'rel . - ('a, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> 'a -> unit - = - fun b -> - fun i -> - fun v -> - let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' b i v -let op_Bang_Star : - 'a 'rrel 'rel . ('a, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> 'a = - fun p -> LowStar_Monotonic_Buffer.index p Stdint.Uint32.zero -let op_Star_Equals : - 'a 'rrel 'rel . - ('a, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> 'a -> unit - = - fun p -> - fun v -> - let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' p Stdint.Uint32.zero v -let blit : - 'a 'rrel1 'rel1 'rrel2 'rel2 . - unit -> - ('a, 'rrel1, 'rrel2) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> - ('a, 'rel1, 'rel2) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> unit - = fun uu___ -> LowStar_Monotonic_Buffer.blit \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_BufferView.ml b/stage0/fstar-lib/generated/LowStar_BufferView.ml deleted file mode 100644 index 130cf325e68..00000000000 --- a/stage0/fstar-lib/generated/LowStar_BufferView.ml +++ /dev/null @@ -1,43 +0,0 @@ -open Prims -type ('a, 'b, 'f, 'g) inverses = unit -type ('a, 'b) view = - | View of Prims.pos * unit * unit -let uu___is_View : 'a 'b . ('a, 'b) view -> Prims.bool = - fun projectee -> true -let __proj__View__item__n : 'a 'b . ('a, 'b) view -> Prims.pos = - fun projectee -> match projectee with | View (n, get, put) -> n -type ('a, 'rrel, 'rel, 'b) buffer_view = - | BufferView of ('a, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer * ( - 'a, 'b) view -let uu___is_BufferView : - 'a 'rrel 'rel 'b . ('a, 'rrel, 'rel, 'b) buffer_view -> Prims.bool = - fun projectee -> true -let __proj__BufferView__item__buf : - 'a 'rrel 'rel 'b . - ('a, 'rrel, 'rel, 'b) buffer_view -> - ('a, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer - = fun projectee -> match projectee with | BufferView (buf, v) -> buf -let __proj__BufferView__item__v : - 'a 'rrel 'rel 'b . ('a, 'rrel, 'rel, 'b) buffer_view -> ('a, 'b) view = - fun projectee -> match projectee with | BufferView (buf, v) -> v -type 'dest buffer = - (unit, unit, unit, (Obj.t, Obj.t, Obj.t, 'dest) buffer_view) - FStar_Pervasives.dtuple4 -type ('dest, 'b) as_buffer_t = - (unit, unit, unit) LowStar_Monotonic_Buffer.mbuffer -let as_buffer : 'b . 'b buffer -> ('b, unit) as_buffer_t = - fun uu___ -> - (fun v -> - Obj.magic - (__proj__BufferView__item__buf - (FStar_Pervasives.__proj__Mkdtuple4__item___4 v))) uu___ -let get_view : 'b . 'b buffer -> (unit, 'b) view = - fun uu___ -> - (fun v -> - Obj.magic - (__proj__BufferView__item__v - (FStar_Pervasives.__proj__Mkdtuple4__item___4 v))) uu___ -type ('b, 'h, 'vb) live = - (unit, unit, unit, unit, unit) LowStar_Monotonic_Buffer.live -type ('b, 'vb, 'h, 'hu) modifies = - (unit, unit, unit) LowStar_Monotonic_Buffer.modifies \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_BufferView_Down.ml b/stage0/fstar-lib/generated/LowStar_BufferView_Down.ml deleted file mode 100644 index 90dafda1b5d..00000000000 --- a/stage0/fstar-lib/generated/LowStar_BufferView_Down.ml +++ /dev/null @@ -1,51 +0,0 @@ -open Prims -type ('a, 'b, 'f, 'g) inverses = unit -type ('a, 'b) view = - | View of Prims.pos * unit * unit -let uu___is_View : 'a 'b . ('a, 'b) view -> Prims.bool = - fun projectee -> true -let __proj__View__item__n : 'a 'b . ('a, 'b) view -> Prims.pos = - fun projectee -> match projectee with | View (n, get, put) -> n -type ('src, 'rrel, 'rel, 'dest) buffer_view = - | BufferView of ('src, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer * - ('src, 'dest) view -let uu___is_BufferView : - 'src 'rrel 'rel 'dest . - ('src, 'rrel, 'rel, 'dest) buffer_view -> Prims.bool - = fun projectee -> true -let __proj__BufferView__item__buf : - 'src 'rrel 'rel 'dest . - ('src, 'rrel, 'rel, 'dest) buffer_view -> - ('src, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer - = fun projectee -> match projectee with | BufferView (buf, v) -> buf -let __proj__BufferView__item__v : - 'src 'rrel 'rel 'dest . - ('src, 'rrel, 'rel, 'dest) buffer_view -> ('src, 'dest) view - = fun projectee -> match projectee with | BufferView (buf, v) -> v -type 'dest buffer = - (unit, unit, unit, (Obj.t, Obj.t, Obj.t, 'dest) buffer_view) - FStar_Pervasives.dtuple4 -type ('dest, 'b) as_buffer_t = - (unit, unit, unit) LowStar_Monotonic_Buffer.mbuffer -let as_buffer : 'b . 'b buffer -> ('b, unit) as_buffer_t = - fun uu___ -> - (fun v -> - let uu___ = v in - match uu___ with - | FStar_Pervasives.Mkdtuple4 - (uu___1, uu___2, uu___3, BufferView (b1, uu___4)) -> Obj.magic b1) - uu___ -let get_view : 'b . 'b buffer -> (unit, 'b) view = - fun uu___ -> - (fun bv -> - let uu___ = bv in - match uu___ with - | FStar_Pervasives.Mkdtuple4 - (uu___1, uu___2, uu___3, BufferView (uu___4, v)) -> Obj.magic v) - uu___ -type ('b, 'h, 'vb) live = - (unit, unit, unit, unit, unit) LowStar_Monotonic_Buffer.live -type ('b, 'vb, 'h, 'hu) mods = - (unit, unit, unit) LowStar_Monotonic_Buffer.modifies -type ('b, 'vb, 'h, 'hu) modifies = - (unit, unit, unit) LowStar_Monotonic_Buffer.modifies \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_BufferView_Up.ml b/stage0/fstar-lib/generated/LowStar_BufferView_Up.ml deleted file mode 100644 index 6282ed2052b..00000000000 --- a/stage0/fstar-lib/generated/LowStar_BufferView_Up.ml +++ /dev/null @@ -1,33 +0,0 @@ -open Prims -type ('uuuuu, 'uuuuu1, 'f, 'g) inverses = unit -type ('a, 'b) view = - | View of Prims.pos * unit * unit -let uu___is_View : 'a 'b . ('a, 'b) view -> Prims.bool = - fun projectee -> true -let __proj__View__item__n : 'a 'b . ('a, 'b) view -> Prims.pos = - fun projectee -> match projectee with | View (n, get, put) -> n -type 'dest buffer = - | Buffer of unit * Obj.t LowStar_BufferView_Down.buffer * (Obj.t, 'dest) - view -let uu___is_Buffer : 'dest . 'dest buffer -> Prims.bool = - fun projectee -> true -let __proj__Buffer__item__down_buf : - 'dest . 'dest buffer -> unit LowStar_BufferView_Down.buffer = - fun uu___ -> - (fun projectee -> - match projectee with | Buffer (src, down_buf, v) -> Obj.magic down_buf) - uu___ -let __proj__Buffer__item__v : 'dest . 'dest buffer -> (unit, 'dest) view = - fun uu___ -> - (fun projectee -> - match projectee with | Buffer (src, down_buf, v) -> Obj.magic v) uu___ -type ('b, 'bv) buffer_src = Obj.t -let as_down_buffer : 'b . 'b buffer -> Obj.t LowStar_BufferView_Down.buffer = - fun uu___ -> - (fun bv -> Obj.magic (__proj__Buffer__item__down_buf bv)) uu___ -let get_view : 'b . 'b buffer -> (Obj.t, 'b) view = - fun uu___ -> (fun v -> Obj.magic (__proj__Buffer__item__v v)) uu___ -type ('b, 'h, 'vb) live = - (unit, unit, unit, unit, unit) LowStar_Monotonic_Buffer.live -type ('b, 'vb, 'h, 'hu) modifies = - (unit, unit, unit) LowStar_Monotonic_Buffer.modifies \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_Comment.ml b/stage0/fstar-lib/generated/LowStar_Comment.ml deleted file mode 100644 index 48ca2709bb9..00000000000 --- a/stage0/fstar-lib/generated/LowStar_Comment.ml +++ /dev/null @@ -1,4 +0,0 @@ -open Prims -let comment_gen : 't . Prims.string -> 't -> Prims.string -> 't = - fun before -> fun body -> fun after -> body -let (comment : Prims.string -> unit) = fun s -> () \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_ConstBuffer.ml b/stage0/fstar-lib/generated/LowStar_ConstBuffer.ml deleted file mode 100644 index f6839f0581c..00000000000 --- a/stage0/fstar-lib/generated/LowStar_ConstBuffer.ml +++ /dev/null @@ -1,61 +0,0 @@ -open Prims -type ('q, 'a) qbuf_cases = Obj.t -type ('q, 'a) q_preorder = Obj.t -type 'a qbuf = (unit, Obj.t) Prims.dtuple2 -type ('a, 'c, 'uuuuu, 'uuuuu1) qbuf_pre = Obj.t -let qbuf_mbuf : - 'a . 'a qbuf -> ('a, Obj.t, Obj.t) LowStar_Monotonic_Buffer.mbuffer = - fun uu___ -> (fun c -> Obj.magic (FStar_Pervasives.dsnd c)) uu___ -type 'a const_buffer = 'a qbuf -let as_qbuf : 'a . 'a const_buffer -> 'a qbuf = fun c -> c -type ('a, 'h, 'c) live = - ('a, Obj.t, Obj.t, unit, unit) LowStar_Monotonic_Buffer.live -let of_buffer : 'a . 'a LowStar_Buffer.buffer -> 'a const_buffer = - fun b -> Prims.Mkdtuple2 ((), (Obj.magic b)) -let of_ibuffer : 'a . 'a LowStar_ImmutableBuffer.ibuffer -> 'a const_buffer = - fun b -> Prims.Mkdtuple2 ((), (Obj.magic b)) -let of_qbuf : - 'uuuuu . - unit -> - ('uuuuu, Obj.t, Obj.t) LowStar_Monotonic_Buffer.mbuffer -> - 'uuuuu const_buffer - = fun q -> fun b -> Prims.Mkdtuple2 ((), (Obj.magic b)) -let null : 'a . unit -> 'a const_buffer = - fun uu___ -> of_buffer (LowStar_Monotonic_Buffer.mnull ()) -let is_null : 'a . 'a const_buffer -> Prims.bool = - fun c -> let x = qbuf_mbuf c in LowStar_Monotonic_Buffer.is_null x -let index : 'a . 'a const_buffer -> FStar_UInt32.t -> 'a = - fun c -> fun i -> let x = qbuf_mbuf c in LowStar_Monotonic_Buffer.index x i -type ('a, 'i, 'len, 'csub, 'c) const_sub_buffer = unit -let sub : 'a . 'a const_buffer -> FStar_UInt32.t -> unit -> 'a const_buffer = - fun c -> - fun i -> - fun len -> - let uu___ = c in - match uu___ with - | Prims.Mkdtuple2 (q, x) -> - let x1 = Obj.magic x in - let y = LowStar_Monotonic_Buffer.msub x1 i () in - Prims.Mkdtuple2 ((), (Obj.magic y)) -let cast : - 'a . 'a const_buffer -> ('a, Obj.t, Obj.t) LowStar_Monotonic_Buffer.mbuffer - = fun c -> qbuf_mbuf c -let to_buffer : 'a . 'a const_buffer -> 'a LowStar_Buffer.buffer = - fun uu___ -> (fun c -> Obj.magic (qbuf_mbuf c)) uu___ -let to_ibuffer : 'a . 'a const_buffer -> 'a LowStar_ImmutableBuffer.ibuffer = - fun uu___ -> (fun c -> Obj.magic (qbuf_mbuf c)) uu___ -let (test : - FStar_UInt32.t LowStar_Buffer.buffer -> - FStar_UInt32.t LowStar_ImmutableBuffer.ibuffer -> FStar_UInt32.t) - = - fun x -> - fun y -> - let c1 = of_buffer x in - let c2 = of_ibuffer y in - (let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' x Stdint.Uint32.zero Stdint.Uint32.one); - (let a = index c1 Stdint.Uint32.zero in - let a' = index c2 Stdint.Uint32.zero in - let c3 = sub c2 Stdint.Uint32.one () in - let a'' = index c3 Stdint.Uint32.zero in - FStar_UInt32.add (FStar_UInt32.add a a') a'') \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_Endianness.ml b/stage0/fstar-lib/generated/LowStar_Endianness.ml deleted file mode 100644 index f6479728652..00000000000 --- a/stage0/fstar-lib/generated/LowStar_Endianness.ml +++ /dev/null @@ -1,240 +0,0 @@ -open Prims -type u8 = FStar_UInt8.t -type u16 = FStar_UInt16.t -type u32 = FStar_UInt32.t -type u64 = FStar_UInt64.t -type u128 = FStar_UInt128.t -let (htole16 : FStar_UInt16.t -> FStar_UInt16.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.htole16" -let (le16toh : FStar_UInt16.t -> FStar_UInt16.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.le16toh" -let (htole32 : FStar_UInt32.t -> FStar_UInt32.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.htole32" -let (le32toh : FStar_UInt32.t -> FStar_UInt32.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.le32toh" -let (htole64 : FStar_UInt64.t -> FStar_UInt64.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.htole64" -let (le64toh : FStar_UInt64.t -> FStar_UInt64.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.le64toh" -let (htobe16 : FStar_UInt16.t -> FStar_UInt16.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.htobe16" -let (be16toh : FStar_UInt16.t -> FStar_UInt16.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.be16toh" -let (htobe32 : FStar_UInt32.t -> FStar_UInt32.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.htobe32" -let (be32toh : FStar_UInt32.t -> FStar_UInt32.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.be32toh" -let (htobe64 : FStar_UInt64.t -> FStar_UInt64.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.htobe64" -let (be64toh : FStar_UInt64.t -> FStar_UInt64.t) = - fun uu___ -> failwith "Not yet implemented: LowStar.Endianness.be64toh" -type ('a, 'rrel, 'rel, 'b, 'i, 'j, 'predicate, 'h) store_pre = unit -type ('a, 'rrel, 'rel, 'b, 'i, 'j, 'predicate, 'h0, 'uuuuu, 'h1) store_post = - unit -let store16_le_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt16.t -> unit - = - fun b -> - fun i -> - fun z -> - failwith "Not yet implemented: LowStar.Endianness.store16_le_i" -let load16_le_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt16.t - = - fun b -> - fun i -> failwith "Not yet implemented: LowStar.Endianness.load16_le_i" -let store16_be_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt16.t -> unit - = - fun b -> - fun i -> - fun z -> - failwith "Not yet implemented: LowStar.Endianness.store16_be_i" -let load16_be_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt16.t - = - fun b -> - fun i -> failwith "Not yet implemented: LowStar.Endianness.load16_be_i" -let store32_le_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> unit - = - fun b -> - fun i -> - fun z -> - failwith "Not yet implemented: LowStar.Endianness.store32_le_i" -let load32_le_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t - = - fun b -> - fun i -> failwith "Not yet implemented: LowStar.Endianness.load32_le_i" -let store32_be_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> unit - = - fun b -> - fun i -> - fun z -> - failwith "Not yet implemented: LowStar.Endianness.store32_be_i" -let load32_be_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t - = - fun b -> - fun i -> failwith "Not yet implemented: LowStar.Endianness.load32_be_i" -let store64_le_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt64.t -> unit - = - fun b -> - fun i -> - fun z -> - failwith "Not yet implemented: LowStar.Endianness.store64_le_i" -let load64_le_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt64.t - = - fun b -> - fun i -> failwith "Not yet implemented: LowStar.Endianness.load64_le_i" -let store64_be_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt64.t -> unit - = - fun b -> - fun i -> - fun z -> - failwith "Not yet implemented: LowStar.Endianness.store64_be_i" -let load64_be_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt64.t - = - fun b -> - fun i -> failwith "Not yet implemented: LowStar.Endianness.load64_be_i" -let store128_le_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt128.t -> unit - = - fun b -> - fun i -> - fun z -> - failwith "Not yet implemented: LowStar.Endianness.store128_le_i" -let load128_le_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt128.t - = - fun b -> - fun i -> failwith "Not yet implemented: LowStar.Endianness.load128_le_i" -let store128_be_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt128.t -> unit - = - fun b -> - fun i -> - fun z -> - failwith "Not yet implemented: LowStar.Endianness.store128_be_i" -let load128_be_i : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt128.t - = - fun b -> - fun i -> failwith "Not yet implemented: LowStar.Endianness.load128_be_i" -let (store16_le : - FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt16.t -> unit) = - fun b -> fun z -> store16_le_i b Stdint.Uint32.zero z -let (load16_le : FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt16.t) = - fun b -> load16_le_i b Stdint.Uint32.zero -let (store16_be : - FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt16.t -> unit) = - fun b -> fun z -> store16_be_i b Stdint.Uint32.zero z -let (load16_be : FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt16.t) = - fun b -> load16_be_i b Stdint.Uint32.zero -let (store32_le : - FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt32.t -> unit) = - fun b -> fun z -> store32_le_i b Stdint.Uint32.zero z -let (load32_le : FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt32.t) = - fun b -> load32_le_i b Stdint.Uint32.zero -let (store32_be : - FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt32.t -> unit) = - fun b -> fun z -> store32_be_i b Stdint.Uint32.zero z -let (load32_be : FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt32.t) = - fun b -> load32_be_i b Stdint.Uint32.zero -let (store64_le : - FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt64.t -> unit) = - fun b -> fun z -> store64_le_i b Stdint.Uint32.zero z -let (load64_le : FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt64.t) = - fun b -> load64_le_i b Stdint.Uint32.zero -let (load64_be : FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt64.t) = - fun b -> load64_be_i b Stdint.Uint32.zero -let (store64_be : - FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt64.t -> unit) = - fun b -> fun z -> store64_be_i b Stdint.Uint32.zero z -let (load128_le : FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt128.t) = - fun b -> load128_le_i b Stdint.Uint32.zero -let (store128_le : - FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt128.t -> unit) = - fun b -> fun z -> store128_le_i b Stdint.Uint32.zero z -let (load128_be : FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt128.t) = - fun b -> load128_be_i b Stdint.Uint32.zero -let (store128_be : - FStar_UInt8.t LowStar_Buffer.buffer -> FStar_UInt128.t -> unit) = - fun b -> fun z -> store128_be_i b Stdint.Uint32.zero z -let index_32_be : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t - = - fun b -> - fun i -> load32_be_i b (FStar_UInt32.mul (Stdint.Uint32.of_int (4)) i) -let index_32_le : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t - = - fun b -> - fun i -> load32_le_i b (FStar_UInt32.mul (Stdint.Uint32.of_int (4)) i) -let index_64_be : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt64.t - = - fun b -> - fun i -> load64_be_i b (FStar_UInt32.mul (Stdint.Uint32.of_int (8)) i) -let index_64_le : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt64.t - = - fun b -> - fun i -> load64_le_i b (FStar_UInt32.mul (Stdint.Uint32.of_int (8)) i) -let upd_32_be : - 'rrel 'rel . - (FStar_UInt8.t, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> unit - = - fun b -> - fun i -> - fun v -> - let h0 = FStar_HyperStack_ST.get () in - store32_be_i b (FStar_UInt32.mul (Stdint.Uint32.of_int (4)) i) v; - (let h1 = FStar_HyperStack_ST.get () in ()) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_ImmutableBuffer.ml b/stage0/fstar-lib/generated/LowStar_ImmutableBuffer.ml deleted file mode 100644 index 926d5ca4b8d..00000000000 --- a/stage0/fstar-lib/generated/LowStar_ImmutableBuffer.ml +++ /dev/null @@ -1,203 +0,0 @@ -open Prims -type ('a, 's1, 's2) immutable_preorder = - ('a, unit, unit) FStar_Seq_Base.equal -type 'a ibuffer = - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) LowStar_Monotonic_Buffer.mbuffer -let inull : 'a . unit -> 'a ibuffer = - fun uu___ -> LowStar_Monotonic_Buffer.mnull () -type 'a ipointer = 'a ibuffer -type 'a ipointer_or_null = 'a ibuffer -let isub : - 'a . - unit -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) LowStar_Monotonic_Buffer.mbuffer - -> - FStar_UInt32.t -> - unit -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.msub -let ioffset : - 'a . - unit -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) LowStar_Monotonic_Buffer.mbuffer - -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.moffset -type ('a, 's, 's1) cpred = ('a, unit, unit) FStar_Seq_Base.equal -type ('a, 's, 'su) seq_eq = ('a, unit, unit) FStar_Seq_Base.equal -type ('a, 'b, 's) value_is = - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder, unit, ('a, unit, unit) seq_eq) - LowStar_Monotonic_Buffer.witnessed -type ('a, 'len, 's) libuffer = - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) LowStar_Monotonic_Buffer.mbuffer -type ('a, 'len, 'r, 's) libuffer_or_null = - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) LowStar_Monotonic_Buffer.mbuffer -let igcmalloc : - 'a . - unit -> - 'a -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = - fun r -> - fun init -> - fun len -> - let b = LowStar_Monotonic_Buffer.mgcmalloc () init len in - LowStar_Monotonic_Buffer.witness_p b (); b -let igcmalloc_and_blit : - 'a . - unit -> - unit -> - unit -> - ('a, Obj.t, Obj.t) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = - fun r -> - fun rrel1 -> - fun rel1 -> - fun src -> - fun id_src -> - fun len -> - let b = - LowStar_Monotonic_Buffer.mgcmalloc_and_blit () () () src - id_src len in - let h0 = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.witness_p b (); b -let igcmalloc_partial : - 'a . - unit -> - 'a -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun r -> fun init -> fun len -> igcmalloc () init len -let imalloc : - 'a . - unit -> - 'a -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = - fun r -> - fun init -> - fun len -> - let b = LowStar_Monotonic_Buffer.mmalloc () init len in - LowStar_Monotonic_Buffer.witness_p b (); b -let imalloc_and_blit : - 'a . - unit -> - unit -> - unit -> - ('a, Obj.t, Obj.t) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = - fun r -> - fun rrel1 -> - fun rel1 -> - fun src -> - fun id_src -> - fun len -> - let b = - LowStar_Monotonic_Buffer.mmalloc_and_blit () () () src id_src - len in - let h0 = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.witness_p b (); b -let imalloc_partial : - 'a . - unit -> - 'a -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun r -> fun init -> fun len -> imalloc () init len -let ialloca : - 'a . - 'a -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = - fun init -> - fun len -> - let b = LowStar_Monotonic_Buffer.malloca init len in - LowStar_Monotonic_Buffer.witness_p b (); b -let ialloca_and_blit : - 'a 'rrel1 'rel1 . - ('a, 'rrel1, 'rel1) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> - FStar_UInt32.t -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = - fun src -> - fun id_src -> - fun len -> - let b = LowStar_Monotonic_Buffer.malloca_and_blit src id_src len in - let h0 = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.witness_p b (); b -let ialloca_of_list : - 'a . - 'a Prims.list -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) LowStar_Monotonic_Buffer.mbuffer - = - fun init -> - let b = LowStar_Monotonic_Buffer.malloca_of_list init in - LowStar_Monotonic_Buffer.witness_p b (); b -let igcmalloc_of_list : - 'a . - unit -> - 'a Prims.list -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = - fun r -> - fun init -> - let b = LowStar_Monotonic_Buffer.mgcmalloc_of_list () init in - LowStar_Monotonic_Buffer.witness_p b (); b -let igcmalloc_of_list_partial : - 'a . - unit -> - 'a Prims.list -> - ('a, ('a, unit, unit) immutable_preorder, - ('a, unit, unit) immutable_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun r -> fun init -> igcmalloc_of_list () init -let witness_contents : 'a . 'a ibuffer -> 'a FStar_Seq_Base.seq -> unit = - fun b -> fun s -> LowStar_Monotonic_Buffer.witness_p b () -let recall_contents : 'a . 'a ibuffer -> 'a FStar_Seq_Base.seq -> unit = - fun b -> fun s -> LowStar_Monotonic_Buffer.recall_p b () -let witness_value : 'a . 'a ibuffer -> unit = - fun b -> - let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.witness_p b () -let recall_value : 'a . 'a ibuffer -> unit -> unit = - fun b -> fun s -> LowStar_Monotonic_Buffer.recall_p b () \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_Modifies.ml b/stage0/fstar-lib/generated/LowStar_Modifies.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/LowStar_Modifies.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_ModifiesPat.ml b/stage0/fstar-lib/generated/LowStar_ModifiesPat.ml deleted file mode 100644 index e8306abedb2..00000000000 --- a/stage0/fstar-lib/generated/LowStar_ModifiesPat.ml +++ /dev/null @@ -1 +0,0 @@ -open Prims \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_Monotonic_Buffer.ml b/stage0/fstar-lib/generated/LowStar_Monotonic_Buffer.ml deleted file mode 100644 index 3f1f87e182f..00000000000 --- a/stage0/fstar-lib/generated/LowStar_Monotonic_Buffer.ml +++ /dev/null @@ -1,473 +0,0 @@ -open Prims -type 'a srel = unit -type ('a, 'len, 'rel, 'i, 'j, 'suburel) compatible_subseq_preorder = unit -type ('a, 'len, 'pre, 'uuuuu, 'uuuuu1) srel_to_lsrel = 'pre -type ('a, 'len, 'rel, 'i, 'j, 'suburel) compatible_sub_preorder = unit -type ('a, 'rrel, 'rel) mbuffer = - | Null - | Buffer of FStar_UInt32.t * (('a, unit) FStar_Seq_Properties.lseq, - ('a, unit, 'rrel, unit, unit) srel_to_lsrel) FStar_HyperStack_ST.mreference - * FStar_UInt32.t * unit -let uu___is_Null : 'a 'rrel 'rel . ('a, 'rrel, 'rel) mbuffer -> Prims.bool = - fun projectee -> match projectee with | Null -> true | uu___ -> false -let uu___is_Buffer : 'a 'rrel 'rel . ('a, 'rrel, 'rel) mbuffer -> Prims.bool - = - fun projectee -> - match projectee with - | Buffer (max_length, content, idx, length) -> true - | uu___ -> false -let __proj__Buffer__item__max_length : - 'a 'rrel 'rel . ('a, 'rrel, 'rel) mbuffer -> FStar_UInt32.t = - fun projectee -> - match projectee with - | Buffer (max_length, content, idx, length) -> max_length -let __proj__Buffer__item__content : - 'a 'rrel 'rel . - ('a, 'rrel, 'rel) mbuffer -> - (('a, unit) FStar_Seq_Properties.lseq, - ('a, unit, 'rrel, unit, unit) srel_to_lsrel) - FStar_HyperStack_ST.mreference - = - fun projectee -> - match projectee with - | Buffer (max_length, content, idx, length) -> content -let __proj__Buffer__item__idx : - 'a 'rrel 'rel . ('a, 'rrel, 'rel) mbuffer -> FStar_UInt32.t = - fun projectee -> - match projectee with | Buffer (max_length, content, idx, length) -> idx -let mnull : - 'uuuuu 'uuuuu1 'uuuuu2 . unit -> ('uuuuu, 'uuuuu1, 'uuuuu2) mbuffer = - fun uu___ -> Null -type ('uuuuu, 'uuuuu1, 'uuuuu2, 'b, 'h) unused_in = Obj.t -type ('t, 'rrel, 'rel, 'b) buffer_compatible = Obj.t -type ('uuuuu, 'rrel, 'rel, 'h, 'b) live = Obj.t - -type ('a, 'rrel, 'rel, 'b, 'i, 'len, 'suburel) compatible_sub = unit -type ubuffer_ = - { - b_max_length: Prims.nat ; - b_offset: Prims.nat ; - b_length: Prims.nat ; - b_is_mm: Prims.bool } -let (__proj__Mkubuffer___item__b_max_length : ubuffer_ -> Prims.nat) = - fun projectee -> - match projectee with - | { b_max_length; b_offset; b_length; b_is_mm;_} -> b_max_length -let (__proj__Mkubuffer___item__b_offset : ubuffer_ -> Prims.nat) = - fun projectee -> - match projectee with - | { b_max_length; b_offset; b_length; b_is_mm;_} -> b_offset -let (__proj__Mkubuffer___item__b_length : ubuffer_ -> Prims.nat) = - fun projectee -> - match projectee with - | { b_max_length; b_offset; b_length; b_is_mm;_} -> b_length -let (__proj__Mkubuffer___item__b_is_mm : ubuffer_ -> Prims.bool) = - fun projectee -> - match projectee with - | { b_max_length; b_offset; b_length; b_is_mm;_} -> b_is_mm -type ('region, 'addr) ubuffer' = ubuffer_ -type ('region, 'addr) ubuffer = unit - -type ('r, 'a, 'b, 'h, 'hu) ubuffer_preserved' = unit -type ('r, 'a, 'b, 'h, 'hu) ubuffer_preserved = unit - -type ('larger, 'smaller) ubuffer_includes' = unit -type ('r1, 'r2, 'a1, 'a2, 'larger, 'smaller) ubuffer_includes0 = unit -type ('r, 'a, 'larger, 'smaller) ubuffer_includes = unit -type ('x1, 'x2) ubuffer_disjoint' = Obj.t -type ('r1, 'r2, 'a1, 'a2, 'b1, 'b2) ubuffer_disjoint0 = unit -type ('r, 'a, 'b1, 'b2) ubuffer_disjoint = unit -type ('h1, 'h2) modifies_0_preserves_mreferences = unit -type ('h1, 'h2) modifies_0_preserves_regions = unit -type ('h1, 'h2) modifies_0_preserves_not_unused_in = unit -type ('h1, 'h2) modifies_0' = unit -type ('h1, 'h2) modifies_0 = unit -type ('a, 'rrel, 'rel, 'b, 'h1, 'h2) modifies_1_preserves_mreferences = unit -type ('a, 'rrel, 'rel, 'b, 'h1, 'h2) modifies_1_preserves_ubuffers = unit -type ('a, 'rrel, 'rel, 'b, 'from, 'to1, 'h1, - 'h2) modifies_1_from_to_preserves_ubuffers = unit -type ('a, 'rrel, 'rel, 'b, 'h1, 'h2) modifies_1_preserves_livenesses = unit -type ('a, 'rrel, 'rel, 'b, 'h1, 'h2) modifies_1' = unit -type ('a, 'rrel, 'rel, 'b, 'h1, 'h2) modifies_1 = unit -type ('a, 'rrel, 'rel, 'b, 'from, 'to1, 'h1, 'h2) modifies_1_from_to = Obj.t -type ('a, 'rrel, 'rel, 'b, 'h1, - 'h2) modifies_addr_of_preserves_not_unused_in = unit -type ('a, 'rrel, 'rel, 'b, 'h1, 'h2) modifies_addr_of' = unit -type ('a, 'rrel, 'rel, 'b, 'h1, 'h2) modifies_addr_of = unit -type loc = unit -type ('s1, 's2) loc_includes = unit -type ('s1, 's2) loc_disjoint = unit -type buf_t = - (unit, unit, unit, (Obj.t, Obj.t, Obj.t) mbuffer) FStar_Pervasives.dtuple4 -let buf : 'a 'rrel 'rel . ('a, 'rrel, 'rel) mbuffer -> buf_t = - fun b -> FStar_Pervasives.Mkdtuple4 ((), (), (), (Obj.magic b)) -type ('h, 'l) all_live = Obj.t -type 'l all_disjoint = Obj.t -type 'l loc_pairwise_disjoint = Obj.t -type ('s, 'h1, 'h2) modifies = unit -type ('h, 'ra) does_not_contain_addr = unit -type ('l, 'h) loc_in = unit -type ('l, 'h) loc_not_in = unit -type ('l, 'h, 'hu) fresh_loc = unit -type ('a1, 'a2, 'rrel1, 'rel1, 'rrel2, 'rel2, 'b1, 'b2) disjoint = unit -type ('a1, 'a2, 'rrel1, 'rel1, 'rrel2, 'rel2, 'b1, 'b2) includes = unit -type ('a, 'rrel, 'rel) mpointer = ('a, 'rrel, 'rel) mbuffer -type ('a, 'rrel, 'rel) mpointer_or_null = ('a, 'rrel, 'rel) mbuffer -let is_null : - 'uuuuu 'uuuuu1 'uuuuu2 . ('uuuuu, 'uuuuu1, 'uuuuu2) mbuffer -> Prims.bool = - fun b -> uu___is_Null b -let msub : - 'a 'rrel 'rel 'suburel . - ('a, 'rrel, 'rel) mbuffer -> - FStar_UInt32.t -> unit -> ('a, 'rrel, 'suburel) mbuffer - = - fun b -> - fun i -> - fun len -> - match b with - | Null -> Null - | Buffer (max_len, content, i0, len0) -> - Buffer (max_len, content, (FStar_UInt32.add i0 i), ()) -let moffset : - 'a 'rrel 'rel 'suburel . - ('a, 'rrel, 'rel) mbuffer -> - FStar_UInt32.t -> ('a, 'rrel, 'suburel) mbuffer - = - fun b -> - fun i -> - match b with - | Null -> Null - | Buffer (max_len, content, i0, len) -> - Buffer (max_len, content, (FStar_UInt32.add i0 i), ()) -let index : - 'uuuuu 'uuuuu1 'uuuuu2 . - ('uuuuu, 'uuuuu1, 'uuuuu2) mbuffer -> FStar_UInt32.t -> 'uuuuu - = - fun b -> - fun i -> - let s = FStar_HyperStack_ST.op_Bang (__proj__Buffer__item__content b) in - FStar_Seq_Base.index s - ((FStar_UInt32.v (__proj__Buffer__item__idx b)) + (FStar_UInt32.v i)) -let upd' : - 'uuuuu 'uuuuu1 'uuuuu2 . - ('uuuuu, 'uuuuu1, 'uuuuu2) mbuffer -> FStar_UInt32.t -> 'uuuuu -> unit - = - fun b -> - fun i -> - fun v -> - let h = FStar_HyperStack_ST.get () in - let uu___ = b in - match uu___ with - | Buffer (max_length, content, idx, len) -> - let s0 = FStar_HyperStack_ST.op_Bang content in - let sb0 = - FStar_Seq_Base.slice s0 (FStar_UInt32.v idx) - (FStar_UInt32.v max_length) in - let s_upd = FStar_Seq_Base.upd sb0 (FStar_UInt32.v i) v in - let sf = - FStar_Seq_Properties.replace_subseq s0 (FStar_UInt32.v idx) - (FStar_UInt32.v max_length) s_upd in - FStar_HyperStack_ST.op_Colon_Equals content sf -let upd : - 'a 'rrel 'rel . ('a, 'rrel, 'rel) mbuffer -> FStar_UInt32.t -> 'a -> unit = - fun b -> fun i -> fun v -> let h = FStar_HyperStack_ST.get () in upd' b i v -type ('a, 'rrel, 'rel, 'b) recallable = unit -type ('uuuuu, 'uuuuu1, 'uuuuu2, 'b) region_lifetime_buf = unit -type ('a, 'rrel, 'rel) rrel_rel_always_compatible = unit -let recall : - 'uuuuu 'uuuuu1 'uuuuu2 . ('uuuuu, 'uuuuu1, 'uuuuu2) mbuffer -> unit = - fun b -> - if uu___is_Null b - then () - else FStar_HyperStack_ST.recall (__proj__Buffer__item__content b) -type 'a spred = unit -type ('a, 'p, 'rel) stable_on = unit -type ('a, 'rrel, 'rel, 'b, 'p, 'h) spred_as_mempred = unit -type ('uuuuu, 'rrel, 'rel, 'b, 'p) witnessed = Obj.t -let witness_p : 'a 'rrel 'rel . ('a, 'rrel, 'rel) mbuffer -> unit -> unit = - fun b -> - fun p -> - match b with - | Null -> () - | Buffer (uu___, content, uu___1, uu___2) -> - FStar_HyperStack_ST.witness_p content () -let recall_p : - 'uuuuu 'uuuuu1 'uuuuu2 . ('uuuuu, 'uuuuu1, 'uuuuu2) mbuffer -> unit -> unit - = - fun b -> - fun p -> - match b with - | Null -> () - | Buffer (uu___, content, uu___1, uu___2) -> - FStar_HyperStack_ST.recall_p content () -let witnessed_functorial_st : - 'a 'rrel 'rel1 'rel2 . - ('a, 'rrel, 'rel1) mbuffer -> - ('a, 'rrel, 'rel2) mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> unit -> unit -> unit - = fun b1 -> fun b2 -> fun i -> fun len -> fun s1 -> fun s2 -> () -type ('a, 'rrel, 'rel, 'b) freeable = unit -let free : - 'uuuuu 'uuuuu1 'uuuuu2 . ('uuuuu, 'uuuuu1, 'uuuuu2) mbuffer -> unit = - fun b -> FStar_HyperStack_ST.rfree (__proj__Buffer__item__content b) -type ('a, 'rrel, 'rel, 'len) lmbuffer = ('a, 'rrel, 'rel) mbuffer -type ('a, 'rrel, 'rel, 'b, 'h0, 'h1, 's) alloc_post_mem_common = unit -type ('a, 'rrel, 'rel, 'len, 'r) lmbuffer_or_null = ('a, 'rrel, 'rel) mbuffer -type ('a, 'rrel, 'rel, 'b, 'h0, 'h1, 's) alloc_partial_post_mem_common = unit -type ('r, 'len) malloc_pre = unit -let alloc_heap_common : - 'a 'rrel . - unit -> - FStar_UInt32.t -> - 'a FStar_Seq_Base.seq -> Prims.bool -> ('a, 'rrel, 'rrel) mbuffer - = - fun r -> - fun len -> - fun s -> - fun mm -> - let content = - if mm - then FStar_HyperStack_ST.ralloc_mm () s - else FStar_HyperStack_ST.ralloc () s in - let b = Buffer (len, content, Stdint.Uint32.zero, ()) in b -let mgcmalloc : - 'uuuuu 'uuuuu1 . - unit -> 'uuuuu -> FStar_UInt32.t -> ('uuuuu, 'uuuuu1, 'uuuuu1) mbuffer - = - fun r -> - fun init -> - fun len -> - alloc_heap_common () len - (FStar_Seq_Base.create (FStar_UInt32.v len) init) false -let read_sub_buffer : - 'a 'rrel 'rel . - ('a, 'rrel, 'rel) mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> 'a FStar_Seq_Base.seq - = - fun b -> - fun idx -> - fun len -> - let s = FStar_HyperStack_ST.op_Bang (__proj__Buffer__item__content b) in - let s1 = - FStar_Seq_Base.slice s - (FStar_UInt32.v (__proj__Buffer__item__idx b)) - (FStar_UInt32.v (__proj__Buffer__item__max_length b)) in - FStar_Seq_Base.slice s1 (FStar_UInt32.v idx) - ((FStar_UInt32.v idx) + (FStar_UInt32.v len)) -let mgcmalloc_and_blit : - 'uuuuu 'uuuuu1 . - unit -> - unit -> - unit -> - ('uuuuu, Obj.t, Obj.t) mbuffer -> - FStar_UInt32.t -> - FStar_UInt32.t -> ('uuuuu, 'uuuuu1, 'uuuuu1) mbuffer - = - fun r -> - fun uu___ -> - fun uu___1 -> - fun src -> - fun id_src -> - fun len -> - let uu___2 = read_sub_buffer src id_src len in - alloc_heap_common () len uu___2 false -let mgcmalloc_partial : - 'a 'rrel . unit -> 'a -> FStar_UInt32.t -> ('a, 'rrel, 'rrel) mbuffer = - fun r -> fun init -> fun len -> mgcmalloc () init len -let mmalloc : - 'uuuuu 'uuuuu1 . - unit -> 'uuuuu -> FStar_UInt32.t -> ('uuuuu, 'uuuuu1, 'uuuuu1) mbuffer - = - fun r -> - fun init -> - fun len -> - alloc_heap_common () len - (FStar_Seq_Base.create (FStar_UInt32.v len) init) true -let mmalloc_and_blit : - 'uuuuu 'uuuuu1 . - unit -> - unit -> - unit -> - ('uuuuu, Obj.t, Obj.t) mbuffer -> - FStar_UInt32.t -> - FStar_UInt32.t -> ('uuuuu, 'uuuuu1, 'uuuuu1) mbuffer - = - fun r -> - fun uu___ -> - fun uu___1 -> - fun src -> - fun id_src -> - fun len -> - let uu___2 = read_sub_buffer src id_src len in - alloc_heap_common () len uu___2 true -let mmalloc_partial : - 'a 'rrel . unit -> 'a -> FStar_UInt32.t -> ('a, 'rrel, 'rrel) mbuffer = - fun r -> fun init -> fun len -> mmalloc () init len -let (alloca_pre : FStar_UInt32.t -> Prims.bool) = - fun len -> (FStar_UInt32.v len) > Prims.int_zero -let malloca : 'a 'rrel . 'a -> FStar_UInt32.t -> ('a, 'rrel, 'rrel) mbuffer = - fun init -> - fun len -> - let content = - FStar_HyperStack_ST.salloc - (FStar_Seq_Base.create (FStar_UInt32.v len) init) in - Buffer (len, content, Stdint.Uint32.zero, ()) -let malloca_and_blit : - 'a 'rrel 'uuuuu 'uuuuu1 . - ('a, 'uuuuu, 'uuuuu1) mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> ('a, 'rrel, 'rrel) mbuffer - = - fun src -> - fun id_src -> - fun len -> - let content = - let uu___ = read_sub_buffer src id_src len in - FStar_HyperStack_ST.salloc uu___ in - Buffer (len, content, Stdint.Uint32.zero, ()) -type ('a, 'init) alloca_of_list_pre = unit -let malloca_of_list : 'a 'rrel . 'a Prims.list -> ('a, 'rrel, 'rrel) mbuffer - = - fun init -> - let len = FStar_UInt32.uint_to_t (FStar_List_Tot_Base.length init) in - let s = FStar_Seq_Base.seq_of_list init in - let content = FStar_HyperStack_ST.salloc s in - Buffer (len, content, Stdint.Uint32.zero, ()) -type ('a, 'r, 'init) gcmalloc_of_list_pre = unit -let mgcmalloc_of_list : - 'a 'rrel . unit -> 'a Prims.list -> ('a, 'rrel, 'rrel) mbuffer = - fun r -> - fun init -> - let len = FStar_UInt32.uint_to_t (FStar_List_Tot_Base.length init) in - let s = FStar_Seq_Base.seq_of_list init in - let content = FStar_HyperStack_ST.ralloc () s in - Buffer (len, content, Stdint.Uint32.zero, ()) -let mgcmalloc_of_list_partial : - 'a 'rrel . unit -> 'a Prims.list -> ('a, 'rrel, 'rrel) mbuffer = - fun r -> fun init -> mgcmalloc_of_list () init -type ('h, 'd, 'len) alloc_drgn_pre = unit -let mmalloc_drgn : - 'a 'rrel . - FStar_HyperStack_ST.drgn -> - 'a -> FStar_UInt32.t -> ('a, 'rrel, 'rrel) mbuffer - = - fun d -> - fun init -> - fun len -> - let content = - FStar_HyperStack_ST.ralloc_drgn d - (FStar_Seq_Base.create (FStar_UInt32.v len) init) in - Buffer (len, content, Stdint.Uint32.zero, ()) -let mmalloc_drgn_mm : - 'a 'rrel . - FStar_HyperStack_ST.drgn -> - 'a -> FStar_UInt32.t -> ('a, 'rrel, 'rrel) mbuffer - = - fun d -> - fun init -> - fun len -> - let content = - FStar_HyperStack_ST.ralloc_drgn_mm d - (FStar_Seq_Base.create (FStar_UInt32.v len) init) in - Buffer (len, content, Stdint.Uint32.zero, ()) -let mmalloc_drgn_and_blit : - 'a 'rrel 'uuuuu 'uuuuu1 . - FStar_HyperStack_ST.drgn -> - ('a, 'uuuuu, 'uuuuu1) mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> ('a, 'rrel, 'rrel) mbuffer - = - fun d -> - fun src -> - fun id_src -> - fun len -> - let content = - let uu___ = read_sub_buffer src id_src len in - FStar_HyperStack_ST.ralloc_drgn d uu___ in - Buffer (len, content, Stdint.Uint32.zero, ()) -let blit : - 'a 'rrel1 'rrel2 'rel1 'rel2 . - ('a, 'rrel1, 'rel1) mbuffer -> - FStar_UInt32.t -> - ('a, 'rrel2, 'rel2) mbuffer -> - FStar_UInt32.t -> FStar_UInt32.t -> unit - = - fun src -> - fun idx_src -> - fun dst -> - fun idx_dst -> - fun len -> - match (src, dst) with - | (Buffer (uu___, uu___1, uu___2, uu___3), Buffer - (uu___4, uu___5, uu___6, uu___7)) -> - if len = Stdint.Uint32.zero - then () - else - (let h = FStar_HyperStack_ST.get () in - let uu___9 = src in - match uu___9 with - | Buffer (max_length1, content1, idx1, length1) -> - let uu___10 = dst in - (match uu___10 with - | Buffer (max_length2, content2, idx2, length2) -> - let s_full1 = - FStar_HyperStack_ST.op_Bang content1 in - let s_full2 = - FStar_HyperStack_ST.op_Bang content2 in - let s1 = - FStar_Seq_Base.slice s_full1 - (FStar_UInt32.v idx1) - (FStar_UInt32.v max_length1) in - let s2 = - FStar_Seq_Base.slice s_full2 - (FStar_UInt32.v idx2) - (FStar_UInt32.v max_length2) in - let s_sub_src = - FStar_Seq_Base.slice s1 - (FStar_UInt32.v idx_src) - ((FStar_UInt32.v idx_src) + - (FStar_UInt32.v len)) in - let s2' = - FStar_Seq_Properties.replace_subseq s2 - (FStar_UInt32.v idx_dst) - ((FStar_UInt32.v idx_dst) + - (FStar_UInt32.v len)) s_sub_src in - let s_full2' = - FStar_Seq_Properties.replace_subseq s_full2 - (FStar_UInt32.v idx2) - (FStar_UInt32.v max_length2) s2' in - (FStar_HyperStack_ST.op_Colon_Equals content2 - s_full2'; - (let h1 = FStar_HyperStack_ST.get () in ())))) - | (uu___, uu___1) -> () -let fill' : - 't 'rrel 'rel . ('t, 'rrel, 'rel) mbuffer -> 't -> FStar_UInt32.t -> unit = - fun b -> - fun z -> - fun len -> - if len = Stdint.Uint32.zero - then () - else - (let h = FStar_HyperStack_ST.get () in - let uu___1 = b in - match uu___1 with - | Buffer (max_length, content, idx, length) -> - let s_full = FStar_HyperStack_ST.op_Bang content in - let s = - FStar_Seq_Base.slice s_full (FStar_UInt32.v idx) - (FStar_UInt32.v max_length) in - let s_src = FStar_Seq_Base.create (FStar_UInt32.v len) z in - let s' = - FStar_Seq_Properties.replace_subseq s Prims.int_zero - (FStar_UInt32.v len) s_src in - let s_full' = - FStar_Seq_Properties.replace_subseq s_full - (FStar_UInt32.v idx) - ((FStar_UInt32.v idx) + (FStar_UInt32.v len)) s_src in - (FStar_HyperStack_ST.op_Colon_Equals content s_full'; - (let h' = FStar_HyperStack_ST.get () in ()))) -let fill : - 't 'rrel 'rel . ('t, 'rrel, 'rel) mbuffer -> 't -> FStar_UInt32.t -> unit = - fun b -> fun z -> fun len -> fill' b z len -type ('region, 'addr) abuffer' = (unit, unit) ubuffer' -type ('region, 'addr) abuffer = unit -let coerce : 't2 't1 . 't1 -> 't2 = - fun uu___ -> (fun x1 -> Obj.magic x1) uu___ \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_PrefixFreezableBuffer.ml b/stage0/fstar-lib/generated/LowStar_PrefixFreezableBuffer.ml deleted file mode 100644 index c0a81fdda4e..00000000000 --- a/stage0/fstar-lib/generated/LowStar_PrefixFreezableBuffer.ml +++ /dev/null @@ -1,75 +0,0 @@ -open Prims -type u8 = FStar_UInt8.t -type u32 = FStar_UInt32.t -let (le_to_n : u8 FStar_Seq_Base.seq -> Prims.nat) = - fun s -> FStar_Endianness.le_to_n s -let (frozen_until : u8 FStar_Seq_Base.seq -> Prims.nat) = - fun s -> le_to_n (FStar_Seq_Base.slice s Prims.int_zero (Prims.of_int (4))) -type ('s1, 's2) pre = unit -type ('uuuuu, 'uuuuu1) prefix_freezable_preorder = unit -type ('n, 's) frozen_until_at_least = unit -type ('i, 'j, 'snap, 's) slice_is = unit -type buffer = (u8, unit, unit) LowStar_Monotonic_Buffer.mbuffer -type 'len lbuffer = buffer -type ('r, 'len) malloc_pre = unit -type ('h0, 'b, 'h1) alloc_post_mem_common = unit -let (update_frozen_until_alloc : - (u8, (unit, unit) prefix_freezable_preorder, - (unit, unit) prefix_freezable_preorder) LowStar_Monotonic_Buffer.mbuffer - -> unit) - = - fun b -> - LowStar_Endianness.store32_le_i b Stdint.Uint32.zero - (Stdint.Uint32.of_int (4)); - LowStar_Monotonic_Buffer.witness_p b () -let (gcmalloc : unit -> u32 -> buffer) = - fun r -> - fun len -> - let h0 = FStar_HyperStack_ST.get () in - let b = - LowStar_Monotonic_Buffer.mgcmalloc () 0 - (FStar_UInt32.add len (Stdint.Uint32.of_int (4))) in - let h = FStar_HyperStack_ST.get () in update_frozen_until_alloc b; b -let (malloc : unit -> u32 -> buffer) = - fun r -> - fun len -> - let h0 = FStar_HyperStack_ST.get () in - let b = - LowStar_Monotonic_Buffer.mmalloc () 0 - (FStar_UInt32.add len (Stdint.Uint32.of_int (4))) in - let h = FStar_HyperStack_ST.get () in update_frozen_until_alloc b; b -type 'len alloca_pre = unit -let (alloca : u32 -> buffer) = - fun len -> - let h0 = FStar_HyperStack_ST.get () in - let b = - LowStar_Monotonic_Buffer.malloca 0 - (FStar_UInt32.add len (Stdint.Uint32.of_int (4))) in - let h = FStar_HyperStack_ST.get () in update_frozen_until_alloc b; b -let (upd : buffer -> u32 -> u8 -> unit) = - fun b -> - fun i -> - fun v -> - LowStar_Monotonic_Buffer.recall_p b (); - (let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' b i v) -let (freeze : buffer -> u32 -> unit) = - fun b -> - fun i -> - LowStar_Monotonic_Buffer.recall_p b (); - LowStar_Endianness.store32_le_i b Stdint.Uint32.zero i; - LowStar_Monotonic_Buffer.witness_p b () -let (frozen_until_st : buffer -> u32) = - fun b -> LowStar_Endianness.load32_le_i b Stdint.Uint32.zero -let (witness_slice : buffer -> u32 -> u32 -> unit -> unit) = - fun b -> - fun i -> fun j -> fun snap -> LowStar_Monotonic_Buffer.witness_p b () -let (recall_slice : buffer -> u32 -> u32 -> unit -> unit) = - fun b -> - fun i -> fun j -> fun snap -> LowStar_Monotonic_Buffer.recall_p b () -let (witness_frozen_until : buffer -> Prims.nat -> unit) = - fun b -> fun n -> LowStar_Monotonic_Buffer.witness_p b () -let (recall_frozen_until : buffer -> Prims.nat -> unit) = - fun b -> fun n -> LowStar_Monotonic_Buffer.recall_p b () -let (recall_frozen_until_default : buffer -> unit) = - fun b -> LowStar_Monotonic_Buffer.recall_p b () \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_RVector.ml b/stage0/fstar-lib/generated/LowStar_RVector.ml deleted file mode 100644 index 38e8617d63d..00000000000 --- a/stage0/fstar-lib/generated/LowStar_RVector.ml +++ /dev/null @@ -1,224 +0,0 @@ -open Prims -type ('rst, 'a, 'rg) copyable = - | Cpy of ('rst -> 'a -> 'a -> unit) -let uu___is_Cpy : - 'rst 'a . - ('rst, 'a) LowStar_Regional.regional -> - ('rst, 'a, unit) copyable -> Prims.bool - = fun rg -> fun projectee -> true -let __proj__Cpy__item__copy : - 'rst 'a . - ('rst, 'a) LowStar_Regional.regional -> - ('rst, 'a, unit) copyable -> 'rst -> 'a -> 'a -> unit - = fun rg -> fun projectee -> match projectee with | Cpy copy -> copy -type ('a, 'rst, 'rg) rvector = 'a LowStar_Vector.vector -type ('a, 'rst, 'rg, 'h, 'rs, 'i, 'j) rs_elems_inv = unit -type ('a, 'rst, 'rg, 'h, 'rv, 'i, 'j) rv_elems_inv = unit -type ('a, 'rst, 'rg, 'h, 'rv) elems_inv = unit -type ('a, 'rst, 'rg, 'rs, 'prid, 'i, 'j) rs_elems_reg = unit -type ('a, 'rst, 'rg, 'h, 'rv, 'i, 'j) rv_elems_reg = unit -type ('a, 'rst, 'rg, 'h, 'rv) elems_reg = unit -type ('a, 'rst, 'rg, 'h, 'rv) rv_itself_inv = unit -type ('a, 'rst, 'rg, 'h, 'rv) rv_inv = unit -let alloc_empty : - 'a 'rst . ('rst, 'a) LowStar_Regional.regional -> ('a, 'rst, unit) rvector - = - fun rg -> - LowStar_Vector.Vec - (Stdint.Uint32.zero, Stdint.Uint32.zero, - (LowStar_Monotonic_Buffer.mnull ())) -let rec alloc_ : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('a, 'rst, unit) rvector -> LowStar_Vector.uint32_t -> unit - = - fun rg -> - fun rv -> - fun cidx -> - let hh0 = FStar_HyperStack_ST.get () in - if cidx = Stdint.Uint32.zero - then () - else - (FStar_HyperStack_ST.new_region (); - (let v = - LowStar_Regional.__proj__Rgl__item__r_alloc rg - (LowStar_Regional.__proj__Rgl__item__state rg) () in - let hh1 = FStar_HyperStack_ST.get () in - LowStar_Vector.assign rv - (FStar_UInt32.sub cidx Stdint.Uint32.one) v; - (let hh2 = FStar_HyperStack_ST.get () in - alloc_ rg rv (FStar_UInt32.sub cidx Stdint.Uint32.one); - (let hh3 = FStar_HyperStack_ST.get () in ())))) -let alloc_rid : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - LowStar_Vector.uint32_t -> unit -> ('a, 'rst, unit) rvector - = - fun rg -> - fun len -> - fun rid -> - let vec = - LowStar_Vector.alloc_rid len - (LowStar_Regional.__proj__Rgl__item__dummy rg) () in - alloc_ rg vec len; vec -let alloc_reserve : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - LowStar_Vector.uint32_t -> unit -> ('a, 'rst, unit) rvector - = - fun rg -> - fun len -> - fun rid -> - LowStar_Vector.alloc_reserve len - (LowStar_Regional.__proj__Rgl__item__dummy rg) () -let alloc : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - LowStar_Vector.uint32_t -> ('a, 'rst, unit) rvector - = - fun rg -> fun len -> FStar_HyperStack_ST.new_region (); alloc_rid rg len () -let insert : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('a, 'rst, unit) rvector -> 'a -> ('a, 'rst, unit) rvector - = - fun rg -> - fun rv -> - fun v -> - let hh0 = FStar_HyperStack_ST.get () in - let irv = LowStar_Vector.insert rv v in - let hh1 = FStar_HyperStack_ST.get () in irv -let insert_copy : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('rst, 'a, unit) copyable -> - ('a, 'rst, unit) rvector -> 'a -> ('a, 'rst, unit) rvector - = - fun rg -> - fun cp -> - fun rv -> - fun v -> - let hh0 = FStar_HyperStack_ST.get () in - FStar_HyperStack_ST.new_region (); - (let nv = - LowStar_Regional.__proj__Rgl__item__r_alloc rg - (LowStar_Regional.__proj__Rgl__item__state rg) () in - let hh1 = FStar_HyperStack_ST.get () in - ((match cp with | Cpy copy -> copy)) - (LowStar_Regional.__proj__Rgl__item__state rg) v nv; - (let hh2 = FStar_HyperStack_ST.get () in insert rg rv nv)) -let assign : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('a, 'rst, unit) rvector -> LowStar_Vector.uint32_t -> 'a -> unit - = - fun rg -> - fun rv -> - fun i -> - fun v -> - let hh0 = FStar_HyperStack_ST.get () in - LowStar_Vector.assign rv i v; - (let hh1 = FStar_HyperStack_ST.get () in ()) -let assign_copy : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('rst, 'a, unit) copyable -> - ('a, 'rst, unit) rvector -> LowStar_Vector.uint32_t -> 'a -> unit - = - fun rg -> - fun cp -> - fun rv -> - fun i -> - fun v -> - let hh0 = FStar_HyperStack_ST.get () in - (let uu___1 = LowStar_Vector.index rv i in - (match cp with | Cpy copy -> copy) - (LowStar_Regional.__proj__Rgl__item__state rg) v uu___1); - (let hh1 = FStar_HyperStack_ST.get () in ()) -let rec free_elems : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('a, 'rst, unit) rvector -> LowStar_Vector.uint32_t -> unit - = - fun rg -> - fun rv -> - fun idx -> - let hh0 = FStar_HyperStack_ST.get () in - (let uu___1 = LowStar_Vector.index rv idx in - LowStar_Regional.__proj__Rgl__item__r_free rg - (LowStar_Regional.__proj__Rgl__item__state rg) uu___1); - (let hh1 = FStar_HyperStack_ST.get () in - if idx <> Stdint.Uint32.zero - then free_elems rg rv (FStar_UInt32.sub idx Stdint.Uint32.one) - else ()) -let flush : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('a, 'rst, unit) rvector -> - LowStar_Vector.uint32_t -> ('a, 'rst, unit) rvector - = - fun rg -> - fun rv -> - fun i -> - let hh0 = FStar_HyperStack_ST.get () in - if i = Stdint.Uint32.zero - then () - else free_elems rg rv (FStar_UInt32.sub i Stdint.Uint32.one); - (let hh1 = FStar_HyperStack_ST.get () in - let frv = - LowStar_Vector.flush rv - (LowStar_Regional.__proj__Rgl__item__dummy rg) i in - let hh2 = FStar_HyperStack_ST.get () in frv) -let rec free_elems_from : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('a, 'rst, unit) rvector -> LowStar_Vector.uint32_t -> unit - = - fun rg -> - fun rv -> - fun idx -> - let hh0 = FStar_HyperStack_ST.get () in - (let uu___1 = LowStar_Vector.index rv idx in - LowStar_Regional.__proj__Rgl__item__r_free rg - (LowStar_Regional.__proj__Rgl__item__state rg) uu___1); - (let hh1 = FStar_HyperStack_ST.get () in - if - FStar_UInt32.lt (FStar_UInt32.add idx Stdint.Uint32.one) - (match rv with | LowStar_Vector.Vec (sz, cap, vs) -> sz) - then free_elems_from rg rv (FStar_UInt32.add idx Stdint.Uint32.one) - else ()) -let shrink : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - ('a, 'rst, unit) rvector -> - LowStar_Vector.uint32_t -> ('a, 'rst, unit) rvector - = - fun rg -> - fun rv -> - fun new_size -> - let size = match rv with | LowStar_Vector.Vec (sz, cap, vs) -> sz in - let hh0 = FStar_HyperStack_ST.get () in - if FStar_UInt32.gte new_size size - then rv - else - (free_elems_from rg rv new_size; - (let hh1 = FStar_HyperStack_ST.get () in - let frv = LowStar_Vector.shrink rv new_size in - let hh2 = FStar_HyperStack_ST.get () in frv)) -let free : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> ('a, 'rst, unit) rvector -> unit - = - fun rg -> - fun rv -> - let hh0 = FStar_HyperStack_ST.get () in - if - (match rv with | LowStar_Vector.Vec (sz, cap, vs) -> sz) = - Stdint.Uint32.zero - then () - else - free_elems rg rv - (FStar_UInt32.sub - (match rv with | LowStar_Vector.Vec (sz, cap, vs) -> sz) - Stdint.Uint32.one); - (let hh1 = FStar_HyperStack_ST.get () in LowStar_Vector.free rv) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_Regional.ml b/stage0/fstar-lib/generated/LowStar_Regional.ml deleted file mode 100644 index c4e2d313087..00000000000 --- a/stage0/fstar-lib/generated/LowStar_Regional.ml +++ /dev/null @@ -1,45 +0,0 @@ -open Prims -type ('st, 'a) regional = - | Rgl of 'st * unit * unit * 'a * unit * unit * unit * unit * unit * unit * - unit * ('st -> unit -> 'a) * ('st -> 'a -> unit) -let uu___is_Rgl : 'st 'a . ('st, 'a) regional -> Prims.bool = - fun projectee -> true -let __proj__Rgl__item__state : 'st 'a . ('st, 'a) regional -> 'st = - fun projectee -> - match projectee with - | Rgl - (state, region_of, loc_of, dummy, r_inv, r_inv_reg, repr, r_repr, - r_sep, irepr, r_alloc_p, r_alloc, r_free) - -> state -let __proj__Rgl__item__dummy : 'st 'a . ('st, 'a) regional -> 'a = - fun projectee -> - match projectee with - | Rgl - (state, region_of, loc_of, dummy, r_inv, r_inv_reg, repr, r_repr, - r_sep, irepr, r_alloc_p, r_alloc, r_free) - -> dummy -let __proj__Rgl__item__r_alloc : - 'st 'a . ('st, 'a) regional -> 'st -> unit -> 'a = - fun projectee -> - match projectee with - | Rgl - (state, region_of, loc_of, dummy, r_inv, r_inv_reg, repr, r_repr, - r_sep, irepr, r_alloc_p, r_alloc, r_free) - -> r_alloc -let __proj__Rgl__item__r_free : - 'st 'a . ('st, 'a) regional -> 'st -> 'a -> unit = - fun projectee -> - match projectee with - | Rgl - (state, region_of, loc_of, dummy, r_inv, r_inv_reg, repr, r_repr, - r_sep, irepr, r_alloc_p, r_alloc, r_free) - -> r_free -type ('a, 'rst, 'rg, 'uuuuu, 'uuuuu1) rg_inv = Obj.t -let rg_dummy : 'a 'rst . ('rst, 'a) regional -> 'a = - fun rg -> __proj__Rgl__item__dummy rg -let rg_alloc : 'a 'rst . ('rst, 'a) regional -> unit -> 'a = - fun rg -> - fun r -> __proj__Rgl__item__r_alloc rg (__proj__Rgl__item__state rg) () -let rg_free : 'a 'rst . ('rst, 'a) regional -> 'a -> unit = - fun rg -> - fun v -> __proj__Rgl__item__r_free rg (__proj__Rgl__item__state rg) v \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_Regional_Instances.ml b/stage0/fstar-lib/generated/LowStar_Regional_Instances.ml deleted file mode 100644 index 88d0cd3f401..00000000000 --- a/stage0/fstar-lib/generated/LowStar_Regional_Instances.ml +++ /dev/null @@ -1,84 +0,0 @@ -open Prims -let buffer_dummy : 'uuuuu . unit -> 'uuuuu LowStar_Buffer.buffer = - fun uu___ -> LowStar_Monotonic_Buffer.mnull () -type nonzero = FStar_UInt32.t -type ('a, 'len, 'h, 'v) buffer_r_inv = unit -type ('a, 'len) buffer_repr = 'a FStar_Seq_Base.seq -type ('a, 'v) buffer_r_alloc_p = unit -let buffer_r_alloc : - 'a . unit -> ('a * nonzero) -> unit -> 'a LowStar_Buffer.buffer = - fun uu___ -> - fun uu___1 -> - fun r -> - match uu___1 with - | (ia, len) -> LowStar_Monotonic_Buffer.mmalloc () ia len -let buffer_r_free : - 'a . unit -> ('a * nonzero) -> 'a LowStar_Buffer.buffer -> unit = - fun uu___ -> fun len -> fun v -> LowStar_Monotonic_Buffer.free v -let buffer_copy : - 'a . - unit -> - ('a * nonzero) -> - 'a LowStar_Buffer.buffer -> 'a LowStar_Buffer.buffer -> unit - = - fun uu___ -> - fun uu___1 -> - fun src -> - fun dst -> - match uu___1 with - | (ia, len) -> - LowStar_Monotonic_Buffer.blit src Stdint.Uint32.zero dst - Stdint.Uint32.zero len -let buffer_regional : - 'a . - 'a -> - nonzero -> - (('a * nonzero), 'a LowStar_Buffer.buffer) LowStar_Regional.regional - = - fun ia -> - fun len -> - LowStar_Regional.Rgl - ((ia, len), (), (), (buffer_dummy ()), (), (), (), (), (), (), (), - (buffer_r_alloc ()), (buffer_r_free ())) -let buffer_copyable : - 'a . - 'a -> - nonzero -> - (('a * nonzero), 'a LowStar_Buffer.buffer, unit) - LowStar_RVector.copyable - = fun ia -> fun len -> LowStar_RVector.Cpy (buffer_copy ()) -let vector_dummy : - 'a 'uuuuu . unit -> ('a, 'uuuuu, unit) LowStar_RVector.rvector = - fun uu___ -> - LowStar_Vector.Vec - (Stdint.Uint32.zero, Stdint.Uint32.zero, - (LowStar_Monotonic_Buffer.mnull ())) -type ('a, 'rst, 'rg, 'h, 'v) vector_r_inv = unit -type ('a, 'rst, 'rg) vector_repr = unit FStar_Seq_Base.seq -type ('a, 'rst, 'rg, 'v) vector_r_alloc_p = unit -let vector_r_alloc : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - unit -> ('a, 'rst, unit) LowStar_RVector.rvector - = - fun rg -> - fun r -> - FStar_HyperStack_ST.new_region (); - LowStar_Vector.alloc_reserve Stdint.Uint32.one - (LowStar_Regional.__proj__Rgl__item__dummy rg) () -let vector_r_free : - 'uuuuu 'uuuuu1 . - unit -> - ('uuuuu1, 'uuuuu) LowStar_Regional.regional -> - ('uuuuu, 'uuuuu1, unit) LowStar_RVector.rvector -> unit - = fun uu___ -> fun uu___1 -> fun v -> LowStar_Vector.free v -let vector_regional : - 'a 'rst . - ('rst, 'a) LowStar_Regional.regional -> - (('rst, 'a) LowStar_Regional.regional, - ('a, 'rst, unit) LowStar_RVector.rvector) LowStar_Regional.regional - = - fun rg -> - LowStar_Regional.Rgl - (rg, (), (), (vector_dummy ()), (), (), (), (), (), (), (), - vector_r_alloc, (vector_r_free ())) \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_UninitializedBuffer.ml b/stage0/fstar-lib/generated/LowStar_UninitializedBuffer.ml deleted file mode 100644 index 24e8950e216..00000000000 --- a/stage0/fstar-lib/generated/LowStar_UninitializedBuffer.ml +++ /dev/null @@ -1,106 +0,0 @@ -open Prims -type ('a, 's1, 's2) initialization_preorder = unit -type 'a ubuffer = - ('a FStar_Pervasives_Native.option, unit, unit) - LowStar_Monotonic_Buffer.mbuffer -let unull : 'a . unit -> 'a ubuffer = - fun uu___ -> LowStar_Monotonic_Buffer.mnull () -type 'a pointer = 'a ubuffer -type 'a pointer_or_null = 'a ubuffer -let usub : - 'a . - unit -> - ('a FStar_Pervasives_Native.option, - ('a, unit, unit) initialization_preorder, - ('a, unit, unit) initialization_preorder) - LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> - unit -> - ('a FStar_Pervasives_Native.option, - ('a, unit, unit) initialization_preorder, - ('a, unit, unit) initialization_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.msub -let uoffset : - 'a . - unit -> - ('a FStar_Pervasives_Native.option, - ('a, unit, unit) initialization_preorder, - ('a, unit, unit) initialization_preorder) - LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> - ('a FStar_Pervasives_Native.option, - ('a, unit, unit) initialization_preorder, - ('a, unit, unit) initialization_preorder) - LowStar_Monotonic_Buffer.mbuffer - = fun uu___ -> LowStar_Monotonic_Buffer.moffset -type ('a, 'i, 's) ipred = unit -type ('a, 'b, 'i) initialized_at = - ('a FStar_Pervasives_Native.option, unit, unit, unit, unit) - LowStar_Monotonic_Buffer.witnessed -let uindex : 'a . 'a ubuffer -> FStar_UInt32.t -> 'a = - fun b -> - fun i -> - let y_opt = LowStar_Monotonic_Buffer.index b i in - LowStar_Monotonic_Buffer.recall_p b (); - FStar_Pervasives_Native.__proj__Some__item__v y_opt -let uupd : 'a . 'a ubuffer -> FStar_UInt32.t -> 'a -> unit = - fun b -> - fun i -> - fun v -> - (let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' b i (FStar_Pervasives_Native.Some v)); - LowStar_Monotonic_Buffer.witness_p b () -type ('a, 'len) lubuffer = 'a ubuffer -type ('a, 'len, 'r) lubuffer_or_null = 'a ubuffer -let ugcmalloc : 'a . unit -> FStar_UInt32.t -> 'a ubuffer = - fun r -> - fun len -> - LowStar_Monotonic_Buffer.mgcmalloc () FStar_Pervasives_Native.None len -let ugcmalloc_partial : 'a . unit -> FStar_UInt32.t -> 'a ubuffer = - fun r -> - fun len -> - LowStar_Monotonic_Buffer.mgcmalloc () FStar_Pervasives_Native.None len -let umalloc : 'a . unit -> FStar_UInt32.t -> 'a ubuffer = - fun r -> - fun len -> - LowStar_Monotonic_Buffer.mmalloc () FStar_Pervasives_Native.None len -let umalloc_partial : 'a . unit -> FStar_UInt32.t -> 'a ubuffer = - fun r -> - fun len -> - LowStar_Monotonic_Buffer.mmalloc () FStar_Pervasives_Native.None len -let ualloca : 'a . FStar_UInt32.t -> 'a ubuffer = - fun len -> - LowStar_Monotonic_Buffer.malloca FStar_Pervasives_Native.None len -type ('a, 'rrel, 'rel, 'src, 'idxusrc, 'dst, 'idxudst, 'j) valid_j_for_blit = - unit -type ('a, 'rrel, 'rel, 'src, 'idxusrc, 'dst, 'idxudst, 'j, 'h0, - 'h1) ublit_post_j = unit -let ublit : - 'a 'rrel 'rel . - ('a, 'rrel, 'rel) LowStar_Monotonic_Buffer.mbuffer -> - FStar_UInt32.t -> - 'a ubuffer -> FStar_UInt32.t -> FStar_UInt32.t -> unit - = - fun src -> - fun idx_src -> - fun dst -> - fun idx_dst -> - fun len -> - let rec aux j = - if j = len - then () - else - if FStar_UInt32.lt j len - then - ((let uu___2 = - LowStar_Monotonic_Buffer.index src - (FStar_UInt32.add idx_src j) in - uupd dst (FStar_UInt32.add idx_dst j) uu___2); - aux (FStar_UInt32.add j Stdint.Uint32.one)) - else () in - aux Stdint.Uint32.zero -let witness_initialized : 'a . 'a ubuffer -> Prims.nat -> unit = - fun b -> fun i -> LowStar_Monotonic_Buffer.witness_p b () -let recall_initialized : 'a . 'a ubuffer -> Prims.nat -> unit = - fun b -> fun i -> LowStar_Monotonic_Buffer.recall_p b () \ No newline at end of file diff --git a/stage0/fstar-lib/generated/LowStar_Vector.ml b/stage0/fstar-lib/generated/LowStar_Vector.ml deleted file mode 100644 index 022f29b49e0..00000000000 --- a/stage0/fstar-lib/generated/LowStar_Vector.ml +++ /dev/null @@ -1,165 +0,0 @@ -open Prims -type uint32_t = FStar_UInt32.t -let (max_uint32 : uint32_t) = (Stdint.Uint32.of_string "4294967295") -type 'a vector_str = - | Vec of uint32_t * uint32_t * 'a LowStar_Buffer.buffer -let uu___is_Vec : 'a . 'a vector_str -> Prims.bool = fun projectee -> true -let __proj__Vec__item__sz : 'a . 'a vector_str -> uint32_t = - fun projectee -> match projectee with | Vec (sz, cap, vs) -> sz -let __proj__Vec__item__cap : 'a . 'a vector_str -> uint32_t = - fun projectee -> match projectee with | Vec (sz, cap, vs) -> cap -let __proj__Vec__item__vs : 'a . 'a vector_str -> 'a LowStar_Buffer.buffer = - fun projectee -> match projectee with | Vec (sz, cap, vs) -> vs -type 'a vector = 'a vector_str -let size_of : 'a . 'a vector -> uint32_t = - fun vec -> match vec with | Vec (sz, cap, vs) -> sz -let capacity_of : 'a . 'a vector -> uint32_t = - fun vec -> match vec with | Vec (sz, cap, vs) -> cap -let is_empty : 'a . 'a vector -> Prims.bool = - fun vec -> (match vec with | Vec (sz, cap, vs) -> sz) = Stdint.Uint32.zero -type ('a, 'h, 'vec) live = - ('a, unit, unit, unit, unit) LowStar_Monotonic_Buffer.live -type ('a, 'vec) freeable = - ('a, unit, unit, unit) LowStar_Monotonic_Buffer.freeable - -type ('h0, 'h1) hmap_dom_eq = (unit, unit, unit) FStar_Set.equal -let alloc_empty : 'a . unit -> 'a vector = - fun uu___ -> - Vec - (Stdint.Uint32.zero, Stdint.Uint32.zero, - (LowStar_Monotonic_Buffer.mnull ())) -let alloc_rid : 'a . uint32_t -> 'a -> unit -> 'a vector = - fun len -> - fun v -> - fun rid -> - let uu___ = LowStar_Monotonic_Buffer.mmalloc () v len in - Vec (len, len, uu___) -let alloc : 'a . uint32_t -> 'a -> 'a vector = - fun len -> fun v -> alloc_rid len v () -let alloc_reserve : 'a . uint32_t -> 'a -> unit -> 'a vector = - fun len -> - fun ia -> - fun rid -> - let uu___ = LowStar_Monotonic_Buffer.mmalloc () ia len in - Vec (Stdint.Uint32.zero, len, uu___) -let alloc_by_buffer : 'a . uint32_t -> 'a LowStar_Buffer.buffer -> 'a vector - = fun len -> fun buf -> Vec (len, len, buf) -let free : 'a . 'a vector -> unit = - fun vec -> - LowStar_Monotonic_Buffer.free (match vec with | Vec (sz, cap, vs) -> vs) -let index : 'a . 'a vector -> uint32_t -> 'a = - fun vec -> - fun i -> - LowStar_Monotonic_Buffer.index - (match vec with | Vec (sz, cap, vs) -> vs) i -let front : 'a . 'a vector -> 'a = - fun vec -> - LowStar_Monotonic_Buffer.index (match vec with | Vec (sz, cap, vs) -> vs) - Stdint.Uint32.zero -let back : 'a . 'a vector -> 'a = - fun vec -> - LowStar_Monotonic_Buffer.index (match vec with | Vec (sz, cap, vs) -> vs) - (FStar_UInt32.sub (match vec with | Vec (sz, cap, vs) -> sz) - Stdint.Uint32.one) -let clear : 'a . 'a vector -> 'a vector = - fun vec -> - Vec - (Stdint.Uint32.zero, (match vec with | Vec (sz, cap, vs) -> cap), - (match vec with | Vec (sz, cap, vs) -> vs)) -let assign : 'a . 'a vector -> uint32_t -> 'a -> unit = - fun vec -> - fun i -> - fun v -> - let hh0 = FStar_HyperStack_ST.get () in - (let uu___1 = - LowStar_Monotonic_Buffer.msub - (match vec with | Vec (sz, cap, vs) -> vs) i () in - let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' uu___1 Stdint.Uint32.zero v); - (let hh1 = FStar_HyperStack_ST.get () in ()) -let (resize_ratio : uint32_t) = (Stdint.Uint32.of_int (2)) -let (new_capacity : uint32_t -> uint32_t) = - fun cap -> - if FStar_UInt32.gte cap (FStar_UInt32.div max_uint32 resize_ratio) - then max_uint32 - else - if cap = Stdint.Uint32.zero - then Stdint.Uint32.one - else FStar_UInt32.mul cap resize_ratio -let insert : 'a . 'a vector -> 'a -> 'a vector = - fun vec -> - fun v -> - let sz = match vec with | Vec (sz1, cap, vs) -> sz1 in - let cap = match vec with | Vec (sz1, cap1, vs) -> cap1 in - let vs = match vec with | Vec (sz1, cap1, vs1) -> vs1 in - if sz = cap - then - let ncap = new_capacity cap in - let nvs = LowStar_Monotonic_Buffer.mmalloc () v ncap in - (LowStar_Monotonic_Buffer.blit vs Stdint.Uint32.zero nvs - Stdint.Uint32.zero sz; - (let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' nvs sz v); - LowStar_Monotonic_Buffer.free vs; - Vec ((FStar_UInt32.add sz Stdint.Uint32.one), ncap, nvs)) - else - ((let h = FStar_HyperStack_ST.get () in - LowStar_Monotonic_Buffer.upd' vs sz v); - Vec ((FStar_UInt32.add sz Stdint.Uint32.one), cap, vs)) -let flush : 'a . 'a vector -> 'a -> uint32_t -> 'a vector = - fun vec -> - fun ia -> - fun i -> - let fsz = - FStar_UInt32.sub (match vec with | Vec (sz, cap, vs) -> sz) i in - let asz = - if (match vec with | Vec (sz, cap, vs) -> sz) = i - then Stdint.Uint32.one - else fsz in - let vs = match vec with | Vec (sz, cap, vs1) -> vs1 in - let fvs = LowStar_Monotonic_Buffer.mmalloc () ia asz in - LowStar_Monotonic_Buffer.blit vs i fvs Stdint.Uint32.zero fsz; - LowStar_Monotonic_Buffer.free vs; - Vec (fsz, asz, fvs) -let shrink : 'a . 'a vector -> uint32_t -> 'a vector = - fun vec -> - fun new_size -> - Vec - (new_size, (match vec with | Vec (sz, cap, vs) -> cap), - (match vec with | Vec (sz, cap, vs) -> vs)) -let rec fold_left_buffer : - 'a 'b . - uint32_t -> 'a LowStar_Buffer.buffer -> ('b -> 'a -> 'b) -> 'b -> 'b - = - fun len -> - fun buf -> - fun f -> - fun ib -> - if len = Stdint.Uint32.zero - then ib - else - (let uu___1 = - LowStar_Monotonic_Buffer.msub buf Stdint.Uint32.one () in - let uu___2 = - let uu___3 = - LowStar_Monotonic_Buffer.index buf Stdint.Uint32.zero in - f ib uu___3 in - fold_left_buffer (FStar_UInt32.sub len Stdint.Uint32.one) uu___1 - f uu___2) -let fold_left : 'a 'b . 'a vector -> ('b -> 'a -> 'b) -> 'b -> 'b = - fun vec -> - fun f -> - fun ib -> - let uu___ = - LowStar_Monotonic_Buffer.msub - (match vec with | Vec (sz, cap, vs) -> vs) Stdint.Uint32.zero () in - fold_left_buffer (match vec with | Vec (sz, cap, vs) -> sz) uu___ f - ib -type ('a, 'seq, 'i, 'j, 'p) forall_seq = unit -type ('a, 'h, 'buf, 'i, 'j, 'p) forall_buffer = unit -type ('a, 'h, 'vec, 'i, 'j, 'p) forall_ = unit -type ('a, 'h, 'vec, 'p) forall_all = unit -type ('a, 'seq, 'i, 'j, 'p) forall2_seq = unit -type ('a, 'h, 'buf, 'i, 'j, 'p) forall2_buffer = unit -type ('a, 'h, 'vec, 'i, 'j, 'p) forall2 = unit -type ('a, 'h, 'vec, 'p) forall2_all = unit \ No newline at end of file diff --git a/stage0/fstar-tests/FStar_Tests_Main.ml b/stage0/fstar-tests/FStar_Tests_Main.ml deleted file mode 100644 index 8d5d9998d29..00000000000 --- a/stage0/fstar-tests/FStar_Tests_Main.ml +++ /dev/null @@ -1,3 +0,0 @@ -let _ = - Printexc.record_backtrace true; - FStarC_Tests_Test.main () diff --git a/stage0/fstar-tests/dune b/stage0/fstar-tests/dune deleted file mode 100644 index 6f48664b6a5..00000000000 --- a/stage0/fstar-tests/dune +++ /dev/null @@ -1,12 +0,0 @@ -(include_subdirs unqualified) -(executable - (name FStar_Tests_Main) - (public_name fstar_tests.exe) - (libraries - fstar_lib - ) - (modes (native exe)) - (enabled_if - (= %{profile} test) - ) -) diff --git a/stage0/fstar-tests/generated/FStarC_Tests_Data.ml b/stage0/fstar-tests/generated/FStarC_Tests_Data.ml deleted file mode 100644 index e8d6506bdb1..00000000000 --- a/stage0/fstar-tests/generated/FStarC_Tests_Data.ml +++ /dev/null @@ -1,164 +0,0 @@ -open Prims -let rec insert : - 'set . - Prims.int -> - (Prims.int, 'set) FStarC_Class_Setlike.setlike -> 'set -> 'set - = - fun n -> - fun uu___ -> - fun s -> - if n = Prims.int_zero - then s - else - (let uu___2 = - Obj.magic - (FStarC_Class_Setlike.add () (Obj.magic uu___) n (Obj.magic s)) in - insert (n - Prims.int_one) uu___ uu___2) -let rec all_mem : - 'set . - Prims.int -> - (Prims.int, 'set) FStarC_Class_Setlike.setlike -> 'set -> Prims.bool - = - fun n -> - fun uu___ -> - fun s -> - if n = Prims.int_zero - then true - else - (FStarC_Class_Setlike.mem () (Obj.magic uu___) n (Obj.magic s)) && - (all_mem (n - Prims.int_one) uu___ s) -let rec all_remove : - 'set . - Prims.int -> - (Prims.int, 'set) FStarC_Class_Setlike.setlike -> 'set -> 'set - = - fun n -> - fun uu___ -> - fun s -> - if n = Prims.int_zero - then s - else - (let uu___2 = - Obj.magic - (FStarC_Class_Setlike.remove () (Obj.magic uu___) n - (Obj.magic s)) in - all_remove (n - Prims.int_one) uu___ uu___2) -let (nn : Prims.int) = (Prims.of_int (10000)) -let (run_all : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Util.print_string "data tests\n"; - (let uu___2 = - FStarC_Compiler_Util.record_time_ms - (fun uu___3 -> - let uu___4 = - Obj.magic - (FStarC_Class_Setlike.empty () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Class_Ord.ord_int)) ()) in - insert nn - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Class_Ord.ord_int) uu___4) in - match uu___2 with - | (f, ms) -> - ((let uu___4 = - FStarC_Class_Show.show FStarC_Class_Show.showable_int ms in - FStarC_Compiler_Util.print1 "FlatSet insert: %s\n" uu___4); - (let uu___4 = - FStarC_Compiler_Util.record_time_ms - (fun uu___5 -> - all_mem nn - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Class_Ord.ord_int) f) in - match uu___4 with - | (f_ok, ms1) -> - ((let uu___6 = - FStarC_Class_Show.show FStarC_Class_Show.showable_int ms1 in - FStarC_Compiler_Util.print1 "FlatSet all_mem: %s\n" uu___6); - (let uu___6 = - FStarC_Compiler_Util.record_time_ms - (fun uu___7 -> - all_remove nn - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Class_Ord.ord_int) f) in - match uu___6 with - | (f1, ms2) -> - ((let uu___8 = - FStarC_Class_Show.show - FStarC_Class_Show.showable_int ms2 in - FStarC_Compiler_Util.print1 "FlatSet all_remove: %s\n" - uu___8); - if Prims.op_Negation f_ok - then failwith "FlatSet all_mem failed" - else (); - (let uu___10 = - let uu___11 = - FStarC_Class_Setlike.is_empty () - (Obj.magic - (FStarC_Compiler_FlatSet.setlike_flat_set - FStarC_Class_Ord.ord_int)) (Obj.magic f1) in - Prims.op_Negation uu___11 in - if uu___10 - then failwith "FlatSet all_remove failed" - else ()); - (let uu___10 = - FStarC_Compiler_Util.record_time_ms - (fun uu___11 -> - let uu___12 = - Obj.magic - (FStarC_Class_Setlike.empty () - (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_int)) ()) in - insert nn - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_int) uu___12) in - match uu___10 with - | (rb, ms3) -> - ((let uu___12 = - FStarC_Class_Show.show - FStarC_Class_Show.showable_int ms3 in - FStarC_Compiler_Util.print1 "RBSet insert: %s\n" - uu___12); - (let uu___12 = - FStarC_Compiler_Util.record_time_ms - (fun uu___13 -> - all_mem nn - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_int) rb) in - match uu___12 with - | (rb_ok, ms4) -> - ((let uu___14 = - FStarC_Class_Show.show - FStarC_Class_Show.showable_int ms4 in - FStarC_Compiler_Util.print1 - "RBSet all_mem: %s\n" uu___14); - (let uu___14 = - FStarC_Compiler_Util.record_time_ms - (fun uu___15 -> - all_remove nn - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_int) rb) in - match uu___14 with - | (rb1, ms5) -> - ((let uu___16 = - FStarC_Class_Show.show - FStarC_Class_Show.showable_int - ms5 in - FStarC_Compiler_Util.print1 - "RBSet all_remove: %s\n" uu___16); - if Prims.op_Negation rb_ok - then failwith "RBSet all_mem failed" - else (); - (let uu___18 = - let uu___19 = - FStarC_Class_Setlike.is_empty () - (Obj.magic - (FStarC_Compiler_RBSet.setlike_rbset - FStarC_Class_Ord.ord_int)) - (Obj.magic rb1) in - Prims.op_Negation uu___19 in - if uu___18 - then - failwith "RBSet all_remove failed" - else ()))))))))))))) \ No newline at end of file diff --git a/stage0/fstar-tests/generated/FStarC_Tests_Norm.ml b/stage0/fstar-tests/generated/FStarC_Tests_Norm.ml deleted file mode 100644 index ebf6e55828d..00000000000 --- a/stage0/fstar-tests/generated/FStarC_Tests_Norm.ml +++ /dev/null @@ -1,1487 +0,0 @@ -open Prims -let (b : FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.binder) = - FStarC_Syntax_Syntax.mk_binder -let (id : FStarC_Syntax_Syntax.term) = FStarC_Tests_Pars.pars "fun x -> x" -let (apply : FStarC_Syntax_Syntax.term) = - FStarC_Tests_Pars.pars "fun f x -> f x" -let (twice : FStarC_Syntax_Syntax.term) = - FStarC_Tests_Pars.pars "fun f x -> f (f x)" -let (tt : FStarC_Syntax_Syntax.term) = FStarC_Tests_Pars.pars "fun x y -> x" -let (ff : FStarC_Syntax_Syntax.term) = FStarC_Tests_Pars.pars "fun x y -> y" -let (z : FStarC_Syntax_Syntax.term) = FStarC_Tests_Pars.pars "fun f x -> x" -let (one : FStarC_Syntax_Syntax.term) = - FStarC_Tests_Pars.pars "fun f x -> f x" -let (two : FStarC_Syntax_Syntax.term) = - FStarC_Tests_Pars.pars "fun f x -> f (f x)" -let (succ : FStarC_Syntax_Syntax.term) = - FStarC_Tests_Pars.pars "fun n f x -> f (n f x)" -let (pred : FStarC_Syntax_Syntax.term) = - FStarC_Tests_Pars.pars - "fun n f x -> n (fun g h -> h (g f)) (fun y -> x) (fun y -> y)" -let (mul : FStarC_Syntax_Syntax.term) = - FStarC_Tests_Pars.pars "fun m n f -> m (n f)" -let rec (encode : Prims.int -> FStarC_Syntax_Syntax.term) = - fun n -> - if n = Prims.int_zero - then z - else - (let uu___1 = let uu___2 = encode (n - Prims.int_one) in [uu___2] in - FStarC_Tests_Util.app succ uu___1) -let (minus : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = fun m -> fun n -> FStarC_Tests_Util.app n [pred; m] -let (let_ : - FStarC_Syntax_Syntax.bv -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term) - = - fun x -> - fun e -> - fun e' -> - let uu___ = - let uu___1 = let uu___2 = b x in [uu___2] in - FStarC_Syntax_Util.abs uu___1 e' FStar_Pervasives_Native.None in - FStarC_Tests_Util.app uu___ [e] -let (mk_let : - FStarC_Syntax_Syntax.bv -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) - = - fun x -> - fun e -> - fun e' -> - let e'1 = - FStarC_Syntax_Subst.subst - [FStarC_Syntax_Syntax.NM (x, Prims.int_zero)] e' in - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_let - { - FStarC_Syntax_Syntax.lbs = - (false, - [{ - FStarC_Syntax_Syntax.lbname = (FStar_Pervasives.Inl x); - FStarC_Syntax_Syntax.lbunivs = []; - FStarC_Syntax_Syntax.lbtyp = FStarC_Syntax_Syntax.tun; - FStarC_Syntax_Syntax.lbeff = - FStarC_Parser_Const.effect_Tot_lid; - FStarC_Syntax_Syntax.lbdef = e; - FStarC_Syntax_Syntax.lbattrs = []; - FStarC_Syntax_Syntax.lbpos = - FStarC_Compiler_Range_Type.dummyRange - }]); - FStarC_Syntax_Syntax.body1 = e'1 - }) FStarC_Compiler_Range_Type.dummyRange -let (lid : Prims.string -> FStarC_Ident.lident) = - fun x -> - FStarC_Ident.lid_of_path ["Test"; x] - FStarC_Compiler_Range_Type.dummyRange -let (znat_l : FStarC_Syntax_Syntax.fv) = - let uu___ = lid "Z" in - FStarC_Syntax_Syntax.lid_as_fv uu___ - (FStar_Pervasives_Native.Some FStarC_Syntax_Syntax.Data_ctor) -let (snat_l : FStarC_Syntax_Syntax.fv) = - let uu___ = lid "S" in - FStarC_Syntax_Syntax.lid_as_fv uu___ - (FStar_Pervasives_Native.Some FStarC_Syntax_Syntax.Data_ctor) -let (tm_fv : - FStarC_Syntax_Syntax.fv -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = - fun fv -> - FStarC_Syntax_Syntax.mk (FStarC_Syntax_Syntax.Tm_fvar fv) - FStarC_Compiler_Range_Type.dummyRange -let (znat : FStarC_Syntax_Syntax.term) = tm_fv znat_l -let (snat : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = - fun s -> - let uu___ = - let uu___1 = - let uu___2 = tm_fv snat_l in - let uu___3 = let uu___4 = FStarC_Syntax_Syntax.as_arg s in [uu___4] in - { - FStarC_Syntax_Syntax.hd = uu___2; - FStarC_Syntax_Syntax.args = uu___3 - } in - FStarC_Syntax_Syntax.Tm_app uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange -let pat : 'uuuuu . 'uuuuu -> 'uuuuu FStarC_Syntax_Syntax.withinfo_t = - fun p -> - FStarC_Syntax_Syntax.withinfo p FStarC_Compiler_Range_Type.dummyRange -let (snat_type : FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) = - let uu___ = - let uu___1 = lid "snat" in - FStarC_Syntax_Syntax.lid_as_fv uu___1 FStar_Pervasives_Native.None in - tm_fv uu___ -let (mk_match : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.branch Prims.list -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = - fun h -> - fun branches -> - let branches1 = - FStarC_Compiler_List.map FStarC_Syntax_Util.branch branches in - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_match - { - FStarC_Syntax_Syntax.scrutinee = h; - FStarC_Syntax_Syntax.ret_opt = FStar_Pervasives_Native.None; - FStarC_Syntax_Syntax.brs = branches1; - FStarC_Syntax_Syntax.rc_opt1 = FStar_Pervasives_Native.None - }) FStarC_Compiler_Range_Type.dummyRange -let (pred_nat : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = - fun s -> - let zbranch = - let uu___ = - pat - (FStarC_Syntax_Syntax.Pat_cons - (znat_l, FStar_Pervasives_Native.None, [])) in - (uu___, FStar_Pervasives_Native.None, znat) in - let sbranch = - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - pat (FStarC_Syntax_Syntax.Pat_var FStarC_Tests_Util.x) in - (uu___5, false) in - [uu___4] in - (snat_l, FStar_Pervasives_Native.None, uu___3) in - FStarC_Syntax_Syntax.Pat_cons uu___2 in - pat uu___1 in - let uu___1 = - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_bvar - { - FStarC_Syntax_Syntax.ppname = - (FStarC_Tests_Util.x.FStarC_Syntax_Syntax.ppname); - FStarC_Syntax_Syntax.index = Prims.int_zero; - FStarC_Syntax_Syntax.sort = - (FStarC_Tests_Util.x.FStarC_Syntax_Syntax.sort) - }) FStarC_Compiler_Range_Type.dummyRange in - (uu___, FStar_Pervasives_Native.None, uu___1) in - mk_match s [zbranch; sbranch] -let (minus_nat : - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = - fun t1 -> - fun t2 -> - let minus1 = FStarC_Tests_Util.m in - let x = - { - FStarC_Syntax_Syntax.ppname = - (FStarC_Tests_Util.x.FStarC_Syntax_Syntax.ppname); - FStarC_Syntax_Syntax.index = - (FStarC_Tests_Util.x.FStarC_Syntax_Syntax.index); - FStarC_Syntax_Syntax.sort = snat_type - } in - let y = - { - FStarC_Syntax_Syntax.ppname = - (FStarC_Tests_Util.y.FStarC_Syntax_Syntax.ppname); - FStarC_Syntax_Syntax.index = - (FStarC_Tests_Util.y.FStarC_Syntax_Syntax.index); - FStarC_Syntax_Syntax.sort = snat_type - } in - let zbranch = - let uu___ = - pat - (FStarC_Syntax_Syntax.Pat_cons - (znat_l, FStar_Pervasives_Native.None, [])) in - let uu___1 = FStarC_Tests_Util.nm x in - (uu___, FStar_Pervasives_Native.None, uu___1) in - let sbranch = - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = - let uu___5 = - pat (FStarC_Syntax_Syntax.Pat_var FStarC_Tests_Util.n) in - (uu___5, false) in - [uu___4] in - (snat_l, FStar_Pervasives_Native.None, uu___3) in - FStarC_Syntax_Syntax.Pat_cons uu___2 in - pat uu___1 in - let uu___1 = - let uu___2 = FStarC_Tests_Util.nm minus1 in - let uu___3 = - let uu___4 = - let uu___5 = FStarC_Tests_Util.nm x in pred_nat uu___5 in - let uu___5 = - let uu___6 = FStarC_Tests_Util.nm FStarC_Tests_Util.n in - [uu___6] in - uu___4 :: uu___5 in - FStarC_Tests_Util.app uu___2 uu___3 in - (uu___, FStar_Pervasives_Native.None, uu___1) in - let lb = - let uu___ = - FStarC_Ident.lid_of_path ["Pure"] - FStarC_Compiler_Range_Type.dummyRange in - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = b x in - let uu___5 = let uu___6 = b y in [uu___6] in uu___4 :: uu___5 in - let uu___4 = - let uu___5 = FStarC_Tests_Util.nm y in - mk_match uu___5 [zbranch; sbranch] in - FStarC_Syntax_Util.abs uu___3 uu___4 FStar_Pervasives_Native.None in - FStarC_Syntax_Subst.subst - [FStarC_Syntax_Syntax.NM (minus1, Prims.int_zero)] uu___2 in - { - FStarC_Syntax_Syntax.lbname = (FStar_Pervasives.Inl minus1); - FStarC_Syntax_Syntax.lbunivs = []; - FStarC_Syntax_Syntax.lbtyp = FStarC_Syntax_Syntax.tun; - FStarC_Syntax_Syntax.lbeff = uu___; - FStarC_Syntax_Syntax.lbdef = uu___1; - FStarC_Syntax_Syntax.lbattrs = []; - FStarC_Syntax_Syntax.lbpos = FStarC_Compiler_Range_Type.dummyRange - } in - let uu___ = - let uu___1 = - let uu___2 = - let uu___3 = - let uu___4 = FStarC_Tests_Util.nm minus1 in - FStarC_Tests_Util.app uu___4 [t1; t2] in - FStarC_Syntax_Subst.subst - [FStarC_Syntax_Syntax.NM (minus1, Prims.int_zero)] uu___3 in - { - FStarC_Syntax_Syntax.lbs = (true, [lb]); - FStarC_Syntax_Syntax.body1 = uu___2 - } in - FStarC_Syntax_Syntax.Tm_let uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange -let (encode_nat : Prims.int -> FStarC_Syntax_Syntax.term) = - fun n -> - let rec aux out n1 = - if n1 = Prims.int_zero - then out - else (let uu___1 = snat out in aux uu___1 (n1 - Prims.int_one)) in - aux znat n -let (default_tests : - (Prims.int * FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax * - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) Prims.list) - = - FStarC_Tests_Pars.pars_and_tc_fragment - "let rec copy (x:list int) : Tot (list int) = match x with | [] -> [] | hd::tl -> hd::copy tl"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let recons (x:list 'a) : Tot (list 'a) = match x with | [] -> [] | hd::tl -> hd::tl"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let rev (x:list 'a) : Tot (list 'a) = let rec aux (x:list 'a) (out:list 'a) : Tot (list 'a) = match x with | [] -> out | hd::tl -> aux tl (hd::out) in aux x []"; - FStarC_Tests_Pars.pars_and_tc_fragment - "type t = | A : int -> int -> t | B : int -> int -> t let f = function | A x y | B y x -> y - x"; - FStarC_Tests_Pars.pars_and_tc_fragment "type snat = | Z | S : snat -> snat"; - FStarC_Tests_Pars.pars_and_tc_fragment "type tb = | T | F"; - FStarC_Tests_Pars.pars_and_tc_fragment "type rb = | A1 | A2 | A3"; - FStarC_Tests_Pars.pars_and_tc_fragment "type hb = | H : tb -> hb"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let select (i:tb) (x:'a) (y:'a) : Tot 'a = match i with | T -> x | F -> y"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let select_int3 (i:int) (x:'a) (y:'a) (z:'a) : Tot 'a = match i with | 0 -> x | 1 -> y | _ -> z"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let select_bool (b:bool) (x:'a) (y:'a) : Tot 'a = if b then x else y"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let select_string3 (s:string) (x:'a) (y:'a) (z:'a) : Tot 'a = match s with | \"abc\" -> x | \"def\" -> y | _ -> z"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let recons_m (x:list tb) = match x with | [] -> [] | hd::tl -> hd::tl"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let rec copy_tb_list_2 (x:list tb) : Tot (list tb) = match x with | [] -> [] | [hd] -> [hd]\n | hd1::hd2::tl -> hd1::hd2::copy_tb_list_2 tl"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let rec copy_list_2 (x:list 'a) : Tot (list 'a) = match x with | [] -> [] | [hd] -> [hd]\n | hd1::hd2::tl -> hd1::hd2::copy_list_2 tl"; - FStarC_Tests_Pars.pars_and_tc_fragment "let (x1:int{x1>3}) = 6"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let (x2:int{x2+1>3 /\\ not (x2-5>0)}) = 2"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let my_plus (x:int) (y:int) = x + y"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let (x3:int{forall (a:nat). a > x2}) = 7"; - FStarC_Tests_Pars.pars_and_tc_fragment "let idd (x: 'a) = x"; - FStarC_Tests_Pars.pars_and_tc_fragment - "let revtb (x: tb) = match x with | T -> F | F -> T"; - FStarC_Tests_Pars.pars_and_tc_fragment "let id_tb (x: tb) = x"; - FStarC_Tests_Pars.pars_and_tc_fragment "let fst_a (x: 'a) (y: 'a) = x"; - FStarC_Tests_Pars.pars_and_tc_fragment "let id_list (x: list 'a) = x"; - FStarC_Tests_Pars.pars_and_tc_fragment "let id_list_m (x: list tb) = x"; - (let uu___25 = - let uu___26 = - let uu___27 = - let uu___28 = - let uu___29 = - let uu___30 = FStarC_Tests_Util.nm FStarC_Tests_Util.n in - [uu___30] in - id :: uu___29 in - one :: uu___28 in - FStarC_Tests_Util.app apply uu___27 in - let uu___27 = FStarC_Tests_Util.nm FStarC_Tests_Util.n in - (Prims.int_zero, uu___26, uu___27) in - let uu___26 = - let uu___27 = - let uu___28 = - let uu___29 = - let uu___30 = FStarC_Tests_Util.nm FStarC_Tests_Util.x in - [uu___30] in - FStarC_Tests_Util.app id uu___29 in - let uu___29 = FStarC_Tests_Util.nm FStarC_Tests_Util.x in - (Prims.int_one, uu___28, uu___29) in - let uu___28 = - let uu___29 = - let uu___30 = - let uu___31 = - let uu___32 = - let uu___33 = FStarC_Tests_Util.nm FStarC_Tests_Util.n in - let uu___34 = - let uu___35 = FStarC_Tests_Util.nm FStarC_Tests_Util.m in - [uu___35] in - uu___33 :: uu___34 in - tt :: uu___32 in - FStarC_Tests_Util.app apply uu___31 in - let uu___31 = FStarC_Tests_Util.nm FStarC_Tests_Util.n in - (Prims.int_one, uu___30, uu___31) in - let uu___30 = - let uu___31 = - let uu___32 = - let uu___33 = - let uu___34 = - let uu___35 = FStarC_Tests_Util.nm FStarC_Tests_Util.n in - let uu___36 = - let uu___37 = FStarC_Tests_Util.nm FStarC_Tests_Util.m in - [uu___37] in - uu___35 :: uu___36 in - ff :: uu___34 in - FStarC_Tests_Util.app apply uu___33 in - let uu___33 = FStarC_Tests_Util.nm FStarC_Tests_Util.m in - ((Prims.of_int (2)), uu___32, uu___33) in - let uu___32 = - let uu___33 = - let uu___34 = - let uu___35 = - let uu___36 = - let uu___37 = - let uu___38 = - let uu___39 = - let uu___40 = - let uu___41 = - let uu___42 = - FStarC_Tests_Util.nm FStarC_Tests_Util.n in - let uu___43 = - let uu___44 = - FStarC_Tests_Util.nm FStarC_Tests_Util.m in - [uu___44] in - uu___42 :: uu___43 in - ff :: uu___41 in - apply :: uu___40 in - apply :: uu___39 in - apply :: uu___38 in - apply :: uu___37 in - apply :: uu___36 in - FStarC_Tests_Util.app apply uu___35 in - let uu___35 = FStarC_Tests_Util.nm FStarC_Tests_Util.m in - ((Prims.of_int (3)), uu___34, uu___35) in - let uu___34 = - let uu___35 = - let uu___36 = - let uu___37 = - let uu___38 = - let uu___39 = - let uu___40 = FStarC_Tests_Util.nm FStarC_Tests_Util.n in - let uu___41 = - let uu___42 = - FStarC_Tests_Util.nm FStarC_Tests_Util.m in - [uu___42] in - uu___40 :: uu___41 in - ff :: uu___39 in - apply :: uu___38 in - FStarC_Tests_Util.app twice uu___37 in - let uu___37 = FStarC_Tests_Util.nm FStarC_Tests_Util.m in - ((Prims.of_int (4)), uu___36, uu___37) in - let uu___36 = - let uu___37 = - let uu___38 = minus one z in - ((Prims.of_int (5)), uu___38, one) in - let uu___38 = - let uu___39 = - let uu___40 = FStarC_Tests_Util.app pred [one] in - ((Prims.of_int (6)), uu___40, z) in - let uu___40 = - let uu___41 = - let uu___42 = minus one one in - ((Prims.of_int (7)), uu___42, z) in - let uu___42 = - let uu___43 = - let uu___44 = FStarC_Tests_Util.app mul [one; one] in - ((Prims.of_int (8)), uu___44, one) in - let uu___44 = - let uu___45 = - let uu___46 = FStarC_Tests_Util.app mul [two; one] in - ((Prims.of_int (9)), uu___46, two) in - let uu___46 = - let uu___47 = - let uu___48 = - let uu___49 = - let uu___50 = FStarC_Tests_Util.app succ [one] in - [uu___50; one] in - FStarC_Tests_Util.app mul uu___49 in - ((Prims.of_int (10)), uu___48, two) in - let uu___48 = - let uu___49 = - let uu___50 = - let uu___51 = encode (Prims.of_int (10)) in - let uu___52 = encode (Prims.of_int (10)) in - minus uu___51 uu___52 in - ((Prims.of_int (11)), uu___50, z) in - let uu___50 = - let uu___51 = - let uu___52 = - let uu___53 = encode (Prims.of_int (100)) in - let uu___54 = encode (Prims.of_int (100)) in - minus uu___53 uu___54 in - ((Prims.of_int (12)), uu___52, z) in - let uu___52 = - let uu___53 = - let uu___54 = - let uu___55 = encode (Prims.of_int (100)) in - let uu___56 = - let uu___57 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.x in - let uu___58 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.x in - minus uu___57 uu___58 in - let_ FStarC_Tests_Util.x uu___55 uu___56 in - ((Prims.of_int (13)), uu___54, z) in - let uu___54 = - let uu___55 = - let uu___56 = - let uu___57 = - FStarC_Tests_Util.app succ [one] in - let uu___58 = - let uu___59 = - let uu___60 = - let uu___61 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.x in - let uu___62 = - let uu___63 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.x in - [uu___63] in - uu___61 :: uu___62 in - FStarC_Tests_Util.app mul uu___60 in - let uu___60 = - let uu___61 = - let uu___62 = - let uu___63 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.y in - let uu___64 = - let uu___65 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.y in - [uu___65] in - uu___63 :: uu___64 in - FStarC_Tests_Util.app mul uu___62 in - let uu___62 = - let uu___63 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.h in - let uu___64 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.h in - minus uu___63 uu___64 in - let_ FStarC_Tests_Util.h uu___61 - uu___62 in - let_ FStarC_Tests_Util.y uu___59 - uu___60 in - let_ FStarC_Tests_Util.x uu___57 uu___58 in - ((Prims.of_int (15)), uu___56, z) in - let uu___56 = - let uu___57 = - let uu___58 = - let uu___59 = - FStarC_Tests_Util.app succ [one] in - let uu___60 = - let uu___61 = - let uu___62 = - let uu___63 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.x in - let uu___64 = - let uu___65 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.x in - [uu___65] in - uu___63 :: uu___64 in - FStarC_Tests_Util.app mul uu___62 in - let uu___62 = - let uu___63 = - let uu___64 = - let uu___65 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.y in - let uu___66 = - let uu___67 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.y in - [uu___67] in - uu___65 :: uu___66 in - FStarC_Tests_Util.app mul - uu___64 in - let uu___64 = - let uu___65 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.h in - let uu___66 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.h in - minus uu___65 uu___66 in - mk_let FStarC_Tests_Util.h uu___63 - uu___64 in - mk_let FStarC_Tests_Util.y uu___61 - uu___62 in - mk_let FStarC_Tests_Util.x uu___59 - uu___60 in - ((Prims.of_int (16)), uu___58, z) in - let uu___58 = - let uu___59 = - let uu___60 = - let uu___61 = - FStarC_Tests_Util.app succ [one] in - let uu___62 = - let uu___63 = - let uu___64 = - let uu___65 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.x in - let uu___66 = - let uu___67 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.x in - [uu___67] in - uu___65 :: uu___66 in - FStarC_Tests_Util.app mul - uu___64 in - let uu___64 = - let uu___65 = - let uu___66 = - let uu___67 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.y in - let uu___68 = - let uu___69 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.y in - [uu___69] in - uu___67 :: uu___68 in - FStarC_Tests_Util.app mul - uu___66 in - let uu___66 = - let uu___67 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.h in - let uu___68 = - FStarC_Tests_Util.nm - FStarC_Tests_Util.h in - minus uu___67 uu___68 in - let_ FStarC_Tests_Util.h uu___65 - uu___66 in - let_ FStarC_Tests_Util.y uu___63 - uu___64 in - let_ FStarC_Tests_Util.x uu___61 - uu___62 in - ((Prims.of_int (17)), uu___60, z) in - let uu___60 = - let uu___61 = - let uu___62 = - let uu___63 = - let uu___64 = snat znat in - snat uu___64 in - pred_nat uu___63 in - let uu___63 = snat znat in - ((Prims.of_int (18)), uu___62, - uu___63) in - let uu___62 = - let uu___63 = - let uu___64 = - let uu___65 = - let uu___66 = - let uu___67 = snat znat in - snat uu___67 in - let uu___67 = snat znat in - minus_nat uu___66 uu___67 in - FStarC_Tests_Pars.tc_term - uu___65 in - let uu___65 = snat znat in - ((Prims.of_int (19)), uu___64, - uu___65) in - let uu___64 = - let uu___65 = - let uu___66 = - let uu___67 = - let uu___68 = - encode_nat - (Prims.of_int (10)) in - let uu___69 = - encode_nat - (Prims.of_int (10)) in - minus_nat uu___68 uu___69 in - FStarC_Tests_Pars.tc_term - uu___67 in - ((Prims.of_int (20)), uu___66, - znat) in - let uu___66 = - let uu___67 = - let uu___68 = - let uu___69 = - let uu___70 = - encode_nat - (Prims.of_int (100)) in - let uu___71 = - encode_nat - (Prims.of_int (100)) in - minus_nat uu___70 uu___71 in - FStarC_Tests_Pars.tc_term - uu___69 in - ((Prims.of_int (21)), uu___68, - znat) in - let uu___68 = - let uu___69 = - let uu___70 = - FStarC_Tests_Pars.tc - "recons [0;1]" in - let uu___71 = - FStarC_Tests_Pars.tc - "[0;1]" in - ((Prims.of_int (24)), - uu___70, uu___71) in - let uu___70 = - let uu___71 = - let uu___72 = - FStarC_Tests_Pars.tc - "recons [false;true;false]" in - let uu___73 = - FStarC_Tests_Pars.tc - "[false;true;false]" in - ((Prims.of_int (241)), - uu___72, uu___73) in - let uu___72 = - let uu___73 = - let uu___74 = - FStarC_Tests_Pars.tc - "copy [0;1]" in - let uu___75 = - FStarC_Tests_Pars.tc - "[0;1]" in - ((Prims.of_int (25)), - uu___74, uu___75) in - let uu___74 = - let uu___75 = - let uu___76 = - FStarC_Tests_Pars.tc - "rev [0;1;2;3;4;5;6;7;8;9;10]" in - let uu___77 = - FStarC_Tests_Pars.tc - "[10;9;8;7;6;5;4;3;2;1;0]" in - ((Prims.of_int (26)), - uu___76, uu___77) in - let uu___76 = - let uu___77 = - let uu___78 = - FStarC_Tests_Pars.tc - "(fun x y z q -> z) T T F T" in - let uu___79 = - FStarC_Tests_Pars.tc - "F" in - ((Prims.of_int (28)), - uu___78, uu___79) in - let uu___78 = - let uu___79 = - let uu___80 = - FStarC_Tests_Pars.tc - "[T; F]" in - let uu___81 = - FStarC_Tests_Pars.tc - "[T; F]" in - ((Prims.of_int (29)), - uu___80, - uu___81) in - let uu___80 = - let uu___81 = - let uu___82 = - FStarC_Tests_Pars.tc - "id_tb T" in - let uu___83 = - FStarC_Tests_Pars.tc - "T" in - ((Prims.of_int (31)), - uu___82, - uu___83) in - let uu___82 = - let uu___83 = - let uu___84 = - FStarC_Tests_Pars.tc - "(fun #a x -> x) #tb T" in - let uu___85 = - FStarC_Tests_Pars.tc - "T" in - ((Prims.of_int (32)), - uu___84, - uu___85) in - let uu___84 = - let uu___85 = - let uu___86 - = - FStarC_Tests_Pars.tc - "revtb T" in - let uu___87 - = - FStarC_Tests_Pars.tc - "F" in - ((Prims.of_int (33)), - uu___86, - uu___87) in - let uu___86 = - let uu___87 - = - let uu___88 - = - FStarC_Tests_Pars.tc - "(fun x y -> x) T F" in - let uu___89 - = - FStarC_Tests_Pars.tc - "T" in - ((Prims.of_int (34)), - uu___88, - uu___89) in - let uu___88 - = - let uu___89 - = - let uu___90 - = - FStarC_Tests_Pars.tc - "fst_a T F" in - let uu___91 - = - FStarC_Tests_Pars.tc - "T" in - ((Prims.of_int (35)), - uu___90, - uu___91) in - let uu___90 - = - let uu___91 - = - let uu___92 - = - FStarC_Tests_Pars.tc - "idd T" in - let uu___93 - = - FStarC_Tests_Pars.tc - "T" in - ((Prims.of_int (36)), - uu___92, - uu___93) in - let uu___92 - = - let uu___93 - = - let uu___94 - = - FStarC_Tests_Pars.tc - "id_list [T]" in - let uu___95 - = - FStarC_Tests_Pars.tc - "[T]" in - ((Prims.of_int (301)), - uu___94, - uu___95) in - let uu___94 - = - let uu___95 - = - let uu___96 - = - FStarC_Tests_Pars.tc - "id_list_m [T]" in - let uu___97 - = - FStarC_Tests_Pars.tc - "[T]" in - ((Prims.of_int (3012)), - uu___96, - uu___97) in - let uu___96 - = - let uu___97 - = - let uu___98 - = - FStarC_Tests_Pars.tc - "recons_m [T; F]" in - let uu___99 - = - FStarC_Tests_Pars.tc - "[T; F]" in - ((Prims.of_int (302)), - uu___98, - uu___99) in - let uu___98 - = - let uu___99 - = - let uu___100 - = - FStarC_Tests_Pars.tc - "select T A1 A3" in - let uu___101 - = - FStarC_Tests_Pars.tc - "A1" in - ((Prims.of_int (303)), - uu___100, - uu___101) in - let uu___100 - = - let uu___101 - = - let uu___102 - = - FStarC_Tests_Pars.tc - "select T 3 4" in - let uu___103 - = - FStarC_Tests_Pars.tc - "3" in - ((Prims.of_int (3031)), - uu___102, - uu___103) in - let uu___102 - = - let uu___103 - = - let uu___104 - = - FStarC_Tests_Pars.tc - "select_bool false 3 4" in - let uu___105 - = - FStarC_Tests_Pars.tc - "4" in - ((Prims.of_int (3032)), - uu___104, - uu___105) in - let uu___104 - = - let uu___105 - = - let uu___106 - = - FStarC_Tests_Pars.tc - "select_int3 1 7 8 9" in - let uu___107 - = - FStarC_Tests_Pars.tc - "8" in - ((Prims.of_int (3033)), - uu___106, - uu___107) in - let uu___106 - = - let uu___107 - = - let uu___108 - = - FStarC_Tests_Pars.tc - "[5]" in - let uu___109 - = - FStarC_Tests_Pars.tc - "[5]" in - ((Prims.of_int (3034)), - uu___108, - uu___109) in - let uu___108 - = - let uu___109 - = - let uu___110 - = - FStarC_Tests_Pars.tc - "[\"abcd\"]" in - let uu___111 - = - FStarC_Tests_Pars.tc - "[\"abcd\"]" in - ((Prims.of_int (3035)), - uu___110, - uu___111) in - let uu___110 - = - let uu___111 - = - let uu___112 - = - FStarC_Tests_Pars.tc - "select_string3 \"def\" 5 6 7" in - let uu___113 - = - FStarC_Tests_Pars.tc - "6" in - ((Prims.of_int (3036)), - uu___112, - uu___113) in - let uu___112 - = - let uu___113 - = - let uu___114 - = - FStarC_Tests_Pars.tc - "idd T" in - let uu___115 - = - FStarC_Tests_Pars.tc - "T" in - ((Prims.of_int (305)), - uu___114, - uu___115) in - let uu___114 - = - let uu___115 - = - let uu___116 - = - FStarC_Tests_Pars.tc - "recons [T]" in - let uu___117 - = - FStarC_Tests_Pars.tc - "[T]" in - ((Prims.of_int (306)), - uu___116, - uu___117) in - let uu___116 - = - let uu___117 - = - let uu___118 - = - FStarC_Tests_Pars.tc - "copy_tb_list_2 [T;F;T;F;T;F;F]" in - let uu___119 - = - FStarC_Tests_Pars.tc - "[T;F;T;F;T;F;F]" in - ((Prims.of_int (307)), - uu___118, - uu___119) in - let uu___118 - = - let uu___119 - = - let uu___120 - = - FStarC_Tests_Pars.tc - "copy_list_2 [T;F;T;F;T;F;F]" in - let uu___121 - = - FStarC_Tests_Pars.tc - "[T;F;T;F;T;F;F]" in - ((Prims.of_int (308)), - uu___120, - uu___121) in - let uu___120 - = - let uu___121 - = - let uu___122 - = - FStarC_Tests_Pars.tc - "rev [T; F; F]" in - let uu___123 - = - FStarC_Tests_Pars.tc - "[F; F; T]" in - ((Prims.of_int (304)), - uu___122, - uu___123) in - let uu___122 - = - let uu___123 - = - let uu___124 - = - FStarC_Tests_Pars.tc - "rev [[T]; [F; T]]" in - let uu___125 - = - FStarC_Tests_Pars.tc - "[[F; T]; [T]]" in - ((Prims.of_int (305)), - uu___124, - uu___125) in - let uu___124 - = - let uu___125 - = - let uu___126 - = - FStarC_Tests_Pars.tc - "x1" in - let uu___127 - = - FStarC_Tests_Pars.tc - "6" in - ((Prims.of_int (309)), - uu___126, - uu___127) in - let uu___126 - = - let uu___127 - = - let uu___128 - = - FStarC_Tests_Pars.tc - "x2" in - let uu___129 - = - FStarC_Tests_Pars.tc - "2" in - ((Prims.of_int (310)), - uu___128, - uu___129) in - let uu___128 - = - let uu___129 - = - let uu___130 - = - FStarC_Tests_Pars.tc - "7 + 3" in - let uu___131 - = - FStarC_Tests_Pars.tc - "10" in - ((Prims.of_int (401)), - uu___130, - uu___131) in - let uu___130 - = - let uu___131 - = - let uu___132 - = - FStarC_Tests_Pars.tc - "true && false" in - let uu___133 - = - FStarC_Tests_Pars.tc - "false" in - ((Prims.of_int (402)), - uu___132, - uu___133) in - let uu___132 - = - let uu___133 - = - let uu___134 - = - FStarC_Tests_Pars.tc - "3 = 5" in - let uu___135 - = - FStarC_Tests_Pars.tc - "false" in - ((Prims.of_int (403)), - uu___134, - uu___135) in - let uu___134 - = - let uu___135 - = - let uu___136 - = - FStarC_Tests_Pars.tc - "\"abc\" ^ \"def\"" in - let uu___137 - = - FStarC_Tests_Pars.tc - "\"abcdef\"" in - ((Prims.of_int (404)), - uu___136, - uu___137) in - let uu___136 - = - let uu___137 - = - let uu___138 - = - FStarC_Tests_Pars.tc - "(fun (x:list int) -> match x with | [] -> 0 | hd::tl -> 1) []" in - let uu___139 - = - FStarC_Tests_Pars.tc - "0" in - ((Prims.of_int (405)), - uu___138, - uu___139) in - [uu___137] in - uu___135 - :: - uu___136 in - uu___133 - :: - uu___134 in - uu___131 - :: - uu___132 in - uu___129 - :: - uu___130 in - uu___127 - :: - uu___128 in - uu___125 - :: - uu___126 in - uu___123 - :: - uu___124 in - uu___121 - :: - uu___122 in - uu___119 - :: - uu___120 in - uu___117 - :: - uu___118 in - uu___115 - :: - uu___116 in - uu___113 - :: - uu___114 in - uu___111 - :: - uu___112 in - uu___109 - :: - uu___110 in - uu___107 - :: - uu___108 in - uu___105 - :: - uu___106 in - uu___103 - :: - uu___104 in - uu___101 - :: - uu___102 in - uu___99 - :: - uu___100 in - uu___97 - :: - uu___98 in - uu___95 - :: - uu___96 in - uu___93 - :: - uu___94 in - uu___91 - :: - uu___92 in - uu___89 :: - uu___90 in - uu___87 :: - uu___88 in - uu___85 :: - uu___86 in - uu___83 :: - uu___84 in - uu___81 :: uu___82 in - uu___79 :: uu___80 in - uu___77 :: uu___78 in - uu___75 :: uu___76 in - uu___73 :: uu___74 in - uu___71 :: uu___72 in - uu___69 :: uu___70 in - uu___67 :: uu___68 in - uu___65 :: uu___66 in - uu___63 :: uu___64 in - uu___61 :: uu___62 in - uu___59 :: uu___60 in - uu___57 :: uu___58 in - uu___55 :: uu___56 in - uu___53 :: uu___54 in - uu___51 :: uu___52 in - uu___49 :: uu___50 in - uu___47 :: uu___48 in - uu___45 :: uu___46 in - uu___43 :: uu___44 in - uu___41 :: uu___42 in - uu___39 :: uu___40 in - uu___37 :: uu___38 in - uu___35 :: uu___36 in - uu___33 :: uu___34 in - uu___31 :: uu___32 in - uu___29 :: uu___30 in - uu___27 :: uu___28 in - uu___25 :: uu___26) -let run_either : - 'uuuuu . - Prims.int -> - 'uuuuu -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - (FStarC_TypeChecker_Env.env -> 'uuuuu -> FStarC_Syntax_Syntax.term) - -> unit - = - fun i -> - fun r -> - fun expected -> - fun normalizer -> - (let uu___1 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.print1 "%s: ... \n\n" uu___1); - (let tcenv = FStarC_Tests_Pars.init () in - (let uu___2 = FStarC_Main.process_args () in ()); - (let x = normalizer tcenv r in - FStarC_Options.init (); - FStarC_Options.set_option "print_universes" - (FStarC_Options.Bool true); - FStarC_Options.set_option "print_implicits" - (FStarC_Options.Bool true); - FStarC_Options.set_option "ugly" (FStarC_Options.Bool true); - FStarC_Options.set_option "print_bound_var_types" - (FStarC_Options.Bool true); - (let uu___7 = - let uu___8 = FStarC_Syntax_Util.unascribe x in - FStarC_Tests_Util.term_eq uu___8 expected in - FStarC_Tests_Util.always i uu___7))) -let (run_whnf : - Prims.int -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> unit) - = - fun i -> - fun r -> - fun expected -> - let steps = - [FStarC_TypeChecker_Env.Primops; - FStarC_TypeChecker_Env.Weak; - FStarC_TypeChecker_Env.HNF; - FStarC_TypeChecker_Env.UnfoldUntil - FStarC_Syntax_Syntax.delta_constant] in - run_either i r expected - (FStarC_TypeChecker_Normalize.normalize steps) -let (run_interpreter : - Prims.int -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> unit) - = - fun i -> - fun r -> - fun expected -> - run_either i r expected - (FStarC_TypeChecker_Normalize.normalize - [FStarC_TypeChecker_Env.Beta; - FStarC_TypeChecker_Env.UnfoldUntil - FStarC_Syntax_Syntax.delta_constant; - FStarC_TypeChecker_Env.Primops]) -let (run_nbe : - Prims.int -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> unit) - = - fun i -> - fun r -> - fun expected -> - run_either i r expected - (FStarC_TypeChecker_NBE.normalize_for_unit_test - [FStarC_TypeChecker_Env.UnfoldUntil - FStarC_Syntax_Syntax.delta_constant]) -let (run_interpreter_with_time : - Prims.int -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - (Prims.int * FStarC_BaseTypes.float)) - = - fun i -> - fun r -> - fun expected -> - let interp uu___ = run_interpreter i r expected in - let uu___ = - let uu___1 = FStarC_Compiler_Util.return_execution_time interp in - FStar_Pervasives_Native.snd uu___1 in - (i, uu___) -let (run_whnf_with_time : - Prims.int -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - (Prims.int * FStarC_BaseTypes.float)) - = - fun i -> - fun r -> - fun expected -> - let whnf uu___ = run_whnf i r expected in - let uu___ = - let uu___1 = FStarC_Compiler_Util.return_execution_time whnf in - FStar_Pervasives_Native.snd uu___1 in - (i, uu___) -let (run_nbe_with_time : - Prims.int -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - (Prims.int * FStarC_BaseTypes.float)) - = - fun i -> - fun r -> - fun expected -> - let nbe uu___ = run_nbe i r expected in - let uu___ = - let uu___1 = FStarC_Compiler_Util.return_execution_time nbe in - FStar_Pervasives_Native.snd uu___1 in - (i, uu___) -let run_tests : - 'uuuuu 'uuuuu1 'uuuuu2 'uuuuu3 . - ('uuuuu * 'uuuuu1 * 'uuuuu2) Prims.list -> - ('uuuuu -> 'uuuuu1 -> 'uuuuu2 -> 'uuuuu3) -> 'uuuuu3 Prims.list - = - fun tests -> - fun run -> - FStarC_Options.__set_unit_tests (); - (let l = - FStarC_Compiler_List.map - (fun uu___1 -> - match uu___1 with | (no, test, res) -> run no test res) tests in - FStarC_Options.__clear_unit_tests (); l) -let (whnf_tests : - (Prims.int * FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.term) - Prims.list) - = - FStarC_Tests_Pars.pars_and_tc_fragment "assume val def : Type0"; - FStarC_Tests_Pars.pars_and_tc_fragment "assume val pred : Type0"; - FStarC_Tests_Pars.pars_and_tc_fragment "let def0 (y:int) = def"; - FStarC_Tests_Pars.pars_and_tc_fragment - "unfold let def1 (y:int) = x:def0 y { pred }"; - (let def_def1 = FStarC_Tests_Pars.tc "x:def0 17 { pred }" in - let def_def1_unfolded = FStarC_Tests_Pars.tc "x:def { pred }" in - let tests = - let uu___4 = - let uu___5 = FStarC_Tests_Pars.tc "def1 17" in - ((Prims.of_int (601)), uu___5, def_def1) in - [uu___4; ((Prims.of_int (602)), def_def1, def_def1_unfolded)] in - tests) -let (run_all_whnf : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Util.print_string "Testing Normlizer WHNF\n"; - (let uu___2 = run_tests whnf_tests run_whnf in - FStarC_Compiler_Util.print_string "Normalizer WHNF ok\n") -let (run_all_nbe : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Util.print_string "Testing NBE\n"; - (let uu___2 = run_tests default_tests run_nbe in - FStarC_Compiler_Util.print_string "NBE ok\n") -let (run_all_interpreter : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Util.print_string "Testing the normalizer\n"; - (let uu___2 = run_tests default_tests run_interpreter in - FStarC_Compiler_Util.print_string "Normalizer ok\n") -let (run_all_whnf_with_time : - unit -> (Prims.int * FStarC_BaseTypes.float) Prims.list) = - fun uu___ -> - FStarC_Compiler_Util.print_string "Testing WHNF\n"; - (let l = run_tests whnf_tests run_whnf_with_time in - FStarC_Compiler_Util.print_string "WHNF ok\n"; l) -let (run_all_nbe_with_time : - unit -> (Prims.int * FStarC_BaseTypes.float) Prims.list) = - fun uu___ -> - FStarC_Compiler_Util.print_string "Testing NBE\n"; - (let l = run_tests default_tests run_nbe_with_time in - FStarC_Compiler_Util.print_string "NBE ok\n"; l) -let (run_all_interpreter_with_time : - unit -> (Prims.int * FStarC_BaseTypes.float) Prims.list) = - fun uu___ -> - FStarC_Compiler_Util.print_string "Testing the normalizer\n"; - (let l = run_tests default_tests run_interpreter_with_time in - FStarC_Compiler_Util.print_string "Normalizer ok\n"; l) -let (run_both_with_time : - Prims.int -> - FStarC_Syntax_Syntax.term -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> unit) - = - fun i -> - fun r -> - fun expected -> - let nbe uu___ = run_nbe i r expected in - let norm uu___ = run_interpreter i r expected in - FStarC_Compiler_Util.measure_execution_time "nbe" nbe; - FStarC_Compiler_Util.print_string "\n"; - FStarC_Compiler_Util.measure_execution_time "normalizer" norm; - FStarC_Compiler_Util.print_string "\n" -let (compare : unit -> unit) = - fun uu___ -> - FStarC_Compiler_Util.print_string - "Comparing times for normalization and nbe\n"; - (let uu___2 = - let uu___3 = encode (Prims.of_int (1000)) in - let uu___4 = - let uu___5 = FStarC_Tests_Util.nm FStarC_Tests_Util.x in - let uu___6 = FStarC_Tests_Util.nm FStarC_Tests_Util.x in - minus uu___5 uu___6 in - let_ FStarC_Tests_Util.x uu___3 uu___4 in - run_both_with_time (Prims.of_int (14)) uu___2 z) -let (compare_times : - (Prims.int * FStarC_BaseTypes.float) Prims.list -> - (Prims.int * FStarC_BaseTypes.float) Prims.list -> unit) - = - fun l_int -> - fun l_nbe -> - FStarC_Compiler_Util.print_string - "Comparing times for normalization and nbe\n"; - FStarC_Compiler_List.iter2 - (fun res1 -> - fun res2 -> - let uu___1 = res1 in - match uu___1 with - | (t1, time_int) -> - let uu___2 = res2 in - (match uu___2 with - | (t2, time_nbe) -> - if t1 = t2 - then - let uu___3 = FStarC_Compiler_Util.string_of_int t1 in - FStarC_Compiler_Util.print3 - "Test %s\nNBE %s\nInterpreter %s\n" uu___3 - (FStarC_Compiler_Util.string_of_float time_nbe) - (FStarC_Compiler_Util.string_of_float time_int) - else - FStarC_Compiler_Util.print_string - "Test numbers do not match...\n")) l_int l_nbe -let (run_all : unit -> unit) = - fun uu___ -> - (let uu___2 = - FStarC_Class_Show.show FStarC_Syntax_Print.showable_term znat in - FStarC_Compiler_Util.print1 "%s" uu___2); - (let uu___2 = run_all_whnf_with_time () in - let l_int = run_all_interpreter_with_time () in - let l_nbe = run_all_nbe_with_time () in compare_times l_int l_nbe) \ No newline at end of file diff --git a/stage0/fstar-tests/generated/FStarC_Tests_Pars.ml b/stage0/fstar-tests/generated/FStarC_Tests_Pars.ml deleted file mode 100644 index 9fc05436848..00000000000 --- a/stage0/fstar-tests/generated/FStarC_Tests_Pars.ml +++ /dev/null @@ -1,875 +0,0 @@ -open Prims -let (test_lid : FStarC_Ident.lident) = - FStarC_Ident.lid_of_path ["Test"] FStarC_Compiler_Range_Type.dummyRange -let (tcenv_ref : - FStarC_TypeChecker_Env.env FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = FStarC_Compiler_Util.mk_ref FStar_Pervasives_Native.None -let (test_mod_ref : - FStarC_Syntax_Syntax.modul FStar_Pervasives_Native.option - FStarC_Compiler_Effect.ref) - = - FStarC_Compiler_Util.mk_ref - (FStar_Pervasives_Native.Some - { - FStarC_Syntax_Syntax.name = test_lid; - FStarC_Syntax_Syntax.declarations = []; - FStarC_Syntax_Syntax.is_interface = false - }) -let (parse_mod : - Prims.string -> - FStarC_Syntax_DsEnv.env -> - (FStarC_Syntax_DsEnv.env * FStarC_Syntax_Syntax.modul)) - = - fun mod_name -> - fun dsenv -> - let uu___ = - FStarC_Parser_ParseIt.parse FStar_Pervasives_Native.None - (FStarC_Parser_ParseIt.Filename mod_name) in - match uu___ with - | FStarC_Parser_ParseIt.ASTFragment (FStar_Pervasives.Inl m, uu___1) -> - let uu___2 = - let uu___3 = FStarC_ToSyntax_ToSyntax.ast_modul_to_modul m in - uu___3 dsenv in - (match uu___2 with - | (m1, env') -> - let uu___3 = - let uu___4 = - FStarC_Ident.lid_of_path ["Test"] - FStarC_Compiler_Range_Type.dummyRange in - FStarC_Syntax_DsEnv.prepare_module_or_interface false false - env' uu___4 FStarC_Syntax_DsEnv.default_mii in - (match uu___3 with | (env'1, uu___4) -> (env'1, m1))) - | FStarC_Parser_ParseIt.ParseError (err, msg, r) -> - FStarC_Compiler_Effect.raise - (FStarC_Errors.Error (err, msg, r, [])) - | FStarC_Parser_ParseIt.ASTFragment - (FStar_Pervasives.Inr uu___1, uu___2) -> - let msg = - FStarC_Compiler_Util.format1 "%s: expected a module\n" mod_name in - FStarC_Errors.raise_error0 FStarC_Errors_Codes.Fatal_ModuleExpected - () (Obj.magic FStarC_Errors_Msg.is_error_message_string) - (Obj.magic msg) - | FStarC_Parser_ParseIt.Term uu___1 -> - failwith - "Impossible: parsing a Filename always results in an ASTFragment" -let (add_mods : - Prims.string Prims.list -> - FStarC_Syntax_DsEnv.env -> - FStarC_TypeChecker_Env.env -> - (FStarC_Syntax_DsEnv.env * FStarC_TypeChecker_Env.env)) - = - fun mod_names -> - fun dsenv -> - fun env -> - FStarC_Compiler_List.fold_left - (fun uu___ -> - fun mod_name -> - match uu___ with - | (dsenv1, env1) -> - let uu___1 = parse_mod mod_name dsenv1 in - (match uu___1 with - | (dsenv2, string_mod) -> - let uu___2 = - FStarC_TypeChecker_Tc.check_module env1 string_mod - false in - (match uu___2 with | (_mod, env2) -> (dsenv2, env2)))) - (dsenv, env) mod_names -let (init_once : unit -> unit) = - fun uu___ -> - let solver = FStarC_SMTEncoding_Solver.dummy in - let env = - FStarC_TypeChecker_Env.initial_env FStarC_Parser_Dep.empty_deps - FStarC_TypeChecker_TcTerm.tc_term - FStarC_TypeChecker_TcTerm.typeof_tot_or_gtot_term - FStarC_TypeChecker_TcTerm.typeof_tot_or_gtot_term_fastpath - FStarC_TypeChecker_TcTerm.universe_of - FStarC_TypeChecker_Rel.teq_nosmt_force - FStarC_TypeChecker_Rel.subtype_nosmt_force solver - FStarC_Parser_Const.prims_lid - FStarC_TypeChecker_NBE.normalize_for_unit_test - FStarC_Universal.core_check in - (env.FStarC_TypeChecker_Env.solver).FStarC_TypeChecker_Env.init env; - (let uu___2 = - let uu___3 = FStarC_Basefiles.prims () in - let uu___4 = - FStarC_Syntax_DsEnv.empty_env FStarC_Parser_Dep.empty_deps in - parse_mod uu___3 uu___4 in - match uu___2 with - | (dsenv, prims_mod) -> - let env1 = - { - FStarC_TypeChecker_Env.solver = - (env.FStarC_TypeChecker_Env.solver); - FStarC_TypeChecker_Env.range = - (env.FStarC_TypeChecker_Env.range); - FStarC_TypeChecker_Env.curmodule = - (env.FStarC_TypeChecker_Env.curmodule); - FStarC_TypeChecker_Env.gamma = - (env.FStarC_TypeChecker_Env.gamma); - FStarC_TypeChecker_Env.gamma_sig = - (env.FStarC_TypeChecker_Env.gamma_sig); - FStarC_TypeChecker_Env.gamma_cache = - (env.FStarC_TypeChecker_Env.gamma_cache); - FStarC_TypeChecker_Env.modules = - (env.FStarC_TypeChecker_Env.modules); - FStarC_TypeChecker_Env.expected_typ = - (env.FStarC_TypeChecker_Env.expected_typ); - FStarC_TypeChecker_Env.sigtab = - (env.FStarC_TypeChecker_Env.sigtab); - FStarC_TypeChecker_Env.attrtab = - (env.FStarC_TypeChecker_Env.attrtab); - FStarC_TypeChecker_Env.instantiate_imp = - (env.FStarC_TypeChecker_Env.instantiate_imp); - FStarC_TypeChecker_Env.effects = - (env.FStarC_TypeChecker_Env.effects); - FStarC_TypeChecker_Env.generalize = - (env.FStarC_TypeChecker_Env.generalize); - FStarC_TypeChecker_Env.letrecs = - (env.FStarC_TypeChecker_Env.letrecs); - FStarC_TypeChecker_Env.top_level = - (env.FStarC_TypeChecker_Env.top_level); - FStarC_TypeChecker_Env.check_uvars = - (env.FStarC_TypeChecker_Env.check_uvars); - FStarC_TypeChecker_Env.use_eq_strict = - (env.FStarC_TypeChecker_Env.use_eq_strict); - FStarC_TypeChecker_Env.is_iface = - (env.FStarC_TypeChecker_Env.is_iface); - FStarC_TypeChecker_Env.admit = - (env.FStarC_TypeChecker_Env.admit); - FStarC_TypeChecker_Env.lax_universes = - (env.FStarC_TypeChecker_Env.lax_universes); - FStarC_TypeChecker_Env.phase1 = - (env.FStarC_TypeChecker_Env.phase1); - FStarC_TypeChecker_Env.failhard = - (env.FStarC_TypeChecker_Env.failhard); - FStarC_TypeChecker_Env.flychecking = - (env.FStarC_TypeChecker_Env.flychecking); - FStarC_TypeChecker_Env.uvar_subtyping = - (env.FStarC_TypeChecker_Env.uvar_subtyping); - FStarC_TypeChecker_Env.intactics = - (env.FStarC_TypeChecker_Env.intactics); - FStarC_TypeChecker_Env.nocoerce = - (env.FStarC_TypeChecker_Env.nocoerce); - FStarC_TypeChecker_Env.tc_term = - (env.FStarC_TypeChecker_Env.tc_term); - FStarC_TypeChecker_Env.typeof_tot_or_gtot_term = - (env.FStarC_TypeChecker_Env.typeof_tot_or_gtot_term); - FStarC_TypeChecker_Env.universe_of = - (env.FStarC_TypeChecker_Env.universe_of); - FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term = - (env.FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); - FStarC_TypeChecker_Env.teq_nosmt_force = - (env.FStarC_TypeChecker_Env.teq_nosmt_force); - FStarC_TypeChecker_Env.subtype_nosmt_force = - (env.FStarC_TypeChecker_Env.subtype_nosmt_force); - FStarC_TypeChecker_Env.qtbl_name_and_index = - (env.FStarC_TypeChecker_Env.qtbl_name_and_index); - FStarC_TypeChecker_Env.normalized_eff_names = - (env.FStarC_TypeChecker_Env.normalized_eff_names); - FStarC_TypeChecker_Env.fv_delta_depths = - (env.FStarC_TypeChecker_Env.fv_delta_depths); - FStarC_TypeChecker_Env.proof_ns = - (env.FStarC_TypeChecker_Env.proof_ns); - FStarC_TypeChecker_Env.synth_hook = - (env.FStarC_TypeChecker_Env.synth_hook); - FStarC_TypeChecker_Env.try_solve_implicits_hook = - (env.FStarC_TypeChecker_Env.try_solve_implicits_hook); - FStarC_TypeChecker_Env.splice = - (env.FStarC_TypeChecker_Env.splice); - FStarC_TypeChecker_Env.mpreprocess = - (env.FStarC_TypeChecker_Env.mpreprocess); - FStarC_TypeChecker_Env.postprocess = - (env.FStarC_TypeChecker_Env.postprocess); - FStarC_TypeChecker_Env.identifier_info = - (env.FStarC_TypeChecker_Env.identifier_info); - FStarC_TypeChecker_Env.tc_hooks = - (env.FStarC_TypeChecker_Env.tc_hooks); - FStarC_TypeChecker_Env.dsenv = dsenv; - FStarC_TypeChecker_Env.nbe = (env.FStarC_TypeChecker_Env.nbe); - FStarC_TypeChecker_Env.strict_args_tab = - (env.FStarC_TypeChecker_Env.strict_args_tab); - FStarC_TypeChecker_Env.erasable_types_tab = - (env.FStarC_TypeChecker_Env.erasable_types_tab); - FStarC_TypeChecker_Env.enable_defer_to_tac = - (env.FStarC_TypeChecker_Env.enable_defer_to_tac); - FStarC_TypeChecker_Env.unif_allow_ref_guards = - (env.FStarC_TypeChecker_Env.unif_allow_ref_guards); - FStarC_TypeChecker_Env.erase_erasable_args = - (env.FStarC_TypeChecker_Env.erase_erasable_args); - FStarC_TypeChecker_Env.core_check = - (env.FStarC_TypeChecker_Env.core_check); - FStarC_TypeChecker_Env.missing_decl = - (env.FStarC_TypeChecker_Env.missing_decl) - } in - let uu___3 = FStarC_TypeChecker_Tc.check_module env1 prims_mod false in - (match uu___3 with - | (_prims_mod, env2) -> - let env3 = - { - FStarC_TypeChecker_Env.solver = - (env2.FStarC_TypeChecker_Env.solver); - FStarC_TypeChecker_Env.range = - (env2.FStarC_TypeChecker_Env.range); - FStarC_TypeChecker_Env.curmodule = - (env2.FStarC_TypeChecker_Env.curmodule); - FStarC_TypeChecker_Env.gamma = - (env2.FStarC_TypeChecker_Env.gamma); - FStarC_TypeChecker_Env.gamma_sig = - (env2.FStarC_TypeChecker_Env.gamma_sig); - FStarC_TypeChecker_Env.gamma_cache = - (env2.FStarC_TypeChecker_Env.gamma_cache); - FStarC_TypeChecker_Env.modules = - (env2.FStarC_TypeChecker_Env.modules); - FStarC_TypeChecker_Env.expected_typ = - (env2.FStarC_TypeChecker_Env.expected_typ); - FStarC_TypeChecker_Env.sigtab = - (env2.FStarC_TypeChecker_Env.sigtab); - FStarC_TypeChecker_Env.attrtab = - (env2.FStarC_TypeChecker_Env.attrtab); - FStarC_TypeChecker_Env.instantiate_imp = - (env2.FStarC_TypeChecker_Env.instantiate_imp); - FStarC_TypeChecker_Env.effects = - (env2.FStarC_TypeChecker_Env.effects); - FStarC_TypeChecker_Env.generalize = - (env2.FStarC_TypeChecker_Env.generalize); - FStarC_TypeChecker_Env.letrecs = - (env2.FStarC_TypeChecker_Env.letrecs); - FStarC_TypeChecker_Env.top_level = - (env2.FStarC_TypeChecker_Env.top_level); - FStarC_TypeChecker_Env.check_uvars = - (env2.FStarC_TypeChecker_Env.check_uvars); - FStarC_TypeChecker_Env.use_eq_strict = - (env2.FStarC_TypeChecker_Env.use_eq_strict); - FStarC_TypeChecker_Env.is_iface = - (env2.FStarC_TypeChecker_Env.is_iface); - FStarC_TypeChecker_Env.admit = - (env2.FStarC_TypeChecker_Env.admit); - FStarC_TypeChecker_Env.lax_universes = - (env2.FStarC_TypeChecker_Env.lax_universes); - FStarC_TypeChecker_Env.phase1 = - (env2.FStarC_TypeChecker_Env.phase1); - FStarC_TypeChecker_Env.failhard = - (env2.FStarC_TypeChecker_Env.failhard); - FStarC_TypeChecker_Env.flychecking = - (env2.FStarC_TypeChecker_Env.flychecking); - FStarC_TypeChecker_Env.uvar_subtyping = - (env2.FStarC_TypeChecker_Env.uvar_subtyping); - FStarC_TypeChecker_Env.intactics = - (env2.FStarC_TypeChecker_Env.intactics); - FStarC_TypeChecker_Env.nocoerce = - (env2.FStarC_TypeChecker_Env.nocoerce); - FStarC_TypeChecker_Env.tc_term = - (env2.FStarC_TypeChecker_Env.tc_term); - FStarC_TypeChecker_Env.typeof_tot_or_gtot_term = - (env2.FStarC_TypeChecker_Env.typeof_tot_or_gtot_term); - FStarC_TypeChecker_Env.universe_of = - (env2.FStarC_TypeChecker_Env.universe_of); - FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term = - (env2.FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); - FStarC_TypeChecker_Env.teq_nosmt_force = - (env2.FStarC_TypeChecker_Env.teq_nosmt_force); - FStarC_TypeChecker_Env.subtype_nosmt_force = - (env2.FStarC_TypeChecker_Env.subtype_nosmt_force); - FStarC_TypeChecker_Env.qtbl_name_and_index = - (env2.FStarC_TypeChecker_Env.qtbl_name_and_index); - FStarC_TypeChecker_Env.normalized_eff_names = - (env2.FStarC_TypeChecker_Env.normalized_eff_names); - FStarC_TypeChecker_Env.fv_delta_depths = - (env2.FStarC_TypeChecker_Env.fv_delta_depths); - FStarC_TypeChecker_Env.proof_ns = - (env2.FStarC_TypeChecker_Env.proof_ns); - FStarC_TypeChecker_Env.synth_hook = - (env2.FStarC_TypeChecker_Env.synth_hook); - FStarC_TypeChecker_Env.try_solve_implicits_hook = - (env2.FStarC_TypeChecker_Env.try_solve_implicits_hook); - FStarC_TypeChecker_Env.splice = - (env2.FStarC_TypeChecker_Env.splice); - FStarC_TypeChecker_Env.mpreprocess = - (env2.FStarC_TypeChecker_Env.mpreprocess); - FStarC_TypeChecker_Env.postprocess = - (env2.FStarC_TypeChecker_Env.postprocess); - FStarC_TypeChecker_Env.identifier_info = - (env2.FStarC_TypeChecker_Env.identifier_info); - FStarC_TypeChecker_Env.tc_hooks = - (env2.FStarC_TypeChecker_Env.tc_hooks); - FStarC_TypeChecker_Env.dsenv = dsenv; - FStarC_TypeChecker_Env.nbe = - (env2.FStarC_TypeChecker_Env.nbe); - FStarC_TypeChecker_Env.strict_args_tab = - (env2.FStarC_TypeChecker_Env.strict_args_tab); - FStarC_TypeChecker_Env.erasable_types_tab = - (env2.FStarC_TypeChecker_Env.erasable_types_tab); - FStarC_TypeChecker_Env.enable_defer_to_tac = - (env2.FStarC_TypeChecker_Env.enable_defer_to_tac); - FStarC_TypeChecker_Env.unif_allow_ref_guards = - (env2.FStarC_TypeChecker_Env.unif_allow_ref_guards); - FStarC_TypeChecker_Env.erase_erasable_args = - (env2.FStarC_TypeChecker_Env.erase_erasable_args); - FStarC_TypeChecker_Env.core_check = - (env2.FStarC_TypeChecker_Env.core_check); - FStarC_TypeChecker_Env.missing_decl = - (env2.FStarC_TypeChecker_Env.missing_decl) - } in - let env4 = - FStarC_TypeChecker_Env.set_current_module env3 test_lid in - FStarC_Compiler_Effect.op_Colon_Equals tcenv_ref - (FStar_Pervasives_Native.Some env4))) -let (uu___0 : unit) = FStarC_Main.setup_hooks (); init_once () -let (init : unit -> FStarC_TypeChecker_Env.env) = - fun uu___ -> - let uu___1 = FStarC_Compiler_Effect.op_Bang tcenv_ref in - match uu___1 with - | FStar_Pervasives_Native.Some f -> f - | uu___2 -> - failwith - "Should have already been initialized by the top-level effect" -let (frag_of_text : Prims.string -> FStarC_Parser_ParseIt.input_frag) = - fun s -> - { - FStarC_Parser_ParseIt.frag_fname = " input"; - FStarC_Parser_ParseIt.frag_text = s; - FStarC_Parser_ParseIt.frag_line = Prims.int_one; - FStarC_Parser_ParseIt.frag_col = Prims.int_zero - } -let (pars : Prims.string -> FStarC_Syntax_Syntax.term) = - fun s -> - try - (fun uu___ -> - match () with - | () -> - let tcenv = init () in - let uu___1 = - FStarC_Parser_ParseIt.parse FStar_Pervasives_Native.None - (FStarC_Parser_ParseIt.Fragment (frag_of_text s)) in - (match uu___1 with - | FStarC_Parser_ParseIt.Term t -> - FStarC_ToSyntax_ToSyntax.desugar_term - tcenv.FStarC_TypeChecker_Env.dsenv t - | FStarC_Parser_ParseIt.ParseError (e, msg, r) -> - FStarC_Errors.raise_error - FStarC_Class_HasRange.hasRange_range r e () - (Obj.magic FStarC_Errors_Msg.is_error_message_list_doc) - (Obj.magic msg) - | FStarC_Parser_ParseIt.ASTFragment uu___2 -> - failwith - "Impossible: parsing a Fragment always results in a Term")) - () - with - | FStarC_Errors.Error (err, msg, r, _ctx) when - let uu___1 = FStarC_Options.trace_error () in - Prims.op_Negation uu___1 -> - (if r = FStarC_Compiler_Range_Type.dummyRange - then - (let uu___2 = FStarC_Errors_Msg.rendermsg msg in - FStarC_Compiler_Util.print_string uu___2) - else - (let uu___3 = FStarC_Compiler_Range_Ops.string_of_range r in - let uu___4 = FStarC_Errors_Msg.rendermsg msg in - FStarC_Compiler_Util.print2 "%s: %s\n" uu___3 uu___4); - FStarC_Compiler_Effect.exit Prims.int_one) - | e when - let uu___1 = FStarC_Options.trace_error () in - Prims.op_Negation uu___1 -> FStarC_Compiler_Effect.raise e -let (tc' : - Prims.string -> (FStarC_Syntax_Syntax.term * FStarC_TypeChecker_Env.env)) = - fun s -> - let tm = pars s in - let tcenv = init () in - let tcenv1 = - { - FStarC_TypeChecker_Env.solver = (tcenv.FStarC_TypeChecker_Env.solver); - FStarC_TypeChecker_Env.range = (tcenv.FStarC_TypeChecker_Env.range); - FStarC_TypeChecker_Env.curmodule = - (tcenv.FStarC_TypeChecker_Env.curmodule); - FStarC_TypeChecker_Env.gamma = (tcenv.FStarC_TypeChecker_Env.gamma); - FStarC_TypeChecker_Env.gamma_sig = - (tcenv.FStarC_TypeChecker_Env.gamma_sig); - FStarC_TypeChecker_Env.gamma_cache = - (tcenv.FStarC_TypeChecker_Env.gamma_cache); - FStarC_TypeChecker_Env.modules = - (tcenv.FStarC_TypeChecker_Env.modules); - FStarC_TypeChecker_Env.expected_typ = - (tcenv.FStarC_TypeChecker_Env.expected_typ); - FStarC_TypeChecker_Env.sigtab = (tcenv.FStarC_TypeChecker_Env.sigtab); - FStarC_TypeChecker_Env.attrtab = - (tcenv.FStarC_TypeChecker_Env.attrtab); - FStarC_TypeChecker_Env.instantiate_imp = - (tcenv.FStarC_TypeChecker_Env.instantiate_imp); - FStarC_TypeChecker_Env.effects = - (tcenv.FStarC_TypeChecker_Env.effects); - FStarC_TypeChecker_Env.generalize = - (tcenv.FStarC_TypeChecker_Env.generalize); - FStarC_TypeChecker_Env.letrecs = - (tcenv.FStarC_TypeChecker_Env.letrecs); - FStarC_TypeChecker_Env.top_level = false; - FStarC_TypeChecker_Env.check_uvars = - (tcenv.FStarC_TypeChecker_Env.check_uvars); - FStarC_TypeChecker_Env.use_eq_strict = - (tcenv.FStarC_TypeChecker_Env.use_eq_strict); - FStarC_TypeChecker_Env.is_iface = - (tcenv.FStarC_TypeChecker_Env.is_iface); - FStarC_TypeChecker_Env.admit = (tcenv.FStarC_TypeChecker_Env.admit); - FStarC_TypeChecker_Env.lax_universes = - (tcenv.FStarC_TypeChecker_Env.lax_universes); - FStarC_TypeChecker_Env.phase1 = true; - FStarC_TypeChecker_Env.failhard = - (tcenv.FStarC_TypeChecker_Env.failhard); - FStarC_TypeChecker_Env.flychecking = - (tcenv.FStarC_TypeChecker_Env.flychecking); - FStarC_TypeChecker_Env.uvar_subtyping = - (tcenv.FStarC_TypeChecker_Env.uvar_subtyping); - FStarC_TypeChecker_Env.intactics = - (tcenv.FStarC_TypeChecker_Env.intactics); - FStarC_TypeChecker_Env.nocoerce = - (tcenv.FStarC_TypeChecker_Env.nocoerce); - FStarC_TypeChecker_Env.tc_term = - (tcenv.FStarC_TypeChecker_Env.tc_term); - FStarC_TypeChecker_Env.typeof_tot_or_gtot_term = - (tcenv.FStarC_TypeChecker_Env.typeof_tot_or_gtot_term); - FStarC_TypeChecker_Env.universe_of = - (tcenv.FStarC_TypeChecker_Env.universe_of); - FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term = - (tcenv.FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); - FStarC_TypeChecker_Env.teq_nosmt_force = - (tcenv.FStarC_TypeChecker_Env.teq_nosmt_force); - FStarC_TypeChecker_Env.subtype_nosmt_force = - (tcenv.FStarC_TypeChecker_Env.subtype_nosmt_force); - FStarC_TypeChecker_Env.qtbl_name_and_index = - (tcenv.FStarC_TypeChecker_Env.qtbl_name_and_index); - FStarC_TypeChecker_Env.normalized_eff_names = - (tcenv.FStarC_TypeChecker_Env.normalized_eff_names); - FStarC_TypeChecker_Env.fv_delta_depths = - (tcenv.FStarC_TypeChecker_Env.fv_delta_depths); - FStarC_TypeChecker_Env.proof_ns = - (tcenv.FStarC_TypeChecker_Env.proof_ns); - FStarC_TypeChecker_Env.synth_hook = - (tcenv.FStarC_TypeChecker_Env.synth_hook); - FStarC_TypeChecker_Env.try_solve_implicits_hook = - (tcenv.FStarC_TypeChecker_Env.try_solve_implicits_hook); - FStarC_TypeChecker_Env.splice = (tcenv.FStarC_TypeChecker_Env.splice); - FStarC_TypeChecker_Env.mpreprocess = - (tcenv.FStarC_TypeChecker_Env.mpreprocess); - FStarC_TypeChecker_Env.postprocess = - (tcenv.FStarC_TypeChecker_Env.postprocess); - FStarC_TypeChecker_Env.identifier_info = - (tcenv.FStarC_TypeChecker_Env.identifier_info); - FStarC_TypeChecker_Env.tc_hooks = - (tcenv.FStarC_TypeChecker_Env.tc_hooks); - FStarC_TypeChecker_Env.dsenv = (tcenv.FStarC_TypeChecker_Env.dsenv); - FStarC_TypeChecker_Env.nbe = (tcenv.FStarC_TypeChecker_Env.nbe); - FStarC_TypeChecker_Env.strict_args_tab = - (tcenv.FStarC_TypeChecker_Env.strict_args_tab); - FStarC_TypeChecker_Env.erasable_types_tab = - (tcenv.FStarC_TypeChecker_Env.erasable_types_tab); - FStarC_TypeChecker_Env.enable_defer_to_tac = - (tcenv.FStarC_TypeChecker_Env.enable_defer_to_tac); - FStarC_TypeChecker_Env.unif_allow_ref_guards = - (tcenv.FStarC_TypeChecker_Env.unif_allow_ref_guards); - FStarC_TypeChecker_Env.erase_erasable_args = - (tcenv.FStarC_TypeChecker_Env.erase_erasable_args); - FStarC_TypeChecker_Env.core_check = - (tcenv.FStarC_TypeChecker_Env.core_check); - FStarC_TypeChecker_Env.missing_decl = - (tcenv.FStarC_TypeChecker_Env.missing_decl) - } in - let uu___ = FStarC_TypeChecker_TcTerm.tc_tot_or_gtot_term tcenv1 tm in - match uu___ with - | (tm1, uu___1, g) -> - (FStarC_TypeChecker_Rel.force_trivial_guard tcenv1 g; - (let tm2 = FStarC_Syntax_Compress.deep_compress false false tm1 in - (tm2, tcenv1))) -let (tc : Prims.string -> FStarC_Syntax_Syntax.term) = - fun s -> let uu___ = tc' s in match uu___ with | (tm, uu___1) -> tm -let (tc_term : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = - fun tm -> - let tcenv = init () in - let tcenv1 = - { - FStarC_TypeChecker_Env.solver = (tcenv.FStarC_TypeChecker_Env.solver); - FStarC_TypeChecker_Env.range = (tcenv.FStarC_TypeChecker_Env.range); - FStarC_TypeChecker_Env.curmodule = - (tcenv.FStarC_TypeChecker_Env.curmodule); - FStarC_TypeChecker_Env.gamma = (tcenv.FStarC_TypeChecker_Env.gamma); - FStarC_TypeChecker_Env.gamma_sig = - (tcenv.FStarC_TypeChecker_Env.gamma_sig); - FStarC_TypeChecker_Env.gamma_cache = - (tcenv.FStarC_TypeChecker_Env.gamma_cache); - FStarC_TypeChecker_Env.modules = - (tcenv.FStarC_TypeChecker_Env.modules); - FStarC_TypeChecker_Env.expected_typ = - (tcenv.FStarC_TypeChecker_Env.expected_typ); - FStarC_TypeChecker_Env.sigtab = (tcenv.FStarC_TypeChecker_Env.sigtab); - FStarC_TypeChecker_Env.attrtab = - (tcenv.FStarC_TypeChecker_Env.attrtab); - FStarC_TypeChecker_Env.instantiate_imp = - (tcenv.FStarC_TypeChecker_Env.instantiate_imp); - FStarC_TypeChecker_Env.effects = - (tcenv.FStarC_TypeChecker_Env.effects); - FStarC_TypeChecker_Env.generalize = - (tcenv.FStarC_TypeChecker_Env.generalize); - FStarC_TypeChecker_Env.letrecs = - (tcenv.FStarC_TypeChecker_Env.letrecs); - FStarC_TypeChecker_Env.top_level = false; - FStarC_TypeChecker_Env.check_uvars = - (tcenv.FStarC_TypeChecker_Env.check_uvars); - FStarC_TypeChecker_Env.use_eq_strict = - (tcenv.FStarC_TypeChecker_Env.use_eq_strict); - FStarC_TypeChecker_Env.is_iface = - (tcenv.FStarC_TypeChecker_Env.is_iface); - FStarC_TypeChecker_Env.admit = (tcenv.FStarC_TypeChecker_Env.admit); - FStarC_TypeChecker_Env.lax_universes = - (tcenv.FStarC_TypeChecker_Env.lax_universes); - FStarC_TypeChecker_Env.phase1 = (tcenv.FStarC_TypeChecker_Env.phase1); - FStarC_TypeChecker_Env.failhard = - (tcenv.FStarC_TypeChecker_Env.failhard); - FStarC_TypeChecker_Env.flychecking = - (tcenv.FStarC_TypeChecker_Env.flychecking); - FStarC_TypeChecker_Env.uvar_subtyping = - (tcenv.FStarC_TypeChecker_Env.uvar_subtyping); - FStarC_TypeChecker_Env.intactics = - (tcenv.FStarC_TypeChecker_Env.intactics); - FStarC_TypeChecker_Env.nocoerce = - (tcenv.FStarC_TypeChecker_Env.nocoerce); - FStarC_TypeChecker_Env.tc_term = - (tcenv.FStarC_TypeChecker_Env.tc_term); - FStarC_TypeChecker_Env.typeof_tot_or_gtot_term = - (tcenv.FStarC_TypeChecker_Env.typeof_tot_or_gtot_term); - FStarC_TypeChecker_Env.universe_of = - (tcenv.FStarC_TypeChecker_Env.universe_of); - FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term = - (tcenv.FStarC_TypeChecker_Env.typeof_well_typed_tot_or_gtot_term); - FStarC_TypeChecker_Env.teq_nosmt_force = - (tcenv.FStarC_TypeChecker_Env.teq_nosmt_force); - FStarC_TypeChecker_Env.subtype_nosmt_force = - (tcenv.FStarC_TypeChecker_Env.subtype_nosmt_force); - FStarC_TypeChecker_Env.qtbl_name_and_index = - (tcenv.FStarC_TypeChecker_Env.qtbl_name_and_index); - FStarC_TypeChecker_Env.normalized_eff_names = - (tcenv.FStarC_TypeChecker_Env.normalized_eff_names); - FStarC_TypeChecker_Env.fv_delta_depths = - (tcenv.FStarC_TypeChecker_Env.fv_delta_depths); - FStarC_TypeChecker_Env.proof_ns = - (tcenv.FStarC_TypeChecker_Env.proof_ns); - FStarC_TypeChecker_Env.synth_hook = - (tcenv.FStarC_TypeChecker_Env.synth_hook); - FStarC_TypeChecker_Env.try_solve_implicits_hook = - (tcenv.FStarC_TypeChecker_Env.try_solve_implicits_hook); - FStarC_TypeChecker_Env.splice = (tcenv.FStarC_TypeChecker_Env.splice); - FStarC_TypeChecker_Env.mpreprocess = - (tcenv.FStarC_TypeChecker_Env.mpreprocess); - FStarC_TypeChecker_Env.postprocess = - (tcenv.FStarC_TypeChecker_Env.postprocess); - FStarC_TypeChecker_Env.identifier_info = - (tcenv.FStarC_TypeChecker_Env.identifier_info); - FStarC_TypeChecker_Env.tc_hooks = - (tcenv.FStarC_TypeChecker_Env.tc_hooks); - FStarC_TypeChecker_Env.dsenv = (tcenv.FStarC_TypeChecker_Env.dsenv); - FStarC_TypeChecker_Env.nbe = (tcenv.FStarC_TypeChecker_Env.nbe); - FStarC_TypeChecker_Env.strict_args_tab = - (tcenv.FStarC_TypeChecker_Env.strict_args_tab); - FStarC_TypeChecker_Env.erasable_types_tab = - (tcenv.FStarC_TypeChecker_Env.erasable_types_tab); - FStarC_TypeChecker_Env.enable_defer_to_tac = - (tcenv.FStarC_TypeChecker_Env.enable_defer_to_tac); - FStarC_TypeChecker_Env.unif_allow_ref_guards = - (tcenv.FStarC_TypeChecker_Env.unif_allow_ref_guards); - FStarC_TypeChecker_Env.erase_erasable_args = - (tcenv.FStarC_TypeChecker_Env.erase_erasable_args); - FStarC_TypeChecker_Env.core_check = - (tcenv.FStarC_TypeChecker_Env.core_check); - FStarC_TypeChecker_Env.missing_decl = - (tcenv.FStarC_TypeChecker_Env.missing_decl) - } in - let uu___ = FStarC_TypeChecker_TcTerm.tc_tot_or_gtot_term tcenv1 tm in - match uu___ with - | (tm1, uu___1, g) -> - (FStarC_TypeChecker_Rel.force_trivial_guard tcenv1 g; - (let tm2 = FStarC_Syntax_Compress.deep_compress false false tm1 in - tm2)) -let (pars_and_tc_fragment : Prims.string -> unit) = - fun s -> - FStarC_Options.set_option "trace_error" (FStarC_Options.Bool true); - (let report uu___1 = let uu___2 = FStarC_Errors.report_all () in () in - try - (fun uu___1 -> - match () with - | () -> - let tcenv = init () in - let frag = frag_of_text s in - (try - (fun uu___2 -> - match () with - | () -> - let uu___3 = - let uu___4 = - FStarC_Compiler_Effect.op_Bang test_mod_ref in - FStarC_Universal.tc_one_fragment uu___4 tcenv - (FStar_Pervasives.Inl (frag, [])) in - (match uu___3 with - | (test_mod', tcenv', uu___4) -> - (FStarC_Compiler_Effect.op_Colon_Equals - test_mod_ref test_mod'; - FStarC_Compiler_Effect.op_Colon_Equals - tcenv_ref - (FStar_Pervasives_Native.Some tcenv'); - (let n = FStarC_Errors.get_err_count () in - if n <> Prims.int_zero - then - (report (); - (let uu___8 = - let uu___9 = - FStarC_Compiler_Util.string_of_int n in - FStarC_Compiler_Util.format1 - "%s errors were reported" uu___9 in - FStarC_Errors.raise_error0 - FStarC_Errors_Codes.Fatal_ErrorsReported - () - (Obj.magic - FStarC_Errors_Msg.is_error_message_string) - (Obj.magic uu___8))) - else ())))) () - with - | uu___2 -> - (report (); - FStarC_Errors.raise_error0 - FStarC_Errors_Codes.Fatal_TcOneFragmentFailed () - (Obj.magic FStarC_Errors_Msg.is_error_message_string) - (Obj.magic (Prims.strcat "tc_one_fragment failed: " s))))) - () - with - | uu___1 -> - ((fun uu___1 -> - if - let uu___2 = FStarC_Options.trace_error () in - Prims.op_Negation uu___2 - then Obj.magic (Obj.repr (FStarC_Compiler_Effect.raise uu___1)) - else Obj.magic (Obj.repr (failwith "unreachable")))) uu___1) -let (test_hashes : unit -> unit) = - fun uu___ -> - (let uu___2 = FStarC_Main.process_args () in ()); - pars_and_tc_fragment "type unary_nat = | U0 | US of unary_nat"; - (let test_one_hash n = - let rec aux n1 = - if n1 = Prims.int_zero - then "U0" - else - (let uu___4 = - let uu___5 = aux (n1 - Prims.int_one) in - Prims.strcat uu___5 ")" in - Prims.strcat "(US " uu___4) in - let tm = let uu___3 = aux n in tc uu___3 in - let hc = FStarC_Syntax_Hash.ext_hash_term tm in - let uu___3 = FStarC_Compiler_Util.string_of_int n in - let uu___4 = FStarC_Hash.string_of_hash_code hc in - FStarC_Compiler_Util.print2 "Hash of unary %s is %s\n" uu___3 uu___4 in - let rec aux n = - if n = Prims.int_zero - then () - else (test_one_hash n; aux (n - Prims.int_one)) in - aux (Prims.of_int (100)); FStarC_Options.init ()) -let (parse_incremental_decls : unit -> unit) = - fun uu___ -> - let source0 = - "module Demo\nlet f x = match x with | Some x -> true | None -> false\nlet test y = if Some? y then f y else true\n```pulse\nfn f() {}\n```\n```pulse\nfn g() {}\n```\nlet something = more\nlet >< junk" in - let source1 = - "module Demo\nlet f x = match x with | Some x -> true | None -> false\nlet test y = if Some? y then f y else true\n```pulse\nfn f() {}\n```\n\n```pulse\nfn g() {}\n```\nlet something = more\nlet >< junk" in - let input0 = - FStarC_Parser_ParseIt.Incremental - { - FStarC_Parser_ParseIt.frag_fname = "Demo.fst"; - FStarC_Parser_ParseIt.frag_text = source0; - FStarC_Parser_ParseIt.frag_line = Prims.int_one; - FStarC_Parser_ParseIt.frag_col = Prims.int_zero - } in - let input1 = - FStarC_Parser_ParseIt.Incremental - { - FStarC_Parser_ParseIt.frag_fname = "Demo.fst"; - FStarC_Parser_ParseIt.frag_text = source1; - FStarC_Parser_ParseIt.frag_line = Prims.int_one; - FStarC_Parser_ParseIt.frag_col = Prims.int_zero - } in - let uu___1 = - let uu___2 = - FStarC_Parser_ParseIt.parse FStar_Pervasives_Native.None input0 in - let uu___3 = - FStarC_Parser_ParseIt.parse FStar_Pervasives_Native.None input1 in - (uu___2, uu___3) in - match uu___1 with - | (FStarC_Parser_ParseIt.IncrementalFragment - (decls0, uu___2, parse_err0), - FStarC_Parser_ParseIt.IncrementalFragment - (decls1, uu___3, parse_err1)) -> - let check_range r l c = - let p = FStarC_Compiler_Range_Ops.start_of_range r in - let uu___4 = - (let uu___5 = FStarC_Compiler_Range_Ops.line_of_pos p in - uu___5 = l) && - (let uu___5 = FStarC_Compiler_Range_Ops.col_of_pos p in - uu___5 = c) in - if uu___4 - then () - else - (let uu___6 = - let uu___7 = FStarC_Compiler_Util.string_of_int l in - let uu___8 = FStarC_Compiler_Util.string_of_int c in - let uu___9 = - let uu___10 = FStarC_Compiler_Range_Ops.line_of_pos p in - FStarC_Compiler_Util.string_of_int uu___10 in - let uu___10 = - let uu___11 = FStarC_Compiler_Range_Ops.col_of_pos p in - FStarC_Compiler_Util.string_of_int uu___11 in - FStarC_Compiler_Util.format4 - "Incremental parsing failed: Expected syntax error at (%s, %s), got error at (%s, %s)" - uu___7 uu___8 uu___9 uu___10 in - failwith uu___6) in - ((match (parse_err0, parse_err1) with - | (FStar_Pervasives_Native.None, uu___5) -> - failwith - "Incremental parsing failed: Expected syntax error at (8, 6), got no error" - | (uu___5, FStar_Pervasives_Native.None) -> - failwith - "Incremental parsing failed: Expected syntax error at (9, 6), got no error" - | (FStar_Pervasives_Native.Some (uu___5, uu___6, rng0), - FStar_Pervasives_Native.Some (uu___7, uu___8, rng1)) -> - (check_range rng0 (Prims.of_int (11)) (Prims.of_int (6)); - check_range rng1 (Prims.of_int (12)) (Prims.of_int (6)))); - (match (decls0, decls1) with - | (d0::d1::d2::d3::d4::d5::[], e0::e1::e2::e3::e4::e5::[]) -> - let uu___5 = - FStarC_Compiler_List.forall2 - (fun uu___6 -> - fun uu___7 -> - match (uu___6, uu___7) with - | ((x, uu___8), (y, uu___9)) -> - FStarC_Parser_AST_Util.eq_decl x y) decls0 decls1 in - if uu___5 - then () - else - failwith - "Incremental parsing failed; unexpected change in a decl" - | uu___5 -> - let uu___6 = - let uu___7 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length decls0) in - let uu___8 = - FStarC_Compiler_Util.string_of_int - (FStarC_Compiler_List.length decls1) in - FStarC_Compiler_Util.format2 - "Incremental parsing failed; expected 6 decls got %s and %s\n" - uu___7 uu___8 in - failwith uu___6)) - | (FStarC_Parser_ParseIt.ParseError (code, message, range), uu___2) -> - let msg = - let uu___3 = FStarC_Compiler_Range_Ops.string_of_range range in - let uu___4 = FStarC_Errors_Msg.rendermsg message in - FStarC_Compiler_Util.format2 - "Incremental parsing failed: Syntax error @ %s: %s" uu___3 uu___4 in - failwith msg - | (uu___2, FStarC_Parser_ParseIt.ParseError (code, message, range)) -> - let msg = - let uu___3 = FStarC_Compiler_Range_Ops.string_of_range range in - let uu___4 = FStarC_Errors_Msg.rendermsg message in - FStarC_Compiler_Util.format2 - "Incremental parsing failed: Syntax error @ %s: %s" uu___3 uu___4 in - failwith msg - | uu___2 -> failwith "Incremental parsing failed: Unexpected output" -let (parse_incremental_decls_use_lang : unit -> unit) = - fun uu___ -> - let source0 = - "module Demo\nlet x = 0\n#lang-somelang\nval f : t\nlet g x = f x\n#restart-solver" in - FStarC_Parser_AST_Util.register_extension_lang_parser "somelang" - FStarC_Parser_ParseIt.parse_fstar_incrementally; - (let input0 = - FStarC_Parser_ParseIt.Incremental - { - FStarC_Parser_ParseIt.frag_fname = "Demo.fst"; - FStarC_Parser_ParseIt.frag_text = source0; - FStarC_Parser_ParseIt.frag_line = Prims.int_one; - FStarC_Parser_ParseIt.frag_col = Prims.int_zero - } in - let uu___2 = - FStarC_Parser_ParseIt.parse FStar_Pervasives_Native.None input0 in - match uu___2 with - | FStarC_Parser_ParseIt.IncrementalFragment (decls0, uu___3, parse_err0) - -> - ((match parse_err0 with - | FStar_Pervasives_Native.None -> () - | FStar_Pervasives_Native.Some uu___5 -> - failwith "Incremental parsing failed: ..."); - (let ds = - FStarC_Compiler_List.map FStar_Pervasives_Native.fst decls0 in - match ds with - | { FStarC_Parser_AST.d = FStarC_Parser_AST.TopLevelModule uu___5; - FStarC_Parser_AST.drange = uu___6; - FStarC_Parser_AST.quals = uu___7; - FStarC_Parser_AST.attrs = uu___8; - FStarC_Parser_AST.interleaved = uu___9;_}::{ - FStarC_Parser_AST.d - = - FStarC_Parser_AST.TopLevelLet - uu___10; - FStarC_Parser_AST.drange - = uu___11; - FStarC_Parser_AST.quals - = uu___12; - FStarC_Parser_AST.attrs - = uu___13; - FStarC_Parser_AST.interleaved - = uu___14;_}:: - { - FStarC_Parser_AST.d = FStarC_Parser_AST.UseLangDecls uu___15; - FStarC_Parser_AST.drange = uu___16; - FStarC_Parser_AST.quals = uu___17; - FStarC_Parser_AST.attrs = uu___18; - FStarC_Parser_AST.interleaved = uu___19;_}::{ - FStarC_Parser_AST.d - = - FStarC_Parser_AST.Val - uu___20; - FStarC_Parser_AST.drange - = uu___21; - FStarC_Parser_AST.quals - = uu___22; - FStarC_Parser_AST.attrs - = uu___23; - FStarC_Parser_AST.interleaved - = uu___24;_}:: - { FStarC_Parser_AST.d = FStarC_Parser_AST.TopLevelLet uu___25; - FStarC_Parser_AST.drange = uu___26; - FStarC_Parser_AST.quals = uu___27; - FStarC_Parser_AST.attrs = uu___28; - FStarC_Parser_AST.interleaved = uu___29;_}::{ - FStarC_Parser_AST.d - = - FStarC_Parser_AST.Pragma - uu___30; - FStarC_Parser_AST.drange - = uu___31; - FStarC_Parser_AST.quals - = uu___32; - FStarC_Parser_AST.attrs - = uu___33; - FStarC_Parser_AST.interleaved - = uu___34;_}::[] - -> () - | uu___5 -> - let uu___6 = - let uu___7 = - FStarC_Class_Show.show - (FStarC_Class_Show.show_list - FStarC_Parser_AST.showable_decl) ds in - Prims.strcat - "Incremental parsing failed; unexpected decls: " uu___7 in - failwith uu___6)) - | FStarC_Parser_ParseIt.ParseError (code, message, range) -> - let msg = - let uu___3 = FStarC_Compiler_Range_Ops.string_of_range range in - let uu___4 = FStarC_Errors_Msg.rendermsg message in - FStarC_Compiler_Util.format2 - "Incremental parsing failed: Syntax error @ %s: %s" uu___3 - uu___4 in - failwith msg - | uu___3 -> failwith "Incremental parsing failed: Unexpected output") \ No newline at end of file diff --git a/stage0/fstar-tests/generated/FStarC_Tests_Test.ml b/stage0/fstar-tests/generated/FStarC_Tests_Test.ml deleted file mode 100644 index 77eebd37d01..00000000000 --- a/stage0/fstar-tests/generated/FStarC_Tests_Test.ml +++ /dev/null @@ -1,73 +0,0 @@ -open Prims -let main : 'uuuuu 'uuuuu1 . 'uuuuu -> 'uuuuu1 = - fun argv -> - FStarC_Compiler_Util.print_string "Initializing tests...\n"; - (try - (fun uu___1 -> - match () with - | () -> - let uu___2 = FStarC_Options.parse_cmd_line () in - (match uu___2 with - | (res, fs) -> - (match res with - | FStarC_Getopt.Help -> - (FStarC_Compiler_Util.print_string - "F* unit tests. This binary can take the same options as F*, but not all of them are meaningful."; - FStarC_Compiler_Effect.exit Prims.int_zero) - | FStarC_Getopt.Error (msg, uu___3) -> - (FStarC_Compiler_Util.print_error msg; - FStarC_Compiler_Effect.exit Prims.int_one) - | FStarC_Getopt.Empty -> - (FStarC_Main.setup_hooks (); - (let uu___5 = FStarC_Tests_Pars.init () in ()); - FStarC_Tests_Pars.parse_incremental_decls (); - FStarC_Tests_Pars.parse_incremental_decls_use_lang - (); - FStarC_Tests_Norm.run_all (); - (let uu___9 = FStarC_Tests_Unif.run_all () in - if uu___9 - then () - else FStarC_Compiler_Effect.exit Prims.int_one); - FStarC_Tests_Data.run_all (); - (let uu___11 = FStarC_Errors.report_all () in ()); - (let nerrs = FStarC_Errors.get_err_count () in - if nerrs > Prims.int_zero - then FStarC_Compiler_Effect.exit Prims.int_one - else (); - FStarC_Compiler_Effect.exit Prims.int_zero)) - | FStarC_Getopt.Success -> - (FStarC_Main.setup_hooks (); - (let uu___5 = FStarC_Tests_Pars.init () in ()); - FStarC_Tests_Pars.parse_incremental_decls (); - FStarC_Tests_Pars.parse_incremental_decls_use_lang - (); - FStarC_Tests_Norm.run_all (); - (let uu___9 = FStarC_Tests_Unif.run_all () in - if uu___9 - then () - else FStarC_Compiler_Effect.exit Prims.int_one); - FStarC_Tests_Data.run_all (); - (let uu___11 = FStarC_Errors.report_all () in ()); - (let nerrs = FStarC_Errors.get_err_count () in - if nerrs > Prims.int_zero - then FStarC_Compiler_Effect.exit Prims.int_one - else (); - FStarC_Compiler_Effect.exit Prims.int_zero))))) () - with - | FStarC_Errors.Error (err, msg, r, _ctx) when - let uu___2 = FStarC_Options.trace_error () in - Prims.op_Negation uu___2 -> - (if r = FStarC_Compiler_Range_Type.dummyRange - then - (let uu___3 = FStarC_Errors_Msg.rendermsg msg in - FStarC_Compiler_Util.print_string uu___3) - else - (let uu___4 = FStarC_Compiler_Range_Ops.string_of_range r in - let uu___5 = FStarC_Errors_Msg.rendermsg msg in - FStarC_Compiler_Util.print2 "%s: %s\n" uu___4 uu___5); - FStarC_Compiler_Effect.exit Prims.int_one) - | e -> - ((let uu___3 = FStarC_Compiler_Util.message_of_exn e in - let uu___4 = FStarC_Compiler_Util.trace_of_exn e in - FStarC_Compiler_Util.print2_error "Error\n%s\n%s\n" uu___3 uu___4); - FStarC_Compiler_Effect.exit Prims.int_one)) \ No newline at end of file diff --git a/stage0/fstar-tests/generated/FStarC_Tests_Unif.ml b/stage0/fstar-tests/generated/FStarC_Tests_Unif.ml deleted file mode 100644 index 19566a6d979..00000000000 --- a/stage0/fstar-tests/generated/FStarC_Tests_Unif.ml +++ /dev/null @@ -1,590 +0,0 @@ -open Prims -let (tcenv : unit -> FStarC_TypeChecker_Env.env) = - fun uu___ -> FStarC_Tests_Pars.init () -let (guard_to_string : - FStarC_TypeChecker_Common.guard_formula -> Prims.string) = - fun g -> - match g with - | FStarC_TypeChecker_Common.Trivial -> "trivial" - | FStarC_TypeChecker_Common.NonTrivial f -> - let uu___ = tcenv () in - FStarC_TypeChecker_Normalize.term_to_string uu___ f -let (success : Prims.bool FStarC_Compiler_Effect.ref) = - FStarC_Compiler_Util.mk_ref true -let (fail : Prims.string -> unit) = - fun msg -> - FStarC_Compiler_Util.print_string msg; - FStarC_Compiler_Effect.op_Colon_Equals success false -let (guard_eq : - Prims.int -> - FStarC_TypeChecker_Common.guard_formula -> - FStarC_TypeChecker_Common.guard_formula -> unit) - = - fun i -> - fun g -> - fun g' -> - let uu___ = - match (g, g') with - | (FStarC_TypeChecker_Common.Trivial, - FStarC_TypeChecker_Common.Trivial) -> (true, g, g') - | (FStarC_TypeChecker_Common.NonTrivial f, - FStarC_TypeChecker_Common.NonTrivial f') -> - let f1 = - let uu___1 = tcenv () in - FStarC_TypeChecker_Normalize.normalize - [FStarC_TypeChecker_Env.EraseUniverses] uu___1 f in - let f'1 = - let uu___1 = tcenv () in - FStarC_TypeChecker_Normalize.normalize - [FStarC_TypeChecker_Env.EraseUniverses] uu___1 f' in - let uu___1 = FStarC_Tests_Util.term_eq f1 f'1 in - (uu___1, (FStarC_TypeChecker_Common.NonTrivial f1), - (FStarC_TypeChecker_Common.NonTrivial f'1)) - | uu___1 -> (false, g, g') in - match uu___ with - | (b, g1, g'1) -> - (if Prims.op_Negation b - then - (let uu___2 = - let uu___3 = FStarC_Compiler_Util.string_of_int i in - let uu___4 = guard_to_string g'1 in - let uu___5 = guard_to_string g1 in - FStarC_Compiler_Util.format3 - "Test %s failed:\n\tExpected guard %s;\n\tGot guard %s\n" - uu___3 uu___4 uu___5 in - fail uu___2) - else (); - (let uu___2 = (FStarC_Compiler_Effect.op_Bang success) && b in - FStarC_Compiler_Effect.op_Colon_Equals success uu___2)) -let (unify : - Prims.int -> - FStarC_Syntax_Syntax.bv Prims.list -> - FStarC_Syntax_Syntax.typ -> - FStarC_Syntax_Syntax.typ -> - FStarC_TypeChecker_Common.guard_formula -> (unit -> unit) -> unit) - = - fun i -> - fun bvs -> - fun x -> - fun y -> - fun g' -> - fun check -> - (let uu___1 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.print1 "%s ..." uu___1); - (let uu___2 = FStarC_Main.process_args () in ()); - (let uu___3 = - FStarC_Class_Show.show FStarC_Syntax_Print.showable_term x in - let uu___4 = - FStarC_Class_Show.show FStarC_Syntax_Print.showable_term y in - FStarC_Compiler_Util.print2 "Unify %s\nand %s\n" uu___3 uu___4); - (let tcenv1 = tcenv () in - let tcenv2 = FStarC_TypeChecker_Env.push_bvs tcenv1 bvs in - let g = - let uu___3 = - let uu___4 = FStarC_TypeChecker_Rel.teq tcenv2 x y in - FStarC_TypeChecker_Rel.solve_deferred_constraints tcenv2 - uu___4 in - FStarC_TypeChecker_Rel.simplify_guard tcenv2 uu___3 in - guard_eq i g.FStarC_TypeChecker_Common.guard_f g'; - check (); - FStarC_Options.init ()) -let (should_fail : - FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ -> unit) = - fun x -> - fun y -> - try - (fun uu___ -> - match () with - | () -> - let g = - let uu___1 = tcenv () in - let uu___2 = - let uu___3 = tcenv () in - FStarC_TypeChecker_Rel.teq uu___3 x y in - FStarC_TypeChecker_Rel.solve_deferred_constraints uu___1 - uu___2 in - (match g.FStarC_TypeChecker_Common.guard_f with - | FStarC_TypeChecker_Common.Trivial -> - let uu___1 = - let uu___2 = - FStarC_Class_Show.show - FStarC_Syntax_Print.showable_term x in - let uu___3 = - FStarC_Class_Show.show - FStarC_Syntax_Print.showable_term y in - FStarC_Compiler_Util.format2 - "%s and %s should not be unifiable\n" uu___2 uu___3 in - fail uu___1 - | FStarC_TypeChecker_Common.NonTrivial f -> - let uu___1 = - FStarC_Class_Show.show - FStarC_Syntax_Print.showable_term x in - let uu___2 = - FStarC_Class_Show.show - FStarC_Syntax_Print.showable_term y in - let uu___3 = - FStarC_Class_Show.show - FStarC_Syntax_Print.showable_term f in - FStarC_Compiler_Util.print3 - "%s and %s are unifiable if %s\n" uu___1 uu___2 uu___3)) - () - with - | FStarC_Errors.Error (e, msg, r, _ctx) -> - let uu___1 = FStarC_Errors_Msg.rendermsg msg in - FStarC_Compiler_Util.print1 "%s\n" uu___1 -let (unify' : Prims.string -> Prims.string -> unit) = - fun x -> - fun y -> - let x1 = FStarC_Tests_Pars.pars x in - let y1 = FStarC_Tests_Pars.pars y in - let g = - let uu___ = tcenv () in - let uu___1 = - let uu___2 = tcenv () in FStarC_TypeChecker_Rel.teq uu___2 x1 y1 in - FStarC_TypeChecker_Rel.solve_deferred_constraints uu___ uu___1 in - let uu___ = FStarC_Class_Show.show FStarC_Syntax_Print.showable_term x1 in - let uu___1 = - FStarC_Class_Show.show FStarC_Syntax_Print.showable_term y1 in - let uu___2 = guard_to_string g.FStarC_TypeChecker_Common.guard_f in - FStarC_Compiler_Util.print3 "%s and %s are unifiable with guard %s\n" - uu___ uu___1 uu___2 -let (norm : FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.term) = - fun t -> - let uu___ = tcenv () in FStarC_TypeChecker_Normalize.normalize [] uu___ t -let (check_core : - Prims.int -> - Prims.bool -> - Prims.bool -> - FStarC_Syntax_Syntax.typ -> FStarC_Syntax_Syntax.typ -> unit) - = - fun i -> - fun subtyping -> - fun guard_ok -> - fun x -> - fun y -> - (let uu___1 = FStarC_Main.process_args () in ()); - (let env = tcenv () in - let res = - if subtyping - then - FStarC_TypeChecker_Core.check_term_subtyping true true env x - y - else - FStarC_TypeChecker_Core.check_term_equality true true env x - y in - (match res with - | FStar_Pervasives.Inl (FStar_Pervasives_Native.None) -> - let uu___2 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.print1 "%s core check ok\n" uu___2 - | FStar_Pervasives.Inl (FStar_Pervasives_Native.Some g) -> - ((let uu___3 = FStarC_Compiler_Util.string_of_int i in - let uu___4 = - FStarC_Class_Show.show - FStarC_Syntax_Print.showable_term g in - FStarC_Compiler_Util.print2 - "%s core check computed guard %s ok\n" uu___3 uu___4); - if Prims.op_Negation guard_ok - then FStarC_Compiler_Effect.op_Colon_Equals success false - else ()) - | FStar_Pervasives.Inr err -> - (FStarC_Compiler_Effect.op_Colon_Equals success false; - (let uu___3 = FStarC_Compiler_Util.string_of_int i in - let uu___4 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.print2 "%s failed\n%s\n" uu___3 - uu___4))); - FStarC_Options.init ()) -let (check_core_typing : - Prims.int -> FStarC_Syntax_Syntax.term -> FStarC_Syntax_Syntax.typ -> unit) - = - fun i -> - fun e -> - fun t -> - (let uu___1 = FStarC_Main.process_args () in ()); - (let env = tcenv () in - (let uu___2 = FStarC_TypeChecker_Core.check_term env e t true in - match uu___2 with - | FStar_Pervasives.Inl (FStar_Pervasives_Native.None) -> - let uu___3 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.print1 "%s core typing ok\n" uu___3 - | FStar_Pervasives.Inl (FStar_Pervasives_Native.Some g) -> - ((let uu___4 = FStarC_Compiler_Util.string_of_int i in - FStarC_Compiler_Util.print1 - "%s core typing produced a guard\n" uu___4); - FStarC_Compiler_Effect.op_Colon_Equals success false) - | FStar_Pervasives.Inr err -> - (FStarC_Compiler_Effect.op_Colon_Equals success false; - (let uu___4 = FStarC_Compiler_Util.string_of_int i in - let uu___5 = FStarC_TypeChecker_Core.print_error err in - FStarC_Compiler_Util.print2 "%s failed\n%s\n" uu___4 uu___5))); - FStarC_Options.init ()) -let (inst : - Prims.int -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - (FStarC_Syntax_Syntax.term * FStarC_Syntax_Syntax.term Prims.list)) - = - fun n -> - fun tm -> - let rec aux out n1 = - if n1 = Prims.int_zero - then out - else - (let uu___1 = - let uu___2 = FStarC_Tests_Pars.init () in - FStarC_TypeChecker_Util.new_implicit_var "" - FStarC_Compiler_Range_Type.dummyRange uu___2 - FStarC_Syntax_Util.ktype0 false in - match uu___1 with - | (t, uu___2, uu___3) -> - let uu___4 = - let uu___5 = FStarC_Tests_Pars.init () in - FStarC_TypeChecker_Util.new_implicit_var "" - FStarC_Compiler_Range_Type.dummyRange uu___5 t false in - (match uu___4 with - | (u, uu___5, uu___6) -> aux (u :: out) (n1 - Prims.int_one))) in - let us = aux [] n in - let uu___ = let uu___1 = FStarC_Tests_Util.app tm us in norm uu___1 in - (uu___, us) -let (run_all : unit -> Prims.bool) = - fun uu___ -> - FStarC_Compiler_Util.print_string "Testing the unifier\n"; - FStarC_Options.__set_unit_tests (); - (let unify_check n bvs x y g f = unify n bvs x y g f in - let unify1 n bvs x y g = unify n bvs x y g (fun uu___3 -> ()) in - let int_t = FStarC_Tests_Pars.tc "Prims.int" in - let x_bv = - FStarC_Syntax_Syntax.gen_bv "x" FStar_Pervasives_Native.None int_t in - let y_bv = - FStarC_Syntax_Syntax.gen_bv "y" FStar_Pervasives_Native.None int_t in - let x = FStarC_Syntax_Syntax.bv_to_name x_bv in - let y = FStarC_Syntax_Syntax.bv_to_name y_bv in - unify1 Prims.int_zero [x_bv] x x FStarC_TypeChecker_Common.Trivial; - (let uu___5 = - let uu___6 = - FStarC_Syntax_Util.mk_eq2 FStarC_Syntax_Syntax.U_zero - FStarC_Syntax_Util.t_bool x y in - FStarC_TypeChecker_Common.NonTrivial uu___6 in - unify1 Prims.int_one [x_bv; y_bv] x y uu___5); - (let id = FStarC_Tests_Pars.tc "fun (x:bool) -> x" in - (let uu___6 = FStarC_Tests_Util.app id [x] in - unify1 (Prims.of_int (2)) [x_bv] x uu___6 - FStarC_TypeChecker_Common.Trivial); - (let id1 = FStarC_Tests_Pars.tc "fun (x:bool) -> x" in - unify1 (Prims.of_int (3)) [] id1 id1 FStarC_TypeChecker_Common.Trivial; - (let id2 = FStarC_Tests_Pars.tc "fun (x:bool) -> x" in - let id' = FStarC_Tests_Pars.tc "fun (y:bool) -> y" in - unify1 (Prims.of_int (4)) [] id2 id' - FStarC_TypeChecker_Common.Trivial; - (let uu___9 = FStarC_Tests_Pars.tc "fun (x y:bool) -> x" in - let uu___10 = FStarC_Tests_Pars.tc "fun (a b:bool) -> a" in - unify1 (Prims.of_int (5)) [] uu___9 uu___10 - FStarC_TypeChecker_Common.Trivial); - (let uu___10 = FStarC_Tests_Pars.tc "fun (x y z:bool) -> y" in - let uu___11 = FStarC_Tests_Pars.tc "fun (a b c:bool) -> b" in - unify1 (Prims.of_int (6)) [] uu___10 uu___11 - FStarC_TypeChecker_Common.Trivial); - (let uu___11 = FStarC_Tests_Pars.tc "fun (x:int) (y:int) -> y" in - let uu___12 = FStarC_Tests_Pars.tc "fun (x:int) (y:int) -> x" in - let uu___13 = - let uu___14 = - FStarC_Tests_Pars.tc "(forall (x:int). (forall (y:int). y==x))" in - FStarC_TypeChecker_Common.NonTrivial uu___14 in - unify1 (Prims.of_int (7)) [] uu___11 uu___12 uu___13); - (let uu___12 = - FStarC_Tests_Pars.tc "fun (x:int) (y:int) (z:int) -> y" in - let uu___13 = - FStarC_Tests_Pars.tc "fun (x:int) (y:int) (z:int) -> z" in - let uu___14 = - let uu___15 = - FStarC_Tests_Pars.tc - "(forall (x:int). (forall (y:int). (forall (z:int). y==z)))" in - FStarC_TypeChecker_Common.NonTrivial uu___15 in - unify1 (Prims.of_int (8)) [] uu___12 uu___13 uu___14); - (let uu___13 = FStarC_Main.process_args () in ()); - (let uu___13 = - let uu___14 = - FStarC_Tests_Pars.tc "fun (u:Type0 -> Type0) (x:Type0) -> u x" in - inst Prims.int_one uu___14 in - match uu___13 with - | (tm, us) -> - let sol = FStarC_Tests_Pars.tc "fun (x:Type0) -> Prims.pair x x" in - (unify_check (Prims.of_int (9)) [] tm sol - FStarC_TypeChecker_Common.Trivial - (fun uu___15 -> - let uu___16 = - let uu___17 = - let uu___18 = FStarC_Compiler_List.hd us in - norm uu___18 in - let uu___18 = norm sol in - FStarC_Tests_Util.term_eq uu___17 uu___18 in - FStarC_Tests_Util.always (Prims.of_int (9)) uu___16); - (let uu___15 = - let uu___16 = - FStarC_Tests_Pars.tc - "fun (u: int -> int -> int) (x:int) -> u x" in - inst Prims.int_one uu___16 in - match uu___15 with - | (tm1, us1) -> - let sol1 = FStarC_Tests_Pars.tc "fun (x y:int) -> x + y" in - (unify_check (Prims.of_int (10)) [] tm1 sol1 - FStarC_TypeChecker_Common.Trivial - (fun uu___17 -> - let uu___18 = - let uu___19 = - let uu___20 = FStarC_Compiler_List.hd us1 in - norm uu___20 in - let uu___20 = norm sol1 in - FStarC_Tests_Util.term_eq uu___19 uu___20 in - FStarC_Tests_Util.always (Prims.of_int (10)) uu___18); - (let tm11 = - FStarC_Tests_Pars.tc "x:int -> y:int{eq2 y x} -> bool" in - let tm2 = FStarC_Tests_Pars.tc "x:int -> y:int -> bool" in - (let uu___18 = - let uu___19 = - FStarC_Tests_Pars.tc - "forall (x:int). (forall (y:int). y==x)" in - FStarC_TypeChecker_Common.NonTrivial uu___19 in - unify1 (Prims.of_int (11)) [] tm11 tm2 uu___18); - (let tm12 = - FStarC_Tests_Pars.tc - "a:Type0 -> b:(a -> Type0) -> x:a -> y:b x -> Tot Type0" in - let tm21 = - FStarC_Tests_Pars.tc - "a:Type0 -> b:(a -> Type0) -> x:a -> y:b x -> Tot Type0" in - unify1 (Prims.of_int (12)) [] tm12 tm21 - FStarC_TypeChecker_Common.Trivial; - (let uu___19 = - let int_typ = FStarC_Tests_Pars.tc "int" in - let x1 = - FStarC_Syntax_Syntax.new_bv - FStar_Pervasives_Native.None int_typ in - let typ = FStarC_Tests_Pars.tc "unit -> Type0" in - let l = - FStarC_Tests_Pars.tc - "fun (q:(unit -> Type0)) -> q ()" in - let q = - FStarC_Syntax_Syntax.new_bv - FStar_Pervasives_Native.None typ in - let tm13 = - let uu___20 = - let uu___21 = - let uu___22 = - FStarC_Syntax_Syntax.bv_to_name q in - [uu___22] in - FStarC_Tests_Util.app l uu___21 in - norm uu___20 in - let l1 = - FStarC_Tests_Pars.tc "fun (p:unit -> Type0) -> p" in - let unit = FStarC_Tests_Pars.tc "()" in - let env = - let uu___20 = FStarC_Tests_Pars.init () in - let uu___21 = - let uu___22 = FStarC_Syntax_Syntax.mk_binder x1 in - let uu___23 = - let uu___24 = FStarC_Syntax_Syntax.mk_binder q in - [uu___24] in - uu___22 :: uu___23 in - FStarC_TypeChecker_Env.push_binders uu___20 - uu___21 in - let uu___20 = - FStarC_TypeChecker_Util.new_implicit_var "" - FStarC_Compiler_Range_Type.dummyRange env typ - false in - match uu___20 with - | (u_p, uu___21, uu___22) -> - let tm22 = - let uu___23 = - let uu___24 = FStarC_Tests_Util.app l1 [u_p] in - norm uu___24 in - FStarC_Tests_Util.app uu___23 [unit] in - (tm13, tm22, [x1; q]) in - match uu___19 with - | (tm13, tm22, bvs_13) -> - (unify1 (Prims.of_int (13)) bvs_13 tm13 tm22 - FStarC_TypeChecker_Common.Trivial; - (let uu___21 = - let int_typ = FStarC_Tests_Pars.tc "int" in - let x1 = - FStarC_Syntax_Syntax.new_bv - FStar_Pervasives_Native.None int_typ in - let typ = - FStarC_Tests_Pars.tc "pure_post unit" in - let l = - FStarC_Tests_Pars.tc - "fun (q:pure_post unit) -> q ()" in - let q = - FStarC_Syntax_Syntax.new_bv - FStar_Pervasives_Native.None typ in - let tm14 = - let uu___22 = - let uu___23 = - let uu___24 = - FStarC_Syntax_Syntax.bv_to_name q in - [uu___24] in - FStarC_Tests_Util.app l uu___23 in - norm uu___22 in - let l1 = - FStarC_Tests_Pars.tc - "fun (p:pure_post unit) -> p" in - let unit = FStarC_Tests_Pars.tc "()" in - let env = - let uu___22 = FStarC_Tests_Pars.init () in - let uu___23 = - let uu___24 = - FStarC_Syntax_Syntax.mk_binder x1 in - let uu___25 = - let uu___26 = - FStarC_Syntax_Syntax.mk_binder q in - [uu___26] in - uu___24 :: uu___25 in - FStarC_TypeChecker_Env.push_binders uu___22 - uu___23 in - let uu___22 = - FStarC_TypeChecker_Util.new_implicit_var "" - FStarC_Compiler_Range_Type.dummyRange env - typ false in - match uu___22 with - | (u_p, uu___23, uu___24) -> - let tm23 = - let uu___25 = - let uu___26 = - FStarC_Tests_Util.app l1 [u_p] in - norm uu___26 in - FStarC_Tests_Util.app uu___25 [unit] in - (tm14, tm23, [x1; q]) in - match uu___21 with - | (tm14, tm23, bvs_14) -> - (unify1 (Prims.of_int (14)) bvs_14 tm14 tm23 - FStarC_TypeChecker_Common.Trivial; - (let uu___23 = - FStarC_Tests_Pars.pars_and_tc_fragment - "let ty0 n = x:int { x >= n }\nlet ty1 n = x:ty0 n { x > n }\nassume val tc (t:Type0) : Type0"; - (let t0 = FStarC_Tests_Pars.tc "ty1 17" in - let t1 = - FStarC_Tests_Pars.tc - "x:ty0 17 { x > 17 }" in - (t0, t1)) in - match uu___23 with - | (tm15, tm24) -> - (check_core (Prims.of_int (15)) false - false tm15 tm24; - (let uu___25 = - let t0 = - FStarC_Tests_Pars.tc - "x:int { x >= 17 /\\ x > 17 }" in - let t1 = - FStarC_Tests_Pars.tc - "x:ty0 17 { x > 17 }" in - (t0, t1) in - match uu___25 with - | (tm16, tm25) -> - (check_core (Prims.of_int (16)) - false false tm16 tm25; - (let uu___27 = - FStarC_Tests_Pars.pars_and_tc_fragment - "let defn17_0 (x:nat) : nat -> nat -> Type0 = fun y z -> a:int { a + x == y + z }"; - (let t0 = - FStarC_Tests_Pars.tc - "defn17_0 0 1 2" in - let t1_head = - FStarC_Tests_Pars.tc - "(defn17_0 0)" in - let arg1 = - FStarC_Tests_Pars.tc "1" in - let arg2 = - FStarC_Tests_Pars.tc "2" in - let t1 = - FStarC_Syntax_Syntax.mk_Tm_app - t1_head - [(arg1, - FStar_Pervasives_Native.None); - (arg2, - FStar_Pervasives_Native.None)] - t0.FStarC_Syntax_Syntax.pos in - (t0, t1)) in - match uu___27 with - | (tm17, tm26) -> - (check_core - (Prims.of_int (17)) - false false tm17 tm26; - (let uu___29 = - let t0 = - FStarC_Tests_Pars.tc - "dp:((dtuple2 int (fun (y:int) -> z:int{ z > y })) <: Type0) { let (| x, _ |) = dp in x > 17 }" in - let t1 = - FStarC_Tests_Pars.tc - "(dtuple2 int (fun (y:int) -> z:int{ z > y }))" in - (t0, t1) in - match uu___29 with - | (tm18, tm27) -> - (check_core - (Prims.of_int (18)) - true false tm18 - tm27; - (let uu___31 = - FStarC_Tests_Pars.pars_and_tc_fragment - "type vprop' = { t:Type0 ; n:nat }"; - (let t0 = - FStarC_Tests_Pars.tc - "x:(({ t=bool; n=0 }).t <: Type0) { x == false }" in - let t1 = - FStarC_Tests_Pars.tc - "x:bool{ x == false }" in - (t0, t1)) in - match uu___31 with - | (tm19, tm28) -> - (check_core - (Prims.of_int (19)) - false false - tm19 tm28; - (let uu___33 - = - let t0 = - FStarC_Tests_Pars.tc - "int" in - let t1 = - FStarC_Tests_Pars.tc - "j:(i:nat{ i > 17 } <: Type0){j > 42}" in - (t0, t1) in - match uu___33 - with - | (tm110, - tm29) -> - (check_core - (Prims.of_int (20)) - true true - tm110 - tm29; - (let uu___35 - = - FStarC_Tests_Pars.pars_and_tc_fragment - "assume val tstr21 (x:string) : Type0"; - ( - let t0 = - FStarC_Tests_Pars.tc - "(fun (x:bool) (y:int) (z: (fun (x:string) -> tstr21 x) \"hello\") -> x)" in - let ty = - FStarC_Tests_Pars.tc - "bool -> int -> tstr21 \"hello\" -> bool" in - (t0, ty)) in - match uu___35 - with - | - (tm3, ty) - -> - (check_core_typing - (Prims.of_int (21)) - tm3 ty; - FStarC_Options.__clear_unit_tests - (); - (let uu___39 - = - FStarC_Compiler_Effect.op_Bang - success in - if - uu___39 - then - FStarC_Compiler_Util.print_string - "Unifier ok\n" - else ()); - FStarC_Compiler_Effect.op_Bang - success)))))))))))))))))))))))))))) \ No newline at end of file diff --git a/stage0/fstar-tests/generated/FStarC_Tests_Util.ml b/stage0/fstar-tests/generated/FStarC_Tests_Util.ml deleted file mode 100644 index c0ade574c38..00000000000 --- a/stage0/fstar-tests/generated/FStarC_Tests_Util.ml +++ /dev/null @@ -1,341 +0,0 @@ -open Prims -let (always : Prims.int -> Prims.bool -> unit) = - fun id -> - fun b -> - if b - then () - else - (let uu___1 = - let uu___2 = FStarC_Compiler_Util.string_of_int id in - FStarC_Compiler_Util.format1 "Assertion failed: test %s" uu___2 in - FStarC_Errors.raise_error0 - FStarC_Errors_Codes.Fatal_AssertionFailure () - (Obj.magic FStarC_Errors_Msg.is_error_message_string) - (Obj.magic uu___1)) -let (x : FStarC_Syntax_Syntax.bv) = - FStarC_Syntax_Syntax.gen_bv "x" FStar_Pervasives_Native.None - FStarC_Syntax_Syntax.tun -let (y : FStarC_Syntax_Syntax.bv) = - FStarC_Syntax_Syntax.gen_bv "y" FStar_Pervasives_Native.None - FStarC_Syntax_Syntax.tun -let (n : FStarC_Syntax_Syntax.bv) = - FStarC_Syntax_Syntax.gen_bv "n" FStar_Pervasives_Native.None - FStarC_Syntax_Syntax.tun -let (h : FStarC_Syntax_Syntax.bv) = - FStarC_Syntax_Syntax.gen_bv "h" FStar_Pervasives_Native.None - FStarC_Syntax_Syntax.tun -let (m : FStarC_Syntax_Syntax.bv) = - FStarC_Syntax_Syntax.gen_bv "m" FStar_Pervasives_Native.None - FStarC_Syntax_Syntax.tun -let tm : 'uuuuu . 'uuuuu -> 'uuuuu FStarC_Syntax_Syntax.syntax = - fun t -> FStarC_Syntax_Syntax.mk t FStarC_Compiler_Range_Type.dummyRange -let (nm : FStarC_Syntax_Syntax.bv -> FStarC_Syntax_Syntax.term) = - fun x1 -> FStarC_Syntax_Syntax.bv_to_name x1 -let (app : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term Prims.list -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax) - = - fun x1 -> - fun ts -> - let uu___ = - let uu___1 = - let uu___2 = - FStarC_Compiler_List.map FStarC_Syntax_Syntax.as_arg ts in - { FStarC_Syntax_Syntax.hd = x1; FStarC_Syntax_Syntax.args = uu___2 - } in - FStarC_Syntax_Syntax.Tm_app uu___1 in - FStarC_Syntax_Syntax.mk uu___ FStarC_Compiler_Range_Type.dummyRange -let rec (term_eq' : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> Prims.bool) - = - fun t1 -> - fun t2 -> - let t11 = FStarC_Syntax_Subst.compress t1 in - let t21 = FStarC_Syntax_Subst.compress t2 in - let binders_eq xs ys = - ((FStarC_Compiler_List.length xs) = (FStarC_Compiler_List.length ys)) - && - (FStarC_Compiler_List.forall2 - (fun x1 -> - fun y1 -> - term_eq' - (x1.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort - (y1.FStarC_Syntax_Syntax.binder_bv).FStarC_Syntax_Syntax.sort) - xs ys) in - let args_eq xs ys = - ((FStarC_Compiler_List.length xs) = (FStarC_Compiler_List.length ys)) - && - (FStarC_Compiler_List.forall2 - (fun uu___ -> - fun uu___1 -> - match (uu___, uu___1) with - | ((a, imp), (b, imp')) -> - (term_eq' a b) && - (FStarC_Syntax_Util.eq_aqual imp imp')) xs ys) in - let comp_eq c d = - match ((c.FStarC_Syntax_Syntax.n), (d.FStarC_Syntax_Syntax.n)) with - | (FStarC_Syntax_Syntax.Total t, FStarC_Syntax_Syntax.Total s) -> - term_eq' t s - | (FStarC_Syntax_Syntax.Comp ct1, FStarC_Syntax_Syntax.Comp ct2) -> - ((FStarC_Ident.lid_equals ct1.FStarC_Syntax_Syntax.effect_name - ct2.FStarC_Syntax_Syntax.effect_name) - && - (term_eq' ct1.FStarC_Syntax_Syntax.result_typ - ct2.FStarC_Syntax_Syntax.result_typ)) - && - (args_eq ct1.FStarC_Syntax_Syntax.effect_args - ct2.FStarC_Syntax_Syntax.effect_args) - | uu___ -> false in - match ((t11.FStarC_Syntax_Syntax.n), (t21.FStarC_Syntax_Syntax.n)) with - | (FStarC_Syntax_Syntax.Tm_lazy l, uu___) -> - let uu___1 = - let uu___2 = - let uu___3 = - FStarC_Compiler_Effect.op_Bang - FStarC_Syntax_Syntax.lazy_chooser in - FStarC_Compiler_Util.must uu___3 in - uu___2 l.FStarC_Syntax_Syntax.lkind l in - term_eq' uu___1 t21 - | (uu___, FStarC_Syntax_Syntax.Tm_lazy l) -> - let uu___1 = - let uu___2 = - let uu___3 = - FStarC_Compiler_Effect.op_Bang - FStarC_Syntax_Syntax.lazy_chooser in - FStarC_Compiler_Util.must uu___3 in - uu___2 l.FStarC_Syntax_Syntax.lkind l in - term_eq' t11 uu___1 - | (FStarC_Syntax_Syntax.Tm_bvar x1, FStarC_Syntax_Syntax.Tm_bvar y1) -> - x1.FStarC_Syntax_Syntax.index = y1.FStarC_Syntax_Syntax.index - | (FStarC_Syntax_Syntax.Tm_name x1, FStarC_Syntax_Syntax.Tm_name y1) -> - FStarC_Syntax_Syntax.bv_eq x1 y1 - | (FStarC_Syntax_Syntax.Tm_fvar f, FStarC_Syntax_Syntax.Tm_fvar g) -> - FStarC_Syntax_Syntax.fv_eq f g - | (FStarC_Syntax_Syntax.Tm_uinst (t, uu___), - FStarC_Syntax_Syntax.Tm_uinst (s, uu___1)) -> term_eq' t s - | (FStarC_Syntax_Syntax.Tm_constant c1, - FStarC_Syntax_Syntax.Tm_constant c2) -> FStarC_Const.eq_const c1 c2 - | (FStarC_Syntax_Syntax.Tm_type u, FStarC_Syntax_Syntax.Tm_type v) -> - u = v - | (FStarC_Syntax_Syntax.Tm_abs - { FStarC_Syntax_Syntax.bs = xs; FStarC_Syntax_Syntax.body = t; - FStarC_Syntax_Syntax.rc_opt = uu___;_}, - FStarC_Syntax_Syntax.Tm_abs - { FStarC_Syntax_Syntax.bs = ys; FStarC_Syntax_Syntax.body = u; - FStarC_Syntax_Syntax.rc_opt = uu___1;_}) - when - (FStarC_Compiler_List.length xs) = (FStarC_Compiler_List.length ys) - -> (binders_eq xs ys) && (term_eq' t u) - | (FStarC_Syntax_Syntax.Tm_abs - { FStarC_Syntax_Syntax.bs = xs; FStarC_Syntax_Syntax.body = t; - FStarC_Syntax_Syntax.rc_opt = uu___;_}, - FStarC_Syntax_Syntax.Tm_abs - { FStarC_Syntax_Syntax.bs = ys; FStarC_Syntax_Syntax.body = u; - FStarC_Syntax_Syntax.rc_opt = uu___1;_}) - -> - if - (FStarC_Compiler_List.length xs) > - (FStarC_Compiler_List.length ys) - then - let uu___2 = - FStarC_Compiler_Util.first_N (FStarC_Compiler_List.length ys) - xs in - (match uu___2 with - | (xs1, xs') -> - let t12 = - let uu___3 = - let uu___4 = - let uu___5 = - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_abs - { - FStarC_Syntax_Syntax.bs = xs'; - FStarC_Syntax_Syntax.body = t; - FStarC_Syntax_Syntax.rc_opt = - FStar_Pervasives_Native.None - }) t11.FStarC_Syntax_Syntax.pos in - { - FStarC_Syntax_Syntax.bs = xs1; - FStarC_Syntax_Syntax.body = uu___5; - FStarC_Syntax_Syntax.rc_opt = - FStar_Pervasives_Native.None - } in - FStarC_Syntax_Syntax.Tm_abs uu___4 in - FStarC_Syntax_Syntax.mk uu___3 - t11.FStarC_Syntax_Syntax.pos in - term_eq' t12 t21) - else - (let uu___3 = - FStarC_Compiler_Util.first_N (FStarC_Compiler_List.length xs) - ys in - match uu___3 with - | (ys1, ys') -> - let t22 = - let uu___4 = - let uu___5 = - let uu___6 = - FStarC_Syntax_Syntax.mk - (FStarC_Syntax_Syntax.Tm_abs - { - FStarC_Syntax_Syntax.bs = ys'; - FStarC_Syntax_Syntax.body = u; - FStarC_Syntax_Syntax.rc_opt = - FStar_Pervasives_Native.None - }) t21.FStarC_Syntax_Syntax.pos in - { - FStarC_Syntax_Syntax.bs = ys1; - FStarC_Syntax_Syntax.body = uu___6; - FStarC_Syntax_Syntax.rc_opt = - FStar_Pervasives_Native.None - } in - FStarC_Syntax_Syntax.Tm_abs uu___5 in - FStarC_Syntax_Syntax.mk uu___4 - t21.FStarC_Syntax_Syntax.pos in - term_eq' t11 t22) - | (FStarC_Syntax_Syntax.Tm_arrow - { FStarC_Syntax_Syntax.bs1 = xs; FStarC_Syntax_Syntax.comp = c;_}, - FStarC_Syntax_Syntax.Tm_arrow - { FStarC_Syntax_Syntax.bs1 = ys; FStarC_Syntax_Syntax.comp = d;_}) - -> (binders_eq xs ys) && (comp_eq c d) - | (FStarC_Syntax_Syntax.Tm_refine - { FStarC_Syntax_Syntax.b = x1; FStarC_Syntax_Syntax.phi = t;_}, - FStarC_Syntax_Syntax.Tm_refine - { FStarC_Syntax_Syntax.b = y1; FStarC_Syntax_Syntax.phi = u;_}) -> - (term_eq' x1.FStarC_Syntax_Syntax.sort y1.FStarC_Syntax_Syntax.sort) - && (term_eq' t u) - | (FStarC_Syntax_Syntax.Tm_app - { - FStarC_Syntax_Syntax.hd = - { FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_fvar fv_eq_1; - FStarC_Syntax_Syntax.pos = uu___; - FStarC_Syntax_Syntax.vars = uu___1; - FStarC_Syntax_Syntax.hash_code = uu___2;_}; - FStarC_Syntax_Syntax.args = - (uu___3, FStar_Pervasives_Native.Some - { FStarC_Syntax_Syntax.aqual_implicit = true; - FStarC_Syntax_Syntax.aqual_attributes = uu___4;_})::t12::t22::[];_}, - FStarC_Syntax_Syntax.Tm_app - { - FStarC_Syntax_Syntax.hd = - { FStarC_Syntax_Syntax.n = FStarC_Syntax_Syntax.Tm_fvar fv_eq_2; - FStarC_Syntax_Syntax.pos = uu___5; - FStarC_Syntax_Syntax.vars = uu___6; - FStarC_Syntax_Syntax.hash_code = uu___7;_}; - FStarC_Syntax_Syntax.args = - (uu___8, FStar_Pervasives_Native.Some - { FStarC_Syntax_Syntax.aqual_implicit = true; - FStarC_Syntax_Syntax.aqual_attributes = uu___9;_})::s1::s2::[];_}) - when - (FStarC_Syntax_Syntax.fv_eq_lid fv_eq_1 FStarC_Parser_Const.eq2_lid) - && - (FStarC_Syntax_Syntax.fv_eq_lid fv_eq_2 - FStarC_Parser_Const.eq2_lid) - -> args_eq [s1; s2] [t12; t22] - | (FStarC_Syntax_Syntax.Tm_app - { FStarC_Syntax_Syntax.hd = t; FStarC_Syntax_Syntax.args = args;_}, - FStarC_Syntax_Syntax.Tm_app - { FStarC_Syntax_Syntax.hd = s; FStarC_Syntax_Syntax.args = args';_}) - -> (term_eq' t s) && (args_eq args args') - | (FStarC_Syntax_Syntax.Tm_match - { FStarC_Syntax_Syntax.scrutinee = t; - FStarC_Syntax_Syntax.ret_opt = FStar_Pervasives_Native.None; - FStarC_Syntax_Syntax.brs = pats; - FStarC_Syntax_Syntax.rc_opt1 = uu___;_}, - FStarC_Syntax_Syntax.Tm_match - { FStarC_Syntax_Syntax.scrutinee = t'; - FStarC_Syntax_Syntax.ret_opt = FStar_Pervasives_Native.None; - FStarC_Syntax_Syntax.brs = pats'; - FStarC_Syntax_Syntax.rc_opt1 = uu___1;_}) - -> - (((FStarC_Compiler_List.length pats) = - (FStarC_Compiler_List.length pats')) - && - (FStarC_Compiler_List.forall2 - (fun uu___2 -> - fun uu___3 -> - match (uu___2, uu___3) with - | ((uu___4, uu___5, e), (uu___6, uu___7, e')) -> - term_eq' e e') pats pats')) - && (term_eq' t t') - | (FStarC_Syntax_Syntax.Tm_ascribed - { FStarC_Syntax_Syntax.tm = t12; - FStarC_Syntax_Syntax.asc = - (FStar_Pervasives.Inl t22, uu___, uu___1); - FStarC_Syntax_Syntax.eff_opt = uu___2;_}, - FStarC_Syntax_Syntax.Tm_ascribed - { FStarC_Syntax_Syntax.tm = s1; - FStarC_Syntax_Syntax.asc = - (FStar_Pervasives.Inl s2, uu___3, uu___4); - FStarC_Syntax_Syntax.eff_opt = uu___5;_}) - -> (term_eq' t12 s1) && (term_eq' t22 s2) - | (FStarC_Syntax_Syntax.Tm_let - { FStarC_Syntax_Syntax.lbs = (is_rec, lbs); - FStarC_Syntax_Syntax.body1 = t;_}, - FStarC_Syntax_Syntax.Tm_let - { FStarC_Syntax_Syntax.lbs = (is_rec', lbs'); - FStarC_Syntax_Syntax.body1 = s;_}) - when is_rec = is_rec' -> - (((FStarC_Compiler_List.length lbs) = - (FStarC_Compiler_List.length lbs')) - && - (FStarC_Compiler_List.forall2 - (fun lb1 -> - fun lb2 -> - (term_eq' lb1.FStarC_Syntax_Syntax.lbtyp - lb2.FStarC_Syntax_Syntax.lbtyp) - && - (term_eq' lb1.FStarC_Syntax_Syntax.lbdef - lb2.FStarC_Syntax_Syntax.lbdef)) lbs lbs')) - && (term_eq' t s) - | (FStarC_Syntax_Syntax.Tm_uvar (u, uu___), - FStarC_Syntax_Syntax.Tm_uvar (u', uu___1)) -> - FStarC_Syntax_Unionfind.equiv u.FStarC_Syntax_Syntax.ctx_uvar_head - u'.FStarC_Syntax_Syntax.ctx_uvar_head - | (FStarC_Syntax_Syntax.Tm_meta - { FStarC_Syntax_Syntax.tm2 = t12; - FStarC_Syntax_Syntax.meta = uu___;_}, - uu___1) -> term_eq' t12 t21 - | (uu___, FStarC_Syntax_Syntax.Tm_meta - { FStarC_Syntax_Syntax.tm2 = t22; - FStarC_Syntax_Syntax.meta = uu___1;_}) - -> term_eq' t11 t22 - | (FStarC_Syntax_Syntax.Tm_delayed uu___, uu___1) -> - let uu___2 = - let uu___3 = - FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t11 in - let uu___4 = - FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t21 in - FStarC_Compiler_Util.format2 "Impossible: %s and %s" uu___3 - uu___4 in - failwith uu___2 - | (uu___, FStarC_Syntax_Syntax.Tm_delayed uu___1) -> - let uu___2 = - let uu___3 = - FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t11 in - let uu___4 = - FStarC_Class_Tagged.tag_of FStarC_Syntax_Syntax.tagged_term t21 in - FStarC_Compiler_Util.format2 "Impossible: %s and %s" uu___3 - uu___4 in - failwith uu___2 - | (FStarC_Syntax_Syntax.Tm_unknown, FStarC_Syntax_Syntax.Tm_unknown) -> - true - | uu___ -> false -let (term_eq : - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> - FStarC_Syntax_Syntax.term' FStarC_Syntax_Syntax.syntax -> Prims.bool) - = - fun t1 -> - fun t2 -> - let b = term_eq' t1 t2 in - if Prims.op_Negation b - then - (let uu___1 = - FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t1 in - let uu___2 = - FStarC_Class_Show.show FStarC_Syntax_Print.showable_term t2 in - FStarC_Compiler_Util.print2 - ">>>>>>>>>>>Term %s is not equal to %s\n" uu___1 uu___2) - else (); - b \ No newline at end of file diff --git a/stage0/fstar.opam b/stage0/fstar.opam new file mode 100644 index 00000000000..4f6276f1998 --- /dev/null +++ b/stage0/fstar.opam @@ -0,0 +1,38 @@ +opam-version: "2.0" +version: "2025.02.06~dev" +maintainer: "taramana@microsoft.com" +authors: "Nik Swamy ,Jonathan Protzenko ,Tahina Ramananandro " +homepage: "http://fstar-lang.org" +license: "Apache-2.0" +depends: [ + "ocaml" {>= "4.14.0"} + "batteries" + "zarith" + "stdint" + "yojson" + "dune" {build & >= "3.8.0"} + "memtrace" + "menhirLib" + "menhir" {build & >= "2.1"} + "mtime" + "pprint" + "sedlex" + "ppxlib" {>= "0.27.0"} + "process" + "ppx_deriving" {build} + "ppx_deriving_yojson" {build} +] +depexts: ["coreutils"] {os = "macos" & os-distribution = "homebrew"} +build: [ + [make "-j" jobs "ADMIT=1"] +] +install: [ + [make "PREFIX=%{prefix}%" "install"] +] +dev-repo: "git+https://github.com/FStarLang/FStar" +bug-reports: "https://github.com/FStarLang/FStar/issues" +synopsis: "Verification system for effectful programs" +url { + src: "https://github.com/FStarLang/FStar/archive/V0.9.7.0-alpha1.zip" + checksum: "md5=78414a6a5a0ca0c7770a43a36c5f31f7" +} diff --git a/stage0/get_fstar_z3.sh b/stage0/get_fstar_z3.sh new file mode 100755 index 00000000000..938d9be0253 --- /dev/null +++ b/stage0/get_fstar_z3.sh @@ -0,0 +1,146 @@ +#!/usr/bin/env bash +set -euo pipefail + +full_install=false + +kernel="$(uname -s)" +case "$kernel" in + CYGWIN*) kernel=Windows ;; +esac + +arch="$(uname -m)" +case "$arch" in + arm64) arch=aarch64 ;; +esac + +release_url=( + "Linux-x86_64-4.8.5":"https://github.com/Z3Prover/z3/releases/download/Z3-4.8.5/z3-4.8.5-x64-ubuntu-16.04.zip" + "Darwin-x86_64-4.8.5":"https://github.com/Z3Prover/z3/releases/download/Z3-4.8.5/z3-4.8.5-x64-osx-10.14.2.zip" + "Windows-x86_64-4.8.5":"https://github.com/Z3Prover/z3/releases/download/Z3-4.8.5/z3-4.8.5-x64-win.zip" + "Linux-x86_64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-x64-glibc-2.35.zip" + "Linux-aarch64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-arm64-glibc-2.34.zip" + "Darwin-x86_64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-x64-osx-13.7.zip" + "Darwin-aarch64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-arm64-osx-13.7.zip" + "Windows-x86_64-4.13.3":"https://github.com/Z3Prover/z3/releases/download/z3-4.13.3/z3-4.13.3-x64-win.zip" +) + +get_url() { + local key elem + key="$1" + + for elem in "${release_url[@]}"; do + if [ "${elem%%:*}" = "$key" ]; then + echo -n "${elem#*:}" + break + fi + done +} + +trap "exit 1" HUP INT PIPE QUIT TERM +cleanup() { + if [ -n "${tmp_dir:-}" ]; then + rm -rf "$tmp_dir" + fi +} +trap "cleanup" EXIT + +download_z3() { + local url version destination_file_name base_name z3_path + url="$1" + version="$2" + destination_file_name="$3" + + if [ -z "${tmp_dir:-}" ]; then + tmp_dir="$(mktemp -d --tmpdir get_fstar_z3.XXXXXXX)" + fi + + echo ">>> Downloading Z3 $version from $url ..." + base_name="$(basename "$url")" + + z3_path="${base_name%.zip}/bin/z3" + if [ "$kernel" = Windows ]; then z3_path="$z3_path.exe"; fi + + pushd "$tmp_dir" > /dev/null + curl -s -L "$url" -o "$base_name" + + unzip -q "$base_name" "$z3_path" + popd > /dev/null + install -m0755 "$tmp_dir/$z3_path" "$destination_file_name" + echo ">>> Installed Z3 $version to $destination_file_name" +} + +full_install_z3() { + local url version dest_dir base_name + + url="$1" + version="$2" + dest_dir="$3" + + mkdir -p "$dest_dir/z3-$version" + pushd "$dest_dir/z3-$version" > /dev/null + + echo ">>> Downloading Z3 $version from $url ..." + base_name="$(basename "$url")" + curl -s -L "$url" -o "$base_name" + + unzip -q "$base_name" + mv "${base_name%.zip}"/* . + rmdir "${base_name%.zip}" + rm "$base_name" + popd > /dev/null +} + +usage() { + echo "Usage: get_fstar_z3.sh destination/directory/bin" + exit 1 +} + +if [ $# -ge 1 ] && [ "$1" == "--full" ]; then + # Passing --full xyz/ will create a tree like + # xyz/z3-4.8.5/bin/z3 + # xyz/z3-4.13.3/bin/z3 + # (plus all other files in each package). This is used + # for our binary packages which include Z3. + full_install=true; + shift; +fi + +if [ $# -ne 1 ]; then + usage +fi + +dest_dir="$1" + +mkdir -p "$dest_dir" + +for z3_ver in 4.8.5 4.13.3; do + destination_file_name="$dest_dir/z3-$z3_ver" + if [ "$kernel" = Windows ]; then destination_file_name="$destination_file_name.exe"; fi + + if [ -f "$destination_file_name" ]; then + echo ">>> Z3 $z3_ver already downloaded to $destination_file_name" + else + key="$kernel-$arch-$z3_ver" + + case "$key" in + Linux-aarch64-4.8.5) + echo ">>> Z3 4.8.5 is not available for aarch64, downloading x86_64 version. You need to install qemu-user (and shared libraries) to execute it." + key="$kernel-x86_64-$z3_ver" + ;; + Darwin-aarch64-4.8.5) + echo ">>> Z3 4.8.5 is not available for aarch64, downloading x86_64 version. You need to install Rosetta 2 to execute it." + key="$kernel-x86_64-$z3_ver" + ;; + esac + + url="$(get_url "$key")" + + if [ -z "$url" ]; then + echo ">>> Z3 $z3_ver not available for this architecture, skipping..." + elif $full_install; then + full_install_z3 "$url" "$z3_ver" "$dest_dir" + else + download_z3 "$url" "$z3_ver" "$destination_file_name" + fi + fi +done diff --git a/stage0/mk/common.mk b/stage0/mk/common.mk new file mode 100644 index 00000000000..18e63e06809 --- /dev/null +++ b/stage0/mk/common.mk @@ -0,0 +1,92 @@ +# This makefile is included from several other makefiles in the tree. + +MAKEFLAGS += --no-builtin-rules +Q?=@ +SIL?=--silent +RUNLIM= +ifneq ($(V),) + Q= + SIL= +else + MAKEFLAGS += -s +endif + +define NO_RUNLIM_ERR +runlim not found: + To use RESOURCEMONITOR=1, the `runlim` tool must be installed and in your $$PATH. + It must also be a recent version supporting the `-p` option. + You can get it from: [https://github.com/arminbiere/runlim] +endef + +define msg = +@printf " %-14s %s\n" $(1) $(2) +endef +# Must be one line so it can be commented out easily +#-tput bold 2>/dev/null +#-tput sgr0 2>/dev/null +define bold_msg = +printf -- " %-15s %s\n" $(1) $(2) +endef + +# Passing RESOURCEMONITOR=1 will create .runlim files through the source tree with +# information about the time and space taken by each F* invocation. +ifneq ($(RESOURCEMONITOR),) + ifeq ($(shell which runlim),) + _ := $(error $(NO_RUNLIM_ERR))) + endif + ifneq ($(MONID),) + MONPREFIX=$(MONID). + endif + RUNLIM=runlim -p -o $@.$(MONPREFIX)runlim +endif + +# Ensure that any failing rule will not create its target file. +# In other words, make `make` less insane. +.DELETE_ON_ERROR: + +.DEFAULT_GOAL:=__undef +.PHONY: __undef +__undef: + $(error "This makefile does not have a default goal") + +# Check that a variable is defined. If not, abort with an (optional) error message. +need = \ + $(if $(value $(strip $1)),, \ + $(error Need a value for $(strip $1)$(if $2, ("$(strip $2)")))) + +# Check that a variable is defined and pointing to an executable. +# Is there no negation in make...? +# Wew! this was interesting to write. Especially the override part. +need_exe = \ + $(if $(value $(strip $1)), \ + $(if $(wildcard $(value $(strip $1))), \ + $(if $(shell test -x $(value $(strip $1)) && echo 1), \ + $(eval override $(strip $1):=$(abspath $(value $(strip $1)))), \ + $(error $(strip $1) ("$(value $(strip $1))") is not executable)), \ + $(error $(strip $1) ("$(value $(strip $1))") does not exist (cwd = $(CURDIR)))), \ + $(error Need an executable for $(strip $1)$(if $2, ("$(strip $2)")))) \ + +need_file = \ + $(if $(value $(strip $1)), \ + $(if $(wildcard $(value $(strip $1))), \ + $(if $(shell test -f $(value $(strip $1)) && echo 1), \ + $(eval override $(strip $1):=$(abspath $(value $(strip $1)))), \ + $(error $(strip $1) ("$(value $(strip $1))") is not executable)), \ + $(error $(strip $1) ("$(value $(strip $1))") does not exist (cwd = $(CURDIR)))), \ + $(error Need a file path for $(strip $1)$(if $2, ("$(strip $2)")))) \ + +need_dir = \ + $(if $(value $(strip $1)), \ + $(if $(wildcard $(value $(strip $1))), \ + $(if $(shell test -d $(value $(strip $1)) && echo 1), \ + $(eval override $(strip $1):=$(abspath $(value $(strip $1)))), \ + $(error $(strip $1) ("$(value $(strip $1))") is not executable)), \ + $(error $(strip $1) ("$(value $(strip $1))") is not a directory (cwd = $(CURDIR)))), \ + $(error Need an *existing* directory path for $(strip $1)$(if $2, ("$(strip $2)")))) \ + +need_dir_mk = \ + $(if $(value $(strip $1)), \ + $(if $(shell mkdir -p $(value $(strip $1)) && echo 1), \ + $(eval override $(strip $1):=$(abspath $(value $(strip $1)))), \ + $(error $(strip $1) ("$(value $(strip $1))") is not a directory (mkdir failed, cwd = $(CURDIR)))), \ + $(error Need a directory path for $(strip $1)$(if $2, ("$(strip $2)")))) \ diff --git a/stage0/mk/fstar-12.mk b/stage0/mk/fstar-12.mk new file mode 100644 index 00000000000..a9326342bf5 --- /dev/null +++ b/stage0/mk/fstar-12.mk @@ -0,0 +1,29 @@ +FSTAR_OPTIONS += --lax +# HACK ALERT! --MLish passed by generic.mk to FStarC modules +# only. Passing it here would mean the library is checked with +# --MLish, which fails. +FSTAR_OPTIONS += --MLish_effect 'FStarC.Effect' +FSTAR_OPTIONS += --no_default_includes +FSTAR_OPTIONS += --include "$(FSTAR_ROOT)/ulib" + +# FIXME: Maintaining this list sucks. Could **the module** itself +# specify whether it is noextract? Actually, the F* compiler should +# already know which of its modules are in its library, and do this by +# default. +EXTRACT := +EXTRACT += --extract ',*' # keep the comma (https://github.com/FStarLang/FStar/pull/3640) +EXTRACT += --extract -Prims +EXTRACT += --extract -FStar +EXTRACT += --extract -FStarC.Extraction.ML.PrintML # very much a special case + +# Library wrangling +EXTRACT += --extract +FStar.Pervasives +EXTRACT += --extract -FStar.Pervasives.Native +EXTRACT += --extract +FStar.Class.Printable +EXTRACT += --extract +FStar.Seq.Base +EXTRACT += --extract +FStar.Seq.Properties + +ROOTS := +ROOTS += $(SRC)/fstar/FStarC.Main.fst + +include mk/generic.mk diff --git a/stage0/mk/generic.mk b/stage0/mk/generic.mk new file mode 100644 index 00000000000..dc980927a2b --- /dev/null +++ b/stage0/mk/generic.mk @@ -0,0 +1,130 @@ +include mk/common.mk + +$(call need_exe, FSTAR_EXE, fstar.exe to be used) +$(call need_dir_mk, CACHE_DIR, directory for checked files) +$(call need_dir_mk, OUTPUT_DIR, directory for extracted OCaml files) +$(call need, CODEGEN, backend (OCaml / Plugin)) +$(call need_dir, SRC, source directory) +$(call need, TAG, a tag for the .depend; to prevent clashes. Sorry.) +$(call need, ROOTS, a list of roots for the dependency analysis) +# Optional: EXTRACT, DEPFLAGS +# +# TOUCH (optional): pass a file to touch everytime something is +# performed. We also create it if it does not exist (this simplifies +# external use) +ifneq ($(TOUCH),) +_ != $(shell [ -f "$(TOUCH)" ] || touch $(TOUCH)) +endif + +maybe_touch=$(if $(TOUCH), touch $(TOUCH)) + +# This is to support both --lax and non --lax clients. +EXTENSION := $(if $(findstring --lax,$(FSTAR_OPTIONS)),.checked.lax,.checked) +MSG := $(if $(findstring --lax,$(FSTAR_OPTIONS)),LAXCHECK,CHECK) + +ifeq ($(CODEGEN),FSharp) +EEXT=fs +else ifeq ($(CODEGEN),krml) +EEXT=krml +else +EEXT=ml +endif + +.PHONY: clean +clean: + rm -rf $(CACHE_DIR) + rm -rf $(OUTPUT_DIR) + +.PHONY: ocaml +ocaml: all-ml + +.PHONY: verify +verify: all-checked + +FSTAR_OPTIONS += --odir "$(OUTPUT_DIR)" +FSTAR_OPTIONS += --cache_dir "$(CACHE_DIR)" +FSTAR_OPTIONS += --include "$(SRC)" +FSTAR_OPTIONS += --cache_checked_modules +FSTAR_OPTIONS += $(OTHERFLAGS) + +ifeq ($(ADMIT),1) +FSTAR_OPTIONS += --admit_smt_queries true +endif + +ifeq ($(OS),Windows_NT) +WINWRAP=$(FSTAR_ROOT)/mk/winwrap.sh +else +WINWRAP= +endif + +FSTAR := $(WINWRAP) $(FSTAR_EXE) $(SIL) $(FSTAR_OPTIONS) + +%$(EXTENSION): FF=$(notdir $(subst $(EXTENSION),,$@)) +%$(EXTENSION): + $(call msg, $(MSG), $(FF)) + $(FSTAR) $(if $(findstring FStarC.,$<),--MLish,) --already_cached ',*' $< + @# HACK: finding FStarC modules and passing --MLish + @# for them and only them. + touch -c $@ # update timestamp even if cache hit + $(maybe_touch) + +%.$(EEXT): FF=$(notdir $(subst $(EXTENSION),,$<)) +%.$(EEXT): MM=$(basename $(FF)) +%.$(EEXT): LBL=$(notdir $@) +# ^ HACK we use notdir to get the module name since we need to pass in +# the fst (not the checked file), but we don't know where it is, so this +# is relying on F* looking in its include path. +%.$(EEXT): + $(call msg, "EXTRACT", $(LBL)) + $(FSTAR) $(if $(findstring FStarC.,$<),--MLish,) $(FF) --already_cached '*,' --codegen $(CODEGEN) --extract_module $(MM) + @# HACK: finding FStarC modules and passing --MLish + @# for them and only them. + $(maybe_touch) + +%.krml: FF=$(notdir $(subst $(EXTENSION),,$<)) +%.krml: MM=$(basename $(FF)) +%.krml: LBL=$(notdir $@) +%.krml: + $(call msg, "EXTRACT", $(LBL)) + $(FSTAR) $(FF) --already_cached ',*' --codegen krml --extract_module $(MM) + +DEPSTEM := $(CACHE_DIR)/.depend$(TAG) + +# We always run this to compute a full list of fst/fsti files in the +# $(SRC) (ignoring the roots, it's a bit conservative). The list is +# saved in $(DEPSTEM).touch.chk, and compared to the one we generated +# before in $(DEPSTEM).touch. If there's a change (or the 'previous') +# does not exist, the timestamp of $(DEPSTEM0.touch will be updated +# triggering an actual dependency run. +.PHONY: .force +$(DEPSTEM).touch: .force + mkdir -p $(dir $@) + find $(SRC) -name '*.fst*' > $@.chk + diff -q $@ $@.chk 2>/dev/null || cp $@.chk $@ + +$(DEPSTEM): $(DEPSTEM).touch + $(call msg, "DEPEND", $(SRC)) + $(FSTAR) --dep full $(ROOTS) $(EXTRACT) $(DEPFLAGS) --output_deps_to $@ + +depend: $(DEPSTEM) +include $(DEPSTEM) + +depgraph: $(DEPSTEM).pdf +$(DEPSTEM).pdf: $(DEPSTEM) .force + $(call msg, "DEPEND GRAPH", $(SRC)) + $(FSTAR) --dep graph $(ROOTS) $(EXTRACT) $(DEPFLAGS) --output_deps_to $(DEPSTEM).graph + $(FSTAR_ROOT)/.scripts/simpl_graph.py $(DEPSTEM).graph > $(DEPSTEM).simpl + dot -Tpdf -o $@ $(DEPSTEM).simpl + echo "Wrote $@" + +all-checked: $(ALL_CHECKED_FILES) + +all-ml: $(ALL_ML_FILES) + @# Remove extraneous .ml files, which can linger after + @# module renamings. The realpath is necessary to prevent + @# discrepancies between absolute and relative paths, double + @# slashes, etc. + rm -vf $(filter-out $(realpath $(ALL_ML_FILES)), $(realpath $(wildcard $(OUTPUT_DIR)/*.ml))) + +all-fs: $(ALL_FS_FILES) + rm -vf $(filter-out $(realpath $(ALL_FS_FILES)), $(realpath $(wildcard $(OUTPUT_DIR)/*.fs))) diff --git a/stage0/mk/lib.mk b/stage0/mk/lib.mk new file mode 100644 index 00000000000..4d1b2884067 --- /dev/null +++ b/stage0/mk/lib.mk @@ -0,0 +1,81 @@ +FSTAR_OPTIONS += --ext context_pruning +FSTAR_OPTIONS += --z3version 4.13.3 + +# Checking a library, make sure to not use the parent lib. +FSTAR_OPTIONS += --no_default_includes +FSTAR_OPTIONS += --include $(SRC) + +EXTRACT_NS := +EXTRACT_NS += -FStar.Buffer +EXTRACT_NS += -FStar.Bytes +EXTRACT_NS += -FStar.Char +EXTRACT_NS += -FStar.CommonST +EXTRACT_NS += -FStar.Constructive +EXTRACT_NS += -FStar.Dyn +EXTRACT_NS += -FStar.Float +EXTRACT_NS += -FStar.Ghost +EXTRACT_NS += -FStar.Heap +EXTRACT_NS += -FStar.Monotonic.Heap +EXTRACT_NS += -FStar.HyperStack.All +EXTRACT_NS += -FStar.HyperStack.ST +EXTRACT_NS += -FStar.HyperStack.IO +EXTRACT_NS += -FStar.Int16 +EXTRACT_NS += -FStar.Int32 +EXTRACT_NS += -FStar.Int64 +EXTRACT_NS += -FStar.Int8 +EXTRACT_NS += -FStar.IO +EXTRACT_NS += -FStar.List +EXTRACT_NS += -FStar.List.Tot.Base +EXTRACT_NS += -FStar.Option +EXTRACT_NS += -FStar.Pervasives.Native +EXTRACT_NS += -FStar.ST +EXTRACT_NS += -FStar.Exn +EXTRACT_NS += -FStar.String +EXTRACT_NS += -FStar.UInt16 +EXTRACT_NS += -FStar.UInt32 +EXTRACT_NS += -FStar.UInt64 +EXTRACT_NS += -FStar.UInt8 +EXTRACT_NS += -FStar.Pointer.Derived1 +EXTRACT_NS += -FStar.Pointer.Derived2 +EXTRACT_NS += -FStar.Pointer.Derived3 +EXTRACT_NS += -FStar.BufferNG +EXTRACT_NS += -FStar.TaggedUnion +EXTRACT_NS += -FStar.Bytes +EXTRACT_NS += -FStar.Util +EXTRACT_NS += -FStar.InteractiveHelpers +EXTRACT_NS += -FStar.Class.Embeddable +EXTRACT_NS += -FStar.Vector.Base +EXTRACT_NS += -FStar.Vector.Properties +EXTRACT_NS += -FStar.Vector +EXTRACT_NS += -FStar.TSet +EXTRACT_NS += -FStar.MSTTotal +EXTRACT_NS += -FStar.MST +EXTRACT_NS += -FStar.NMSTTotal +EXTRACT_NS += -FStar.NMST +EXTRACT_NS += -FStar.Printf +EXTRACT_NS += -FStar.ModifiesGen +EXTRACT_NS += -LowStar.Printf +EXTRACT_NS += -FStar.Sealed +EXTRACT_NS += +FStar.List.Pure.Base +EXTRACT_NS += +FStar.List.Tot.Properties +EXTRACT_NS += +FStar.Int.Cast.Full + +# Note: the pluginlib rules will enable these. +EXTRACT_NS += -FStar.Tactics +EXTRACT_NS += -FStar.Reflection + +EXTRACT := --extract '* $(EXTRACT_NS)' + +# Leaving this empty, F* will scan the include path for all fst/fsti +# files. This will read fstar.include and follow it too. +# ROOTS := +# No! If we do that, we will pick up files from the current directory +# (the root of the repo) since that is implicitly included in F*'s +# search path. So instead, be explicit about scanning over all the files +# in $(SRC) (i.e. ulib). Note that there is a still a problem if there is a +# file in the cwd named like a file in ulib/, F* may prefer the former. +# +# Update: generic.mk will now complain too. +ROOTS := $(shell find $(SRC) -name '*.fst' -o -name '*.fsti') + +include mk/generic.mk diff --git a/stage0/mk/winwrap.sh b/stage0/mk/winwrap.sh new file mode 100755 index 00000000000..2c493b61a42 --- /dev/null +++ b/stage0/mk/winwrap.sh @@ -0,0 +1,20 @@ +#!/bin/bash + +# Running ./winwrap.sh cmd args will make replace any cygwin paths in +# the args before calling cmd. E.g. /cygdrive/c/foo/bar -> c:/foo/bar +# +# If none of the arguments are of that shape, this script should be +# fully transparent, passing arguments to $cmd in exactly the same shape +# even if they contain spaces, etc. + +cmd=$1 +shift + +args=() + +for arg; do + arg=$(echo "$arg" | sed 's,^/cygdrive/\(.\)/,\1:/,') + args+=("$arg") +done + +exec $cmd "${args[@]}" diff --git a/stage0/ulib/.gitignore b/stage0/ulib/.gitignore deleted file mode 100644 index fd6c867cee3..00000000000 --- a/stage0/ulib/.gitignore +++ /dev/null @@ -1,14 +0,0 @@ -*.fst-ver -*.fsti-ver -*.mgen -.depend* -fs/extracted -[Bb]in/ -[Oo]bj/ -*.bak - -dep.graph -dep_simpl.graph -depgraph.pdf - -depgraph-* diff --git a/stage0/ulib/Cfg.fst.config.json b/stage0/ulib/Cfg.fst.config.json new file mode 100644 index 00000000000..20dd6d861c6 --- /dev/null +++ b/stage0/ulib/Cfg.fst.config.json @@ -0,0 +1,12 @@ +{ + "_comment": "Note: the path below must be the 'uninstalled' path (not in out/) so we can still open ulib interactively even if the library failed to build as a whole (which is usually a time when you want to open it!). You can switch to stage2 too, just also switch the include of ulib.checked below", + + "fstar_exe": "../stage1/dune/_build/default/fstarc-full/fstarc1_full.exe", + "options": [ + "--ext", "context_pruning", + "--z3version", "4.13.3" + ], + "include_dirs": [ + "../stage1/ulib.checked" + ] +} diff --git a/stage0/ulib/FStar.FunctionalQueue.fst b/stage0/ulib/FStar.FunctionalQueue.fst index f4af0d78298..5caf7291c5b 100644 --- a/stage0/ulib/FStar.FunctionalQueue.fst +++ b/stage0/ulib/FStar.FunctionalQueue.fst @@ -144,7 +144,7 @@ let lemma_snoc_list_seq (#a:Type) (x:a) (q:queue a) seq_of_list l `Seq.append` seq_of_list [x]; == { assert (Seq.equal (seq_of_list [x]) (Seq.create 1 x)) } seq_of_list l `Seq.append` Seq.create 1 x; - == { admit() } + == { } Seq.snoc (seq_of_list l) x; } diff --git a/stage0/ulib/FStar.Issue.fsti b/stage0/ulib/FStar.Issue.fsti index 3697227fc1e..68b98a1139e 100644 --- a/stage0/ulib/FStar.Issue.fsti +++ b/stage0/ulib/FStar.Issue.fsti @@ -23,8 +23,10 @@ val range_of_issue (i:issue) : Tot (option range) val context_of_issue (i:issue) : Tot (list string) +val issue_to_doc (i:issue) : Tot Pprint.document + val render_issue (i:issue) : Tot string - + (* NOTE: the only way to build a document that actually reduces in interpreted mode (like in tactics when not using plugins) is using arbitrary_string, as below. *) diff --git a/stage0/ulib/FStar.Math.Fermat.fst b/stage0/ulib/FStar.Math.Fermat.fst index 1c8140d0cff..a14631d3ffe 100644 --- a/stage0/ulib/FStar.Math.Fermat.fst +++ b/stage0/ulib/FStar.Math.Fermat.fst @@ -477,11 +477,14 @@ let fermat p a = val mod_mult_congr_aux (p:int{is_prime p}) (a b c:int) : Lemma (requires (a * c) % p = (b * c) % p /\ 0 <= b /\ b <= a /\ a < p /\ c % p <> 0) (ensures a = b) +#push-options "--retry 3" // proof below is brittle let mod_mult_congr_aux p a b c = let open FStar.Math.Lemmas in calc (==>) { (a * c) % p == (b * c) % p; ==> { mod_add_both (a * c) (b * c) (-b * c) p } + (a * c + (- b * c)) % p == (b * c + (- b * c)) % p; + ==> {} (a * c - b * c) % p == (b * c - b * c) % p; ==> { swap_mul a c; swap_mul b c; lemma_mul_sub_distr c a b } (c * (a - b)) % p == (b * c - b * c) % p; @@ -491,6 +494,7 @@ let mod_mult_congr_aux p a b c = let r, s = FStar.Math.Euclid.bezout_prime p (c % p) in FStar.Math.Euclid.euclid p (c % p) (a - b) r s; small_mod (a - b) p +#pop-options let mod_mult_congr p a b c = let open FStar.Math.Lemmas in diff --git a/stage0/ulib/FStar.Matrix.fst b/stage0/ulib/FStar.Matrix.fst index c44a524868f..bca2a15b210 100644 --- a/stage0/ulib/FStar.Matrix.fst +++ b/stage0/ulib/FStar.Matrix.fst @@ -732,6 +732,7 @@ let matrix_mul_unit_row_lemma #c #eq m (add mul: CE.cm c eq) (i: under m) (SB.create 1 mul.unit `SB.append` SB.create (m-i-1) add.unit)) (row (matrix_mul_unit add mul m) i) +#push-options "--z3rlimit 20" let matrix_mul_unit_col_lemma #c #eq m (add mul: CE.cm c eq) (i: under m) : Lemma ((col (matrix_mul_unit add mul m) i == (SB.create i add.unit) `SB.append` @@ -745,7 +746,8 @@ let matrix_mul_unit_col_lemma #c #eq m (add mul: CE.cm c eq) (i: under m) SB.lemma_eq_elim ((SB.create i add.unit) `SB.append` (SB.create 1 mul.unit `SB.append` SB.create (m-i-1) add.unit)) (col (matrix_mul_unit add mul m) i) - +#pop-options + let seq_of_products_zeroes_lemma #c #eq #m (mul: CE.cm c eq) (z: c{is_absorber z mul}) (s: SB.seq c{SB.length s == m}) diff --git a/stage0/ulib/FStar.ModifiesGen.fst b/stage0/ulib/FStar.ModifiesGen.fst index 412343c3c23..45a49be66ae 100644 --- a/stage0/ulib/FStar.ModifiesGen.fst +++ b/stage0/ulib/FStar.ModifiesGen.fst @@ -15,8 +15,7 @@ *) module FStar.ModifiesGen -#set-options "--split_queries no --ext 'context_pruning='" -#set-options "--using_facts_from '*,-FStar.Tactics,-FStar.Reflection,-FStar.List'" +#set-options "--split_queries no" module HS = FStar.HyperStack module HST = FStar.HyperStack.ST @@ -220,7 +219,6 @@ let loc_equal_elim (#al: aloc_t) (#c: cls al) (s1 s2: loc c) : Lemma = fun_set_equal_elim (Loc?.non_live_addrs s1) (Loc?.non_live_addrs s2); fun_set_equal_elim (Loc?.live_addrs s1) (Loc?.live_addrs s2) - let loc_union_idem #al #c s = assert (loc_union s s `loc_equal` s) @@ -1060,7 +1058,7 @@ let modifies_preserves_liveness_strong #al #c s1 s2 h h' #t #pre r x = #pop-options let modifies_preserves_region_liveness #al #c l1 l2 h h' r = () - +#restart-solver let modifies_preserves_region_liveness_reference #al #c l1 l2 h h' #t #pre r = () let modifies_preserves_region_liveness_aloc #al #c l1 l2 h h' #r #n x = @@ -1184,6 +1182,7 @@ let loc_includes_loc_regions_restrict_to_regions (loc_includes (loc_regions false rs) (restrict_to_regions l rs)) = Classical.forall_intro (loc_aux_includes_refl #al #c) +#push-options "--z3rlimit_factor 2" let modifies_only_live_regions #al #c rs l h h' = let s = l in let c_rs = Set.complement rs in @@ -1205,6 +1204,7 @@ let modifies_only_live_regions #al #c rs l h h' = modifies_only_live_regions_weak rs s_c_rs h h'; loc_includes_restrict_to_regions s c_rs; modifies_loc_includes s h h' s_c_rs +#pop-options let no_upd_fresh_region #al #c r l h0 h1 = modifies_only_live_regions (HS.mod_set (Set.singleton r)) l h0 h1 @@ -1244,6 +1244,7 @@ let popped_modifies #al c h0 h1 = ) #pop-options +#push-options "--z3rlimit_factor 2" let modifies_fresh_frame_popped #al #c h0 h1 s h2 h3 = fresh_frame_modifies c h0 h1; let r = loc_region_only #al #c false (HS.get_tip h2) in @@ -1261,6 +1262,7 @@ let modifies_fresh_frame_popped #al #c h0 h1 s h2 h3 = ); modifies_trans' s' h0 h2 h3; modifies_only_live_regions rs s h0 h3 +#pop-options let modifies_loc_regions_intro #al #c rs h1 h2 = let f (r: HS.rid) (a: nat) (b: al r a) : Lemma @@ -1475,6 +1477,7 @@ let loc_not_unused_in #al c h = (mk_live_addrs (fun x -> f x)) (Ghost.hide (aloc_domain c (Ghost.hide (Set.complement Set.empty)) f)) +#restart-solver let loc_unused_in #al c h = let f (r: HS.rid) : GTot (GSet.set nat) = if not (HS.live_region h r) @@ -1493,10 +1496,13 @@ let loc_unused_in #al c h = let loc_regions_unused_in #al c h rs = () #push-options "--z3rlimit 20" +#restart-solver let loc_addresses_unused_in #al c r a h = () #pop-options - +#restart-solver +#push-options "--fuel 2 --ifuel 1 --z3smtopt '(set-option :smt.qi.eager_threshold 5)' --z3rlimit_factor 4" let loc_addresses_not_unused_in #al c r a h = () +#pop-options #push-options "--z3rlimit 50" let loc_unused_in_not_unused_in_disjoint #al c h = @@ -1528,7 +1534,8 @@ let modifies_address_liveness_insensitive_unused_in #al c h h' = #pop-options #pop-options -#push-options "--max_fuel 0 --max_ifuel 0 --z3rlimit 16" +#push-options "--max_fuel 0 --max_ifuel 0 --z3rlimit 16 --retry 5 --z3cliopt 'smt.qi.eager_threshold=5'" +#restart-solver let modifies_only_not_unused_in #al #c l h h' = assert (modifies_preserves_regions l h h'); assert (modifies_preserves_not_unused_in l h h'); @@ -1713,6 +1720,7 @@ let union_aux_of_aux_left : Tot (GSet.set (aloc (cls_union c))) = GSet.comprehend (union_aux_of_aux_left_pred c b s) +#restart-solver let union_loc_of_loc #al c b l = let (Loc regions region_liveness_tags non_live_addrs live_addrs aux) = l in let aux' : GSet.set (aloc #(cls_union_aloc al) (cls_union c)) = @@ -1750,6 +1758,7 @@ let union_aux_of_aux_left_inv : Tot (GSet.set (aloc (c b))) = GSet.comprehend (union_aux_of_aux_left_inv_pred b s) +#restart-solver let mem_union_aux_of_aux_left_intro (#al: (bool -> HS.rid -> nat -> Tot Type)) (c: ((b: bool) -> Tot (cls (al b)))) @@ -1772,6 +1781,7 @@ let mem_union_aux_of_aux_left_elim [SMTPat (GSet.mem x (union_aux_of_aux_left #al c b aux))] = () +#restart-solver let addrs_of_loc_union_loc_of_loc (#al: (bool -> HS.rid -> nat -> Tot Type)) (c: ((b: bool) -> Tot (cls (al b)))) @@ -1783,6 +1793,7 @@ let addrs_of_loc_union_loc_of_loc [SMTPat (addrs_of_loc (union_loc_of_loc #al c b l) r)] = () +#restart-solver let union_loc_of_loc_none #al c b = assert (loc_equal #_ #(cls_union c) (union_loc_of_loc c b (loc_none #_ #(c b))) (loc_none #_ #(cls_union c))) @@ -1791,13 +1802,17 @@ let union_loc_of_loc_union #al c b l1 l2 = assert (loc_equal #_ #(cls_union c) (union_loc_of_loc c b (loc_union #_ #(c b) l1 l2)) (loc_union #_ #(cls_union c) (union_loc_of_loc c b l1) (union_loc_of_loc c b l2))) #pop-options +#push-options "--z3rlimit_factor 2" +#restart-solver let union_loc_of_loc_addresses #al c b preserve_liveness r n = assert (loc_equal #_ #(cls_union c) (union_loc_of_loc c b (loc_addresses #_ #(c b) preserve_liveness r n)) (loc_addresses #_ #(cls_union c) preserve_liveness r n)) let union_loc_of_loc_regions #al c b preserve_liveness r = assert (loc_equal #_ #(cls_union c) (union_loc_of_loc c b (loc_regions #_ #(c b) preserve_liveness r)) (loc_regions #_ #(cls_union c) preserve_liveness r)) +#pop-options -#push-options "--z3rlimit 25" +#push-options "--z3rlimit_factor 6 --fuel 2 --ifuel 1 --z3cliopt 'smt.qi.eager_threshold=5'" +#restart-solver let union_loc_of_loc_includes_intro (#al: (bool -> HS.rid -> nat -> Tot Type)) (c: ((b: bool) -> Tot (cls (al b)))) @@ -1897,7 +1912,8 @@ let union_loc_of_loc_includes #al c b s1 s2 = Classical.move_requires (union_loc_of_loc_includes_elim c b s1) s2; Classical.move_requires (union_loc_of_loc_includes_intro c b s1) s2 -#push-options "--fuel 0 --ifuel 0" +#push-options "--fuel 0 --ifuel 0 --z3cliopt 'smt.qi.eager_threshold=5' --z3rlimit_factor 4" +#restart-solver let union_loc_of_loc_disjoint_intro (#al: (bool -> HS.rid -> nat -> Tot Type)) (c: ((b: bool) -> Tot (cls (al b)))) @@ -1947,8 +1963,11 @@ let union_loc_of_loc_disjoint_intro xs.addr `GSet.mem` addrs_of_loc_weak smaller xs.region /\ aloc_disjoint xl xs )) by ( + let open FStar.Stubs.Tactics.V2.Builtins in let open FStar.Tactics.SMT in set_rlimit 15; + set_options "--z3cliopt 'smt.qi.eager_threshold=1'"; + set_options "--retry 5"; () ); assert (auxl ` loc_aux_disjoint` doms); @@ -2144,6 +2163,7 @@ let raise_loc #al #c l = live_addrs (Ghost.hide (GSet.comprehend (raise_loc_aux_pred c aux))) +#restart-solver let raise_loc_none #al #c = assert (raise_loc u#x u#y (loc_none #_ #c) `loc_equal` loc_none) @@ -2156,23 +2176,24 @@ let raise_loc_addresses #al #c preserve_liveness r a = let raise_loc_regions #al #c preserve_liveness r = assert (raise_loc u#x u#y (loc_regions #_ #c preserve_liveness r) `loc_equal` loc_regions preserve_liveness r) -#push-options "--z3rlimit 15 --z3cliopt 'smt.qi.eager_threshold=100'" +#push-options "--z3rlimit 15 --z3cliopt 'smt.qi.eager_threshold=100' --fuel 2 --ifuel 1" +#restart-solver let raise_loc_includes #al #c l1 l2 = - let l1' = raise_loc l1 in - let l2' = raise_loc l2 in - assert (forall (x: aloc (raise_cls c)) . GSet.mem x (Ghost.reveal (Loc?.aux l1')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l1))); - assert (forall (x: aloc (raise_cls c)) . GSet.mem x (Ghost.reveal (Loc?.aux l2')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l2))); - assert (forall (x: aloc c) . GSet.mem x (Ghost.reveal (Loc?.aux l1)) <==> GSet.mem (upgrade_aloc x) (Ghost.reveal (Loc?.aux l1'))); - assert (forall (x: aloc c) . GSet.mem x (Ghost.reveal (Loc?.aux l2)) <==> GSet.mem (upgrade_aloc x) (Ghost.reveal (Loc?.aux l2'))); - assert (loc_aux_includes (Ghost.reveal (Loc?.aux l1')) (Ghost.reveal (Loc?.aux l2')) <==> loc_aux_includes (Ghost.reveal (Loc?.aux l1)) (Ghost.reveal (Loc?.aux l2))) + let l1' = raise_loc u#x u#y l1 in + let l2' = raise_loc u#x u#y l2 in + assert (forall (x: aloc (raise_cls u#x u#y c)) . GSet.mem x (Ghost.reveal (Loc?.aux l1')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l1))); + assert (forall (x: aloc (raise_cls u#x u#y c)) . GSet.mem x (Ghost.reveal (Loc?.aux l2')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l2))); + assert (forall (x: aloc c) . GSet.mem x (Ghost.reveal (Loc?.aux l1)) <==> GSet.mem (upgrade_aloc u#x u#y x) (Ghost.reveal (Loc?.aux l1'))); + assert (forall (x: aloc c) . GSet.mem x (Ghost.reveal (Loc?.aux l2)) <==> GSet.mem (upgrade_aloc u#x u#y x) (Ghost.reveal (Loc?.aux l2'))); + () #pop-options #push-options "--z3rlimit 20" let raise_loc_disjoint #al #c l1 l2 = - let l1' = raise_loc l1 in - let l2' = raise_loc l2 in - assert (forall (x: aloc (raise_cls c)) . GSet.mem x (Ghost.reveal (Loc?.aux l1')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l1))); - assert (forall (x: aloc (raise_cls c)) . GSet.mem x (Ghost.reveal (Loc?.aux l2')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l2))); + let l1' = raise_loc u#x u#y l1 in + let l2' = raise_loc u#x u#y l2 in + assert (forall (x: aloc (raise_cls u#x u#y c)) . GSet.mem x (Ghost.reveal (Loc?.aux l1')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l1))); + assert (forall (x: aloc (raise_cls u#x u#y c)) . GSet.mem x (Ghost.reveal (Loc?.aux l2')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l2))); assert (forall (x: aloc c) . GSet.mem x (Ghost.reveal (Loc?.aux l1)) <==> GSet.mem (upgrade_aloc x) (Ghost.reveal (Loc?.aux l1'))); assert (forall (x: aloc c) . GSet.mem x (Ghost.reveal (Loc?.aux l2)) <==> GSet.mem (upgrade_aloc x) (Ghost.reveal (Loc?.aux l2'))); assert (forall r . addrs_of_loc l1' r `GSet.equal` addrs_of_loc l1 r); @@ -2182,9 +2203,9 @@ let raise_loc_disjoint #al #c l1 l2 = #pop-options let modifies_raise_loc #al #c l h1 h2 = - let l' = raise_loc l in - assert (forall (x: aloc (raise_cls c)) . GSet.mem x (Ghost.reveal (Loc?.aux l')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l))); - assert (forall (x: aloc c) . GSet.mem x (Ghost.reveal (Loc?.aux l)) <==> GSet.mem (upgrade_aloc x) (Ghost.reveal (Loc?.aux l'))); + let l' = raise_loc u#x u#y l in + assert (forall (x: aloc (raise_cls u#x u#y c)) . GSet.mem x (Ghost.reveal (Loc?.aux l')) <==> GSet.mem (downgrade_aloc x) (Ghost.reveal (Loc?.aux l))); + assert (forall (x: aloc c) . GSet.mem x (Ghost.reveal (Loc?.aux l)) <==> GSet.mem (upgrade_aloc u#x u#y x) (Ghost.reveal (Loc?.aux l'))); assert (forall r . addrs_of_loc l' r `GSet.equal` addrs_of_loc l r); assert (forall (x1 x2: aloc (raise_cls u#x u#y c)) . aloc_disjoint x1 x2 <==> aloc_disjoint (downgrade_aloc x1) (downgrade_aloc x2)); assert (forall (r: HS.rid) (a: nat) (b: raise_aloc al r a) . diff --git a/stage0/ulib/FStar.Pervasives.fst b/stage0/ulib/FStar.Pervasives.fst index 42987e0cdc6..0ffdc79d0b3 100644 --- a/stage0/ulib/FStar.Pervasives.fst +++ b/stage0/ulib/FStar.Pervasives.fst @@ -57,6 +57,7 @@ type norm_step = | Reify // Reify effectful definitions into their representations | NormDebug // Turn on debugging for this call | UnfoldOnly : list string -> norm_step // Unlike Delta, unfold definitions for only the given + | UnfoldOnce : list string -> norm_step // names, each string is a fully qualified name // like `A.M.f` // idem @@ -103,6 +104,9 @@ let reify_ = Reify irreducible let delta_only s = UnfoldOnly s +irreducible +let delta_once s = UnfoldOnce s + irreducible let delta_fully s = UnfoldFully s diff --git a/stage0/ulib/FStar.Pervasives.fsti b/stage0/ulib/FStar.Pervasives.fsti index 31dd09c6942..d9f46f6f97f 100644 --- a/stage0/ulib/FStar.Pervasives.fsti +++ b/stage0/ulib/FStar.Pervasives.fsti @@ -217,6 +217,13 @@ val reify_ : norm_step list. Each string is a fully qualified name like [A.M.f] *) val delta_only (s: list string) : Tot norm_step +(** Like [delta_only], unfold only the definitions in this list, +but do so only once. This is useful for a controlled unfolding +of recursive definitions. NOTE: if there are many occurrences +of a variable in this list, it is unspecified which one will +be unfolded (currently it depends on normalization order). *) +val delta_once (s: list string) : Tot norm_step + (** Unfold definitions for only the names in the given list, but unfold each definition encountered after unfolding as well. @@ -328,9 +335,8 @@ val normalize_spec (a: Type0) : Lemma (normalize a == a) val norm_spec (s: list norm_step) (#a: Type) (x: a) : Lemma (norm s #a x == x) (** Use the following to expose an ["opaque_to_smt"] definition to the - solver as: [reveal_opaque (`%defn) defn]. NB: zeta is needed in - the case where the definition is recursive. *) -let reveal_opaque (s: string) = norm_spec [delta_only [s]; zeta] + solver as: [reveal_opaque (`%defn) defn]. *) +let reveal_opaque (s: string) = norm_spec [delta_once [s]] (** Wrappers over pure wp combinators that return a pure_wp type (with monotonicity refinement) *) diff --git a/stage0/ulib/FStar.String.fsti b/stage0/ulib/FStar.String.fsti index ba6245670af..e4515aaf0ab 100644 --- a/stage0/ulib/FStar.String.fsti +++ b/stage0/ulib/FStar.String.fsti @@ -75,7 +75,8 @@ val split: list char -> string -> Tot (list string) /// `concat s l` concatentates the strings in `l` delimited by `s` val concat: string -> list string -> Tot string -/// `compare s0 s1`: lexicographic ordering on strings +/// `compare s0 s1`: lexicographic ordering on strings. +/// Negative if s1s2 val compare: string -> string -> Tot int /// `lowercase`: transform each character to its lowercase variant diff --git a/stage0/ulib/FStar.Stubs.Tactics.Common.fsti b/stage0/ulib/FStar.Stubs.Tactics.Common.fsti index 019ceaa6181..1f7e346845d 100644 --- a/stage0/ulib/FStar.Stubs.Tactics.Common.fsti +++ b/stage0/ulib/FStar.Stubs.Tactics.Common.fsti @@ -12,3 +12,9 @@ above. *) exception TacticFailure of error_message & option FStar.Range.range exception SKIP + +(* This will stop the execution of the metaprogram, reporting all the errors +that have been logged so far (with log_issues). If none have been logged +F* will anyway display an error and reject the definition, but the expectation +is that this is only raised when the plugin is doing its own error handling. *) +exception Stop diff --git a/stage0/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti b/stage0/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti index a277a35e88d..f91f3e5f60b 100644 --- a/stage0/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti +++ b/stage0/ulib/FStar.Stubs.Tactics.V2.Builtins.fsti @@ -29,6 +29,8 @@ open FStar.Tactics.Effect open FStar.Stubs.Tactics.Types include FStar.Stubs.Tactics.Unseal +val fixup_range : Range.range -> TacRO Range.range + (** Resolve unification variable indirections at the top of the term. *) val compress : term -> Tac term @@ -476,6 +478,10 @@ val all_ext_options : unit -> Tac (list (string & string)) is returned if the key was unset. *) val ext_getv (k:string) : Tac string +(* Returns true iff the extension flag is enabled. I.e. it's a non-empty +string that is not 0/off/false. *) +val ext_enabled (k:string) : Tac bool + (* Return all k/v pairs in the state which are within the given namespace. *) val ext_getns (ns:string) : Tac (list (string & string)) @@ -549,9 +555,10 @@ val check_prop_validity (g:env) (t:term) val match_complete_token (g:env) (sc:term) (t:typ) (pats:list pattern) (bnds:list (list binding)) : Type0 -// Returns elaborated patterns, the bindings for each one, and a token +// Returns elaborated patterns, the bindings for each one, and a token. Possibly some issues +// too. val check_match_complete (g:env) (sc:term) (t:typ) (pats:list pattern) - : Tac (option (pats_bnds:(list pattern & list (list binding)) + : Tac (ret_t (pats_bnds:(list pattern & list (list binding)) {match_complete_token g sc t (fst pats_bnds) (snd pats_bnds) /\ List.Tot.length (fst pats_bnds) == List.Tot.length (snd pats_bnds) /\ List.Tot.length (fst pats_bnds) == List.Tot.length pats})) diff --git a/stage0/ulib/FStar.Tactics.Effect.fsti b/stage0/ulib/FStar.Tactics.Effect.fsti index d104d531ef3..63eb25d4d7c 100644 --- a/stage0/ulib/FStar.Tactics.Effect.fsti +++ b/stage0/ulib/FStar.Tactics.Effect.fsti @@ -164,6 +164,9 @@ effect Tac (a:Type) = TacH a (requires (fun _ -> True)) (ensures (fun _ _ -> Tru (* Metaprograms that succeed *) effect TacS (a:Type) = TacH a (requires (fun _ -> True)) (ensures (fun _ps r -> Success? r)) +(* Always succeed, no effect *) +effect TacRO (a:Type) = TAC a (fun ps post -> forall r. post (Success r ps)) + (* A variant that doesn't prove totality (nor type safety!) *) effect TacF (a:Type) = TacH a (requires (fun _ -> False)) (ensures (fun _ _ -> True)) diff --git a/stage0/ulib/FStar.Tactics.Print.fst b/stage0/ulib/FStar.Tactics.Print.fst index 77a248e6542..4e30b93593a 100644 --- a/stage0/ulib/FStar.Tactics.Print.fst +++ b/stage0/ulib/FStar.Tactics.Print.fst @@ -6,9 +6,13 @@ open FStar.Stubs.Tactics.V2.Builtins open FStar.Tactics.V2.Derived open FStar.Tactics.NamedView -let namedv_to_string (x:namedv) : Tac string= +let namedv_view_to_string (x:Stubs.Reflection.V2.Data.namedv_view) : Tac string= unseal x.ppname ^ "#" ^ string_of_int x.uniq +let namedv_to_string (x:Stubs.Reflection.Types.namedv) : Tac string= + let x = Stubs.Reflection.V2.Builtins.inspect_namedv x in + namedv_view_to_string x + private let paren (s:string) : string = "(" ^ s ^ ")" @@ -39,7 +43,7 @@ let universes_to_ast_string (us:universes) : Tac string = let rec term_to_ast_string (t:term) : Tac string = match inspect t with - | Tv_Var bv -> "Tv_Var " ^ namedv_to_string bv + | Tv_Var bv -> "Tv_Var " ^ namedv_view_to_string bv | Tv_BVar bv -> "Tv_BVar " ^ bv_to_string bv | Tv_FVar fv -> "Tv_FVar " ^ fv_to_string fv | Tv_UInst fv us -> diff --git a/stage0/ulib/FStar.Tactics.Print.fsti b/stage0/ulib/FStar.Tactics.Print.fsti index 38efbf930bb..4a0a43d0983 100644 --- a/stage0/ulib/FStar.Tactics.Print.fsti +++ b/stage0/ulib/FStar.Tactics.Print.fsti @@ -5,7 +5,7 @@ open FStar.Stubs.Reflection.V2.Data open FStar.Tactics.Effect [@@plugin] -val namedv_to_string (x:namedv) : Tac string +val namedv_to_string (x:Stubs.Reflection.Types.namedv) : Tac string [@@plugin] val universe_to_ast_string (u:universe) : Tac string diff --git a/stage0/ulib/FStar.Tactics.V2.Derived.fst b/stage0/ulib/FStar.Tactics.V2.Derived.fst index 06f6a002612..5dd819eae9e 100644 --- a/stage0/ulib/FStar.Tactics.V2.Derived.fst +++ b/stage0/ulib/FStar.Tactics.V2.Derived.fst @@ -63,29 +63,36 @@ exception Goal_not_trivial let goals () : Tac (list goal) = goals_of (get ()) let smt_goals () : Tac (list goal) = smt_goals_of (get ()) +private +let map_optRO (f:'a -> TacRO 'b) (x:option 'a) : TacRO (option 'b) = + match x with + | None -> None + | Some x -> Some (f x) + let fail_doc_at (#a:Type) (m:error_message) (r:option range) - : TAC a (fun ps post -> post (Failed (TacticFailure (m, r)) ps)) - = raise #a (TacticFailure (m, r)) + : TAC a (fun ps post -> forall r. post (Failed (TacticFailure (m, r)) ps)) + = let r = map_optRO fixup_range r in + raise #a (TacticFailure (m, r)) let fail_doc (#a:Type) (m:error_message) : TAC a (fun ps post -> post (Failed (TacticFailure (m, None)) ps)) = raise #a (TacticFailure (m, None)) let fail_at (#a:Type) (m:string) (r:option range) - : TAC a (fun ps post -> post (Failed (TacticFailure (mkmsg m, r)) ps)) + : TAC a (fun ps post -> forall r. post (Failed (TacticFailure (mkmsg m, r)) ps)) = fail_doc_at (mkmsg m) r let fail (#a:Type) (m:string) - : TAC a (fun ps post -> post (Failed (TacticFailure (mkmsg m, None)) ps)) + : TAC a (fun ps post -> forall r. post (Failed (TacticFailure (mkmsg m, r)) ps)) = fail_at m None let fail_silently_doc (#a:Type) (m:error_message) - : TAC a (fun _ post -> forall ps. post (Failed (TacticFailure (m, None)) ps)) + : TAC a (fun _ post -> forall r ps. post (Failed (TacticFailure (m, r)) ps)) = set_urgency 0; raise #a (TacticFailure (m, None)) let fail_silently (#a:Type) (m:string) - : TAC a (fun _ post -> forall ps. post (Failed (TacticFailure (mkmsg m, None)) ps)) + : TAC a (fun _ post -> forall r ps. post (Failed (TacticFailure (mkmsg m, r)) ps)) = fail_silently_doc (mkmsg m) (** Return the current *goal*, not its type. (Ignores SMT goals) *) diff --git a/stage0/ulib/Makefile b/stage0/ulib/Makefile deleted file mode 100644 index 7b298526804..00000000000 --- a/stage0/ulib/Makefile +++ /dev/null @@ -1,71 +0,0 @@ -.PHONY: all benchmark extra clean_checked clean fstardoc ulib-in-fsharp - -FSTAR_HOME=.. - -# Makefile.verify has been split off because it is the actual -# Makefile that is distributed in the binary package. This -# Makefile here is not. - -all: .cache - +$(MAKE) FSTAR_HOME=$(FSTAR_HOME) -f Makefile.verify verify-all - -core: .cache - +$(MAKE) FSTAR_HOME=$(FSTAR_HOME) -f Makefile.verify verify-core - -benchmark: .cache - +$(MAKE) FSTAR_HOME=$(FSTAR_HOME) -f Makefile.verify verify-benchmark - -extra: .cache - +$(MAKE) FSTAR_HOME=$(FSTAR_HOME) -f Makefile.verify verify-extra - -.cache: - mkdir -p .cache - - - -include $(FSTAR_HOME)/ulib/ml/Makefile.realized -include $(FSTAR_HOME)/ulib/ml/Makefile.include -include $(FSTAR_HOME)/.common.mk - -# Builds ulibfs.dll and the nuget package -ulib-in-fsharp: ulib-in-fsharp-dll - +$(MAKE) -f Makefile.extract.fsharp nuget - -ulib-in-fsharp-dll: core - +$(MAKE) -f Makefile.extract.fsharp dll - -.PHONY: ulib-in-fsharp-dll - -clean_checked: - $(Q)rm -f *.checked .cache/*.checked .depend - -clean: clean_checked - $(call msg, "CLEAN", "ulib/") - $(Q)rm -f .depend.* - $(Q)rm -f *.checked.lax .cache/*.checked.lax - -DOC_FILES=Prims.fst FStar.Pervasives.Native.fst FStar.Pervasives.fst \ - FStar.Squash.fsti FStar.Classical.fsti FStar.BigOps.fsti \ - FStar.BitVector.fst FStar.BV.fsti \ - FStar.Char.fsti FStar.Date.fsti FStar.DependentMap.fsti \ - FStar.Dyn.fsti FStar.Exn.fst FStar.Fin.fst FStar.Float.fsti \ - FStar.FunctionalExtensionality.fsti FStar.Float.fsti \ - FStar.Ghost.fsti FStar.IFC.fsti FStar.IndefiniteDescription.fst \ - FStar.UInt8.fst FStar.UInt16.fst FStar.UInt32.fst FStar.UInt64.fst - -DOC_DIR=./doc - -fstardoc: $(DOC_DIR) $(addprefix $(DOC_DIR)/, $(addsuffix .md, $(DOC_FILES))) - -$(DOC_DIR): - mkdir -p $@ - -$(DOC_DIR)/%.md: % - ../bin/fstar --print_in_place $^ - python3 ../.scripts/fstardoc/fstardoc.py $^ > $@ - -INSTALL_EXEC ?= install -export INSTALL_EXEC - -install: all - +./install-ulib.sh diff --git a/stage0/ulib/Makefile.extract b/stage0/ulib/Makefile.extract deleted file mode 100644 index 2c7b79f7292..00000000000 --- a/stage0/ulib/Makefile.extract +++ /dev/null @@ -1,72 +0,0 @@ -.PHONY: indent extra - -FSTAR_HOME=.. -include ml/Makefile.realized - -include $(FSTAR_HOME)/.common.mk -include gmake/z3.mk -include gmake/fstar.mk - -DUNE_SNAPSHOT ?= $(call maybe_cygwin_path,$(realpath $(FSTAR_HOME)/ocaml)) -OUTPUT_DIRECTORY=$(FSTAR_HOME)/src/ocaml-output/fstarlib - -FSTAR_FILES:= -FSTAR_FILES+=$(wildcard *.fst *.fsti) -FSTAR_FILES+=$(wildcard experimental/*.fst experimental/*.fsti) -FSTAR_FILES:=$(filter-out $(NOEXTRACT_FILES), $(FSTAR_FILES)) - -OTHERFLAGS += --z3version 4.13.3 - -CODEGEN = Plugin -MY_FSTAR=$(RUNLIM) $(FSTAR) $(SIL) $(OTHERFLAGS) --cache_checked_modules --odir $(OUTPUT_DIRECTORY) --cache_dir .cache --warn_error @241 -EXTRACT_MODULES=--extract '* $(NOEXTRACT_MODULES)' - -# And then, in a separate invocation, from each .checked we -# extract an .ml file -$(OUTPUT_DIRECTORY)/%.ml: - $(call msg, "EXTRACT", $(basename $(notdir $@))) - $(Q)$(MY_FSTAR) $(subst .checked,,$(notdir $<)) --codegen $(CODEGEN) --extract_module $(basename $(notdir $(subst .checked,,$<))) - -DEPEND=.depend.extract -DEPENDRSP=.depend.extract.rsp - -# GM/TR: These shell commands run ALWAYS, as soon as the Makefile is LOADED. -# This is clearly undesirable, but the command-line argument line in -# Windows prevents us from doing this simply. -$(DEPENDRSP): - $(Q)true $(shell rm -f $(DEPENDRSP)) $(foreach f,$(FSTAR_FILES),$(shell echo $(f) >> $(DEPENDRSP))) - -$(DEPEND): $(DEPENDRSP) - $(call msg, "DEPEND") - $(Q)mkdir -p .cache - $(Q)$(MY_FSTAR) --dep full $(EXTRACT_MODULES) @$(DEPENDRSP) --output_deps_to $@ - -dep.graph: $(DEPENDRSP) - $(Q)$(MY_FSTAR) --dep graph $(EXTRACT_MODULES) @$(DEPENDRSP) --output_deps_to $@ - -depgraph.pdf: dep.graph - $(Q)$(FSTAR_HOME)/.scripts/simpl_graph.py dep.graph > dep_simpl.graph - $(call msg, "DOT", $@) - $(Q)dot -Tpdf -o $@ dep_simpl.graph - -# make depgraph-FStar.Tactics.fst.pdf to get a dep graph of FStar.Tactics.fst downwards -depgraph-%.pdf: - $(Q)$(MY_FSTAR) --dep graph $(EXTRACT_MODULES) $* --output_deps_to $@.graph - $(Q)$(FSTAR_HOME)/.scripts/simpl_graph.py $@.graph > $@.graph.simpl - $(call msg, "DOT", $@) - $(Q)dot -Tpdf -o $@ $@.graph.simpl - -depend.extract: $(DEPEND) - -include $(DEPEND) - -.PHONY: all-ml dune-snapshot intfiles - -# Prims is the only .fst (not fsti) with an Ocaml implementation -# so we do not need to extract it. -all-ml: $(filter-out %/prims.ml, $(ALL_ML_FILES)) - -intfiles: - +$(MAKE) -C ml intfiles - -dune-snapshot: all-ml intfiles diff --git a/stage0/ulib/Makefile.extract.fsharp b/stage0/ulib/Makefile.extract.fsharp deleted file mode 100644 index ed51ebc7ee0..00000000000 --- a/stage0/ulib/Makefile.extract.fsharp +++ /dev/null @@ -1,88 +0,0 @@ -.PHONY: indent extra - -all: nuget - -ifndef FSTAR_HOME - FSTAR_EXE := $(shell which fstar.exe) - ifeq ($(FSTAR_EXE),) - # assuming F* source directory - FSTAR_HOME=.. - FSTAR_EXE := $(FSTAR_HOME)/bin/fstar.exe - else - FSTAR_HOME=$(dir $(FSTAR_EXE))/.. - endif - export FSTAR_HOME -endif -FSTAR_ULIB=$(shell if test -d $(FSTAR_HOME)/ulib ; then echo $(FSTAR_HOME)/ulib ; else echo $(FSTAR_HOME)/lib/fstar ; fi) -include $(FSTAR_ULIB)/ml/Makefile.realized -include $(FSTAR_ULIB)/gmake/z3.mk -include $(FSTAR_ULIB)/gmake/fstar.mk - -FSTAR_FILES:=$(wildcard *.fst *.fsti) \ - $(wildcard experimental/*fst experimental/*fsti) -EXTRACT_MODULES=--extract '* $(NOEXTRACT_MODULES)' - -OUTPUT_DIRECTORY=fs/extracted - -CODEGEN ?= FSharp - -OTHERFLAGS += --z3version 4.13.3 - -MY_FSTAR=$(FSTAR) $(OTHERFLAGS) --warn_error @241 --cache_checked_modules --odir $(OUTPUT_DIRECTORY) --cache_dir .cache - -# And then, in a separate invocation, from each .checked file we -# extract an .fs file -# NOTE: The comma below is to prevent expansion of the wildcard in Windows -# EVEN WITH THE SINGLE QUOTES. Do not remove. See https://github.com/FStarLang/FStar/pull/3421. -$(OUTPUT_DIRECTORY)/%.fs: - $(MY_FSTAR) --already_cached '*,' $(subst .checked,,$(notdir $<)) --codegen $(CODEGEN) --extract_module $(basename $(notdir $(subst .checked,,$<))) - -.depend.extract.fsharp: - $(call msg, "DEPEND") - true $(shell rm -f .depend.extract.fsharp.rsp) $(foreach f,$(FSTAR_FILES),$(shell echo $(f) >> .depend.extract.fsharp.rsp)) - $(Q)$(MY_FSTAR) --extract 'FSharp:*;OCaml:None;krml:None' --dep full $(EXTRACT_MODULES) @.depend.extract.fsharp.rsp --output_deps_to .depend.extract.fsharp - -depend.extract.fsharp: .depend.extract.fsharp - -include .depend.extract.fsharp - -FS_FILES= \ - FStar_Pervasives.fs \ - FStar_Preorder.fs \ - FStar_Squash.fs \ - FStar_Classical.fs \ - FStar_FunctionalExtensionality.fs \ - FStar_StrongExcludedMiddle.fs \ - FStar_PropositionalExtensionality.fs \ - FStar_PredicateExtensionality.fs \ - FStar_List_Tot_Properties.fs \ - FStar_Monotonic_HyperHeap.fs \ - FStar_Monotonic_HyperStack.fs \ - FStar_Monotonic_Witnessed.fs \ - FStar_Monotonic_Map.fs \ - FStar_HyperStack.fs \ - FStar_Seq_Base.fs \ - FStar_Seq_Properties.fs \ - FStar_Seq.fs \ - FStar_Calc.fs \ - FStar_Math_Lib.fs \ - FStar_Math_Lemmas.fs \ - FStar_BitVector.fs \ - FStar_UInt.fs \ - FStar_Int.fs \ - FStar_Int_Cast.fs \ - FStar_UInt128.fs \ - FStar_BigOps.fs \ - FStar_Int128.fs \ - FStar_Integers.fs \ - FStar_Ref.fs - -all-fs: $(addprefix $(OUTPUT_DIRECTORY)/, $(FS_FILES)) - -.PHONY: all-fs nuget dll - -dll: all-fs - +$(MAKE) -C fs/VS build - -nuget: dll - +$(MAKE) -C fs/VS all diff --git a/stage0/ulib/Makefile.verify b/stage0/ulib/Makefile.verify deleted file mode 100644 index afd2553ab7e..00000000000 --- a/stage0/ulib/Makefile.verify +++ /dev/null @@ -1,90 +0,0 @@ -.PHONY: verify-all verify-core verify-extra - -# List the files that should be verified by verify-extra and verify-all -# NOTE: Only use files that are extracted+linked into the library, -# or they will anyway be verified when extracting it. Currently, legacy/ -# is the only subdirectory that does not go into fstar.lib. -EXTRA=legacy/FStar.Pointer.Base.fst - -# List the files that should NOT be verified at all -FLAKY= - -# List the files that should be verified by verify-core and verify-all -# Those files are the roots from where all dependencies are computed -FSTAR_FILES := $(filter-out $(FLAKY), \ - $(wildcard FStar.*.fst FStar.*.fsti) \ - $(wildcard LowStar.*.fst LowStar.*.fsti) \ - $(wildcard legacy/*fst legacy/*fsti) \ - ) - -ifneq ($(STAGE_EXPERIMENTAL),0) -FSTAR_FILES += $(filter-out $(FLAKY), \ - $(wildcard experimental/FStar.InteractiveHelpers.*fst experimental/FStar.InteractiveHelpers.*fsti) \ -) -ifneq ($(STAGE_EXPERIMENTAL),1) -FSTAR_FILES += $(filter-out $(FLAKY), \ - $(wildcard experimental/*fst experimental/*fsti) \ -) -endif -endif - -WITH_CACHE_DIR=--cache_dir .cache - -# 271 -> pattern uses theory symbols -# 330 -> experimental feature -# 247 -> did not write checked file -OTHERFLAGS+=--warn_error @271-330@247 --ext context_pruning -OTHERFLAGS += --z3version 4.13.3 - -include $(FSTAR_HOME)/.common.mk -include gmake/z3.mk -include gmake/fstar.mk -include gmake/Makefile.tmpl -# Default rule is verify-all, defined in gmake/Makefile.tmpl - -%.fst-in: - -#turn off 271 (pattern uses theory symbols warning), to be fixed soon -%FStar.UInt.fsti.checked: OTHERFLAGS+=--warn_error -271 -%FStar.UInt.fst.checked: OTHERFLAGS+=--warn_error -271 -%FStar.ModifiesGen.fst.checked: OTHERFLAGS+=--warn_error -271 - -#these are legacy files that should go away soon -%FStar.Buffer.fst.checked: OTHERFLAGS+=--warn_error -271 -%FStar.Buffer.Quantifiers.fst.checked: OTHERFLAGS+=--warn_error -271 - -verify-core: $(filter-out $(addprefix %, $(addsuffix .checked, $(notdir $(EXTRA)))), $(ALL_CHECKED_FILES)) -verify-extra: $(filter $(addprefix %, $(addsuffix .checked, $(notdir $(EXTRA)))), $(ALL_CHECKED_FILES)) -verify-all: verify-core verify-extra - -%.checked: - $(call msg, "CHECK", $(basename $(notdir $@))) - @# MY_FSTAR is imported from ulib/gmake.Makefile.tmpl, so it does not - @# contain the $(SIL) flag nor the $(RUNLIM) for monitoring resources. - @# You can debug with --debug $(basename $(notdir $<)) - $(Q)$(RUNLIM) $(MY_FSTAR) $(SIL) $(COMPAT_INDEXED_EFFECTS) $< - -# Benchmarking rules -# -# we want to run FStar with just the target file as that being checked -# ideally all the .checked files will exist and we will: -# - move them to the side -# - execute the benchmark -# - move the checked file back -# -# phony-benchmark target to ensure bench rules always run on: -# make -C ulib benchmark - -.PHONY: phony-benchmark - -phony-benchmark: - -# We use -f to check the file even if a valid .checked already exists -# And remove --cache_checked_modules so we don't update them -%.fst.bench: %.fst phony-benchmark - $(BENCHMARK_PRE) $(filter-out --cache_checked_modules, $(MY_FSTAR)) -f $*.fst - -%.fsti.bench: %.fsti phony-benchmark - $(BENCHMARK_PRE) $(filter-out --cache_checked_modules, $(MY_FSTAR)) -f $*.fsti - -verify-benchmark: $(addsuffix .bench, $(filter-out $(EXTRA) ,$(FSTAR_FILES))) diff --git a/stage0/ulib/default.nix b/stage0/ulib/default.nix deleted file mode 100644 index 80f08de554f..00000000000 --- a/stage0/ulib/default.nix +++ /dev/null @@ -1,20 +0,0 @@ -{ fstar-dune, lib, stdenv, version, z3 }: - -stdenv.mkDerivation { - pname = "fstar-ulib"; - inherit version; - - src = lib.sourceByRegex ./.. [ "ulib.*" ".common.mk" ]; - - postPatch = '' - mkdir -p bin - cp ${fstar-dune}/bin/fstar.exe bin - export PATH="$(pwd)/bin:${z3}/bin:$PATH" - patchShebangs ulib/install-ulib.sh - cd ulib - ''; - - enableParallelBuilding = true; - - preInstall = "export PREFIX=$out"; -} diff --git a/stage0/ulib/fs/FStar_All.fs b/stage0/ulib/fs/FStar_All.fs deleted file mode 100644 index d17e5bfd367..00000000000 --- a/stage0/ulib/fs/FStar_All.fs +++ /dev/null @@ -1,7 +0,0 @@ -#light "off" -module FStar_All - let failwith x = failwith x - let exit i = exit i - let pipe_right a f = f a - let pipe_left f a = f a - let try_with f1 f2 = try f1 () with | e -> f2 e diff --git a/stage0/ulib/fs/FStar_Char.fs b/stage0/ulib/fs/FStar_Char.fs deleted file mode 100644 index 362dc52b204..00000000000 --- a/stage0/ulib/fs/FStar_Char.fs +++ /dev/null @@ -1,9 +0,0 @@ -module FStar_Char -open Prims - -type char = FSharp.Core.char - -let lowercase = System.Char.ToLower -let uppercase = System.Char.ToUpper -let int_of_char (x:char) : int = Microsoft.FSharp.Core.Operators.int x |> System.Numerics.BigInteger.op_Implicit -let char_of_int (x:int) : char = Microsoft.FSharp.Core.Operators.int x |> Microsoft.FSharp.Core.Operators.char diff --git a/stage0/ulib/fs/FStar_Dyn.fs b/stage0/ulib/fs/FStar_Dyn.fs deleted file mode 100644 index a1b4bd8be6c..00000000000 --- a/stage0/ulib/fs/FStar_Dyn.fs +++ /dev/null @@ -1,7 +0,0 @@ -module FStar_Dyn - -type dyn = obj - -let mkdyn (x:'a) : dyn = box x - -let undyn (d:dyn) : 'a = unbox<'a> d diff --git a/stage0/ulib/fs/FStar_Float.fs b/stage0/ulib/fs/FStar_Float.fs deleted file mode 100644 index b95942563b5..00000000000 --- a/stage0/ulib/fs/FStar_Float.fs +++ /dev/null @@ -1,5 +0,0 @@ -module FStar_Float -open Prims - -type float = FSharp.Core.float -type double = float diff --git a/stage0/ulib/fs/FStar_Ghost.fs b/stage0/ulib/fs/FStar_Ghost.fs deleted file mode 100644 index dca2089cef3..00000000000 --- a/stage0/ulib/fs/FStar_Ghost.fs +++ /dev/null @@ -1,12 +0,0 @@ -module FStar_Ghost - -type erased = unit -let reveal : erased -> unit = fun _ -> () -let hide : unit -> erased = fun _ -> () -let hide_reveal : erased -> unit = fun _ -> () -let reveal_hide : unit -> unit = fun _ -> () -let elift1 : (unit -> unit) -> erased -> erased = fun _ _ -> () -let elift2 : (unit -> unit -> unit) -> erased -> erased -> erased = fun _ _ _ -> () -let elift3 : (unit -> unit -> unit -> unit) -> erased -> erased -> erased -> erased = fun _ _ _ _ -> () -let elift1_p : (unit -> unit) -> erased -> erased = fun _ _ -> () -let elift2_p : (unit -> unit -> unit) -> erased -> erased -> erased = fun _ _ _ -> () diff --git a/stage0/ulib/fs/FStar_Heap.fs b/stage0/ulib/fs/FStar_Heap.fs deleted file mode 100644 index 1321304f226..00000000000 --- a/stage0/ulib/fs/FStar_Heap.fs +++ /dev/null @@ -1,7 +0,0 @@ -module FStar_Heap - -open FStar_Monotonic_Heap - -type 'a ref = 'a FStar_Monotonic_Heap.ref -type trivial_rel = Prims.l_True -type trivial_preorder = trivial_rel diff --git a/stage0/ulib/fs/FStar_HyperStack_All.fs b/stage0/ulib/fs/FStar_HyperStack_All.fs deleted file mode 100644 index d83edab144e..00000000000 --- a/stage0/ulib/fs/FStar_HyperStack_All.fs +++ /dev/null @@ -1,8 +0,0 @@ -module FStar_HyperStack_All - -let failwith x = failwith x -let exit i = exit (Microsoft.FSharp.Core.Operators.int i) -let pipe_right a f = f a -let pipe_left f a = f a -let try_with f1 f2 = try f1 () with | e -> f2 e - diff --git a/stage0/ulib/fs/FStar_HyperStack_IO.fs b/stage0/ulib/fs/FStar_HyperStack_IO.fs deleted file mode 100644 index 64f17eef943..00000000000 --- a/stage0/ulib/fs/FStar_HyperStack_IO.fs +++ /dev/null @@ -1,6 +0,0 @@ -module FStar_HyperStack_IO - -open Prims - -let print_string : Prims.string -> Prims.unit = - FStar_IO.print_string diff --git a/stage0/ulib/fs/FStar_HyperStack_ST.fs b/stage0/ulib/fs/FStar_HyperStack_ST.fs deleted file mode 100644 index eccb680f1a8..00000000000 --- a/stage0/ulib/fs/FStar_HyperStack_ST.fs +++ /dev/null @@ -1,90 +0,0 @@ -module FStar_HyperStack_ST - -open FStar_CommonST - -open FStar_Monotonic_HyperHeap - -(* TODO: There are issues with removing unused parameters in (Monotonic_)Hyper_Stack modules *) -open FStar_Monotonic_HyperStack - -open FStar_HyperStack - -let push_frame () = () -let pop_frame () = () - -let root = () - -let def_rid = root - -let salloc (contents:'a) :('a reference) = - let r = FStar_CommonST.alloc contents in - MkRef (root, r) - -let salloc_mm (contents:'a) :('a reference) = - let r = FStar_CommonST.alloc contents in - MkRef (root, r) - -let sfree r = () - -let new_region = (fun r0 -> def_rid) -let new_colored_region = (fun r0 c -> def_rid) - -let ralloc i (contents:'a) :('a reference) = - let r = FStar_CommonST.alloc contents in - MkRef (i, r) - -let ralloc_mm i (contents:'a) :('a reference) = - let r = FStar_CommonST.alloc contents in - MkRef (i, r) - -let rfree r = () - -let op_Colon_Equals r v = match r with - | MkRef (_, r) -> op_Colon_Equals r v - -let op_Bang r = match r with - | MkRef (_, r) -> op_Bang r - -let read = op_Bang - -let write = op_Colon_Equals - -let get () = HS (Prims.parse_int "0", FStar_Map.const1 FStar_Monotonic_Heap.emp, def_rid) - -let recall = (fun r -> ()) - -let recall_region = (fun r -> ()) -let witness_region _ = () -let witness_hsref _ = () -type erid = rid - -type ('a, 'rel) mreference = ('a, 'rel) FStar_Monotonic_HyperStack.mreference -type ('a, 'rel) mref = ('a, 'rel) FStar_Monotonic_HyperStack.mref -type 'a reference = ('a, unit) mreference -type 'a ref = ('a, unit) mref -type ('a, 'b) m_rref = ('a, 'b) mref - -//type 'a ref = 'a FStar_HyperStack.reference -//type 'a mreference = 'a ref -//type 'a reference = 'a ref -let alloc = salloc -//type 'a mref = 'a ref -//type 'b m_rref = 'b ref -type stable_on_t = unit -let mr_witness _ _ _ _ _ = () -let testify _ = () -let testify_forall _ = () -let testify_forall_region_contains_pred _ _ = () - -type ex_rid = erid -type 'a witnessed = 'a FStar_CommonST.witnessed -type stable_on = unit -type token = unit -let witness_p _ _ = () -let recall_p _ _ = () - -type drgn = rid -let new_drgn _ = () -let free_drgn _ = () -let ralloc_drgn = ralloc -let ralloc_drgn_mm = ralloc_mm diff --git a/stage0/ulib/fs/FStar_IO.fs b/stage0/ulib/fs/FStar_IO.fs deleted file mode 100644 index b060b1aac7e..00000000000 --- a/stage0/ulib/fs/FStar_IO.fs +++ /dev/null @@ -1,27 +0,0 @@ -module FStar_IO -exception EOF -open System -open System.IO -type fd_read = TextReader -type fd_write = TextWriter - -let print_newline _ = Printf.printf "\n" -let print_string x = Printf.printf "%s" x -let print_uint8 x = Printf.printf "%02x" x -let print_uint32 x = Printf.printf "%04x" x -let print_uint64 x = Printf.printf "%08x" x -let print_any x = Printf.printf "%A" x -let input_line () = System.Console.ReadLine() -let input_int () = Int32.Parse(System.Console.ReadLine()) -let input_float () = Single.Parse(System.Console.ReadLine(), System.Globalization.CultureInfo.InvariantCulture); -let open_read_file (x:string) = new StreamReader(x) -let open_write_file (x:string) = File.CreateText(x) -let close_read_file (x:fd_read) = x.Close() -let close_write_file (x:fd_write) = x.Close() -let read_line (fd:fd_read) = - let x = fd.ReadLine() in - if x=null - then raise EOF - else x -let write_string (fd:fd_write) (x:string) = - fd.Write(x) diff --git a/stage0/ulib/fs/FStar_Int16.fs b/stage0/ulib/fs/FStar_Int16.fs deleted file mode 100644 index b837d19c0e3..00000000000 --- a/stage0/ulib/fs/FStar_Int16.fs +++ /dev/null @@ -1,85 +0,0 @@ -module FStar_Int16 -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS FILE IS BASED ON AUTOGENERATED ml/FStar_Int16.ml FILE! *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -type int16 = System.Int16 -type t = System.Int16 -let n = Prims.of_int 16 - -let int_to_t x = System.Int16.Parse((string x)) -let __int_to_t = int_to_t - -let v (x:t) : Prims.int = Prims.parse_int (string x) - -let zero = 0s -let one = 1s -let ones = System.Int16.MaxValue - -(* Reexport add, plus aliases *) -let add : t -> t -> t = (+) -let add_underspec : t -> t -> t = (+) -let add_mod : t -> t -> t = (+) - -(* Reexport sub, plus aliases *) -let sub : t -> t -> t = (-) -let sub_underspec : t -> t -> t = (-) -let sub_mod : t -> t -> t = (-) - -(* Reexport mul, plus aliases *) -let mul : t -> t -> t = (*) -let mul_underspec : t -> t -> t = (*) -let mul_mod : t -> t -> t = (*) - -(* Just reexport these *) -let div : t -> t -> t = (/) -let rem : t -> t -> t = (%) -let logand : t -> t -> t = (&&&) -let logxor : t -> t -> t = (^^^) -let logor : t -> t -> t = (|||) -let lognot : t -> t = (~~~) -let to_string : t -> string = string -let of_string : string -> t = System.Int16.Parse - -let to_string_hex (x : t) = "0x" + (x.ToString("X")) - -let to_string_hex_pad (i : t) = i.ToString("X4") - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right (n : t) (i : System.UInt32) : t = n >>> (int32 i) -let shift_left (n : t) (i : System.UInt32) : t = n <<< (int32 i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/ulib/fs/FStar_Int32.fs b/stage0/ulib/fs/FStar_Int32.fs deleted file mode 100644 index b35b9fee7b3..00000000000 --- a/stage0/ulib/fs/FStar_Int32.fs +++ /dev/null @@ -1,85 +0,0 @@ -module FStar_Int32 -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS FILE IS BASED ON AUTOGENERATED ml/FStar_Int32.ml FILE! *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -type int32 = System.Int32 -type t = System.Int32 -let n = Prims.of_int 32 - -let int_to_t x = System.Int32.Parse((string x)) -let __int_to_t = int_to_t - -let v (x:t) : Prims.int = Prims.parse_int (string x) - -let zero = 0 -let one = 1 -let ones = System.Int32.MaxValue - -(* Reexport add, plus aliases *) -let add : t -> t -> t = (+) -let add_underspec : t -> t -> t = (+) -let add_mod : t -> t -> t = (+) - -(* Reexport sub, plus aliases *) -let sub : t -> t -> t = (-) -let sub_underspec : t -> t -> t = (-) -let sub_mod : t -> t -> t = (-) - -(* Reexport mul, plus aliases *) -let mul : t -> t -> t = (*) -let mul_underspec : t -> t -> t = (*) -let mul_mod : t -> t -> t = (*) - -(* Just reexport these *) -let div : t -> t -> t = (/) -let rem : t -> t -> t = (%) -let logand : t -> t -> t = (&&&) -let logxor : t -> t -> t = (^^^) -let logor : t -> t -> t = (|||) -let lognot : t -> t = (~~~) -let to_string : t -> string = string -let of_string : string -> t = System.Int32.Parse - -let to_string_hex (x : t) = "0x" + (x.ToString("X")) - -let to_string_hex_pad (i : t) = i.ToString("X8") - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right (n : t) (i : System.UInt32) : t = n >>> (FSharp.Core.Operators.int32 i) -let shift_left (n : t) (i : System.UInt32) : t = n <<< (FSharp.Core.Operators.int32 i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/ulib/fs/FStar_Int64.fs b/stage0/ulib/fs/FStar_Int64.fs deleted file mode 100644 index 734d148f02d..00000000000 --- a/stage0/ulib/fs/FStar_Int64.fs +++ /dev/null @@ -1,85 +0,0 @@ -module FStar_Int64 -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS FILE IS BASED ON AUTOGENERATED ml/FStar_Int64.ml FILE! *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -type int16 = System.Int64 -type t = System.Int64 -let n = Prims.of_int 64 - -let int_to_t x = System.Int64.Parse((string x)) -let __int_to_t = int_to_t - -let v (x:t) : Prims.int = Prims.parse_int (string x) - -let zero = 0L -let one = 1L -let ones = System.Int64.MaxValue - -(* Reexport add, plus aliases *) -let add : t -> t -> t = (+) -let add_underspec : t -> t -> t = (+) -let add_mod : t -> t -> t = (+) - -(* Reexport sub, plus aliases *) -let sub : t -> t -> t = (-) -let sub_underspec : t -> t -> t = (-) -let sub_mod : t -> t -> t = (-) - -(* Reexport mul, plus aliases *) -let mul : t -> t -> t = (*) -let mul_underspec : t -> t -> t = (*) -let mul_mod : t -> t -> t = (*) - -(* Just reexport these *) -let div : t -> t -> t = (/) -let rem : t -> t -> t = (%) -let logand : t -> t -> t = (&&&) -let logxor : t -> t -> t = (^^^) -let logor : t -> t -> t = (|||) -let lognot : t -> t = (~~~) -let to_string : t -> string = string -let of_string : string -> t = System.Int64.Parse - -let to_string_hex (x : t) = "0x" + (x.ToString("X")) - -let to_string_hex_pad (i : t) = i.ToString("X16") - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right (n : t) (i : System.UInt32) : t = n >>> (int32 i) -let shift_left (n : t) (i : System.UInt32) : t = n <<< (int32 i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/ulib/fs/FStar_Int8.fs b/stage0/ulib/fs/FStar_Int8.fs deleted file mode 100644 index fcfe9607068..00000000000 --- a/stage0/ulib/fs/FStar_Int8.fs +++ /dev/null @@ -1,85 +0,0 @@ -module FStar_Int8 -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS FILE IS BASED ON AUTOGENERATED ml/FStar_Int8.ml FILE! *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -type int8 = System.SByte -type t = System.SByte -let n = Prims.of_int 8 - -let int_to_t x = System.SByte.Parse((string x)) -let __int_to_t = int_to_t - -let v (x:t) : Prims.int = Prims.parse_int (string x) - -let zero = 0y -let one = 1y -let ones = System.SByte.MaxValue - -(* Reexport add, plus aliases *) -let add : t -> t -> t = (+) -let add_underspec : t -> t -> t = (+) -let add_mod : t -> t -> t = (+) - -(* Reexport sub, plus aliases *) -let sub : t -> t -> t = (-) -let sub_underspec : t -> t -> t = (-) -let sub_mod : t -> t -> t = (-) - -(* Reexport mul, plus aliases *) -let mul : t -> t -> t = (*) -let mul_underspec : t -> t -> t = (*) -let mul_mod : t -> t -> t = (*) - -(* Just reexport these *) -let div : t -> t -> t = (/) -let rem : t -> t -> t = (%) -let logand : t -> t -> t = (&&&) -let logxor : t -> t -> t = (^^^) -let logor : t -> t -> t = (|||) -let lognot : t -> t = (~~~) -let to_string : t -> string = string -let of_string : string -> t = System.SByte.Parse - -let to_string_hex (x : t) = "0x" + (x.ToString("X")) - -let to_string_hex_pad (i : t) = i.ToString("X2") - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right (n : t) (i : System.UInt32) : t = n >>> (int32 i) -let shift_left (n : t) (i : System.UInt32) : t = n <<< (int32 i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/ulib/fs/FStar_List.fs b/stage0/ulib/fs/FStar_List.fs deleted file mode 100644 index 29d4e065659..00000000000 --- a/stage0/ulib/fs/FStar_List.fs +++ /dev/null @@ -1,54 +0,0 @@ -module FStar_List -open Prims -//open FStar.List.Tot.Base - -let isEmpty l = List.isEmpty l -let mem = List.contains -let memT = mem -let hd = List.head -let tail = List.tail -let tl = List.tail - -let nth l i = List.nth l (Microsoft.FSharp.Core.Operators.int i) -let length l : int = List.length l |> System.Numerics.BigInteger.op_Implicit -let rev = List.rev -let map = List.map -let mapT = map -let mapi f l = List.mapi (fun i x -> f (System.Numerics.BigInteger.op_Implicit i) x) l -let map2 = List.map2 -let rec map3 = List.map3 -let iter = List.iter -let iter2 = List.iter2 -let iteri_aux _ _ _ = failwith "FStar.List.fs: Not implemented: iteri_aux" -let iteri f l = List.iteri (fun i x -> f (System.Numerics.BigInteger.op_Implicit i) x) l -let partition = List.partition -let append = List.append -let rev_append _ _ = failwith "FStar.List.fs: Not implemented: rev_append" -let fold_left = List.fold -let fold_right = List.foldBack -let fold_left2 = List.fold2 -let fold_right2 = List.foldBack2 -let collect = List.collect -let unzip = List.unzip -let unzip3 = List.unzip3 -let filter = List.filter -let sortWith f l = List.sortWith (fun x y -> Microsoft.FSharp.Core.Operators.int (f x y)) l -let for_all = List.forall -let forall2 = List.forall2 -let tryFind f l = List.tryFind f l -let tryFindT = tryFind -let find = tryFind -let tryPick f l = List.tryPick f l -let flatten = List.concat -let split = unzip -let choose = List.choose -let existsb f l = List.exists f l -let existsML f l = List.exists f l -let contains x l = List.exists (fun y -> x = y) l -let zip = List.zip -let splitAt x l = List.splitAt ( Microsoft.FSharp.Core.Operators.int x) l -let filter_map = List.choose -let index f l = System.Numerics.BigInteger.op_Implicit (List.findIndex f l) -let zip3 = List.zip3 -let unique _ _ = failwith "FStar.List.fs: Not implemented: unique" -let map_flatten f l = flatten (map f l) diff --git a/stage0/ulib/fs/FStar_List_Tot_Base.fs b/stage0/ulib/fs/FStar_List_Tot_Base.fs deleted file mode 100644 index 1edaa3e6926..00000000000 --- a/stage0/ulib/fs/FStar_List_Tot_Base.fs +++ /dev/null @@ -1,48 +0,0 @@ -module FStar_List_Tot_Base -open Prims - -let isEmpty l = List.isEmpty l -let hd = List.head -let tail = List.tail -let tl = List.tail -let length l : int = List.length l |> System.Numerics.BigInteger.op_Implicit -let nth l (i : Prims.nat) = try Some (List.nth l (Microsoft.FSharp.Core.Operators.int i)) with _ -> None -let index l (i : Prims.nat) = List.nth l (Microsoft.FSharp.Core.Operators.int i) -let count _ _ = failwith "FStar_List.Tot.Base.fs: Not implemented: count" -let rev_acc l r = List.fold (fun xs x -> x :: xs) r l -let rev = List.rev -let append = List.append -let op_At = append -let snoc (x, y) = append x [y] -let flatten = List.concat -let map = List.map -let mapi_init _ _ _ = failwith "FStar.List.Tot.Base.fs: Not implemented: mapi_init" -let mapi f l = List.mapi (fun i x -> f (System.Numerics.BigInteger.op_Implicit i) x) l -let concatMap f l = List.collect f l -let fold_left = List.fold -let fold_right = List.foldBack -let fold_left2 = List.fold2 -let mem = List.contains -//type ('a, 'b, 'c) memP = NOT IMPLEMENTED -let contains x l = List.exists (fun y -> x = y) l -let existsb f l = List.exists f l -let find f l = List.tryFind f l -let filter = List.filter -let for_all = List.forall -let collect f l = List.collect f l -let tryFind = find -let tryPick f l = List.tryPick f l -let choose = List.choose -let partition = List.partition -let subset _ _ = failwith "FStar.List.Tot.Base.fs: Not implemented: subset" -let noRepeats _ = failwith "FStar.List.Tot.Base.fs: Not implemented: noRepeats" -let rec assoc x l = l |> List.tryFind (fun (h, _) -> h = x) |> Option.map snd -let split = List.unzip -let splitAt = List.splitAt -let unzip = List.unzip - -let unzip3 = List.unzip3 -let bool_of_compare _ _ _ = failwith "FStar.List.Tot.Base.fs: Not implemented: bool_of_compare" -let compare_of_bool _ _ _ = failwith "FStar.List.Tot.Base.fs: Not implemented: compare_of_bool" -let sortWith (f : 'a -> 'a -> Prims.int) l = List.sortWith (fun x y -> Microsoft.FSharp.Core.Operators.int (f x y)) l -let list_unref l = l diff --git a/stage0/ulib/fs/FStar_Map.fs b/stage0/ulib/fs/FStar_Map.fs deleted file mode 100644 index 140d8d0a704..00000000000 --- a/stage0/ulib/fs/FStar_Map.fs +++ /dev/null @@ -1,135 +0,0 @@ -#light "off" -module FStar_Map -open Prims -open FStar_Pervasives -(* TODO: The extracted version of this file doesn't include the when 'key : comparison constraint which is required for F# *) -type t<'key, 'value when 'key : comparison> = -{mappings : ('key, 'value) FStar_FunctionalExtensionality.restricted_t; domain : 'key FStar_Set.set} - - -let __proj__Mkt__item__mappings = (fun ( projectee : ('key, 'value) t ) -> (match (projectee) with -| {mappings = mappings; domain = domain} -> begin -mappings -end)) - - -let __proj__Mkt__item__domain = (fun ( projectee : ('key, 'value) t ) -> (match (projectee) with -| {mappings = mappings; domain = domain} -> begin -domain -end)) - - -let sel = (fun ( m : ('key, 'value) t ) ( k : 'key ) -> (m.mappings k)) - - -let upd = (fun ( m : ('key, 'value) t ) ( k : 'key ) ( v : 'value ) -> {mappings = (FStar_FunctionalExtensionality.on_domain (fun ( x : 'key ) -> (match ((Prims.op_Equality x k)) with -| true -> begin -v -end -| uu____5020 -> begin -(m.mappings x) -end))); domain = (FStar_Set.union m.domain (FStar_Set.singleton k))}) - - -let const1 = (fun ( v : 'value ) -> {mappings = (FStar_FunctionalExtensionality.on_domain (fun ( uu____5049 : 'key ) -> v)); domain = (FStar_Set.complement (FStar_Set.empty ()))}) - - -let domain = (fun ( m : ('key, 'value) t ) -> m.domain) - - -let contains = (fun ( m : ('key, 'value) t ) ( k : 'key ) -> (FStar_Set.mem k m.domain)) - - -let concat = (fun ( m1 : ('key, 'value) t ) ( m2 : ('key, 'value) t ) -> {mappings = (FStar_FunctionalExtensionality.on_domain (fun ( x : 'key ) -> (match ((FStar_Set.mem x m2.domain)) with -| true -> begin -(m2.mappings x) -end -| uu____5174 -> begin -(m1.mappings x) -end))); domain = (FStar_Set.union m1.domain m2.domain)}) - -(* TODO: Only implicit arguments at the start of a function are erased, whereas the others are extracted to unit and obj - which makes extracted function unusable. See examples/hello/TestFSharp for a minimal example. - - Here, key should be a generic argument with a comparison constraint instead of obj/unit. - - A simple workaround would be to change the declaration of map_val in the FStar.Map.fsti so that - '#key:eqtype' parameter is moved before any non-implicit parameters (i.e. before 'f'). -*) -let map_val = (fun ( f : 'uuuuuu5195 -> 'uuuuuu5196 ) ( key : 'key ) ( m : ('key, 'uuuuuu5195) t ) -> {mappings = (FStar_FunctionalExtensionality.on_domain (fun ( x : 'key ) -> (f (m.mappings x)))); domain = m.domain}) - - -let restrict = (fun ( s : 'key FStar_Set.set ) ( m : ('key, 'value) t ) -> {mappings = m.mappings; domain = (FStar_Set.intersect s m.domain)}) - - -let const_on = (fun ( dom : 'key FStar_Set.set ) ( v : 'value ) -> (restrict dom (const1 v))) - - -type disjoint_dom = -unit - - -type has_dom = -unit - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -type equal = -unit - - - - - - - - - - - - - diff --git a/stage0/ulib/fs/FStar_Monotonic_Heap.fs b/stage0/ulib/fs/FStar_Monotonic_Heap.fs deleted file mode 100644 index 6c92edde7ea..00000000000 --- a/stage0/ulib/fs/FStar_Monotonic_Heap.fs +++ /dev/null @@ -1,46 +0,0 @@ -module FStar_Monotonic_Heap - -type heap = unit - -(* Following OCaml implementation we want reference (physical) equality for ref. - https://www.lexifi.com/blog/references-physical-equality *) -[] -type 'a ref = { - mutable contents: 'a; - id: int -} - -type 'a mref = 'a ref - -let emp = - () - -(* Logical functions on heap *) -(* TODO : complete the functions to have the same interface as in FStar.Heap.fsti *) - -let addr_of _ = unbox (box ()) -let is_mm _ = unbox (box ()) - -(* let compare_addrs *) - -// HACK: We need to somehow make the implementation agree with the interface. Those types seem to be used only -// in lemmas, so they shouldn't matter. -type ('a, 'b, 'c, 'd) contains = 'a * 'b * 'c * 'd -type ('a, 'b) addr_unused_in = 'a * 'b -type ('a, 'b, 'c, 'd) unused_in = 'a * 'b * 'c * 'd -let fresh _ _ _ = unbox (box ()) - -let sel _ _ = unbox (box ()) -let upd _ _ _ = unbox (box ()) -let alloc _ _ _ = unbox (box ()) - -let free_mm _ _ = unbox (box ()) -let sel_tot = sel -let upd_tot = upd - -(* Untyped view of references *) -type aref = - | Ref of (unit * unit) -let dummy_aref = Ref ((), ()) -let aref_of _ = dummy_aref -let ref_of _ _ = unbox (box ()) diff --git a/stage0/ulib/fs/FStar_Mul.fs b/stage0/ulib/fs/FStar_Mul.fs deleted file mode 100644 index ad12ac28b60..00000000000 --- a/stage0/ulib/fs/FStar_Mul.fs +++ /dev/null @@ -1,3 +0,0 @@ -module FStar_Mul -open Prims -let (*) = Prims.op_Multiply diff --git a/stage0/ulib/fs/FStar_Option.fs b/stage0/ulib/fs/FStar_Option.fs deleted file mode 100644 index 2a74f4f9c0b..00000000000 --- a/stage0/ulib/fs/FStar_Option.fs +++ /dev/null @@ -1,11 +0,0 @@ -module FStar_Option -let isSome = function - | Some _ -> true - | None -> false -let isNone o = not (isSome o) -let map f = function - | Some x -> Some (f x) - | None -> None -let get = function - | Some x -> x - | None -> failwith "Option.get called on None" diff --git a/stage0/ulib/fs/FStar_ST.fs b/stage0/ulib/fs/FStar_ST.fs deleted file mode 100644 index 79da3351dea..00000000000 --- a/stage0/ulib/fs/FStar_ST.fs +++ /dev/null @@ -1,23 +0,0 @@ -#light "off" -module FStar_ST - -open FStar_CommonST - -type 'a mref = 'a FStar_Monotonic_Heap.mref -type 'a ref = 'a FStar_Monotonic_Heap.ref - -let read = read -let op_Bang = op_Bang - -let write = write -let op_Colon_Equals = op_Colon_Equals - -let alloc x = alloc - -let recall = recall -let get = get - -type 'a witnessed = 'a FStar_CommonST.witnessed - -let gst_Witness = gst_witness -let gst_recall = gst_recall \ No newline at end of file diff --git a/stage0/ulib/fs/FStar_Set.fs b/stage0/ulib/fs/FStar_Set.fs deleted file mode 100644 index 28e1df7bb34..00000000000 --- a/stage0/ulib/fs/FStar_Set.fs +++ /dev/null @@ -1,15 +0,0 @@ -module FStar_Set - -type set<'a when 'a : comparison> = Set<'a> -let empty () = Set.empty -let singleton = Set.singleton -let union = Set.union -let intersect = Set.intersect -let complement x = Set.empty // TODO -let mem = Set.contains - -(* - * F* should not extract Set.equal - * We should fix it, adding the following in the meantime - *) -type equal = unit diff --git a/stage0/ulib/fs/FStar_String.fs b/stage0/ulib/fs/FStar_String.fs deleted file mode 100644 index c40710f24dc..00000000000 --- a/stage0/ulib/fs/FStar_String.fs +++ /dev/null @@ -1,29 +0,0 @@ -module FStar_String -open Prims - -let make (i : nat) (c : FStar_Char.char) = String.init (Microsoft.FSharp.Core.Operators.int i) (fun _ -> string([|c|])) -let strcat s t = s ^ t -let op_Hat s t = strcat s t - -let split (seps : FStar_Char.char list) (s : string) = s.Split(Array.ofList seps) - -let compare (x : string) (y : string) = Prims.of_int (x.CompareTo(y)) -type char = FStar_Char.char -let concat = String.concat -let length s = Prims.of_int (String.length s) -let strlen s = length s - -let substring (s : string) (i : Prims.int) (j : Prims.int) = s.Substring(Microsoft.FSharp.Core.Operators.int i, Microsoft.FSharp.Core.Operators.int j) -let sub = substring - -let get (s : string) (i : Prims.int) = s.[Microsoft.FSharp.Core.Operators.int i] -let collect (f : char -> string) (s : string) = s |> Array.ofSeq |> Array.map f |> String.concat "" -let lowercase (s : string) = s.ToLowerInvariant() -let uppercase (s : string) = s.ToUpperInvariant() -//let escaped = BatString.escaped -let index = get - -let index_of (s : string) (c : char) = s.IndexOf(c) -let list_of_string (s : string) = s |> Seq.toList -let string_of_list (l : char list) = string(Array.ofList l) -let string_of_char (c : char) = string(c, 1) diff --git a/stage0/ulib/fs/FStar_UInt16.fs b/stage0/ulib/fs/FStar_UInt16.fs deleted file mode 100644 index 9c9c543ce6f..00000000000 --- a/stage0/ulib/fs/FStar_UInt16.fs +++ /dev/null @@ -1,85 +0,0 @@ -module FStar_UInt16 -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS FILE IS BASED ON AUTOGENERATED ml/FStar_UInt16.ml FILE! *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -type uint16 = System.UInt16 -type t = System.UInt16 -let n = Prims.of_int 16 - -let uint_to_t x = System.UInt16.Parse((string x)) -let __uint_to_t = uint_to_t - -let v (x:t) : Prims.int = Prims.parse_int (string x) - -let zero = 0us -let one = 1us -let ones = System.UInt16.MaxValue - -(* Reexport add, plus aliases *) -let add : t -> t -> t = (+) -let add_underspec : t -> t -> t = (+) -let add_mod : t -> t -> t = (+) - -(* Reexport sub, plus aliases *) -let sub : t -> t -> t = (-) -let sub_underspec : t -> t -> t = (-) -let sub_mod : t -> t -> t = (-) - -(* Reexport mul, plus aliases *) -let mul : t -> t -> t = (*) -let mul_underspec : t -> t -> t = (*) -let mul_mod : t -> t -> t = (*) - -(* Just reexport these *) -let div : t -> t -> t = (/) -let rem : t -> t -> t = (%) -let logand : t -> t -> t = (&&&) -let logxor : t -> t -> t = (^^^) -let logor : t -> t -> t = (|||) -let lognot : t -> t = (~~~) -let to_string : t -> string = string -let of_string : string -> t = System.UInt16.Parse - -let to_string_hex (x : t) = "0x" + (x.ToString("X")) - -let to_string_hex_pad (i : t) = i.ToString("X4") - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right (n : t) (i : System.UInt32) : t = n >>> (int32 i) -let shift_left (n : t) (i : System.UInt32) : t = n <<< (int32 i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/ulib/fs/FStar_UInt32.fs b/stage0/ulib/fs/FStar_UInt32.fs deleted file mode 100644 index 58a4feeb85d..00000000000 --- a/stage0/ulib/fs/FStar_UInt32.fs +++ /dev/null @@ -1,85 +0,0 @@ -module FStar_UInt32 -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS FILE IS BASED ON AUTOGENERATED ml/FStar_UInt32.ml FILE! *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -type uint32 = System.UInt32 -type t = System.UInt32 -let n = Prims.of_int 32 - -let uint_to_t x = System.UInt32.Parse((string x)) -let __uint_to_t = uint_to_t - -let v (x:t) : Prims.int = Prims.parse_int (string x) - -let zero = 0u -let one = 1u -let ones = System.UInt32.MaxValue - -(* Reexport add, plus aliases *) -let add : t -> t -> t = (+) -let add_underspec : t -> t -> t = (+) -let add_mod : t -> t -> t = (+) - -(* Reexport sub, plus aliases *) -let sub : t -> t -> t = (-) -let sub_underspec : t -> t -> t = (-) -let sub_mod : t -> t -> t = (-) - -(* Reexport mul, plus aliases *) -let mul : t -> t -> t = (*) -let mul_underspec : t -> t -> t = (*) -let mul_mod : t -> t -> t = (*) - -(* Just reexport these *) -let div : t -> t -> t = (/) -let rem : t -> t -> t = (%) -let logand : t -> t -> t = (&&&) -let logxor : t -> t -> t = (^^^) -let logor : t -> t -> t = (|||) -let lognot : t -> t = (~~~) -let to_string : t -> string = string -let of_string : string -> t = System.UInt32.Parse - -let to_string_hex (x : t) = "0x" + (x.ToString("X")) - -let to_string_hex_pad (i : t) = i.ToString("X8") - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right (n : t) (i : System.UInt32) : t = n >>> (int32 i) -let shift_left (n : t) (i : System.UInt32) : t = n <<< (int32 i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/ulib/fs/FStar_UInt64.fs b/stage0/ulib/fs/FStar_UInt64.fs deleted file mode 100644 index 1b0a40070e3..00000000000 --- a/stage0/ulib/fs/FStar_UInt64.fs +++ /dev/null @@ -1,85 +0,0 @@ -module FStar_UInt64 -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS FILE IS BASED ON AUTOGENERATED ml/FStar_UInt64.ml FILE! *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -type uint64 = System.UInt64 -type t = System.UInt64 -let n = Prims.of_int 64 - -let uint_to_t x = System.UInt64.Parse((string x)) -let __uint_to_t = uint_to_t - -let v (x:t) : Prims.int = Prims.parse_int (string x) - -let zero = 0UL -let one = 1UL -let ones = System.UInt64.MaxValue - -(* Reexport add, plus aliases *) -let add : t -> t -> t = (+) -let add_underspec : t -> t -> t = (+) -let add_mod : t -> t -> t = (+) - -(* Reexport sub, plus aliases *) -let sub : t -> t -> t = (-) -let sub_underspec : t -> t -> t = (-) -let sub_mod : t -> t -> t = (-) - -(* Reexport mul, plus aliases *) -let mul : t -> t -> t = (*) -let mul_underspec : t -> t -> t = (*) -let mul_mod : t -> t -> t = (*) - -(* Just reexport these *) -let div : t -> t -> t = (/) -let rem : t -> t -> t = (%) -let logand : t -> t -> t = (&&&) -let logxor : t -> t -> t = (^^^) -let logor : t -> t -> t = (|||) -let lognot : t -> t = (~~~) -let to_string : t -> string = string -let of_string : string -> t = System.UInt64.Parse - -let to_string_hex (x : t) = "0x" + (x.ToString("X")) - -let to_string_hex_pad (i : t) = i.ToString("X16") - -(* The shifts take a uint32 argument, so we need to convert *) -let shift_right (n : t) (i : System.UInt32) : t = n >>> (int32 i) -let shift_left (n : t) (i : System.UInt32) : t = n <<< (int32 i) -let shift_arithmetic_right = shift_right - -(* Comparison operators *) -let eq (a:t) (b:t) : bool = a = b -let gt (a:t) (b:t) : bool = a > b -let gte (a:t) (b:t) : bool = a >= b -let lt (a:t) (b:t) : bool = a < b -let lte (a:t) (b:t) : bool = a <= b - -(* NOT Constant time operators *) -let eq_mask (a:t) (b:t) : t = if a = b then ones else zero -let gte_mask (a:t) (b:t) : t = if a >= b then ones else zero - -(* Infix notations *) -let op_Plus_Hat = add -let op_Plus_Question_Hat = add_underspec -let op_Plus_Percent_Hat = add_mod -let op_Subtraction_Hat = sub -let op_Subtraction_Question_Hat = sub_underspec -let op_Subtraction_Percent_Hat = sub_mod -let op_Star_Hat = mul -let op_Star_Question_Hat = mul_underspec -let op_Star_Percent_Hat = mul_mod -let op_Slash_Hat = div -let op_Percent_Hat = rem -let op_Hat_Hat = logxor -let op_Amp_Hat = logand -let op_Bar_Hat = logor -let op_Less_Less_Hat = shift_left -let op_Greater_Greater_Hat = shift_right -let op_Equals_Hat = eq -let op_Greater_Hat = gt -let op_Greater_Equals_Hat = gte -let op_Less_Hat = lt -let op_Less_Equals_Hat = lte diff --git a/stage0/ulib/fs/VS/.gitignore b/stage0/ulib/fs/VS/.gitignore deleted file mode 100644 index 57a74cff201..00000000000 --- a/stage0/ulib/fs/VS/.gitignore +++ /dev/null @@ -1 +0,0 @@ -packages \ No newline at end of file diff --git a/stage0/ulib/fs/VS/Makefile b/stage0/ulib/fs/VS/Makefile deleted file mode 100644 index c55ab611cc3..00000000000 --- a/stage0/ulib/fs/VS/Makefile +++ /dev/null @@ -1,42 +0,0 @@ -# -*- Makefile -*- - -# -------------------------------------------------------------------- -DOTNET = dotnet - -CONFIGURATION?=Release - -DOTNET_PARAMS = /verbosity:minimal /p:Configuration=$(CONFIGURATION) - -ifndef FSTAR_HOME - FSTAR_EXE = $(shell which fstar.exe) - ifdef FSTAR_EXE - # assuming some ..../bin directory - FSTAR_HOME=$(dir $(FSTAR_EXE))/.. - else - # assuming F* source repository - FSTAR_HOME=../../.. - endif -endif - -PREFIX?=$(FSTAR_HOME) - - -# -------------------------------------------------------------------- -.PHONY: all install-packages build - -all: build - $(DOTNET) pack ../ulibfs.fsproj -o $(PREFIX)/nuget - -# .NET convention: .dll files go to bin/ instead of lib/fstar -# TODO: in that case, we should rename ulibfs.dll into fstar_ulibfs.dll -# to avoid clashes with other .dll files in bin/ . This is one reason -# why we do not include this rule in `make install`, but only in -# `make package` -build: install-packages - $(DOTNET) build UlibFS.sln -o $(PREFIX)/bin - -install-packages: - $(DOTNET) restore $(DOTNET_PARAMS) UlibFS.sln - -clean: - $(DOTNET) clean $(DOTNET_PARAMS) UlibFS.sln diff --git a/stage0/ulib/fs/VS/README.md b/stage0/ulib/fs/VS/README.md deleted file mode 100644 index bd6f346d14d..00000000000 --- a/stage0/ulib/fs/VS/README.md +++ /dev/null @@ -1,4 +0,0 @@ -ulibfs -====== - -Runtime library for exported code exported from F* to F#. diff --git a/stage0/ulib/fs/VS/UlibFS.sln b/stage0/ulib/fs/VS/UlibFS.sln deleted file mode 100644 index 7fda5cd0cd0..00000000000 --- a/stage0/ulib/fs/VS/UlibFS.sln +++ /dev/null @@ -1,27 +0,0 @@ - -Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio Version 16 -VisualStudioVersion = 16.0.30114.105 -MinimumVisualStudioVersion = 10.0.40219.1 -Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "Solution Items", "Solution Items", "{82253A13-6BB4-4C9F-8198-50F638EFB3EE}" -EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "ulibfs", "..\ulibfs.fsproj", "{E3E96B71-22AB-4518-B08E-9C55C4D256DB}" -EndProject -Global - GlobalSection(SolutionConfigurationPlatforms) = preSolution - Debug|Any CPU = Debug|Any CPU - Release|Any CPU = Release|Any CPU - EndGlobalSection - GlobalSection(ProjectConfigurationPlatforms) = postSolution - {E3E96B71-22AB-4518-B08E-9C55C4D256DB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {E3E96B71-22AB-4518-B08E-9C55C4D256DB}.Debug|Any CPU.Build.0 = Debug|Any CPU - {E3E96B71-22AB-4518-B08E-9C55C4D256DB}.Release|Any CPU.ActiveCfg = Release|Any CPU - {E3E96B71-22AB-4518-B08E-9C55C4D256DB}.Release|Any CPU.Build.0 = Release|Any CPU - EndGlobalSection - GlobalSection(SolutionProperties) = preSolution - HideSolutionNode = FALSE - EndGlobalSection - GlobalSection(ExtensibilityGlobals) = postSolution - SolutionGuid = {F7F50713-93CD-494F-80BA-C050D87A05B2} - EndGlobalSection -EndGlobal diff --git a/stage0/ulib/fs/VS/fstar-new.png b/stage0/ulib/fs/VS/fstar-new.png deleted file mode 100644 index e6bf8a6b330..00000000000 Binary files a/stage0/ulib/fs/VS/fstar-new.png and /dev/null differ diff --git a/stage0/ulib/fs/VS/global.json b/stage0/ulib/fs/VS/global.json deleted file mode 100644 index ff28d518391..00000000000 --- a/stage0/ulib/fs/VS/global.json +++ /dev/null @@ -1,6 +0,0 @@ -{ - "sdk": { - "version": "6.0.400", - "rollForward": "latestFeature" - } -} diff --git a/stage0/ulib/fs/native_int/prims.fs b/stage0/ulib/fs/native_int/prims.fs deleted file mode 100644 index f7ea728fe93..00000000000 --- a/stage0/ulib/fs/native_int/prims.fs +++ /dev/null @@ -1,108 +0,0 @@ -#light "off" -module Prims - let down (x:obj) : 'b = - x :?> 'b - let lift (x:'a) : obj = x :> obj - let checked_cast (x:'a) : 'b = lift x |> down - type Tot<'a> = 'a - type unit = Microsoft.FSharp.Core.unit - type bool = Microsoft.FSharp.Core.bool - type char = Microsoft.FSharp.Core.char - type string = Microsoft.FSharp.Core.string - type 'a array = 'a Microsoft.FSharp.Core.array - type double = Microsoft.FSharp.Core.double - type float = Microsoft.FSharp.Core.float - type int = Microsoft.FSharp.Core.int - type byte = Microsoft.FSharp.Core.byte - type exn = Microsoft.FSharp.Core.exn - type 'a list' = 'a list - type 'a list = 'a list' - type 'a option = 'a Microsoft.FSharp.Core.option - type nat = int - type 'dummy b2t = Dummy_b2t of unit - type ('a,'b) l__HashMultiMap = ('a, 'b) Microsoft.FSharp.Collections.HashMultiMap - type (' p, ' q) l_or = - | Left of ' p - | Right of ' q - - let uu___is_Left = function - | Left _ -> true - | _ -> false - - let uu___is_Right = function - | Right _ -> true - | _ -> false - - type (' p, ' q) l_and = - | And of ' p * ' q - - let uu___is_And = function - | And _ -> true - - type l__True = - | T - - let uu___is_T = function - | T -> true - - type l__False = unit - (*This is how Coq extracts Inductive void := . Our extraction needs to be fixed to recognize when there - are no constructors and generate this type abbreviation*) - - type (' p, ' q) l_imp = - ' p -> ' q - - type (' p, ' q) l_iff = - ((' p, ' q) l_imp, (' q, ' p) l_imp) l_and - - type ' p l_not = - (' p, l__False) l_imp - - type (' a, ' p) l__Forall = - ' a -> ' p - - type ' f l__ForallTyp = - unit -> ' f - - type (' a, ' p) l__Exists = - | MkExists of ' a * ' p - - - - type heap = unit (*perhaps implement Heap concretely, and hence get it extracted fully automatically? - We shoud get rid of this plethora of assumed primitives! *) - type (' p, ' q, 'dummyP, 'dummyQ) l__Eq2 = Dummy_Eq2 of unit - - let ignore _ = () - let cut = () - let fst = fst - let snd = snd - let admit () = () - let _assume () = () - let _assert x = () - let magic () = failwith "no magic" - let min x y = if x < y then x else y - let strcat x y = x ^ y - let op_Negation x = not x - - open System.Numerics - let ( + ) (x:int) (y:int) = x + y - let ( - ) (x:int) (y:int) = x - y - let ( * ) (x:int) (y:int) = x * y - let ( / ) (x:int) (y:int) = x / y - let ( <= ) (x:int) (y:int) = x <= y - let ( >= ) (x:int) (y:int) = x >= y - let ( < ) (x:int) (y:int) = x < y - let ( > ) (x:int) (y:int) = x > y - let ( % ) (x:int) (y:int) = x % y - let parse_int = Integer.parse - - let op_Equality x y = x = y - let op_disEquality x y = x<>y - let op_AmpAmp x y = x && y - let op_BarBar x y = x || y - let uu___is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) - let uu___is_Cons l = not (uu___is_Nil l) - let raise e = raise e - let string_of_bool b = sprintf "%b" b - let string_of_int i = sprintf "%d" i diff --git a/stage0/ulib/fs/prims.fs b/stage0/ulib/fs/prims.fs deleted file mode 100644 index a2ce47f4484..00000000000 --- a/stage0/ulib/fs/prims.fs +++ /dev/null @@ -1,140 +0,0 @@ -#light "off" -module Prims -open System.Numerics - -(* Euclidean division and remainder: - Inefficient implementation based on the naive version at - https://en.wikipedia.org/wiki/Division_algorithm - - Note, in OCaml, we use ZArith's ediv and erem -*) -let rec ediv_rem (n:bigint) (d:bigint) : bigint * bigint = - if d < 0I then - let q, r = ediv_rem n (-d) in - -q, r - else if n < 0I then - let q, r = ediv_rem (-n) d in - if r = 0I then - -q, 0I - else - (-q) - (-1I), - d - r - else BigInteger.DivRem (n, d) - -type int = bigint -type nonzero = int -let ( + ) (x:bigint) (y:int) = x + y -let ( - ) (x:int) (y:int) = x - y -let ( * ) (x:int) (y:int) = x * y -let ( / ) (x:int) (y:int) = fst (ediv_rem x y) -let ( <= ) (x:int) (y:int) = x <= y -let ( >= ) (x:int) (y:int) = x >= y -let ( < ) (x:int) (y:int) = x < y -let ( > ) (x:int) (y:int) = x > y -let (mod) (x:int) (y:int) = snd (ediv_rem x y) -let ( ~- ) (x:int) = -x -let abs (x:int) = BigInteger.Abs x -let of_int (x:FSharp.Core.int) = BigInteger x -let int_zero = of_int 0 -let int_one = of_int 1 -let parse_int = BigInteger.Parse -let to_string (x:int) = x.ToString() - -type unit = Microsoft.FSharp.Core.unit -type bool = Microsoft.FSharp.Core.bool -type string = Microsoft.FSharp.Core.string -type 'a array = 'a Microsoft.FSharp.Core.array -type exn = Microsoft.FSharp.Core.exn -type 'a list' = 'a list -type 'a list = 'a Microsoft.FSharp.Collections.list -type 'a option = 'a Microsoft.FSharp.Core.option - -type nat = int -type pos = int -type 'd b2t = B2t of unit - -type 'a squash = Squash of unit - -type (' p, ' q) sum = - | Left of ' p - | Right of ' q - -type (' p, ' q) l_or = ('p, 'q) sum squash - -let uu___is_Left = function Left _ -> true | Right _ -> false - -let uu___is_Right = function Left _ -> false | Right _ -> true - -type (' p, ' q) pair = -| Pair of ' p * ' q - -type (' p, ' q) l_and = ('p, 'q) pair squash - -let uu___is_Pair _ = true - - -type trivial = - | T - -type l_True = trivial squash - -let uu___is_T _ = true - -type empty = unit -(*This is how Coq extracts Inductive void := . Our extraction needs to be fixed to recognize when there - are no constructors and generate this type abbreviation*) -type l_False = empty squash - -type (' p, ' q) l_imp = ('p -> 'q) squash - -type (' p, ' q) l_iff = ((' p, ' q) l_imp, (' q, ' p) l_imp) l_and - -type ' p l_not = (' p, l_False) l_imp - -type (' a, ' p) l_Forall = L_forall of unit - -type (' a, ' p) l_Exists = L_exists of unit - - -type (' p, ' q, 'dummyP) eq2 = Eq2 of unit -type (' p, ' q, 'dummyP, 'dummyQ) op_Equals_Equals_Equals = Eq3 of unit - -type prop = obj - -let cut = () -let admit () = failwith "no admits" -let _assume () = () -let _assert x = () -let magic () = failwith "no magic" -let unsafe_coerce x = unbox (box x) -let op_Negation x = not x - -let op_Equality x y = x = y -let op_disEquality x y = x<>y -let op_AmpAmp x y = x && y -let op_BarBar x y = x || y -let uu___is_Nil l = l = [] (*consider redefining List.isEmpty as this function*) -let uu___is_Cons l = not (uu___is_Nil l) -let strcat x y = x ^ y - -let string_of_bool (b:bool) = b.ToString() -let string_of_int (i:int) = i.ToString() - -type ('a, 'b) dtuple2 = - | Mkdtuple2 of 'a * 'b - -let __proj__Mkdtuple2__item___1 x = match x with - | Mkdtuple2 (x, _) -> x -let __proj__Mkdtuple2__item___2 x = match x with - | Mkdtuple2 (_, x) -> x - -let rec pow2 (n:int) = if n = bigint 0 then - bigint 1 - else - (bigint 2) * pow2 (n - (bigint 1)) - -let __proj__Cons__item__tl = function - | _::tl -> tl - | _ -> failwith "Impossible" - -let min = min diff --git a/stage0/ulib/fs/ulibfs.fsproj b/stage0/ulib/fs/ulibfs.fsproj deleted file mode 100644 index d080a2f303e..00000000000 --- a/stage0/ulib/fs/ulibfs.fsproj +++ /dev/null @@ -1,104 +0,0 @@ - - - netstandard2.0 - --nowarn:0086 --mlcompatibility --nologo - Library - false - True - false - 0.0.3 - README.md - fstar-new.png - https://fstar-lang.org/ - https://github.com/FStarLang/FStar - LICENSE - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/stage0/ulib/fstar.include b/stage0/ulib/fstar.include index 05c2d2a67a2..1972d88b22e 100644 --- a/stage0/ulib/fstar.include +++ b/stage0/ulib/fstar.include @@ -1,3 +1,2 @@ legacy experimental -.cache diff --git a/stage0/ulib/gmake/Makefile.tmpl b/stage0/ulib/gmake/Makefile.tmpl deleted file mode 100644 index 86aa9877194..00000000000 --- a/stage0/ulib/gmake/Makefile.tmpl +++ /dev/null @@ -1,86 +0,0 @@ -.PHONY: verify-all basic_clean test test.karamel test.ocaml -################################################################################ -# Customize these variables for your project -################################################################################ -# The root files of your project, from which to begin scanning dependences -FSTAR_FILES ?= - -# The paths to related files which to include for scanning -# -- No need to add FSTAR_HOME/ulib; it is included by default -INCLUDE_PATHS ?= - -# The executable file you want to produce -PROGRAM ?= - -# A driver in ML to call into your program -TOP_LEVEL_FILE ?= - -# A place to put all the emitted .ml files -OUTPUT_DIRECTORY ?= _output - -################################################################################ -MY_FSTAR=$(FSTAR) $(SIL) --cache_checked_modules --odir $(OUTPUT_DIRECTORY) -ML_FILES=$(addprefix $(OUTPUT_DIRECTORY)/,$(addsuffix .ml,$(subst .,_, $(subst .fst,,$(FSTAR_FILES))))) -OCAML_EXE=$(PROGRAM).ocaml.exe -KRML_EXE=$(PROGRAM).exe - -# a.fst.checked is the binary, checked version of a.fst -%.fst.checked: %.fst - $(MY_FSTAR) $*.fst - touch -c $@ - -# a.fsti.checked is the binary, checked version of a.fsti -%.fsti.checked: %.fsti - $(MY_FSTAR) $*.fsti - touch -c $@ - -# The _tags file is a directive to ocamlbuild -# The extracted ML files are precious, because you may want to examine them, -# e.g., to see how type signatures were transformed from F* -.PRECIOUS: _tags $(ML_FILES) $(addsuffix .checked,$(FSTAR_FILES)) $(OUTPUT_DIRECTORY)/out.krml - -_tags: - echo ": traverse" > $@ - echo "<$(OUTPUT_DIRECTORY)>: traverse\n" >> $@ - echo "<$(OUTPUT_DIRECTORY)/c>: -traverse\n" >> $@ - -# To extract an A.ml ML file from an A.fst, we just reload its A.fst.checked file -# and then with the --codegen OCaml option, emit an A.ml -# Note, by default F* will extract all files in the dependency graph -# With the --extract_module, we instruct it to just extract A.ml -$(OUTPUT_DIRECTORY)/%.ml: - $(MY_FSTAR) $(subst .checked,,$(notdir $<)) --codegen OCaml --extract_module $(subst .fst.checked,,$(notdir $<)) - -# FIXME: ocamlbuild is deprecated, use dune instead -$(OCAML_EXE): _tags $(ML_FILES) $(TOP_LEVEL_FILE) - OCAMLPATH="$(FSTAR_HOME)/lib" ocamlbuild -I $(OUTPUT_DIRECTORY) -use-ocamlfind -pkg fstar.lib $(subst .ml,.native,$(TOP_LEVEL_FILE)) - mv _build/$(subst .ml,.native,$(TOP_LEVEL_FILE)) $@ - -test.ocaml: $(OCAML_EXE) - ./$< hello - -$(OUTPUT_DIRECTORY)/c/out.krml: $(addsuffix .checked,$(FSTAR_FILES)) - krml -fsopts --cache_checked_modules -tmpdir $(OUTPUT_DIRECTORY)/c -skip-translation $(FSTAR_FILES) - -$(KRML_EXE): $(OUTPUT_DIRECTORY)/c/out.krml - krml $< -tmpdir $(OUTPUT_DIRECTORY)/c -no-prefix A -o $@ - -test.karamel: $(KRML_EXE) - ./$< hello - -test: test.karamel test.ocaml - -basic_clean: - rm -rf _build $(OUTPUT_DIRECTORY) *~ *.checked $(OCAML_EXE) $(KRML_EXE) .depend .depend.rsp - -.depend: $(FSTAR_FILES) - @true $(shell rm -f .depend.rsp) $(foreach f,--dep full $(addprefix --include , $(INCLUDE_PATHS)) $(FSTAR_FILES),$(shell echo $(f) >> .depend.rsp)) - $(MY_FSTAR) @.depend.rsp --output_deps_to .depend - -depend: .depend - -include .depend - -# The default target is to verify all files, without extracting anything -# It needs to be here, because it reads the variable ALL_CHECKED_FILES in .depend -verify-all: $(ALL_CHECKED_FILES) diff --git a/stage0/ulib/gmake/fstar.mk b/stage0/ulib/gmake/fstar.mk deleted file mode 100644 index edd1db1abd8..00000000000 --- a/stage0/ulib/gmake/fstar.mk +++ /dev/null @@ -1,51 +0,0 @@ -WARN_ERROR= -OTHERFLAGS+=$(WARN_ERROR) -OTHERFLAGS+=--z3version 4.13.3 -ifdef Z3 -OTHERFLAGS+=--smt $(Z3) -endif - -# Set ADMIT=1 to admit queries -ADMIT ?= -MAYBE_ADMIT = $(if $(ADMIT),--admit_smt_queries true) - -ifdef FSTAR_HOME - FSTAR_HOME := $(realpath $(FSTAR_HOME)) - ifeq ($(OS),Windows_NT) - FSTAR_HOME := $(shell cygpath -m $(FSTAR_HOME)) - endif - FSTAR_EXE?=$(FSTAR_HOME)/bin/fstar.exe -else -# FSTAR_HOME not defined, assume fstar.exe reachable from PATH -FSTAR_EXE?=fstar.exe -endif -FSTAR=$(FSTAR_EXE) $(OTHERFLAGS) $(MAYBE_ADMIT) $(WITH_CACHE_DIR) - -# Benchmarking wrappers are enabled by setting BENCHMARK_CMD, for example: -# make -C tests/micro-benchmarks BENCHMARK_CMD=time -# make -C ulib benchmark BENCHMARK_CMD='perf stat -x,' -# -# This will utilize the BENCHMARK_CMD to collect data on the executed commands -# -# BENCHMARK_CMD can be set to a wrapper command that works when called as follows: -# $BENCHMARK_CMD -o -- -# -# For example Linux perf stat or strace: -# BENCHMARK_CMD=perf stat -x, -# BENCHMARK_CMD=strace -# -# or GNU time: -# BENCHMARK_CMD=time -# -# or the orun OCaml benchmarking program which will include GC stats and available at: -# https://github.com/ocaml-bench/sandmark/tree/master/orun -# BENCHMARK_CMD=orun -# -BENCHMARK_CMD?= - -ifeq ($(BENCHMARK_CMD),) -BENCHMARK_PRE= -else -# substitution allows targets of the form %.fst.bench to still produce single .bench suffix -BENCHMARK_PRE=-$(BENCHMARK_CMD) -o $(subst .bench,,$@).bench -- -endif diff --git a/stage0/ulib/gmake/z3.mk b/stage0/ulib/gmake/z3.mk deleted file mode 100644 index b7c3b25545a..00000000000 --- a/stage0/ulib/gmake/z3.mk +++ /dev/null @@ -1,24 +0,0 @@ -USE_Z3_NIGHTLY?=no -USE_UNTESTED_Z3_NIGHTLY?=no - -ifeq ($(USE_Z3_NIGHTLY),yes) -ifndef HAVE_Z3_NIGHTLY_BIN - ifndef FSTAR_HOME - $(error "Please define the `FSTAR_HOME` variable before including this makefile.") - endif - ifeq ($(USE_UNTESTED_Z3_NIGHTLY),yes) - C=get-latest - else - C=get-tested - endif - $(info Obtaining Z3 nightly binary ...) - Q=$(shell cd $(FSTAR_HOME) && python .scripts/z3_nightly.py $(C)) - $(info $(Q)) - export Z3=$(abspath $(FSTAR_HOME)/$(lastword $(Q))) - export HAVE_Z3_NIGHTLY_BIN=yes -endif -endif - -ifdef Z3 - $(info Using Z3 at $(Z3)) -endif diff --git a/stage0/ulib/install-ulib.sh b/stage0/ulib/install-ulib.sh deleted file mode 100755 index ee7686c34f8..00000000000 --- a/stage0/ulib/install-ulib.sh +++ /dev/null @@ -1,9 +0,0 @@ -#!/usr/bin/env bash -set -e -set -x - -for f in fstar.include *.fst *.fsti experimental/*.fst experimental/*.fsti .cache/*.checked ml/Makefile.realized ml/Makefile.include gmake/* legacy/*.fst legacy/*.fsti Makefile.extract.fsharp fs/* fs/VS/* ; do - if [[ -f $f ]] ; then - "$INSTALL_EXEC" -m 644 -D -p $f $PREFIX/lib/fstar/$f - fi -done diff --git a/stage0/ulib/legacy/FStar.Buffer.fst b/stage0/ulib/legacy/FStar.Buffer.fst index 1911536b625..1bf7092d5db 100644 --- a/stage0/ulib/legacy/FStar.Buffer.fst +++ b/stage0/ulib/legacy/FStar.Buffer.fst @@ -1152,7 +1152,6 @@ let lemma_modifies_one_trans_1 (#a:Type) (b:buffer a) (h0:mem) (h1:mem) (h2:mem) [SMTPat (modifies_one (frameOf b) h0 h1); SMTPat (modifies_one (frameOf b) h1 h2)] = () -#reset-options "--z3rlimit 100 --max_fuel 0 --max_ifuel 0 --initial_fuel 0 --initial_ifuel 0" (** Corresponds to memcpy *) val blit: #t:Type @@ -1170,6 +1169,8 @@ val blit: #t:Type Seq.slice (as_seq h0 b) 0 (v idx_b) /\ Seq.slice (as_seq h1 b) (v idx_b+v len) (length b) == Seq.slice (as_seq h0 b) (v idx_b+v len) (length b) )) + +#push-options "--z3rlimit 150 --max_fuel 0 --max_ifuel 0 --initial_fuel 0 --initial_ifuel 0" #restart-solver let rec blit #t a idx_a b idx_b len = let h0 = HST.get () in @@ -1185,6 +1186,7 @@ let rec blit #t a idx_a b idx_b len = Seq.cons_head_tail (Seq.slice (as_seq h0 b) (v idx_b + v len') (length b)); Seq.cons_head_tail (Seq.slice (as_seq h1 b) (v idx_b + v len') (length b)) end +#pop-options (** Corresponds to memset *) val fill: #t:Type diff --git a/stage0/ulib/legacy/LowStar.ToFStarBuffer.fst b/stage0/ulib/legacy/LowStar.ToFStarBuffer.fst index 43ed7628305..1bcad243243 100644 --- a/stage0/ulib/legacy/LowStar.ToFStarBuffer.fst +++ b/stage0/ulib/legacy/LowStar.ToFStarBuffer.fst @@ -16,7 +16,6 @@ module LowStar.ToFStarBuffer (* WARNING: FOR TRANSITIONAL PURPOSES ONLY *) -#set-options "--ext 'context_pruning='" module Old = FStar.Buffer module OldM = FStar.Modifies module New = LowStar.Buffer diff --git a/stage0/ulib/mk_int.sh b/stage0/ulib/mk_int.sh deleted file mode 100755 index 449e650fea9..00000000000 --- a/stage0/ulib/mk_int.sh +++ /dev/null @@ -1,166 +0,0 @@ -#!/usr/bin/env bash - -set -eu - -function err () { - echo "Generating the int files failed." - echo "Please note this must be run in the ulib/ directory" -} - -trap err ERR - -## Write FStar.Int.fsti - -for i in 8 16 32 64 128; do - f=FStar.Int$i.fsti - cat > $f <> $f - if [ $i -eq 128 ]; then - cat >> $f < b:Int64.t -> Pure t - (requires True) - (ensures (fun c -> v c = Int64.v a * Int64.v b)) -EOF - fi -done - - -##Write FStar.Int.fst - -for i in 8 16 32 64 128; do - f=FStar.Int$i.fst - cat > $f <> $f - if [ $i -eq 128 ]; then - cat >> $f <.fsti - -for i in 8 16 32 64; do - f=FStar.UInt$i.fsti - cat > $f <> $f - if [ $i -eq 8 ]; then - echo "unfold inline_for_extraction type byte = t" >> $f - fi - if [ $i -eq 128 ]; then - cat >> $f < b:UInt64.t -> Pure t - (requires True) - (ensures (fun c -> v c = UInt64.v a * UInt64.v b)) -EOF - fi -done - - -##Write FStar.UInt.fst - -for i in 8 16 32 64; do - f=FStar.UInt$i.fst - cat > $f <> $f - if [ $i -eq 128 ]; then - cat >> $f <$@ - $(Q)echo '(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *)' >> $@ - $(Q)echo '(* THIS IS AN AUTOGENERATED FILE! See ulib/ml/Makefile *)' >> $@ - $(Q)echo '(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *)' >> $@ - $(Q)echo '' >> $@ - $(Q)cat $< FStar_Ints.ml.body >> $@ - -$(TARGET_DIR): - mkdir -p $@ diff --git a/stage0/ulib/ml/Makefile.include b/stage0/ulib/ml/Makefile.include deleted file mode 100644 index c2b2db6e1f6..00000000000 --- a/stage0/ulib/ml/Makefile.include +++ /dev/null @@ -1,26 +0,0 @@ -FSTAR_DEFAULT_ARGS= -ifdef FSTAR_HOME - ULIB_ML=$(FSTAR_HOME)/ulib/ml - FSTARLIB_DIR=$(FSTAR_HOME)/lib/fstar/lib -else - FSTAR_PREFIX=$(dir $(shell which fstar.exe))/.. - ULIB_ML=$(FSTAR_PREFIX)/lib/fstar/ml - FSTARLIB_DIR=$(FSTAR_PREFIX)/lib/fstar/lib -endif -FSTARLIB=$(FSTARLIB_DIR)/fstar_lib.cmxa - -# Left as an example if we were to add multiple versions of fstar ulib -# ifeq ($(MEM),HST) -# OCAML_DEFAULT_FLAGS=-predicates hyperstack -# endif - -ifdef FSTAR_HOME - WITH_OCAMLPATH=OCAMLPATH=$(FSTAR_HOME)/lib -else - WITH_OCAMLPATH= -endif -OCAMLOPT_BARE=$(WITH_OCAMLPATH) ocamlfind opt -OCAMLOPT_=$(OCAMLOPT_BARE) -package fstar.lib -linkpkg -g -OCAMLOPT=$(OCAMLOPT_) $(OCAML_DEFAULT_FLAGS) -OCAMLC_=$(WITH_OCAMLPATH) ocamlfind c -package fstar.lib -linkpkg -g -OCAMLC=$(OCAMLC_) $(OCAML_DEFAULT_FLAGS) diff --git a/stage0/ulib/ml/Makefile.realized b/stage0/ulib/ml/Makefile.realized deleted file mode 100644 index fd0f74d98ff..00000000000 --- a/stage0/ulib/ml/Makefile.realized +++ /dev/null @@ -1,20 +0,0 @@ -# You should include this Makefile in your Makefile to make sure you remain -# future-proof w.r.t. realized modules! - -FSTAR_REALIZED_MODULES=Buffer Bytes Char CommonST Constructive Dyn Float Ghost Heap Monotonic.Heap \ - HyperStack.All HyperStack.ST HyperStack.IO Int16 Int32 Int64 Int8 \ - List List.Tot.Base Mul Option Pervasives.Native ST Exn String \ - UInt16 UInt32 UInt64 UInt8 \ - Pointer.Derived1 Pointer.Derived2 \ - Pointer.Derived3 \ - BufferNG \ - TaggedUnion \ - Bytes Util \ - Pervasives Order Range \ - Vector.Base Vector.Properties Vector TSet - # prims is realized by default hence not included in this list - -NOEXTRACT_STEEL_MODULES = -FStar.MSTTotal -FStar.MST -FStar.NMSTTotal -FStar.NMST - -NOEXTRACT_MODULES:=$(addprefix -FStar., $(FSTAR_REALIZED_MODULES) Printf) \ - -LowStar.Printf +FStar.List.Pure.Base +FStar.List.Tot.Properties +FStar.Int.Cast.Full $(NOEXTRACT_STEEL_MODULES) diff --git a/stage0/fstar-lib/FStar_Buffer.ml b/stage0/ulib/ml/app-extra/FStar_Buffer.ml similarity index 100% rename from stage0/fstar-lib/FStar_Buffer.ml rename to stage0/ulib/ml/app-extra/FStar_Buffer.ml diff --git a/stage0/fstar-lib/FStar_HyperStack_ST.ml b/stage0/ulib/ml/app-extra/FStar_HyperStack_ST.ml similarity index 100% rename from stage0/fstar-lib/FStar_HyperStack_ST.ml rename to stage0/ulib/ml/app-extra/FStar_HyperStack_ST.ml diff --git a/stage0/ulib/ml/app-extra/README.txt b/stage0/ulib/ml/app-extra/README.txt new file mode 100644 index 00000000000..0a613f953fd --- /dev/null +++ b/stage0/ulib/ml/app-extra/README.txt @@ -0,0 +1,3 @@ +This is really part of the application library, but depends on some extracted +lib modules so it cannot be used in building the compiler. Hence, we separate it here, +so we can just include 'app' when building fstarc-bare. diff --git a/stage0/ulib/ml/app/FStar_All.ml b/stage0/ulib/ml/app/FStar_All.ml new file mode 100644 index 00000000000..c9a376ee3ac --- /dev/null +++ b/stage0/ulib/ml/app/FStar_All.ml @@ -0,0 +1,3 @@ +exception Failure = Failure +let failwith x = raise (Failure x) +let exit i = exit (Z.to_int i) diff --git a/stage0/ulib/ml/app/FStar_Bytes.ml b/stage0/ulib/ml/app/FStar_Bytes.ml new file mode 100644 index 00000000000..ac80dca1b1b --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Bytes.ml @@ -0,0 +1,249 @@ +module U8 = FStar_UInt8 +module U16 = FStar_UInt16 +module U32 = FStar_UInt32 +module U64 = FStar_UInt64 + +type u8 = U8.t +type u16 = U16.t +type u32 = U32.t + +type byte = u8 + +type bytes = string +type cbytes = string (* not in FStar.Bytes *) + +let len (b:bytes) = U32.of_native_int (String.length b) +let length (b:bytes) = Z.of_int (String.length b) + +let reveal (b:bytes) = () +let length_reveal (x:bytes) = () +let hide s = () +let hide_reveal (x:bytes) = () +let reveal_hide s = () + +type 'a lbytes = bytes +type 'a lbytes32 = bytes +type kbytes = bytes + +let empty_bytes = "" +let empty_unique (b:bytes) = () + +let get (b:bytes) (pos:u32) = int_of_char (String.get b (Z.to_int (U32.to_int pos))) +let op_String_Access = get + +let index (b:bytes) (i:Z.t) = get b (U32.uint_to_t i) + +type ('b1, 'b2) equal = unit + +let extensionality (b1:bytes) (b2:bytes) = () + +let create (len:u32) (v:byte) = String.make (U32.to_native_int len) (char_of_int v) +let create_ (len:Z.t) (v:byte) = String.make (Z.to_int len) (char_of_int v) + +let init (len:u32) (f:u32 -> byte) = + String.init (U32.to_native_int len) + (fun (i:int) -> + let b : byte = f (U32.of_native_int i) in + char_of_int b) + +let abyte (b:byte) = create (U32.of_native_int 1) b +let twobytes (bs:(byte * byte)) = + init (U32.of_native_int 2) (fun i -> if i = U32.of_native_int 0 then fst bs else snd bs) + +let append (b1:bytes) (b2:bytes) = b1 ^ b2 +let op_At_Bar = append + +let slice (b:bytes) (s:u32) (e:u32) = + String.sub b (U32.to_native_int s) (U32.to_native_int (U32.sub e s)) +let slice_ (b:bytes) (s:Z.t) (e:Z.t) = + slice b (U32.uint_to_t s) (U32.uint_to_t e) + +let sub (b:bytes) (s:u32) (l:u32) = + String.sub b (U32.to_native_int s) (U32.to_native_int l) + +let split (b:bytes) (k:u32) = + sub b (U32.of_native_int 0) k, + sub b k (U32.sub (U32.of_native_int (String.length b)) k) +let split_ (b:bytes) (k:Z.t) = + split b (U32.of_int k) + +let fits_in_k_bytes (n:Z.t) (k:Z.t) = (* expects k to fit in an int *) + Z.leq Z.zero n && + Z.leq n (Z.of_int (BatInt.pow 2 (8 * Z.to_int k))) +type 'a uint_k = Z.t + +let rec repr_bytes (n:Z.t) = + if Z.to_int n < 256 then Z.of_int 1 + else Z.add (Z.of_int 1) (repr_bytes (Z.div n (Z.of_int 256))) + +let lemma_repr_bytes_values (n:Z.t) = () +let repr_bytes_size (k:Z.t) (n:'a uint_k) = () +let int_of_bytes (b:bytes) = + let x = ref Z.zero in + let len = String.length b in + let n = Z.of_int 256 in + for y = 0 to len-1 do + x := Z.add (Z.mul n !x) (Z.of_int (get b (U32.of_native_int y))) + done; + !x + +let bytes_of_int (nb:Z.t) (i:Z.t) = + let nb = Z.to_int nb in + let i = Z.to_int64 i in + if Int64.compare i Int64.zero < 0 then failwith "Negative 64bit."; + let rec put_bytes bb lb n = + if lb = 0 then failwith "not enough bytes" + else + begin + let lown = Int64.logand n (Int64.of_int 255) in + Bytes.set bb (lb-1) (char_of_int (Int64.to_int lown)); + let ns = Int64.div n (Int64.of_int 256) in + if Int64.compare ns Int64.zero > 0 then + put_bytes bb (lb-1) ns + else bb + end + in + let b = Bytes.make nb (char_of_int 0) in + Bytes.to_string (put_bytes b nb i) + +let int_of_bytes_of_int (k:Z.t) (n:'a uint_k) = () +let bytes_of_int_of_bytes (b:bytes) = () + +let int32_of_bytes (b:bytes) = + Z.to_int (int_of_bytes b) + +let int16_of_bytes (b:bytes) = + Z.to_int (int_of_bytes b) + +let int8_of_bytes (b:bytes) = + Z.to_int (int_of_bytes b) + +let bytes_of_int32 (n:U32.t) = + bytes_of_int (Z.of_int 4) (U32.to_int n) + +let bytes_of_int16 (n:U32.t) = + bytes_of_int (Z.of_int 2) (U32.to_int n) + +let bytes_of_int8 (n:U32.t) = + bytes_of_int (Z.of_int 1) (U32.to_int n) + +type 'a minbytes = bytes + +let xor (len:U32.t) (s1:'a minbytes) (s2:'b minbytes) : bytes = + let f (i:u32) : byte = + let l = int_of_char s1.[U32.to_native_int i] in + let r = int_of_char s2.[U32.to_native_int i] in + l lxor r + in + init len f + +let xor_ (len:Z.t) = xor (U32.of_int len) + +let xor_commutative (n:U32.t) (b1: 'a minbytes) (b2: 'b minbytes) = () +let xor_append (b1:bytes) (b2:bytes) (x1:bytes) (b2:bytes) = () +let xor_idempotent (n:U32.t) (b1:bytes) (b2:bytes) = () + +(*********************************************************************************) +(* Under discussion *) +let utf8 (x:string) : bytes = x (* TODO: use Camomile *) +let utf8_encode = utf8 +let iutf8 (x:bytes) : string = x (* TODO: use Camomile *) +let iutf8_opt (x:bytes) : string option = Some (x) +(*********************************************************************************) + +(* Some helpers to deal with the conversation from hex literals to bytes and + * conversely. Mostly for tests. *) + +let digit_to_int c = match c with + | '0'..'9' -> Char.code c - Char.code '0' + | 'a'..'f' -> 10 + Char.code c - Char.code 'a' + | _ -> failwith "hex_to_char: invalid hex digit" + +let hex_to_char a b = + Char.chr ((digit_to_int a) lsl 4 + digit_to_int b) + +let char_to_hex c = + let n = Char.code c in + let digits = "0123456789abcdef" in + digits.[n lsr 4], digits.[n land 0x0f] + +let string_of_hex s = + let n = String.length s in + if n mod 2 <> 0 then + failwith "string_of_hex: invalid length" + else + let res = Bytes.create (n/2) in + let rec aux i = + if i >= n then () + else ( + Bytes.set res (i/2) (hex_to_char s.[i] s.[i+1]); + aux (i+2) + ) + in + aux 0; + res +let bytes_of_hex s = Bytes.to_string (string_of_hex s) + +let hex_of_string s = + let n = String.length s in + let buf = Buffer.create n in + for i = 0 to n - 1 do + let d1,d2 = char_to_hex s.[i] in + Buffer.add_char buf d1; + Buffer.add_char buf d2; + done; + Buffer.contents buf +let hex_of_bytes b = hex_of_string b + +let print_bytes (s:bytes) : string = + let b = Buffer.create 1024 in + for i = 0 to String.length s - 1 do + Buffer.add_string b (Printf.sprintf "%02X" (int_of_char s.[i])); + done; + Buffer.contents b + +let string_of_bytes b = b +let bytes_of_string s = s + +(*********************************************************************************) +(* OLD *) +(*********************************************************************************) + +let cbyte (b:bytes) = + try int_of_char (String.get b 0) + with _ -> failwith "cbyte: called on empty string" + +let cbyte2 (b:bytes) = + try (int_of_char (String.get b 0), int_of_char (String.get b 1)) + with _ -> failwith "cbyte2: need at least length 2" + +let index (b:bytes) i = + try int_of_char (String.get b (Z.to_int i)) + with _ -> failwith "index: called out of bound" + +let get_cbytes (b:bytes) = b +let abytes (ba:cbytes) = ba +let abyte (ba:byte) = String.make 1 (char_of_int ba) +let abyte2 (ba1,ba2) = + String.init 2 (fun i -> if i = 0 then char_of_int ba1 else char_of_int ba2) + +let split_eq = split + +let createBytes len (value:int) : bytes = + let len = Z.to_int len in + try abytes (String.make len (char_of_int value)) + with _ -> failwith "Default integer for createBytes was greater than max_value" + +let initBytes len f : bytes = + let len = Z.to_int len in + try abytes (String.init len (fun i -> char_of_int (f (Z.of_int i)))) + with _ -> failwith "Platform.Bytes.initBytes: invalid char returned" + +let equalBytes (b1:bytes) (b2:bytes) = b1 = b2 + +let split2 (b:bytes) i j : bytes * bytes * bytes = + let b1, b2 = split b i in + let b2a, b2b = split b2 j in + (b1, b2a, b2b) + +let byte_of_int i = Z.to_int i diff --git a/stage0/ulib/ml/app/FStar_Char.ml b/stage0/ulib/ml/app/FStar_Char.ml new file mode 100644 index 00000000000..2727e723626 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Char.ml @@ -0,0 +1,21 @@ +module UChar = BatUChar + +module U32 = FStar_UInt32 + +type char = int[@@deriving yojson,show] +type char_code = U32.t + +(* FIXME(adl) UChar.lowercase/uppercase removed from recent Batteries. Use Camomile? *) +let lowercase (x:char) : char = + try Char.code (Char.lowercase_ascii (Char.chr x)) + with _ -> x + +let uppercase (x:char) : char = + try Char.code (Char.uppercase_ascii (Char.chr x)) + with _ -> x + +let int_of_char (x:char) : Z.t= Z.of_int x +let char_of_int (i:Z.t) : char = Z.to_int i + +let u32_of_char (x:char) : char_code = U32.of_native_int x +let char_of_u32 (x:char_code) : char = U32.to_native_int x diff --git a/stage0/ulib/ml/app/FStar_CommonST.ml b/stage0/ulib/ml/app/FStar_CommonST.ml new file mode 100644 index 00000000000..2a798438918 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_CommonST.ml @@ -0,0 +1,19 @@ +open FStar_Monotonic_Heap + +let read x = !x + +let op_Bang x = read x + +let write x y = x := y + +let op_Colon_Equals x y = write x y + +let alloc contents = ref contents + +let recall = (fun r -> ()) +let get () = () + +type 'a witnessed = | C + +let gst_witness = (fun r -> ()) +let gst_recall = (fun r -> ()) diff --git a/stage0/ulib/ml/app/FStar_Exn.ml b/stage0/ulib/ml/app/FStar_Exn.ml new file mode 100644 index 00000000000..8128ed78d96 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Exn.ml @@ -0,0 +1 @@ +let raise = raise diff --git a/stage0/ulib/ml/app/FStar_Float.ml b/stage0/ulib/ml/app/FStar_Float.ml new file mode 100644 index 00000000000..39546f9599e --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Float.ml @@ -0,0 +1,2 @@ +type double = float[@@deriving yojson,show] +type float = double[@@deriving yojson,show] diff --git a/stage0/ulib/ml/app/FStar_Heap.ml b/stage0/ulib/ml/app/FStar_Heap.ml new file mode 100644 index 00000000000..f58f5935c55 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Heap.ml @@ -0,0 +1,5 @@ +open FStar_Monotonic_Heap + +type 'a ref = 'a FStar_Monotonic_Heap.ref +type ('a, 'b, 'c) trivial_rel = Prims.l_True +type ('a, 'b, 'c) trivial_preorder = ('a, 'b, 'c) trivial_rel diff --git a/stage0/ulib/ml/app/FStar_IO.ml b/stage0/ulib/ml/app/FStar_IO.ml new file mode 100644 index 00000000000..0888665e028 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_IO.ml @@ -0,0 +1,82 @@ +exception EOF +type fd_read = in_channel +type fd_write = out_channel +let stdin = stdin +let stdout = stdout +let stderr = stderr + +let pr = Printf.printf +let spr = Printf.sprintf +let fpr = Printf.fprintf + +let print_newline = print_newline +let print_string s = pr "%s" s; flush stdout + + +(* let print_nat s = + * pr "%x" s; + * flush stdout + * + * let print_nat_dec s = + * pr "%u" s; + * flush stdout *) + +let print_via (f:'a -> string) (x:'a) : unit = + print_string (f x); + flush stdout + +let print_uint8 = print_via FStar_UInt8.to_string_hex +let print_uint16 = print_via FStar_UInt16.to_string_hex +let print_uint32 = print_via FStar_UInt32.to_string_hex +let print_uint64 = print_via FStar_UInt64.to_string_hex + +let print_uint8_dec = print_via FStar_UInt8.to_string +let print_uint16_dec = print_via FStar_UInt16.to_string +let print_uint32_dec = print_via FStar_UInt32.to_string +let print_uint64_dec = print_via FStar_UInt64.to_string + +let print_uint8_hex_pad = print_via FStar_UInt8.to_string_hex_pad +let print_uint16_hex_pad = print_via FStar_UInt16.to_string_hex_pad +let print_uint32_hex_pad = print_via FStar_UInt32.to_string_hex_pad +let print_uint64_hex_pad = print_via FStar_UInt64.to_string_hex_pad + + +let __zeropad n s = + String.make (n - String.length s) '0' ^ s + +(* The magic numbers in these dec_pad functions are the precomputed + * string lengths of the maximum number when printed in decimal. + * + * - length "255" = 3 + * - length "65535" = 5 + * - length "4294967296" = 10 + * - length "18446744073709551616" = 20 + *) +let print_uint8_dec_pad n = + let s = FStar_UInt8.to_string n in + print_string (__zeropad 3 s) + +let print_uint16_dec_pad n = + let s = FStar_UInt16.to_string n in + print_string (__zeropad 5 s) + +let print_uint32_dec_pad n = + let s = FStar_UInt32.to_string n in + print_string (__zeropad 10 s) + +let print_uint64_dec_pad n = + let s = FStar_UInt64.to_string n in + print_string (__zeropad 20 s) + +let print_any s = output_value stdout s; flush stdout +let input_line = read_line +let input_int () = Z.of_int (read_int ()) +let input_float = read_float +let open_read_file = open_in +let open_write_file = open_out +let close_read_file = close_in +let close_write_file = close_out +let read_line fd = try Stdlib.input_line fd with End_of_file -> raise EOF +let write_string = output_string + +let debug_print_string s = print_string s; false diff --git a/stage0/ulib/ml/app/FStar_ImmutableArray.ml b/stage0/ulib/ml/app/FStar_ImmutableArray.ml new file mode 100644 index 00000000000..342a434e9e9 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_ImmutableArray.ml @@ -0,0 +1,2 @@ +module IAB = FStar_ImmutableArray_Base +let to_list (x:'a IAB.t) = Array.to_list x diff --git a/stage0/ulib/ml/app/FStar_ImmutableArray_Base.ml b/stage0/ulib/ml/app/FStar_ImmutableArray_Base.ml new file mode 100644 index 00000000000..2cb272926af --- /dev/null +++ b/stage0/ulib/ml/app/FStar_ImmutableArray_Base.ml @@ -0,0 +1,7 @@ +type 'a t = 'a array + +let of_list (l:'a list) = Array.of_list l + +let length (a: 'a t) = Z.of_int (Array.length a) + +let index (a: 'a t) (i:Z.t) = Array.get a (Z.to_int i) diff --git a/stage0/ulib/ml/app/FStar_List.ml b/stage0/ulib/ml/app/FStar_List.ml new file mode 100644 index 00000000000..4ae3e5c1b49 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_List.ml @@ -0,0 +1,82 @@ +(* We give an implementation here using OCaml's BatList, + which provides tail-recursive versions of most functions *) +include FStar_List_Tot_Base + +let isEmpty l = l = [] +let singleton x = [x] +let mem = BatList.mem +let memT = mem +let hd = BatList.hd +let tl = BatList.tl +let tail = BatList.tl + +let nth l i = BatList.nth l (Z.to_int i) +let length l = Z.of_int (BatList.length l) +let rev = BatList.rev +let map = BatList.map +let mapT = map +let mapi f l = BatList.mapi (fun i x -> f (Z.of_int i) x) l +let map2 = BatList.map2 +let rec map3 f l1 l2 l3 = + match l1, l2, l3 with + | [], [], [] -> [] + | x::xs, y::ys, z::zs -> (f x y z)::(map3 f xs ys zs) + | _, _, _ -> failwith "The lists do not have the same length" +let iter = BatList.iter +let iter2 = BatList.iter2 +let iteri_aux _ _ _ = failwith "FStar_List.ml: Not implemented: iteri_aux" +let iteri f l = BatList.iteri (fun i x -> f (Z.of_int i) x) l +let partition = BatList.partition +let append = BatList.append +let rev_append = BatList.rev_append +let fold_left = BatList.fold_left +let fold_right = BatList.fold_right +let fold_left2 = BatList.fold_left2 +let fold_right2 = BatList.fold_right2 +let rev_map_onto f l acc = fold_left (fun acc x -> f x :: acc) acc l +let rec init = function + | [] -> failwith "init: empty list" + | [h] -> [] + | h::t -> h::(init t) +let last = BatList.last +let last_opt l = List.fold_left (fun _ x -> Some x) None l +let collect f l = BatList.flatten (BatList.map f l) +let unzip = BatList.split +let rec unzip3 = function + | [] -> ([],[],[]) + | (x,y,z)::xyzs -> + let (xs,ys,zs) = unzip3 xyzs in + (x::xs,y::ys,z::zs) +let filter = BatList.filter +let sortWith f l = BatList.sort (fun x y -> Z.to_int (f x y)) l +let for_all = BatList.for_all +let forall2 = BatList.for_all2 +let tryFind f l = try Some (BatList.find f l) with | Not_found -> None +let tryFindT = tryFind +let find = tryFind +let tryPick f l = try f (BatList.find (fun x -> f x <> None) l) with | Not_found -> None +let flatten = BatList.flatten +let concat = flatten +let split = unzip +let choose = BatList.filter_map +let existsb f l = BatList.exists f l +let existsML f l = BatList.exists f l +let contains x l = BatList.exists (fun y -> x = y) l +let zip = BatList.combine +let splitAt x l = BatList.split_at (Z.to_int x) l +let filter_map = BatList.filter_map +let index f l = + Z.of_int (fst (BatList.findi (fun _ x -> f x) l)) + +let rec zip3 l1 l2 l3 = + match l1, l2, l3 with + | [], [], [] -> [] + | h1::t1, h2::t2, h3::t3 -> (h1, h2, h3) :: (zip3 t1 t2 t3) + | _ -> failwith "zip3" +let unique = BatList.unique +let map_flatten f l = flatten (map f l) + +let span = BatList.span + +let deduplicate (f:'a -> 'a -> bool) (l:'a list) : 'a list = BatList.unique ~eq:f l +let fold_left_map = BatList.fold_left_map diff --git a/stage0/ulib/ml/app/FStar_List_Tot_Base.ml b/stage0/ulib/ml/app/FStar_List_Tot_Base.ml new file mode 100644 index 00000000000..537c03abb2a --- /dev/null +++ b/stage0/ulib/ml/app/FStar_List_Tot_Base.ml @@ -0,0 +1,76 @@ +(* We give an implementation here using OCaml's BatList, + which provide tail-recursive versions of most functions. + The rest we implement manually. *) + +let isEmpty l = l = [] +let hd = BatList.hd +let tail = BatList.tl +let tl = BatList.tl + +let rec last = function + | x :: [] -> x + | _ :: tl -> last tl + +let rec init = function + | _ :: [] -> [] + | hd :: tl -> hd :: init tl + +let length l = Z.of_int (BatList.length l) +let nth l i = try Some (BatList.nth l (Z.to_int i)) with _ -> None +let index l i = BatList.nth l (Z.to_int i) + +let rec count x = function + | [] -> Prims.int_zero + | hd::tl -> if x=hd then Z.add Prims.int_one (count x tl) else count x tl + +let rev_acc l r = BatList.rev_append l r +let rev = BatList.rev +let append = BatList.append +let op_At = append +let snoc (x, y) = append x [y] +let flatten = BatList.flatten +let map = BatList.map +let mapi_init _ _ _ = failwith "FStar_List_Tot_Base.ml: Not implemented: mapi_init" +let mapi f l = BatList.mapi (fun i x -> f (Z.of_int i) x) l +let concatMap f l = flatten (map f l) +let fold_left = BatList.fold_left +let fold_right = BatList.fold_right +let fold_left2 = BatList.fold_left2 +let mem = BatList.mem +type ('a, 'b, 'c) memP = unit +let contains x l = BatList.exists (fun y -> x = y) l +let existsb f l = BatList.exists f l +let find f l = try Some (BatList.find f l) with | Not_found -> None +let filter = BatList.filter +let for_all = BatList.for_all +let collect f l = BatList.flatten (BatList.map f l) +let tryFind = find +let tryPick f l = try f (BatList.find (fun x -> f x <> None) l) with | Not_found -> None +let choose = BatList.filter_map +let partition = BatList.partition +let subset la lb = BatList.subset (fun x y -> if x = y then 0 else 1) la lb + +let rec noRepeats = function + | [] -> true + | h :: tl -> not (mem h tl) && noRepeats tl + +let assoc x l = match List.assoc x l with exception Not_found -> None | x -> Some x +let split = BatList.split +let unzip = split +let rec unzip3 = function + | [] -> ([],[],[]) + | (x,y,z)::xyzs -> + let (xs,ys,zs) = unzip3 xyzs in + (x::xs,y::ys,z::zs) + +let splitAt n l = BatList.split_at (Z.to_int n) l +let unsnoc l = let l1, l2 = splitAt (Z.sub (length l) Z.one) l in l1, hd l2 +let split3 l i = let a, a1 = splitAt i l in let b :: c = a1 in a, b, c + +let bool_of_compare f x y = Z.gt (f x y) Z.zero +let compare_of_bool = + fun rel -> fun x -> fun y -> if (rel x y) then Z.one else (if x = y then Z.zero else (Z.neg Z.one)) +let sortWith f l = BatList.sort (fun x y -> Z.to_int (f x y)) l +let list_unref l = l +let list_ref _ l = l +let list_refb _ l = l diff --git a/stage0/ulib/ml/app/FStar_Monotonic_Heap.ml b/stage0/ulib/ml/app/FStar_Monotonic_Heap.ml new file mode 100644 index 00000000000..1c1cc85cb10 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Monotonic_Heap.ml @@ -0,0 +1,36 @@ +type heap = unit + +type nonrec 'a ref = 'a ref + +type ('a, 'b) mref = 'a ref + +let emp = + () + +(* Logical functions on heap *) +(* TODO : complete the functions to have the same interface as in FStar.Heap.fsti *) + +let addr_of _ = Obj.magic () +let is_mm _ = Obj.magic () + +(* let compare_addrs *) + +type ('a, 'b, 'c, 'd) contains +type ('a, 'b) addr_unused_in +type ('a, 'b, 'c, 'd) unused_in +let fresh _ _ _ = Obj.magic () + +let sel _ _ = Obj.magic () +let upd _ _ _ = Obj.magic () +let alloc _ _ _ = Obj.magic () + +let free_mm _ _ = Obj.magic () +let sel_tot = sel +let upd_tot = upd + +(* Untyped view of references *) +type aref = + | Ref of (unit * unit) +let dummy_aref = Ref ((), ()) +let aref_of _ = dummy_aref +let ref_of _ _ = Obj.magic () diff --git a/stage0/ulib/ml/app/FStar_Option.ml b/stage0/ulib/ml/app/FStar_Option.ml new file mode 100644 index 00000000000..18b7837e926 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Option.ml @@ -0,0 +1,37 @@ +open Prims +let isNone: 'a . 'a FStar_Pervasives_Native.option -> Prims.bool = + fun uu___10_12 -> + match uu___10_12 with + | FStar_Pervasives_Native.None -> true + | FStar_Pervasives_Native.Some uu____15 -> false +let isSome: 'a . 'a FStar_Pervasives_Native.option -> Prims.bool = + fun uu___11_27 -> + match uu___11_27 with + | FStar_Pervasives_Native.Some uu____30 -> true + | FStar_Pervasives_Native.None -> false +let map: + 'a 'b . + ('a -> 'b) -> + 'a FStar_Pervasives_Native.option -> 'b FStar_Pervasives_Native.option + = + fun f -> + fun uu___12_58 -> + match uu___12_58 with + | FStar_Pervasives_Native.Some x -> + let uu____64 = f x in FStar_Pervasives_Native.Some uu____64 + | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None +let mapTot: + 'a 'b . + ('a -> 'b) -> + 'a FStar_Pervasives_Native.option -> 'b FStar_Pervasives_Native.option + = + fun f -> + fun uu___13_91 -> + match uu___13_91 with + | FStar_Pervasives_Native.Some x -> FStar_Pervasives_Native.Some (f x) + | FStar_Pervasives_Native.None -> FStar_Pervasives_Native.None +let get: 'a . 'a FStar_Pervasives_Native.option -> 'a = + fun uu___14_108 -> + match uu___14_108 with + | FStar_Pervasives_Native.Some x -> x + | FStar_Pervasives_Native.None -> failwith "empty option" \ No newline at end of file diff --git a/stage0/ulib/ml/app/FStar_Pervasives_Native.ml b/stage0/ulib/ml/app/FStar_Pervasives_Native.ml new file mode 100644 index 00000000000..0027fcb263a --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Pervasives_Native.ml @@ -0,0 +1,285 @@ + +type 'a option' = 'a option = + | None + | Some of 'a[@@deriving yojson,show] + +type 'a option = 'a option' = + | None + | Some of 'a[@@deriving yojson,show] + +let uu___is_None = function None -> true | _ -> false +let uu___is_Some = function Some _ -> true | _ -> false +let __proj__Some__item__v = function Some x -> x | _ -> assert false + +(* 'a * 'b *) +type ('a,'b) tuple2 = 'a * 'b[@@deriving yojson,show] + +let fst = Stdlib.fst +let snd = Stdlib.snd + +let __proj__Mktuple2__item___1 = fst +let __proj__Mktuple2__item___2 = snd + +type ('a,'b,'c) tuple3 = + 'a* 'b* 'c +[@@deriving yojson,show] +let uu___is_Mktuple3 projectee = true +let __proj__Mktuple3__item___1 projectee = + match projectee with | (_1,_2,_3) -> _1 +let __proj__Mktuple3__item___2 projectee = + match projectee with | (_1,_2,_3) -> _2 +let __proj__Mktuple3__item___3 projectee = + match projectee with | (_1,_2,_3) -> _3 + +type ('a,'b,'c,'d) tuple4 = + 'a* 'b* 'c* 'd +[@@deriving yojson,show] +let uu___is_Mktuple4 projectee = true +let __proj__Mktuple4__item___1 projectee = + match projectee with | (_1,_2,_3,_4) -> _1 +let __proj__Mktuple4__item___2 projectee = + match projectee with | (_1,_2,_3,_4) -> _2 +let __proj__Mktuple4__item___3 projectee = + match projectee with | (_1,_2,_3,_4) -> _3 +let __proj__Mktuple4__item___4 projectee = + match projectee with | (_1,_2,_3,_4) -> _4 + +type ('a,'b,'c,'d,'e) tuple5 = + 'a* 'b* 'c* 'd* 'e +[@@deriving yojson,show] +let uu___is_Mktuple5 projectee = true +let __proj__Mktuple5__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5) -> _1 +let __proj__Mktuple5__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5) -> _2 +let __proj__Mktuple5__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5) -> _3 +let __proj__Mktuple5__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5) -> _4 +let __proj__Mktuple5__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5) -> _5 + +type ('a,'b,'c,'d,'e,'f) tuple6 = + 'a* 'b* 'c* 'd* 'e* 'f +[@@deriving yojson,show] +let uu___is_Mktuple6 projectee = true +let __proj__Mktuple6__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6) -> _1 +let __proj__Mktuple6__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6) -> _2 +let __proj__Mktuple6__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6) -> _3 +let __proj__Mktuple6__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6) -> _4 +let __proj__Mktuple6__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6) -> _5 +let __proj__Mktuple6__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6) -> _6 + +type ('a,'b,'c,'d,'e,'f,'g) tuple7 = + 'a* 'b* 'c* 'd* 'e* 'f* 'g +[@@deriving yojson,show] +let uu___is_Mktuple7 projectee = true +let __proj__Mktuple7__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7) -> _1 +let __proj__Mktuple7__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7) -> _2 +let __proj__Mktuple7__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7) -> _3 +let __proj__Mktuple7__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7) -> _4 +let __proj__Mktuple7__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7) -> _5 +let __proj__Mktuple7__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7) -> _6 +let __proj__Mktuple7__item___7 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7) -> _7 + +type ('a,'b,'c,'d,'e,'f,'g,'h) tuple8 = + 'a* 'b* 'c* 'd* 'e* 'f* 'g* 'h +[@@deriving yojson,show] +let uu___is_Mktuple8 projectee = true +let __proj__Mktuple8__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _1 +let __proj__Mktuple8__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _2 +let __proj__Mktuple8__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _3 +let __proj__Mktuple8__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _4 +let __proj__Mktuple8__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _5 +let __proj__Mktuple8__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _6 +let __proj__Mktuple8__item___7 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _7 +let __proj__Mktuple8__item___8 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8) -> _8 + +type ('a,'b,'c,'d,'e,'f,'g,'h,'i) tuple9 = + 'a *'b *'c *'d *'e *'f *'g *'h *'i +[@@deriving yojson,show] +let uu___is_Mktuple9 projectee = true +let __proj__Mktuple9__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _1 +let __proj__Mktuple9__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _2 +let __proj__Mktuple9__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _3 +let __proj__Mktuple9__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _4 +let __proj__Mktuple9__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _5 +let __proj__Mktuple9__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _6 +let __proj__Mktuple9__item___7 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _7 +let __proj__Mktuple9__item___8 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _8 +let __proj__Mktuple9__item___9 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9) -> _9 + +type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j) tuple10 = + 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j +[@@deriving yojson,show] +let uu___is_Mktuple10 projectee = true +let __proj__Mktuple10__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _1 +let __proj__Mktuple10__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _2 +let __proj__Mktuple10__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _3 +let __proj__Mktuple10__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _4 +let __proj__Mktuple10__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _5 +let __proj__Mktuple10__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _6 +let __proj__Mktuple10__item___7 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _7 +let __proj__Mktuple10__item___8 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _8 +let __proj__Mktuple10__item___9 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _9 +let __proj__Mktuple10__item___10 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10) -> _10 + +type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k) tuple11 = + 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j *'k +[@@deriving yojson,show] +let uu___is_Mktuple11 projectee = true +let __proj__Mktuple11__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _1 +let __proj__Mktuple11__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _2 +let __proj__Mktuple11__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _3 +let __proj__Mktuple11__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _4 +let __proj__Mktuple11__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _5 +let __proj__Mktuple11__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _6 +let __proj__Mktuple11__item___7 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _7 +let __proj__Mktuple11__item___8 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _8 +let __proj__Mktuple11__item___9 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _9 +let __proj__Mktuple11__item___10 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _10 +let __proj__Mktuple11__item___11 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11) -> _11 + +type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l) tuple12 = + 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j *'k *'l +[@@deriving yojson,show] +let uu___is_Mktuple12 projectee = true +let __proj__Mktuple12__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _1 +let __proj__Mktuple12__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _2 +let __proj__Mktuple12__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _3 +let __proj__Mktuple12__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _4 +let __proj__Mktuple12__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _5 +let __proj__Mktuple12__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _6 +let __proj__Mktuple12__item___7 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _7 +let __proj__Mktuple12__item___8 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _8 +let __proj__Mktuple12__item___9 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _9 +let __proj__Mktuple12__item___10 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _10 +let __proj__Mktuple12__item___11 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _11 +let __proj__Mktuple12__item___12 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12) -> _12 + +type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l,'m) tuple13 = + 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j *'k *'l *'m +[@@deriving yojson,show] +let uu___is_Mktuple13 projectee = true +let __proj__Mktuple13__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _1 +let __proj__Mktuple13__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _2 +let __proj__Mktuple13__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _3 +let __proj__Mktuple13__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _4 +let __proj__Mktuple13__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _5 +let __proj__Mktuple13__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _6 +let __proj__Mktuple13__item___7 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _7 +let __proj__Mktuple13__item___8 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _8 +let __proj__Mktuple13__item___9 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _9 +let __proj__Mktuple13__item___10 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _10 +let __proj__Mktuple13__item___11 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _11 +let __proj__Mktuple13__item___12 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _12 +let __proj__Mktuple13__item___13 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13) -> _13 + +type ('a,'b,'c,'d,'e,'f,'g,'h,'i,'j,'k,'l,'m,'n) tuple14 = + 'a *'b *'c *'d *'e *'f *'g *'h *'i *'j *'k *'l *'m *'n +[@@deriving yojson,show] +let uu___is_Mktuple14 projectee = true +let __proj__Mktuple14__item___1 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _1 +let __proj__Mktuple14__item___2 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _2 +let __proj__Mktuple14__item___3 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _3 +let __proj__Mktuple14__item___4 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _4 +let __proj__Mktuple14__item___5 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _5 +let __proj__Mktuple14__item___6 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _6 +let __proj__Mktuple14__item___7 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _7 +let __proj__Mktuple14__item___8 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _8 +let __proj__Mktuple14__item___9 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _9 +let __proj__Mktuple14__item___10 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _10 +let __proj__Mktuple14__item___11 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _11 +let __proj__Mktuple14__item___12 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _12 +let __proj__Mktuple14__item___13 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _13 +let __proj__Mktuple14__item___14 projectee = + match projectee with | (_1,_2,_3,_4,_5,_6,_7,_8,_9,_10,_11,_12,_13,_14) -> _14 diff --git a/stage0/ulib/ml/app/FStar_Pprint.ml b/stage0/ulib/ml/app/FStar_Pprint.ml new file mode 100644 index 00000000000..83bf2f366ee --- /dev/null +++ b/stage0/ulib/ml/app/FStar_Pprint.ml @@ -0,0 +1,95 @@ +(* + Copyright 2016 Microsoft Research + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. +*) + +(* NOTE!!! This is a copy of FStarC_Pprint that is exposed to applications +via the library, without needing to link against compiler modules. The compiler +itself could also use this but there are some issues with effect polymorphism +(e.g. flow_map would need two versions, and having the ML one in the ulib module +would introduce a lot of dependencies) and also would need to have a single definition +of `float` (the compiler defines its own, though this is probably unneeded and can +be removed). *) + +(* prettyprint.fsti's OCaml implementation is just a thin wrapper around + Francois Pottier's pprint package. *) +include PPrint + +(* FIXME(adl) also print the char in a comment if it's representable *) +let doc_of_char c = PPrint.OCaml.char (Char.chr c) +let doc_of_string = PPrint.string +let doc_of_bool b = PPrint.string (string_of_bool b) +let blank_buffer_doc = [ ("", PPrint.empty) ] + +let substring s ofs len = + PPrint.substring s (Z.to_int ofs) (Z.to_int len) + +let fancystring s apparent_length = + PPrint.fancystring s (Z.to_int apparent_length) + +let fancysubstring s ofs len apparent_length = + PPrint.fancysubstring s (Z.to_int ofs) (Z.to_int len) (Z.to_int apparent_length) + +let blank n = PPrint.blank (Z.to_int n) + +let break_ n = PPrint.break (Z.to_int n) + +let op_Hat_Hat = PPrint.(^^) +let op_Hat_Slash_Hat = PPrint.(^/^) + +let nest j doc = PPrint.nest (Z.to_int j) doc + +let long_left_arrow = PPrint.string "<--" +let larrow = PPrint.string "<-" +let rarrow = PPrint.string "->" + +let repeat n doc = PPrint.repeat (Z.to_int n) doc + +let hang n doc = PPrint.hang (Z.to_int n) doc + +let prefix n b left right = + PPrint.prefix (Z.to_int n) (Z.to_int b) left right + +let jump n b right = + PPrint.jump (Z.to_int n) (Z.to_int b) right + +let infix n b middle left right = + PPrint.infix (Z.to_int n) (Z.to_int b) middle left right + +let surround n b opening contents closing = + PPrint.surround (Z.to_int n) (Z.to_int b) opening contents closing + +let soft_surround n b opening contents closing = + PPrint.soft_surround (Z.to_int n) (Z.to_int b) opening contents closing + +let surround_separate n b void_ opening sep closing docs = + PPrint.surround_separate (Z.to_int n) (Z.to_int b) void_ opening sep closing docs + +let surround_separate_map n b void_ opening sep closing f xs = + PPrint.surround_separate_map (Z.to_int n) (Z.to_int b) void_ opening sep closing f xs + +(* Wrap up ToBuffer.pretty. *) +let pretty_string rfrac width doc = + let buf = Buffer.create 0 in + PPrint.ToBuffer.pretty rfrac (Z.to_int width) buf doc; + Buffer.contents buf + +(* Wrap up ToChannel.pretty *) +let pretty_out_channel rfrac width doc ch = + PPrint.ToChannel.pretty rfrac (Z.to_int width) ch doc; + flush ch + +(* A simple renderer, with some default values. *) +let render (doc:document) : string = + pretty_string 1.0 (Z.of_int 80) doc diff --git a/stage0/ulib/ml/app/FStar_ST.ml b/stage0/ulib/ml/app/FStar_ST.ml new file mode 100644 index 00000000000..a27ecf12ba2 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_ST.ml @@ -0,0 +1,28 @@ +(* https://www.lexifi.com/blog/references-physical-equality *) + +open FStar_CommonST + +type ('a, 'b) mref = ('a, 'b) FStar_Monotonic_Heap.mref + +type 'a ref = 'a FStar_Monotonic_Heap.ref + +let ref_to_yojson _ _ = `Null +let ref_of_yojson _ _ = failwith "cannot readback" + +let read = read + +let op_Bang = op_Bang + +let write = write + +let op_Colon_Equals = op_Colon_Equals + +let alloc = alloc + +let recall = recall +let get = get + +type 'a witnessed = 'a FStar_CommonST.witnessed + +let gst_witness = gst_witness +let gst_recall = gst_recall diff --git a/stage0/ulib/ml/app/FStar_String.ml b/stage0/ulib/ml/app/FStar_String.ml new file mode 100644 index 00000000000..9dcff4a94df --- /dev/null +++ b/stage0/ulib/ml/app/FStar_String.ml @@ -0,0 +1,43 @@ +let make i c = BatUTF8.init (Z.to_int i) (fun _ -> BatUChar.chr c) +let strcat s t = s ^ t +let op_Hat s t = strcat s t + +(* restore pre-2.11 BatString.nsplit behavior, + see https://github.com/ocaml-batteries-team/batteries-included/issues/845 *) +let batstring_nsplit s t = + if s = "" then [] else BatString.split_on_string t s + +let split seps s = + let rec repeat_split acc = function + | [] -> acc + | sep::seps -> + let usep = BatUTF8.init 1 (fun _ -> BatUChar.chr sep) in + let l = BatList.flatten (BatList.map (fun x -> batstring_nsplit x usep) acc) in + repeat_split l seps in + repeat_split [s] seps +let compare x y = Z.of_int (BatString.compare x y) +type char = FStar_Char.char +let concat = BatString.concat +let length s = Z.of_int (BatUTF8.length s) +let strlen s = length s + +let substring s i j = + BatUTF8.init (Z.to_int j) (fun k -> BatUTF8.get s (k + Z.to_int i)) +let sub = substring + +let get s i = BatUChar.code (BatUTF8.get s (Z.to_int i)) +let collect f s = + let r = ref "" in + BatUTF8.iter (fun c -> r := !r ^ f (BatUChar.code c)) s; !r +let lowercase = BatString.lowercase_ascii +let uppercase = BatString.uppercase_ascii +let escaped = BatString.escaped +let index = get +exception Found of int +let index_of s c = + let c = BatUChar.chr c in + try let _ = BatUTF8.iteri (fun c' i -> if c = c' then raise (Found i) else ()) s in Z.of_int (-1) + with Found i -> Z.of_int i +let list_of_string s = BatList.init (BatUTF8.length s) (fun i -> BatUChar.code (BatUTF8.get s i)) +let string_of_list l = BatUTF8.init (BatList.length l) (fun i -> BatUChar.chr (BatList.at l i)) +let string_of_char (c:char) = BatString.of_char (Char.chr c) diff --git a/stage0/ulib/ml/app/FStar_UInt8.ml b/stage0/ulib/ml/app/FStar_UInt8.ml new file mode 100644 index 00000000000..2148ee255f1 --- /dev/null +++ b/stage0/ulib/ml/app/FStar_UInt8.ml @@ -0,0 +1,84 @@ +(* GM: This file is manual due to the derivings, + and that sucks. *) + +type uint8 = int[@@deriving yojson,show] +type byte = uint8[@@deriving yojson,show] +type t = uint8[@@deriving yojson,show] +type t' = t[@@deriving yojson,show] + +let (%) x y = if x < 0 then (x mod y) + y else x mod y + +let n = Prims.parse_int "8" +let v (x:uint8) : Prims.int = Prims.parse_int (string_of_int x) + +let zero = 0 +let one = 1 +let ones = 255 + +let add (a:uint8) (b:uint8) : uint8 = a + b +let add_underspec a b = (add a b) land 255 +let add_mod = add_underspec + +let sub (a:uint8) (b:uint8) : uint8 = a - b +let sub_underspec a b = (sub a b) land 255 +let sub_mod = sub_underspec + +let mul (a:uint8) (b:uint8) : uint8 = a * b +let mul_underspec a b = (mul a b) land 255 +let mul_mod = mul_underspec + +let div (a:uint8) (b:uint8) : uint8 = a / b + +let rem (a:uint8) (b:uint8) : uint8 = a mod b + +let logand (a:uint8) (b:uint8) : uint8 = a land b +let logxor (a:uint8) (b:uint8) : uint8 = a lxor b +let logor (a:uint8) (b:uint8) : uint8 = a lor b +let lognot (a:uint8) : uint8 = lnot a + +let int_to_uint8 (x:Prims.int) : uint8 = Z.to_int x % 256 + +let shift_right (a:uint8) (b:Stdint.Uint32.t) : uint8 = a lsr (Stdint.Uint32.to_int b) +let shift_left (a:uint8) (b:Stdint.Uint32.t) : uint8 = (a lsl (Stdint.Uint32.to_int b)) land 255 + +(* Comparison operators *) +let eq (a:uint8) (b:uint8) : bool = a = b +let gt (a:uint8) (b:uint8) : bool = a > b +let gte (a:uint8) (b:uint8) : bool = a >= b +let lt (a:uint8) (b:uint8) : bool = a < b +let lte (a:uint8) (b:uint8) : bool = a <= b + +(* NOT Constant time comparison operators *) +let gte_mask (a:uint8) (b:uint8) : uint8 = if a >= b then 255 else 0 +let eq_mask (a:uint8) (b:uint8) : uint8 = if a = b then 255 else 0 + +(* Infix notations *) +let op_Plus_Hat = add +let op_Plus_Question_Hat = add_underspec +let op_Plus_Percent_Hat = add_mod +let op_Subtraction_Hat = sub +let op_Subtraction_Question_Hat = sub_underspec +let op_Subtraction_Percent_Hat = sub_mod +let op_Star_Hat = mul +let op_Star_Question_Hat = mul_underspec +let op_Star_Percent_Hat = mul_mod +let op_Slash_Hat = div +let op_Percent_Hat = rem +let op_Hat_Hat = logxor +let op_Amp_Hat = logand +let op_Bar_Hat = logor +let op_Less_Less_Hat = shift_left +let op_Greater_Greater_Hat = shift_right +let op_Equals_Hat = eq +let op_Greater_Hat = gt +let op_Greater_Equals_Hat = gte +let op_Less_Hat = lt +let op_Less_Equals_Hat = lte + +let of_string s = int_of_string s +let to_string s = string_of_int s +let to_string_hex s = Printf.sprintf "0x%x" s +let to_string_hex_pad s = Printf.sprintf "%02x" s +let uint_to_t s = int_to_uint8 s +let to_int s = s +let __uint_to_t = uint_to_t diff --git a/stage0/ulib/ml/app/Prims.ml b/stage0/ulib/ml/app/Prims.ml new file mode 100644 index 00000000000..b96a81ebdc7 --- /dev/null +++ b/stage0/ulib/ml/app/Prims.ml @@ -0,0 +1,195 @@ +type int = Z.t[@printer Z.pp_print][@@deriving show] +let of_int = Z.of_int +let int_zero = Z.zero +let int_one = Z.one +let parse_int = Z.of_string +let to_string = Z.to_string + +type tmp = string [@@deriving yojson] +let int_to_yojson x = tmp_to_yojson (to_string x) +let int_of_yojson x = + match tmp_of_yojson x with + | Ok x -> Ok (parse_int x) + | Error x -> Error x + +type attribute = unit +let (cps : attribute) = () +type 'Auu____5 hasEq = unit +type eqtype = unit +type bool' = bool +[@@deriving yojson,show] +type bool = bool' +[@@deriving yojson,show] +type empty = unit +(*This is how Coq extracts Inductive void := . Our extraction needs to be fixed to recognize when there + are no constructors and generate this type abbreviation*) +type trivial = + | T +let (uu___is_T : trivial -> bool) = fun projectee -> true +type nonrec unit = unit +type 'Ap squash = unit +type 'Ap auto_squash = unit +type l_True = unit +type l_False = unit +type ('Aa,'Ax,'dummyV0) equals = + | Refl +let uu___is_Refl : 'Aa . 'Aa -> 'Aa -> ('Aa,unit,unit) equals -> bool = + fun x -> fun uu____65 -> fun projectee -> true +type ('Aa,'Ax,'Ay) eq2 = unit +type ('Aa,'Ab,'Ax,'Ay) op_Equals_Equals_Equals = unit +type 'Ab b2t = unit +type ('Ap,'Aq) pair = + | Pair of 'Ap * 'Aq +let uu___is_Pair : 'Ap 'Aq . ('Ap,'Aq) pair -> bool = + fun projectee -> true +let __proj__Pair__item___1 : 'Ap 'Aq . ('Ap,'Aq) pair -> 'Ap = + fun projectee -> match projectee with | Pair (_0,_1) -> _0 +let __proj__Pair__item___2 : 'Ap 'Aq . ('Ap,'Aq) pair -> 'Aq = + fun projectee -> match projectee with | Pair (_0,_1) -> _1 +type ('Ap,'Aq) l_and = unit +type ('Ap,'Aq) sum = + | Left of 'Ap + | Right of 'Aq +let uu___is_Left : 'Ap 'Aq . ('Ap,'Aq) sum -> bool = + fun projectee -> + match projectee with | Left _0 -> true | uu____344 -> false + +let __proj__Left__item___0 : 'Ap 'Aq . ('Ap,'Aq) sum -> 'Ap = + fun projectee -> match projectee with | Left _0 -> _0 +let uu___is_Right : 'Ap 'Aq . ('Ap,'Aq) sum -> bool = + fun projectee -> + match projectee with | Right _0 -> true | uu____404 -> false + +let __proj__Right__item___0 : 'Ap 'Aq . ('Ap,'Aq) sum -> 'Aq = + fun projectee -> match projectee with | Right _0 -> _0 +type ('Ap,'Aq) l_or = unit +type ('Ap,'Aq) l_imp = unit +type ('Ap,'Aq) l_iff = unit +type 'Ap l_not = unit +type ('Ap,'Aq,'Ar) l_ITE = unit +type ('Aa,'Ab,'Auu____484,'Auu____485) precedes = unit +type ('Aa,'Auu____490,'Auu____491) has_type = unit +type ('Aa,'Ap) l_Forall = unit +type prop = unit +let id x = x +type ('Aa,'Ab) dtuple2 = + | Mkdtuple2 of 'Aa * 'Ab +let uu___is_Mkdtuple2 : 'Aa 'Ab . ('Aa,'Ab) dtuple2 -> bool = + fun projectee -> true +let __proj__Mkdtuple2__item___1 : 'Aa 'Ab . ('Aa,'Ab) dtuple2 -> 'Aa = + fun projectee -> match projectee with | Mkdtuple2 (_1,_2) -> _1 +let __proj__Mkdtuple2__item___2 : 'Aa 'Ab . ('Aa,'Ab) dtuple2 -> 'Ab = + fun projectee -> match projectee with | Mkdtuple2 (_1,_2) -> _2 +type ('Aa,'Ap) l_Exists = unit +type string' = string[@@deriving yojson,show] +type string = string'[@@deriving yojson,show] +type pure_pre = unit +type ('Aa,'Apre) pure_post' = unit +type 'Aa pure_post = unit +type 'Aa pure_wp = unit +type 'Auu____655 guard_free = unit +type ('Aa,'Ax,'Ap) pure_return = unit +type ('Ar1,'Aa,'Ab,'Awp1,'Awp2,'Ap) pure_bind_wp = 'Awp1 +type ('Aa,'Ap,'Awp_then,'Awp_else,'Apost) pure_if_then_else = unit[@@deriving yojson,show] +type ('Aa,'Awp,'Apost) pure_ite_wp = unit +type ('Aa,'Awp1,'Awp2) pure_stronger = unit +type ('Aa,'Ab,'Awp,'Ap) pure_close_wp = unit +type ('Aa,'Aq,'Awp,'Ap) pure_assert_p = unit +type ('Aa,'Aq,'Awp,'Ap) pure_assume_p = unit +type ('Aa,'Ap) pure_null_wp = unit +type ('Aa,'Awp) pure_trivial = 'Awp +type ('Ap, 'Apost) pure_assert_wp = unit +type ('Aa,'Awp,'Auu____878) purewp_id = 'Awp + + +let op_AmpAmp x y = x && y +let op_BarBar x y = x || y +let op_Negation x = not x + +let ( + ) = Z.add +let ( - ) = Z.sub +let ( * ) = Z.mul +let ( / ) = Z.ediv +let ( <= ) = Z.leq +let ( >= ) = Z.geq +let ( < ) = Z.lt +let ( > ) = Z.gt +let ( mod ) = Z.erem +let ( ~- ) = Z.neg +let abs = Z.abs + +let op_Multiply x y = x * y +let op_Subtraction x y = x - y +let op_Addition x y = x + y +let op_Minus x = -x +let op_LessThan x y = x < y +let op_LessThanOrEqual x y = x <= y +let op_GreaterThan x y = x > y +let op_GreaterThanOrEqual x y = x >= y +let op_Equality x y = x = y +let op_disEquality x y = x<>y + +type nonrec exn = exn +type 'a array' = 'a array[@@deriving yojson,show] +type 'a array = 'a array'[@@deriving yojson,show] +let strcat x y = x ^ y +let op_Hat x y = x ^ y + +type 'a list' = 'a list[@@deriving yojson,show] +type 'a list = 'a list'[@@deriving yojson,show] +let uu___is_Nil : 'Aa . 'Aa list -> bool = + fun projectee -> match projectee with | [] -> true | uu____1190 -> false +let uu___is_Cons : 'Aa . 'Aa list -> bool = + fun projectee -> + match projectee with | hd::tl -> true | uu____1216 -> false + +let __proj__Cons__item__hd : 'Aa . 'Aa list -> 'Aa = + fun projectee -> match projectee with | hd::tl -> hd +let __proj__Cons__item__tl : 'Aa . 'Aa list -> 'Aa list = + fun projectee -> match projectee with | hd::tl -> tl +type pattern = unit + + +type ('Aa,'Auu____1278) decreases = unit +let returnM : 'Aa . 'Aa -> 'Aa = fun x -> x +type lex_t = + | LexTop + | LexCons of unit * Obj.t * lex_t +let (uu___is_LexTop : lex_t -> bool) = + fun projectee -> + match projectee with | LexTop -> true | uu____1313 -> false + +let (uu___is_LexCons : lex_t -> bool) = + fun projectee -> + match projectee with | LexCons (a,_1,_2) -> true | uu____1327 -> false + +type 'Aprojectee __proj__LexCons__item__a = Obj.t +let (__proj__LexCons__item___1 : lex_t -> Obj.t) = + fun projectee -> match projectee with | LexCons (a,_1,_2) -> _1 +let (__proj__LexCons__item___2 : lex_t -> lex_t) = + fun projectee -> match projectee with | LexCons (a,_1,_2) -> _2 +type ('Aa,'Awp) as_requires = 'Awp +type ('Aa,'Awp,'Ax) as_ensures = unit +let admit () = failwith "Prims.admit: cannot be executed" +let magic () = failwith "Prims.magic: cannot be executed" +let unsafe_coerce : 'Aa 'Ab . 'Aa -> 'Ab = + fun x -> Obj.magic x + +type 'Ap spinoff = 'Ap + + +type nat = int +type pos = int +type nonzero = int +let op_Modulus x y = x mod y +let op_Division x y = x / y +let rec (pow2 : nat -> pos) = + fun x -> + Z.shift_left Z.one (Z.to_int x) + +let (min : int -> int -> int) = + fun x -> fun y -> if x <= y then x else y +let (abs : int -> int) = + fun x -> if x >= (parse_int "0") then x else op_Minus x +let string_of_bool = string_of_bool +let string_of_int = to_string diff --git a/stage0/fstar-lib/generated/FStar_Int8.ml b/stage0/ulib/ml/app/ints/FStar_Ints.ml.body similarity index 89% rename from stage0/fstar-lib/generated/FStar_Int8.ml rename to stage0/ulib/ml/app/ints/FStar_Ints.ml.body index 5b0ca3d51fa..de9b5d23188 100644 --- a/stage0/fstar-lib/generated/FStar_Int8.ml +++ b/stage0/ulib/ml/app/ints/FStar_Ints.ml.body @@ -1,20 +1,10 @@ -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) -(* THIS IS AN AUTOGENERATED FILE! See ulib/ml/Makefile *) -(* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! *) - -(* This file is meant to be concatenated to FStar_Ints.ml.body *) -module M = Stdint.Int8 -type int8 = M.t -type t = M.t -let n = Prims.of_int 8 - -let int_to_t x = M.of_string (Z.to_string x) -let __int_to_t = int_to_t (* This .ml.body file is concatenated to every .ml.prefix file in this * directory (ulib/ml/) to generate the OCaml realizations for machine * integers, as they all pretty much share their definitions and are * based on Stdint. *) +type t = M.t + let v (x:t) : Prims.int = Prims.parse_int (M.to_string x) let zero = M.zero diff --git a/stage0/ulib/ml/app/ints/dune b/stage0/ulib/ml/app/ints/dune new file mode 100644 index 00000000000..2f7e19e83a6 --- /dev/null +++ b/stage0/ulib/ml/app/ints/dune @@ -0,0 +1,46 @@ +; NOTE: We explcitly write 'bash ./mk_int_file.sh' instead of just +; calling the script so this works in native Windows. This is needed to +; even build a source package in Windows, since we ship exactly this +; dune file and script. We should consider just shipping the generated +; ML files, if there's a convenient way to do so. + +; This one is special and hand-written... sigh +; (rule +; (target FStar_UInt8.ml) +; (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) +; (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 8)))) + +(rule + (target FStar_UInt16.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 16)))) + +(rule + (target FStar_UInt32.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 32)))) + +(rule + (target FStar_UInt64.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh U 64)))) + +(rule + (target FStar_Int8.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 8)))) + +(rule + (target FStar_Int16.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 16)))) + +(rule + (target FStar_Int32.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 32)))) + +(rule + (target FStar_Int64.ml) + (deps (:script mk_int_file.sh) (:body FStar_Ints.ml.body)) + (action (with-stdout-to %{target} (run bash ./mk_int_file.sh S 64)))) diff --git a/stage0/ulib/ml/app/ints/mk_int_file.sh b/stage0/ulib/ml/app/ints/mk_int_file.sh new file mode 100755 index 00000000000..6d4f6d64c32 --- /dev/null +++ b/stage0/ulib/ml/app/ints/mk_int_file.sh @@ -0,0 +1,34 @@ +#!/usr/bin/env bash + +# This script must run on Windows/Cygwin too. + +set -eu + +SIGN=$1 +WIDTH=$2 + +if [ "$SIGN" == "U" ]; then + cat << EOF + module M = Stdint.Uint${WIDTH} + type uint${WIDTH} = M.t + let n = Prims.of_int ${WIDTH} + + let uint_to_t x = M.of_string (Z.to_string x) + let __uint_to_t = uint_to_t +EOF +elif [ "$SIGN" == "S" ]; then + cat << EOF + module M = Stdint.Int${WIDTH} + type int${WIDTH} = M.t + let n = Prims.of_int ${WIDTH} + + let int_to_t x = M.of_string (Z.to_string x) + let __int_to_t = int_to_t +EOF +else + echo "Bad usage" &>2 + exit 1 +fi + +cat ./FStar_Ints.ml.body +exit 0 diff --git a/stage0/ulib/ml/plugin/FStarC_Tactics_Unseal.ml b/stage0/ulib/ml/plugin/FStarC_Tactics_Unseal.ml new file mode 100644 index 00000000000..62339692c70 --- /dev/null +++ b/stage0/ulib/ml/plugin/FStarC_Tactics_Unseal.ml @@ -0,0 +1,7 @@ +open Fstarcompiler +open FStarC_Tactics_Result +open FStarC_Tactics_Types + +let tac_return x = fun ps -> Success (x, ps) + +let unseal x = tac_return x diff --git a/stage0/ulib/ml/plugin/FStarC_Tactics_V1_Builtins.ml b/stage0/ulib/ml/plugin/FStarC_Tactics_V1_Builtins.ml new file mode 100644 index 00000000000..ef0bc1b2ca7 --- /dev/null +++ b/stage0/ulib/ml/plugin/FStarC_Tactics_V1_Builtins.ml @@ -0,0 +1,143 @@ +open Fstarcompiler +open Prims +open FStar_Pervasives_Native +open FStar_Pervasives +open FStarC_Tactics_Result +open FStarC_Tactics_Types + +module N = FStarC_TypeChecker_Normalize +module B = FStarC_Tactics_V1_Basic +module TM = FStarC_Tactics_Monad +module CTRW = FStarC_Tactics_CtrlRewrite +module RD = FStarC_Reflection_V1_Data +module EMB = FStarC_Syntax_Embeddings +module EMBBase = FStarC_Syntax_Embeddings_Base +module NBET = FStarC_TypeChecker_NBETerm + +type ('a,'wp) tac_repr = proofstate -> 'a __result +type 'a __tac = ('a, unit) tac_repr + +let interpret_tac (t: 'a TM.tac) (ps: proofstate): 'a __result = + TM.run t ps + +let uninterpret_tac (t: 'a __tac) (ps: proofstate): 'a __result = + t ps + +let to_tac_0 (t: 'a __tac): 'a TM.tac = + (fun (ps: proofstate) -> + uninterpret_tac t ps) |> TM.mk_tac + +let to_tac_1 (t: 'b -> 'a __tac): 'b -> 'a TM.tac = fun x -> + (fun (ps: proofstate) -> + uninterpret_tac (t x) ps) |> TM.mk_tac + +let from_tac_1 (t: 'a -> 'b TM.tac): 'a -> 'b __tac = + fun (x: 'a) -> + fun (ps: proofstate) -> + let m = t x in + interpret_tac m ps + +let from_tac_2 (t: 'a -> 'b -> 'c TM.tac): 'a -> 'b -> 'c __tac = + fun (x: 'a) -> + fun (y: 'b) -> + fun (ps: proofstate) -> + let m = t x y in + interpret_tac m ps + +let from_tac_3 (t: 'a -> 'b -> 'c -> 'd TM.tac): 'a -> 'b -> 'c -> 'd __tac = + fun (x: 'a) -> + fun (y: 'b) -> + fun (z: 'c) -> + fun (ps: proofstate) -> + let m = t x y z in + interpret_tac m ps + +let from_tac_4 (t: 'a -> 'b -> 'c -> 'd -> 'e TM.tac): 'a -> 'b -> 'c -> 'd -> 'e __tac = + fun (x: 'a) -> + fun (y: 'b) -> + fun (z: 'c) -> + fun (w: 'd) -> + fun (ps: proofstate) -> + let m = t x y z w in + interpret_tac m ps + +(* Pointing to the internal primitives *) +let set_goals = from_tac_1 TM.set_goals +let set_smt_goals = from_tac_1 TM.set_smt_goals +let top_env = from_tac_1 B.top_env +let fresh = from_tac_1 B.fresh +let refine_intro = from_tac_1 B.refine_intro +let tc = from_tac_2 B.tc +let tcc = from_tac_2 B.tcc +let unshelve = from_tac_1 B.unshelve +let unquote = fun t -> failwith "Sorry, unquote does not work in compiled tactics" +let norm = fun s -> from_tac_1 B.norm s +let norm_term_env = fun e s -> from_tac_3 B.norm_term_env e s +let norm_binder_type = fun s -> from_tac_2 B.norm_binder_type s +let intro = from_tac_1 B.intro +let intro_rec = from_tac_1 B.intro_rec +let rename_to = from_tac_2 B.rename_to +let revert = from_tac_1 B.revert +let binder_retype = from_tac_1 B.binder_retype +let clear_top = from_tac_1 B.clear_top +let clear = from_tac_1 B.clear +let rewrite = from_tac_1 B.rewrite +let t_exact = from_tac_3 B.t_exact +let t_apply = from_tac_4 B.t_apply +let t_apply_lemma = from_tac_3 B.t_apply_lemma +let print = from_tac_1 B.print +let debugging = from_tac_1 B.debugging +let dump = from_tac_1 B.dump +let dump_all = from_tac_2 B.dump_all +let dump_uvars_of = from_tac_2 B.dump_uvars_of +let t_trefl = from_tac_1 B.t_trefl +let dup = from_tac_1 B.dup +let prune = from_tac_1 B.prune +let addns = from_tac_1 B.addns +let t_destruct = from_tac_1 B.t_destruct +let set_options = from_tac_1 B.set_options +let uvar_env = from_tac_2 B.uvar_env +let ghost_uvar_env = from_tac_2 B.ghost_uvar_env +let unify_env = from_tac_3 B.unify_env +let unify_guard_env = from_tac_3 B.unify_guard_env +let match_env = from_tac_3 B.match_env +let launch_process = from_tac_3 B.launch_process +let fresh_bv_named = from_tac_1 B.fresh_bv_named +let change = from_tac_1 B.change +let get_guard_policy = from_tac_1 B.get_guard_policy +let set_guard_policy = from_tac_1 B.set_guard_policy +let lax_on = from_tac_1 B.lax_on +let tadmit_t = from_tac_1 B.tadmit_t +let join = from_tac_1 B.join +let inspect = from_tac_1 B.inspect +let pack = from_tac_1 B.pack +let pack_curried = from_tac_1 B.pack_curried +let curms = from_tac_1 B.curms +let set_urgency = from_tac_1 B.set_urgency +let t_commute_applied_match = from_tac_1 B.t_commute_applied_match +let gather_or_solve_explicit_guards_for_resolved_goals = from_tac_1 B.gather_explicit_guards_for_resolved_goals +let string_to_term = from_tac_2 B.string_to_term +let push_bv_dsenv = from_tac_2 B.push_bv_dsenv +let term_to_string = from_tac_1 B.term_to_string +let comp_to_string = from_tac_1 B.comp_to_string +let range_to_string = from_tac_1 B.range_to_string +let term_eq_old = from_tac_2 B.term_eq_old + +let with_compat_pre_core (n:Prims.int) (f: unit -> 'a __tac) : 'a __tac = + from_tac_2 B.with_compat_pre_core n (to_tac_0 (f ())) + +let get_vconfig = from_tac_1 B.get_vconfig +let set_vconfig = from_tac_1 B.set_vconfig +let t_smt_sync = from_tac_1 B.t_smt_sync +let free_uvars = from_tac_1 B.free_uvars + +(* The handlers need to "embed" their argument. *) +let catch (t: unit -> 'a __tac): ((exn, 'a) either) __tac = from_tac_1 TM.catch (to_tac_0 (t ())) +let recover (t: unit -> 'a __tac): ((exn, 'a) either) __tac = from_tac_1 TM.recover (to_tac_0 (t ())) + +let ctrl_rewrite + (d : direction) + (t1 : FStarC_Syntax_Syntax.term -> (bool * ctrl_flag) __tac) + (t2 : unit -> unit __tac) + : unit __tac + = from_tac_3 CTRW.ctrl_rewrite d (to_tac_1 t1) (to_tac_0 (t2 ())) diff --git a/stage0/ulib/ml/plugin/FStarC_Tactics_V2_Builtins.ml b/stage0/ulib/ml/plugin/FStarC_Tactics_V2_Builtins.ml new file mode 100644 index 00000000000..f47e475f23a --- /dev/null +++ b/stage0/ulib/ml/plugin/FStarC_Tactics_V2_Builtins.ml @@ -0,0 +1,185 @@ +open Fstarcompiler +open Prims +open FStar_Pervasives_Native +open FStar_Pervasives +open FStarC_Tactics_Result +open FStarC_Tactics_Types + +module N = FStarC_TypeChecker_Normalize +module B = FStarC_Tactics_V2_Basic +module TM = FStarC_Tactics_Monad +module CTRW = FStarC_Tactics_CtrlRewrite +module RT = FStarC_Reflection_Types +module RD = FStarC_Reflection_V1_Data +module EMB = FStarC_Syntax_Embeddings +module EMBBase = FStarC_Syntax_Embeddings_Base +module NBET = FStarC_TypeChecker_NBETerm + +type ('a,'wp) tac_repr = proofstate -> 'a __result +type 'a __tac = ('a, unit) tac_repr + +let interpret_tac (s:string) (t: 'a TM.tac) (ps: proofstate): 'a __result = + FStarC_Errors.with_ctx + ("While running primitive " ^ s ^ " (called from within a plugin)") + (fun () -> TM.run t ps) + +let uninterpret_tac (t: 'a __tac) (ps: proofstate): 'a __result = + t ps + +let to_tac_0 (t: 'a __tac): 'a TM.tac = + (fun (ps: proofstate) -> + uninterpret_tac t ps) |> TM.mk_tac + +let to_tac_1 (t: 'b -> 'a __tac): 'b -> 'a TM.tac = fun x -> + (fun (ps: proofstate) -> + uninterpret_tac (t x) ps) |> TM.mk_tac + +let from_tac_1 s (t: 'a -> 'r TM.tac): 'a -> 'r __tac = + fun (xa: 'a) (ps : proofstate) -> + let m = t xa in + interpret_tac s m ps + +let from_tac_2 s (t: 'a -> 'b -> 'r TM.tac): 'a -> 'b -> 'r __tac = + fun (xa: 'a) (xb: 'b) (ps : proofstate) -> + let m = t xa xb in + interpret_tac s m ps + +let from_tac_3 s (t: 'a -> 'b -> 'c -> 'r TM.tac): 'a -> 'b -> 'c -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (ps : proofstate) -> + let m = t xa xb xc in + interpret_tac s m ps + +let from_tac_4 s (t: 'a -> 'b -> 'c -> 'd -> 'r TM.tac): 'a -> 'b -> 'c -> 'd -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (xd: 'd) (ps : proofstate) -> + let m = t xa xb xc xd in + interpret_tac s m ps + +let from_tac_5 s (t: 'a -> 'b -> 'c -> 'd -> 'e -> 'r TM.tac): 'a -> 'b -> 'c -> 'd -> 'e -> 'r __tac = + fun (xa: 'a) (xb: 'b) (xc: 'c) (xd: 'd) (xe: 'e) (ps : proofstate) -> + let m = t xa xb xc xd xe in + interpret_tac s m ps + + +(* Pointing to the internal primitives *) +let fixup_range = from_tac_1 "B.fixup_range" B.fixup_range +let compress = from_tac_1 "B.compress" B.compress +let set_goals = from_tac_1 "TM.set_goals" TM.set_goals +let set_smt_goals = from_tac_1 "TM.set_smt_goals" TM.set_smt_goals +let top_env = from_tac_1 "B.top_env" B.top_env +let fresh = from_tac_1 "B.fresh" B.fresh +let refine_intro = from_tac_1 "B.refine_intro" B.refine_intro +let tc = from_tac_2 "B.tc" B.tc +let tcc = from_tac_2 "B.tcc" B.tcc +let unshelve = from_tac_1 "B.unshelve" B.unshelve +let unquote = fun t -> failwith "Sorry, unquote does not work in compiled tactics" +let norm = fun s -> from_tac_1 "B.norm" B.norm s +let norm_term_env = fun e s -> from_tac_3 "B.norm_term_env" B.norm_term_env e s +let norm_binding_type = fun s -> from_tac_2 "B.norm_binding_type" B.norm_binding_type s +let intro = from_tac_1 "B.intro" B.intro +let intros = from_tac_1 "B.intros" B.intros +let intro_rec = from_tac_1 "B.intro_rec" B.intro_rec +let rename_to = from_tac_2 "B.rename_to" B.rename_to +let revert = from_tac_1 "B.revert" B.revert +let var_retype = from_tac_1 "B.var_retype" B.var_retype +let clear_top = from_tac_1 "B.clear_top" B.clear_top +let clear = from_tac_1 "B.clear" B.clear +let rewrite = from_tac_1 "B.rewrite" B.rewrite +let grewrite = from_tac_2 "B.grewrite" B.grewrite +let t_exact = from_tac_3 "B.t_exact" B.t_exact +let t_apply = from_tac_4 "B.t_apply" B.t_apply +let t_apply_lemma = from_tac_3 "B.t_apply_lemma" B.t_apply_lemma +let print = from_tac_1 "B.print" B.print +let debugging = from_tac_1 "B.debugging" B.debugging +let ide = from_tac_1 "B.ide" B.ide +let dump = from_tac_1 "B.dump" B.dump +let dump_all = from_tac_2 "B.dump_all" B.dump_all +let dump_uvars_of = from_tac_2 "B.dump_uvars_of" B.dump_uvars_of +let t_trefl = from_tac_1 "B.t_trefl" B.t_trefl +let dup = from_tac_1 "B.dup" B.dup +let prune = from_tac_1 "B.prune" B.prune +let addns = from_tac_1 "B.addns" B.addns +let t_destruct = from_tac_1 "B.t_destruct" B.t_destruct +let set_options = from_tac_1 "B.set_options" B.set_options +let uvar_env = from_tac_2 "B.uvar_env" B.uvar_env +let ghost_uvar_env = from_tac_2 "B.ghost_uvar_env" B.ghost_uvar_env +let unify_env = from_tac_3 "B.unify_env" B.unify_env +let unify_guard_env = from_tac_3 "B.unify_guard_env" B.unify_guard_env +let match_env = from_tac_3 "B.match_env" B.match_env +let launch_process = from_tac_3 "B.launch_process" B.launch_process +let fresh_bv_named = from_tac_1 "B.fresh_bv_named" B.fresh_bv_named +let change = from_tac_1 "B.change" B.change +let get_guard_policy = from_tac_1 "B.get_guard_policy" B.get_guard_policy +let set_guard_policy = from_tac_1 "B.set_guard_policy" B.set_guard_policy +let lax_on = from_tac_1 "B.lax_on" B.lax_on +let tadmit_t = from_tac_1 "B.tadmit_t" B.tadmit_t +let join = from_tac_1 "B.join" B.join +let curms = from_tac_1 "B.curms" B.curms +let set_urgency = from_tac_1 "B.set_urgency" B.set_urgency +let set_dump_on_failure = from_tac_1 "B.set_dump_on_failure" B.set_dump_on_failure +let t_commute_applied_match = from_tac_1 "B.t_commute_applied_match" B.t_commute_applied_match +let gather_or_solve_explicit_guards_for_resolved_goals = from_tac_1 "B.gather_explicit_guards_for_resolved_goals" B.gather_explicit_guards_for_resolved_goals +let string_to_term = from_tac_2 "B.string_to_term" B.string_to_term +let push_bv_dsenv = from_tac_2 "B.push_bv_dsenv" B.push_bv_dsenv +let term_to_string = from_tac_1 "B.term_to_string" B.term_to_string +let comp_to_string = from_tac_1 "B.comp_to_string" B.comp_to_string +let term_to_doc = from_tac_1 "B.term_to_doc" B.term_to_doc +let comp_to_doc = from_tac_1 "B.comp_to_doc" B.comp_to_doc +let range_to_string = from_tac_1 "B.range_to_string" B.range_to_string +let term_eq_old = from_tac_2 "B.term_eq_old" B.term_eq_old + +let with_compat_pre_core (n:Prims.int) (f: unit -> 'a __tac) : 'a __tac = + from_tac_2 "B.with_compat_pre_core" B.with_compat_pre_core n (to_tac_0 (f ())) + +let get_vconfig = from_tac_1 "B.get_vconfig" B.get_vconfig +let set_vconfig = from_tac_1 "B.set_vconfig" B.set_vconfig +let t_smt_sync = from_tac_1 "B.t_smt_sync" B.t_smt_sync +let free_uvars = from_tac_1 "B.free_uvars" B.free_uvars +let all_ext_options = from_tac_1 "B.all_ext_options" B.all_ext_options +let ext_getv = from_tac_1 "B.ext_getv" B.ext_getv +let ext_enabled = from_tac_1 "B.ext_enabled" B.ext_enabled +let ext_getns = from_tac_1 "B.ext_getns" B.ext_getns + +let alloc x = from_tac_1 "B.alloc" B.alloc x +let read r = from_tac_1 "B.read" B.read r +let write r x = from_tac_2 "B.write" B.write r x + +type ('env, 't) prop_validity_token = unit +type ('env, 'sc, 't, 'pats, 'bnds) match_complete_token = unit + +let is_non_informative = from_tac_2 "B.refl_is_non_informative" B.refl_is_non_informative +let check_subtyping = from_tac_3 "B.refl_check_subtyping" B.refl_check_subtyping +let t_check_equiv = from_tac_5 "B.t_refl_check_equiv" B.t_refl_check_equiv +let core_compute_term_type = from_tac_2 "B.refl_core_compute_term_type" B.refl_core_compute_term_type +let core_check_term = from_tac_4 "B.refl_core_check_term" B.refl_core_check_term +let core_check_term_at_type = from_tac_3 "B.refl_core_check_term_at_type" B.refl_core_check_term_at_type +let check_match_complete = from_tac_4 "B.refl_check_match_complete" B.refl_check_match_complete +let tc_term = from_tac_2 "B.refl_tc_term" B.refl_tc_term +let universe_of = from_tac_2 "B.refl_universe_of" B.refl_universe_of +let check_prop_validity = from_tac_2 "B.refl_check_prop_validity" B.refl_check_prop_validity +let instantiate_implicits = from_tac_3 "B.refl_instantiate_implicits" B.refl_instantiate_implicits +let try_unify = from_tac_4 "B.refl_try_unify" B.refl_try_unify +let maybe_relate_after_unfolding = from_tac_3 "B.refl_maybe_relate_after_unfolding" B.refl_maybe_relate_after_unfolding +let maybe_unfold_head = from_tac_2 "B.refl_maybe_unfold_head" B.refl_maybe_unfold_head +let norm_well_typed_term = from_tac_3 "B.norm_well_typed_term" B.refl_norm_well_typed_term + +let push_open_namespace = from_tac_2 "B.push_open_namespace" B.push_open_namespace +let push_module_abbrev = from_tac_3 "B.push_module_abbrev" B.push_module_abbrev +let resolve_name = from_tac_2 "B.resolve_name" B.resolve_name +let log_issues = from_tac_1 "B.log_issues" B.log_issues + +(* The handlers need to "embed" their argument. *) +let catch (t: unit -> 'a __tac): ((exn, 'a) either) __tac = from_tac_1 "TM.catch" TM.catch (to_tac_0 (t ())) +let recover (t: unit -> 'a __tac): ((exn, 'a) either) __tac = from_tac_1 "TM.recover" TM.recover (to_tac_0 (t ())) + +let ctrl_rewrite + (d : direction) + (t1 : FStarC_Syntax_Syntax.term -> (bool * ctrl_flag) __tac) + (t2 : unit -> unit __tac) + : unit __tac + = from_tac_3 "ctrl_rewrite" CTRW.ctrl_rewrite d (to_tac_1 t1) (to_tac_0 (t2 ())) + +let call_subtac g (t : unit -> unit __tac) u ty = + let t = to_tac_1 t () in + from_tac_4 "B.call_subtac" B.call_subtac g t u ty + +let call_subtac_tm = from_tac_4 "B.call_subtac_tm" B.call_subtac_tm diff --git a/stage0/ulib/ml/plugin/FStar_Issue.ml b/stage0/ulib/ml/plugin/FStar_Issue.ml new file mode 100644 index 00000000000..3286f0ca6cf --- /dev/null +++ b/stage0/ulib/ml/plugin/FStar_Issue.ml @@ -0,0 +1,56 @@ +open Fstarcompiler +type issue_level = FStarC_Errors.issue_level +type issue = FStarC_Errors.issue +type issue_level_string = string + +open FStarC_Errors + +let string_of_level (i:issue_level) += match i with + | ENotImplemented + | EError -> "Error" + | EInfo -> "Info" + | EWarning -> "Warning" + +let message_of_issue (i:issue) = i.issue_msg + +let level_of_issue (i:issue) = string_of_level (i.issue_level) + +let number_of_issue (i:issue) = i.issue_number + +let range_of_issue (i:issue) = i.issue_range + +let context_of_issue (i:issue) = i.issue_ctx + +let mk_issue_level (i:issue_level_string) + : issue_level + = match i with + | "Error" -> EError + | "Info" -> EInfo + | "Warning" -> EWarning + +let issue_to_doc (i:issue) : FStarC_Pprint.document = FStarC_Errors.issue_to_doc' true i +let render_issue (i:issue) : string = FStarC_Errors.format_issue i + +let mk_issue_doc (i:issue_level_string) + (msg:FStarC_Pprint.document list) + (range:FStarC_Range.range option) + (number:Z.t option) + (ctx:string list) + = { issue_level = mk_issue_level i; + issue_msg = msg; + issue_range = range; + issue_number = number; + issue_ctx = ctx } + +(* repeated... could be extracted *) +let mk_issue (i:issue_level_string) + (msg:string) + (range:FStarC_Range.range option) + (number:Z.t option) + (ctx:string list) + = { issue_level = mk_issue_level i; + issue_msg = [FStarC_Pprint.arbitrary_string msg]; + issue_range = range; + issue_number = number; + issue_ctx = ctx } diff --git a/stage0/ulib/ml/plugin/FStar_Range.ml b/stage0/ulib/ml/plugin/FStar_Range.ml new file mode 100644 index 00000000000..c615d145464 --- /dev/null +++ b/stage0/ulib/ml/plugin/FStar_Range.ml @@ -0,0 +1,15 @@ +type __range = Fstarcompiler.FStarC_Range_Type.range +type range = __range + +let mk_range f a b c d = Fstarcompiler.FStarC_Range_Type.mk_range f {line=a;col=b} {line=c;col=d} +let range_0 : range = let z = Prims.parse_int "0" in mk_range "dummy" z z z z +let join_range r1 r2 = Fstarcompiler.FStarC_Range_Ops.union_ranges r1 r2 + +let explode (r:__range) = + (r.use_range.file_name, + r.use_range.start_pos.line, + r.use_range.start_pos.col, + r.use_range.end_pos.line, + r.use_range.end_pos.col) + +type ('Ar,'Amsg,'Ab) labeled = 'Ab diff --git a/stage0/ulib/ml/plugin/FStar_Reflection_Typing_Builtins.ml b/stage0/ulib/ml/plugin/FStar_Reflection_Typing_Builtins.ml new file mode 100644 index 00000000000..c0ad1c3e3c0 --- /dev/null +++ b/stage0/ulib/ml/plugin/FStar_Reflection_Typing_Builtins.ml @@ -0,0 +1,28 @@ +open Fstarcompiler +open FStarC_Syntax_Syntax +module R = FStarC_Range + +let dummy_range = R.dummyRange +let underscore = FStarC_Ident.mk_ident ("_", R.dummyRange) +let int_as_bv (n:Prims.int) = { ppname = underscore; index = n; sort = tun} + +let open_term (t:term) (v:Prims.int) + : term + = let subst = DB (Z.zero, int_as_bv v) in + FStarC_Syntax_Subst.subst [subst] t + +let close_term (t:term) (v:Prims.int) + : term + = let subst = NM (int_as_bv v, Z.zero) in + FStarC_Syntax_Subst.subst [subst] t + +let open_with (t:term) (v:term) + : term + = let neg = int_as_bv (Z.of_int (-1)) in (* a temporary non-clashing name *) + let opened_t = FStarC_Syntax_Subst.subst [DB(Z.zero, neg)] t in + (* gets substituted away immediately *) + FStarC_Syntax_Subst.subst [NT(neg, v)] opened_t + +let rename (t:term) (x:Prims.int) (y:Prims.int) + : term + = FStarC_Syntax_Subst.subst [NT(int_as_bv x, bv_to_name (int_as_bv y))] t diff --git a/stage0/ulib/ml/plugin/FStar_Sealed.ml b/stage0/ulib/ml/plugin/FStar_Sealed.ml new file mode 100644 index 00000000000..622ae81bcd3 --- /dev/null +++ b/stage0/ulib/ml/plugin/FStar_Sealed.ml @@ -0,0 +1,4 @@ +type 'a sealed = 'a +let seal x = x +let map_seal s f = f s +let bind_seal s f = f s diff --git a/stage0/ulib/reclaimable/FStar.ST.fst b/stage0/ulib/reclaimable/FStar.ST.fst deleted file mode 100644 index ba293b05a42..00000000000 --- a/stage0/ulib/reclaimable/FStar.ST.fst +++ /dev/null @@ -1,73 +0,0 @@ -(* - Copyright 2008-2014 Nikhil Swamy and Microsoft Research - - Licensed under the Apache License, Version 2.0 (the "License"); - you may not use this file except in compliance with the License. - You may obtain a copy of the License at - - http://www.apache.org/licenses/LICENSE-2.0 - - Unless required by applicable law or agreed to in writing, software - distributed under the License is distributed on an "AS IS" BASIS, - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. - See the License for the specific language governing permissions and - limitations under the License. -*) -module FStar.ST -#set-options "--max_fuel 0 --initial_fuel 0 --initial_ifuel 0 --max_ifuel 0" -open FStar.Set -open FStar.Heap -type ref (a:Type) = Heap.ref a - -// this intentionally does not preclude h' extending h with fresh refs -type modifies (mods:set aref) (h:heap) (h':heap) = - b2t (Heap.equal h' (concat h' (restrict h (complement mods)))) - -let st_pre = st_pre_h heap -let st_post a = st_post_h heap a -let st_wp a = st_wp_h heap a -new_effect STATE = STATE_h heap -unfold let lift_div_state (a:Type) (wp:pure_wp a) (p:st_post a) (h:heap) = wp (fun a -> p a h) -sub_effect DIV ~> STATE = lift_div_state - -effect State (a:Type) (wp:st_wp a) = - STATE a wp -effect ST (a:Type) (pre:st_pre) (post: (heap -> Tot (st_post a))) = - STATE a - (fun (p:st_post a) (h:heap) -> pre h /\ (forall a h1. (pre h /\ post h a h1) ==> p a h1)) (* WP *) -effect St (a:Type) = - ST a (fun h -> True) (fun h0 r h1 -> True) - -(* signatures WITH permissions *) -assume val alloc: #a:Type -> init:a -> ST (ref a) - (fun h -> True) - (fun h0 r h1 -> not(contains h0 r) /\ contains h1 r /\ h1==upd h0 r init) - -assume val read: #a:Type -> r:ref a -> ST a - (requires (fun h -> contains h r)) - (ensures (fun h0 x h1 -> h0==h1 /\ x==sel h0 r)) - -assume val write: #a:Type -> r:ref a -> v:a -> ST unit - (requires (fun h -> contains h r)) - (ensures (fun h0 x h1 -> h1==upd h0 r v)) - -assume val op_Colon_Equals: #a:Type -> r:ref a -> v:a -> ST unit - (requires (fun h -> contains h r)) - (ensures (fun h0 x h1 -> h1==upd h0 r v)) - -assume val free: #a:Type -> r:ref a -> ST unit - (requires (fun h -> contains h r)) - (ensures (fun h0 x h1 -> modifies !{r} h0 h1 /\ not(contains h1 r))) - -assume val get: unit -> State heap (fun 'post h -> 'post h h) - -assume val forget_ST: #a:Type -> #b:(a -> Type) - -> #req:(a -> heap -> Type) - -> #ens:(x:a -> heap -> b x -> heap -> Type) - -> $f:(x:a -> ST (b x) (req x) (ens x)) - -> Pure (x:a -> Div (b x) - (requires (forall h. req x h)) - (ensures (fun (y:b x) -> exists h0 h1. ens x h0 y h1))) - (requires (forall (x:a) (y:b x) h h'. - (req x h /\ ens x h y h' ==> modifies !{} h h'))) - (ensures (fun _ -> True)) diff --git a/stage0/version.txt b/stage0/version.txt new file mode 100644 index 00000000000..b5fba53fb3d --- /dev/null +++ b/stage0/version.txt @@ -0,0 +1 @@ +2025.02.06 diff --git a/version.txt b/version.txt index 1887bba38c2..b5fba53fb3d 100644 --- a/version.txt +++ b/version.txt @@ -1 +1 @@ -2025.01.17 +2025.02.06