diff options
147 files changed, 10661 insertions, 8592 deletions
@@ -19,7 +19,7 @@ _build/ /charon # We group everything here -bin +/bin # oasis generated files setup.data @@ -13,36 +13,30 @@ all: build-tests-verify nix # Variables customizable by the user #################################### -# Set this variable to any value to call Charon to regenerate the .llbc source -# files before running the tests -REGEN_LLBC ?= +# Paths to the executables we need for tests. They are overriden in CI. +AENEAS_EXE ?= $(PWD)/bin/aeneas +TEST_RUNNER_EXE ?= $(PWD)/bin/test_runner +CHARON_EXE ?= $(PWD)/charon/bin/charon -# The path to Charon -CHARON_HOME ?= ./charon +# The user can specify additional translation options for Aeneas. +AENEAS_OPTIONS ?= +CHARON_OPTIONS ?= -# The path to the Aeneas executable to run the tests - we need the ability to -# change this path for the Nix package. -AENEAS_EXE ?= bin/aeneas +# The directory thta contains the rust source files for tests. +INPUTS_DIR ?= tests/src +# The directory where to look for the .llbc files. +LLBC_DIR ?= $(PWD)/tests/llbc -# The user can specify additional translation options for Aeneas. -# By default we activate the (expensive) sanity checks. -OPTIONS ?= - -# The rules use (and update) the following variables -# -# The Charon test directory where to look for the .llbc files -CHARON_TEST_DIR ?= $(CHARON_HOME)/tests -# The options with which to call Charon -CHARON_OPTIONS = -# The backend sub-directory in which to generate the files -BACKEND_SUBDIR := -# The directory in which to extract the result of the translation -SUBDIR := +# In CI, we enforce formatting and activate the (expensive) sanity checks. +IN_CI ?= #################################### # The rules #################################### +# Never remove intermediate files +.SECONDARY: + # Build the compiler, after formatting the code .PHONY: build build: format build-dev @@ -53,7 +47,12 @@ build-test-verify: build test verify # Build the project, without formatting the code .PHONY: build-dev +ifdef IN_CI +build-dev: + @true +else build-dev: build-bin build-lib build-bin-dir doc +endif .PHONY: build-bin build-bin: check-charon @@ -63,11 +62,16 @@ build-bin: check-charon build-lib: check-charon cd compiler && dune build aeneas.cmxs +.PHONY: build-runner +build-runner: check-charon + cd tests/test_runner && dune build + .PHONY: build-bin-dir -build-bin-dir: build-bin build-lib +build-bin-dir: build-bin build-lib build-runner mkdir -p bin cp -f compiler/_build/default/main.exe bin/aeneas cp -f compiler/_build/default/main.exe bin/aeneas.cmxs + cp -f tests/test_runner/_build/default/run_test.exe bin/test_runner mkdir -p bin/backends/fstar mkdir -p bin/backends/coq cp -rf backends/fstar/*.fst* bin/backends/fstar/ @@ -100,207 +104,83 @@ check-charon: setup-charon: @./scripts/check-charon-install.sh --force +ifdef IN_CI +# In CI, error if formatting is not done. +format: RUSTFMT_FLAGS := --check +endif + +# Reformat the project files +.PHONY: format +format: + @# `|| `true` because the command returns an error if it changed anything, which we don't care about. + cd compiler && dune fmt || true + cd tests/test_runner && dune fmt || true + rustfmt $(RUSTFMT_FLAGS) $(INPUTS_DIR)/*.rs + cd $(INPUTS_DIR)/betree && cargo fmt $(RUSTFMT_FLAGS) .PHONY: clean clean: clean-generated cd compiler && dune clean + cd $(INPUTS_DIR)/betree && $(MAKE) clean -# Test the project by translating test files to F* -.PHONY: test -test: build-dev test-all +.PHONY: clean-generated +clean-generated: clean-generated-aeneas clean-generated-llbc -.PHONY: test-all -test-all: test-no_nested_borrows test-paper \ - test-hashmap test-hashmap_main \ - test-external test-constants \ - test-polonius_list test-betree_main \ - ctest-test-betree_main \ - test-loops \ - test-arrays test-traits test-bitwise test-demo +.PHONY: clean-generated-aeneas +clean-generated-aeneas: + @# We can't put this line in `tests/Makefile` otherwise it will detect itself. + @# FIXME: generation of hol4 files is deactivated so we don't delete those. + @# `|| true` to avoid failing if there are no generated files present. + grep -lR 'THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS' tests | grep -v '^tests/hol4' | xargs rm || true -.PHONY: clean-generated -clean-generated: - # We can't put this line in `tests/Makefile` otherwise it will detect itself. - # FIXME: generation of hol4 files is deactivated so we don't delete those. - grep -lR 'THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS' tests | grep -v '^tests/hol4' | xargs rm +.PHONY: clean-generated-llbc +clean-generated-llbc: + rm -rf $(LLBC_DIR) + +# ============================================================================= +# The tests. +# ============================================================================= + +# Test the project by translating test files to various backends. +.PHONY: test +test: build-dev test-all betree-tests + +# This runs the rust tests of the betree crate. +.PHONY: betree-tests +betree-tests: + cd $(INPUTS_DIR)/betree && $(MAKE) test # Verify the F* files generated by the translation .PHONY: verify verify: cd tests && $(MAKE) all -# Reformat the project -.PHONY: format -format: - @# `|| `true` because the command returns an error if it changed anything, which we don't care about. - cd compiler && dune fmt || true +# List the files and directories in `INPUTS_DIR` +INPUTS_LIST = $(wildcard $(INPUTS_DIR)/*) +# Remove the directory prefix, replace with `test-` +INPUTS_LIST := $(subst $(INPUTS_DIR)/,test-,$(INPUTS_LIST)) -# The commands to run Charon to generate the .llbc files -ifeq (, $(REGEN_LLBC)) -else -CHARON_CMD = cd $(CHARON_TEST_DIR) && $(MAKE) test-$* +# Run all the tests we found. +.PHONY: test-all +test-all: $(INPUTS_LIST) + +ifdef IN_CI +# In CI we do extra sanity checks. +test-%: AENEAS_OPTIONS += -checks endif -# The command to run Aeneas on the proper llbc file -AENEAS_CMD = $(AENEAS_EXE) $(CHARON_TEST_DIR)/llbc/$(FILE).llbc -dest tests/$(BACKEND_SUBDIR)/$(SUBDIR) $(OPTIONS) - - -# Add specific options to some tests -test-no_nested_borrows test-paper: \ - OPTIONS += -test-trans-units -test-no_nested_borrows test-paper: SUBDIR := misc -tfstar-no_nested_borrows tfstar-paper: -tlean-no_nested_borrows: SUBDIR := -tlean-paper: SUBDIR := -thol4-no_nested_borrows: SUBDIR := misc-no_nested_borrows -thol4-paper: SUBDIR := misc-paper - -test-arrays: OPTIONS += -test-arrays: SUBDIR := arrays -tfstar-arrays: OPTIONS += -decreases-clauses -template-clauses -split-files -tcoq-arrays: OPTIONS += -use-fuel -tlean-arrays: SUBDIR := -tlean-arrays: OPTIONS += -thol4-arrays: OPTIONS += - -test-traits: OPTIONS += -test-traits: SUBDIR := traits -tfstar-traits: OPTIONS += -decreases-clauses -template-clauses -tcoq-traits: OPTIONS += -tlean-traits: SUBDIR := -tlean-traits: OPTIONS += -thol4-traits: OPTIONS += - -test-loops: OPTIONS += -test-loops: SUBDIR := misc -tfstar-loops: OPTIONS += -decreases-clauses -template-clauses -split-files -tcoq-loops: OPTIONS += -use-fuel -tlean-loops: SUBDIR := -thol4-loops: SUBDIR := misc-loops - -test-demo: OPTIONS += -test-demo: SUBDIR := demo -tfstar-demo: OPTIONS += -use-fuel -tcoq-demo: OPTIONS += -use-fuel -tlean-demo: SUBDIR := Demo -thol4-demo: OPTIONS += - -# TODO: reactivate -test-trans-units -test-hashmap: OPTIONS += -split-files -test-hashmap: SUBDIR := hashmap -tfstar-hashmap: OPTIONS += -decreases-clauses -template-clauses -tcoq-hashmap: OPTIONS += -use-fuel -tlean-hashmap: SUBDIR := -tlean-hashmap: OPTIONS += -no-gen-lib-entry # We add a custom import in the Hashmap.lean file: we do not want to overwrite it -thol4-hashmap: OPTIONS += - -# TODO: reactivate -test-trans-units -test-hashmap_main: OPTIONS += -state -split-files -test-hashmap_main: SUBDIR := hashmap_on_disk -tfstar-hashmap_main: OPTIONS += -decreases-clauses -template-clauses -tcoq-hashmap_main: OPTIONS += -use-fuel -tlean-hashmap_main: SUBDIR := -thol4-hashmap_main: OPTIONS += - -test-polonius_list: OPTIONS += -test-trans-units -test-polonius_list: SUBDIR := misc -tfstar-polonius_list: OPTIONS += -tcoq-polonius_list: OPTIONS += -tlean-polonius_list: SUBDIR := -tlean-polonius_list: OPTIONS += -thol4-polonius_list: SUBDIR := misc-polonius_list -thol4-polonius_list: OPTIONS += - -test-constants: OPTIONS += -test-trans-units -test-constants: SUBDIR := misc -tfstar-constants: OPTIONS += -tcoq-constants: OPTIONS += -tlean-constants: SUBDIR := -tlean-constants: OPTIONS += -thol4-constants: SUBDIR := misc-constants -thol4-constants: OPTIONS += - -test-external: OPTIONS += -test-trans-units -state -split-files -test-external: SUBDIR := misc -tfstar-external: OPTIONS += -tcoq-external: OPTIONS += -tlean-external: SUBDIR := -tlean-external: OPTIONS += -thol4-external: SUBDIR := misc-external -thol4-external: OPTIONS += - -test-bitwise: OPTIONS += -test-trans-units -test-bitwise: SUBDIR := misc -tfstar-bitwise: OPTIONS += -tcoq-bitwise: OPTIONS += -tlean-bitwise: SUBDIR := -tlean-bitwise: OPTIONS += -thol4-bitwise: SUBDIR := misc-bitwise -thol4-bitwise: OPTIONS += - -BETREE_FSTAR_OPTIONS = -decreases-clauses -template-clauses -test-betree_main: OPTIONS += -backward-no-state-update -test-trans-units -state -split-files -test-betree_main: SUBDIR:=betree -tfstar-betree_main: OPTIONS += $(BETREE_FSTAR_OPTIONS) -tcoq-betree_main: OPTIONS += -use-fuel -tlean-betree_main: SUBDIR := -tlean-betree_main: OPTIONS += -thol4-betree_main: OPTIONS += - -# Additional, *c*ustom test on the betree: translate it without `-backward-no-state-update`. -# This generates very ugly code, but is good to test the translation. -.PHONY: ctest-test-betree_main -ctest-test-betree_main: test-betree_main -ctest-test-betree_main: OPTIONS += -backend fstar -test-trans-units -state -split-files -ctest-test-betree_main: OPTIONS += $(BETREE_FSTAR_OPTIONS) -ctest-test-betree_main: BACKEND_SUBDIR := "fstar" -ctest-test-betree_main: SUBDIR:=betree_back_stateful -ctest-test-betree_main: FILE = betree_main -ctest-test-betree_main: - $(AENEAS_CMD) - -# Generic rules to extract the LLBC from a rust file -# We use the rules in Charon's Makefile to generate the .llbc files: the options -# vary with the test files. -.PHONY: gen-llbc-% -gen-llbc-%: - $(CHARON_CMD) - -# Generic rules to test the translation of an LLBC file. +# Translate the given rust file to available backends. The test runner decides +# which backends to use and sets test-specific options. +# Note: the tests have the fulle file name: `test-arrays.rs`, `test-loops.rs`, `test-betree`. .PHONY: test-% -test-%: FILE = $* -test-%: gen-llbc-% tfstar-% tcoq-% tlean-% thol4-% +test-%: build-dev + $(TEST_RUNNER_EXE) $(CHARON_EXE) $(AENEAS_EXE) $(LLBC_DIR) $(INPUTS_DIR)/"$*" $(AENEAS_OPTIONS) echo "# Test $* done" -.PHONY: tfstar-% -tfstar-%: OPTIONS += -backend fstar -tfstar-%: BACKEND_SUBDIR := fstar -tfstar-%: - $(AENEAS_CMD) - -.PHONY: tcoq-% -tcoq-%: OPTIONS += -backend coq -tcoq-%: BACKEND_SUBDIR := coq -tcoq-%: - $(AENEAS_CMD) - -.PHONY: tlean-% -tlean-%: OPTIONS += -backend lean -tlean-%: BACKEND_SUBDIR := lean -tlean-%: - $(AENEAS_CMD) - -# TODO: reactivate HOL4 once traits are parameterized by their associated types -.PHONY: thol4-% -thol4-%: OPTIONS += -backend hol4 -thol4-%: BACKEND_SUBDIR := hol4 -thol4-%: - echo Ignoring the $* test for HOL4 - -#thol4-%: -# $(AENEAS_CMD) - -# Nix - TODO: add the lean tests +# ============================================================================= +# Nix +# ============================================================================= +# TODO: add the lean tests .PHONY: nix nix: nix build && nix flake check diff --git a/backends/lean/Base/Arith/Int.lean b/backends/lean/Base/Arith/Int.lean index 5a85dff0..4a3db5f8 100644 --- a/backends/lean/Base/Arith/Int.lean +++ b/backends/lean/Base/Arith/Int.lean @@ -3,22 +3,25 @@ import Lean import Lean.Meta.Tactic.Simp import Init.Data.List.Basic -import Mathlib.Tactic.Linarith --- TODO: there is no Omega tactic for now - it seems it hasn't been ported yet ---import Mathlib.Tactic.Omega import Base.Utils import Base.Arith.Base namespace Arith open Utils +open Lean Lean.Elab Lean.Meta + +/- We can introduce a term in the context. + For instance, if we find `x : U32` in the context we can introduce `0 ≤ x ∧ x ≤ U32.max` --- Remark: I tried a version of the shape `HasScalarProp {a : Type} (x : a)` --- but the lookup didn't work + Remark: I tried a version of the shape `HasScalarProp {a : Type} (x : a)` + but the lookup didn't work. + -/ class HasIntProp (a : Sort u) where prop_ty : a → Prop prop : ∀ x:a, prop_ty x +/- Proposition with implications: if we find P we can introduce Q in the context -/ class PropHasImp (x : Prop) where concl : Prop prop : x → concl @@ -27,14 +30,9 @@ instance (p : Int → Prop) : HasIntProp (Subtype p) where prop_ty := λ x => p x prop := λ x => x.property --- This also works for `x ≠ y` because this expression reduces to `¬ x = y` --- and `Ne` is marked as `reducible` -instance (x y : Int) : PropHasImp (¬ x = y) where - concl := x < y ∨ x > y - prop := λ (h:x ≠ y) => ne_is_lt_or_gt h - --- Check if a proposition is a linear integer proposition. --- We notably use this to check the goals. +/- Check if a proposition is a linear integer proposition. + We notably use this to check the goals: this is useful to filter goals that + are unlikely to be solvable with arithmetic tactics. -/ class IsLinearIntProp (x : Prop) where instance (x y : Int) : IsLinearIntProp (x < y) where @@ -43,17 +41,35 @@ instance (x y : Int) : IsLinearIntProp (x ≤ y) where instance (x y : Int) : IsLinearIntProp (x ≥ y) where instance (x y : Int) : IsLinearIntProp (x ≥ y) where instance (x y : Int) : IsLinearIntProp (x = y) where -/- It seems we don't need to do any special preprocessing when the *goal* - has the following shape - I guess `linarith` automatically calls `intro` -/ -instance (x y : Int) : IsLinearIntProp (¬ x = y) where -open Lean Lean.Elab Lean.Meta +instance (x y : Nat) : IsLinearIntProp (x < y) where +instance (x y : Nat) : IsLinearIntProp (x > y) where +instance (x y : Nat) : IsLinearIntProp (x ≤ y) where +instance (x y : Nat) : IsLinearIntProp (x ≥ y) where +instance (x y : Nat) : IsLinearIntProp (x ≥ y) where +instance (x y : Nat) : IsLinearIntProp (x = y) where --- Explore a term by decomposing the applications (we explore the applied --- functions and their arguments, but ignore lambdas, forall, etc. - --- should we go inside?). --- Remark: we pretend projections are applications, and explore the projected --- terms. +instance : IsLinearIntProp False where +instance (p : Prop) [IsLinearIntProp p] : IsLinearIntProp (¬ p) where +instance (p q : Prop) [IsLinearIntProp p] [IsLinearIntProp q] : IsLinearIntProp (p ∨ q) where +instance (p q : Prop) [IsLinearIntProp p] [IsLinearIntProp q] : IsLinearIntProp (p ∧ q) where +-- We use the one below for goals +instance (p q : Prop) [IsLinearIntProp p] [IsLinearIntProp q] : IsLinearIntProp (p → q) where + +-- Check if the goal is a linear arithmetic goal +def goalIsLinearInt : Tactic.TacticM Bool := do + Tactic.withMainContext do + let gty ← Tactic.getMainTarget + match ← trySynthInstance (← mkAppM ``IsLinearIntProp #[gty]) with + | .some _ => pure true + | _ => pure false + +/- Explore a term by decomposing the applications (we explore the applied + functions and their arguments, but ignore lambdas, forall, etc. - + should we go inside?). + + Remark: we pretend projections are applications, and explore the projected + terms. -/ partial def foldTermApps (k : α → Expr → MetaM α) (s : α) (e : Expr) : MetaM α := do -- Explore the current expression let e := e.consumeMData @@ -68,8 +84,8 @@ partial def foldTermApps (k : α → Expr → MetaM α) (s : α) (e : Expr) : Me args.foldlM (foldTermApps k) s | _ => pure s --- Provided a function `k` which lookups type class instances on an expression, --- collect all the instances lookuped by applying `k` on the sub-expressions of `e`. +/- Provided a function `k` which lookups type class instances on an expression, + collect all the instances lookuped by applying `k` on the sub-expressions of `e`. -/ def collectInstances (k : Expr → MetaM (Option Expr)) (s : HashSet Expr) (e : Expr) : MetaM (HashSet Expr) := do let k s e := do @@ -78,8 +94,8 @@ def collectInstances | some i => pure (s.insert i) foldTermApps k s e --- Similar to `collectInstances`, but explores all the local declarations in the --- main context. +/- Similar to `collectInstances`, but explores all the local declarations in the + main context. -/ def collectInstancesFromMainCtx (k : Expr → MetaM (Option Expr)) : Tactic.TacticM (HashSet Expr) := do Tactic.withMainContext do -- Get the local context @@ -152,6 +168,9 @@ example (x y : Int) (_ : x ≠ y) (_ : ¬ x = y) : True := by display_prop_has_imp_instances simp +example (x y : Int) (h0 : x ≤ y) (h1 : x ≠ y) : x < y := by + omega + -- Lookup instances in a context and introduce them with additional declarations. def introInstances (declToUnfold : Name) (lookup : Expr → MetaM (Option Expr)) : Tactic.TacticM (Array Expr) := do let hs ← collectInstancesFromMainCtx lookup @@ -174,60 +193,33 @@ def introHasIntPropInstances : Tactic.TacticM (Array Expr) := do elab "intro_has_int_prop_instances" : tactic => do let _ ← introHasIntPropInstances +def introPropHasImpInstances : Tactic.TacticM (Array Expr) := do + trace[Arith] "Introducing the PropHasImp instances" + introInstances ``PropHasImp.concl lookupPropHasImp + -- Lookup the instances of `PropHasImp for all the sub-expressions in the context, -- and introduce the corresponding assumptions elab "intro_prop_has_imp_instances" : tactic => do - trace[Arith] "Introducing the PropHasImp instances" - let _ ← introInstances ``PropHasImp.concl lookupPropHasImp + let _ ← introPropHasImpInstances -example (x y : Int) (h0 : x ≤ y) (h1 : x ≠ y) : x < y := by - intro_prop_has_imp_instances - rename_i h - split_disj h - . linarith - . linarith - -/- Boosting a bit the linarith tac. - - We do the following: - - for all the assumptions of the shape `(x : Int) ≠ y` or `¬ (x = y), we - introduce two goals with the assumptions `x < y` and `x > y` - TODO: we could create a PR for mathlib. +/- Boosting a bit the `omega` tac. -/ def intTacPreprocess (extraPreprocess : Tactic.TacticM Unit) : Tactic.TacticM Unit := do Tactic.withMainContext do - -- Lookup the instances of PropHasImp (this is how we detect assumptions - -- of the proper shape), introduce assumptions in the context and split - -- on those - -- TODO: get rid of the assumptions that we split - let rec splitOnAsms (asms : List Expr) : Tactic.TacticM Unit := - match asms with - | [] => pure () - | asm :: asms => - let k := splitOnAsms asms - Utils.splitDisjTac asm k k - -- Introduce the scalar bounds + -- Introduce the instances of `HasIntProp` let _ ← introHasIntPropInstances - -- Extra preprocessing, before we split on the disjunctions + -- Introduce the instances of `PropHasImp` + let _ ← introPropHasImpInstances + -- Extra preprocessing extraPreprocess - -- Split - note that the extra-preprocessing step might actually have - -- proven the goal (by doing simplifications for instance) - Tactic.allGoals do - let asms ← introInstances ``PropHasImp.concl lookupPropHasImp - splitOnAsms asms.toList + -- Reduce all the terms in the goal - note that the extra preprocessing step + -- might have proven the goal, hence the `Tactic.allGoals` + Tactic.allGoals do tryTac (dsimpAt false [] [] [] Tactic.Location.wildcard) elab "int_tac_preprocess" : tactic => intTacPreprocess (do pure ()) --- Check if the goal is a linear arithmetic goal -def goalIsLinearInt : Tactic.TacticM Bool := do - Tactic.withMainContext do - let gty ← Tactic.getMainTarget - match ← trySynthInstance (← mkAppM ``IsLinearIntProp #[gty]) with - | .some _ => pure true - | _ => pure false - -def intTac (splitGoalConjs : Bool) (extraPreprocess : Tactic.TacticM Unit) : Tactic.TacticM Unit := do +def intTac (tacName : String) (splitGoalConjs : Bool) (extraPreprocess : Tactic.TacticM Unit) : Tactic.TacticM Unit := do Tactic.withMainContext do Tactic.focus do let g ← Tactic.getMainGoal @@ -243,31 +235,15 @@ def intTac (splitGoalConjs : Bool) (extraPreprocess : Tactic.TacticM Unit) : Ta -- Split the conjunctions in the goal if splitGoalConjs then Tactic.allGoals (Utils.repeatTac Utils.splitConjTarget) -- Call linarith - let linarith := do - let cfg : Linarith.LinarithConfig := { - -- We do this with our custom preprocessing - splitNe := false - } - Tactic.liftMetaFinishingTactic <| Linarith.linarith false [] cfg Tactic.allGoals do - -- We check if the goal is a linear arithmetic goal: if yes, we directly - -- call linarith, otherwise we first apply exfalso (we do this because - -- linarith is too general and sometimes fails to do this correctly). - if ← goalIsLinearInt then do - trace[Arith] "linarith goal: {← Tactic.getMainGoal}" - linarith - else do + try do Tactic.Omega.omegaTactic {} + catch _ => let g ← Tactic.getMainGoal - let gs ← g.apply (Expr.const ``False.elim [.zero]) - let goals ← Tactic.getGoals - Tactic.setGoals (gs ++ goals) - Tactic.allGoals do - trace[Arith] "linarith goal: {← Tactic.getMainGoal}" - linarith + throwError "{tacName} failed to prove the goal:\n{g}" elab "int_tac" args:(" split_goal"?): tactic => let split := args.raw.getArgs.size > 0 - intTac split (do pure ()) + intTac "int_tac" split (do pure ()) -- For termination proofs syntax "int_decr_tac" : tactic @@ -280,19 +256,11 @@ macro_rules | apply Arith.to_int_sub_to_nat_lt) <;> simp_all <;> int_tac) -example (x : Int) (h0: 0 ≤ x) (h1: x ≠ 0) : 0 < x := by - int_tac_preprocess - linarith - linarith - -example (x : Int) (h0: 0 ≤ x) (h1: x ≠ 0) : 0 < x := by - int_tac - --- Checking that things append correctly when there are several disjunctions +-- Checking that things happen correctly when there are several disjunctions example (x y : Int) (h0: 0 ≤ x) (h1: x ≠ 0) (h2 : 0 ≤ y) (h3 : y ≠ 0) : 0 < x ∧ 0 < y := by int_tac split_goal --- Checking that things append correctly when there are several disjunctions +-- Checking that things happen correctly when there are several disjunctions example (x y : Int) (h0: 0 ≤ x) (h1: x ≠ 0) (h2 : 0 ≤ y) (h3 : y ≠ 0) : 0 < x ∧ 0 < y ∧ x + y ≥ 2 := by int_tac split_goal diff --git a/backends/lean/Base/Arith/Scalar.lean b/backends/lean/Base/Arith/Scalar.lean index 9441be86..86b2e216 100644 --- a/backends/lean/Base/Arith/Scalar.lean +++ b/backends/lean/Base/Arith/Scalar.lean @@ -38,7 +38,7 @@ elab "scalar_tac_preprocess" : tactic => -- A tactic to solve linear arithmetic goals in the presence of scalars def scalarTac (splitGoalConjs : Bool) : Tactic.TacticM Unit := do - intTac splitGoalConjs scalarTacExtraPreprocess + intTac "scalar_tac" splitGoalConjs scalarTacExtraPreprocess elab "scalar_tac" : tactic => scalarTac false diff --git a/backends/lean/Base/Utils.lean b/backends/lean/Base/Utils.lean index eacfe72b..7ae5a832 100644 --- a/backends/lean/Base/Utils.lean +++ b/backends/lean/Base/Utils.lean @@ -658,6 +658,12 @@ example (h : ∃ x y z, x + y + z ≥ 0) : ∃ x, x ≥ 0 := by rename_i x y z exists x + y + z +/- Initialize a context for the `simp` function. + + The initialization of the context is adapted from `Tactic.elabSimpArgs`. + Something very annoying is that there is no function which allows to + initialize a simp context without doing an elaboration - as a consequence + we write our own here. -/ def mkSimpCtx (simpOnly : Bool) (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVarId) : Tactic.TacticM Simp.Context := do -- Initialize either with the builtin simp theorems or with all the simp theorems @@ -689,7 +695,6 @@ def mkSimpCtx (simpOnly : Bool) (declsToUnfold : List Name) (thms : List Name) ( let congrTheorems ← getSimpCongrTheorems pure { simpTheorems := #[simpThms], congrTheorems } - inductive Location where /-- Apply the tactic everywhere. Same as `Tactic.Location.wildcard` -/ | wildcard @@ -725,11 +730,7 @@ where | some (_, mvarId) => replaceMainGoal [mvarId] return usedSimps -/- Call the simp tactic. - The initialization of the context is adapted from Tactic.elabSimpArgs. - Something very annoying is that there is no function which allows to - initialize a simp context without doing an elaboration - as a consequence - we write our own here. -/ +/- Call the simp tactic. -/ def simpAt (simpOnly : Bool) (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVarId) (loc : Location) : Tactic.TacticM Unit := do @@ -738,6 +739,15 @@ def simpAt (simpOnly : Bool) (declsToUnfold : List Name) (thms : List Name) (hyp -- Apply the simplifier let _ ← customSimpLocation ctx (discharge? := .none) loc +/- Call the dsimp tactic. -/ +def dsimpAt (simpOnly : Bool) (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVarId) + (loc : Tactic.Location) : + Tactic.TacticM Unit := do + -- Initialize the simp context + let ctx ← mkSimpCtx simpOnly declsToUnfold thms hypsToUse + -- Apply the simplifier + dsimpLocation ctx loc + -- Call the simpAll tactic def simpAll (declsToUnfold : List Name) (thms : List Name) (hypsToUse : List FVarId) : Tactic.TacticM Unit := do @@ -1,2 +1,2 @@ # This is the commit from https://github.com/AeneasVerif/charon that should be used with this version of aeneas. -c049120c15567d22520c94f570363eb4948d849f +a5fda598f359a2b85e044a884fd977d75f4578b4 diff --git a/compiler/AssociatedTypes.ml b/compiler/AssociatedTypes.ml index 27425a51..1c335d8d 100644 --- a/compiler/AssociatedTypes.ml +++ b/compiler/AssociatedTypes.ml @@ -34,7 +34,7 @@ end module TyMap = Collections.MakeMap (TyOrd) -let compute_norm_trait_types_from_preds (meta : Meta.meta option) +let compute_norm_trait_types_from_preds (span : Meta.span option) (trait_type_constraints : trait_type_constraint list) : ty TraitTypeRefMap.t = (* Compute a union-find structure by recursively exploring the predicates and clauses *) @@ -51,9 +51,9 @@ let compute_norm_trait_types_from_preds (meta : Meta.meta option) (* Sanity check: the type constraint can't make use of regions - Remark that it would be enough to only visit the field [ty] of the trait type constraint, but for safety we visit all the fields *) - sanity_check_opt_meta __FILE__ __LINE__ + sanity_check_opt_span __FILE__ __LINE__ (trait_type_constraint_no_regions c) - meta; + span; let { trait_ref; type_name; ty } : trait_type_constraint = c in let trait_ty = TTraitType (trait_ref, type_name) in let trait_ty_ref = get_ref trait_ty in @@ -82,10 +82,10 @@ let compute_norm_trait_types_from_preds (meta : Meta.meta option) in TraitTypeRefMap.of_list rbindings -let ctx_add_norm_trait_types_from_preds (meta : Meta.meta) (ctx : eval_ctx) +let ctx_add_norm_trait_types_from_preds (span : Meta.span) (ctx : eval_ctx) (trait_type_constraints : trait_type_constraint list) : eval_ctx = let norm_trait_types = - compute_norm_trait_types_from_preds (Some meta) trait_type_constraints + compute_norm_trait_types_from_preds (Some span) trait_type_constraints in { ctx with norm_trait_types } @@ -95,7 +95,7 @@ let rec trait_instance_id_is_local_clause (id : trait_instance_id) : bool = match id with | Self | Clause _ -> true | TraitImpl _ | BuiltinOrAuto _ | TraitRef _ | UnknownTrait _ | FnPointer _ - | Closure _ -> + | Closure _ | Unsolved _ -> false | ParentClause (id, _, _) | ItemClause (id, _, _, _) -> trait_instance_id_is_local_clause id @@ -104,7 +104,7 @@ let rec trait_instance_id_is_local_clause (id : trait_instance_id) : bool = but they should be applied to types without regions. *) type norm_ctx = { - meta : Meta.meta option; + span : Meta.span option; norm_trait_types : ty TraitTypeRefMap.t; type_decls : type_decl TypeDeclId.Map.t; fun_decls : fun_decl FunDeclId.Map.t; @@ -241,9 +241,9 @@ let rec norm_ctx_normalize_ty (ctx : norm_ctx) (ty : ty) : ty = match trait_ref.trait_id with | TraitRef { trait_id = TraitImpl impl_id; generics = ref_generics; _ } -> - cassert_opt_meta __FILE__ __LINE__ + cassert_opt_span __FILE__ __LINE__ (ref_generics = empty_generic_args) - ctx.meta "Higher order trait types are not supported yet"; + ctx.span "Higher order trait types are not supported yet"; log#ldebug (lazy ("norm_ctx_normalize_ty: trait type: trait ref: " @@ -283,9 +283,9 @@ let rec norm_ctx_normalize_ty (ctx : norm_ctx) (ty : ty) : ty = ^ trait_ref_to_string ctx trait_ref ^ "\n- raw trait ref:\n" ^ show_trait_ref trait_ref)); (* We can't project *) - sanity_check_opt_meta __FILE__ __LINE__ + sanity_check_opt_span __FILE__ __LINE__ (trait_instance_id_is_local_clause trait_ref.trait_id) - ctx.meta; + ctx.span; TTraitType (trait_ref, type_name) in let tr : trait_type_ref = { trait_ref; type_name } in @@ -353,9 +353,9 @@ and norm_ctx_normalize_trait_instance_id (ctx : norm_ctx) match impl with | None -> (* This is actually a local clause *) - sanity_check_opt_meta __FILE__ __LINE__ + sanity_check_opt_span __FILE__ __LINE__ (trait_instance_id_is_local_clause inst_id) - ctx.meta; + ctx.span; (ParentClause (inst_id, decl_id, clause_id), None) | Some impl -> (* We figure out the parent clause by doing the following: @@ -386,9 +386,9 @@ and norm_ctx_normalize_trait_instance_id (ctx : norm_ctx) match impl with | None -> (* This is actually a local clause *) - sanity_check_opt_meta __FILE__ __LINE__ + sanity_check_opt_span __FILE__ __LINE__ (trait_instance_id_is_local_clause inst_id) - ctx.meta; + ctx.span; (ItemClause (inst_id, decl_id, item_name, clause_id), None) | Some impl -> (* We figure out the item clause by doing the following: @@ -428,12 +428,12 @@ and norm_ctx_normalize_trait_instance_id (ctx : norm_ctx) | TraitRef trait_ref -> (* The trait instance id necessarily refers to a local sub-clause. We can't project over it and can only peel off the [TraitRef] wrapper *) - sanity_check_opt_meta __FILE__ __LINE__ + sanity_check_opt_span __FILE__ __LINE__ (trait_instance_id_is_local_clause trait_ref.trait_id) - ctx.meta; - sanity_check_opt_meta __FILE__ __LINE__ + ctx.span; + sanity_check_opt_span __FILE__ __LINE__ (trait_ref.generics = empty_generic_args) - ctx.meta; + ctx.span; (trait_ref.trait_id, None) | FnPointer ty -> let ty = norm_ctx_normalize_ty ctx ty in @@ -443,7 +443,7 @@ and norm_ctx_normalize_trait_instance_id (ctx : norm_ctx) | Closure (fid, generics) -> let generics = norm_ctx_normalize_generic_args ctx generics in (Closure (fid, generics), None) - | UnknownTrait _ -> + | Unsolved _ | UnknownTrait _ -> (* This is actually an error case *) (id, None) @@ -482,9 +482,9 @@ and norm_ctx_normalize_trait_ref (ctx : norm_ctx) (trait_ref : trait_ref) : (lazy ("norm_ctx_normalize_trait_ref: normalized to: " ^ trait_ref_to_string ctx trait_ref)); - sanity_check_opt_meta __FILE__ __LINE__ + sanity_check_opt_span __FILE__ __LINE__ (generics = empty_generic_args) - ctx.meta; + ctx.span; trait_ref (* Not sure this one is really necessary *) @@ -501,9 +501,9 @@ let norm_ctx_normalize_trait_type_constraint (ctx : norm_ctx) let ty = norm_ctx_normalize_ty ctx ty in { trait_ref; type_name; ty } -let mk_norm_ctx (meta : Meta.meta) (ctx : eval_ctx) : norm_ctx = +let mk_norm_ctx (span : Meta.span) (ctx : eval_ctx) : norm_ctx = { - meta = Some meta; + span = Some span; norm_trait_types = ctx.norm_trait_types; type_decls = ctx.type_ctx.type_decls; fun_decls = ctx.fun_ctx.fun_decls; @@ -514,20 +514,20 @@ let mk_norm_ctx (meta : Meta.meta) (ctx : eval_ctx) : norm_ctx = const_generic_vars = ctx.const_generic_vars; } -let ctx_normalize_ty (meta : Meta.meta) (ctx : eval_ctx) (ty : ty) : ty = - norm_ctx_normalize_ty (mk_norm_ctx meta ctx) ty +let ctx_normalize_ty (span : Meta.span) (ctx : eval_ctx) (ty : ty) : ty = + norm_ctx_normalize_ty (mk_norm_ctx span ctx) ty (** Normalize a type and erase the regions at the same time *) -let ctx_normalize_erase_ty (meta : Meta.meta) (ctx : eval_ctx) (ty : ty) : ty = - let ty = ctx_normalize_ty meta ctx ty in +let ctx_normalize_erase_ty (span : Meta.span) (ctx : eval_ctx) (ty : ty) : ty = + let ty = ctx_normalize_ty span ctx ty in Subst.erase_regions ty -let ctx_normalize_trait_type_constraint (meta : Meta.meta) (ctx : eval_ctx) +let ctx_normalize_trait_type_constraint (span : Meta.span) (ctx : eval_ctx) (ttc : trait_type_constraint) : trait_type_constraint = - norm_ctx_normalize_trait_type_constraint (mk_norm_ctx meta ctx) ttc + norm_ctx_normalize_trait_type_constraint (mk_norm_ctx span ctx) ttc (** Same as [type_decl_get_instantiated_variants_fields_types] but normalizes the types *) -let type_decl_get_inst_norm_variants_fields_rtypes (meta : Meta.meta) +let type_decl_get_inst_norm_variants_fields_rtypes (span : Meta.span) (ctx : eval_ctx) (def : type_decl) (generics : generic_args) : (VariantId.id option * ty list) list = let res = @@ -535,51 +535,51 @@ let type_decl_get_inst_norm_variants_fields_rtypes (meta : Meta.meta) in List.map (fun (variant_id, types) -> - (variant_id, List.map (ctx_normalize_ty meta ctx) types)) + (variant_id, List.map (ctx_normalize_ty span ctx) types)) res (** Same as [type_decl_get_instantiated_field_types] but normalizes the types *) -let type_decl_get_inst_norm_field_rtypes (meta : Meta.meta) (ctx : eval_ctx) +let type_decl_get_inst_norm_field_rtypes (span : Meta.span) (ctx : eval_ctx) (def : type_decl) (opt_variant_id : VariantId.id option) (generics : generic_args) : ty list = let types = Subst.type_decl_get_instantiated_field_types def opt_variant_id generics in - List.map (ctx_normalize_ty meta ctx) types + List.map (ctx_normalize_ty span ctx) types (** Same as [ctx_adt_value_get_instantiated_field_rtypes] but normalizes the types *) -let ctx_adt_value_get_inst_norm_field_rtypes (meta : Meta.meta) (ctx : eval_ctx) +let ctx_adt_value_get_inst_norm_field_rtypes (span : Meta.span) (ctx : eval_ctx) (adt : adt_value) (id : type_id) (generics : generic_args) : ty list = let types = - Subst.ctx_adt_value_get_instantiated_field_types meta ctx adt id generics + Subst.ctx_adt_value_get_instantiated_field_types span ctx adt id generics in - List.map (ctx_normalize_ty meta ctx) types + List.map (ctx_normalize_ty span ctx) types (** Same as [ctx_adt_value_get_instantiated_field_types] but normalizes the types and erases the regions. *) -let type_decl_get_inst_norm_field_etypes (meta : Meta.meta) (ctx : eval_ctx) +let type_decl_get_inst_norm_field_etypes (span : Meta.span) (ctx : eval_ctx) (def : type_decl) (opt_variant_id : VariantId.id option) (generics : generic_args) : ty list = let types = Subst.type_decl_get_instantiated_field_types def opt_variant_id generics in - let types = List.map (ctx_normalize_ty meta ctx) types in + let types = List.map (ctx_normalize_ty span ctx) types in List.map Subst.erase_regions types (** Same as [ctx_adt_get_instantiated_field_types] but normalizes the types and erases the regions. *) -let ctx_adt_get_inst_norm_field_etypes (meta : Meta.meta) (ctx : eval_ctx) +let ctx_adt_get_inst_norm_field_etypes (span : Meta.span) (ctx : eval_ctx) (def_id : TypeDeclId.id) (opt_variant_id : VariantId.id option) (generics : generic_args) : ty list = let types = Subst.ctx_adt_get_instantiated_field_types ctx def_id opt_variant_id generics in - let types = List.map (ctx_normalize_ty meta ctx) types in + let types = List.map (ctx_normalize_ty span ctx) types in List.map Subst.erase_regions types (** Same as [substitute_signature] but normalizes the types *) -let ctx_subst_norm_signature (meta : Meta.meta) (ctx : eval_ctx) +let ctx_subst_norm_signature (span : Meta.span) (ctx : eval_ctx) (asubst : RegionGroupId.id -> AbstractionId.id) (r_subst : RegionVarId.id -> RegionId.id) (ty_subst : TypeVarId.id -> ty) (cg_subst : ConstGenericVarId.id -> const_generic) @@ -591,11 +591,11 @@ let ctx_subst_norm_signature (meta : Meta.meta) (ctx : eval_ctx) sg regions_hierarchy in let { regions_hierarchy; inputs; output; trait_type_constraints } = sg in - let inputs = List.map (ctx_normalize_ty meta ctx) inputs in - let output = ctx_normalize_ty meta ctx output in + let inputs = List.map (ctx_normalize_ty span ctx) inputs in + let output = ctx_normalize_ty span ctx output in let trait_type_constraints = List.map - (ctx_normalize_trait_type_constraint meta ctx) + (ctx_normalize_trait_type_constraint span ctx) trait_type_constraints in { regions_hierarchy; inputs; output; trait_type_constraints } diff --git a/compiler/Contexts.ml b/compiler/Contexts.ml index 0a62f5ef..745c22b6 100644 --- a/compiler/Contexts.ml +++ b/compiler/Contexts.ml @@ -286,7 +286,7 @@ let lookup_const_generic_var (ctx : eval_ctx) (vid : ConstGenericVarId.id) : ConstGenericVarId.nth ctx.const_generic_vars vid (** Lookup a variable in the current frame *) -let env_lookup_var (meta : Meta.meta) (env : env) (vid : VarId.id) : +let env_lookup_var (span : Meta.span) (env : env) (vid : VarId.id) : var_binder * typed_value = (* We take care to stop at the end of current frame: different variables in different frames can have the same id! @@ -298,13 +298,13 @@ let env_lookup_var (meta : Meta.meta) (env : env) (vid : VarId.id) : | EBinding (BVar var, v) :: env' -> if var.index = vid then (var, v) else lookup env' | (EBinding (BDummy _, _) | EAbs _) :: env' -> lookup env' - | EFrame :: _ -> craise __FILE__ __LINE__ meta "End of frame" + | EFrame :: _ -> craise __FILE__ __LINE__ span "End of frame" in lookup env -let ctx_lookup_var_binder (meta : Meta.meta) (ctx : eval_ctx) (vid : VarId.id) : +let ctx_lookup_var_binder (span : Meta.span) (ctx : eval_ctx) (vid : VarId.id) : var_binder = - fst (env_lookup_var meta ctx.env vid) + fst (env_lookup_var span ctx.env vid) let ctx_lookup_type_decl (ctx : eval_ctx) (tid : TypeDeclId.id) : type_decl = TypeDeclId.Map.find tid ctx.type_ctx.type_decls @@ -323,14 +323,14 @@ let ctx_lookup_trait_impl (ctx : eval_ctx) (id : TraitImplId.id) : trait_impl = TraitImplId.Map.find id ctx.trait_impls_ctx.trait_impls (** Retrieve a variable's value in the current frame *) -let env_lookup_var_value (meta : Meta.meta) (env : env) (vid : VarId.id) : +let env_lookup_var_value (span : Meta.span) (env : env) (vid : VarId.id) : typed_value = - snd (env_lookup_var meta env vid) + snd (env_lookup_var span env vid) (** Retrieve a variable's value in an evaluation context *) -let ctx_lookup_var_value (meta : Meta.meta) (ctx : eval_ctx) (vid : VarId.id) : +let ctx_lookup_var_value (span : Meta.span) (ctx : eval_ctx) (vid : VarId.id) : typed_value = - env_lookup_var_value meta ctx.env vid + env_lookup_var_value span ctx.env vid (** Retrieve a const generic value in an evaluation context *) let ctx_lookup_const_generic_value (ctx : eval_ctx) (vid : ConstGenericVarId.id) @@ -342,19 +342,19 @@ let ctx_lookup_const_generic_value (ctx : eval_ctx) (vid : ConstGenericVarId.id) This is a helper function: it can break invariants and doesn't perform any check. *) -let env_update_var_value (meta : Meta.meta) (env : env) (vid : VarId.id) +let env_update_var_value (span : Meta.span) (env : env) (vid : VarId.id) (nv : typed_value) : env = (* We take care to stop at the end of current frame: different variables in different frames can have the same id! *) let rec update env = match env with - | [] -> craise __FILE__ __LINE__ meta "Unexpected" + | [] -> craise __FILE__ __LINE__ span "Unexpected" | EBinding ((BVar b as var), v) :: env' -> if b.index = vid then EBinding (var, nv) :: env' else EBinding (var, v) :: update env' | ((EBinding (BDummy _, _) | EAbs _) as ee) :: env' -> ee :: update env' - | EFrame :: _ -> craise __FILE__ __LINE__ meta "End of frame" + | EFrame :: _ -> craise __FILE__ __LINE__ span "End of frame" in update env @@ -366,20 +366,20 @@ let var_to_binder (var : var) : var_binder = This is a helper function: it can break invariants and doesn't perform any check. *) -let ctx_update_var_value (meta : Meta.meta) (ctx : eval_ctx) (vid : VarId.id) +let ctx_update_var_value (span : Meta.span) (ctx : eval_ctx) (vid : VarId.id) (nv : typed_value) : eval_ctx = - { ctx with env = env_update_var_value meta ctx.env vid nv } + { ctx with env = env_update_var_value span ctx.env vid nv } (** Push a variable in the context's environment. Checks that the pushed variable and its value have the same type (this is important). *) -let ctx_push_var (meta : Meta.meta) (ctx : eval_ctx) (var : var) +let ctx_push_var (span : Meta.span) (ctx : eval_ctx) (var : var) (v : typed_value) : eval_ctx = cassert __FILE__ __LINE__ (TypesUtils.ty_is_ety var.var_ty && var.var_ty = v.ty) - meta "The pushed variables and their values do not have the same type"; + span "The pushed variables and their values do not have the same type"; let bv = var_to_binder var in { ctx with env = EBinding (BVar bv, v) :: ctx.env } @@ -388,7 +388,7 @@ let ctx_push_var (meta : Meta.meta) (ctx : eval_ctx) (var : var) Checks that the pushed variables and their values have the same type (this is important). *) -let ctx_push_vars (meta : Meta.meta) (ctx : eval_ctx) +let ctx_push_vars (span : Meta.span) (ctx : eval_ctx) (vars : (var * typed_value) list) : eval_ctx = log#ldebug (lazy @@ -404,7 +404,7 @@ let ctx_push_vars (meta : Meta.meta) (ctx : eval_ctx) (fun (var, (value : typed_value)) -> TypesUtils.ty_is_ety var.var_ty && var.var_ty = value.ty) vars) - meta "The pushed variables and their values do not have the same type"; + span "The pushed variables and their values do not have the same type"; let vars = List.map (fun (var, value) -> EBinding (BVar (var_to_binder var), value)) @@ -426,11 +426,11 @@ let ctx_push_fresh_dummy_vars (ctx : eval_ctx) (vl : typed_value list) : List.fold_left (fun ctx v -> ctx_push_fresh_dummy_var ctx v) ctx vl (** Remove a dummy variable from a context's environment. *) -let ctx_remove_dummy_var meta (ctx : eval_ctx) (vid : DummyVarId.id) : +let ctx_remove_dummy_var span (ctx : eval_ctx) (vid : DummyVarId.id) : eval_ctx * typed_value = let rec remove_var (env : env) : env * typed_value = match env with - | [] -> craise __FILE__ __LINE__ meta "Could not lookup a dummy variable" + | [] -> craise __FILE__ __LINE__ span "Could not lookup a dummy variable" | EBinding (BDummy vid', v) :: env when vid' = vid -> (env, v) | ee :: env -> let env, v = remove_var env in @@ -440,11 +440,11 @@ let ctx_remove_dummy_var meta (ctx : eval_ctx) (vid : DummyVarId.id) : ({ ctx with env }, v) (** Lookup a dummy variable in a context's environment. *) -let ctx_lookup_dummy_var (meta : Meta.meta) (ctx : eval_ctx) +let ctx_lookup_dummy_var (span : Meta.span) (ctx : eval_ctx) (vid : DummyVarId.id) : typed_value = let rec lookup_var (env : env) : typed_value = match env with - | [] -> craise __FILE__ __LINE__ meta "Could not lookup a dummy variable" + | [] -> craise __FILE__ __LINE__ span "Could not lookup a dummy variable" | EBinding (BDummy vid', v) :: _env when vid' = vid -> v | _ :: env -> lookup_var env in @@ -460,17 +460,17 @@ let erase_regions (ty : ty) : ty = v#visit_ty () ty (** Push an uninitialized variable (which thus maps to {!constructor:Values.value.VBottom}) *) -let ctx_push_uninitialized_var (meta : Meta.meta) (ctx : eval_ctx) (var : var) : +let ctx_push_uninitialized_var (span : Meta.span) (ctx : eval_ctx) (var : var) : eval_ctx = - ctx_push_var meta ctx var (mk_bottom meta (erase_regions var.var_ty)) + ctx_push_var span ctx var (mk_bottom span (erase_regions var.var_ty)) (** Push a list of uninitialized variables (which thus map to {!constructor:Values.value.VBottom}) *) -let ctx_push_uninitialized_vars (meta : Meta.meta) (ctx : eval_ctx) +let ctx_push_uninitialized_vars (span : Meta.span) (ctx : eval_ctx) (vars : var list) : eval_ctx = let vars = - List.map (fun v -> (v, mk_bottom meta (erase_regions v.var_ty))) vars + List.map (fun v -> (v, mk_bottom span (erase_regions v.var_ty))) vars in - ctx_push_vars meta ctx vars + ctx_push_vars span ctx vars let env_find_abs (env : env) (pred : abs -> bool) : abs option = let rec lookup env = @@ -489,11 +489,11 @@ let env_lookup_abs_opt (env : env) (abs_id : AbstractionId.id) : abs option = this abstraction (for instance, remove the abs id from all the parent sets of all the other abstractions). *) -let env_remove_abs (meta : Meta.meta) (env : env) (abs_id : AbstractionId.id) : +let env_remove_abs (span : Meta.span) (env : env) (abs_id : AbstractionId.id) : env * abs option = let rec remove (env : env) : env * abs option = match env with - | [] -> craise __FILE__ __LINE__ meta "Unreachable" + | [] -> craise __FILE__ __LINE__ span "Unreachable" | EFrame :: _ -> (env, None) | EBinding (bv, v) :: env -> let env, abs_opt = remove env in @@ -515,11 +515,11 @@ let env_remove_abs (meta : Meta.meta) (env : env) (abs_id : AbstractionId.id) : we also substitute the abstraction id wherever it is used (i.e., in the parent sets of the other abstractions). *) -let env_subst_abs (meta : Meta.meta) (env : env) (abs_id : AbstractionId.id) +let env_subst_abs (span : Meta.span) (env : env) (abs_id : AbstractionId.id) (nabs : abs) : env * abs option = let rec update (env : env) : env * abs option = match env with - | [] -> craise __FILE__ __LINE__ meta "Unreachable" + | [] -> craise __FILE__ __LINE__ span "Unreachable" | EFrame :: _ -> (* We're done *) (env, None) | EBinding (bv, v) :: env -> let env, opt_abs = update env in @@ -551,22 +551,22 @@ let ctx_find_abs (ctx : eval_ctx) (p : abs -> bool) : abs option = env_find_abs ctx.env p (** See the comments for {!env_remove_abs} *) -let ctx_remove_abs (meta : Meta.meta) (ctx : eval_ctx) +let ctx_remove_abs (span : Meta.span) (ctx : eval_ctx) (abs_id : AbstractionId.id) : eval_ctx * abs option = - let env, abs = env_remove_abs meta ctx.env abs_id in + let env, abs = env_remove_abs span ctx.env abs_id in ({ ctx with env }, abs) (** See the comments for {!env_subst_abs} *) -let ctx_subst_abs (meta : Meta.meta) (ctx : eval_ctx) +let ctx_subst_abs (span : Meta.span) (ctx : eval_ctx) (abs_id : AbstractionId.id) (nabs : abs) : eval_ctx * abs option = - let env, abs_opt = env_subst_abs meta ctx.env abs_id nabs in + let env, abs_opt = env_subst_abs span ctx.env abs_id nabs in ({ ctx with env }, abs_opt) -let ctx_set_abs_can_end (meta : Meta.meta) (ctx : eval_ctx) +let ctx_set_abs_can_end (span : Meta.span) (ctx : eval_ctx) (abs_id : AbstractionId.id) (can_end : bool) : eval_ctx = let abs = ctx_lookup_abs ctx abs_id in let abs = { abs with can_end } in - fst (ctx_subst_abs meta ctx abs_id abs) + fst (ctx_subst_abs span ctx abs_id abs) let ctx_type_decl_is_rec (ctx : eval_ctx) (id : TypeDeclId.id) : bool = let decl_group = TypeDeclId.Map.find id ctx.type_ctx.type_decls_groups in diff --git a/compiler/Cps.ml b/compiler/Cps.ml index a3c8f1e1..142c2b08 100644 --- a/compiler/Cps.ml +++ b/compiler/Cps.ml @@ -3,6 +3,7 @@ open Values open Contexts +open Errors (** TODO: change the name *) type eval_error = EPanic @@ -36,172 +37,111 @@ type statement_eval_res = type eval_result = SymbolicAst.expression option -(** Continuation function *) -type m_fun = eval_ctx -> eval_result - -(** Continuation taking another continuation as parameter *) -type cm_fun = m_fun -> m_fun - -(** Continuation taking a typed value as parameter - TODO: use more *) -type typed_value_m_fun = typed_value -> m_fun - -(** Continuation taking another continuation as parameter and a typed - value as parameter. - *) -type typed_value_cm_fun = typed_value -> cm_fun - -(** Type of a continuation used when evaluating a statement *) -type st_m_fun = statement_eval_res -> m_fun - -(** Type of a continuation used when evaluating a statement *) -type st_cm_fun = st_m_fun -> m_fun - -(** Convert a unit function to a cm function *) -let unit_to_cm_fun (f : eval_ctx -> unit) : cm_fun = - fun cf ctx -> - f ctx; - cf ctx - -(** *) -let update_to_cm_fun (f : eval_ctx -> eval_ctx) : cm_fun = - fun cf ctx -> - let ctx = f ctx in - cf ctx - -(** Composition of functions taking continuations as parameters. - We tried to make this as general as possible. *) -let comp (f : 'c -> 'd -> 'e) (g : ('a -> 'b) -> 'c) : ('a -> 'b) -> 'd -> 'e = - fun cf ctx -> f (g cf) ctx - -let comp_unit (f : cm_fun) (g : eval_ctx -> unit) : cm_fun = - comp f (unit_to_cm_fun g) - -let comp_update (f : cm_fun) (g : eval_ctx -> eval_ctx) : cm_fun = - comp f (update_to_cm_fun g) - -(** This is just a test, to check that {!comp} is general enough to handle a case - where a function must compute a value and give it to the continuation. - It happens for functions like {!val:InterpreterExpressions.eval_operand}. - - Keeping this here also makes it a good reference, when one wants to figure - out the signatures he should use for such a composition. - *) -let comp_ret_val (f : (typed_value -> m_fun) -> m_fun) - (g : m_fun -> typed_value -> m_fun) : cm_fun = - comp f g - -let apply (f : cm_fun) (g : m_fun) : m_fun = fun ctx -> f g ctx -let id_cm_fun : cm_fun = fun cf ctx -> cf ctx - -(** If we have a list of [inputs] of type ['a list] and a function [f] which - evaluates one element of type ['a] to compute a result of type ['b] before - giving it to a continuation, the following function performs a fold operation: - it evaluates all the inputs one by one by accumulating the results in a list, - and gives the list to a continuation. - - Note that we make sure that the results are listed in the order in - which they were computed (the first element of the list is the result - of applying [f] to the first element of the inputs). - - See the unit test below for an illustration. - *) -let fold_left_apply_continuation (f : 'a -> ('c -> 'd) -> 'c -> 'd) - (inputs : 'a list) (cf : 'c -> 'd) : 'c -> 'd = - let rec eval_list (inputs : 'a list) (cf : 'c -> 'd) : 'c -> 'd = +(** Function which takes a context as input, and evaluates to: + - a new context + - a continuation with which to build the execution trace, provided the + trace for the end of the execution. + *) +type cm_fun = eval_ctx -> eval_ctx * (eval_result -> eval_result) + +type st_cm_fun = + eval_ctx -> (eval_ctx * statement_eval_res) * (eval_result -> eval_result) + +(** Type of a function used when evaluating a statement *) +type stl_cm_fun = + eval_ctx -> + (eval_ctx * statement_eval_res) list + * (SymbolicAst.expression list option -> eval_result) + +(** Compose continuations that we use to compute execution traces *) +let cc_comp (f : 'b -> 'c) (g : 'a -> 'b) : 'a -> 'c = fun e -> f (g e) + +let comp (f : 'b -> 'c) (g : 'x * ('a -> 'b)) : 'x * ('a -> 'c) = + let x, g = g in + (x, cc_comp f g) + +let comp2 (f : 'b -> 'c) (g : 'x * 'y * ('a -> 'b)) : 'x * 'y * ('a -> 'c) = + let x, y, g = g in + (x, y, cc_comp f g) + +(** [fold] operation for functions which thread a context and return a continuation *) +let fold_left_apply_continuation (f : 'a -> 'c -> 'c * ('e -> 'e)) + (inputs : 'a list) (ctx : 'c) : 'c * ('e -> 'e) = + let rec eval_list (inputs : 'a list) : 'c -> 'b = fun ctx -> match inputs with - | [] -> cf ctx - | x :: inputs -> comp (f x) (fun cf -> eval_list inputs cf) cf ctx + | [] -> (ctx, fun x -> x) + | x :: inputs -> + let ctx, cc = f x ctx in + comp cc (eval_list inputs ctx) in - eval_list inputs cf - -(** Unit test/example for {!fold_left_apply_continuation} *) -let _ = - fold_left_apply_continuation - (fun x cf (ctx : int) -> cf (ctx + x)) - [ 1; 20; 300; 4000 ] - (fun (ctx : int) -> assert (ctx = 4321)) - 0 - -(** If we have a list of [inputs] of type ['a list] and a function [f] which - evaluates one element of type ['a] to compute a result of type ['b] before - giving it to a continuation, the following function performs a fold operation: - it evaluates all the inputs one by one by accumulating the results in a list, - and gives the list to a continuation. - - Note that we make sure that the results are listed in the order in - which they were computed (the first element of the list is the result - of applying [f] to the first element of the inputs). - - See the unit test below for an illustration. - *) -let fold_left_list_apply_continuation (f : 'a -> ('b -> 'c -> 'd) -> 'c -> 'd) - (inputs : 'a list) (cf : 'b list -> 'c -> 'd) : 'c -> 'd = - let rec eval_list (inputs : 'a list) (cf : 'b list -> 'c -> 'd) - (outputs : 'b list) : 'c -> 'd = - fun ctx -> + eval_list inputs ctx + +(** [map] operation for functions which thread a context and return a continuation *) +let map_apply_continuation (f : 'a -> 'c -> 'b * 'c * ('e -> 'e)) + (inputs : 'a list) (ctx : 'c) : 'b list * 'c * ('e -> 'e) = + let rec eval_list (inputs : 'a list) (ctx : 'c) : 'b list * 'c * ('e -> 'e) = match inputs with - | [] -> cf (List.rev outputs) ctx + | [] -> ([], ctx, fun e -> e) | x :: inputs -> - comp (f x) (fun cf v -> eval_list inputs cf (v :: outputs)) cf ctx + let v, ctx, cc1 = f x ctx in + let vl, ctx, cc2 = eval_list inputs ctx in + (v :: vl, ctx, cc_comp cc1 cc2) in - eval_list inputs cf [] - -(** Unit test/example for {!fold_left_list_apply_continuation} *) -let _ = - fold_left_list_apply_continuation - (fun x cf (ctx : unit) -> cf (10 + x) ctx) - [ 0; 1; 2; 3; 4 ] - (fun values _ctx -> assert (values = [ 10; 11; 12; 13; 14 ])) - () - -(** Composition of functions taking continuations as parameters. - - We sometimes have the following situation, where we want to compose three - functions [send], [transmit] and [receive] such that: - - those three functions take continuations as parameters - - [send] generates a value and gives it to its continuation - - [receive] expects a value (so we can compose [send] and [receive] like - so: [comp send receive]) - - [transmit] doesn't expect any value and needs to be called between [send] - and [receive] - - In this situation, we need to take the value given by [send] and "transmit" - it to [receive]. - - This is what this function does (see the unit test below for an illustration). - *) -let comp_transmit (f : ('v -> 'm) -> 'n) (g : 'm -> 'm) : ('v -> 'm) -> 'n = - fun cf -> f (fun v -> g (cf v)) - -(** Example of use of {!comp_transmit} - TODO: make "real" unit tests *) -let () = - let return3 (cf : int -> unit -> unit) (ctx : unit) = cf 3 ctx in - let do_nothing (cf : unit -> unit) (ctx : unit) = cf ctx in - let consume3 (x : int) (ctx : unit) : unit = - assert (x = 3); - ctx + eval_list inputs ctx + +let opt_list_to_list_opt (len : int) (el : 'a option list) : 'a list option = + let expr_list = + List.rev + (List.fold_left + (fun acc a -> match a with Some b -> b :: acc | None -> []) + [] el) in - let cc = comp_transmit return3 do_nothing in - let cc = cc consume3 in - cc () - -(** Sometimes, we want to compose a function with a continuation which checks - its computed value and its updated context, before transmitting them + let _ = assert (List.length expr_list = len) in + if Option.is_none (List.hd expr_list) then None else Some expr_list + +let cc_singleton file line span cf el = + match el with + | Some [ e ] -> cf (Some e) + | Some _ -> internal_error file line span + | _ -> None + +(** It happens that we need to concatenate lists of results, for + instance when evaluating the branches of a match. When applying + the continuations to build the symbolic expressions, we need + to decompose the list of expressions we get to give it to the + individual continuations for the branches. *) -let comp_check_value (f : ('v -> 'ctx -> 'a) -> 'ctx -> 'b) - (g : 'v -> 'ctx -> unit) : ('v -> 'ctx -> 'a) -> 'ctx -> 'b = - fun cf -> - f (fun v ctx -> - g v ctx; - cf v ctx) - -(** This case is similar to {!comp_check_value}, but even simpler (we only check - the context) - *) -let comp_check_ctx (f : ('ctx -> 'a) -> 'ctx -> 'b) (g : 'ctx -> unit) : - ('ctx -> 'a) -> 'ctx -> 'b = - fun cf -> - f (fun ctx -> - g ctx; - cf ctx) +let comp_seqs (file : string) (line : int) (span : Meta.span) + (ls : + ('a list + * (SymbolicAst.expression list option -> SymbolicAst.expression option)) + list) : + 'a list + * (SymbolicAst.expression list option -> SymbolicAst.expression list option) + = + (* Auxiliary function: given a list of expressions el, build the expressions + corresponding to the different branches *) + let rec cc_aux ls el = + match ls with + | [] -> + (* End of the list of branches: there shouldn't be any expression remaining *) + sanity_check file line (el = []) span; + [] + | (resl, cf) :: ls -> + (* Split the list of expressions between: + - the expressions for the current branch + - the expressions for the remaining branches *) + let el0, el = Collections.List.split_at el (List.length resl) in + (* Compute the expression for the current branch *) + let e0 = cf (Some el0) in + let e0 = + match e0 with None -> internal_error file line span | Some e -> e + in + (* Compute the expressions for the remaining branches *) + let e = cc_aux ls el in + (* Concatenate *) + e0 :: e + in + let cc el = match el with None -> None | Some el -> Some (cc_aux ls el) in + (List.flatten (fst (List.split ls)), cc) diff --git a/compiler/Errors.ml b/compiler/Errors.ml index 30887593..6e2de7e1 100644 --- a/compiler/Errors.ml +++ b/compiler/Errors.ml @@ -1,70 +1,72 @@ let log = Logging.errors_log -let meta_to_string (meta : Meta.meta) = - let span = meta.span in - let file = match span.file with Virtual s | Local s -> s in +let span_to_string (span : Meta.span) = + let raw_span = span.span in + let file = match raw_span.file with Virtual s | Local s -> s in let loc_to_string (l : Meta.loc) : string = string_of_int l.line ^ ":" ^ string_of_int l.col in - "Source: '" ^ file ^ "', lines " ^ loc_to_string span.beg_loc ^ "-" - ^ loc_to_string span.end_loc + "Source: '" ^ file ^ "', lines " + ^ loc_to_string raw_span.beg_loc + ^ "-" + ^ loc_to_string raw_span.end_loc -let format_error_message (meta : Meta.meta option) (msg : string) = - let meta = - match meta with None -> "" | Some meta -> "\n" ^ meta_to_string meta +let format_error_message (span : Meta.span option) (msg : string) = + let span = + match span with None -> "" | Some span -> "\n" ^ span_to_string span in - msg ^ meta + msg ^ span let format_error_message_with_file_line (file : string) (line : int) - (meta : Meta.meta option) (msg : string) = + (span : Meta.span option) (msg : string) = "In file " ^ file ^ ", line " ^ string_of_int line ^ ":\n" - ^ format_error_message meta msg + ^ format_error_message span msg -exception CFailure of (Meta.meta option * string) +exception CFailure of (Meta.span option * string) -let error_list : (Meta.meta option * string) list ref = ref [] +let error_list : (Meta.span option * string) list ref = ref [] -let push_error (meta : Meta.meta option) (msg : string) = - error_list := (meta, msg) :: !error_list +let push_error (span : Meta.span option) (msg : string) = + error_list := (span, msg) :: !error_list (** Register an error, and throw an exception if [throw] is true *) let save_error (file : string) (line : int) ?(throw : bool = false) - (meta : Meta.meta option) (msg : string) = - push_error meta msg; + (span : Meta.span option) (msg : string) = + push_error span msg; if !Config.fail_hard && throw then ( - let msg = format_error_message_with_file_line file line meta msg in + let msg = format_error_message_with_file_line file line span msg in log#serror (msg ^ "\n"); raise (Failure msg)) -let craise_opt_meta (file : string) (line : int) (meta : Meta.meta option) +let craise_opt_span (file : string) (line : int) (span : Meta.span option) (msg : string) = if !Config.fail_hard then ( - let msg = format_error_message_with_file_line file line meta msg in + let msg = format_error_message_with_file_line file line span msg in log#serror (msg ^ "\n"); - raise (Failure (format_error_message_with_file_line file line meta msg))) + raise (Failure (format_error_message_with_file_line file line span msg))) else - let () = push_error meta msg in - raise (CFailure (meta, msg)) + let () = push_error span msg in + raise (CFailure (span, msg)) -let craise (file : string) (line : int) (meta : Meta.meta) (msg : string) = - craise_opt_meta file line (Some meta) msg +let craise (file : string) (line : int) (span : Meta.span) (msg : string) = + craise_opt_span file line (Some span) msg -let cassert_opt_meta (file : string) (line : int) (b : bool) - (meta : Meta.meta option) (msg : string) = - if not b then craise_opt_meta file line meta msg +let cassert_opt_span (file : string) (line : int) (b : bool) + (span : Meta.span option) (msg : string) = + if not b then craise_opt_span file line span msg -let cassert (file : string) (line : int) (b : bool) (meta : Meta.meta) +let cassert (file : string) (line : int) (b : bool) (span : Meta.span) (msg : string) = - cassert_opt_meta file line b (Some meta) msg + cassert_opt_span file line b (Some span) msg -let sanity_check (file : string) (line : int) b meta = - cassert file line b meta "Internal error, please file an issue" +let sanity_check (file : string) (line : int) b span = + cassert file line b span "Internal error, please file an issue" -let sanity_check_opt_meta (file : string) (line : int) b meta = - cassert_opt_meta file line b meta "Internal error, please file an issue" +let sanity_check_opt_span (file : string) (line : int) b span = + cassert_opt_span file line b span "Internal error, please file an issue" -let internal_error (file : string) (line : int) meta = - craise file line meta "Internal error, please file an issue" +let internal_error (file : string) (line : int) span = + craise file line span "Internal error, please file an issue" let exec_raise = craise let exec_assert = cassert diff --git a/compiler/Extract.ml b/compiler/Extract.ml index 8efb59fb..035ea8fe 100644 --- a/compiler/Extract.ml +++ b/compiler/Extract.ml @@ -46,7 +46,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) let f = def.f in let open ExtractBuiltin in let fun_id = (Pure.FunId (FRegular f.def_id), f.loop_id) in - ctx_add f.meta (FunId (FromLlbc fun_id)) fun_info.extract_name ctx + ctx_add f.span (FunId (FromLlbc fun_id)) fun_info.extract_name ctx | None -> (* Not builtin *) (* If this is a trait method implementation, we prefix the name with the @@ -60,7 +60,7 @@ let extract_fun_decl_register_names (ctx : extraction_ctx) (* Add the decreases proof for Lean only *) match !Config.backend with | Coq | FStar -> ctx - | HOL4 -> craise __FILE__ __LINE__ def.meta "Unexpected" + | HOL4 -> craise __FILE__ __LINE__ def.span "Unexpected" | Lean -> ctx_add_decreases_proof def ctx else ctx in @@ -90,7 +90,7 @@ let extract_global_decl_register_names (ctx : extraction_ctx) TODO: we don't need something very generic anymore (some definitions used to be polymorphic). *) -let extract_adt_g_value (meta : Meta.meta) +let extract_adt_g_value (span : Meta.span) (extract_value : extraction_ctx -> bool -> 'v -> extraction_ctx) (fmt : F.formatter) (ctx : extraction_ctx) (is_single_pat : bool) (inside : bool) (variant_id : VariantId.id option) (field_values : 'v list) @@ -130,10 +130,10 @@ let extract_adt_g_value (meta : Meta.meta) (* For now, we only support fully applied tuple constructors *) cassert __FILE__ __LINE__ (List.length generics.types = List.length field_values) - meta "Only fully applied tuple constructors are currently supported"; + span "Only fully applied tuple constructors are currently supported"; cassert __FILE__ __LINE__ (generics.const_generics = [] && generics.trait_refs = []) - meta "Only fully applied tuple constructors are currently supported"; + span "Only fully applied tuple constructors are currently supported"; extract_as_tuple () | TAdt (adt_id, _) -> (* "Regular" ADT *) @@ -172,8 +172,8 @@ let extract_adt_g_value (meta : Meta.meta) *) let cons = match variant_id with - | Some vid -> ctx_get_variant meta adt_id vid ctx - | None -> ctx_get_struct meta adt_id ctx + | Some vid -> ctx_get_variant span adt_id vid ctx + | None -> ctx_get_struct span adt_id ctx in let use_parentheses = inside && field_values <> [] in if use_parentheses then F.pp_print_string fmt "("; @@ -187,18 +187,18 @@ let extract_adt_g_value (meta : Meta.meta) in if use_parentheses then F.pp_print_string fmt ")"; ctx - | _ -> craise __FILE__ __LINE__ meta "Inconsistent typed value" + | _ -> craise __FILE__ __LINE__ span "Inconsistent typed value" (* Extract globals in the same way as variables *) -let extract_global (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) +let extract_global (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (id : A.GlobalDeclId.id) (generics : generic_args) : unit = let use_brackets = inside && generics <> empty_generic_args in F.pp_open_hvbox fmt ctx.indent_incr; if use_brackets then F.pp_print_string fmt "("; (* Extract the global name *) - F.pp_print_string fmt (ctx_get_global meta id ctx); + F.pp_print_string fmt (ctx_get_global span id ctx); (* Extract the generics *) - extract_generic_args meta ctx fmt TypeDeclId.Set.empty generics; + extract_generic_args span ctx fmt TypeDeclId.Set.empty generics; if use_brackets then F.pp_print_string fmt ")"; F.pp_close_box fmt () @@ -236,7 +236,7 @@ let fun_builtin_filter_types (id : FunDeclId.id) (types : 'a list) As a pattern can introduce new variables, we return an extraction context updated with new bindings. *) -let rec extract_typed_pattern (meta : Meta.meta) (ctx : extraction_ctx) +let rec extract_typed_pattern (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (is_let : bool) (inside : bool) ?(with_type = false) (v : typed_pattern) : extraction_ctx = if with_type then F.pp_print_string fmt "("; @@ -244,11 +244,11 @@ let rec extract_typed_pattern (meta : Meta.meta) (ctx : extraction_ctx) let ctx = match v.value with | PatConstant cv -> - extract_literal meta fmt inside cv; + extract_literal span fmt inside cv; ctx | PatVar (v, _) -> - let vname = ctx_compute_var_basename meta ctx v.basename v.ty in - let ctx, vname = ctx_add_var meta vname v.id ctx in + let vname = ctx_compute_var_basename span ctx v.basename v.ty in + let ctx, vname = ctx_add_var span vname v.id ctx in F.pp_print_string fmt vname; ctx | PatDummy -> @@ -256,22 +256,22 @@ let rec extract_typed_pattern (meta : Meta.meta) (ctx : extraction_ctx) ctx | PatAdt av -> let extract_value ctx inside v = - extract_typed_pattern meta ctx fmt is_let inside v + extract_typed_pattern span ctx fmt is_let inside v in - extract_adt_g_value meta extract_value fmt ctx is_let inside + extract_adt_g_value span extract_value fmt ctx is_let inside av.variant_id av.field_values v.ty in if with_type then ( F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - extract_ty meta ctx fmt TypeDeclId.Set.empty false v.ty; + extract_ty span ctx fmt TypeDeclId.Set.empty false v.ty; F.pp_print_string fmt ")"); ctx (** Return true if we need to wrap a succession of let-bindings in a [do ...] block (because some of them are monadic) *) -let lets_require_wrap_in_do (meta : Meta.meta) +let lets_require_wrap_in_do (span : Meta.span) (lets : (bool * typed_pattern * texpression) list) : bool = match !backend with | Lean -> @@ -283,7 +283,7 @@ let lets_require_wrap_in_do (meta : Meta.meta) if wrap_in_do then sanity_check __FILE__ __LINE__ (List.for_all (fun (m, _, _) -> m) lets) - meta; + span; wrap_in_do | FStar | Coq -> false @@ -304,38 +304,38 @@ let extract_texpression_errors (fmt : F.formatter) = | Lean -> F.pp_print_string fmt "sorry" | HOL4 -> F.pp_print_string fmt "(* ERROR: could not generate the code *)" -let rec extract_texpression (meta : Meta.meta) (ctx : extraction_ctx) +let rec extract_texpression (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (e : texpression) : unit = match e.e with | Var var_id -> - let var_name = ctx_get_var meta var_id ctx in + let var_name = ctx_get_var span var_id ctx in F.pp_print_string fmt var_name | CVar var_id -> - let var_name = ctx_get_const_generic_var meta var_id ctx in + let var_name = ctx_get_const_generic_var span var_id ctx in F.pp_print_string fmt var_name - | Const cv -> extract_literal meta fmt inside cv + | Const cv -> extract_literal span fmt inside cv | App _ -> let app, args = destruct_apps e in - extract_App meta ctx fmt inside app args + extract_App span ctx fmt inside app args | Lambda _ -> let xl, e = destruct_lambdas e in - extract_Lambda (meta : Meta.meta) ctx fmt inside xl e + extract_Lambda (span : Meta.span) ctx fmt inside xl e | Qualif _ -> (* We use the app case *) - extract_App meta ctx fmt inside e [] - | Let (_, _, _, _) -> extract_lets meta ctx fmt inside e - | Switch (scrut, body) -> extract_Switch meta ctx fmt inside scrut body - | Meta (_, e) -> extract_texpression meta ctx fmt inside e - | StructUpdate supd -> extract_StructUpdate meta ctx fmt inside e.ty supd + extract_App span ctx fmt inside e [] + | Let (_, _, _, _) -> extract_lets span ctx fmt inside e + | Switch (scrut, body) -> extract_Switch span ctx fmt inside scrut body + | Meta (_, e) -> extract_texpression span ctx fmt inside e + | StructUpdate supd -> extract_StructUpdate span ctx fmt inside e.ty supd | Loop _ -> (* The loop nodes should have been eliminated in {!PureMicroPasses} *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | EError (_, _) -> extract_texpression_errors fmt (* Extract an application *or* a top-level qualif (function extraction has * to handle top-level qualifiers, so it seemed more natural to merge the * two cases) *) -and extract_App (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) +and extract_App (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (app : texpression) (args : texpression list) : unit = (* We don't do the same thing if the app is a top-level identifier (function, * ADT constructor...) or a "regular" expression *) @@ -344,19 +344,19 @@ and extract_App (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (* Top-level qualifier *) match qualif.id with | FunOrOp fun_id -> - extract_function_call meta ctx fmt inside fun_id qualif.generics args + extract_function_call span ctx fmt inside fun_id qualif.generics args | Global global_id -> assert (args = []); - extract_global meta ctx fmt inside global_id qualif.generics + extract_global span ctx fmt inside global_id qualif.generics | AdtCons adt_cons_id -> - extract_adt_cons meta ctx fmt inside adt_cons_id qualif.generics args + extract_adt_cons span ctx fmt inside adt_cons_id qualif.generics args | Proj proj -> - extract_field_projector meta ctx fmt inside app proj qualif.generics + extract_field_projector span ctx fmt inside app proj qualif.generics args | TraitConst (trait_ref, const_name) -> - extract_trait_ref meta ctx fmt TypeDeclId.Set.empty true trait_ref; + extract_trait_ref span ctx fmt TypeDeclId.Set.empty true trait_ref; let name = - ctx_get_trait_const meta trait_ref.trait_decl_ref.trait_decl_id + ctx_get_trait_const span trait_ref.trait_decl_ref.trait_decl_id const_name ctx in let add_brackets (s : string) = @@ -371,12 +371,12 @@ and extract_App (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) F.pp_open_hovbox fmt ctx.indent_incr; (* Print the app expression *) let app_inside = (inside && args = []) || args <> [] in - extract_texpression meta ctx fmt app_inside app; + extract_texpression span ctx fmt app_inside app; (* Print the arguments *) List.iter (fun ve -> F.pp_print_space fmt (); - extract_texpression meta ctx fmt true ve) + extract_texpression span ctx fmt true ve) args; (* Close the box for the application *) F.pp_close_box fmt (); @@ -384,7 +384,7 @@ and extract_App (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) if inside then F.pp_print_string fmt ")" (** Subcase of the app case: function call *) -and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) +and extract_function_call (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (fid : fun_or_op_id) (generics : generic_args) (args : texpression list) : unit = match (fid, args) with @@ -393,11 +393,11 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) * Note that the way we generate the translation, we shouldn't get the * case where we have no argument (all functions are fully instantiated, * and no AST transformation introduces partial calls). *) - extract_unop meta (extract_texpression meta ctx fmt) fmt inside unop arg + extract_unop span (extract_texpression span ctx fmt) fmt inside unop arg | Binop (binop, int_ty), [ arg0; arg1 ] -> (* Number of arguments: similar to unop *) - extract_binop meta - (extract_texpression meta ctx fmt) + extract_binop span + (extract_texpression span ctx fmt) fmt inside binop int_ty arg0 arg1 | Fun fun_id, _ -> if inside then F.pp_print_string fmt "("; @@ -464,11 +464,11 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) if not method_id.is_provided then ( (* Required method *) - sanity_check __FILE__ __LINE__ (lp_id = None) trait_decl.meta; - extract_trait_ref trait_decl.meta ctx fmt TypeDeclId.Set.empty true + sanity_check __FILE__ __LINE__ (lp_id = None) trait_decl.span; + extract_trait_ref trait_decl.span ctx fmt TypeDeclId.Set.empty true trait_ref; let fun_name = - ctx_get_trait_method meta trait_ref.trait_decl_ref.trait_decl_id + ctx_get_trait_method span trait_ref.trait_decl_ref.trait_decl_id method_name ctx in let add_brackets (s : string) = @@ -479,7 +479,7 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) (* Provided method: we see it as a regular function call, and use the function name *) let fun_id = FromLlbc (FunId (FRegular method_id.id), lp_id) in - let fun_name = ctx_get_function trait_decl.meta fun_id ctx in + let fun_name = ctx_get_function trait_decl.span fun_id ctx in F.pp_print_string fmt fun_name; (* Note that we do not need to print the generics for the trait @@ -488,16 +488,16 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) Print the trait ref (to instantate the self clause) *) F.pp_print_space fmt (); - extract_trait_ref trait_decl.meta ctx fmt TypeDeclId.Set.empty true + extract_trait_ref trait_decl.span ctx fmt TypeDeclId.Set.empty true trait_ref | _ -> - let fun_name = ctx_get_function meta fun_id ctx in + let fun_name = ctx_get_function span fun_id ctx in F.pp_print_string fmt fun_name); (* Sanity check: HOL4 doesn't support const generics *) sanity_check __FILE__ __LINE__ (generics.const_generics = [] || !backend <> HOL4) - meta; + span; (* Print the generics. We might need to filter some of the type arguments, if the type @@ -512,12 +512,12 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) in (match types with | Ok types -> - extract_generic_args meta ctx fmt TypeDeclId.Set.empty + extract_generic_args span ctx fmt TypeDeclId.Set.empty { generics with types } | Error (types, err) -> - extract_generic_args meta ctx fmt TypeDeclId.Set.empty + extract_generic_args span ctx fmt TypeDeclId.Set.empty { generics with types }; - save_error __FILE__ __LINE__ (Some meta) err; + save_error __FILE__ __LINE__ (Some span) err; F.pp_print_string fmt "(\"ERROR: ill-formed builtin: invalid number of filtering \ arguments\")"); @@ -525,14 +525,14 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) List.iter (fun ve -> F.pp_print_space fmt (); - extract_texpression meta ctx fmt true ve) + extract_texpression span ctx fmt true ve) args; (* Close the box for the function call *) F.pp_close_box fmt (); (* Return *) if inside then F.pp_print_string fmt ")" | (Unop _ | Binop _), _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Unreachable:\n" ^ "Function: " ^ show_fun_or_op_id fid ^ ",\nNumber of arguments: " ^ string_of_int (List.length args) @@ -540,22 +540,22 @@ and extract_function_call (meta : Meta.meta) (ctx : extraction_ctx) ^ String.concat " " (List.map show_texpression args)) (** Subcase of the app case: ADT constructor *) -and extract_adt_cons (meta : Meta.meta) (ctx : extraction_ctx) +and extract_adt_cons (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (adt_cons : adt_cons_id) (generics : generic_args) (args : texpression list) : unit = let e_ty = TAdt (adt_cons.adt_id, generics) in let is_single_pat = false in let _ = - extract_adt_g_value meta + extract_adt_g_value span (fun ctx inside e -> - extract_texpression meta ctx fmt inside e; + extract_texpression span ctx fmt inside e; ctx) fmt ctx is_single_pat inside adt_cons.variant_id args e_ty in () (** Subcase of the app case: ADT field projector. *) -and extract_field_projector (meta : Meta.meta) (ctx : extraction_ctx) +and extract_field_projector (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (original_app : texpression) (proj : projection) (_generics : generic_args) (args : texpression list) : unit = @@ -582,7 +582,7 @@ and extract_field_projector (meta : Meta.meta) (ctx : extraction_ctx) match num_fields with Some len -> len = 1 | None -> false in if is_tuple_struct && has_one_field then - extract_texpression meta ctx fmt inside arg + extract_texpression span ctx fmt inside arg else (* Exactly one argument: pretty-print *) let field_name = @@ -633,12 +633,12 @@ and extract_field_projector (meta : Meta.meta) (ctx : extraction_ctx) if field_id + 1 = Option.get num_fields then twos_prefix else twos_prefix ^ ".1" else "#" ^ string_of_int field_id - else ctx_get_field meta proj.adt_id proj.field_id ctx + else ctx_get_field span proj.adt_id proj.field_id ctx in (* Open a box *) F.pp_open_hovbox fmt ctx.indent_incr; (* Extract the expression *) - extract_texpression meta ctx fmt true arg; + extract_texpression span ctx fmt true arg; (* We allow to break where the "." appears (except Lean, it's a syntax error) *) if !backend <> Lean then F.pp_print_break fmt 0 0; F.pp_print_string fmt "."; @@ -651,26 +651,26 @@ and extract_field_projector (meta : Meta.meta) (ctx : extraction_ctx) | arg :: args -> (* Call extract_App again, but in such a way that the first argument is * isolated *) - extract_App meta ctx fmt inside (mk_app meta original_app arg) args + extract_App span ctx fmt inside (mk_app span original_app arg) args | [] -> (* No argument: shouldn't happen *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" -and extract_Lambda (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) +and extract_Lambda (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (xl : typed_pattern list) (e : texpression) : unit = (* Open a box for the abs expression *) F.pp_open_hovbox fmt ctx.indent_incr; (* Open parentheses *) if inside then F.pp_print_string fmt "("; (* Print the lambda - note that there should always be at least one variable *) - sanity_check __FILE__ __LINE__ (xl <> []) meta; + sanity_check __FILE__ __LINE__ (xl <> []) span; F.pp_print_string fmt "fun"; let with_type = !backend = Coq in let ctx = List.fold_left (fun ctx x -> F.pp_print_space fmt (); - extract_typed_pattern meta ctx fmt true true ~with_type x) + extract_typed_pattern span ctx fmt true true ~with_type x) ctx xl in F.pp_print_space fmt (); @@ -678,13 +678,13 @@ and extract_Lambda (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) else F.pp_print_string fmt "->"; F.pp_print_space fmt (); (* Print the body *) - extract_texpression meta ctx fmt false e; + extract_texpression span ctx fmt false e; (* Close parentheses *) if inside then F.pp_print_string fmt ")"; (* Close the box for the abs expression *) F.pp_close_box fmt () -and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) +and extract_lets (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (e : texpression) : unit = (* Destruct the lets. @@ -710,7 +710,7 @@ and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) *) let lets, next_e = match !backend with - | HOL4 -> destruct_lets_no_interleave meta e + | HOL4 -> destruct_lets_no_interleave span e | FStar | Coq | Lean -> destruct_lets e in (* Extract the let-bindings *) @@ -731,16 +731,16 @@ and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) * TODO: cleanup * *) if monadic && (!backend = Coq || !backend = HOL4) then ( - let ctx = extract_typed_pattern meta ctx fmt true true lv in + let ctx = extract_typed_pattern span ctx fmt true true lv in F.pp_print_space fmt (); let arrow = match !backend with | Coq | HOL4 -> "<-" - | FStar | Lean -> craise __FILE__ __LINE__ meta "impossible" + | FStar | Lean -> craise __FILE__ __LINE__ span "impossible" in F.pp_print_string fmt arrow; F.pp_print_space fmt (); - extract_texpression meta ctx fmt false re; + extract_texpression span ctx fmt false re; F.pp_print_string fmt ";"; ctx) else ( @@ -757,7 +757,7 @@ and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) else ( F.pp_print_string fmt "let"; F.pp_print_space fmt ()); - let ctx = extract_typed_pattern meta ctx fmt true true lv in + let ctx = extract_typed_pattern span ctx fmt true true lv in F.pp_print_space fmt (); let eq = match !backend with @@ -768,7 +768,7 @@ and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) in F.pp_print_string fmt eq; F.pp_print_space fmt (); - extract_texpression meta ctx fmt false re; + extract_texpression span ctx fmt false re; (* End the let-binding *) (match !backend with | Lean -> @@ -796,7 +796,7 @@ and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) if inside && !backend <> Lean then F.pp_print_string fmt "("; (* If Lean and HOL4, we rely on monadic blocks, so we insert a do and open a new box immediately *) - let wrap_in_do_od = lets_require_wrap_in_do meta lets in + let wrap_in_do_od = lets_require_wrap_in_do span lets in if wrap_in_do_od then ( F.pp_print_string fmt "do"; F.pp_print_space fmt ()); @@ -808,7 +808,7 @@ and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (* Open a box for the next expression *) F.pp_open_hovbox fmt ctx.indent_incr; (* Print the next expression *) - extract_texpression meta ctx fmt false next_e; + extract_texpression span ctx fmt false next_e; (* Close the box for the next expression *) F.pp_close_box fmt (); @@ -822,7 +822,7 @@ and extract_lets (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (* Close the box for the whole expression *) F.pp_close_box fmt () -and extract_Switch (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) +and extract_Switch (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (_inside : bool) (scrut : texpression) (body : switch_body) : unit = (* Remark: we don't use the [inside] parameter because we extract matches in a conservative manner: we always make sure they are parenthesized/delimited @@ -842,9 +842,9 @@ and extract_Switch (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) if !backend = Lean && ctx.use_dep_ite then F.pp_print_string fmt " h:"; F.pp_print_space fmt (); let scrut_inside = - PureUtils.texpression_requires_parentheses meta scrut + PureUtils.texpression_requires_parentheses span scrut in - extract_texpression meta ctx fmt scrut_inside scrut; + extract_texpression span ctx fmt scrut_inside scrut; (* Close the box for the [if e] *) F.pp_close_box fmt (); @@ -858,7 +858,7 @@ and extract_Switch (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) let then_or_else = if is_then then "then" else "else" in F.pp_print_string fmt then_or_else; let parenth = - PureUtils.texpression_requires_parentheses meta e_branch + PureUtils.texpression_requires_parentheses span e_branch in (* Open the parenthesized expression *) let print_space_after_parenth = @@ -880,7 +880,7 @@ and extract_Switch (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (* Open a box for the branch *) F.pp_open_hovbox fmt ctx.indent_incr; (* Print the branch expression *) - extract_texpression meta ctx fmt false e_branch; + extract_texpression span ctx fmt false e_branch; (* Close the box for the branch *) F.pp_close_box fmt (); (* Close the parenthesized expression *) @@ -912,9 +912,9 @@ and extract_Switch (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt match_begin; F.pp_print_space fmt (); let scrut_inside = - PureUtils.texpression_requires_parentheses meta scrut + PureUtils.texpression_requires_parentheses span scrut in - extract_texpression meta ctx fmt scrut_inside scrut; + extract_texpression span ctx fmt scrut_inside scrut; F.pp_print_space fmt (); let match_scrut_end = match !backend with FStar | Coq | Lean -> "with" | HOL4 -> "of" @@ -933,7 +933,7 @@ and extract_Switch (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (* Print the pattern *) F.pp_print_string fmt "|"; F.pp_print_space fmt (); - let ctx = extract_typed_pattern meta ctx fmt false false br.pat in + let ctx = extract_typed_pattern span ctx fmt false false br.pat in F.pp_print_space fmt (); let arrow = match !backend with FStar -> "->" | Coq | Lean | HOL4 -> "=>" @@ -945,7 +945,7 @@ and extract_Switch (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (* Open a box for the branch *) F.pp_open_hovbox fmt ctx.indent_incr; (* Print the branch itself *) - extract_texpression meta ctx fmt false br.branch; + extract_texpression span ctx fmt false br.branch; (* Close the box for the branch *) F.pp_close_box fmt (); (* Close the box for the pattern+branch *) @@ -964,12 +964,12 @@ and extract_Switch (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (* Close the box for the whole expression *) F.pp_close_box fmt () -and extract_StructUpdate (meta : Meta.meta) (ctx : extraction_ctx) +and extract_StructUpdate (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (e_ty : ty) (supd : struct_update) : unit = (* We can't update a subset of the fields in Coq (i.e., we can do [{| x:= 3; y := 4 |}], but there is no syntax for [{| s with x := 3 |}]) *) - sanity_check __FILE__ __LINE__ (!backend <> Coq || supd.init = None) meta; + sanity_check __FILE__ __LINE__ (!backend <> Coq || supd.init = None) span; (* In the case of HOL4, records with no fields are not supported and are thus extracted to unit. We need to check that by looking up the definition *) let extract_as_unit = @@ -1034,7 +1034,7 @@ and extract_StructUpdate (meta : Meta.meta) (ctx : extraction_ctx) if need_paren then F.pp_print_string fmt "("; F.pp_open_hvbox fmt ctx.indent_incr; if supd.init <> None then ( - let var_name = ctx_get_var meta (Option.get supd.init) ctx in + let var_name = ctx_get_var span (Option.get supd.init) ctx in F.pp_print_string fmt var_name; F.pp_print_space fmt (); F.pp_print_string fmt "with"; @@ -1053,12 +1053,12 @@ and extract_StructUpdate (meta : Meta.meta) (ctx : extraction_ctx) F.pp_print_space fmt ()) (fun (fid, fe) -> F.pp_open_hvbox fmt ctx.indent_incr; - let f = ctx_get_field meta supd.struct_id fid ctx in + let f = ctx_get_field span supd.struct_id fid ctx in F.pp_print_string fmt f; F.pp_print_string fmt (" " ^ assign); F.pp_print_space fmt (); F.pp_open_hvbox fmt ctx.indent_incr; - extract_texpression meta ctx fmt true fe; + extract_texpression span ctx fmt true fe; F.pp_close_box fmt (); F.pp_close_box fmt ()) supd.updates; @@ -1077,16 +1077,16 @@ and extract_StructUpdate (meta : Meta.meta) (ctx : extraction_ctx) (* Open the box for `Array.replicate T N [` *) F.pp_open_hovbox fmt ctx.indent_incr; (* Print the array constructor *) - let cs = ctx_get_struct meta (TAssumed TArray) ctx in + let cs = ctx_get_struct span (TAssumed TArray) ctx in F.pp_print_string fmt cs; (* Print the parameters *) - let _, generics = ty_as_adt meta e_ty in + let _, generics = ty_as_adt span e_ty in let ty = Collections.List.to_cons_nil generics.types in F.pp_print_space fmt (); - extract_ty meta ctx fmt TypeDeclId.Set.empty true ty; + extract_ty span ctx fmt TypeDeclId.Set.empty true ty; let cg = Collections.List.to_cons_nil generics.const_generics in F.pp_print_space fmt (); - extract_const_generic meta ctx fmt true cg; + extract_const_generic span ctx fmt true cg; F.pp_print_space fmt (); F.pp_print_string fmt "["; (* Close the box for `Array.mk T N [` *) @@ -1101,7 +1101,7 @@ and extract_StructUpdate (meta : Meta.meta) (ctx : extraction_ctx) (fun () -> F.pp_print_string fmt delimiter; F.pp_print_space fmt ()) - (fun (_, fe) -> extract_texpression meta ctx fmt false fe) + (fun (_, fe) -> extract_texpression span ctx fmt false fe) supd.updates; (* Close the boxes *) F.pp_close_box fmt (); @@ -1109,7 +1109,7 @@ and extract_StructUpdate (meta : Meta.meta) (ctx : extraction_ctx) F.pp_print_string fmt "]"; if need_paren then F.pp_print_string fmt ")"; F.pp_close_box fmt () - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" (** A small utility to print the parameters of a function signature. @@ -1143,7 +1143,7 @@ let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx) match def.kind with | TraitItemProvided (decl_id, _) -> let trait_decl = T.TraitDeclId.Map.find decl_id ctx.trans_trait_decls in - let ctx, _ = ctx_add_trait_self_clause def.meta ctx in + let ctx, _ = ctx_add_trait_self_clause def.span ctx in let ctx = { ctx with is_provided_method = true } in (ctx, Some trait_decl) | _ -> (ctx, None) @@ -1151,14 +1151,14 @@ let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx) (* Add the type parameters - note that we need those bindings only for the * body translation (they are not top-level) *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params def.meta def.llbc_name def.signature.llbc_generics + ctx_add_generic_params def.span def.llbc_name def.signature.llbc_generics def.signature.generics ctx in (* Print the generics *) (* Open a box for the generics *) F.pp_open_hovbox fmt 0; (let space = Some space in - extract_generic_params def.meta ctx fmt TypeDeclId.Set.empty ~space + extract_generic_params def.span ctx fmt TypeDeclId.Set.empty ~space ~trait_decl def.signature.generics type_params cg_params trait_clauses); (* Close the box for the generics *) F.pp_close_box fmt (); @@ -1173,11 +1173,11 @@ let extract_fun_parameters (space : bool ref) (ctx : extraction_ctx) (* Open a box for the input parameter *) F.pp_open_hovbox fmt 0; F.pp_print_string fmt "("; - let ctx = extract_typed_pattern def.meta ctx fmt true false lv in + let ctx = extract_typed_pattern def.span ctx fmt true false lv in F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - extract_ty def.meta ctx fmt TypeDeclId.Set.empty false lv.ty; + extract_ty def.span ctx fmt TypeDeclId.Set.empty false lv.ty; F.pp_print_string fmt ")"; (* Close the box for the input parameters *) F.pp_close_box fmt (); @@ -1196,7 +1196,7 @@ let extract_fun_input_parameters_types (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = let extract_param (ty : ty) : unit = let inside = false in - extract_ty def.meta ctx fmt TypeDeclId.Set.empty inside ty; + extract_ty def.span ctx fmt TypeDeclId.Set.empty inside ty; F.pp_print_space fmt (); extract_arrow fmt (); F.pp_print_space fmt () @@ -1206,13 +1206,13 @@ let extract_fun_input_parameters_types (ctx : extraction_ctx) let extract_fun_inputs_output_parameters_types (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = extract_fun_input_parameters_types ctx fmt def; - extract_ty def.meta ctx fmt TypeDeclId.Set.empty false def.signature.output + extract_ty def.span ctx fmt TypeDeclId.Set.empty false def.signature.output -let assert_backend_supports_decreases_clauses (meta : Meta.meta) = +let assert_backend_supports_decreases_clauses (span : Meta.span) = match !backend with | FStar | Lean -> () | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Decreases clauses are only supported for the Lean and F* backends" (** Extract a decreases clause function template body. @@ -1233,13 +1233,13 @@ let assert_backend_supports_decreases_clauses (meta : Meta.meta) = *) let extract_template_fstar_decreases_clause (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = - cassert __FILE__ __LINE__ (!backend = FStar) def.meta + cassert __FILE__ __LINE__ (!backend = FStar) def.span "The generation of template decrease clauses is only supported for the F* \ backend"; (* Retrieve the function name *) let def_name = - ctx_get_termination_measure def.meta def.def_id def.loop_id ctx + ctx_get_termination_measure def.span def.def_id def.loop_id ctx in (* Add a break before *) F.pp_print_break fmt 0 0; @@ -1249,9 +1249,9 @@ let extract_template_fstar_decreases_clause (ctx : extraction_ctx) Some def.llbc_name else None in - extract_comment_with_span ctx fmt + extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]: decreases clause" ] - name def.meta.span); + name def.span.span); F.pp_print_space fmt (); (* Open a box for the definition, so that whenever possible it gets printed on * one line *) @@ -1302,7 +1302,7 @@ let extract_template_fstar_decreases_clause (ctx : extraction_ctx) *) let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = - cassert __FILE__ __LINE__ (!backend = Lean) def.meta + cassert __FILE__ __LINE__ (!backend = Lean) def.span "The generation of template termination and decreasing clauses is only \ supported for the Lean backend"; (* @@ -1310,15 +1310,15 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) *) (* Retrieve the function name *) let def_name = - ctx_get_termination_measure def.meta def.def_id def.loop_id ctx + ctx_get_termination_measure def.span def.def_id def.loop_id ctx in let def_body = Option.get def.body in (* Add a break before *) F.pp_print_break fmt 0 0; (* Print a comment to link the extracted type to its original rust definition *) - extract_comment_with_span ctx fmt + extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]: termination measure" ] - None def.meta.span; + None def.span.span; F.pp_print_space fmt (); (* Open a box for the definition, so that whenever possible it gets printed on * one line *) @@ -1346,7 +1346,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) let vars = List.map (fun (v : var) -> v.id) def_body.inputs in if List.length vars = 1 then - F.pp_print_string fmt (ctx_get_var def.meta (List.hd vars) ctx_body) + F.pp_print_string fmt (ctx_get_var def.span (List.hd vars) ctx_body) else ( F.pp_open_hovbox fmt 0; F.pp_print_string fmt "("; @@ -1354,7 +1354,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (fun () -> F.pp_print_string fmt ","; F.pp_print_space fmt ()) - (fun v -> F.pp_print_string fmt (ctx_get_var def.meta v ctx_body)) + (fun v -> F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) vars; F.pp_print_string fmt ")"; F.pp_close_box fmt ()); @@ -1368,12 +1368,12 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (* * Extract a template for the decreases proof *) - let def_name = ctx_get_decreases_proof def.meta def.def_id def.loop_id ctx in + let def_name = ctx_get_decreases_proof def.span def.def_id def.loop_id ctx in (* syntax <def_name> term ... term : tactic *) F.pp_print_break fmt 0 0; - extract_comment_with_span ctx fmt + extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]: decreases_by tactic" ] - None def.meta.span; + None def.span.span; F.pp_print_space fmt (); F.pp_open_hvbox fmt 0; F.pp_print_string fmt "syntax \""; @@ -1391,7 +1391,7 @@ let extract_template_lean_termination_and_decreasing (ctx : extraction_ctx) (fun v -> F.pp_print_space fmt (); F.pp_print_string fmt "$"; - F.pp_print_string fmt (ctx_get_var def.meta v ctx_body)) + F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) vars; F.pp_print_string fmt ") =>"; F.pp_close_box fmt (); @@ -1418,7 +1418,7 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter) Some def.llbc_name else None in - extract_comment_with_span ctx fmt comment name def.meta.span + extract_comment_with_raw_span ctx fmt comment name def.span.span (** Extract a function declaration. @@ -1429,9 +1429,9 @@ let extract_fun_comment (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (has_decreases_clause : bool) (def : fun_decl) : unit = - sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.meta; + sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.span; (* Retrieve the function name *) - let def_name = ctx_get_local_function def.meta def.def_id def.loop_id ctx in + let def_name = ctx_get_local_function def.span def.def_id def.loop_id ctx in (* Add a break before *) if !backend <> HOL4 || not (decl_is_first_from_group kind) then F.pp_print_break fmt 0 0; @@ -1501,18 +1501,18 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) if is_opaque then extract_fun_input_parameters_types ctx fmt def; (* [Tot] *) if has_decreases_clause then ( - assert_backend_supports_decreases_clauses def.meta; + assert_backend_supports_decreases_clauses def.span; if !backend = FStar then ( F.pp_print_string fmt "Tot"; F.pp_print_space fmt ())); - extract_ty def.meta ctx fmt TypeDeclId.Set.empty has_decreases_clause + extract_ty def.span ctx fmt TypeDeclId.Set.empty has_decreases_clause def.signature.output; (* Close the box for the return type *) F.pp_close_box fmt (); (* Print the decrease clause - rk.: a function with a decreases clause * is necessarily a transparent function *) if has_decreases_clause && !backend = FStar then ( - assert_backend_supports_decreases_clauses def.meta; + assert_backend_supports_decreases_clauses def.span; F.pp_print_space fmt (); (* Open a box for the decreases clause *) F.pp_open_hovbox fmt ctx.indent_incr; @@ -1523,7 +1523,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) F.pp_open_hovbox fmt ctx.indent_incr; (* The name of the decrease clause *) let decr_name = - ctx_get_termination_measure def.meta def.def_id def.loop_id ctx + ctx_get_termination_measure def.span def.def_id def.loop_id ctx in F.pp_print_string fmt decr_name; (* Print the generic parameters - TODO: we do this many @@ -1554,7 +1554,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) List.fold_left (fun ctx (lv : typed_pattern) -> F.pp_print_space fmt (); - let ctx = extract_typed_pattern def.meta ctx fmt true false lv in + let ctx = extract_typed_pattern def.span ctx fmt true false lv in ctx) ctx inputs_lvs in @@ -1581,7 +1581,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) F.pp_open_hvbox fmt 0; (* Extract the body *) let _ = - extract_texpression def.meta ctx_body fmt false (Option.get def.body).body + extract_texpression def.span ctx_body fmt false (Option.get def.body).body in (* Close the box for the body *) F.pp_close_box fmt ()); @@ -1598,7 +1598,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (* termination_by *) let terminates_name = - ctx_get_termination_measure def.meta def.def_id def.loop_id ctx + ctx_get_termination_measure def.span def.def_id def.loop_id ctx in F.pp_print_break fmt 0 0; (* Open a box for the whole [termination_by CALL => DECREASES] *) @@ -1611,7 +1611,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun v -> F.pp_print_space fmt (); - F.pp_print_string fmt (ctx_get_var def.meta v ctx_body)) + F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) all_vars; F.pp_print_space fmt (); F.pp_print_string fmt "=>"; @@ -1631,7 +1631,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun v -> F.pp_print_space fmt (); - F.pp_print_string fmt (ctx_get_var def.meta v ctx_body)) + F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) vars; (* Close the box for [DECREASES] *) F.pp_close_box fmt (); @@ -1642,7 +1642,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (* Open a box for the [decreasing by ...] *) F.pp_open_hvbox fmt ctx.indent_incr; let decreases_name = - ctx_get_decreases_proof def.meta def.def_id def.loop_id ctx + ctx_get_decreases_proof def.span def.def_id def.loop_id ctx in F.pp_print_string fmt "decreasing_by"; F.pp_print_space fmt (); @@ -1651,7 +1651,7 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun v -> F.pp_print_space fmt (); - F.pp_print_string fmt (ctx_get_var def.meta v ctx_body)) + F.pp_print_string fmt (ctx_get_var def.span v ctx_body)) vars; F.pp_close_box fmt (); (* Close the box for the [decreasing by ...] *) @@ -1681,15 +1681,15 @@ let extract_fun_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) (def : fun_decl) : unit = (* Retrieve the definition name *) - let def_name = ctx_get_local_function def.meta def.def_id def.loop_id ctx in + let def_name = ctx_get_local_function def.span def.def_id def.loop_id ctx in cassert __FILE__ __LINE__ (def.signature.generics.const_generics = []) - def.meta + def.span "Constant generics are not supported yet when generating code for HOL4"; (* Add the type/const gen parameters - note that we need those bindings only for the generation of the type (they are not top-level) *) let ctx, _, _, _ = - ctx_add_generic_params def.meta def.llbc_name def.signature.llbc_generics + ctx_add_generic_params def.span def.llbc_name def.signature.llbc_generics def.signature.generics ctx in (* Add breaks to insert new lines between definitions *) @@ -1706,7 +1706,7 @@ let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt "“:"; (* Generate the type *) extract_fun_input_parameters_types ctx fmt def; - extract_ty def.meta ctx fmt TypeDeclId.Set.empty false def.signature.output; + extract_ty def.span ctx fmt TypeDeclId.Set.empty false def.signature.output; (* Close the box for the type *) F.pp_print_string fmt "”"; F.pp_close_box fmt (); @@ -1731,7 +1731,7 @@ let extract_fun_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_fun_decl (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (has_decreases_clause : bool) (def : fun_decl) : unit = - sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.meta; + sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.span; (* We treat HOL4 opaque functions in a specific manner *) if !backend = HOL4 && Option.is_none def.body then extract_fun_decl_hol4_opaque ctx fmt def @@ -1744,7 +1744,7 @@ let extract_fun_decl (ctx : extraction_ctx) (fmt : F.formatter) extracted to two declarations, and we can actually factor out the generation of those declarations. See {!extract_global_decl} for more explanations. *) -let extract_global_decl_body_gen (meta : Meta.meta) (ctx : extraction_ctx) +let extract_global_decl_body_gen (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (name : string) (generics : generic_params) (type_params : string list) (cg_params : string list) (trait_clauses : string list) (ty : ty) @@ -1777,7 +1777,7 @@ let extract_global_decl_body_gen (meta : Meta.meta) (ctx : extraction_ctx) (* Extract the generic parameters *) let space = ref true in - extract_generic_params meta ctx fmt TypeDeclId.Set.empty ~space:(Some space) + extract_generic_params span ctx fmt TypeDeclId.Set.empty ~space:(Some space) generics type_params cg_params trait_clauses; if not !space then F.pp_print_space fmt (); @@ -1790,7 +1790,7 @@ let extract_global_decl_body_gen (meta : Meta.meta) (ctx : extraction_ctx) (* Open "TYPE" box (depth=3) *) F.pp_open_hovbox fmt ctx.indent_incr; (* Print "TYPE" *) - extract_ty meta ctx fmt TypeDeclId.Set.empty false ty; + extract_ty span ctx fmt TypeDeclId.Set.empty false ty; (* Close "TYPE" box (depth=3) *) F.pp_close_box fmt (); @@ -1836,7 +1836,7 @@ let extract_global_decl_body_gen (meta : Meta.meta) (ctx : extraction_ctx) Remark (SH): having to treat this specific case separately is very annoying, but I could not find a better way. *) -let extract_global_decl_hol4_opaque (meta : Meta.meta) (ctx : extraction_ctx) +let extract_global_decl_hol4_opaque (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (name : string) (generics : generic_params) (ty : ty) : unit = (* TODO: non-empty generics *) @@ -1850,7 +1850,7 @@ let extract_global_decl_hol4_opaque (meta : Meta.meta) (ctx : extraction_ctx) F.pp_close_box fmt (); (* Print the type *) F.pp_open_hovbox fmt 0; - extract_ty meta ctx fmt TypeDeclId.Set.empty false ty; + extract_ty span ctx fmt TypeDeclId.Set.empty false ty; (* Close the definition *) F.pp_print_string fmt ")"; F.pp_close_box fmt (); @@ -1881,9 +1881,9 @@ let extract_global_decl_hol4_opaque (meta : Meta.meta) (ctx : extraction_ctx) *) let extract_global_decl_aux (ctx : extraction_ctx) (fmt : F.formatter) (global : global_decl) (body : fun_decl) (interface : bool) : unit = - let meta = body.meta in - sanity_check __FILE__ __LINE__ body.is_global_decl_body meta; - sanity_check __FILE__ __LINE__ (body.signature.inputs = []) meta; + let span = body.span in + sanity_check __FILE__ __LINE__ body.is_global_decl_body span; + sanity_check __FILE__ __LINE__ (body.signature.inputs = []) span; (* Add a break then the name of the corresponding LLBC declaration *) F.pp_print_break fmt 0 0; @@ -1892,26 +1892,26 @@ let extract_global_decl_aux (ctx : extraction_ctx) (fmt : F.formatter) Some global.llbc_name else None in - extract_comment_with_span ctx fmt + extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx global.llbc_name ^ "]" ] - name global.meta.span; + name global.span.span; F.pp_print_space fmt (); - let decl_name = ctx_get_global meta global.def_id ctx in + let decl_name = ctx_get_global span global.def_id ctx in let body_name = - ctx_get_function meta + ctx_get_function span (FromLlbc (Pure.FunId (FRegular global.body_id), None)) ctx in let decl_ty, body_ty = let ty = body.signature.output in if body.signature.fwd_info.effect_info.can_fail then - (unwrap_result_ty meta ty, ty) + (unwrap_result_ty span ty, ty) else (ty, mk_result_ty ty) in (* Add the type parameters *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params meta global.llbc_name global.llbc_generics + ctx_add_generic_params span global.llbc_name global.llbc_generics global.generics ctx in match body.body with @@ -1919,20 +1919,20 @@ let extract_global_decl_aux (ctx : extraction_ctx) (fmt : F.formatter) (* No body: only generate a [val x_c : u32] declaration *) let kind = if interface then Declared else Assumed in if !backend = HOL4 then - extract_global_decl_hol4_opaque meta ctx fmt decl_name global.generics + extract_global_decl_hol4_opaque span ctx fmt decl_name global.generics decl_ty else - extract_global_decl_body_gen meta ctx fmt kind decl_name global.generics + extract_global_decl_body_gen span ctx fmt kind decl_name global.generics type_params cg_params trait_clauses decl_ty None | Some body -> (* There is a body *) (* Generate: [let x_body : result u32 = Return 3] *) - extract_global_decl_body_gen meta ctx fmt SingleNonRec body_name + extract_global_decl_body_gen span ctx fmt SingleNonRec body_name global.generics type_params cg_params trait_clauses body_ty - (Some (fun fmt -> extract_texpression meta ctx fmt false body.body)); + (Some (fun fmt -> extract_texpression span ctx fmt false body.body)); F.pp_print_break fmt 0 0; (* Generate: [let x_c : u32 = eval_global x_body] *) - extract_global_decl_body_gen meta ctx fmt SingleNonRec decl_name + extract_global_decl_body_gen span ctx fmt SingleNonRec decl_name global.generics type_params cg_params trait_clauses decl_ty (Some (fun fmt -> @@ -2007,7 +2007,7 @@ let extract_trait_decl_register_parent_clause_names (ctx : extraction_ctx) (* Register the names *) List.fold_left (fun ctx (cid, cname) -> - ctx_add trait_decl.meta + ctx_add trait_decl.span (TraitParentClauseId (trait_decl.def_id, cid)) cname ctx) ctx clause_names @@ -2042,7 +2042,7 @@ let extract_trait_decl_register_constant_names (ctx : extraction_ctx) (* Register the names *) List.fold_left (fun ctx (item_name, name) -> - ctx_add trait_decl.meta + ctx_add trait_decl.span (TraitItemId (trait_decl.def_id, item_name)) name ctx) ctx constant_names @@ -2103,13 +2103,13 @@ let extract_trait_decl_type_names (ctx : extraction_ctx) List.fold_left (fun ctx (item_name, (type_name, clauses)) -> let ctx = - ctx_add trait_decl.meta + ctx_add trait_decl.span (TraitItemId (trait_decl.def_id, item_name)) type_name ctx in List.fold_left (fun ctx (clause_id, clause_name) -> - ctx_add trait_decl.meta + ctx_add trait_decl.span (TraitItemClauseId (trait_decl.def_id, item_name, clause_id)) clause_name ctx) ctx clauses) @@ -2161,7 +2161,7 @@ let extract_trait_decl_method_names (ctx : extraction_ctx) (* Register the names *) List.fold_left (fun ctx (item_name, fun_name) -> - ctx_add trait_decl.meta + ctx_add trait_decl.span (TraitMethodId (trait_decl.def_id, item_name)) fun_name ctx) ctx method_names @@ -2184,9 +2184,9 @@ let extract_trait_decl_register_names (ctx : extraction_ctx) | Some info -> (info.extract_name, info.constructor) in let ctx = - ctx_add trait_decl.meta (TraitDeclId trait_decl.def_id) trait_name ctx + ctx_add trait_decl.span (TraitDeclId trait_decl.def_id) trait_name ctx in - ctx_add trait_decl.meta (TraitDeclConstructorId trait_decl.def_id) + ctx_add trait_decl.span (TraitDeclConstructorId trait_decl.def_id) trait_constructor ctx in (* Parent clauses *) @@ -2243,7 +2243,7 @@ let extract_trait_impl_register_names (ctx : extraction_ctx) (* For now we do not support overriding provided methods *) cassert __FILE__ __LINE__ (trait_impl.provided_methods = []) - trait_impl.meta + trait_impl.span ("Overriding trait provided methods in trait implementations is not \ supported yet (overriden methods: " ^ String.concat ", " (List.map fst trait_impl.provided_methods) @@ -2256,7 +2256,7 @@ let extract_trait_impl_register_names (ctx : extraction_ctx) | None -> ctx_compute_trait_impl_name ctx trait_decl trait_impl | Some name -> name in - ctx_add trait_decl.meta (TraitImplId trait_impl.def_id) name ctx + ctx_add trait_decl.span (TraitImplId trait_impl.def_id) name ctx (** Small helper. @@ -2305,7 +2305,7 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let trans = A.FunDeclId.Map.find id ctx.trans_funs in (* Extract the items *) let f = trans.f in - let fun_name = ctx_get_trait_method decl.meta decl.def_id item_name ctx in + let fun_name = ctx_get_trait_method decl.span decl.def_id item_name ctx in let ty () = (* Extract the generics *) (* We need to add the generics specific to the method, by removing those @@ -2321,7 +2321,7 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter) - we only generate trait clauses for the clauses we find in the pure generics *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params decl.meta f.llbc_name f.signature.llbc_generics + ctx_add_generic_params decl.span f.llbc_name f.signature.llbc_generics generics ctx in let backend_uses_forall = @@ -2331,7 +2331,7 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let use_forall = generics_not_empty && backend_uses_forall in let use_arrows = generics_not_empty && not backend_uses_forall in let use_forall_use_sep = false in - extract_generic_params decl.meta ctx fmt TypeDeclId.Set.empty ~use_forall + extract_generic_params decl.span ctx fmt TypeDeclId.Set.empty ~use_forall ~use_forall_use_sep ~use_arrows generics type_params cg_params trait_clauses; if use_forall then F.pp_print_string fmt ","; @@ -2345,7 +2345,7 @@ let extract_trait_decl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (decl : trait_decl) : unit = (* Retrieve the trait name *) - let decl_name = ctx_get_trait_decl decl.meta decl.def_id ctx in + let decl_name = ctx_get_trait_decl decl.span decl.def_id ctx in (* Add a break before *) F.pp_print_break fmt 0 0; (* Print a comment to link the extracted type to its original rust definition *) @@ -2354,9 +2354,9 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) Some decl.llbc_name else None in - extract_comment_with_span ctx fmt + extract_comment_with_raw_span ctx fmt [ "Trait declaration: [" ^ name_to_string ctx decl.llbc_name ^ "]" ] - name decl.meta.span); + name decl.span.span); F.pp_print_break fmt 0 0; (* Open two outer boxes for the definition, so that whenever possible it gets printed on one line and indents are correct. @@ -2373,7 +2373,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (* Open the box for the name + generics *) F.pp_open_hovbox fmt ctx.indent_incr; let qualif = - Option.get (type_decl_kind_to_qualif decl.meta SingleNonRec (Some Struct)) + Option.get (type_decl_kind_to_qualif decl.span SingleNonRec (Some Struct)) in (* When checking if the trait declaration is empty: we ignore the provided methods, because for now they are extracted separately *) @@ -2389,10 +2389,10 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (* Add the type and const generic params - note that we need those bindings only for the * body translation (they are not top-level) *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params decl.meta decl.llbc_name decl.llbc_generics generics + ctx_add_generic_params decl.span decl.llbc_name decl.llbc_generics generics ctx in - extract_generic_params decl.meta ctx fmt TypeDeclId.Set.empty generics + extract_generic_params decl.span ctx fmt TypeDeclId.Set.empty generics type_params cg_params trait_clauses; F.pp_print_space fmt (); @@ -2402,7 +2402,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) F.pp_close_box fmt ()) else if is_empty && !backend = Coq then ( (* Coq is not very good at infering constructors *) - let cons = ctx_get_trait_constructor decl.meta decl.def_id ctx in + let cons = ctx_get_trait_constructor decl.span decl.def_id ctx in F.pp_print_string fmt (":= " ^ cons ^ "{}."); (* Outer box *) F.pp_close_box fmt ()) @@ -2411,7 +2411,7 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) | Lean -> F.pp_print_string fmt "where" | FStar -> F.pp_print_string fmt "= {" | Coq -> - let cons = ctx_get_trait_constructor decl.meta decl.def_id ctx in + let cons = ctx_get_trait_constructor decl.span decl.def_id ctx in F.pp_print_string fmt (":= " ^ cons ^ " {") | _ -> F.pp_print_string fmt "{"); @@ -2425,11 +2425,11 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) (* The constants *) List.iter (fun (name, (ty, _)) -> - let item_name = ctx_get_trait_const decl.meta decl.def_id name ctx in + let item_name = ctx_get_trait_const decl.span decl.def_id name ctx in let ty () = let inside = false in F.pp_print_space fmt (); - extract_ty decl.meta ctx fmt TypeDeclId.Set.empty inside ty + extract_ty decl.span ctx fmt TypeDeclId.Set.empty inside ty in extract_trait_decl_item ctx fmt item_name ty) decl.consts; @@ -2438,22 +2438,22 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun (name, (clauses, _)) -> (* Extract the type *) - let item_name = ctx_get_trait_type decl.meta decl.def_id name ctx in + let item_name = ctx_get_trait_type decl.span decl.def_id name ctx in let ty () = F.pp_print_space fmt (); - F.pp_print_string fmt (type_keyword decl.meta) + F.pp_print_string fmt (type_keyword decl.span) in extract_trait_decl_item ctx fmt item_name ty; (* Extract the clauses *) List.iter (fun clause -> let item_name = - ctx_get_trait_item_clause decl.meta decl.def_id name + ctx_get_trait_item_clause decl.span decl.def_id name clause.clause_id ctx in let ty () = F.pp_print_space fmt (); - extract_trait_clause_type decl.meta ctx fmt TypeDeclId.Set.empty + extract_trait_clause_type decl.span ctx fmt TypeDeclId.Set.empty clause in extract_trait_decl_item ctx fmt item_name ty) @@ -2465,11 +2465,11 @@ let extract_trait_decl (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun clause -> let item_name = - ctx_get_trait_parent_clause decl.meta decl.def_id clause.clause_id ctx + ctx_get_trait_parent_clause decl.span decl.def_id clause.clause_id ctx in let ty () = F.pp_print_space fmt (); - extract_trait_clause_type decl.meta ctx fmt TypeDeclId.Set.empty + extract_trait_clause_type decl.span ctx fmt TypeDeclId.Set.empty clause in extract_trait_decl_item ctx fmt item_name ty) @@ -2507,25 +2507,25 @@ let extract_trait_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) in if num_params > 0 then ( (* The constructor *) - let cons_name = ctx_get_trait_constructor decl.meta decl.def_id ctx in + let cons_name = ctx_get_trait_constructor decl.span decl.def_id ctx in extract_coq_arguments_instruction ctx fmt cons_name num_params; (* The constants *) List.iter (fun (name, _) -> - let item_name = ctx_get_trait_const decl.meta decl.def_id name ctx in + let item_name = ctx_get_trait_const decl.span decl.def_id name ctx in extract_coq_arguments_instruction ctx fmt item_name num_params) decl.consts; (* The types *) List.iter (fun (name, (clauses, _)) -> (* The type *) - let item_name = ctx_get_trait_type decl.meta decl.def_id name ctx in + let item_name = ctx_get_trait_type decl.span decl.def_id name ctx in extract_coq_arguments_instruction ctx fmt item_name num_params; (* The type clauses *) List.iter (fun clause -> let item_name = - ctx_get_trait_item_clause decl.meta decl.def_id name + ctx_get_trait_item_clause decl.span decl.def_id name clause.clause_id ctx in extract_coq_arguments_instruction ctx fmt item_name num_params) @@ -2535,7 +2535,7 @@ let extract_trait_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun clause -> let item_name = - ctx_get_trait_parent_clause decl.meta decl.def_id clause.clause_id ctx + ctx_get_trait_parent_clause decl.span decl.def_id clause.clause_id ctx in extract_coq_arguments_instruction ctx fmt item_name num_params) decl.parent_clauses; @@ -2544,7 +2544,7 @@ let extract_trait_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) (fun (item_name, _) -> (* Extract the items *) let item_name = - ctx_get_trait_method decl.meta decl.def_id item_name ctx + ctx_get_trait_method decl.span decl.def_id item_name ctx in extract_coq_arguments_instruction ctx fmt item_name num_params) decl.required_methods; @@ -2570,7 +2570,7 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter) let trans = A.FunDeclId.Map.find id ctx.trans_funs in (* Extract the items *) let f = trans.f in - let fun_name = ctx_get_trait_method impl.meta trait_decl_id item_name ctx in + let fun_name = ctx_get_trait_method impl.span trait_decl_id item_name ctx in let ty () = (* Filter the generics if the method is a builtin *) let i_tys, _, _ = impl_generics in @@ -2610,16 +2610,16 @@ let extract_trait_impl_method_items (ctx : extraction_ctx) (fmt : F.formatter) - we only generate trait clauses for the clauses we find in the pure generics *) let ctx, f_tys, f_cgs, f_tcs = - ctx_add_generic_params impl.meta f.llbc_name f.signature.llbc_generics + ctx_add_generic_params impl.span f.llbc_name f.signature.llbc_generics f_generics ctx in let use_forall = f_generics <> empty_generic_params in - extract_generic_params impl.meta ctx fmt TypeDeclId.Set.empty ~use_forall + extract_generic_params impl.span ctx fmt TypeDeclId.Set.empty ~use_forall f_generics f_tys f_cgs f_tcs; if use_forall then F.pp_print_string fmt ","; (* Extract the function call *) F.pp_print_space fmt (); - let fun_name = ctx_get_local_function impl.meta f.def_id None ctx in + let fun_name = ctx_get_local_function impl.span f.def_id None ctx in F.pp_print_string fmt fun_name; let all_generics = let _, i_cgs, i_tcs = impl_generics in @@ -2640,7 +2640,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) (impl : trait_impl) : unit = log#ldebug (lazy ("extract_trait_impl: " ^ name_to_string ctx impl.llbc_name)); (* Retrieve the impl name *) - let impl_name = ctx_get_trait_impl impl.meta impl.def_id ctx in + let impl_name = ctx_get_trait_impl impl.span impl.def_id ctx in (* Add a break before *) F.pp_print_break fmt 0 0; (* Print a comment to link the extracted type to its original rust definition *) @@ -2653,10 +2653,10 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) Some (trait_decl.llbc_generics, decl_ref.decl_generics) ) else (None, None) in - extract_comment_with_span ctx fmt + extract_comment_with_raw_span ctx fmt [ "Trait implementation: [" ^ name_to_string ctx impl.llbc_name ^ "]" ] (* TODO: why option option for the generics? Looks like a bug in OCaml!? *) - name ?generics:(Some generics) impl.meta.span); + name ?generics:(Some generics) impl.span.span); F.pp_print_break fmt 0 0; (* Open two outer boxes for the definition, so that whenever possible it gets printed on @@ -2686,18 +2686,18 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) (* Add the type and const generic params - note that we need those bindings only for the * body translation (they are not top-level) *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params impl.meta impl.llbc_name impl.llbc_generics + ctx_add_generic_params impl.span impl.llbc_name impl.llbc_generics impl.generics ctx in let all_generics = (type_params, cg_params, trait_clauses) in - extract_generic_params impl.meta ctx fmt TypeDeclId.Set.empty impl.generics + extract_generic_params impl.span ctx fmt TypeDeclId.Set.empty impl.generics type_params cg_params trait_clauses; (* Print the type *) F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - extract_trait_decl_ref impl.meta ctx fmt TypeDeclId.Set.empty false + extract_trait_decl_ref impl.span ctx fmt TypeDeclId.Set.empty false impl.impl_trait; (* When checking if the trait impl is empty: we ignore the provided @@ -2712,7 +2712,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) else if is_empty && !Config.backend = Coq then ( (* Coq is not very good at infering constructors *) let cons = - ctx_get_trait_constructor impl.meta impl.impl_trait.trait_decl_id ctx + ctx_get_trait_constructor impl.span impl.impl_trait.trait_decl_id ctx in F.pp_print_string fmt (":= " ^ cons ^ "."); (* Outer box *) @@ -2737,12 +2737,12 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) (* The constants *) List.iter (fun (provided_id, (name, (_, id))) -> - let item_name = ctx_get_trait_const impl.meta trait_decl_id name ctx in + let item_name = ctx_get_trait_const impl.span trait_decl_id name ctx in (* The parameters are not the same depending on whether the constant is a provided constant or not *) let print_params () = if provided_id = Some id then - extract_generic_args impl.meta ctx fmt TypeDeclId.Set.empty + extract_generic_args impl.span ctx fmt TypeDeclId.Set.empty impl.impl_trait.decl_generics else let all_params = @@ -2756,7 +2756,7 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) in let ty () = F.pp_print_space fmt (); - F.pp_print_string fmt (ctx_get_global impl.meta id ctx); + F.pp_print_string fmt (ctx_get_global impl.span id ctx); print_params () in @@ -2767,22 +2767,22 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun (name, (trait_refs, ty)) -> (* Extract the type *) - let item_name = ctx_get_trait_type impl.meta trait_decl_id name ctx in + let item_name = ctx_get_trait_type impl.span trait_decl_id name ctx in let ty () = F.pp_print_space fmt (); - extract_ty impl.meta ctx fmt TypeDeclId.Set.empty false ty + extract_ty impl.span ctx fmt TypeDeclId.Set.empty false ty in extract_trait_impl_item ctx fmt item_name ty; (* Extract the clauses *) TraitClauseId.iteri (fun clause_id trait_ref -> let item_name = - ctx_get_trait_item_clause impl.meta trait_decl_id name clause_id + ctx_get_trait_item_clause impl.span trait_decl_id name clause_id ctx in let ty () = F.pp_print_space fmt (); - extract_trait_ref impl.meta ctx fmt TypeDeclId.Set.empty false + extract_trait_ref impl.span ctx fmt TypeDeclId.Set.empty false trait_ref in extract_trait_impl_item ctx fmt item_name ty) @@ -2793,11 +2793,11 @@ let extract_trait_impl (ctx : extraction_ctx) (fmt : F.formatter) TraitClauseId.iteri (fun clause_id trait_ref -> let item_name = - ctx_get_trait_parent_clause impl.meta trait_decl_id clause_id ctx + ctx_get_trait_parent_clause impl.span trait_decl_id clause_id ctx in let ty () = F.pp_print_space fmt (); - extract_trait_ref impl.meta ctx fmt TypeDeclId.Set.empty false + extract_trait_ref impl.span ctx fmt TypeDeclId.Set.empty false trait_ref in extract_trait_impl_item ctx fmt item_name ty) @@ -2862,7 +2862,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt "("; let fun_name = - ctx_get_local_function def.meta def.def_id def.loop_id ctx + ctx_get_local_function def.span def.def_id def.loop_id ctx in F.pp_print_string fmt fun_name; if sg.inputs <> [] then ( @@ -2872,7 +2872,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt "="; F.pp_print_space fmt (); let success = - ctx_get_variant def.meta (TAssumed TResult) result_ok_id ctx + ctx_get_variant def.span (TAssumed TResult) result_ok_id ctx in F.pp_print_string fmt (success ^ " ())") | Coq -> @@ -2880,7 +2880,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt "("; let fun_name = - ctx_get_local_function def.meta def.def_id def.loop_id ctx + ctx_get_local_function def.span def.def_id def.loop_id ctx in F.pp_print_string fmt fun_name; if sg.inputs <> [] then ( @@ -2893,7 +2893,7 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt "("; let fun_name = - ctx_get_local_function def.meta def.def_id def.loop_id ctx + ctx_get_local_function def.span def.def_id def.loop_id ctx in F.pp_print_string fmt fun_name; if sg.inputs <> [] then ( @@ -2903,14 +2903,14 @@ let extract_unit_test_if_unit_fun (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt "=="; F.pp_print_space fmt (); let success = - ctx_get_variant def.meta (TAssumed TResult) result_ok_id ctx + ctx_get_variant def.span (TAssumed TResult) result_ok_id ctx in F.pp_print_string fmt (success ^ " ())") | HOL4 -> F.pp_print_string fmt "val _ = assert_ok ("; F.pp_print_string fmt "“"; let fun_name = - ctx_get_local_function def.meta def.def_id def.loop_id ctx + ctx_get_local_function def.span def.def_id def.loop_id ctx in F.pp_print_string fmt fun_name; if sg.inputs <> [] then ( diff --git a/compiler/ExtractBase.ml b/compiler/ExtractBase.ml index f2686cc6..ab7eb50c 100644 --- a/compiler/ExtractBase.ml +++ b/compiler/ExtractBase.ml @@ -237,7 +237,7 @@ module IdSet = Collections.MakeSet (IdOrderedType) *) type names_map = { id_to_name : string IdMap.t; - name_to_id : (id * Meta.meta option) StringMap.t; + name_to_id : (id * Meta.span option) StringMap.t; (** The name to id map is used to look for name clashes, and generate nice debugging messages: if there is a name clash, it is useful to know precisely which identifiers are mapped to the same name... @@ -254,15 +254,15 @@ let empty_names_map : names_map = (** Small helper to report name collision *) let report_name_collision (id_to_string : id -> string) - ((id1, meta1) : id * Meta.meta option) (id2 : id) (meta2 : Meta.meta option) + ((id1, span1) : id * Meta.span option) (id2 : id) (span2 : Meta.span option) (name : string) : unit = - let meta_to_string (meta : Meta.meta option) = - match meta with + let span_to_string (span : Meta.span option) = + match span with | None -> "" - | Some meta -> "\n " ^ Errors.meta_to_string meta + | Some span -> "\n " ^ Errors.span_to_string span in - let id1 = "\n- " ^ id_to_string id1 ^ meta_to_string meta1 in - let id2 = "\n- " ^ id_to_string id2 ^ meta_to_string meta2 in + let id1 = "\n- " ^ id_to_string id1 ^ span_to_string span1 in + let id2 = "\n- " ^ id_to_string id2 ^ span_to_string span2 in let err = "Name clash detected: the following identifiers are bound to the same name \ \"" ^ name ^ "\":" ^ id1 ^ id2 @@ -270,36 +270,36 @@ let report_name_collision (id_to_string : id -> string) in (* Register the error. - We don't link this error to any meta information because we already put + We don't link this error to any span information because we already put the span information about the two problematic definitions in the error message above. *) save_error __FILE__ __LINE__ None err let names_map_get_id_from_name (name : string) (nm : names_map) : - (id * Meta.meta option) option = + (id * Meta.span option) option = StringMap.find_opt name nm.name_to_id let names_map_check_collision (id_to_string : id -> string) (id : id) - (meta : Meta.meta option) (name : string) (nm : names_map) : unit = + (span : Meta.span option) (name : string) (nm : names_map) : unit = match names_map_get_id_from_name name nm with | None -> () (* Ok *) | Some clash -> (* There is a clash: print a nice debugging message for the user *) - report_name_collision id_to_string clash id meta name + report_name_collision id_to_string clash id span name (** Insert bindings in a names map without checking for collisions *) -let names_map_add_unchecked ((id, meta) : id * Meta.meta option) (name : string) +let names_map_add_unchecked ((id, span) : id * Meta.span option) (name : string) (nm : names_map) : names_map = (* Insert *) let id_to_name = IdMap.add id name nm.id_to_name in - let name_to_id = StringMap.add name (id, meta) nm.name_to_id in + let name_to_id = StringMap.add name (id, span) nm.name_to_id in let names_set = StringSet.add name nm.names_set in { id_to_name; name_to_id; names_set } -let names_map_add (id_to_string : id -> string) ((id, meta) : id * meta option) +let names_map_add (id_to_string : id -> string) ((id, span) : id * span option) (name : string) (nm : names_map) : names_map = (* Check if there is a clash *) - names_map_check_collision id_to_string id meta name nm; + names_map_check_collision id_to_string id span name nm; (* Sanity check *) (if StringSet.mem name nm.names_set then let err = @@ -307,9 +307,9 @@ let names_map_add (id_to_string : id -> string) ((id, meta) : id * meta option) ^ ":\nThe chosen name is already in the names set: " ^ name in (* If we fail hard on errors, raise an exception *) - save_error __FILE__ __LINE__ meta err); + save_error __FILE__ __LINE__ span err); (* Insert *) - names_map_add_unchecked (id, meta) name nm + names_map_add_unchecked (id, span) name nm (** The unsafe names map stores mappings from identifiers to names which might collide. For some backends and some names, it might be acceptable to have @@ -396,7 +396,7 @@ let allow_collisions (id : id) : bool = (** The [id_to_string] function to print nice debugging messages if there are collisions *) let names_maps_add (id_to_string : id -> string) (id : id) - (meta : Meta.meta option) (name : string) (nm : names_maps) : names_maps = + (span : Meta.span option) (name : string) (nm : names_maps) : names_maps = (* We do not use the same name map if we allow/disallow collisions. We notably use it for field names: some backends like Lean can use the type information to disambiguate field projections. @@ -411,7 +411,7 @@ let names_maps_add (id_to_string : id -> string) (id : id) *) if allow_collisions id then ( (* Check with the ids which are considered to be strict on collisions *) - names_map_check_collision id_to_string id meta name nm.strict_names_map; + names_map_check_collision id_to_string id span name nm.strict_names_map; { nm with unsafe_names_map = unsafe_names_map_add id name nm.unsafe_names_map; @@ -426,15 +426,15 @@ let names_maps_add (id_to_string : id -> string) (id : id) *) let strict_names_map = if strict_collisions id then - names_map_add id_to_string (id, meta) name nm.strict_names_map + names_map_add id_to_string (id, span) name nm.strict_names_map else nm.strict_names_map in - let names_map = names_map_add id_to_string (id, meta) name nm.names_map in + let names_map = names_map_add id_to_string (id, span) name nm.names_map in { nm with strict_names_map; names_map } (** The [id_to_string] function to print nice debugging messages if there are collisions *) -let names_maps_get (meta : Meta.meta option) (id_to_string : id -> string) +let names_maps_get (span : Meta.span option) (id_to_string : id -> string) (id : id) (nm : names_maps) : string = (* We do not use the same name map if we allow/disallow collisions *) let map_to_string (m : string IdMap.t) : string = @@ -454,7 +454,7 @@ let names_maps_get (meta : Meta.meta option) (id_to_string : id -> string) "Could not find: " ^ id_to_string id ^ "\nNames map:\n" ^ map_to_string m in - save_error __FILE__ __LINE__ meta err; + save_error __FILE__ __LINE__ span err; "(%%%ERROR: unknown identifier\": " ^ id_to_string id ^ "\"%%%)") else let m = nm.names_map.id_to_name in @@ -465,7 +465,7 @@ let names_maps_get (meta : Meta.meta option) (id_to_string : id -> string) "Could not find: " ^ id_to_string id ^ "\nNames map:\n" ^ map_to_string m in - save_error __FILE__ __LINE__ meta err; + save_error __FILE__ __LINE__ span err; "(ERROR: \"" ^ id_to_string id ^ "\")" type names_map_init = { @@ -491,9 +491,9 @@ let names_maps_add_assumed_variant (id_to_string : id -> string) names_maps_add id_to_string (VariantId (TAssumed id, variant_id)) None name nm let names_maps_add_function (id_to_string : id -> string) - ((fid, meta) : fun_id * meta option) (name : string) (nm : names_maps) : + ((fid, span) : fun_id * span option) (name : string) (nm : names_maps) : names_maps = - names_maps_add id_to_string (FunId fid) meta name nm + names_maps_add id_to_string (FunId fid) span name nm let bool_name () = if !backend = Lean then "Bool" else "bool" let char_name () = if !backend = Lean then "Char" else "char" @@ -537,7 +537,7 @@ let scalar_name (ty : literal_type) : string = functions, etc. *) type extraction_ctx = { - (* mutable _meta : Meta.meta; *) + (* mutable _span : Meta.span; *) crate : A.crate; trans_ctx : trans_ctx; names_maps : names_maps; @@ -599,17 +599,17 @@ let llbc_fun_id_to_string (ctx : extraction_ctx) = let fun_id_to_string (ctx : extraction_ctx) = PrintPure.regular_fun_id_to_string (extraction_ctx_to_fmt_env ctx) -let adt_variant_to_string (meta : Meta.meta option) (ctx : extraction_ctx) = - PrintPure.adt_variant_to_string ~meta (extraction_ctx_to_fmt_env ctx) +let adt_variant_to_string (span : Meta.span option) (ctx : extraction_ctx) = + PrintPure.adt_variant_to_string ~span (extraction_ctx_to_fmt_env ctx) -let adt_field_to_string (meta : Meta.meta option) (ctx : extraction_ctx) = - PrintPure.adt_field_to_string ~meta (extraction_ctx_to_fmt_env ctx) +let adt_field_to_string (span : Meta.span option) (ctx : extraction_ctx) = + PrintPure.adt_field_to_string ~span (extraction_ctx_to_fmt_env ctx) (** Debugging function, used when communicating name collisions to the user, and also to print ids for internal debugging (in case of lookup miss for instance). *) -let id_to_string (meta : Meta.meta option) (id : id) (ctx : extraction_ctx) : +let id_to_string (span : Meta.span option) (id : id) (ctx : extraction_ctx) : string = let trait_decl_id_to_string (id : A.TraitDeclId.id) : string = let trait_name = trait_decl_id_to_string ctx id in @@ -638,11 +638,11 @@ let id_to_string (meta : Meta.meta option) (id : id) (ctx : extraction_ctx) : | StructId id -> "struct constructor of: " ^ type_id_to_string ctx id | VariantId (id, variant_id) -> let type_name = type_id_to_string ctx id in - let variant_name = adt_variant_to_string meta ctx id (Some variant_id) in + let variant_name = adt_variant_to_string span ctx id (Some variant_id) in "type name: " ^ type_name ^ ", variant name: " ^ variant_name | FieldId (id, field_id) -> let type_name = type_id_to_string ctx id in - let field_name = adt_field_to_string meta ctx id field_id in + let field_name = adt_field_to_string span ctx id field_id in "type name: " ^ type_name ^ ", field name: " ^ field_name | UnknownId -> "keyword" | TypeVarId id -> "type_var_id: " ^ TypeVarId.to_string id @@ -668,119 +668,119 @@ let id_to_string (meta : Meta.meta option) (id : id) (ctx : extraction_ctx) : trait_decl_id_to_string trait_decl_id ^ ", method name: " ^ fun_name | TraitSelfClauseId -> "trait_self_clause" -let ctx_add (meta : Meta.meta) (id : id) (name : string) (ctx : extraction_ctx) +let ctx_add (span : Meta.span) (id : id) (name : string) (ctx : extraction_ctx) : extraction_ctx = - let id_to_string (id : id) : string = id_to_string (Some meta) id ctx in + let id_to_string (id : id) : string = id_to_string (Some span) id ctx in let names_maps = - names_maps_add id_to_string id (Some meta) name ctx.names_maps + names_maps_add id_to_string id (Some span) name ctx.names_maps in { ctx with names_maps } -let ctx_get (meta : Meta.meta option) (id : id) (ctx : extraction_ctx) : string +let ctx_get (span : Meta.span option) (id : id) (ctx : extraction_ctx) : string = - let id_to_string (id : id) : string = id_to_string meta id ctx in - names_maps_get meta id_to_string id ctx.names_maps + let id_to_string (id : id) : string = id_to_string span id ctx in + names_maps_get span id_to_string id ctx.names_maps -let ctx_get_global (meta : Meta.meta) (id : A.GlobalDeclId.id) +let ctx_get_global (span : Meta.span) (id : A.GlobalDeclId.id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (GlobalId id) ctx + ctx_get (Some span) (GlobalId id) ctx -let ctx_get_function (meta : Meta.meta) (id : fun_id) (ctx : extraction_ctx) : +let ctx_get_function (span : Meta.span) (id : fun_id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (FunId id) ctx + ctx_get (Some span) (FunId id) ctx -let ctx_get_local_function (meta : Meta.meta) (id : A.FunDeclId.id) +let ctx_get_local_function (span : Meta.span) (id : A.FunDeclId.id) (lp : LoopId.id option) (ctx : extraction_ctx) : string = - ctx_get_function meta (FromLlbc (FunId (FRegular id), lp)) ctx + ctx_get_function span (FromLlbc (FunId (FRegular id), lp)) ctx -let ctx_get_type (meta : Meta.meta option) (id : type_id) (ctx : extraction_ctx) +let ctx_get_type (span : Meta.span option) (id : type_id) (ctx : extraction_ctx) : string = - sanity_check_opt_meta __FILE__ __LINE__ (id <> TTuple) meta; - ctx_get meta (TypeId id) ctx + sanity_check_opt_span __FILE__ __LINE__ (id <> TTuple) span; + ctx_get span (TypeId id) ctx -let ctx_get_local_type (meta : Meta.meta) (id : TypeDeclId.id) +let ctx_get_local_type (span : Meta.span) (id : TypeDeclId.id) (ctx : extraction_ctx) : string = - ctx_get_type (Some meta) (TAdtId id) ctx + ctx_get_type (Some span) (TAdtId id) ctx -let ctx_get_assumed_type (meta : Meta.meta option) (id : assumed_ty) +let ctx_get_assumed_type (span : Meta.span option) (id : assumed_ty) (ctx : extraction_ctx) : string = - ctx_get_type meta (TAssumed id) ctx + ctx_get_type span (TAssumed id) ctx -let ctx_get_trait_constructor (meta : Meta.meta) (id : trait_decl_id) +let ctx_get_trait_constructor (span : Meta.span) (id : trait_decl_id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TraitDeclConstructorId id) ctx + ctx_get (Some span) (TraitDeclConstructorId id) ctx -let ctx_get_trait_self_clause (meta : Meta.meta) (ctx : extraction_ctx) : string +let ctx_get_trait_self_clause (span : Meta.span) (ctx : extraction_ctx) : string = - ctx_get (Some meta) TraitSelfClauseId ctx + ctx_get (Some span) TraitSelfClauseId ctx -let ctx_get_trait_decl (meta : Meta.meta) (id : trait_decl_id) +let ctx_get_trait_decl (span : Meta.span) (id : trait_decl_id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TraitDeclId id) ctx + ctx_get (Some span) (TraitDeclId id) ctx -let ctx_get_trait_impl (meta : Meta.meta) (id : trait_impl_id) +let ctx_get_trait_impl (span : Meta.span) (id : trait_impl_id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TraitImplId id) ctx + ctx_get (Some span) (TraitImplId id) ctx -let ctx_get_trait_item (meta : Meta.meta) (id : trait_decl_id) +let ctx_get_trait_item (span : Meta.span) (id : trait_decl_id) (item_name : string) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TraitItemId (id, item_name)) ctx + ctx_get (Some span) (TraitItemId (id, item_name)) ctx -let ctx_get_trait_const (meta : Meta.meta) (id : trait_decl_id) +let ctx_get_trait_const (span : Meta.span) (id : trait_decl_id) (item_name : string) (ctx : extraction_ctx) : string = - ctx_get_trait_item meta id item_name ctx + ctx_get_trait_item span id item_name ctx -let ctx_get_trait_type (meta : Meta.meta) (id : trait_decl_id) +let ctx_get_trait_type (span : Meta.span) (id : trait_decl_id) (item_name : string) (ctx : extraction_ctx) : string = - ctx_get_trait_item meta id item_name ctx + ctx_get_trait_item span id item_name ctx -let ctx_get_trait_method (meta : Meta.meta) (id : trait_decl_id) +let ctx_get_trait_method (span : Meta.span) (id : trait_decl_id) (item_name : string) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TraitMethodId (id, item_name)) ctx + ctx_get (Some span) (TraitMethodId (id, item_name)) ctx -let ctx_get_trait_parent_clause (meta : Meta.meta) (id : trait_decl_id) +let ctx_get_trait_parent_clause (span : Meta.span) (id : trait_decl_id) (clause : trait_clause_id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TraitParentClauseId (id, clause)) ctx + ctx_get (Some span) (TraitParentClauseId (id, clause)) ctx -let ctx_get_trait_item_clause (meta : Meta.meta) (id : trait_decl_id) +let ctx_get_trait_item_clause (span : Meta.span) (id : trait_decl_id) (item : string) (clause : trait_clause_id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TraitItemClauseId (id, item, clause)) ctx + ctx_get (Some span) (TraitItemClauseId (id, item, clause)) ctx -let ctx_get_var (meta : Meta.meta) (id : VarId.id) (ctx : extraction_ctx) : +let ctx_get_var (span : Meta.span) (id : VarId.id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (VarId id) ctx + ctx_get (Some span) (VarId id) ctx -let ctx_get_type_var (meta : Meta.meta) (id : TypeVarId.id) +let ctx_get_type_var (span : Meta.span) (id : TypeVarId.id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TypeVarId id) ctx + ctx_get (Some span) (TypeVarId id) ctx -let ctx_get_const_generic_var (meta : Meta.meta) (id : ConstGenericVarId.id) +let ctx_get_const_generic_var (span : Meta.span) (id : ConstGenericVarId.id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (ConstGenericVarId id) ctx + ctx_get (Some span) (ConstGenericVarId id) ctx -let ctx_get_local_trait_clause (meta : Meta.meta) (id : TraitClauseId.id) +let ctx_get_local_trait_clause (span : Meta.span) (id : TraitClauseId.id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (LocalTraitClauseId id) ctx + ctx_get (Some span) (LocalTraitClauseId id) ctx -let ctx_get_field (meta : Meta.meta) (type_id : type_id) (field_id : FieldId.id) +let ctx_get_field (span : Meta.span) (type_id : type_id) (field_id : FieldId.id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (FieldId (type_id, field_id)) ctx + ctx_get (Some span) (FieldId (type_id, field_id)) ctx -let ctx_get_struct (meta : Meta.meta) (def_id : type_id) (ctx : extraction_ctx) +let ctx_get_struct (span : Meta.span) (def_id : type_id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (StructId def_id) ctx + ctx_get (Some span) (StructId def_id) ctx -let ctx_get_variant (meta : Meta.meta) (def_id : type_id) +let ctx_get_variant (span : Meta.span) (def_id : type_id) (variant_id : VariantId.id) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (VariantId (def_id, variant_id)) ctx + ctx_get (Some span) (VariantId (def_id, variant_id)) ctx -let ctx_get_decreases_proof (meta : Meta.meta) (def_id : A.FunDeclId.id) +let ctx_get_decreases_proof (span : Meta.span) (def_id : A.FunDeclId.id) (loop_id : LoopId.id option) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (DecreasesProofId (FRegular def_id, loop_id)) ctx + ctx_get (Some span) (DecreasesProofId (FRegular def_id, loop_id)) ctx -let ctx_get_termination_measure (meta : Meta.meta) (def_id : A.FunDeclId.id) +let ctx_get_termination_measure (span : Meta.span) (def_id : A.FunDeclId.id) (loop_id : LoopId.id option) (ctx : extraction_ctx) : string = - ctx_get (Some meta) (TerminationMeasureId (FRegular def_id, loop_id)) ctx + ctx_get (Some span) (TerminationMeasureId (FRegular def_id, loop_id)) ctx (** Small helper to compute the name of a unary operation *) let unop_name (unop : unop) : string = @@ -1256,7 +1256,7 @@ let initialize_names_maps () : names_maps = Remark: can return [None] for some backends like HOL4. *) -let type_decl_kind_to_qualif (meta : Meta.meta) (kind : decl_kind) +let type_decl_kind_to_qualif (span : Meta.span) (kind : decl_kind) (type_kind : type_decl_kind option) : string option = match !backend with | FStar -> ( @@ -1284,7 +1284,7 @@ let type_decl_kind_to_qualif (meta : Meta.meta) (kind : decl_kind) (* This is for traits *) Some "Record" | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Unexpected: (" ^ show_decl_kind kind ^ ", " ^ Print.option_to_string show_type_decl_kind type_kind ^ ")")) @@ -1341,17 +1341,17 @@ let fun_decl_kind_to_qualif (kind : decl_kind) : string option = TODO: move inside the formatter? *) -let type_keyword (meta : Meta.meta) = +let type_keyword (span : Meta.span) = match !backend with | FStar -> "Type0" | Coq | Lean -> "Type" - | HOL4 -> craise __FILE__ __LINE__ meta "Unexpected" + | HOL4 -> craise __FILE__ __LINE__ span "Unexpected" (** Helper *) -let name_last_elem_as_ident (meta : Meta.meta) (n : llbc_name) : string = +let name_last_elem_as_ident (span : Meta.span) (n : llbc_name) : string = match Collections.List.last n with | PeIdent (s, _) -> s - | PeImpl _ -> craise __FILE__ __LINE__ meta "Unexpected" + | PeImpl _ -> craise __FILE__ __LINE__ span "Unexpected" (** Helper @@ -1360,22 +1360,22 @@ let name_last_elem_as_ident (meta : Meta.meta) (n : llbc_name) : string = we remove it. We ignore disambiguators (there may be collisions, but we check if there are). *) -let ctx_prepare_name (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_prepare_name (span : Meta.span) (ctx : extraction_ctx) (name : llbc_name) : llbc_name = (* Rmk.: initially we only filtered the disambiguators equal to 0 *) match name with | (PeIdent (crate, _) as id) :: name -> if crate = ctx.crate.name then name else id :: name | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Unexpected name shape: " ^ TranslateCore.name_to_string ctx.trans_ctx name) (** Helper *) -let ctx_compute_simple_name (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_simple_name (span : Meta.span) (ctx : extraction_ctx) (name : llbc_name) : string list = (* Rmk.: initially we only filtered the disambiguators equal to 0 *) - let name = ctx_prepare_name meta ctx name in + let name = ctx_prepare_name span ctx name in name_to_simple_name ctx.trans_ctx name (** Helper *) @@ -1383,14 +1383,14 @@ let ctx_compute_simple_type_name = ctx_compute_simple_name (** Helper *) -let ctx_compute_type_name_no_suffix (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_type_name_no_suffix (span : Meta.span) (ctx : extraction_ctx) (name : llbc_name) : string = - flatten_name (ctx_compute_simple_type_name meta ctx name) + flatten_name (ctx_compute_simple_type_name span ctx name) (** Provided a basename, compute a type name. *) -let ctx_compute_type_name (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_type_name (span : Meta.span) (ctx : extraction_ctx) (name : llbc_name) = - let name = ctx_compute_type_name_no_suffix meta ctx name in + let name = ctx_compute_type_name_no_suffix span ctx name in match !backend with | FStar -> StringUtils.lowercase_first_letter (name ^ "_t") | Coq | HOL4 -> name ^ "_t" @@ -1407,7 +1407,7 @@ let ctx_compute_type_name (meta : Meta.meta) (ctx : extraction_ctx) access then causes trouble because not all provers accept syntax like [x.3] where [x] is a tuple. *) -let ctx_compute_field_name (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_field_name (span : Meta.span) (ctx : extraction_ctx) (def_name : llbc_name) (field_id : FieldId.id) (field_name : string option) : string = let field_name_s = @@ -1423,7 +1423,7 @@ let ctx_compute_field_name (meta : Meta.meta) (ctx : extraction_ctx) else field_name_s else let def_name = - ctx_compute_type_name_no_suffix meta ctx def_name ^ "_" ^ field_name_s + ctx_compute_type_name_no_suffix span ctx def_name ^ "_" ^ field_name_s in match !backend with | Lean | HOL4 -> def_name @@ -1433,14 +1433,14 @@ let ctx_compute_field_name (meta : Meta.meta) (ctx : extraction_ctx) - type name - variant name *) -let ctx_compute_variant_name (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_variant_name (span : Meta.span) (ctx : extraction_ctx) (def_name : llbc_name) (variant : string) : string = match !backend with | FStar | Coq | HOL4 -> let variant = to_camel_case variant in if !variant_concatenate_type_name then StringUtils.capitalize_first_letter - (ctx_compute_type_name_no_suffix meta ctx def_name ^ "_" ^ variant) + (ctx_compute_type_name_no_suffix span ctx def_name ^ "_" ^ variant) else variant | Lean -> variant @@ -1455,14 +1455,14 @@ let ctx_compute_variant_name (meta : Meta.meta) (ctx : extraction_ctx) Inputs: - type name *) -let ctx_compute_struct_constructor (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_struct_constructor (span : Meta.span) (ctx : extraction_ctx) (basename : llbc_name) : string = - let tname = ctx_compute_type_name meta ctx basename in + let tname = ctx_compute_type_name span ctx basename in ExtractBuiltin.mk_struct_constructor tname -let ctx_compute_fun_name_no_suffix (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_fun_name_no_suffix (span : Meta.span) (ctx : extraction_ctx) (fname : llbc_name) : string = - let fname = ctx_compute_simple_name meta ctx fname in + let fname = ctx_compute_simple_name span ctx fname in (* TODO: don't convert to snake case for Coq, HOL4, F* *) let fname = flatten_name fname in match !backend with @@ -1470,15 +1470,15 @@ let ctx_compute_fun_name_no_suffix (meta : Meta.meta) (ctx : extraction_ctx) | Lean -> fname (** Provided a basename, compute the name of a global declaration. *) -let ctx_compute_global_name (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_global_name (span : Meta.span) (ctx : extraction_ctx) (name : llbc_name) : string = match !Config.backend with | Coq | FStar | HOL4 -> let parts = - List.map to_snake_case (ctx_compute_simple_name meta ctx name) + List.map to_snake_case (ctx_compute_simple_name span ctx name) in String.concat "_" parts - | Lean -> flatten_name (ctx_compute_simple_name meta ctx name) + | Lean -> flatten_name (ctx_compute_simple_name span ctx name) (** Helper function: generate a suffix for a function name, i.e., generates a suffix like "_loop", "loop1", etc. to append to a function name. @@ -1509,10 +1509,10 @@ let default_fun_suffix (num_loops : int) (loop_id : LoopId.id option) : string = - loop id (if pertinent) TODO: use the fun id for the assumed functions. *) -let ctx_compute_fun_name (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_fun_name (span : Meta.span) (ctx : extraction_ctx) (fname : llbc_name) (num_loops : int) (loop_id : LoopId.id option) : string = - let fname = ctx_compute_fun_name_no_suffix meta ctx fname in + let fname = ctx_compute_fun_name_no_suffix span ctx fname in (* Compute the suffix *) let suffix = default_fun_suffix num_loops loop_id in (* Concatenate *) @@ -1520,7 +1520,7 @@ let ctx_compute_fun_name (meta : Meta.meta) (ctx : extraction_ctx) let ctx_compute_trait_decl_name (ctx : extraction_ctx) (trait_decl : trait_decl) : string = - ctx_compute_type_name trait_decl.meta ctx trait_decl.llbc_name + ctx_compute_type_name trait_decl.span ctx trait_decl.llbc_name let ctx_compute_trait_impl_name (ctx : extraction_ctx) (trait_decl : trait_decl) (trait_impl : trait_impl) : string = @@ -1533,7 +1533,7 @@ let ctx_compute_trait_impl_name (ctx : extraction_ctx) (trait_decl : trait_decl) let name = let params = trait_impl.llbc_generics in let args = trait_impl.llbc_impl_trait.decl_generics in - let name = ctx_prepare_name trait_impl.meta ctx trait_decl.llbc_name in + let name = ctx_prepare_name trait_impl.span ctx trait_decl.llbc_name in trait_name_with_generics_to_simple_name ctx.trans_ctx name params args in let name = flatten_name name in @@ -1670,17 +1670,17 @@ let ctx_compute_trait_type_clause_name (ctx : extraction_ctx) the same purpose as in [llbc_name]. - loop identifier, if this is for a loop *) -let ctx_compute_termination_measure_name (meta : Meta.meta) +let ctx_compute_termination_measure_name (span : Meta.span) (ctx : extraction_ctx) (_fid : A.FunDeclId.id) (fname : llbc_name) (num_loops : int) (loop_id : LoopId.id option) : string = - let fname = ctx_compute_fun_name_no_suffix meta ctx fname in + let fname = ctx_compute_fun_name_no_suffix span ctx fname in let lp_suffix = default_fun_loop_suffix num_loops loop_id in (* Compute the suffix *) let suffix = match !Config.backend with | FStar -> "_decreases" | Lean -> "_terminates" - | Coq | HOL4 -> craise __FILE__ __LINE__ meta "Unexpected" + | Coq | HOL4 -> craise __FILE__ __LINE__ span "Unexpected" in (* Concatenate *) fname ^ lp_suffix ^ suffix @@ -1699,16 +1699,16 @@ let ctx_compute_termination_measure_name (meta : Meta.meta) the same purpose as in [llbc_name]. - loop identifier, if this is for a loop *) -let ctx_compute_decreases_proof_name (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_decreases_proof_name (span : Meta.span) (ctx : extraction_ctx) (_fid : A.FunDeclId.id) (fname : llbc_name) (num_loops : int) (loop_id : LoopId.id option) : string = - let fname = ctx_compute_fun_name_no_suffix meta ctx fname in + let fname = ctx_compute_fun_name_no_suffix span ctx fname in let lp_suffix = default_fun_loop_suffix num_loops loop_id in (* Compute the suffix *) let suffix = match !Config.backend with | Lean -> "_decreases" - | FStar | Coq | HOL4 -> craise __FILE__ __LINE__ meta "Unexpected" + | FStar | Coq | HOL4 -> craise __FILE__ __LINE__ span "Unexpected" in (* Concatenate *) fname ^ lp_suffix ^ suffix @@ -1726,7 +1726,7 @@ let ctx_compute_decreases_proof_name (meta : Meta.meta) (ctx : extraction_ctx) if necessary to prevent name clashes: the burden of name clashes checks is thus on the caller's side. *) -let ctx_compute_var_basename (meta : Meta.meta) (ctx : extraction_ctx) +let ctx_compute_var_basename (span : Meta.span) (ctx : extraction_ctx) (basename : string option) (ty : ty) : string = (* Small helper to derive var names from ADT type names. @@ -1739,7 +1739,7 @@ let ctx_compute_var_basename (meta : Meta.meta) (ctx : extraction_ctx) let cl = to_snake_case name in let cl = String.split_on_char '_' cl in let cl = List.filter (fun s -> String.length s > 0) cl in - sanity_check __FILE__ __LINE__ (List.length cl > 0) meta; + sanity_check __FILE__ __LINE__ (List.length cl > 0) span; let cl = List.map (fun s -> s.[0]) cl in StringUtils.string_of_chars cl in @@ -1842,85 +1842,85 @@ let name_append_index (basename : string) (i : int) : string = basename ^ string_of_int i (** Generate a unique type variable name and add it to the context *) -let ctx_add_type_var (meta : Meta.meta) (basename : string) (id : TypeVarId.id) +let ctx_add_type_var (span : Meta.span) (basename : string) (id : TypeVarId.id) (ctx : extraction_ctx) : extraction_ctx * string = let name = ctx_compute_type_var_basename ctx basename in let name = basename_to_unique ctx.names_maps.names_map.names_set name_append_index name in - let ctx = ctx_add meta (TypeVarId id) name ctx in + let ctx = ctx_add span (TypeVarId id) name ctx in (ctx, name) (** Generate a unique const generic variable name and add it to the context *) -let ctx_add_const_generic_var (meta : Meta.meta) (basename : string) +let ctx_add_const_generic_var (span : Meta.span) (basename : string) (id : ConstGenericVarId.id) (ctx : extraction_ctx) : extraction_ctx * string = let name = ctx_compute_const_generic_var_basename ctx basename in let name = basename_to_unique ctx.names_maps.names_map.names_set name_append_index name in - let ctx = ctx_add meta (ConstGenericVarId id) name ctx in + let ctx = ctx_add span (ConstGenericVarId id) name ctx in (ctx, name) (** See {!ctx_add_type_var} *) -let ctx_add_type_vars (meta : Meta.meta) (vars : (string * TypeVarId.id) list) +let ctx_add_type_vars (span : Meta.span) (vars : (string * TypeVarId.id) list) (ctx : extraction_ctx) : extraction_ctx * string list = List.fold_left_map - (fun ctx (name, id) -> ctx_add_type_var meta name id ctx) + (fun ctx (name, id) -> ctx_add_type_var span name id ctx) ctx vars (** Generate a unique variable name and add it to the context *) -let ctx_add_var (meta : Meta.meta) (basename : string) (id : VarId.id) +let ctx_add_var (span : Meta.span) (basename : string) (id : VarId.id) (ctx : extraction_ctx) : extraction_ctx * string = let name = basename_to_unique ctx.names_maps.names_map.names_set name_append_index basename in - let ctx = ctx_add meta (VarId id) name ctx in + let ctx = ctx_add span (VarId id) name ctx in (ctx, name) (** Generate a unique variable name for the trait self clause and add it to the context *) -let ctx_add_trait_self_clause (meta : Meta.meta) (ctx : extraction_ctx) : +let ctx_add_trait_self_clause (span : Meta.span) (ctx : extraction_ctx) : extraction_ctx * string = let basename = trait_self_clause_basename in let name = basename_to_unique ctx.names_maps.names_map.names_set name_append_index basename in - let ctx = ctx_add meta TraitSelfClauseId name ctx in + let ctx = ctx_add span TraitSelfClauseId name ctx in (ctx, name) (** Generate a unique trait clause name and add it to the context *) -let ctx_add_local_trait_clause (meta : Meta.meta) (basename : string) +let ctx_add_local_trait_clause (span : Meta.span) (basename : string) (id : TraitClauseId.id) (ctx : extraction_ctx) : extraction_ctx * string = let name = basename_to_unique ctx.names_maps.names_map.names_set name_append_index basename in - let ctx = ctx_add meta (LocalTraitClauseId id) name ctx in + let ctx = ctx_add span (LocalTraitClauseId id) name ctx in (ctx, name) (** See {!ctx_add_var} *) -let ctx_add_vars (meta : Meta.meta) (vars : var list) (ctx : extraction_ctx) : +let ctx_add_vars (span : Meta.span) (vars : var list) (ctx : extraction_ctx) : extraction_ctx * string list = List.fold_left_map (fun ctx (v : var) -> - let name = ctx_compute_var_basename meta ctx v.basename v.ty in - ctx_add_var meta name v.id ctx) + let name = ctx_compute_var_basename span ctx v.basename v.ty in + ctx_add_var span name v.id ctx) ctx vars -let ctx_add_type_params (meta : Meta.meta) (vars : type_var list) +let ctx_add_type_params (span : Meta.span) (vars : type_var list) (ctx : extraction_ctx) : extraction_ctx * string list = List.fold_left_map - (fun ctx (var : type_var) -> ctx_add_type_var meta var.name var.index ctx) + (fun ctx (var : type_var) -> ctx_add_type_var span var.name var.index ctx) ctx vars -let ctx_add_const_generic_params (meta : Meta.meta) +let ctx_add_const_generic_params (span : Meta.span) (vars : const_generic_var list) (ctx : extraction_ctx) : extraction_ctx * string list = List.fold_left_map (fun ctx (var : const_generic_var) -> - ctx_add_const_generic_var meta var.name var.index ctx) + ctx_add_const_generic_var span var.name var.index ctx) ctx vars (** Returns the lists of names for: @@ -1932,7 +1932,7 @@ let ctx_add_const_generic_params (meta : Meta.meta) pretty names for the trait clauses. See {!ctx_compute_trait_clause_name} for additional information. *) -let ctx_add_local_trait_clauses (meta : Meta.meta) +let ctx_add_local_trait_clauses (span : Meta.span) (current_def_name : Types.name) (llbc_generics : Types.generic_params) (clauses : trait_clause list) (ctx : extraction_ctx) : extraction_ctx * string list = @@ -1942,7 +1942,7 @@ let ctx_add_local_trait_clauses (meta : Meta.meta) ctx_compute_trait_clause_basename ctx current_def_name llbc_generics c.clause_id in - ctx_add_local_trait_clause meta basename c.clause_id ctx) + ctx_add_local_trait_clause span basename c.clause_id ctx) ctx clauses (** Returns the lists of names for: @@ -1954,15 +1954,15 @@ let ctx_add_local_trait_clauses (meta : Meta.meta) pretty names for the trait clauses. See {!ctx_compute_trait_clause_name} for additional information. *) -let ctx_add_generic_params (meta : Meta.meta) (current_def_name : Types.name) +let ctx_add_generic_params (span : Meta.span) (current_def_name : Types.name) (llbc_generics : Types.generic_params) (generics : generic_params) (ctx : extraction_ctx) : extraction_ctx * string list * string list * string list = let { types; const_generics; trait_clauses } = generics in - let ctx, tys = ctx_add_type_params meta types ctx in - let ctx, cgs = ctx_add_const_generic_params meta const_generics ctx in + let ctx, tys = ctx_add_type_params span types ctx in + let ctx, cgs = ctx_add_const_generic_params span const_generics ctx in let ctx, tcs = - ctx_add_local_trait_clauses meta current_def_name llbc_generics + ctx_add_local_trait_clauses span current_def_name llbc_generics trait_clauses ctx in (ctx, tys, cgs, tcs) @@ -1970,20 +1970,20 @@ let ctx_add_generic_params (meta : Meta.meta) (current_def_name : Types.name) let ctx_add_decreases_proof (def : fun_decl) (ctx : extraction_ctx) : extraction_ctx = let name = - ctx_compute_decreases_proof_name def.meta ctx def.def_id def.llbc_name + ctx_compute_decreases_proof_name def.span ctx def.def_id def.llbc_name def.num_loops def.loop_id in - ctx_add def.meta + ctx_add def.span (DecreasesProofId (FRegular def.def_id, def.loop_id)) name ctx let ctx_add_termination_measure (def : fun_decl) (ctx : extraction_ctx) : extraction_ctx = let name = - ctx_compute_termination_measure_name def.meta ctx def.def_id def.llbc_name + ctx_compute_termination_measure_name def.span ctx def.def_id def.llbc_name def.num_loops def.loop_id in - ctx_add def.meta + ctx_add def.span (TerminationMeasureId (FRegular def.def_id, def.loop_id)) name ctx @@ -1998,10 +1998,10 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) : match match_name_find_opt ctx.trans_ctx def.name builtin_globals_map with | Some name -> (* Yes: register the custom binding *) - ctx_add def.item_meta.meta decl name ctx + ctx_add def.item_meta.span decl name ctx | None -> (* Not the case: "standard" registration *) - let name = ctx_compute_global_name def.item_meta.meta ctx def.name in + let name = ctx_compute_global_name def.item_meta.span ctx def.name in let body = FunId (FromLlbc (FunId (FRegular def.body), None)) in (* If this is a provided constant (i.e., the default value for a constant @@ -2011,26 +2011,26 @@ let ctx_add_global_decl_and_body (def : A.global_decl) (ctx : extraction_ctx) : let suffix = match def.kind with TraitItemProvided _ -> "_default" | _ -> "" in - let ctx = ctx_add def.item_meta.meta decl (name ^ suffix) ctx in - let ctx = ctx_add def.item_meta.meta body (name ^ suffix ^ "_body") ctx in + let ctx = ctx_add def.item_meta.span decl (name ^ suffix) ctx in + let ctx = ctx_add def.item_meta.span body (name ^ suffix ^ "_body") ctx in ctx let ctx_compute_fun_name (def : fun_decl) (ctx : extraction_ctx) : string = (* Add the function name *) - ctx_compute_fun_name def.meta ctx def.llbc_name def.num_loops def.loop_id + ctx_compute_fun_name def.span ctx def.llbc_name def.num_loops def.loop_id (* TODO: move to Extract *) let ctx_add_fun_decl (def : fun_decl) (ctx : extraction_ctx) : extraction_ctx = (* Sanity check: the function should not be a global body - those are handled * separately *) - sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.meta; + sanity_check __FILE__ __LINE__ (not def.is_global_decl_body) def.span; (* Lookup the LLBC def to compute the region group information *) let def_id = def.def_id in (* Add the function name *) let def_name = ctx_compute_fun_name def ctx in let fun_id = (Pure.FunId (FRegular def_id), def.loop_id) in - ctx_add def.meta (FunId (FromLlbc fun_id)) def_name ctx + ctx_add def.span (FunId (FromLlbc fun_id)) def_name ctx let ctx_compute_type_decl_name (ctx : extraction_ctx) (def : type_decl) : string = - ctx_compute_type_name def.meta ctx def.llbc_name + ctx_compute_type_name def.span ctx def.llbc_name diff --git a/compiler/ExtractName.ml b/compiler/ExtractName.ml index 0573512d..81c35847 100644 --- a/compiler/ExtractName.ml +++ b/compiler/ExtractName.ml @@ -32,7 +32,7 @@ end For impl blocks, we simply use the name of the type (without its arguments) if all the arguments are variables. *) -let pattern_to_extract_name (meta : Meta.meta option) (name : pattern) : +let pattern_to_extract_name (span : Meta.span option) (name : pattern) : string list = let c = { tgt = TkName } in let all_vars = @@ -73,7 +73,7 @@ let pattern_to_extract_name (meta : Meta.meta option) (name : pattern) : let id = Collections.List.last id in match id with | PIdent (_, _) -> super#visit_PImpl () (EComp [ id ]) - | PImpl _ -> craise_opt_meta __FILE__ __LINE__ meta "Unreachable") + | PImpl _ -> craise_opt_span __FILE__ __LINE__ span "Unreachable") | _ -> super#visit_PImpl () ty method! visit_EPrimAdt _ adt g = diff --git a/compiler/ExtractTypes.ml b/compiler/ExtractTypes.ml index 70a4d000..2fc0c117 100644 --- a/compiler/ExtractTypes.ml +++ b/compiler/ExtractTypes.ml @@ -15,7 +15,7 @@ include ExtractBase if it is made of an application (ex.: [U32 3]) - the constant value *) -let extract_literal (meta : Meta.meta) (fmt : F.formatter) (inside : bool) +let extract_literal (span : Meta.span) (fmt : F.formatter) (inside : bool) (cv : literal) : unit = match cv with | VScalar sv -> ( @@ -29,7 +29,7 @@ let extract_literal (meta : Meta.meta) (fmt : F.formatter) (inside : bool) | HOL4 -> F.pp_print_string fmt ("int_to_" ^ int_name sv.int_ty); F.pp_print_space fmt () - | _ -> craise __FILE__ __LINE__ meta "Unreachable"); + | _ -> craise __FILE__ __LINE__ span "Unreachable"); (* We need to add parentheses if the value is negative *) if sv.value >= Z.of_int 0 then F.pp_print_string fmt (Z.to_string sv.value) @@ -42,7 +42,7 @@ let extract_literal (meta : Meta.meta) (fmt : F.formatter) (inside : bool) let iname = String.lowercase_ascii (int_name sv.int_ty) in F.pp_print_string fmt ("#" ^ iname) | HOL4 -> () - | _ -> craise __FILE__ __LINE__ meta "Unreachable"); + | _ -> craise __FILE__ __LINE__ span "Unreachable"); if print_brackets then F.pp_print_string fmt ")") | VBool b -> let b = @@ -71,7 +71,7 @@ let extract_literal (meta : Meta.meta) (fmt : F.formatter) (inside : bool) F.pp_print_string fmt c; if inside then F.pp_print_string fmt ")") | VStr _ | VByteStr _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "String and byte string literals are unsupported" (** Format a unary operation @@ -85,7 +85,7 @@ let extract_literal (meta : Meta.meta) (fmt : F.formatter) (inside : bool) - unop - argument *) -let extract_unop (meta : Meta.meta) (extract_expr : bool -> texpression -> unit) +let extract_unop (span : Meta.span) (extract_expr : bool -> texpression -> unit) (fmt : F.formatter) (inside : bool) (unop : unop) (arg : texpression) : unit = match unop with @@ -132,7 +132,7 @@ let extract_unop (meta : Meta.meta) (extract_expr : bool -> texpression -> unit) match !backend with | Coq | FStar -> "scalar_cast" | Lean -> "Scalar.cast" - | HOL4 -> craise __FILE__ __LINE__ meta "Unreachable" + | HOL4 -> craise __FILE__ __LINE__ span "Unreachable" in let src = if !backend <> Lean then Some (integer_type_to_string src) @@ -145,21 +145,21 @@ let extract_unop (meta : Meta.meta) (extract_expr : bool -> texpression -> unit) match !backend with | Coq | FStar -> "scalar_cast_bool" | Lean -> "Scalar.cast_bool" - | HOL4 -> craise __FILE__ __LINE__ meta "Unreachable" + | HOL4 -> craise __FILE__ __LINE__ span "Unreachable" in let tgt = integer_type_to_string tgt in (cast_str, None, Some tgt) | TInteger _, TBool -> (* This is not allowed by rustc: the way of doing it in Rust is: [x != 0] *) - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Unexpected cast: integer to bool" | TBool, TBool -> (* There shouldn't be any cast here. Note that if one writes [b as bool] in Rust (where [b] is a boolean), it gets compiled to [b] (i.e., no cast is introduced). *) - craise __FILE__ __LINE__ meta "Unexpected cast: bool to bool" - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unexpected cast: bool to bool" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in (* Print the name of the function *) F.pp_print_string fmt cast_str; @@ -192,7 +192,7 @@ let extract_unop (meta : Meta.meta) (extract_expr : bool -> texpression -> unit) - argument 0 - argument 1 *) -let extract_binop (meta : Meta.meta) +let extract_binop (span : Meta.span) (extract_expr : bool -> texpression -> unit) (fmt : F.formatter) (inside : bool) (binop : E.binop) (int_ty : integer_type) (arg0 : texpression) (arg1 : texpression) : unit = @@ -216,7 +216,7 @@ let extract_binop (meta : Meta.meta) | Sub -> "-" | Mul -> "*" | CheckedAdd | CheckedSub | CheckedMul -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Checked operations are not implemented" | Shl -> "<<<" | Shr -> ">>>" @@ -241,7 +241,7 @@ let extract_binop (meta : Meta.meta) constant we need to provide the second implicit type argument *) if binop_is_shift && !backend = FStar && is_const arg1 then ( F.pp_print_space fmt (); - let ty = ty_as_integer meta arg1.ty in + let ty = ty_as_integer span arg1.ty in F.pp_print_string fmt ("#" ^ StringUtils.capitalize_first_letter (int_name ty))); F.pp_print_space fmt (); @@ -282,7 +282,7 @@ let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter) if is_single_opaque_fun_decl_group dg then () else let compute_fun_def_name (def : Pure.fun_decl) : string = - ctx_get_local_function def.meta def.def_id def.loop_id ctx ^ "_def" + ctx_get_local_function def.span def.def_id def.loop_id ctx ^ "_def" in let names = List.map compute_fun_def_name dg in (* Add a break before *) @@ -296,7 +296,7 @@ let start_fun_decl_group (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_string fmt ("val [" ^ String.concat ", " names ^ "] = DefineDiv ‘") else ( - sanity_check_opt_meta __FILE__ __LINE__ (List.length names = 1) None; + sanity_check_opt_span __FILE__ __LINE__ (List.length names = 1) None; let name = List.hd names in F.pp_print_string fmt ("val " ^ name ^ " = Define ‘")); F.pp_print_cut fmt () @@ -401,15 +401,15 @@ let extract_arrow (fmt : F.formatter) () : unit = if !Config.backend = Lean then F.pp_print_string fmt "→" else F.pp_print_string fmt "->" -let extract_const_generic (meta : Meta.meta) (ctx : extraction_ctx) +let extract_const_generic (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (inside : bool) (cg : const_generic) : unit = match cg with | CgGlobal id -> - let s = ctx_get_global meta id ctx in + let s = ctx_get_global span id ctx in F.pp_print_string fmt s - | CgValue v -> extract_literal meta fmt inside v + | CgValue v -> extract_literal span fmt inside v | CgVar id -> - let s = ctx_get_const_generic_var meta id ctx in + let s = ctx_get_const_generic_var span id ctx in F.pp_print_string fmt s let extract_literal_type (_ctx : extraction_ctx) (fmt : F.formatter) @@ -446,9 +446,9 @@ let extract_ty_errors (fmt : F.formatter) : unit = | Lean -> F.pp_print_string fmt "sorry" | HOL4 -> F.pp_print_string fmt "(* ERROR: could not generate the code *)" -let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) +let rec extract_ty (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (inside : bool) (ty : ty) : unit = - let extract_rec = extract_ty meta ctx fmt no_params_tys in + let extract_rec = extract_ty span ctx fmt no_params_tys in match ty with | TAdt (type_id, generics) -> ( let has_params = generics <> empty_generic_args in @@ -486,7 +486,7 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) if print_paren then F.pp_print_string fmt "("; (* TODO: for now, only the opaque *functions* are extracted in the opaque module. The opaque *types* are assumed. *) - F.pp_print_string fmt (ctx_get_type (Some meta) type_id ctx); + F.pp_print_string fmt (ctx_get_type (Some span) type_id ctx); (* We might need to filter the type arguments, if the type is builtin (for instance, we filter the global allocator type argument for `Vec`). *) @@ -507,19 +507,19 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) { generics with types }) | _ -> generics in - extract_generic_args meta ctx fmt no_params_tys generics; + extract_generic_args span ctx fmt no_params_tys generics; if print_paren then F.pp_print_string fmt ")" | HOL4 -> let { types; const_generics; trait_refs } = generics in (* Const generics are not supported in HOL4 *) - cassert __FILE__ __LINE__ (const_generics = []) meta + cassert __FILE__ __LINE__ (const_generics = []) span "Constant generics are not supported yet when generating code \ for HOL4"; let print_tys = match type_id with | TAdtId id -> not (TypeDeclId.Set.mem id no_params_tys) | TAssumed _ -> true - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in if types <> [] && print_tys then ( let print_paren = List.length types > 1 in @@ -531,13 +531,13 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) (extract_rec true) types; if print_paren then F.pp_print_string fmt ")"; F.pp_print_space fmt ()); - F.pp_print_string fmt (ctx_get_type (Some meta) type_id ctx); + F.pp_print_string fmt (ctx_get_type (Some span) type_id ctx); if trait_refs <> [] then ( F.pp_print_space fmt (); Collections.List.iter_link (F.pp_print_space fmt) - (extract_trait_ref meta ctx fmt no_params_tys true) + (extract_trait_ref span ctx fmt no_params_tys true) trait_refs))) - | TVar vid -> F.pp_print_string fmt (ctx_get_type_var meta vid ctx) + | TVar vid -> F.pp_print_string fmt (ctx_get_type_var span vid ctx) | TLiteral lty -> extract_literal_type ctx fmt lty | TArrow (arg_ty, ret_ty) -> if inside then F.pp_print_string fmt "("; @@ -549,10 +549,10 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) if inside then F.pp_print_string fmt ")" | TTraitType (trait_ref, type_name) -> ( if !parameterize_trait_types then - craise __FILE__ __LINE__ meta "Unimplemented" + craise __FILE__ __LINE__ span "Unimplemented" else let type_name = - ctx_get_trait_type meta trait_ref.trait_decl_ref.trait_decl_id + ctx_get_trait_type span trait_ref.trait_decl_ref.trait_decl_id type_name ctx in let add_brackets (s : string) = @@ -569,19 +569,19 @@ let rec extract_ty (meta : Meta.meta) (ctx : extraction_ctx) (fmt : F.formatter) | Self -> sanity_check __FILE__ __LINE__ (trait_ref.generics = empty_generic_args) - meta; - extract_trait_instance_id_with_dot meta ctx fmt no_params_tys false + span; + extract_trait_instance_id_with_dot span ctx fmt no_params_tys false trait_ref.trait_id; F.pp_print_string fmt type_name | _ -> (* HOL4 doesn't have 1st class types *) - cassert __FILE__ __LINE__ (!backend <> HOL4) meta + cassert __FILE__ __LINE__ (!backend <> HOL4) span "Trait types are not supported yet when generating code for HOL4"; - extract_trait_ref meta ctx fmt no_params_tys false trait_ref; + extract_trait_ref span ctx fmt no_params_tys false trait_ref; F.pp_print_string fmt ("." ^ add_brackets type_name)) | Error -> extract_ty_errors fmt -and extract_trait_ref (meta : Meta.meta) (ctx : extraction_ctx) +and extract_trait_ref (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_ref) : unit = let use_brackets = tr.generics <> empty_generic_args && inside in @@ -603,24 +603,24 @@ and extract_trait_ref (meta : Meta.meta) (ctx : extraction_ctx) { tr.generics with types }) | _ -> tr.generics in - extract_trait_instance_id meta ctx fmt no_params_tys inside tr.trait_id; - extract_generic_args meta ctx fmt no_params_tys generics; + extract_trait_instance_id span ctx fmt no_params_tys inside tr.trait_id; + extract_generic_args span ctx fmt no_params_tys generics; if use_brackets then F.pp_print_string fmt ")" -and extract_trait_decl_ref (meta : Meta.meta) (ctx : extraction_ctx) +and extract_trait_decl_ref (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (inside : bool) (tr : trait_decl_ref) : unit = let use_brackets = tr.decl_generics <> empty_generic_args && inside in - let name = ctx_get_trait_decl meta tr.trait_decl_id ctx in + let name = ctx_get_trait_decl span tr.trait_decl_id ctx in if use_brackets then F.pp_print_string fmt "("; F.pp_print_string fmt name; (* There is something subtle here: the trait obligations for the implemented trait are put inside the parent clauses, so we must ignore them here *) let generics = { tr.decl_generics with trait_refs = [] } in - extract_generic_args meta ctx fmt no_params_tys generics; + extract_generic_args span ctx fmt no_params_tys generics; if use_brackets then F.pp_print_string fmt ")" -and extract_generic_args (meta : Meta.meta) (ctx : extraction_ctx) +and extract_generic_args (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (generics : generic_args) : unit = let { types; const_generics; trait_refs } = generics in @@ -628,19 +628,19 @@ and extract_generic_args (meta : Meta.meta) (ctx : extraction_ctx) if types <> [] then ( F.pp_print_space fmt (); Collections.List.iter_link (F.pp_print_space fmt) - (extract_ty meta ctx fmt no_params_tys true) + (extract_ty span ctx fmt no_params_tys true) types); if const_generics <> [] then ( - cassert __FILE__ __LINE__ (!backend <> HOL4) meta + cassert __FILE__ __LINE__ (!backend <> HOL4) span "Constant generics are not supported yet when generating code for HOL4"; F.pp_print_space fmt (); Collections.List.iter_link (F.pp_print_space fmt) - (extract_const_generic meta ctx fmt true) + (extract_const_generic span ctx fmt true) const_generics)); if trait_refs <> [] then ( F.pp_print_space fmt (); Collections.List.iter_link (F.pp_print_space fmt) - (extract_trait_ref meta ctx fmt no_params_tys true) + (extract_trait_ref span ctx fmt no_params_tys true) trait_refs) (** We sometimes need to ignore references to `Self` when generating the @@ -649,7 +649,7 @@ and extract_generic_args (meta : Meta.meta) (ctx : extraction_ctx) id (e.g., `<Self as Foo>::foo` - note that in the extracted code, the projections are often written with a dot '.'). *) -and extract_trait_instance_id_with_dot (meta : Meta.meta) (ctx : extraction_ctx) +and extract_trait_instance_id_with_dot (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (inside : bool) (id : trait_instance_id) : unit = match id with @@ -668,7 +668,7 @@ and extract_trait_instance_id_with_dot (meta : Meta.meta) (ctx : extraction_ctx) *) if ctx.is_provided_method then (* Provided method: use the trait self clause *) - let self_clause = ctx_get_trait_self_clause meta ctx in + let self_clause = ctx_get_trait_self_clause span ctx in F.pp_print_string fmt (self_clause ^ ".") else (* Declaration: nothing to print, we will directly refer to @@ -676,10 +676,10 @@ and extract_trait_instance_id_with_dot (meta : Meta.meta) (ctx : extraction_ctx) () | _ -> (* Other cases *) - extract_trait_instance_id meta ctx fmt no_params_tys inside id; + extract_trait_instance_id span ctx fmt no_params_tys inside id; F.pp_print_string fmt "." -and extract_trait_instance_id (meta : Meta.meta) (ctx : extraction_ctx) +and extract_trait_instance_id (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (inside : bool) (id : trait_instance_id) : unit = let add_brackets (s : string) = if !backend = Coq then "(" ^ s ^ ")" else s in @@ -687,31 +687,31 @@ and extract_trait_instance_id (meta : Meta.meta) (ctx : extraction_ctx) | Self -> (* This has a specific treatment depending on the item we're extracting (associated type, etc.). We should have caught this elsewhere. *) - save_error __FILE__ __LINE__ (Some meta) "Unexpected occurrence of `Self`"; + save_error __FILE__ __LINE__ (Some span) "Unexpected occurrence of `Self`"; F.pp_print_string fmt "ERROR(\"Unexpected Self\")" | TraitImpl id -> - let name = ctx_get_trait_impl meta id ctx in + let name = ctx_get_trait_impl span id ctx in F.pp_print_string fmt name | Clause id -> - let name = ctx_get_local_trait_clause meta id ctx in + let name = ctx_get_local_trait_clause span id ctx in F.pp_print_string fmt name | ParentClause (inst_id, decl_id, clause_id) -> (* Use the trait decl id to lookup the name *) - let name = ctx_get_trait_parent_clause meta decl_id clause_id ctx in - extract_trait_instance_id_with_dot meta ctx fmt no_params_tys true inst_id; + let name = ctx_get_trait_parent_clause span decl_id clause_id ctx in + extract_trait_instance_id_with_dot span ctx fmt no_params_tys true inst_id; F.pp_print_string fmt (add_brackets name) | ItemClause (inst_id, decl_id, item_name, clause_id) -> (* Use the trait decl id to lookup the name *) let name = - ctx_get_trait_item_clause meta decl_id item_name clause_id ctx + ctx_get_trait_item_clause span decl_id item_name clause_id ctx in - extract_trait_instance_id_with_dot meta ctx fmt no_params_tys true inst_id; + extract_trait_instance_id_with_dot span ctx fmt no_params_tys true inst_id; F.pp_print_string fmt (add_brackets name) | TraitRef trait_ref -> - extract_trait_ref meta ctx fmt no_params_tys inside trait_ref + extract_trait_ref span ctx fmt no_params_tys inside trait_ref | UnknownTrait _ -> (* This is an error case *) - craise __FILE__ __LINE__ meta "Unexpected" + craise __FILE__ __LINE__ span "Unexpected" (** Compute the names for all the top-level identifiers used in a type definition (type name, variant names, field names, etc. but not type @@ -741,10 +741,10 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : (* Compute and register the type def name *) let def_name = match info with - | None -> ctx_compute_type_name def.meta ctx def.llbc_name + | None -> ctx_compute_type_name def.span ctx def.llbc_name | Some info -> info.extract_name in - let ctx = ctx_add def.meta (TypeId (TAdtId def.def_id)) def_name ctx in + let ctx = ctx_add def.span (TypeId (TAdtId def.def_id)) def_name ctx in (* Compute and register: * - the variant names, if this is an enumeration * - the field names, if this is a structure @@ -766,12 +766,12 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : FieldId.mapi (fun fid (field : field) -> ( fid, - ctx_compute_field_name def.meta ctx def.llbc_name fid + ctx_compute_field_name def.span ctx def.llbc_name fid field.field_name )) fields in let cons_name = - ctx_compute_struct_constructor def.meta ctx def.llbc_name + ctx_compute_struct_constructor def.span ctx def.llbc_name in (field_names, cons_name) | Some { body_info = Some (Struct (cons_name, field_names)); _ } -> @@ -788,18 +788,18 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : in (field_names, cons_name) | Some info -> - craise __FILE__ __LINE__ def.meta + craise __FILE__ __LINE__ def.span ("Invalid builtin information: " ^ show_builtin_type_info info) in (* Add the fields *) let ctx = List.fold_left (fun ctx (fid, name) -> - ctx_add def.meta (FieldId (TAdtId def.def_id, fid)) name ctx) + ctx_add def.span (FieldId (TAdtId def.def_id, fid)) name ctx) ctx field_names in (* Add the constructor name *) - ctx_add def.meta (StructId (TAdtId def.def_id)) cons_name ctx + ctx_add def.span (StructId (TAdtId def.def_id)) cons_name ctx | Enum variants -> let variant_names = match info with @@ -807,14 +807,14 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : VariantId.mapi (fun variant_id (variant : variant) -> let name = - ctx_compute_variant_name def.meta ctx def.llbc_name + ctx_compute_variant_name def.span ctx def.llbc_name variant.variant_name in (* Add the type name prefix for Lean *) let name = if !Config.backend = Lean then let type_name = - ctx_compute_type_name def.meta ctx def.llbc_name + ctx_compute_type_name def.span ctx def.llbc_name in type_name ^ "." ^ name else name @@ -835,11 +835,11 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : (variant_id, StringMap.find variant.variant_name variant_map)) variants | _ -> - craise __FILE__ __LINE__ def.meta "Invalid builtin information" + craise __FILE__ __LINE__ def.span "Invalid builtin information" in List.fold_left (fun ctx (vid, vname) -> - ctx_add def.meta (VariantId (TAdtId def.def_id, vid)) vname ctx) + ctx_add def.span (VariantId (TAdtId def.def_id, vid)) vname ctx) ctx variant_names | Opaque -> (* Nothing to do *) @@ -849,7 +849,7 @@ let extract_type_decl_register_names (ctx : extraction_ctx) (def : type_decl) : ctx (** Print the variants *) -let extract_type_decl_variant (meta : Meta.meta) (ctx : extraction_ctx) +let extract_type_decl_variant (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (type_decl_group : TypeDeclId.Set.t) (type_name : string) (type_params : string list) (cg_params : string list) (cons_name : string) (fields : field list) : unit = @@ -878,9 +878,9 @@ let extract_type_decl_variant (meta : Meta.meta) (ctx : extraction_ctx) | Some field_name -> let var_id = VarId.of_int (FieldId.to_int fid) in let field_name = - ctx_compute_var_basename meta ctx (Some field_name) f.field_ty + ctx_compute_var_basename span ctx (Some field_name) f.field_ty in - let ctx, field_name = ctx_add_var meta field_name var_id ctx in + let ctx, field_name = ctx_add_var span field_name var_id ctx in F.pp_print_string fmt (field_name ^ " :"); F.pp_print_space fmt (); ctx) @@ -888,7 +888,7 @@ let extract_type_decl_variant (meta : Meta.meta) (ctx : extraction_ctx) in (* Print the field type *) let inside = !backend = HOL4 in - extract_ty meta ctx fmt type_decl_group inside f.field_ty; + extract_ty span ctx fmt type_decl_group inside f.field_ty; (* Print the arrow [->] *) if !backend <> HOL4 then ( F.pp_print_space fmt (); @@ -904,7 +904,7 @@ let extract_type_decl_variant (meta : Meta.meta) (ctx : extraction_ctx) List.fold_left (fun ctx (fid, f) -> print_field fid f ctx) ctx fields in (* Sanity check: HOL4 doesn't support const generics *) - sanity_check __FILE__ __LINE__ (cg_params = [] || !backend <> HOL4) meta; + sanity_check __FILE__ __LINE__ (cg_params = [] || !backend <> HOL4) span; (* Print the final type *) if !backend <> HOL4 then ( F.pp_print_space fmt (); @@ -960,10 +960,10 @@ let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter) (* We don't lookup the name, because it may have a prefix for the type id (in the case of Lean) *) let cons_name = - ctx_compute_variant_name def.meta ctx def.llbc_name v.variant_name + ctx_compute_variant_name def.span ctx def.llbc_name v.variant_name in let fields = v.fields in - extract_type_decl_variant def.meta ctx fmt type_decl_group def_name + extract_type_decl_variant def.span ctx fmt type_decl_group def_name type_params cg_params cons_name fields in (* Print the variants *) @@ -971,7 +971,7 @@ let extract_type_decl_enum_body (ctx : extraction_ctx) (fmt : F.formatter) List.iter (fun (vid, v) -> print_variant vid v) variants (** Extract a struct as a tuple *) -let extract_type_decl_tuple_struct_body (meta : Meta.meta) +let extract_type_decl_tuple_struct_body (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (fields : field list) : unit = (* If the type is empty, we need to have a special treatment *) if fields = [] then ( @@ -985,7 +985,7 @@ let extract_type_decl_tuple_struct_body (meta : Meta.meta) F.pp_print_string fmt sep) (fun (f : field) -> F.pp_print_space fmt (); - extract_ty meta ctx fmt TypeDeclId.Set.empty true f.field_ty) + extract_ty span ctx fmt TypeDeclId.Set.empty true f.field_ty) fields let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) @@ -1061,7 +1061,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) (* If Coq: print the constructor name *) (* TODO: remove superfluous test not is_rec below *) if !backend = Coq && not is_rec then ( - F.pp_print_string fmt (ctx_get_struct def.meta (TAdtId def.def_id) ctx); + F.pp_print_string fmt (ctx_get_struct def.span (TAdtId def.def_id) ctx); F.pp_print_string fmt " "); (match !backend with | Lean -> () @@ -1076,7 +1076,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) (* Print the fields *) let print_field (field_id : FieldId.id) (f : field) : unit = let field_name = - ctx_get_field def.meta (TAdtId def.def_id) field_id ctx + ctx_get_field def.span (TAdtId def.def_id) field_id ctx in (* Open a box for the field *) F.pp_open_box fmt ctx.indent_incr; @@ -1084,7 +1084,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - extract_ty def.meta ctx fmt type_decl_group false f.field_ty; + extract_ty def.span ctx fmt type_decl_group false f.field_ty; if !backend <> Lean then F.pp_print_string fmt ";"; (* Close the box for the field *) F.pp_close_box fmt () @@ -1108,7 +1108,7 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) a group of mutually recursive types: we extract it as an inductive type *) cassert __FILE__ __LINE__ (is_rec && (!backend = Coq || !backend = Lean)) - def.meta + def.span "Constant generics are not supported yet when generating code for HOL4"; (* Small trick: in Lean we use namespaces, meaning we don't need to prefix the constructor name with the name of the type at definition site, @@ -1116,10 +1116,10 @@ let extract_type_decl_struct_body (ctx : extraction_ctx) (fmt : F.formatter) we generate `inductive Foo := | mk ... *) let cons_name = if !backend = Lean then "mk" - else ctx_get_struct def.meta (TAdtId def.def_id) ctx + else ctx_get_struct def.span (TAdtId def.def_id) ctx in - let def_name = ctx_get_local_type def.meta def.def_id ctx in - extract_type_decl_variant def.meta ctx fmt type_decl_group def_name + let def_name = ctx_get_local_type def.span def.def_id ctx in + extract_type_decl_variant def.span ctx fmt type_decl_group def_name type_params cg_params cons_name fields) in () @@ -1146,17 +1146,19 @@ let extract_comment (fmt : F.formatter) (sl : string list) : unit = F.pp_print_string fmt rd; F.pp_close_box fmt () -let extract_comment_with_span (ctx : extraction_ctx) (fmt : F.formatter) +let extract_comment_with_raw_span (ctx : extraction_ctx) (fmt : F.formatter) (sl : string list) (name : Types.name option) ?(generics : (Types.generic_params * Types.generic_args) option = None) - (span : Meta.span) : unit = - let file = match span.file with Virtual s | Local s -> s in + (raw_span : Meta.raw_span) : unit = + let file = match raw_span.file with Virtual s | Local s -> s in let loc_to_string (l : Meta.loc) : string = string_of_int l.line ^ ":" ^ string_of_int l.col in - let span = - "Source: '" ^ file ^ "', lines " ^ loc_to_string span.beg_loc ^ "-" - ^ loc_to_string span.end_loc + let raw_span = + "Source: '" ^ file ^ "', lines " + ^ loc_to_string raw_span.beg_loc + ^ "-" + ^ loc_to_string raw_span.end_loc in let name = match (name, generics) with @@ -1169,16 +1171,16 @@ let extract_comment_with_span (ctx : extraction_ctx) (fmt : F.formatter) ^ name_with_generics_to_pattern_string ctx.trans_ctx name params args; ] in - extract_comment fmt (sl @ [ span ] @ name) + extract_comment fmt (sl @ [ raw_span ] @ name) -let extract_trait_clause_type (meta : Meta.meta) (ctx : extraction_ctx) +let extract_trait_clause_type (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) (clause : trait_clause) : unit = - let trait_name = ctx_get_trait_decl meta clause.trait_id ctx in + let trait_name = ctx_get_trait_decl span clause.trait_id ctx in F.pp_print_string fmt trait_name; - (* let meta = (TraitDeclId.Map.find clause.trait_id ctx.trans_trait_decls).meta in + (* let span = (TraitDeclId.Map.find clause.trait_id ctx.trans_trait_decls).span in *) - extract_generic_args meta ctx fmt no_params_tys clause.generics + extract_generic_args span ctx fmt no_params_tys clause.generics (** Insert a space, if necessary *) let insert_req_space (fmt : F.formatter) (space : bool ref) : unit = @@ -1193,12 +1195,12 @@ let extract_trait_self_clause (insert_req_space : unit -> unit) (params : string list) : unit = insert_req_space (); F.pp_print_string fmt "("; - let self_clause = ctx_get_trait_self_clause trait_decl.meta ctx in + let self_clause = ctx_get_trait_self_clause trait_decl.span ctx in F.pp_print_string fmt self_clause; F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - let trait_id = ctx_get_trait_decl trait_decl.meta trait_decl.def_id ctx in + let trait_id = ctx_get_trait_decl trait_decl.span trait_decl.def_id ctx in F.pp_print_string fmt trait_id; List.iter (fun p -> @@ -1211,7 +1213,7 @@ let extract_trait_self_clause (insert_req_space : unit -> unit) - [trait_decl]: if [Some], it means we are extracting the generics for a provided method and need to insert a trait self clause (see {!TraitSelfClauseId}). *) -let extract_generic_params (meta : Meta.meta) (ctx : extraction_ctx) +let extract_generic_params (span : Meta.span) (ctx : extraction_ctx) (fmt : F.formatter) (no_params_tys : TypeDeclId.Set.t) ?(use_forall = false) ?(use_forall_use_sep = true) ?(use_arrows = false) ?(as_implicits : bool = false) ?(space : bool ref option = None) @@ -1222,7 +1224,7 @@ let extract_generic_params (meta : Meta.meta) (ctx : extraction_ctx) (* HOL4 doesn't support const generics *) cassert __FILE__ __LINE__ (cg_params = [] || !backend <> HOL4) - meta "Constant generics are not supported yet when generating code for HOL4"; + span "Constant generics are not supported yet when generating code for HOL4"; let left_bracket (implicit : bool) = if implicit && !backend <> FStar then F.pp_print_string fmt "{" else F.pp_print_string fmt "(" @@ -1266,7 +1268,7 @@ let extract_generic_params (meta : Meta.meta) (ctx : extraction_ctx) type_params; F.pp_print_string fmt ":"; F.pp_print_space fmt (); - F.pp_print_string fmt (type_keyword meta); + F.pp_print_string fmt (type_keyword span); (* ) *) right_bracket as_implicits; if use_arrows then ( @@ -1278,7 +1280,7 @@ let extract_generic_params (meta : Meta.meta) (ctx : extraction_ctx) insert_req_space (); (* ( *) left_bracket as_implicits; - let n = ctx_get_const_generic_var meta var.index ctx in + let n = ctx_get_const_generic_var span var.index ctx in print_implicit_symbol as_implicits; F.pp_print_string fmt n; F.pp_print_space fmt (); @@ -1297,13 +1299,13 @@ let extract_generic_params (meta : Meta.meta) (ctx : extraction_ctx) insert_req_space (); (* ( *) left_bracket as_implicits; - let n = ctx_get_local_trait_clause meta clause.clause_id ctx in + let n = ctx_get_local_trait_clause span clause.clause_id ctx in print_implicit_symbol as_implicits; F.pp_print_string fmt n; F.pp_print_space fmt (); F.pp_print_string fmt ":"; F.pp_print_space fmt (); - extract_trait_clause_type meta ctx fmt no_params_tys clause; + extract_trait_clause_type span ctx fmt no_params_tys clause; (* ) *) right_bracket as_implicits; if use_arrows then ( @@ -1347,11 +1349,11 @@ let extract_generic_params (meta : Meta.meta) (ctx : extraction_ctx) dtype_params; map (fun (cg : const_generic_var) -> - ctx_get_const_generic_var trait_decl.meta cg.index ctx) + ctx_get_const_generic_var trait_decl.span cg.index ctx) dcgs; map (fun c -> - ctx_get_local_trait_clause trait_decl.meta c.clause_id ctx) + ctx_get_local_trait_clause trait_decl.span c.clause_id ctx) dtrait_clauses; ] in @@ -1370,7 +1372,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) (type_decl_group : TypeDeclId.Set.t) (kind : decl_kind) (def : type_decl) (extract_body : bool) : unit = (* Sanity check *) - sanity_check __FILE__ __LINE__ (extract_body || !backend <> HOL4) def.meta; + sanity_check __FILE__ __LINE__ (extract_body || !backend <> HOL4) def.span; let is_tuple_struct = TypesUtils.type_decl_from_decl_id_is_tuple_struct ctx.trans_ctx.type_ctx.type_infos def.def_id @@ -1398,11 +1400,11 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) let is_opaque_coq = !backend = Coq && is_opaque in let use_forall = is_opaque_coq && def.generics <> empty_generic_params in (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.meta def.def_id ctx in + let def_name = ctx_get_local_type def.span def.def_id ctx in (* Add the type and const generic params - note that we need those bindings only for the * body translation (they are not top-level) *) let ctx_body, type_params, cg_params, trait_clauses = - ctx_add_generic_params def.meta def.llbc_name def.llbc_generics def.generics + ctx_add_generic_params def.span def.llbc_name def.llbc_generics def.generics ctx in (* Add a break before *) @@ -1414,9 +1416,9 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) Some def.llbc_name else None in - extract_comment_with_span ctx fmt + extract_comment_with_raw_span ctx fmt [ "[" ^ name_to_string ctx def.llbc_name ^ "]" ] - name def.meta.span); + name def.span.span); F.pp_print_break fmt 0 0; (* Open a box for the definition, so that whenever possible it gets printed on * one line. Note however that in the case of Lean line breaks are important @@ -1436,7 +1438,7 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt ()) else (); (* > "type TYPE_NAME" *) - let qualif = type_decl_kind_to_qualif def.meta kind type_kind in + let qualif = type_decl_kind_to_qualif def.span kind type_kind in (match qualif with | Some qualif -> F.pp_print_string fmt (qualif ^ " " ^ def_name) | None -> F.pp_print_string fmt def_name); @@ -1444,11 +1446,11 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) support trait clauses *) cassert __FILE__ __LINE__ ((cg_params = [] && trait_clauses = []) || !backend <> HOL4) - def.meta + def.span "Constant generics and type definitions with trait clauses are not \ supported yet when generating code for HOL4"; (* Print the generic parameters *) - extract_generic_params def.meta ctx_body fmt type_decl_group ~use_forall + extract_generic_params def.span ctx_body fmt type_decl_group ~use_forall def.generics type_params cg_params trait_clauses; (* Print the "=" if we extract the body*) if extract_body then ( @@ -1475,21 +1477,21 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) F.pp_print_space fmt (); F.pp_print_string fmt ":"); F.pp_print_space fmt (); - F.pp_print_string fmt (type_keyword def.meta)); + F.pp_print_string fmt (type_keyword def.span)); (* Close the box for "type TYPE_NAME (TYPE_PARAMS) =" *) F.pp_close_box fmt (); (if extract_body then match def.kind with | Struct fields -> if is_tuple_struct then - extract_type_decl_tuple_struct_body def.meta ctx_body fmt fields + extract_type_decl_tuple_struct_body def.span ctx_body fmt fields else extract_type_decl_struct_body ctx_body fmt type_decl_group kind def type_params cg_params fields | Enum variants -> extract_type_decl_enum_body ctx_body fmt type_decl_group def def_name type_params cg_params variants - | Opaque -> craise __FILE__ __LINE__ def.meta "Unreachable"); + | Opaque -> craise __FILE__ __LINE__ def.span "Unreachable"); (* Add the definition end delimiter *) if !backend = HOL4 && decl_is_not_last_from_group kind then ( F.pp_print_space fmt (); @@ -1513,16 +1515,16 @@ let extract_type_decl_gen (ctx : extraction_ctx) (fmt : F.formatter) let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) (def : type_decl) : unit = (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.meta def.def_id ctx in + let def_name = ctx_get_local_type def.span def.def_id ctx in (* Generic parameters are unsupported *) cassert __FILE__ __LINE__ (def.generics.const_generics = []) - def.meta + def.span "Constant generics are not supported yet when generating code for HOL4"; (* Trait clauses on type definitions are unsupported *) cassert __FILE__ __LINE__ (def.generics.trait_clauses = []) - def.meta + def.span "Types with trait clauses are not supported yet when generating code for \ HOL4"; (* Types *) @@ -1545,9 +1547,9 @@ let extract_type_decl_hol4_opaque (ctx : extraction_ctx) (fmt : F.formatter) let extract_type_decl_hol4_empty_record (ctx : extraction_ctx) (fmt : F.formatter) (def : type_decl) : unit = (* Retrieve the definition name *) - let def_name = ctx_get_local_type def.meta def.def_id ctx in + let def_name = ctx_get_local_type def.span def.def_id ctx in (* Sanity check *) - sanity_check __FILE__ __LINE__ (def.generics = empty_generic_params) def.meta; + sanity_check __FILE__ __LINE__ (def.generics = empty_generic_params) def.span; (* Generate the declaration *) F.pp_print_space fmt (); F.pp_print_string fmt ("Type " ^ def_name ^ " = “: unit”"); @@ -1623,7 +1625,7 @@ let extract_coq_arguments_instruction (ctx : extraction_ctx) (fmt : F.formatter) *) let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit = - sanity_check __FILE__ __LINE__ (!backend = Coq) decl.meta; + sanity_check __FILE__ __LINE__ (!backend = Coq) decl.span; (* Generating the [Arguments] instructions is useful only if there are parameters *) let num_params = List.length decl.generics.types @@ -1638,14 +1640,14 @@ let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) | Struct fields -> let adt_id = TAdtId decl.def_id in (* Generate the instruction for the record constructor *) - let cons_name = ctx_get_struct decl.meta adt_id ctx in + let cons_name = ctx_get_struct decl.span adt_id ctx in extract_coq_arguments_instruction ctx fmt cons_name num_params; (* Generate the instruction for the record projectors, if there are *) let is_rec = decl_is_from_rec_group kind in if not is_rec then FieldId.iteri (fun fid _ -> - let cons_name = ctx_get_field decl.meta adt_id fid ctx in + let cons_name = ctx_get_field decl.span adt_id fid ctx in extract_coq_arguments_instruction ctx fmt cons_name num_params) fields; (* Add breaks to insert new lines between definitions *) @@ -1655,7 +1657,7 @@ let extract_type_decl_coq_arguments (ctx : extraction_ctx) (fmt : F.formatter) VariantId.iteri (fun vid (_ : variant) -> let cons_name = - ctx_get_variant decl.meta (TAdtId decl.def_id) vid ctx + ctx_get_variant decl.span (TAdtId decl.def_id) vid ctx in extract_coq_arguments_instruction ctx fmt cons_name num_params) variants; @@ -1806,7 +1808,7 @@ let extract_type_decl_lean_record_field_projectors (ctx : extraction_ctx) *) let extract_type_decl_coq_record_field_projectors (ctx : extraction_ctx) (fmt : F.formatter) (kind : decl_kind) (decl : type_decl) : unit = - sanity_check __FILE__ __LINE__ (!backend = Coq) decl.meta; + sanity_check __FILE__ __LINE__ (!backend = Coq) decl.span; match decl.kind with | Opaque | Enum _ -> () | Struct fields -> @@ -1815,13 +1817,13 @@ let extract_type_decl_coq_record_field_projectors (ctx : extraction_ctx) if is_rec then (* Add the type params *) let ctx, type_params, cg_params, trait_clauses = - ctx_add_generic_params decl.meta decl.llbc_name decl.llbc_generics + ctx_add_generic_params decl.span decl.llbc_name decl.llbc_generics decl.generics ctx in - let ctx, record_var = ctx_add_var decl.meta "x" (VarId.of_int 0) ctx in - let ctx, field_var = ctx_add_var decl.meta "x" (VarId.of_int 1) ctx in - let def_name = ctx_get_local_type decl.meta decl.def_id ctx in - let cons_name = ctx_get_struct decl.meta (TAdtId decl.def_id) ctx in + let ctx, record_var = ctx_add_var decl.span "x" (VarId.of_int 0) ctx in + let ctx, field_var = ctx_add_var decl.span "x" (VarId.of_int 1) ctx in + let def_name = ctx_get_local_type decl.span decl.def_id ctx in + let cons_name = ctx_get_struct decl.span (TAdtId decl.def_id) ctx in let extract_field_proj (field_id : FieldId.id) (_ : field) : unit = F.pp_print_space fmt (); (* Outer box for the projector definition *) @@ -1833,12 +1835,12 @@ let extract_type_decl_coq_record_field_projectors (ctx : extraction_ctx) F.pp_print_string fmt "Definition"; F.pp_print_space fmt (); let field_name = - ctx_get_field decl.meta (TAdtId decl.def_id) field_id ctx + ctx_get_field decl.span (TAdtId decl.def_id) field_id ctx in F.pp_print_string fmt field_name; (* Print the generics *) let as_implicits = true in - extract_generic_params decl.meta ctx fmt TypeDeclId.Set.empty + extract_generic_params decl.span ctx fmt TypeDeclId.Set.empty ~as_implicits decl.generics type_params cg_params trait_clauses; (* Print the record parameter *) F.pp_print_space fmt (); @@ -1915,12 +1917,12 @@ let extract_type_decl_coq_record_field_projectors (ctx : extraction_ctx) (* Inner box for the projector definition *) F.pp_open_hovbox fmt ctx.indent_incr; let ctx, record_var = - ctx_add_var decl.meta "x" (VarId.of_int 0) ctx + ctx_add_var decl.span "x" (VarId.of_int 0) ctx in F.pp_print_string fmt "Notation"; F.pp_print_space fmt (); let field_name = - ctx_get_field decl.meta (TAdtId decl.def_id) field_id ctx + ctx_get_field decl.span (TAdtId decl.def_id) field_id ctx in F.pp_print_string fmt ("\"" ^ record_var ^ " .(" ^ field_name ^ ")\""); F.pp_print_space fmt (); diff --git a/compiler/FunsAnalysis.ml b/compiler/FunsAnalysis.ml index ddfbf312..a11eab87 100644 --- a/compiler/FunsAnalysis.ml +++ b/compiler/FunsAnalysis.ml @@ -147,7 +147,7 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) (* Sanity check: global bodies don't contain stateful calls *) cassert __FILE__ __LINE__ ((not f.is_global_decl_body) || not !stateful) - f.item_meta.meta + f.item_meta.span "Global definition containing a stateful call in its body"; let builtin_info = get_builtin_info f in let has_builtin_info = builtin_info <> None in @@ -172,11 +172,11 @@ let analyze_module (m : crate) (funs_map : fun_decl FunDeclId.Map.t) let is_global_decl_body = List.exists (fun f -> f.is_global_decl_body) d in cassert __FILE__ __LINE__ ((not is_global_decl_body) || List.length d = 1) - (List.hd d).item_meta.meta + (List.hd d).item_meta.span "This global definition is in a group of mutually recursive definitions"; cassert __FILE__ __LINE__ ((not !group_has_builtin_info) || List.length d = 1) - (List.hd d).item_meta.meta + (List.hd d).item_meta.span "This builtin function belongs to a group of mutually recursive \ definitions"; (* We ignore on purpose functions that cannot fail and consider they *can* diff --git a/compiler/Interpreter.ml b/compiler/Interpreter.ml index f10c8d3e..94158979 100644 --- a/compiler/Interpreter.ml +++ b/compiler/Interpreter.ml @@ -49,12 +49,12 @@ let compute_contexts (m : crate) : decls_ctx = to compute a normalization map (for the associated types) and that we added it in the context. *) -let normalize_inst_fun_sig (meta : Meta.meta) (ctx : eval_ctx) +let normalize_inst_fun_sig (span : Meta.span) (ctx : eval_ctx) (sg : inst_fun_sig) : inst_fun_sig = let { regions_hierarchy = _; trait_type_constraints = _; inputs; output } = sg in - let norm = AssociatedTypes.ctx_normalize_ty meta ctx in + let norm = AssociatedTypes.ctx_normalize_ty span ctx in let inputs = List.map norm inputs in let output = norm output in { sg with inputs; output } @@ -69,7 +69,7 @@ let normalize_inst_fun_sig (meta : Meta.meta) (ctx : eval_ctx) clauses (we are not considering a function call, so we don't need to normalize because a trait clause was instantiated with a specific trait ref). *) -let symbolic_instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) +let symbolic_instantiate_fun_sig (span : Meta.span) (ctx : eval_ctx) (sg : fun_sig) (regions_hierarchy : region_var_groups) (kind : item_kind) : eval_ctx * inst_fun_sig = let tr_self = @@ -85,7 +85,7 @@ let symbolic_instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) List.map (fun (v : const_generic_var) -> CgVar v.index) const_generics in (* Annoying that we have to generate this substitution here *) - let r_subst _ = craise __FILE__ __LINE__ meta "Unexpected region" in + let r_subst _ = craise __FILE__ __LINE__ span "Unexpected region" in let ty_subst = Substitute.make_type_subst_from_vars sg.generics.types types in @@ -123,7 +123,7 @@ let symbolic_instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) trait_instance_id = match TraitClauseId.Map.find_opt clause_id tr_map with | Some tr -> tr - | None -> craise __FILE__ __LINE__ meta "Local trait clause not found" + | None -> craise __FILE__ __LINE__ span "Local trait clause not found" in let mk_subst tr_map = let tr_subst = mk_tr_subst tr_map in @@ -152,15 +152,15 @@ let symbolic_instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) { regions; types; const_generics; trait_refs } in let inst_sg = - instantiate_fun_sig meta ctx generics tr_self sg regions_hierarchy + instantiate_fun_sig span ctx generics tr_self sg regions_hierarchy in (* Compute the normalization maps *) let ctx = - AssociatedTypes.ctx_add_norm_trait_types_from_preds meta ctx + AssociatedTypes.ctx_add_norm_trait_types_from_preds span ctx inst_sg.trait_type_constraints in (* Normalize the signature *) - let inst_sg = normalize_inst_fun_sig meta ctx inst_sg in + let inst_sg = normalize_inst_fun_sig span ctx inst_sg in (* Return *) (ctx, inst_sg) @@ -196,12 +196,12 @@ let initialize_symbolic_context_for_fun (ctx : decls_ctx) (fdef : fun_decl) : (List.for_all (fun ty -> not (ty_has_nested_borrows ctx.type_ctx.type_infos ty)) (sg.output :: sg.inputs)) - fdef.item_meta.meta "Nested borrows are not supported yet"; + fdef.item_meta.span "Nested borrows are not supported yet"; cassert __FILE__ __LINE__ (List.for_all (fun ty -> not (ty_has_adt_with_borrows ctx.type_ctx.type_infos ty)) (sg.output :: sg.inputs)) - fdef.item_meta.meta "ADTs containing borrows are not supported yet"; + fdef.item_meta.span "ADTs containing borrows are not supported yet"; (* Create the context *) let regions_hierarchy = @@ -211,25 +211,25 @@ let initialize_symbolic_context_for_fun (ctx : decls_ctx) (fdef : fun_decl) : List.map (fun (g : region_var_group) -> g.id) regions_hierarchy in let ctx = - initialize_eval_ctx fdef.item_meta.meta ctx region_groups sg.generics.types + initialize_eval_ctx fdef.item_meta.span ctx region_groups sg.generics.types sg.generics.const_generics in (* Instantiate the signature. This updates the context because we compute at the same time the normalization map for the associated types. *) let ctx, inst_sg = - symbolic_instantiate_fun_sig fdef.item_meta.meta ctx fdef.signature + symbolic_instantiate_fun_sig fdef.item_meta.span ctx fdef.signature regions_hierarchy fdef.kind in (* Create fresh symbolic values for the inputs *) let input_svs = List.map - (fun ty -> mk_fresh_symbolic_value fdef.item_meta.meta ty) + (fun ty -> mk_fresh_symbolic_value fdef.item_meta.span ty) inst_sg.inputs in (* Initialize the abstractions as empty (i.e., with no avalues) abstractions *) let call_id = fresh_fun_call_id () in - sanity_check __FILE__ __LINE__ (call_id = FunCallId.zero) fdef.item_meta.meta; + sanity_check __FILE__ __LINE__ (call_id = FunCallId.zero) fdef.item_meta.span; let compute_abs_avalues (abs : abs) (ctx : eval_ctx) : eval_ctx * typed_avalue list = (* Project over the values - we use *loan* projectors, as explained above *) @@ -251,14 +251,14 @@ let initialize_symbolic_context_for_fun (ctx : decls_ctx) (fdef : fun_decl) : Collections.List.split_at (List.tl body.locals) body.arg_count in (* Push the return variable (initialized with ⊥) *) - let ctx = ctx_push_uninitialized_var fdef.item_meta.meta ctx ret_var in + let ctx = ctx_push_uninitialized_var fdef.item_meta.span ctx ret_var in (* Push the input variables (initialized with symbolic values) *) let input_values = List.map mk_typed_value_from_symbolic_value input_svs in let ctx = - ctx_push_vars fdef.item_meta.meta ctx (List.combine input_vars input_values) + ctx_push_vars fdef.item_meta.span ctx (List.combine input_vars input_values) in (* Push the remaining local variables (initialized with ⊥) *) - let ctx = ctx_push_uninitialized_vars fdef.item_meta.meta ctx local_vars in + let ctx = ctx_push_uninitialized_vars fdef.item_meta.span ctx local_vars in (* Return *) (ctx, input_svs, inst_sg) @@ -292,7 +292,7 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) ^ "\n- inside_loop: " ^ Print.bool_to_string inside_loop ^ "\n- ctx:\n" - ^ Print.Contexts.eval_ctx_to_string ~meta:(Some fdef.item_meta.meta) ctx)); + ^ Print.Contexts.eval_ctx_to_string ~span:(Some fdef.item_meta.span) ctx)); (* We need to instantiate the function signature - to retrieve * the return type. Note that it is important to re-generate * an instantiation of the signature, so that we use fresh @@ -301,13 +301,15 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) FunIdMap.find (FRegular fdef.def_id) ctx.fun_ctx.regions_hierarchies in let _, ret_inst_sg = - symbolic_instantiate_fun_sig fdef.item_meta.meta ctx fdef.signature + symbolic_instantiate_fun_sig fdef.item_meta.span ctx fdef.signature regions_hierarchy fdef.kind in let ret_rty = ret_inst_sg.output in (* Move the return value out of the return variable *) let pop_return_value = is_regular_return in - let cf_pop_frame = pop_frame config fdef.item_meta.meta pop_return_value in + let ret_value, ctx, cc = + pop_frame config fdef.item_meta.span pop_return_value ctx + in (* We need to find the parents regions/abstractions of the region we * will end - this will allow us to, first, mark the other return @@ -328,163 +330,158 @@ let evaluate_function_symbolic_synthesize_backward_from_return (config : config) (* Insert the return value in the return abstractions (by applying * borrow projections) *) - let cf_consume_ret (ret_value : typed_value option) ctx = - let ctx = - if is_regular_return then ( - let ret_value = Option.get ret_value in - let compute_abs_avalues (abs : abs) (ctx : eval_ctx) : - eval_ctx * typed_avalue list = - let ctx, avalue = - apply_proj_borrows_on_input_value config fdef.item_meta.meta ctx - abs.regions abs.ancestors_regions ret_value ret_rty - in - (ctx, [ avalue ]) + let ctx = + if is_regular_return then ( + let ret_value = Option.get ret_value in + let compute_abs_avalues (abs : abs) (ctx : eval_ctx) : + eval_ctx * typed_avalue list = + let ctx, avalue = + apply_proj_borrows_on_input_value config fdef.item_meta.span ctx + abs.regions abs.ancestors_regions ret_value ret_rty in + (ctx, [ avalue ]) + in - (* Initialize and insert the abstractions in the context. - * - * We take care of allowing to end only the regions which should end (note - * that this is important for soundness: this is part of the borrow checking). - * Also see the documentation of the [can_end] field of [abs] for more - * information. *) - let parent_and_current_rgs = RegionGroupId.Set.add back_id parent_rgs in - let region_can_end rid = - RegionGroupId.Set.mem rid parent_and_current_rgs - in - sanity_check __FILE__ __LINE__ (region_can_end back_id) - fdef.item_meta.meta; - let ctx = - create_push_abstractions_from_abs_region_groups - (fun rg_id -> SynthRet rg_id) - ret_inst_sg.regions_hierarchy region_can_end compute_abs_avalues ctx - in - ctx) - else ctx - in + (* Initialize and insert the abstractions in the context. + * + * We take care of allowing to end only the regions which should end (note + * that this is important for soundness: this is part of the borrow checking). + * Also see the documentation of the [can_end] field of [abs] for more + * information. *) + let parent_and_current_rgs = RegionGroupId.Set.add back_id parent_rgs in + let region_can_end rid = + RegionGroupId.Set.mem rid parent_and_current_rgs + in + sanity_check __FILE__ __LINE__ (region_can_end back_id) + fdef.item_meta.span; + let ctx = + create_push_abstractions_from_abs_region_groups + (fun rg_id -> SynthRet rg_id) + ret_inst_sg.regions_hierarchy region_can_end compute_abs_avalues ctx + in + ctx) + else ctx + in - (* We now need to end the proper *input* abstractions - pay attention - * to the fact that we end the *input* abstractions, not the *return* - * abstractions (of course, the corresponding return abstractions will - * automatically be ended, because they consumed values coming from the - * input abstractions...) *) - (* End the parent abstractions and the current abstraction - note that we - * end them in an order which follows the regions hierarchy: it should lead - * to generated code which has a better consistency between the parent - * and children backward functions. - * - * Note that we don't end the same abstraction if we are *inside* a loop (i.e., - * we are evaluating an [EndContinue]) or not. - *) - let current_abs_id, end_fun_synth_input = - let fun_abs_id = - (RegionGroupId.nth inst_sg.regions_hierarchy back_id).id + (* We now need to end the proper *input* abstractions - pay attention + * to the fact that we end the *input* abstractions, not the *return* + * abstractions (of course, the corresponding return abstractions will + * automatically be ended, because they consumed values coming from the + * input abstractions...) *) + (* End the parent abstractions and the current abstraction - note that we + * end them in an order which follows the regions hierarchy: it should lead + * to generated code which has a better consistency between the parent + * and children backward functions. + * + * Note that we don't end the same abstraction if we are *inside* a loop (i.e., + * we are evaluating an [EndContinue]) or not. + *) + let current_abs_id, end_fun_synth_input = + let fun_abs_id = (RegionGroupId.nth inst_sg.regions_hierarchy back_id).id in + if not inside_loop then (Some fun_abs_id, true) + else + (* We are inside a loop *) + let pred (abs : abs) = + match abs.kind with + | Loop (_, rg_id', kind) -> + let rg_id' = Option.get rg_id' in + let is_ret = + match kind with LoopSynthInput -> true | LoopCall -> false + in + rg_id' = back_id && is_ret + | _ -> false in - if not inside_loop then (Some fun_abs_id, true) - else - (* We are inside a loop *) - let pred (abs : abs) = + (* There is not necessarily an input synthesis abstraction specifically + for the loop. + If there is none, the input synthesis abstraction is actually the + function input synthesis abstraction. + + Example: + ======== + {[ + fn clear(v: &mut Vec<u32>) { + let mut i = 0; + while i < v.len() { + v[i] = 0; + i += 1; + } + } + ]} + *) + match ctx_find_abs ctx pred with + | None -> + (* The loop gives back nothing for this region group. + Ex.: + {[ + pub fn ignore_input_mut_borrow(_a: &mut u32) { + loop {} + } + ]} + *) + (None, false) + | Some abs -> (Some abs.abs_id, false) + in + log#ldebug + (lazy + ("evaluate_function_symbolic_synthesize_backward_from_return: ending \ + input abstraction: " + ^ Print.option_to_string AbstractionId.to_string current_abs_id)); + + (* Set the proper abstractions as endable *) + let ctx = + let visit_loop_abs = + object + inherit [_] map_eval_ctx + + method! visit_abs _ abs = match abs.kind with - | Loop (_, rg_id', kind) -> + | Loop (loop_id', rg_id', LoopSynthInput) -> + (* We only allow to end the loop synth input abs for the region + group [rg_id] *) + sanity_check __FILE__ __LINE__ + (if Option.is_some loop_id then loop_id = Some loop_id' + else true) + fdef.item_meta.span; + (* Loop abstractions *) let rg_id' = Option.get rg_id' in - let is_ret = - match kind with LoopSynthInput -> true | LoopCall -> false - in - rg_id' = back_id && is_ret - | _ -> false - in - (* There is not necessarily an input synthesis abstraction specifically - for the loop. - If there is none, the input synthesis abstraction is actually the - function input synthesis abstraction. - - Example: - ======== - {[ - fn clear(v: &mut Vec<u32>) { - let mut i = 0; - while i < v.len() { - v[i] = 0; - i += 1; - } - } - ]} - *) - match ctx_find_abs ctx pred with - | None -> - (* The loop gives back nothing for this region group. - Ex.: - {[ - pub fn ignore_input_mut_borrow(_a: &mut u32) { - loop {} - } - ]} - *) - (None, false) - | Some abs -> (Some abs.abs_id, false) - in - log#ldebug - (lazy - ("evaluate_function_symbolic_synthesize_backward_from_return: ending \ - input abstraction: " - ^ Print.option_to_string AbstractionId.to_string current_abs_id)); - - (* Set the proper abstractions as endable *) - let ctx = - let visit_loop_abs = - object - inherit [_] map_eval_ctx - - method! visit_abs _ abs = - match abs.kind with - | Loop (loop_id', rg_id', LoopSynthInput) -> - (* We only allow to end the loop synth input abs for the region - group [rg_id] *) - sanity_check __FILE__ __LINE__ - (if Option.is_some loop_id then loop_id = Some loop_id' - else true) - fdef.item_meta.meta; - (* Loop abstractions *) - let rg_id' = Option.get rg_id' in - if rg_id' = back_id && inside_loop then - { abs with can_end = true } - else abs - | Loop (loop_id', _, LoopCall) -> - (* We can end all the loop call abstractions *) - sanity_check __FILE__ __LINE__ (loop_id = Some loop_id') - fdef.item_meta.meta; + if rg_id' = back_id && inside_loop then { abs with can_end = true } - | SynthInput rg_id' -> - if rg_id' = back_id && end_fun_synth_input then - { abs with can_end = true } - else abs - | _ -> - (* Other abstractions *) - abs - end - in - visit_loop_abs#visit_eval_ctx () ctx + else abs + | Loop (loop_id', _, LoopCall) -> + (* We can end all the loop call abstractions *) + sanity_check __FILE__ __LINE__ (loop_id = Some loop_id') + fdef.item_meta.span; + { abs with can_end = true } + | SynthInput rg_id' -> + if rg_id' = back_id && end_fun_synth_input then + { abs with can_end = true } + else abs + | _ -> + (* Other abstractions *) + abs + end in + visit_loop_abs#visit_eval_ctx () ctx + in - let current_abs_id = - match current_abs_id with None -> [] | Some id -> [ id ] - in - let target_abs_ids = List.append parent_input_abs_ids current_abs_id in - let cf_end_target_abs cf = - List.fold_left - (fun cf id -> end_abstraction config fdef.item_meta.meta id cf) - cf target_abs_ids - in - (* Generate the Return node *) - let cf_return : m_fun = - fun ctx -> - match loop_id with - | None -> Some (SA.Return (ctx, None)) - | Some loop_id -> Some (SA.ReturnWithLoop (loop_id, inside_loop)) - in - (* Apply *) - cf_end_target_abs cf_return ctx + let current_abs_id = + match current_abs_id with None -> [] | Some id -> [ id ] + in + let target_abs_ids = List.append parent_input_abs_ids current_abs_id in + let ctx, cc = + comp cc + (fold_left_apply_continuation + (fun id ctx -> end_abstraction config fdef.item_meta.span id ctx) + target_abs_ids ctx) + in + (* Generate the Return node *) + let return_expr = + match loop_id with + | None -> Some (SA.Return (ctx, None)) + | Some loop_id -> Some (SA.ReturnWithLoop (loop_id, inside_loop)) in - cf_pop_frame cf_consume_ret ctx + (* Apply *) + cc return_expr (** Evaluate a function with the symbolic interpreter. @@ -512,7 +509,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) (* Create the continuation to finish the evaluation *) let config = mk_config SymbolicMode in - let cf_finish (res : statement_eval_res) (ctx : eval_ctx) = + let finish (res : statement_eval_res) (ctx : eval_ctx) = let ctx0 = ctx in log#ldebug (lazy @@ -535,17 +532,13 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) *) (* Forward translation: retrieve the returned value *) let fwd_e = - (* Pop the frame and retrieve the returned value at the same time*) + (* Pop the frame and retrieve the returned value at the same time *) let pop_return_value = true in - let cf_pop = - pop_frame config fdef.item_meta.meta pop_return_value + let ret_value, ctx, cc_pop = + pop_frame config fdef.item_meta.span pop_return_value ctx in (* Generate the Return node *) - let cf_return ret_value : m_fun = - fun ctx -> Some (SA.Return (ctx, ret_value)) - in - (* Apply *) - cf_pop cf_return ctx + cc_pop (Some (SA.Return (ctx, ret_value))) in let fwd_e = Option.get fwd_e in (* Backward translation: introduce "return" @@ -556,7 +549,7 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) match res with | Return -> None | LoopReturn loop_id -> Some loop_id - | _ -> craise __FILE__ __LINE__ fdef.item_meta.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ fdef.item_meta.span "Unreachable" in let is_regular_return = true in let inside_loop = Option.is_some loop_id in @@ -582,22 +575,18 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) match res with | EndEnterLoop _ -> false | EndContinue _ -> true - | _ -> craise __FILE__ __LINE__ fdef.item_meta.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ fdef.item_meta.span "Unreachable" in (* Forward translation *) let fwd_e = (* Pop the frame - there is no returned value to pop: in the translation we will simply call the loop function *) let pop_return_value = false in - let cf_pop = - pop_frame config fdef.item_meta.meta pop_return_value + let _ret_value, _ctx, cc_pop = + pop_frame config fdef.item_meta.span pop_return_value ctx in (* Generate the Return node *) - let cf_return _ret_value : m_fun = - fun _ctx -> Some (SA.ReturnWithLoop (loop_id, inside_loop)) - in - (* Apply *) - cf_pop cf_return ctx + cc_pop (Some (SA.ReturnWithLoop (loop_id, inside_loop))) in let fwd_e = Option.get fwd_e in (* Backward translation: introduce "return" @@ -625,16 +614,23 @@ let evaluate_function_symbolic (synthesize : bool) (ctx : decls_ctx) * the executions can lead to a panic *) if synthesize then Some SA.Panic else None | Unit | Break _ | Continue _ -> - craise __FILE__ __LINE__ fdef.item_meta.meta + craise __FILE__ __LINE__ fdef.item_meta.span ("evaluate_function_symbolic failed on: " ^ name_to_string ()) in (* Evaluate the function *) let symbolic = - try eval_function_body config (Option.get fdef.body).body cf_finish ctx - with CFailure (meta, msg) -> Some (Error (meta, msg)) + try + let ctx_resl, cc = + eval_function_body config (Option.get fdef.body).body ctx + in + let el = + List.map Option.get + (List.map (fun (ctx, res) -> finish res ctx) ctx_resl) + in + cc (Some el) + with CFailure (span, msg) -> Some (Error (span, msg)) in - (* Return *) (input_svs, symbolic) @@ -659,35 +655,33 @@ module Test = struct (* Sanity check - *) sanity_check __FILE__ __LINE__ (fdef.signature.generics = empty_generic_params) - fdef.item_meta.meta; - sanity_check __FILE__ __LINE__ (body.arg_count = 0) fdef.item_meta.meta; + fdef.item_meta.span; + sanity_check __FILE__ __LINE__ (body.arg_count = 0) fdef.item_meta.span; (* Create the evaluation context *) - let ctx = initialize_eval_ctx fdef.item_meta.meta decls_ctx [] [] [] in + let ctx = initialize_eval_ctx fdef.item_meta.span decls_ctx [] [] [] in (* Insert the (uninitialized) local variables *) - let ctx = ctx_push_uninitialized_vars fdef.item_meta.meta ctx body.locals in + let ctx = ctx_push_uninitialized_vars fdef.item_meta.span ctx body.locals in (* Create the continuation to check the function's result *) let config = mk_config ConcreteMode in - let cf_check (res : statement_eval_res) (ctx : eval_ctx) = + let check (res : statement_eval_res) (ctx : eval_ctx) = match res with | Return -> (* Ok: drop the local variables and finish *) let pop_return_value = true in - pop_frame config fdef.item_meta.meta pop_return_value - (fun _ _ -> None) - ctx + pop_frame config fdef.item_meta.span pop_return_value ctx | _ -> - craise __FILE__ __LINE__ fdef.item_meta.meta + craise __FILE__ __LINE__ fdef.item_meta.span ("Unit test failed (concrete execution) on: " ^ Print.Types.name_to_string (Print.Contexts.decls_ctx_to_fmt_env decls_ctx) fdef.name) in - (* Evaluate the function *) - let _ = eval_function_body config body.body cf_check ctx in + let ctx_resl, _ = eval_function_body config body.body ctx in + let _ = List.map (fun (ctx, res) -> check res ctx) ctx_resl in () (** Small helper: return true if the function is a *transparent* unit function diff --git a/compiler/InterpreterBorrows.ml b/compiler/InterpreterBorrows.ml index a158ed9a..ef958d2c 100644 --- a/compiler/InterpreterBorrows.ml +++ b/compiler/InterpreterBorrows.ml @@ -30,7 +30,7 @@ let log = Logging.borrows_log loans. This is used to merge borrows with abstractions, to compute loop fixed points for instance. *) -let end_borrow_get_borrow (meta : Meta.meta) +let end_borrow_get_borrow (span : Meta.span) (allowed_abs : AbstractionId.id option) (allow_inner_loans : bool) (l : BorrowId.id) (ctx : eval_ctx) : ( eval_ctx * (AbstractionId.id option * g_borrow_content) option, @@ -43,7 +43,7 @@ let end_borrow_get_borrow (meta : Meta.meta) in let set_replaced_bc (abs_id : AbstractionId.id option) (bc : g_borrow_content) = - sanity_check __FILE__ __LINE__ (Option.is_none !replaced_bc) meta; + sanity_check __FILE__ __LINE__ (Option.is_none !replaced_bc) span; replaced_bc := Some (abs_id, bc) in (* Raise an exception if: @@ -146,12 +146,12 @@ let end_borrow_get_borrow (meta : Meta.meta) let av = super#visit_typed_avalue outer av in (* Reconstruct *) ALoan (ASharedLoan (bids, v, av)) - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } | AEndedSharedLoan _ (* The loan has ended, so no need to update the outer borrows *) | AIgnoredMutLoan _ (* Nothing special to do *) | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } (* Nothing special to do *) | AIgnoredSharedLoan _ -> (* Nothing special to do *) @@ -182,7 +182,7 @@ let end_borrow_get_borrow (meta : Meta.meta) * Also note that, as we are moving the borrowed value inside the * abstraction (and not really giving the value back to the context) * we do not insert {!AEndedMutBorrow} but rather {!ABottom} *) - craise __FILE__ __LINE__ meta "Unimplemented" + craise __FILE__ __LINE__ span "Unimplemented" (* ABottom *)) else (* Update the outer borrows before diving into the child avalue *) @@ -203,7 +203,7 @@ let end_borrow_get_borrow (meta : Meta.meta) | AIgnoredMutBorrow (_, _) | AEndedMutBorrow _ | AEndedIgnoredMutBorrow - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AEndedSharedBorrow -> (* Nothing special to do *) super#visit_ABorrow outer bc @@ -217,7 +217,7 @@ let end_borrow_get_borrow (meta : Meta.meta) set_replaced_bc (fst outer) (Abstract bc); (* Update the value - note that we are necessarily in the second * of the two cases described above *) - let asb = remove_borrow_from_asb meta l asb in + let asb = remove_borrow_from_asb span l asb in ABorrow (AProjSharedBorrow asb)) else (* Nothing special to do *) super#visit_ABorrow outer bc @@ -225,8 +225,8 @@ let end_borrow_get_borrow (meta : Meta.meta) method! visit_abs outer abs = (* Update the outer abs *) let outer_abs, outer_borrows = outer in - sanity_check __FILE__ __LINE__ (Option.is_none outer_abs) meta; - sanity_check __FILE__ __LINE__ (Option.is_none outer_borrows) meta; + sanity_check __FILE__ __LINE__ (Option.is_none outer_abs) span; + sanity_check __FILE__ __LINE__ (Option.is_none outer_borrows) span; let outer = (Some abs.abs_id, None) in super#visit_abs outer abs end @@ -246,27 +246,27 @@ let end_borrow_get_borrow (meta : Meta.meta) give the value back. TODO: this was not the case before, so some sanity checks are not useful anymore. *) -let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) +let give_back_value (config : config) (span : Meta.span) (bid : BorrowId.id) (nv : typed_value) (ctx : eval_ctx) : eval_ctx = (* Sanity check *) exec_assert __FILE__ __LINE__ (not (loans_in_value nv)) - meta "Can not end a borrow because the value to give back contains bottom"; + span "Can not end a borrow because the value to give back contains bottom"; exec_assert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions nv)) - meta "Can not end a borrow because the value to give back contains bottom"; + span "Can not end a borrow because the value to give back contains bottom"; (* Debug *) log#ldebug (lazy ("give_back_value:\n- bid: " ^ BorrowId.to_string bid ^ "\n- value: " - ^ typed_value_to_string ~meta:(Some meta) ctx nv + ^ typed_value_to_string ~span:(Some span) ctx nv ^ "\n- context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n")); (* We use a reference to check that we updated exactly one loan *) let replaced : bool ref = ref false in let set_replaced () = - sanity_check __FILE__ __LINE__ (not !replaced) meta; + sanity_check __FILE__ __LINE__ (not !replaced) span; replaced := true in (* Whenever giving back symbolic values, they shouldn't contain already ended regions *) @@ -274,7 +274,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* We sometimes need to reborrow values while giving a value back due: prepare that *) let allow_reborrows = true in let fresh_reborrow, apply_registered_reborrows = - prepare_reborrows config meta allow_reborrows + prepare_reborrows config span allow_reborrows in (* The visitor to give back the values *) let obj = @@ -304,7 +304,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* Sanity check *) let expected_ty = ty in if nv.ty <> expected_ty then - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Value given back doesn't have the proper type:\n\ - expected: " ^ ty_to_string ctx ty ^ "\n- received: " ^ ty_to_string ctx nv.ty); @@ -338,10 +338,10 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) match nv.value with | VSymbolic sv -> let abs = Option.get opt_abs in - (* Remember the given back value as a meta-value + (* Remember the given back value as a span-value * TODO: it is a bit annoying to have to deconstruct * the value... Think about a more elegant way. *) - let given_back_meta = as_symbolic meta nv.value in + let given_back_span = as_symbolic span nv.value in (* The loan projector *) let given_back = mk_aproj_loans_value_from_symbolic_value abs.regions sv @@ -351,8 +351,8 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* Return *) ABorrow (AEndedIgnoredMutBorrow - { given_back; child; given_back_meta }) - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + { given_back; child; given_back_span }) + | _ -> craise __FILE__ __LINE__ span "Unreachable" else (* Continue exploring *) ABorrow (super#visit_AIgnoredMutBorrow opt_abs bid' child) @@ -367,7 +367,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* Preparing a bit *) let regions, ancestors_regions = match opt_abs with - | None -> craise __FILE__ __LINE__ meta "Unreachable" + | None -> craise __FILE__ __LINE__ span "Unreachable" | Some abs -> (abs.regions, abs.ancestors_regions) in (* Rk.: there is a small issue with the types of the aloan values. @@ -384,23 +384,23 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) * an ended loan *) (* Register the insertion *) set_replaced (); - (* Remember the given back value as a meta-value *) - let given_back_meta = nv in + (* Remember the given back value as a span-value *) + let given_back_span = nv in (* Apply the projection *) let given_back = - apply_proj_borrows meta check_symbolic_no_ended ctx + apply_proj_borrows span check_symbolic_no_ended ctx fresh_reborrow regions ancestors_regions nv borrowed_value_aty in (* Continue giving back in the child value *) let child = super#visit_typed_avalue opt_abs child in (* Return the new value *) - ALoan (AEndedMutLoan { child; given_back; given_back_meta })) + ALoan (AEndedMutLoan { child; given_back; given_back_span })) else (* Continue exploring *) super#visit_ALoan opt_abs lc | ASharedLoan (_, _, _) -> (* We are giving back a value to a *mutable* loan: nothing special to do *) super#visit_ALoan opt_abs lc - | AEndedMutLoan { child = _; given_back = _; given_back_meta = _ } + | AEndedMutLoan { child = _; given_back = _; given_back_span = _ } | AEndedSharedLoan (_, _) -> (* Nothing special to do *) super#visit_ALoan opt_abs lc @@ -408,23 +408,23 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* This loan is ignored, but we may have to project on a subvalue * of the value which is given back *) if opt_bid = Some bid then - (* Remember the given back value as a meta-value *) - let given_back_meta = nv in + (* Remember the given back value as a span-value *) + let given_back_span = nv in (* Note that we replace the ignored mut loan by an *ended* ignored * mut loan. Also, this is not the loan we are looking for *per se*: * we don't register the fact that we inserted the value somewhere * (i.e., we don't call {!set_replaced}) *) let given_back = - apply_proj_borrows meta check_symbolic_no_ended ctx + apply_proj_borrows span check_symbolic_no_ended ctx fresh_reborrow regions ancestors_regions nv borrowed_value_aty in (* Continue giving back in the child value *) let child = super#visit_typed_avalue opt_abs child in ALoan - (AEndedIgnoredMutLoan { given_back; child; given_back_meta }) + (AEndedIgnoredMutLoan { given_back; child; given_back_span }) else super#visit_ALoan opt_abs lc | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AIgnoredSharedLoan _ -> (* Nothing special to do *) super#visit_ALoan opt_abs lc @@ -433,7 +433,7 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* We remember in which abstraction we are before diving - * this is necessary for projecting values: we need to know * over which regions to project *) - sanity_check __FILE__ __LINE__ (Option.is_none opt_abs) meta; + sanity_check __FILE__ __LINE__ (Option.is_none opt_abs) span; super#visit_EAbs (Some abs) abs end in @@ -441,19 +441,19 @@ let give_back_value (config : config) (meta : Meta.meta) (bid : BorrowId.id) (* Explore the environment *) let ctx = obj#visit_eval_ctx None ctx in (* Check we gave back to exactly one loan *) - cassert __FILE__ __LINE__ !replaced meta "No loan updated"; + cassert __FILE__ __LINE__ !replaced span "No loan updated"; (* Apply the reborrows *) apply_registered_reborrows ctx (** Give back a *modified* symbolic value. *) -let give_back_symbolic_value (_config : config) (meta : Meta.meta) +let give_back_symbolic_value (_config : config) (span : Meta.span) (proj_regions : RegionId.Set.t) (proj_ty : rty) (sv : symbolic_value) (nsv : symbolic_value) (ctx : eval_ctx) : eval_ctx = (* Sanity checks *) sanity_check __FILE__ __LINE__ (sv.sv_id <> nsv.sv_id && ty_is_rty proj_ty) - meta; - (* Store the given-back value as a meta-value for synthesis purposes *) + span; + (* Store the given-back value as a span-value for synthesis purposes *) let mv = nsv in (* Substitution function, to replace the borrow projectors over symbolic values *) let subst (_abs : abs) local_given_back = @@ -474,11 +474,11 @@ let give_back_symbolic_value (_config : config) (meta : Meta.meta) type [T]! We thus *mustn't* introduce a projector here. *) (* AProjBorrows (nsv, sv.sv_ty) *) - internal_error __FILE__ __LINE__ meta + internal_error __FILE__ __LINE__ span in AProjLoans (sv, (mv, child_proj) :: local_given_back) in - update_intersecting_aproj_loans meta proj_regions proj_ty sv subst ctx + update_intersecting_aproj_loans span proj_regions proj_ty sv subst ctx (** Auxiliary function to end borrows. See {!give_back}. @@ -493,13 +493,13 @@ let give_back_symbolic_value (_config : config) (meta : Meta.meta) end abstraction when ending this abstraction. When doing this, we need to convert the {!avalue} to a {!type:value} by introducing the proper symbolic values. *) -let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) +let give_back_avalue_to_same_abstraction (_config : config) (span : Meta.span) (bid : BorrowId.id) (nv : typed_avalue) (nsv : typed_value) (ctx : eval_ctx) : eval_ctx = (* We use a reference to check that we updated exactly one loan *) let replaced : bool ref = ref false in let set_replaced () = - cassert __FILE__ __LINE__ (not !replaced) meta + cassert __FILE__ __LINE__ (not !replaced) span "Exacly one loan should be updated"; replaced := true in @@ -539,7 +539,7 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) * {!typed_avalue} *) let _, expected_ty, _ = ty_get_ref ty in if nv.ty <> expected_ty then - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Value given back doesn't have the proper type:\n\ - expected: " ^ ty_to_string ctx ty ^ "\n- received: " ^ ty_to_string ctx nv.ty); @@ -550,12 +550,12 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) set_replaced (); (* Return the new value *) ALoan - (AEndedMutLoan { given_back = nv; child; given_back_meta = nsv })) + (AEndedMutLoan { given_back = nv; child; given_back_span = nsv })) else (* Continue exploring *) super#visit_ALoan opt_abs lc | ASharedLoan (_, _, _) (* We are giving back a value to a *mutable* loan: nothing special to do *) - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } | AEndedSharedLoan (_, _) -> (* Nothing special to do *) super#visit_ALoan opt_abs lc @@ -568,13 +568,13 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) * we don't register the fact that we inserted the value somewhere * (i.e., we don't call {!set_replaced}) *) (* Sanity check *) - sanity_check __FILE__ __LINE__ (nv.ty = ty) meta; + sanity_check __FILE__ __LINE__ (nv.ty = ty) span; ALoan (AEndedIgnoredMutLoan - { given_back = nv; child; given_back_meta = nsv })) + { given_back = nv; child; given_back_span = nsv })) else super#visit_ALoan opt_abs lc | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AIgnoredSharedLoan _ -> (* Nothing special to do *) super#visit_ALoan opt_abs lc @@ -584,7 +584,7 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) (* Explore the environment *) let ctx = obj#visit_eval_ctx None ctx in (* Check we gave back to exactly one loan *) - cassert __FILE__ __LINE__ !replaced meta "No loan updated"; + cassert __FILE__ __LINE__ !replaced span "No loan updated"; (* Return *) ctx @@ -597,12 +597,12 @@ let give_back_avalue_to_same_abstraction (_config : config) (meta : Meta.meta) we update. TODO: this was not the case before, so some sanity checks are not useful anymore. *) -let give_back_shared _config (meta : Meta.meta) (bid : BorrowId.id) +let give_back_shared _config (span : Meta.span) (bid : BorrowId.id) (ctx : eval_ctx) : eval_ctx = (* We use a reference to check that we updated exactly one loan *) let replaced : bool ref = ref false in let set_replaced () = - cassert __FILE__ __LINE__ (not !replaced) meta + cassert __FILE__ __LINE__ (not !replaced) span "Exactly one loan should be updated"; replaced := true in @@ -650,14 +650,14 @@ let give_back_shared _config (meta : Meta.meta) (bid : BorrowId.id) else (* Not the loan we are looking for: continue exploring *) super#visit_ALoan opt_abs lc - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } (* Nothing special to do (the loan has ended) *) | AEndedSharedLoan (_, _) (* Nothing special to do (the loan has ended) *) | AIgnoredMutLoan (_, _) (* Nothing special to do (we are giving back a *shared* borrow) *) | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } (* Nothing special to do *) | AIgnoredSharedLoan _ -> (* Nothing special to do *) @@ -668,7 +668,7 @@ let give_back_shared _config (meta : Meta.meta) (bid : BorrowId.id) (* Explore the environment *) let ctx = obj#visit_eval_ctx None ctx in (* Check we gave back to exactly one loan *) - cassert __FILE__ __LINE__ !replaced meta "No loan updated"; + cassert __FILE__ __LINE__ !replaced span "No loan updated"; (* Return *) ctx @@ -677,12 +677,12 @@ let give_back_shared _config (meta : Meta.meta) (bid : BorrowId.id) to an environment by inserting a new borrow id in the set of borrows tracked by a shared value, referenced by the [original_bid] argument. *) -let reborrow_shared (meta : Meta.meta) (original_bid : BorrowId.id) +let reborrow_shared (span : Meta.span) (original_bid : BorrowId.id) (new_bid : BorrowId.id) (ctx : eval_ctx) : eval_ctx = (* Keep track of changes *) let r = ref false in let set_ref () = - sanity_check __FILE__ __LINE__ (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) span; r := true in @@ -712,7 +712,7 @@ let reborrow_shared (meta : Meta.meta) (original_bid : BorrowId.id) let env = obj#visit_env () ctx.env in (* Check that we reborrowed once *) - sanity_check __FILE__ __LINE__ !r meta; + sanity_check __FILE__ __LINE__ !r span; { ctx with env } (** Convert an {!type:avalue} to a {!type:value}. @@ -731,9 +731,9 @@ let reborrow_shared (meta : Meta.meta) (original_bid : BorrowId.id) be expanded (because expanding this symbolic value would require expanding a reference whose region has already ended). *) -let convert_avalue_to_given_back_value (meta : Meta.meta) (av : typed_avalue) : +let convert_avalue_to_given_back_value (span : Meta.span) (av : typed_avalue) : symbolic_value = - mk_fresh_symbolic_value meta av.ty + mk_fresh_symbolic_value span av.ty (** Auxiliary function: see {!end_borrow_aux}. @@ -751,19 +751,19 @@ let convert_avalue_to_given_back_value (meta : Meta.meta) (av : typed_avalue) : borrows. This kind of internal reshuffling. should be similar to ending abstractions (it is tantamount to ending *sub*-abstractions). *) -let give_back (config : config) (meta : Meta.meta) (l : BorrowId.id) +let give_back (config : config) (span : Meta.span) (l : BorrowId.id) (bc : g_borrow_content) (ctx : eval_ctx) : eval_ctx = (* Debug *) log#ldebug (lazy (let bc = match bc with - | Concrete bc -> borrow_content_to_string ~meta:(Some meta) ctx bc - | Abstract bc -> aborrow_content_to_string ~meta:(Some meta) ctx bc + | Concrete bc -> borrow_content_to_string ~span:(Some span) ctx bc + | Abstract bc -> aborrow_content_to_string ~span:(Some span) ctx bc in "give_back:\n- bid: " ^ BorrowId.to_string l ^ "\n- content: " ^ bc ^ "\n- context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n")); (* This is used for sanity checks *) let sanity_ek = @@ -772,88 +772,83 @@ let give_back (config : config) (meta : Meta.meta) (l : BorrowId.id) match bc with | Concrete (VMutBorrow (l', tv)) -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (l' = l) meta; - sanity_check __FILE__ __LINE__ (not (loans_in_value tv)) meta; + sanity_check __FILE__ __LINE__ (l' = l) span; + sanity_check __FILE__ __LINE__ (not (loans_in_value tv)) span; (* Check that the corresponding loan is somewhere - purely a sanity check *) sanity_check __FILE__ __LINE__ - (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) - meta; + (Option.is_some (lookup_loan_opt span sanity_ek l ctx)) + span; (* Update the context *) - give_back_value config meta l tv ctx + give_back_value config span l tv ctx | Concrete (VSharedBorrow l' | VReservedMutBorrow l') -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (l' = l) meta; + sanity_check __FILE__ __LINE__ (l' = l) span; (* Check that the borrow is somewhere - purely a sanity check *) sanity_check __FILE__ __LINE__ - (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) - meta; + (Option.is_some (lookup_loan_opt span sanity_ek l ctx)) + span; (* Update the context *) - give_back_shared config meta l ctx + give_back_shared config span l ctx | Abstract (AMutBorrow (l', av)) -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (l' = l) meta; + sanity_check __FILE__ __LINE__ (l' = l) span; (* Check that the corresponding loan is somewhere - purely a sanity check *) sanity_check __FILE__ __LINE__ - (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) - meta; + (Option.is_some (lookup_loan_opt span sanity_ek l ctx)) + span; (* Convert the avalue to a (fresh symbolic) value. Rem.: we shouldn't do this here. We should do this in a function which takes care of ending *sub*-abstractions. *) - let sv = convert_avalue_to_given_back_value meta av in + let sv = convert_avalue_to_given_back_value span av in (* Update the context *) - give_back_avalue_to_same_abstraction config meta l av + give_back_avalue_to_same_abstraction config span l av (mk_typed_value_from_symbolic_value sv) ctx | Abstract (ASharedBorrow l') -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (l' = l) meta; + sanity_check __FILE__ __LINE__ (l' = l) span; (* Check that the borrow is somewhere - purely a sanity check *) sanity_check __FILE__ __LINE__ - (Option.is_some (lookup_loan_opt meta sanity_ek l ctx)) - meta; + (Option.is_some (lookup_loan_opt span sanity_ek l ctx)) + span; (* Update the context *) - give_back_shared config meta l ctx + give_back_shared config span l ctx | Abstract (AProjSharedBorrow asb) -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (borrow_in_asb l asb) meta; + sanity_check __FILE__ __LINE__ (borrow_in_asb l asb) span; (* Update the context *) - give_back_shared config meta l ctx + give_back_shared config span l ctx | Abstract ( AEndedMutBorrow _ | AIgnoredMutBorrow _ | AEndedIgnoredMutBorrow _ | AEndedSharedBorrow ) -> - craise __FILE__ __LINE__ meta "Unreachable" - -let check_borrow_disappeared (meta : Meta.meta) (fun_name : string) - (l : BorrowId.id) (ctx0 : eval_ctx) : cm_fun = - let check_disappeared (ctx : eval_ctx) : unit = - let _ = - match lookup_borrow_opt ek_all l ctx with - | None -> () (* Ok *) - | Some _ -> - log#ltrace - (lazy - (fun_name ^ ": " ^ BorrowId.to_string l - ^ ": borrow didn't disappear:\n- original context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx0 - ^ "\n\n- new context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - internal_error __FILE__ __LINE__ meta - in - match lookup_loan_opt meta ek_all l ctx with - | None -> () (* Ok *) - | Some _ -> - log#ltrace - (lazy - (fun_name ^ ": " ^ BorrowId.to_string l - ^ ": loan didn't disappear:\n- original context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx0 - ^ "\n\n- new context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - internal_error __FILE__ __LINE__ meta - in - unit_to_cm_fun check_disappeared + craise __FILE__ __LINE__ span "Unreachable" + +let check_borrow_disappeared (span : Meta.span) (fun_name : string) + (l : BorrowId.id) (ctx0 : eval_ctx) (ctx : eval_ctx) : unit = + (match lookup_borrow_opt ek_all l ctx with + | None -> () (* Ok *) + | Some _ -> + log#ltrace + (lazy + (fun_name ^ ": " ^ BorrowId.to_string l + ^ ": borrow didn't disappear:\n- original context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx0 + ^ "\n\n- new context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); + internal_error __FILE__ __LINE__ span); + match lookup_loan_opt span ek_all l ctx with + | None -> () (* Ok *) + | Some _ -> + log#ltrace + (lazy + (fun_name ^ ": " ^ BorrowId.to_string l + ^ ": loan didn't disappear:\n- original context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx0 + ^ "\n\n- new context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); + internal_error __FILE__ __LINE__ span (** End a borrow identified by its borrow id in a context. @@ -876,27 +871,27 @@ let check_borrow_disappeared (meta : Meta.meta) (fun_name : string) perform anything smart and is trusted, and another function for the book-keeping. *) -let rec end_borrow_aux (config : config) (meta : Meta.meta) +let rec end_borrow_aux (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (allowed_abs : AbstractionId.id option) (l : BorrowId.id) : cm_fun = - fun cf ctx -> + fun ctx -> (* Check that we don't loop *) let chain0 = chain in let chain = - add_borrow_or_abs_id_to_chain meta "end_borrow_aux: " (BorrowId l) chain + add_borrow_or_abs_id_to_chain span "end_borrow_aux: " (BorrowId l) chain in log#ldebug (lazy ("end borrow: " ^ BorrowId.to_string l ^ ":\n- original context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Utility function for the sanity checks: check that the borrow disappeared * from the context *) let ctx0 = ctx in - let cf_check : cm_fun = check_borrow_disappeared meta "end borrow" l ctx0 in + let check = check_borrow_disappeared span "end borrow" l ctx0 in (* Start by ending the borrow itself (we lookup it up and replace it with [Bottom] *) let allow_inner_loans = false in - match end_borrow_get_borrow meta allowed_abs allow_inner_loans l ctx with + match end_borrow_get_borrow span allowed_abs allow_inner_loans l ctx with (* Two cases: - error: we found outer borrows (the borrow is inside a borrowed value) or inner loans (the borrow contains loans) @@ -925,31 +920,41 @@ let rec end_borrow_aux (config : config) (meta : Meta.meta) * inside another borrow *) let allowed_abs' = None in (* End the outer borrows *) - let cc = end_borrows_aux config meta chain allowed_abs' bids in + let ctx, cc = + end_borrows_aux config span chain allowed_abs' bids ctx + in (* Retry to end the borrow *) - let cc = comp cc (end_borrow_aux config meta chain0 allowed_abs l) in - (* Check and apply *) - comp cc cf_check cf ctx + let ctx, cc = + comp cc (end_borrow_aux config span chain0 allowed_abs l ctx) + in + (* Check and continue *) + check ctx; + (ctx, cc) | OuterBorrows (Borrow bid) | InnerLoans (Borrow bid) -> let allowed_abs' = None in (* End the outer borrow *) - let cc = end_borrow_aux config meta chain allowed_abs' bid in + let ctx, cc = end_borrow_aux config span chain allowed_abs' bid ctx in (* Retry to end the borrow *) - let cc = comp cc (end_borrow_aux config meta chain0 allowed_abs l) in - (* Check and apply *) - comp cc cf_check cf ctx + let ctx, cc = + comp cc (end_borrow_aux config span chain0 allowed_abs l ctx) + in + (* Check and continue *) + check ctx; + (ctx, cc) | OuterAbs abs_id -> (* The borrow is inside an abstraction: end the whole abstraction *) - let cf_end_abs = end_abstraction_aux config meta chain abs_id in - (* Compose with a sanity check *) - comp cf_end_abs cf_check cf ctx) + let ctx, end_abs = end_abstraction_aux config span chain abs_id ctx in + (* Sanity check *) + check ctx; + (ctx, end_abs)) | Ok (ctx, None) -> log#ldebug (lazy "End borrow: borrow not found"); (* It is possible that we can't find a borrow in symbolic mode (ending * an abstraction may end several borrows at once *) - sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) meta; + sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) span; (* Do a sanity check and continue *) - cf_check cf ctx + check ctx; + (ctx, fun e -> e) (* We found a borrow and replaced it with [Bottom]: give it back (i.e., update the corresponding loan) *) | Ok (ctx, Some (_, bc)) -> @@ -958,35 +963,35 @@ let rec end_borrow_aux (config : config) (meta : Meta.meta) | Concrete (VMutBorrow (_, bv)) -> sanity_check __FILE__ __LINE__ (Option.is_none (get_first_loan_in_value bv)) - meta + span | _ -> ()); (* Give back the value *) - let ctx = give_back config meta l bc ctx in + let ctx = give_back config span l bc ctx in (* Do a sanity check and continue *) - let cc = cf_check in + check ctx; (* Save a snapshot of the environment for the name generation *) - let cc = comp cc SynthesizeSymbolic.cf_save_snapshot in + let cc = SynthesizeSymbolic.save_snapshot ctx in (* Compose *) - cc cf ctx + (ctx, cc) -and end_borrows_aux (config : config) (meta : Meta.meta) +and end_borrows_aux (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (allowed_abs : AbstractionId.id option) (lset : BorrowId.Set.t) : cm_fun = - fun cf -> + fun ctx -> (* This is not necessary, but we prefer to reorder the borrow ids, - * so that we actually end from the smallest id to the highest id - just - * a matter of taste, and may make debugging easier *) + so that we actually end from the smallest id to the highest id - just + a matter of taste, and may make debugging easier *) let ids = BorrowId.Set.fold (fun id ids -> id :: ids) lset [] in - List.fold_left - (fun cf id -> end_borrow_aux config meta chain allowed_abs id cf) - cf ids + fold_left_apply_continuation + (fun id ctx -> end_borrow_aux config span chain allowed_abs id ctx) + ids ctx -and end_abstraction_aux (config : config) (meta : Meta.meta) +and end_abstraction_aux (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_id : AbstractionId.id) : cm_fun = - fun cf ctx -> + fun ctx -> (* Check that we don't loop *) let chain = - add_borrow_or_abs_id_to_chain meta "end_abstraction_aux: " (AbsId abs_id) + add_borrow_or_abs_id_to_chain span "end_abstraction_aux: " (AbsId abs_id) chain in (* Remember the original context for printing purposes *) @@ -996,7 +1001,7 @@ and end_abstraction_aux (config : config) (meta : Meta.meta) ("end_abstraction_aux: " ^ AbstractionId.to_string abs_id ^ "\n- original context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx0)); + ^ eval_ctx_to_string ~span:(Some span) ctx0)); (* Lookup the abstraction - note that if we end a list of abstractions, ending one abstraction may lead to the current abstraction having @@ -1009,133 +1014,121 @@ and end_abstraction_aux (config : config) (meta : Meta.meta) ("abs not found (already ended): " ^ AbstractionId.to_string abs_id ^ "\n")); - cf ctx + (ctx, fun e -> e) | Some abs -> (* Check that we can end the abstraction *) if abs.can_end then () else - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Can't end abstraction " ^ AbstractionId.to_string abs.abs_id ^ " as it is set as non-endable"); (* End the parent abstractions first *) - let cc = end_abstractions_aux config meta chain abs.parents in - let cc = - comp_unit cc (fun ctx -> - log#ldebug - (lazy - ("end_abstraction_aux: " - ^ AbstractionId.to_string abs_id - ^ "\n- context after parent abstractions ended:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx))) - in + let ctx, cc = end_abstractions_aux config span chain abs.parents ctx in + log#ldebug + (lazy + ("end_abstraction_aux: " + ^ AbstractionId.to_string abs_id + ^ "\n- context after parent abstractions ended:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* End the loans inside the abstraction *) - let cc = comp cc (end_abstraction_loans config meta chain abs_id) in - let cc = - comp_unit cc (fun ctx -> - log#ldebug - (lazy - ("end_abstraction_aux: " - ^ AbstractionId.to_string abs_id - ^ "\n- context after loans ended:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx))) + let ctx, cc = + comp cc (end_abstraction_loans config span chain abs_id ctx) in + log#ldebug + (lazy + ("end_abstraction_aux: " + ^ AbstractionId.to_string abs_id + ^ "\n- context after loans ended:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* End the abstraction itself by redistributing the borrows it contains *) - let cc = comp cc (end_abstraction_borrows config meta chain abs_id) in + let ctx, cc = + comp cc (end_abstraction_borrows config span chain abs_id ctx) + in (* End the regions owned by the abstraction - note that we don't need to - * relookup the abstraction: the set of regions in an abstraction never - * changes... *) - let cc = - comp_update cc (fun ctx -> - let ended_regions = - RegionId.Set.union ctx.ended_regions abs.regions - in - { ctx with ended_regions }) + relookup the abstraction: the set of regions in an abstraction never + changes... *) + let ctx = + let ended_regions = RegionId.Set.union ctx.ended_regions abs.regions in + { ctx with ended_regions } in (* Remove all the references to the id of the current abstraction, and remove - * the abstraction itself. - * **Rk.**: this is where we synthesize the updated symbolic AST *) - let cc = - comp cc (end_abstraction_remove_from_context config meta abs_id) + the abstraction itself. + **Rk.**: this is where we synthesize the updated symbolic AST *) + let ctx, cc = + comp cc (end_abstraction_remove_from_context config span abs_id ctx) in (* Debugging *) - let cc = - comp_unit cc (fun ctx -> - log#ldebug - (lazy - ("end_abstraction_aux: " - ^ AbstractionId.to_string abs_id - ^ "\n- original context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx0 - ^ "\n\n- new context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx))) - in + log#ldebug + (lazy + ("end_abstraction_aux: " + ^ AbstractionId.to_string abs_id + ^ "\n- original context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx0 + ^ "\n\n- new context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Sanity check: ending an abstraction must preserve the invariants *) - let cc = comp cc (Invariants.cf_check_invariants meta) in + Invariants.check_invariants span ctx; (* Save a snapshot of the environment for the name generation *) - let cc = comp cc SynthesizeSymbolic.cf_save_snapshot in + let cc = cc_comp cc (SynthesizeSymbolic.save_snapshot ctx) in - (* Apply the continuation *) - cc cf ctx + (* Return *) + (ctx, cc) -and end_abstractions_aux (config : config) (meta : Meta.meta) +and end_abstractions_aux (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_ids : AbstractionId.Set.t) : cm_fun = - fun cf -> + fun ctx -> (* This is not necessary, but we prefer to reorder the abstraction ids, * so that we actually end from the smallest id to the highest id - just * a matter of taste, and may make debugging easier *) let abs_ids = AbstractionId.Set.fold (fun id ids -> id :: ids) abs_ids [] in - List.fold_left - (fun cf id -> end_abstraction_aux config meta chain id cf) - cf abs_ids + fold_left_apply_continuation + (fun id ctx -> end_abstraction_aux config span chain id ctx) + abs_ids ctx -and end_abstraction_loans (config : config) (meta : Meta.meta) +and end_abstraction_loans (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_id : AbstractionId.id) : cm_fun = - fun cf ctx -> + fun ctx -> (* Lookup the abstraction *) let abs = ctx_lookup_abs ctx abs_id in (* End the first loan we find. * * We ignore the "ignored mut/shared loans": as we should have already ended * the parent abstractions, they necessarily come from children. *) - let opt_loan = get_first_non_ignored_aloan_in_abstraction meta abs in + let opt_loan = get_first_non_ignored_aloan_in_abstraction span abs in match opt_loan with | None -> (* No loans: nothing to update *) - cf ctx + (ctx, fun e -> e) | Some (BorrowIds bids) -> (* There are loans: end the corresponding borrows, then recheck *) - let cc : cm_fun = + let ctx, cc = match bids with - | Borrow bid -> end_borrow_aux config meta chain None bid - | Borrows bids -> end_borrows_aux config meta chain None bids + | Borrow bid -> end_borrow_aux config span chain None bid ctx + | Borrows bids -> end_borrows_aux config span chain None bids ctx in (* Reexplore, looking for loans *) - let cc = comp cc (end_abstraction_loans config meta chain abs_id) in - (* Continue *) - cc cf ctx + comp cc (end_abstraction_loans config span chain abs_id ctx) | Some (SymbolicValue sv) -> (* There is a proj_loans over a symbolic value: end the proj_borrows - * which intersect this proj_loans, then end the proj_loans itself *) - let cc = - end_proj_loans_symbolic config meta chain abs_id abs.regions sv + which intersect this proj_loans, then end the proj_loans itself *) + let ctx, cc = + end_proj_loans_symbolic config span chain abs_id abs.regions sv ctx in (* Reexplore, looking for loans *) - let cc = comp cc (end_abstraction_loans config meta chain abs_id) in - (* Continue *) - cc cf ctx + comp cc (end_abstraction_loans config span chain abs_id ctx) -and end_abstraction_borrows (config : config) (meta : Meta.meta) +and end_abstraction_borrows (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_id : AbstractionId.id) : cm_fun = - fun cf ctx -> + fun ctx -> log#ldebug (lazy ("end_abstraction_borrows: abs_id: " ^ AbstractionId.to_string abs_id)); @@ -1184,7 +1177,7 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) method! visit_aproj env sproj = (match sproj with - | AProjLoans _ -> craise __FILE__ __LINE__ meta "Unexpected" + | AProjLoans _ -> craise __FILE__ __LINE__ span "Unexpected" | AProjBorrows (sv, proj_ty) -> raise (FoundAProjBorrows (sv, proj_ty)) | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); super#visit_aproj env sproj @@ -1193,7 +1186,7 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) method! visit_borrow_content _ bc = match bc with | VSharedBorrow _ | VMutBorrow (_, _) -> raise (FoundBorrowContent bc) - | VReservedMutBorrow _ -> craise __FILE__ __LINE__ meta "Unreachable" + | VReservedMutBorrow _ -> craise __FILE__ __LINE__ span "Unreachable" end in (* Lookup the abstraction *) @@ -1202,32 +1195,32 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) (* Explore the abstraction, looking for borrows *) obj#visit_abs () abs; (* No borrows: nothing to update *) - cf ctx + (ctx, fun e -> e) with (* There are concrete (i.e., not symbolic) borrows: end them, then reexplore *) | FoundABorrowContent bc -> log#ldebug (lazy ("end_abstraction_borrows: found aborrow content: " - ^ aborrow_content_to_string ~meta:(Some meta) ctx bc)); + ^ aborrow_content_to_string ~span:(Some span) ctx bc)); let ctx = match bc with | AMutBorrow (bid, av) -> (* First, convert the avalue to a (fresh symbolic) value *) - let sv = convert_avalue_to_given_back_value meta av in + let sv = convert_avalue_to_given_back_value span av in (* Replace the mut borrow to register the fact that we ended * it and store with it the freshly generated given back value *) let ended_borrow = ABorrow (AEndedMutBorrow (sv, av)) in - let ctx = update_aborrow meta ek_all bid ended_borrow ctx in + let ctx = update_aborrow span ek_all bid ended_borrow ctx in (* Give the value back *) let sv = mk_typed_value_from_symbolic_value sv in - give_back_value config meta bid sv ctx + give_back_value config span bid sv ctx | ASharedBorrow bid -> (* Replace the shared borrow to account for the fact it ended *) let ended_borrow = ABorrow AEndedSharedBorrow in - let ctx = update_aborrow meta ek_all bid ended_borrow ctx in + let ctx = update_aborrow span ek_all bid ended_borrow ctx in (* Give back *) - give_back_shared config meta bid ctx + give_back_shared config span bid ctx | AProjSharedBorrow asb -> (* Retrieve the borrow ids *) let bids = @@ -1242,21 +1235,21 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) * can use to identify the whole set *) let repr_bid = List.hd bids in (* Replace the shared borrow with Bottom *) - let ctx = update_aborrow meta ek_all repr_bid ABottom ctx in + let ctx = update_aborrow span ek_all repr_bid ABottom ctx in (* Give back the shared borrows *) let ctx = List.fold_left - (fun ctx bid -> give_back_shared config meta bid ctx) + (fun ctx bid -> give_back_shared config span bid ctx) ctx bids in (* Continue *) ctx | AEndedMutBorrow _ | AIgnoredMutBorrow _ | AEndedIgnoredMutBorrow _ | AEndedSharedBorrow -> - craise __FILE__ __LINE__ meta "Unexpected" + craise __FILE__ __LINE__ span "Unexpected" in (* Reexplore *) - end_abstraction_borrows config meta chain abs_id cf ctx + end_abstraction_borrows config span chain abs_id ctx (* There are symbolic borrows: end them, then reexplore *) | FoundAProjBorrows (sv, proj_ty) -> log#ldebug @@ -1264,60 +1257,58 @@ and end_abstraction_borrows (config : config) (meta : Meta.meta) ("end_abstraction_borrows: found aproj borrows: " ^ aproj_to_string ctx (AProjBorrows (sv, proj_ty)))); (* Generate a fresh symbolic value *) - let nsv = mk_fresh_symbolic_value meta proj_ty in + let nsv = mk_fresh_symbolic_value span proj_ty in (* Replace the proj_borrows - there should be exactly one *) let ended_borrow = AEndedProjBorrows nsv in - let ctx = update_aproj_borrows meta abs.abs_id sv ended_borrow ctx in + let ctx = update_aproj_borrows span abs.abs_id sv ended_borrow ctx in (* Give back the symbolic value *) let ctx = - give_back_symbolic_value config meta abs.regions proj_ty sv nsv ctx + give_back_symbolic_value config span abs.regions proj_ty sv nsv ctx in (* Reexplore *) - end_abstraction_borrows config meta chain abs_id cf ctx + end_abstraction_borrows config span chain abs_id ctx (* There are concrete (i.e., not symbolic) borrows in shared values: end them, then reexplore *) | FoundBorrowContent bc -> log#ldebug (lazy ("end_abstraction_borrows: found borrow content: " - ^ borrow_content_to_string ~meta:(Some meta) ctx bc)); + ^ borrow_content_to_string ~span:(Some span) ctx bc)); let ctx = match bc with | VSharedBorrow bid -> ( (* Replace the shared borrow with bottom *) let allow_inner_loans = false in match - end_borrow_get_borrow meta (Some abs_id) allow_inner_loans bid ctx + end_borrow_get_borrow span (Some abs_id) allow_inner_loans bid ctx with - | Error _ -> craise __FILE__ __LINE__ meta "Unreachable" + | Error _ -> craise __FILE__ __LINE__ span "Unreachable" | Ok (ctx, _) -> (* Give back *) - give_back_shared config meta bid ctx) + give_back_shared config span bid ctx) | VMutBorrow (bid, v) -> ( (* Replace the mut borrow with bottom *) let allow_inner_loans = false in match - end_borrow_get_borrow meta (Some abs_id) allow_inner_loans bid ctx + end_borrow_get_borrow span (Some abs_id) allow_inner_loans bid ctx with - | Error _ -> craise __FILE__ __LINE__ meta "Unreachable" + | Error _ -> craise __FILE__ __LINE__ span "Unreachable" | Ok (ctx, _) -> (* Give the value back - note that the mut borrow was below a * shared borrow: the value is thus unchanged *) - give_back_value config meta bid v ctx) - | VReservedMutBorrow _ -> craise __FILE__ __LINE__ meta "Unreachable" + give_back_value config span bid v ctx) + | VReservedMutBorrow _ -> craise __FILE__ __LINE__ span "Unreachable" in (* Reexplore *) - end_abstraction_borrows config meta chain abs_id cf ctx + end_abstraction_borrows config span chain abs_id ctx (** Remove an abstraction from the context, as well as all its references *) -and end_abstraction_remove_from_context (_config : config) (meta : Meta.meta) +and end_abstraction_remove_from_context (_config : config) (span : Meta.span) (abs_id : AbstractionId.id) : cm_fun = - fun cf ctx -> - let ctx, abs = ctx_remove_abs meta ctx abs_id in + fun ctx -> + let ctx, abs = ctx_remove_abs span ctx abs_id in let abs = Option.get abs in - (* Apply the continuation *) - let expr = cf ctx in (* Synthesize the symbolic AST *) - SynthesizeSymbolic.synthesize_end_abstraction ctx abs expr + (ctx, SynthesizeSymbolic.synthesize_end_abstraction ctx abs) (** End a proj_loan over a symbolic value by ending the proj_borrows which intersect this proj_loans. @@ -1333,32 +1324,27 @@ and end_abstraction_remove_from_context (_config : config) (meta : Meta.meta) intersecting proj_borrows, either in the concrete context or in an abstraction *) -and end_proj_loans_symbolic (config : config) (meta : Meta.meta) +and end_proj_loans_symbolic (config : config) (span : Meta.span) (chain : borrow_or_abs_ids) (abs_id : AbstractionId.id) (regions : RegionId.Set.t) (sv : symbolic_value) : cm_fun = - fun cf ctx -> + fun ctx -> (* Small helpers for sanity checks *) - let check ctx = no_aproj_over_symbolic_in_context meta sv ctx in - let cf_check (cf : m_fun) : m_fun = - fun ctx -> - check ctx; - cf ctx - in + let check ctx = no_aproj_over_symbolic_in_context span sv ctx in (* Find the first proj_borrows which intersects the proj_loans *) let explore_shared = true in match - lookup_intersecting_aproj_borrows_opt meta explore_shared regions sv ctx + lookup_intersecting_aproj_borrows_opt span explore_shared regions sv ctx with | None -> (* We couldn't find any in the context: it means that the symbolic value * is in the concrete environment (or that we dropped it, in which case * it is completely absent). We thus simply need to replace the loans * projector with an ended projector. *) - let ctx = update_aproj_loans_to_ended meta abs_id sv ctx in + let ctx = update_aproj_loans_to_ended span abs_id sv ctx in (* Sanity check *) check ctx; (* Continue *) - cf ctx + (ctx, fun e -> e) | Some (SharedProjs projs) -> (* We found projectors over shared values - split between the projectors which belong to the current abstraction and the others. @@ -1389,8 +1375,7 @@ and end_proj_loans_symbolic (config : config) (meta : Meta.meta) List.partition (fun (abs_id', _) -> abs_id' = abs_id) projs in (* End the external borrow projectors (end their abstractions) *) - let cf_end_external : cm_fun = - fun cf ctx -> + let ctx, cc = let abs_ids = List.map fst external_projs in let abs_ids = List.fold_left @@ -1398,25 +1383,20 @@ and end_proj_loans_symbolic (config : config) (meta : Meta.meta) AbstractionId.Set.empty abs_ids in (* End the abstractions and continue *) - end_abstractions_aux config meta chain abs_ids cf ctx + end_abstractions_aux config span chain abs_ids ctx in (* End the internal borrows projectors and the loans projector *) - let cf_end_internal : cm_fun = - fun cf ctx -> + let ctx = (* All the proj_borrows are owned: simply erase them *) let ctx = - remove_intersecting_aproj_borrows_shared meta regions sv ctx + remove_intersecting_aproj_borrows_shared span regions sv ctx in (* End the loan itself *) - let ctx = update_aproj_loans_to_ended meta abs_id sv ctx in - (* Sanity check *) - check ctx; - (* Continue *) - cf ctx + update_aproj_loans_to_ended span abs_id sv ctx in - (* Compose and apply *) - let cc = comp cf_end_external cf_end_internal in - cc cf ctx + (* Sanity check *) + check ctx; + (ctx, cc) | Some (NonSharedProj (abs_id', _proj_ty)) -> (* We found one projector of borrows in an abstraction: if it comes * from this abstraction, we can end it directly, otherwise we need @@ -1440,51 +1420,50 @@ and end_proj_loans_symbolic (config : config) (meta : Meta.meta) *) (* End the projector of borrows - TODO: not completely sure what to * replace it with... Maybe we should introduce an ABottomProj? *) - let ctx = update_aproj_borrows meta abs_id sv AIgnoredProjBorrows ctx in + let ctx = update_aproj_borrows span abs_id sv AIgnoredProjBorrows ctx in (* Sanity check: no other occurrence of an intersecting projector of borrows *) sanity_check __FILE__ __LINE__ (Option.is_none - (lookup_intersecting_aproj_borrows_opt meta explore_shared regions + (lookup_intersecting_aproj_borrows_opt span explore_shared regions sv ctx)) - meta; + span; (* End the projector of loans *) - let ctx = update_aproj_loans_to_ended meta abs_id sv ctx in + let ctx = update_aproj_loans_to_ended span abs_id sv ctx in (* Sanity check *) check ctx; (* Continue *) - cf ctx) + (ctx, fun e -> e)) else (* The borrows proj comes from a different abstraction: end it. *) - let cc = end_abstraction_aux config meta chain abs_id' in + let ctx, cc = end_abstraction_aux config span chain abs_id' ctx in (* Retry ending the projector of loans *) - let cc = - comp cc (end_proj_loans_symbolic config meta chain abs_id regions sv) + let ctx, cc = + comp cc + (end_proj_loans_symbolic config span chain abs_id regions sv ctx) in (* Sanity check *) - let cc = comp cc cf_check in - (* Continue *) - cc cf ctx - -let end_borrow config (meta : Meta.meta) : BorrowId.id -> cm_fun = - end_borrow_aux config meta [] None + check ctx; + (* Return *) + (ctx, cc) -let end_borrows config (meta : Meta.meta) : BorrowId.Set.t -> cm_fun = - end_borrows_aux config meta [] None +let end_borrow config (span : Meta.span) : BorrowId.id -> cm_fun = + end_borrow_aux config span [] None -let end_abstraction config meta = end_abstraction_aux config meta [] -let end_abstractions config meta = end_abstractions_aux config meta [] +let end_borrows config (span : Meta.span) : BorrowId.Set.t -> cm_fun = + end_borrows_aux config span [] None -let end_borrow_no_synth config meta id ctx = - get_cf_ctx_no_synth meta (end_borrow config meta id) ctx +let end_abstraction config span = end_abstraction_aux config span [] +let end_abstractions config span = end_abstractions_aux config span [] +let end_borrow_no_synth config span id ctx = fst (end_borrow config span id ctx) -let end_borrows_no_synth config meta ids ctx = - get_cf_ctx_no_synth meta (end_borrows config meta ids) ctx +let end_borrows_no_synth config span ids ctx = + fst (end_borrows config span ids ctx) -let end_abstraction_no_synth config meta id ctx = - get_cf_ctx_no_synth meta (end_abstraction config meta id) ctx +let end_abstraction_no_synth config span id ctx = + fst (end_abstraction config span id ctx) -let end_abstractions_no_synth config meta ids ctx = - get_cf_ctx_no_synth meta (end_abstractions config meta ids) ctx +let end_abstractions_no_synth config span ids ctx = + fst (end_abstractions config span ids ctx) (** Helper function: see {!activate_reserved_mut_borrow}. @@ -1502,15 +1481,14 @@ let end_abstractions_no_synth config meta ids ctx = The loan to update mustn't be a borrowed value. *) -let promote_shared_loan_to_mut_loan (meta : Meta.meta) (l : BorrowId.id) - (cf : typed_value -> m_fun) : m_fun = - fun ctx -> +let promote_shared_loan_to_mut_loan (span : Meta.span) (l : BorrowId.id) + (ctx : eval_ctx) : typed_value * eval_ctx = (* Debug *) log#ldebug (lazy ("promote_shared_loan_to_mut_loan:\n- loan: " ^ BorrowId.to_string l ^ "\n- context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n")); (* Lookup the shared loan - note that we can't promote a shared loan * in a shared value, but we can do it in a mutably borrowed value. @@ -1519,34 +1497,34 @@ let promote_shared_loan_to_mut_loan (meta : Meta.meta) (l : BorrowId.id) let ek = { enter_shared_loans = false; enter_mut_borrows = true; enter_abs = false } in - match lookup_loan meta ek l ctx with + match lookup_loan span ek l ctx with | _, Concrete (VMutLoan _) -> - craise __FILE__ __LINE__ meta "Expected a shared loan, found a mut loan" + craise __FILE__ __LINE__ span "Expected a shared loan, found a mut loan" | _, Concrete (VSharedLoan (bids, sv)) -> (* Check that there is only one borrow id (l) and update the loan *) cassert __FILE__ __LINE__ (BorrowId.Set.mem l bids && BorrowId.Set.cardinal bids = 1) - meta "There should only be one borrow id"; + span "There should only be one borrow id"; (* We need to check that there aren't any loans in the value: we should have gotten rid of those already, but it is better to do a sanity check. *) - sanity_check __FILE__ __LINE__ (not (loans_in_value sv)) meta; + sanity_check __FILE__ __LINE__ (not (loans_in_value sv)) span; (* Check there isn't {!Bottom} (this is actually an invariant *) cassert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions sv)) - meta "There shouldn't be a bottom"; + span "There shouldn't be a bottom"; (* Check there aren't reserved borrows *) cassert __FILE__ __LINE__ (not (reserved_in_value sv)) - meta "There shouldn't be reserved borrows"; + span "There shouldn't be reserved borrows"; (* Update the loan content *) - let ctx = update_loan meta ek l (VMutLoan l) ctx in - (* Continue *) - cf sv ctx + let ctx = update_loan span ek l (VMutLoan l) ctx in + (* Return *) + (sv, ctx) | _, Abstract _ -> (* I don't think it is possible to have two-phase borrows involving borrows - * returned by abstractions. I'm not sure how we could handle that anyway. *) - craise __FILE__ __LINE__ meta + returned by abstractions. I'm not sure how we could handle that anyway. *) + craise __FILE__ __LINE__ span "Can't promote a shared loan to a mutable loan if the loan is inside a \ region abstraction" @@ -1555,41 +1533,36 @@ let promote_shared_loan_to_mut_loan (meta : Meta.meta) (l : BorrowId.id) This function updates a shared borrow to a mutable borrow (and that is all: it doesn't touch the corresponding loan). *) -let replace_reserved_borrow_with_mut_borrow (meta : Meta.meta) (l : BorrowId.id) - (cf : m_fun) (borrowed_value : typed_value) : m_fun = - fun ctx -> +let replace_reserved_borrow_with_mut_borrow (span : Meta.span) (l : BorrowId.id) + (borrowed_value : typed_value) (ctx : eval_ctx) : eval_ctx = (* Lookup the reserved borrow - note that we don't go inside borrows/loans: there can't be reserved borrows inside other borrows/loans *) let ek = { enter_shared_loans = false; enter_mut_borrows = false; enter_abs = false } in - let ctx = - match lookup_borrow meta ek l ctx with - | Concrete (VSharedBorrow _ | VMutBorrow (_, _)) -> - craise __FILE__ __LINE__ meta "Expected a reserved mutable borrow" - | Concrete (VReservedMutBorrow _) -> - (* Update it *) - update_borrow meta ek l (VMutBorrow (l, borrowed_value)) ctx - | Abstract _ -> - (* This can't happen for sure *) - craise __FILE__ __LINE__ meta - "Can't promote a shared borrow to a mutable borrow if the borrow is \ - inside a region abstraction" - in - (* Continue *) - cf ctx + match lookup_borrow span ek l ctx with + | Concrete (VSharedBorrow _ | VMutBorrow (_, _)) -> + craise __FILE__ __LINE__ span "Expected a reserved mutable borrow" + | Concrete (VReservedMutBorrow _) -> + (* Update it *) + update_borrow span ek l (VMutBorrow (l, borrowed_value)) ctx + | Abstract _ -> + (* This can't happen for sure *) + craise __FILE__ __LINE__ span + "Can't promote a shared borrow to a mutable borrow if the borrow is \ + inside a region abstraction" (** Promote a reserved mut borrow to a mut borrow. *) -let rec promote_reserved_mut_borrow (config : config) (meta : Meta.meta) +let rec promote_reserved_mut_borrow (config : config) (span : Meta.span) (l : BorrowId.id) : cm_fun = - fun cf ctx -> + fun ctx -> (* Lookup the value *) let ek = { enter_shared_loans = false; enter_mut_borrows = true; enter_abs = false } in - match lookup_loan meta ek l ctx with - | _, Concrete (VMutLoan _) -> craise __FILE__ __LINE__ meta "Unreachable" + match lookup_loan span ek l ctx with + | _, Concrete (VMutLoan _) -> craise __FILE__ __LINE__ span "Unreachable" | _, Concrete (VSharedLoan (bids, sv)) -> ( (* If there are loans inside the value, end them. Note that there can't be reserved borrows inside the value. @@ -1597,53 +1570,48 @@ let rec promote_reserved_mut_borrow (config : config) (meta : Meta.meta) match get_first_loan_in_value sv with | Some lc -> (* End the loans *) - let cc = + let ctx, cc = match lc with - | VSharedLoan (bids, _) -> end_borrows config meta bids - | VMutLoan bid -> end_borrow config meta bid + | VSharedLoan (bids, _) -> end_borrows config span bids ctx + | VMutLoan bid -> end_borrow config span bid ctx in (* Recursive call *) - let cc = comp cc (promote_reserved_mut_borrow config meta l) in - (* Continue *) - cc cf ctx + comp cc (promote_reserved_mut_borrow config span l ctx) | None -> (* No loan to end inside the value *) (* Some sanity checks *) log#ldebug (lazy ("activate_reserved_mut_borrow: resulting value:\n" - ^ typed_value_to_string ~meta:(Some meta) ctx sv)); - sanity_check __FILE__ __LINE__ (not (loans_in_value sv)) meta; + ^ typed_value_to_string ~span:(Some span) ctx sv)); + sanity_check __FILE__ __LINE__ (not (loans_in_value sv)) span; sanity_check __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions sv)) - meta; - sanity_check __FILE__ __LINE__ (not (reserved_in_value sv)) meta; + span; + sanity_check __FILE__ __LINE__ (not (reserved_in_value sv)) span; (* End the borrows which borrow from the value, at the exception of the borrow we want to promote *) let bids = BorrowId.Set.remove l bids in - let cc = end_borrows config meta bids in + let ctx, cc = end_borrows config span bids ctx in (* Promote the loan - TODO: this will fail if the value contains * any loans. In practice, it shouldn't, but we could also * look for loans inside the value and end them before promoting * the borrow. *) - let cc = comp cc (promote_shared_loan_to_mut_loan meta l) in + let v, ctx = promote_shared_loan_to_mut_loan span l ctx in (* Promote the borrow - the value should have been checked by {!promote_shared_loan_to_mut_loan} *) - let cc = - comp cc (fun cf borrowed_value -> - replace_reserved_borrow_with_mut_borrow meta l cf borrowed_value) - in - (* Continue *) - cc cf ctx) + let ctx = replace_reserved_borrow_with_mut_borrow span l v ctx in + (* Return *) + (ctx, cc)) | _, Abstract _ -> (* I don't think it is possible to have two-phase borrows involving borrows * returned by abstractions. I'm not sure how we could handle that anyway. *) - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Can't activate a reserved mutable borrow referencing a loan inside\n\ \ a region abstraction" -let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) +let destructure_abs (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) (destructure_shared_values : bool) (ctx : eval_ctx) (abs0 : abs) : abs = (* Accumulator to store the destructured values *) let avalues = ref [] in @@ -1656,7 +1624,7 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) ignore the children altogether. Instead, we explore them and make sure we don't register values while doing so. *) - let push_fail _ = craise __FILE__ __LINE__ meta "Unreachable" in + let push_fail _ = craise __FILE__ __LINE__ span "Unreachable" in (* Function to explore an avalue and destructure it *) let rec list_avalues (allow_borrows : bool) (push : typed_avalue -> unit) (av : typed_avalue) : unit = @@ -1673,13 +1641,13 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) (* We don't support nested borrows for now *) cassert __FILE__ __LINE__ (not (value_has_borrows ctx sv.value)) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; (* Destructure the shared value *) let avl, sv = if destructure_shared_values then list_values sv else ([], sv) in (* Push a value *) - let ignored = mk_aignored meta child_av.ty in + let ignored = mk_aignored span child_av.ty in let value = ALoan (ASharedLoan (bids, sv, ignored)) in push { value; ty }; (* Explore the child *) @@ -1695,39 +1663,39 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) (* Explore the child *) list_avalues false push_fail child_av; (* Explore the whole loan *) - let ignored = mk_aignored meta child_av.ty in + let ignored = mk_aignored span child_av.ty in let value = ALoan (AMutLoan (bid, ignored)) in push { value; ty } | AIgnoredMutLoan (opt_bid, child_av) -> (* We don't support nested borrows for now *) cassert __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)) - meta "Nested borrows are not supported yet"; - sanity_check __FILE__ __LINE__ (opt_bid = None) meta; + span "Nested borrows are not supported yet"; + sanity_check __FILE__ __LINE__ (opt_bid = None) span; (* Simply explore the child *) list_avalues false push_fail child_av | AEndedMutLoan - { child = child_av; given_back = _; given_back_meta = _ } + { child = child_av; given_back = _; given_back_span = _ } | AEndedSharedLoan (_, child_av) | AEndedIgnoredMutLoan - { child = child_av; given_back = _; given_back_meta = _ } + { child = child_av; given_back = _; given_back_span = _ } | AIgnoredSharedLoan child_av -> (* We don't support nested borrows for now *) cassert __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; (* Simply explore the child *) list_avalues false push_fail child_av) | ABorrow bc -> ( (* Sanity check - rem.: may be redundant with [push_fail] *) - sanity_check __FILE__ __LINE__ allow_borrows meta; + sanity_check __FILE__ __LINE__ allow_borrows span; (* Explore the borrow content *) match bc with | AMutBorrow (bid, child_av) -> (* Explore the child *) list_avalues false push_fail child_av; (* Explore the borrow *) - let ignored = mk_aignored meta child_av.ty in + let ignored = mk_aignored span child_av.ty in let value = ABorrow (AMutBorrow (bid, ignored)) in push { value; ty } | ASharedBorrow _ -> @@ -1737,21 +1705,21 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) (* We don't support nested borrows for now *) cassert __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)) - meta "Nested borrows are not supported yet"; - sanity_check __FILE__ __LINE__ (opt_bid = None) meta; + span "Nested borrows are not supported yet"; + sanity_check __FILE__ __LINE__ (opt_bid = None) span; (* Just explore the child *) list_avalues false push_fail child_av | AEndedIgnoredMutBorrow - { child = child_av; given_back = _; given_back_meta = _ } -> + { child = child_av; given_back = _; given_back_span = _ } -> (* We don't support nested borrows for now *) cassert __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos child_av.ty)) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; (* Just explore the child *) list_avalues false push_fail child_av | AProjSharedBorrow asb -> (* We don't support nested borrows *) - cassert __FILE__ __LINE__ (asb = []) meta + cassert __FILE__ __LINE__ (asb = []) span "Nested borrows are not supported yet"; (* Nothing specific to do *) () @@ -1760,13 +1728,13 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) be in the context anymore (if we end *one* borrow in an abstraction, we have to end them all and remove the abstraction from the context) *) - craise __FILE__ __LINE__ meta "Unreachable") + craise __FILE__ __LINE__ span "Unreachable") | ASymbolic _ -> (* For now, we fore all symbolic values containing borrows to be eagerly expanded *) sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos ty)) - meta + span and list_values (v : typed_value) : typed_avalue list * typed_value = let ty = v.ty in match v.value with @@ -1778,22 +1746,22 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) let avl = List.concat avll in let adt = { adt with field_values } in (avl, { v with value = VAdt adt }) - | VBottom -> craise __FILE__ __LINE__ meta "Unreachable" + | VBottom -> craise __FILE__ __LINE__ span "Unreachable" | VBorrow _ -> (* We don't support nested borrows for now *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | VLoan lc -> ( match lc with | VSharedLoan (bids, sv) -> let avl, sv = list_values sv in if destructure_shared_values then ( (* Rem.: the shared value can't contain loans nor borrows *) - cassert __FILE__ __LINE__ (ty_no_regions ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ty) span "Nested borrows are not supported yet"; let av : typed_avalue = sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv.value)) - meta; + span; (* We introduce fresh ids for the symbolic values *) let mk_value_with_fresh_sids (v : typed_value) : typed_value = let visitor = @@ -1809,20 +1777,20 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) let sv = mk_value_with_fresh_sids sv in (* Create the new avalue *) let value = - ALoan (ASharedLoan (bids, sv, mk_aignored meta ty)) + ALoan (ASharedLoan (bids, sv, mk_aignored span ty)) in { value; ty } in let avl = List.append [ av ] avl in (avl, sv)) else (avl, { v with value = VLoan (VSharedLoan (bids, sv)) }) - | VMutLoan _ -> craise __FILE__ __LINE__ meta "Unreachable") + | VMutLoan _ -> craise __FILE__ __LINE__ span "Unreachable") | VSymbolic _ -> (* For now, we fore all symbolic values containing borrows to be eagerly expanded *) sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos ty)) - meta; + span; ([], v) in @@ -1832,14 +1800,14 @@ let destructure_abs (meta : Meta.meta) (abs_kind : abs_kind) (can_end : bool) (* Update *) { abs0 with avalues; kind = abs_kind; can_end } -let abs_is_destructured (meta : Meta.meta) (destructure_shared_values : bool) +let abs_is_destructured (span : Meta.span) (destructure_shared_values : bool) (ctx : eval_ctx) (abs : abs) : bool = let abs' = - destructure_abs meta abs.kind abs.can_end destructure_shared_values ctx abs + destructure_abs span abs.kind abs.can_end destructure_shared_values ctx abs in abs = abs' -let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) +let convert_value_to_abstractions (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) (destructure_shared_values : bool) (ctx : eval_ctx) (v : typed_value) : abs list = (* Convert the value to a list of avalues *) @@ -1878,7 +1846,7 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) log#ldebug (lazy ("convert_value_to_abstractions: to_avalues:\n- value: " - ^ typed_value_to_string ~meta:(Some meta) ctx v)); + ^ typed_value_to_string ~span:(Some span) ctx v)); let ty = v.ty in match v.value with @@ -1922,14 +1890,14 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) (avl, { v with value = VAdt adt }) | VBorrow bc -> ( let _, ref_ty, kind = ty_as_ref ty in - cassert __FILE__ __LINE__ (ty_no_regions ref_ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ref_ty) span "Nested borrows are not supported yet"; (* Sanity check *) - sanity_check __FILE__ __LINE__ allow_borrows meta; + sanity_check __FILE__ __LINE__ allow_borrows span; (* Convert the borrow content *) match bc with | VSharedBorrow bid -> - cassert __FILE__ __LINE__ (ty_no_regions ref_ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ref_ty) span "Nested borrows are not supported yet"; let ty = TRef (RFVar r_id, ref_ty, kind) in let value = ABorrow (ASharedBorrow bid) in @@ -1939,10 +1907,10 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) (* We don't support nested borrows for now *) cassert __FILE__ __LINE__ (not (value_has_borrows ctx bv.value)) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; (* Create an avalue to push - note that we use [AIgnore] for the inner avalue *) let ty = TRef (RFVar r_id, ref_ty, kind) in - let ignored = mk_aignored meta ref_ty in + let ignored = mk_aignored span ref_ty in let av = ABorrow (AMutBorrow (bid, ignored)) in let av = { value = av; ty } in (* Continue exploring, looking for loans (and forbidding borrows, @@ -1952,7 +1920,7 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) (av :: avl, value) | VReservedMutBorrow _ -> (* This borrow should have been activated *) - craise __FILE__ __LINE__ meta "Unexpected") + craise __FILE__ __LINE__ span "Unexpected") | VLoan lc -> ( match lc with | VSharedLoan (bids, sv) -> @@ -1960,13 +1928,13 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) (* We don't support nested borrows for now *) cassert __FILE__ __LINE__ (not (value_has_borrows ctx sv.value)) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; (* Push the avalue - note that we use [AIgnore] for the inner avalue *) (* For avalues, a loan has the borrow type *) - cassert __FILE__ __LINE__ (ty_no_regions ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ty) span "Nested borrows are not supported yet"; let ty = mk_ref_ty (RFVar r_id) ty RShared in - let ignored = mk_aignored meta ty in + let ignored = mk_aignored span ty in (* Rem.: the shared value might contain loans *) let avl, sv = to_avalues false true true r_id sv in let av = ALoan (ASharedLoan (bids, sv, ignored)) in @@ -1982,10 +1950,10 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) | VMutLoan bid -> (* Push the avalue - note that we use [AIgnore] for the inner avalue *) (* For avalues, a loan has the borrow type *) - cassert __FILE__ __LINE__ (ty_no_regions ty) meta + cassert __FILE__ __LINE__ (ty_no_regions ty) span "Nested borrows are not supported yet"; let ty = mk_ref_ty (RFVar r_id) ty RMut in - let ignored = mk_aignored meta ty in + let ignored = mk_aignored span ty in let av = ALoan (AMutLoan (bid, ignored)) in let av = { value = av; ty } in ([ av ], v)) @@ -1994,7 +1962,7 @@ let convert_value_to_abstractions (meta : Meta.meta) (abs_kind : abs_kind) be eagerly expanded, and we don't support nested borrows *) cassert __FILE__ __LINE__ (not (value_has_borrows ctx v.value)) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; (* Return nothing *) ([], v) in @@ -2035,7 +2003,7 @@ type merge_abstraction_info = { - all the borrows are destructured (for instance, shared loans can't contain shared loans). *) -let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) +let compute_merge_abstraction_info (span : Meta.span) (ctx : eval_ctx) (abs : abs) : merge_abstraction_info = let loans : loan_id_set ref = ref BorrowId.Set.empty in let borrows : borrow_id_set ref = ref BorrowId.Set.empty in @@ -2048,32 +2016,32 @@ let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) in let push_loans ids (lc : g_loan_content_with_ty) : unit = - sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint !loans ids) meta; + sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint !loans ids) span; loans := BorrowId.Set.union !loans ids; BorrowId.Set.iter (fun id -> sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem id !loan_to_content)) - meta; + span; loan_to_content := BorrowId.Map.add id lc !loan_to_content; borrows_loans := LoanId id :: !borrows_loans) ids in let push_loan id (lc : g_loan_content_with_ty) : unit = - sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem id !loans)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem id !loans)) span; loans := BorrowId.Set.add id !loans; sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem id !loan_to_content)) - meta; + span; loan_to_content := BorrowId.Map.add id lc !loan_to_content; borrows_loans := LoanId id :: !borrows_loans in let push_borrow id (bc : g_borrow_content_with_ty) : unit = - sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem id !borrows)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem id !borrows)) span; borrows := BorrowId.Set.add id !borrows; sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem id !borrow_to_content)) - meta; + span; borrow_to_content := BorrowId.Map.add id bc !borrow_to_content; borrows_loans := BorrowId id :: !borrows_loans in @@ -2096,23 +2064,23 @@ let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) let ty = match Option.get env with | Concrete ty -> ty - | Abstract _ -> craise __FILE__ __LINE__ meta "Unreachable" + | Abstract _ -> craise __FILE__ __LINE__ span "Unreachable" in (match lc with | VSharedLoan (bids, _) -> push_loans bids (Concrete (ty, lc)) - | VMutLoan _ -> craise __FILE__ __LINE__ meta "Unreachable"); + | VMutLoan _ -> craise __FILE__ __LINE__ span "Unreachable"); (* Continue *) super#visit_loan_content env lc method! visit_borrow_content _ _ = (* Can happen if we explore shared values which contain borrows - i.e., if we have nested borrows (we forbid this for now) *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" method! visit_aloan_content env lc = let ty = match Option.get env with - | Concrete _ -> craise __FILE__ __LINE__ meta "Unreachable" + | Concrete _ -> craise __FILE__ __LINE__ span "Unreachable" | Abstract ty -> ty in (* Register the loans *) @@ -2122,14 +2090,14 @@ let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) | AEndedMutLoan _ | AEndedSharedLoan _ | AIgnoredMutLoan _ | AEndedIgnoredMutLoan _ | AIgnoredSharedLoan _ -> (* The abstraction has been destructured, so those shouldn't appear *) - craise __FILE__ __LINE__ meta "Unreachable"); + craise __FILE__ __LINE__ span "Unreachable"); (* Continue *) super#visit_aloan_content env lc method! visit_aborrow_content env bc = let ty = match Option.get env with - | Concrete _ -> craise __FILE__ __LINE__ meta "Unreachable" + | Concrete _ -> craise __FILE__ __LINE__ span "Unreachable" | Abstract ty -> ty in (* Explore the borrow content *) @@ -2143,20 +2111,20 @@ let compute_merge_abstraction_info (meta : Meta.meta) (ctx : eval_ctx) | AsbProjReborrows _ -> (* Can only happen if the symbolic value (potentially) contains borrows - i.e., we have nested borrows *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in List.iter register asb | AIgnoredMutBorrow _ | AEndedIgnoredMutBorrow _ | AEndedMutBorrow _ | AEndedSharedBorrow -> (* The abstraction has been destructured, so those shouldn't appear *) - craise __FILE__ __LINE__ meta "Unreachable"); + craise __FILE__ __LINE__ span "Unreachable"); super#visit_aborrow_content env bc method! visit_symbolic_value _ sv = (* Sanity check: no borrows *) sanity_check __FILE__ __LINE__ (not (symbolic_value_has_borrows ctx sv)) - meta + span end in @@ -2223,25 +2191,25 @@ type merge_duplicates_funcs = { Merge two abstractions into one, without updating the context. *) -let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) +let merge_into_abstraction_aux (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) (merge_funs : merge_duplicates_funcs option) (ctx : eval_ctx) (abs0 : abs) (abs1 : abs) : abs = log#ldebug (lazy ("merge_into_abstraction_aux:\n- abs0:\n" - ^ abs_to_string meta ctx abs0 + ^ abs_to_string span ctx abs0 ^ "\n\n- abs1:\n" - ^ abs_to_string meta ctx abs1)); + ^ abs_to_string span ctx abs1)); (* Check that the abstractions are destructured *) if !Config.sanity_checks then ( let destructure_shared_values = true in sanity_check __FILE__ __LINE__ - (abs_is_destructured meta destructure_shared_values ctx abs0) - meta; + (abs_is_destructured span destructure_shared_values ctx abs0) + span; sanity_check __FILE__ __LINE__ - (abs_is_destructured meta destructure_shared_values ctx abs1) - meta); + (abs_is_destructured span destructure_shared_values ctx abs1) + span); (* Compute the relevant information *) let { @@ -2251,7 +2219,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) loan_to_content = loan_to_content0; borrow_to_content = borrow_to_content0; } = - compute_merge_abstraction_info meta ctx abs0 + compute_merge_abstraction_info span ctx abs0 in let { @@ -2261,7 +2229,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) loan_to_content = loan_to_content1; borrow_to_content = borrow_to_content1; } = - compute_merge_abstraction_info meta ctx abs1 + compute_merge_abstraction_info span ctx abs1 in (* Sanity check: there is no loan/borrows which appears in both abstractions, @@ -2269,8 +2237,8 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) if merge_funs = None then ( sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint borrows0 borrows1) - meta; - sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint loans0 loans1) meta); + span; + sanity_check __FILE__ __LINE__ (BorrowId.Set.disjoint loans0 loans1) span); (* Merge. There are several cases: @@ -2297,7 +2265,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) log#ldebug (lazy ("merge_into_abstraction_aux: push_avalue: " - ^ typed_avalue_to_string ~meta:(Some meta) ctx av)); + ^ typed_avalue_to_string ~span:(Some span) ctx av)); avalues := av :: !avalues in let push_opt_avalue av = @@ -2311,7 +2279,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) in let filter_bids (bids : BorrowId.Set.t) : BorrowId.Set.t = let bids = BorrowId.Set.diff bids intersect in - sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) span; bids in let filter_bid (bid : BorrowId.id) : BorrowId.id option = @@ -2339,11 +2307,11 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) (Option.get merge_funs).merge_ashared_borrows id ty0 ty1 | AProjSharedBorrow _, AProjSharedBorrow _ -> (* Unreachable because requires nested borrows *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | _ -> (* Unreachable because those cases are ignored (ended/ignored borrows) or inconsistent *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in let merge_g_borrow_contents (bc0 : g_borrow_content_with_ty) @@ -2351,12 +2319,12 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) match (bc0, bc1) with | Concrete _, Concrete _ -> (* This can happen only in case of nested borrows *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Abstract (ty0, bc0), Abstract (ty1, bc1) -> merge_aborrow_contents ty0 bc0 ty1 bc1 | Concrete _, Abstract _ | Abstract _, Concrete _ -> (* TODO: is it really unreachable? *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in let merge_aloan_contents (ty0 : rty) (lc0 : aloan_content) (ty1 : rty) @@ -2374,7 +2342,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) (* Check that the sets of ids are the same - if it is not the case, it means we actually need to merge more than 2 avalues: we ignore this case for now *) - sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids0 ids1) meta; + sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids0 ids1) span; let ids = ids0 in if BorrowId.Set.is_empty ids then ( (* If the set of ids is empty, we can eliminate this shared loan. @@ -2388,12 +2356,12 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) *) sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv0.value)) - meta; + span; sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv0.value)) - meta; - sanity_check __FILE__ __LINE__ (is_aignored child0.value) meta; - sanity_check __FILE__ __LINE__ (is_aignored child1.value) meta; + span; + sanity_check __FILE__ __LINE__ (is_aignored child0.value) span; + sanity_check __FILE__ __LINE__ (is_aignored child1.value) span; None) else ( (* Register the loan ids *) @@ -2405,7 +2373,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) | _ -> (* Unreachable because those cases are ignored (ended/ignored borrows) or inconsistent *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in (* Note that because we may filter ids from a set of id, this function has @@ -2416,12 +2384,12 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) match (lc0, lc1) with | Concrete _, Concrete _ -> (* This can not happen: the values should have been destructured *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Abstract (ty0, lc0), Abstract (ty1, lc1) -> merge_aloan_contents ty0 lc0 ty1 lc1 | Concrete _, Abstract _ | Abstract _, Concrete _ -> (* TODO: is it really unreachable? *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in (* Note that we first explore the borrows/loans of [abs1], because we @@ -2462,12 +2430,12 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) a concrete borrow can only happen inside a shared loan *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Abstract (ty, bc) -> { value = ABorrow bc; ty }) | Some bc0, Some bc1 -> - sanity_check __FILE__ __LINE__ (merge_funs <> None) meta; + sanity_check __FILE__ __LINE__ (merge_funs <> None) span; merge_g_borrow_contents bc0 bc1 - | None, None -> craise __FILE__ __LINE__ meta "Unreachable" + | None, None -> craise __FILE__ __LINE__ span "Unreachable" in push_avalue av) | LoanId bid -> @@ -2500,19 +2468,19 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) | Concrete _ -> (* This shouldn't happen because the avalues should have been destructured. *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Abstract (ty, lc) -> ( match lc with | ASharedLoan (bids, sv, child) -> let bids = filter_bids bids in sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) - meta; + span; sanity_check __FILE__ __LINE__ - (is_aignored child.value) meta; + (is_aignored child.value) span; sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv.value)) - meta; + span; let lc = ASharedLoan (bids, sv, child) in set_loans_as_merged bids; Some { value = ALoan lc; ty } @@ -2523,11 +2491,11 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) | AIgnoredMutLoan _ | AEndedIgnoredMutLoan _ | AIgnoredSharedLoan _ -> (* The abstraction has been destructured, so those shouldn't appear *) - craise __FILE__ __LINE__ meta "Unreachable")) + craise __FILE__ __LINE__ span "Unreachable")) | Some lc0, Some lc1 -> - sanity_check __FILE__ __LINE__ (merge_funs <> None) meta; + sanity_check __FILE__ __LINE__ (merge_funs <> None) span; merge_g_loan_contents lc0 lc1 - | None, None -> craise __FILE__ __LINE__ meta "Unreachable" + | None, None -> craise __FILE__ __LINE__ span "Unreachable" in push_opt_avalue av)) borrows_loans; @@ -2545,7 +2513,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) match av.value with | ABorrow _ -> true | ALoan _ -> false - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in let aborrows, aloans = List.partition is_borrow avalues in List.append aborrows aloans @@ -2580,7 +2548,7 @@ let merge_into_abstraction_aux (meta : Meta.meta) (abs_kind : abs_kind) in (* Sanity check *) - sanity_check __FILE__ __LINE__ (abs_is_destructured meta true ctx abs) meta; + sanity_check __FILE__ __LINE__ (abs_is_destructured span true ctx abs) span; (* Return *) abs @@ -2591,7 +2559,7 @@ let ctx_merge_regions (ctx : eval_ctx) (rid : RegionId.id) let env = Substitute.env_subst_rids rsubst ctx.env in { ctx with env } -let merge_into_abstraction (meta : Meta.meta) (abs_kind : abs_kind) +let merge_into_abstraction (span : Meta.span) (abs_kind : abs_kind) (can_end : bool) (merge_funs : merge_duplicates_funcs option) (ctx : eval_ctx) (abs_id0 : AbstractionId.id) (abs_id1 : AbstractionId.id) : eval_ctx * AbstractionId.id = @@ -2601,13 +2569,13 @@ let merge_into_abstraction (meta : Meta.meta) (abs_kind : abs_kind) (* Merge them *) let nabs = - merge_into_abstraction_aux meta abs_kind can_end merge_funs ctx abs0 abs1 + merge_into_abstraction_aux span abs_kind can_end merge_funs ctx abs0 abs1 in (* Update the environment: replace the abstraction 1 with the result of the merge, remove the abstraction 0 *) - let ctx = fst (ctx_subst_abs meta ctx abs_id1 nabs) in - let ctx = fst (ctx_remove_abs meta ctx abs_id0) in + let ctx = fst (ctx_subst_abs span ctx abs_id1 nabs) in + let ctx = fst (ctx_remove_abs span ctx abs_id0) in (* Merge all the regions from the abstraction into one (the first - i.e., the one with the smallest id). Note that we need to do this in the whole diff --git a/compiler/InterpreterBorrows.mli b/compiler/InterpreterBorrows.mli index 30b75790..56df9344 100644 --- a/compiler/InterpreterBorrows.mli +++ b/compiler/InterpreterBorrows.mli @@ -9,39 +9,39 @@ open Cps the set of borrows tracked by a shared value, referenced by the [original_bid] argument. *) val reborrow_shared : - Meta.meta -> BorrowId.id -> BorrowId.id -> eval_ctx -> eval_ctx + Meta.span -> BorrowId.id -> BorrowId.id -> eval_ctx -> eval_ctx (** End a borrow identified by its id, while preserving the invariants. If the borrow is inside another borrow/an abstraction or contains loans, [end_borrow] will end those borrows/abstractions/loans first. *) -val end_borrow : config -> Meta.meta -> BorrowId.id -> cm_fun +val end_borrow : config -> Meta.span -> BorrowId.id -> cm_fun (** End a set of borrows identified by their ids, while preserving the invariants. *) -val end_borrows : config -> Meta.meta -> BorrowId.Set.t -> cm_fun +val end_borrows : config -> Meta.span -> BorrowId.Set.t -> cm_fun (** End an abstraction while preserving the invariants. *) -val end_abstraction : config -> Meta.meta -> AbstractionId.id -> cm_fun +val end_abstraction : config -> Meta.span -> AbstractionId.id -> cm_fun (** End a set of abstractions while preserving the invariants. *) -val end_abstractions : config -> Meta.meta -> AbstractionId.Set.t -> cm_fun +val end_abstractions : config -> Meta.span -> AbstractionId.Set.t -> cm_fun (** End a borrow and return the resulting environment, ignoring synthesis *) val end_borrow_no_synth : - config -> Meta.meta -> BorrowId.id -> eval_ctx -> eval_ctx + config -> Meta.span -> BorrowId.id -> eval_ctx -> eval_ctx (** End a set of borrows and return the resulting environment, ignoring synthesis *) val end_borrows_no_synth : - config -> Meta.meta -> BorrowId.Set.t -> eval_ctx -> eval_ctx + config -> Meta.span -> BorrowId.Set.t -> eval_ctx -> eval_ctx (** End an abstraction and return the resulting environment, ignoring synthesis *) val end_abstraction_no_synth : - config -> Meta.meta -> AbstractionId.id -> eval_ctx -> eval_ctx + config -> Meta.span -> AbstractionId.id -> eval_ctx -> eval_ctx (** End a set of abstractions and return the resulting environment, ignoring synthesis *) val end_abstractions_no_synth : - config -> Meta.meta -> AbstractionId.Set.t -> eval_ctx -> eval_ctx + config -> Meta.span -> AbstractionId.Set.t -> eval_ctx -> eval_ctx (** Promote a reserved mut borrow to a mut borrow, while preserving the invariants. @@ -52,7 +52,7 @@ val end_abstractions_no_synth : the corresponding shared loan with a mutable loan (after having ended the other shared borrows which point to this loan). *) -val promote_reserved_mut_borrow : config -> Meta.meta -> BorrowId.id -> cm_fun +val promote_reserved_mut_borrow : config -> Meta.span -> BorrowId.id -> cm_fun (** Transform an abstraction to an abstraction where the values are not structured. @@ -95,7 +95,7 @@ val promote_reserved_mut_borrow : config -> Meta.meta -> BorrowId.id -> cm_fun - [abs] *) val destructure_abs : - Meta.meta -> abs_kind -> bool -> bool -> eval_ctx -> abs -> abs + Meta.span -> abs_kind -> bool -> bool -> eval_ctx -> abs -> abs (** Return [true] if the values in an abstraction are destructured. @@ -103,7 +103,7 @@ val destructure_abs : The input boolean is [destructure_shared_value]. See {!destructure_abs}. *) -val abs_is_destructured : Meta.meta -> bool -> eval_ctx -> abs -> bool +val abs_is_destructured : Meta.span -> bool -> eval_ctx -> abs -> bool (** Turn a value into a abstractions. @@ -129,7 +129,7 @@ val abs_is_destructured : Meta.meta -> bool -> eval_ctx -> abs -> bool - [v] *) val convert_value_to_abstractions : - Meta.meta -> abs_kind -> bool -> bool -> eval_ctx -> typed_value -> abs list + Meta.span -> abs_kind -> bool -> bool -> eval_ctx -> typed_value -> abs list (** See {!merge_into_abstraction}. @@ -236,7 +236,7 @@ type merge_duplicates_funcs = { results from the merge. *) val merge_into_abstraction : - Meta.meta -> + Meta.span -> abs_kind -> bool -> merge_duplicates_funcs option -> diff --git a/compiler/InterpreterBorrowsCore.ml b/compiler/InterpreterBorrowsCore.ml index a01be046..2628b26a 100644 --- a/compiler/InterpreterBorrowsCore.ml +++ b/compiler/InterpreterBorrowsCore.ml @@ -72,10 +72,10 @@ let borrow_or_abs_ids_chain_to_string (ids : borrow_or_abs_ids) : string = String.concat " -> " ids (** Add a borrow or abs id to a chain of ids, while checking that we don't loop *) -let add_borrow_or_abs_id_to_chain (meta : Meta.meta) (msg : string) +let add_borrow_or_abs_id_to_chain (span : Meta.span) (msg : string) (id : borrow_or_abs_id) (ids : borrow_or_abs_ids) : borrow_or_abs_ids = if List.mem id ids then - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span (msg ^ "detected a loop in the chain of ids: " ^ borrow_or_abs_ids_chain_to_string (id :: ids)) else id :: ids @@ -94,25 +94,25 @@ let add_borrow_or_abs_id_to_chain (meta : Meta.meta) (msg : string) TODO: is there a way of deriving such a comparison? TODO: rename *) -let rec compare_rtys (meta : Meta.meta) (default : bool) +let rec compare_rtys (span : Meta.span) (default : bool) (combine : bool -> bool -> bool) (compare_regions : region -> region -> bool) (ty1 : rty) (ty2 : rty) : bool = - let compare = compare_rtys meta default combine compare_regions in + let compare = compare_rtys span default combine compare_regions in (* Sanity check - TODO: don't do this at every recursive call *) - sanity_check __FILE__ __LINE__ (ty_is_rty ty1 && ty_is_rty ty2) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty1 && ty_is_rty ty2) span; (* Normalize the associated types *) match (ty1, ty2) with | TLiteral lit1, TLiteral lit2 -> - sanity_check __FILE__ __LINE__ (lit1 = lit2) meta; + sanity_check __FILE__ __LINE__ (lit1 = lit2) span; default | TAdt (id1, generics1), TAdt (id2, generics2) -> - sanity_check __FILE__ __LINE__ (id1 = id2) meta; + sanity_check __FILE__ __LINE__ (id1 = id2) span; (* There are no regions in the const generics, so we ignore them, but we still check they are the same, for sanity *) sanity_check __FILE__ __LINE__ (generics1.const_generics = generics2.const_generics) - meta; + span; (* We also ignore the trait refs *) @@ -146,7 +146,7 @@ let rec compare_rtys (meta : Meta.meta) (default : bool) combine params_b tys_b | TRef (r1, ty1, kind1), TRef (r2, ty2, kind2) -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (kind1 = kind2) meta; + sanity_check __FILE__ __LINE__ (kind1 = kind2) span; (* Explanation for the case where we check if projections intersect: * the projections intersect if the borrows intersect or their contents * intersect. *) @@ -154,19 +154,19 @@ let rec compare_rtys (meta : Meta.meta) (default : bool) let tys_b = compare ty1 ty2 in combine regions_b tys_b | TVar id1, TVar id2 -> - sanity_check __FILE__ __LINE__ (id1 = id2) meta; + sanity_check __FILE__ __LINE__ (id1 = id2) span; default | TTraitType _, TTraitType _ -> (* The types should have been normalized. If after normalization we get trait types, we can consider them as variables *) - sanity_check __FILE__ __LINE__ (ty1 = ty2) meta; + sanity_check __FILE__ __LINE__ (ty1 = ty2) span; default | _ -> log#ltrace (lazy ("compare_rtys: unexpected inputs:" ^ "\n- ty1: " ^ show_ty ty1 ^ "\n- ty2: " ^ show_ty ty2)); - internal_error __FILE__ __LINE__ meta + internal_error __FILE__ __LINE__ span (** Check if two different projections intersect. This is necessary when giving a symbolic value to an abstraction: we need to check that @@ -175,14 +175,14 @@ let rec compare_rtys (meta : Meta.meta) (default : bool) Note that the two abstractions have different views (in terms of regions) of the symbolic value (hence the two region types). *) -let projections_intersect (meta : Meta.meta) (ty1 : rty) +let projections_intersect (span : Meta.span) (ty1 : rty) (rset1 : RegionId.Set.t) (ty2 : rty) (rset2 : RegionId.Set.t) : bool = let default = false in let combine b1 b2 = b1 || b2 in let compare_regions r1 r2 = region_in_set r1 rset1 && region_in_set r2 rset2 in - compare_rtys meta default combine compare_regions ty1 ty2 + compare_rtys span default combine compare_regions ty1 ty2 (** Check if the first projection contains the second projection. We use this function when checking invariants. @@ -190,14 +190,14 @@ let projections_intersect (meta : Meta.meta) (ty1 : rty) The regions in the types shouldn't be erased (this function will raise an exception otherwise). *) -let projection_contains (meta : Meta.meta) (ty1 : rty) (rset1 : RegionId.Set.t) +let projection_contains (span : Meta.span) (ty1 : rty) (rset1 : RegionId.Set.t) (ty2 : rty) (rset2 : RegionId.Set.t) : bool = let default = true in let combine b1 b2 = b1 && b2 in let compare_regions r1 r2 = region_in_set r1 rset1 || not (region_in_set r2 rset2) in - compare_rtys meta default combine compare_regions ty1 ty2 + compare_rtys span default combine compare_regions ty1 ty2 (** Lookup a loan content. @@ -207,7 +207,7 @@ let projection_contains (meta : Meta.meta) (ty1 : rty) (rset1 : RegionId.Set.t) the {!InterpreterUtils.abs_or_var_id} is not necessarily {!constructor:Aeneas.InterpreterUtils.abs_or_var_id.VarId} or {!constructor:Aeneas.InterpreterUtils.abs_or_var_id.DummyVarId}: there can be concrete loans in abstractions (in the shared values). *) -let lookup_loan_opt (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) +let lookup_loan_opt (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) (ctx : eval_ctx) : (abs_or_var_id * g_loan_content) option = (* We store here whether we are inside an abstraction or a value - note that we * could also track that with the environment, it would probably be more idiomatic @@ -262,16 +262,16 @@ let lookup_loan_opt (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) if BorrowId.Set.mem l bids then raise (FoundGLoanContent (Abstract lc)) else super#visit_ASharedLoan env bids v av - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } | AEndedSharedLoan (_, _) | AIgnoredMutLoan (_, _) | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AIgnoredSharedLoan _ -> super#visit_aloan_content env lc method! visit_EBinding env bv v = - sanity_check __FILE__ __LINE__ (Option.is_none !abs_or_var) meta; + sanity_check __FILE__ __LINE__ (Option.is_none !abs_or_var) span; abs_or_var := Some (match bv with @@ -281,7 +281,7 @@ let lookup_loan_opt (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) abs_or_var := None method! visit_EAbs env abs = - sanity_check __FILE__ __LINE__ (Option.is_none !abs_or_var) meta; + sanity_check __FILE__ __LINE__ (Option.is_none !abs_or_var) span; if ek.enter_abs then ( abs_or_var := Some (AbsId abs.abs_id); super#visit_EAbs env abs; @@ -296,17 +296,17 @@ let lookup_loan_opt (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) with FoundGLoanContent lc -> ( match !abs_or_var with | Some abs_or_var -> Some (abs_or_var, lc) - | None -> craise __FILE__ __LINE__ meta "Inconsistent state") + | None -> craise __FILE__ __LINE__ span "Inconsistent state") (** Lookup a loan content. The loan is referred to by a borrow id. Raises an exception if no loan was found. *) -let lookup_loan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) +let lookup_loan (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) (ctx : eval_ctx) : abs_or_var_id * g_loan_content = - match lookup_loan_opt meta ek l ctx with - | None -> craise __FILE__ __LINE__ meta "Unreachable" + match lookup_loan_opt span ek l ctx with + | None -> craise __FILE__ __LINE__ span "Unreachable" | Some res -> res (** Update a loan content. @@ -315,14 +315,14 @@ let lookup_loan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) This is a helper function: it might break invariants. *) -let update_loan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) +let update_loan (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) (nlc : loan_content) (ctx : eval_ctx) : eval_ctx = (* We use a reference to check that we update exactly one loan: when updating * inside values, we check we don't update more than one loan. Then, upon * returning we check that we updated at least once. *) let r = ref false in let update () : loan_content = - sanity_check __FILE__ __LINE__ (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) span; r := true; nlc in @@ -369,7 +369,7 @@ let update_loan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let ctx = obj#visit_eval_ctx () ctx in (* Check that we updated at least one loan *) - sanity_check __FILE__ __LINE__ !r meta; + sanity_check __FILE__ __LINE__ !r span; ctx (** Update a abstraction loan content. @@ -378,14 +378,14 @@ let update_loan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) This is a helper function: it might break invariants. *) -let update_aloan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) +let update_aloan (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) (nlc : aloan_content) (ctx : eval_ctx) : eval_ctx = (* We use a reference to check that we update exactly one loan: when updating * inside values, we check we don't update more than one loan. Then, upon * returning we check that we updated at least once. *) let r = ref false in let update () : aloan_content = - sanity_check __FILE__ __LINE__ (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) span; r := true; nlc in @@ -401,11 +401,11 @@ let update_aloan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) | ASharedLoan (bids, v, av) -> if BorrowId.Set.mem l bids then update () else super#visit_ASharedLoan env bids v av - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } | AEndedSharedLoan (_, _) | AIgnoredMutLoan (_, _) | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AIgnoredSharedLoan _ -> super#visit_aloan_content env lc @@ -418,7 +418,7 @@ let update_aloan (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let ctx = obj#visit_eval_ctx () ctx in (* Check that we updated at least one loan *) - sanity_check __FILE__ __LINE__ !r meta; + sanity_check __FILE__ __LINE__ !r span; ctx (** Lookup a borrow content from a borrow id. *) @@ -462,7 +462,7 @@ let lookup_borrow_opt (ek : exploration_kind) (l : BorrowId.id) (ctx : eval_ctx) | AIgnoredMutBorrow (_, _) | AEndedMutBorrow _ | AEndedIgnoredMutBorrow - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AEndedSharedBorrow -> super#visit_aborrow_content env bc | AProjSharedBorrow asb -> @@ -484,10 +484,10 @@ let lookup_borrow_opt (ek : exploration_kind) (l : BorrowId.id) (ctx : eval_ctx) Raise an exception if no loan was found *) -let lookup_borrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) +let lookup_borrow (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) (ctx : eval_ctx) : g_borrow_content = match lookup_borrow_opt ek l ctx with - | None -> craise __FILE__ __LINE__ meta "Unreachable" + | None -> craise __FILE__ __LINE__ span "Unreachable" | Some lc -> lc (** Update a borrow content. @@ -496,14 +496,14 @@ let lookup_borrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) This is a helper function: it might break invariants. *) -let update_borrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) +let update_borrow (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) (nbc : borrow_content) (ctx : eval_ctx) : eval_ctx = (* We use a reference to check that we update exactly one borrow: when updating * inside values, we check we don't update more than one borrow. Then, upon * returning we check that we updated at least once. *) let r = ref false in let update () : borrow_content = - sanity_check __FILE__ __LINE__ (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) span; r := true; nbc in @@ -544,7 +544,7 @@ let update_borrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let ctx = obj#visit_eval_ctx () ctx in (* Check that we updated at least one borrow *) - sanity_check __FILE__ __LINE__ !r meta; + sanity_check __FILE__ __LINE__ !r span; ctx (** Update an abstraction borrow content. @@ -553,14 +553,14 @@ let update_borrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) This is a helper function: it might break invariants. *) -let update_aborrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) +let update_aborrow (span : Meta.span) (ek : exploration_kind) (l : BorrowId.id) (nv : avalue) (ctx : eval_ctx) : eval_ctx = (* We use a reference to check that we update exactly one borrow: when updating * inside values, we check we don't update more than one borrow. Then, upon * returning we check that we updated at least once. *) let r = ref false in let update () : avalue = - sanity_check __FILE__ __LINE__ (not !r) meta; + sanity_check __FILE__ __LINE__ (not !r) span; r := true; nv in @@ -591,7 +591,7 @@ let update_aborrow (meta : Meta.meta) (ek : exploration_kind) (l : BorrowId.id) let ctx = obj#visit_eval_ctx () ctx in (* Check that we updated at least one borrow *) - cassert __FILE__ __LINE__ !r meta "No borrow was updated"; + cassert __FILE__ __LINE__ !r span "No borrow was updated"; ctx (** Auxiliary function: see its usage in [end_borrow_get_borrow_in_value] *) @@ -669,13 +669,13 @@ let get_first_outer_loan_or_borrow_in_value (with_borrows : bool) | FoundLoanContent lc -> Some (LoanContent lc) | FoundBorrowContent bc -> Some (BorrowContent bc) -let proj_borrows_intersects_proj_loans (meta : Meta.meta) +let proj_borrows_intersects_proj_loans (span : Meta.span) (proj_borrows : RegionId.Set.t * symbolic_value * rty) (proj_loans : RegionId.Set.t * symbolic_value) : bool = let b_regions, b_sv, b_ty = proj_borrows in let l_regions, l_sv = proj_loans in if same_symbolic_id b_sv l_sv then - projections_intersect meta l_sv.sv_ty l_regions b_ty b_regions + projections_intersect span l_sv.sv_ty l_regions b_ty b_regions else false (** Result of looking up aproj_borrows which intersect a given aproj_loans in @@ -703,24 +703,24 @@ type looked_up_aproj_borrows = This is a helper function. *) -let lookup_intersecting_aproj_borrows_opt (meta : Meta.meta) +let lookup_intersecting_aproj_borrows_opt (span : Meta.span) (lookup_shared : bool) (regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : looked_up_aproj_borrows option = let found : looked_up_aproj_borrows option ref = ref None in let set_non_shared ((id, ty) : AbstractionId.id * rty) : unit = match !found with | None -> found := Some (NonSharedProj (id, ty)) - | Some _ -> craise __FILE__ __LINE__ meta "Unreachable" + | Some _ -> craise __FILE__ __LINE__ span "Unreachable" in let add_shared (x : AbstractionId.id * rty) : unit = match !found with | None -> found := Some (SharedProjs [ x ]) | Some (SharedProjs pl) -> found := Some (SharedProjs (x :: pl)) - | Some (NonSharedProj _) -> craise __FILE__ __LINE__ meta "Unreachable" + | Some (NonSharedProj _) -> craise __FILE__ __LINE__ span "Unreachable" in let check_add_proj_borrows (is_shared : bool) abs sv' proj_ty = if - proj_borrows_intersects_proj_loans meta + proj_borrows_intersects_proj_loans span (abs.regions, sv', proj_ty) (regions, sv) then @@ -736,7 +736,7 @@ let lookup_intersecting_aproj_borrows_opt (meta : Meta.meta) method! visit_abstract_shared_borrow abs asb = (* Sanity check *) (match !found with - | Some (NonSharedProj _) -> craise __FILE__ __LINE__ meta "Unreachable" + | Some (NonSharedProj _) -> craise __FILE__ __LINE__ span "Unreachable" | _ -> ()); (* Explore *) if lookup_shared then @@ -775,23 +775,23 @@ let lookup_intersecting_aproj_borrows_opt (meta : Meta.meta) Returns the id of the owning abstraction, and the projection type used in this abstraction. *) -let lookup_intersecting_aproj_borrows_not_shared_opt (meta : Meta.meta) +let lookup_intersecting_aproj_borrows_not_shared_opt (span : Meta.span) (regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : (AbstractionId.id * rty) option = let lookup_shared = false in match - lookup_intersecting_aproj_borrows_opt meta lookup_shared regions sv ctx + lookup_intersecting_aproj_borrows_opt span lookup_shared regions sv ctx with | None -> None | Some (NonSharedProj (abs_id, rty)) -> Some (abs_id, rty) - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" (** Similar to {!lookup_intersecting_aproj_borrows_opt}, but updates the values. This is a helper function: it might break invariants. *) -let update_intersecting_aproj_borrows (meta : Meta.meta) +let update_intersecting_aproj_borrows (span : Meta.span) (can_update_shared : bool) (update_shared : AbstractionId.id -> rty -> abstract_shared_borrows) (update_non_shared : AbstractionId.id -> rty -> aproj) @@ -802,18 +802,18 @@ let update_intersecting_aproj_borrows (meta : Meta.meta) let add_shared () = match !shared with | None -> shared := Some true - | Some b -> sanity_check __FILE__ __LINE__ b meta + | Some b -> sanity_check __FILE__ __LINE__ b span in let set_non_shared () = match !shared with | None -> shared := Some false | Some _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Found unexpected intersecting proj_borrows" in let check_proj_borrows is_shared abs sv' proj_ty = if - proj_borrows_intersects_proj_loans meta + proj_borrows_intersects_proj_loans span (abs.regions, sv', proj_ty) (regions, sv) then ( @@ -830,7 +830,7 @@ let update_intersecting_aproj_borrows (meta : Meta.meta) method! visit_abstract_shared_borrows abs asb = (* Sanity check *) (match !shared with - | Some b -> sanity_check __FILE__ __LINE__ b meta + | Some b -> sanity_check __FILE__ __LINE__ b span | _ -> ()); (* Explore *) if can_update_shared then @@ -863,7 +863,7 @@ let update_intersecting_aproj_borrows (meta : Meta.meta) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Check that we updated the context at least once *) - cassert __FILE__ __LINE__ (Option.is_some !shared) meta + cassert __FILE__ __LINE__ (Option.is_some !shared) span "Context was not updated"; (* Return *) ctx @@ -875,12 +875,12 @@ let update_intersecting_aproj_borrows (meta : Meta.meta) This is a helper function: it might break invariants. *) -let update_intersecting_aproj_borrows_non_shared (meta : Meta.meta) +let update_intersecting_aproj_borrows_non_shared (span : Meta.span) (regions : RegionId.Set.t) (sv : symbolic_value) (nv : aproj) (ctx : eval_ctx) : eval_ctx = (* Small helpers *) let can_update_shared = false in - let update_shared _ _ = craise __FILE__ __LINE__ meta "Unexpected" in + let update_shared _ _ = craise __FILE__ __LINE__ span "Unexpected" in let updated = ref false in let update_non_shared _ _ = (* We can update more than one borrow! *) @@ -889,11 +889,11 @@ let update_intersecting_aproj_borrows_non_shared (meta : Meta.meta) in (* Update *) let ctx = - update_intersecting_aproj_borrows meta can_update_shared update_shared + update_intersecting_aproj_borrows span can_update_shared update_shared update_non_shared regions sv ctx in (* Check that we updated at least once *) - sanity_check __FILE__ __LINE__ !updated meta; + sanity_check __FILE__ __LINE__ !updated span; (* Return *) ctx @@ -902,15 +902,15 @@ let update_intersecting_aproj_borrows_non_shared (meta : Meta.meta) This is a helper function: it might break invariants. *) -let remove_intersecting_aproj_borrows_shared (meta : Meta.meta) +let remove_intersecting_aproj_borrows_shared (span : Meta.span) (regions : RegionId.Set.t) (sv : symbolic_value) (ctx : eval_ctx) : eval_ctx = (* Small helpers *) let can_update_shared = true in let update_shared _ _ = [] in - let update_non_shared _ _ = craise __FILE__ __LINE__ meta "Unexpected" in + let update_non_shared _ _ = craise __FILE__ __LINE__ span "Unexpected" in (* Update *) - update_intersecting_aproj_borrows meta can_update_shared update_shared + update_intersecting_aproj_borrows span can_update_shared update_shared update_non_shared regions sv ctx (** Updates the proj_loans intersecting some projection. @@ -944,12 +944,12 @@ let remove_intersecting_aproj_borrows_shared (meta : Meta.meta) Note that the symbolic value at this place is necessarily equal to [sv], which is why we don't give it as parameters. *) -let update_intersecting_aproj_loans (meta : Meta.meta) +let update_intersecting_aproj_loans (span : Meta.span) (proj_regions : RegionId.Set.t) (proj_ty : rty) (sv : symbolic_value) (subst : abs -> (msymbolic_value * aproj) list -> aproj) (ctx : eval_ctx) : eval_ctx = (* *) - sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) span; (* Small helpers for sanity checks *) let updated = ref false in let update abs local_given_back : aproj = @@ -971,9 +971,9 @@ let update_intersecting_aproj_loans (meta : Meta.meta) | AProjLoans (sv', given_back) -> let abs = Option.get abs in if same_symbolic_id sv sv' then ( - sanity_check __FILE__ __LINE__ (sv.sv_ty = sv'.sv_ty) meta; + sanity_check __FILE__ __LINE__ (sv.sv_ty = sv'.sv_ty) span; if - projections_intersect meta proj_ty proj_regions sv'.sv_ty + projections_intersect span proj_ty proj_regions sv'.sv_ty abs.regions then update abs given_back else super#visit_aproj (Some abs) sproj) @@ -983,7 +983,7 @@ let update_intersecting_aproj_loans (meta : Meta.meta) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Check that we updated the context at least once *) - sanity_check __FILE__ __LINE__ !updated meta; + sanity_check __FILE__ __LINE__ !updated span; (* Return *) ctx @@ -997,13 +997,13 @@ let update_intersecting_aproj_loans (meta : Meta.meta) Sanity check: we check that there is exactly one projector which corresponds to the couple (abstraction id, symbolic value). *) -let lookup_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) +let lookup_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) (sv : symbolic_value) (ctx : eval_ctx) : (msymbolic_value * aproj) list = (* Small helpers for sanity checks *) let found = ref None in let set_found x = (* There is at most one projector which corresponds to the description *) - sanity_check __FILE__ __LINE__ (Option.is_none !found) meta; + sanity_check __FILE__ __LINE__ (Option.is_none !found) span; found := Some x in (* The visitor *) @@ -1021,9 +1021,9 @@ let lookup_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) super#visit_aproj abs sproj | AProjLoans (sv', given_back) -> let abs = Option.get abs in - sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) meta; + sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; if sv'.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (sv' = sv) meta; + sanity_check __FILE__ __LINE__ (sv' = sv) span; set_found given_back) else ()); super#visit_aproj abs sproj @@ -1042,13 +1042,13 @@ let lookup_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) Sanity check: we check that there is exactly one projector which corresponds to the couple (abstraction id, symbolic value). *) -let update_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) +let update_aproj_loans (span : Meta.span) (abs_id : AbstractionId.id) (sv : symbolic_value) (nproj : aproj) (ctx : eval_ctx) : eval_ctx = (* Small helpers for sanity checks *) let found = ref false in let update () = (* We update at most once *) - sanity_check __FILE__ __LINE__ (not !found) meta; + sanity_check __FILE__ __LINE__ (not !found) span; found := true; nproj in @@ -1067,9 +1067,9 @@ let update_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) super#visit_aproj abs sproj | AProjLoans (sv', _) -> let abs = Option.get abs in - sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) meta; + sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; if sv'.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (sv' = sv) meta; + sanity_check __FILE__ __LINE__ (sv' = sv) span; update ()) else super#visit_aproj (Some abs) sproj end @@ -1077,7 +1077,7 @@ let update_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Sanity check *) - sanity_check __FILE__ __LINE__ !found meta; + sanity_check __FILE__ __LINE__ !found span; (* Return *) ctx @@ -1091,13 +1091,13 @@ let update_aproj_loans (meta : Meta.meta) (abs_id : AbstractionId.id) TODO: factorize with {!update_aproj_loans}? *) -let update_aproj_borrows (meta : Meta.meta) (abs_id : AbstractionId.id) +let update_aproj_borrows (span : Meta.span) (abs_id : AbstractionId.id) (sv : symbolic_value) (nproj : aproj) (ctx : eval_ctx) : eval_ctx = (* Small helpers for sanity checks *) let found = ref false in let update () = (* We update at most once *) - sanity_check __FILE__ __LINE__ (not !found) meta; + sanity_check __FILE__ __LINE__ (not !found) span; found := true; nproj in @@ -1116,9 +1116,9 @@ let update_aproj_borrows (meta : Meta.meta) (abs_id : AbstractionId.id) super#visit_aproj abs sproj | AProjBorrows (sv', _proj_ty) -> let abs = Option.get abs in - sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) meta; + sanity_check __FILE__ __LINE__ (abs.abs_id = abs_id) span; if sv'.sv_id = sv.sv_id then ( - sanity_check __FILE__ __LINE__ (sv' = sv) meta; + sanity_check __FILE__ __LINE__ (sv' = sv) span; update ()) else super#visit_aproj (Some abs) sproj end @@ -1126,7 +1126,7 @@ let update_aproj_borrows (meta : Meta.meta) (abs_id : AbstractionId.id) (* Apply *) let ctx = obj#visit_eval_ctx None ctx in (* Sanity check *) - sanity_check __FILE__ __LINE__ !found meta; + sanity_check __FILE__ __LINE__ !found span; (* Return *) ctx @@ -1135,18 +1135,18 @@ let update_aproj_borrows (meta : Meta.meta) (abs_id : AbstractionId.id) Converts an {!Values.aproj.AProjLoans} to an {!Values.aproj.AEndedProjLoans}. The projector is identified by a symbolic value and an abstraction id. *) -let update_aproj_loans_to_ended (meta : Meta.meta) (abs_id : AbstractionId.id) +let update_aproj_loans_to_ended (span : Meta.span) (abs_id : AbstractionId.id) (sv : symbolic_value) (ctx : eval_ctx) : eval_ctx = (* Lookup the projector of loans *) - let given_back = lookup_aproj_loans meta abs_id sv ctx in + let given_back = lookup_aproj_loans span abs_id sv ctx in (* Create the new value for the projector *) let nproj = AEndedProjLoans (sv, given_back) in (* Insert it *) - let ctx = update_aproj_loans meta abs_id sv nproj ctx in + let ctx = update_aproj_loans span abs_id sv nproj ctx in (* Return *) ctx -let no_aproj_over_symbolic_in_context (meta : Meta.meta) (sv : symbolic_value) +let no_aproj_over_symbolic_in_context (span : Meta.span) (sv : symbolic_value) (ctx : eval_ctx) : unit = (* The visitor *) let obj = @@ -1164,7 +1164,7 @@ let no_aproj_over_symbolic_in_context (meta : Meta.meta) (sv : symbolic_value) (* Apply *) try obj#visit_eval_ctx () ctx with Found -> - craise __FILE__ __LINE__ meta "update_aproj_loans_to_ended: failed" + craise __FILE__ __LINE__ span "update_aproj_loans_to_ended: failed" (** Helper function @@ -1173,7 +1173,7 @@ let no_aproj_over_symbolic_in_context (meta : Meta.meta) (sv : symbolic_value) **Remark:** we don't take the *ignored* mut/shared loans into account. *) -let get_first_non_ignored_aloan_in_abstraction (meta : Meta.meta) (abs : abs) : +let get_first_non_ignored_aloan_in_abstraction (span : Meta.span) (abs : abs) : borrow_ids_or_symbolic_value option = (* Explore to find a loan *) let obj = @@ -1184,14 +1184,14 @@ let get_first_non_ignored_aloan_in_abstraction (meta : Meta.meta) (abs : abs) : match lc with | AMutLoan (bid, _) -> raise (FoundBorrowIds (Borrow bid)) | ASharedLoan (bids, _, _) -> raise (FoundBorrowIds (Borrows bids)) - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } | AEndedSharedLoan (_, _) -> super#visit_aloan_content env lc | AIgnoredMutLoan (_, _) -> (* Ignore *) super#visit_aloan_content env lc | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AIgnoredSharedLoan _ -> (* Ignore *) super#visit_aloan_content env lc @@ -1202,7 +1202,7 @@ let get_first_non_ignored_aloan_in_abstraction (meta : Meta.meta) (abs : abs) : | VMutLoan _ -> (* The mut loan linked to the mutable borrow present in a shared * value in an abstraction should be in an AProjBorrows *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | VSharedLoan (bids, _) -> raise (FoundBorrowIds (Borrows bids)) method! visit_aproj env sproj = @@ -1226,9 +1226,9 @@ let get_first_non_ignored_aloan_in_abstraction (meta : Meta.meta) (abs : abs) : (* There are loan projections over symbolic values *) Some (SymbolicValue sv) -let lookup_shared_value_opt (meta : Meta.meta) (ctx : eval_ctx) +let lookup_shared_value_opt (span : Meta.span) (ctx : eval_ctx) (bid : BorrowId.id) : typed_value option = - match lookup_loan_opt meta ek_all bid ctx with + match lookup_loan_opt span ek_all bid ctx with | None -> None | Some (_, lc) -> ( match lc with @@ -1236,6 +1236,6 @@ let lookup_shared_value_opt (meta : Meta.meta) (ctx : eval_ctx) Some sv | _ -> None) -let lookup_shared_value (meta : Meta.meta) (ctx : eval_ctx) (bid : BorrowId.id) +let lookup_shared_value (span : Meta.span) (ctx : eval_ctx) (bid : BorrowId.id) : typed_value = - Option.get (lookup_shared_value_opt meta ctx bid) + Option.get (lookup_shared_value_opt span ctx bid) diff --git a/compiler/InterpreterExpansion.ml b/compiler/InterpreterExpansion.ml index e47fbfbe..388d7382 100644 --- a/compiler/InterpreterExpansion.ml +++ b/compiler/InterpreterExpansion.ml @@ -49,14 +49,14 @@ type proj_kind = LoanProj | BorrowProj it would make things clearer. *) let apply_symbolic_expansion_to_target_avalues (config : config) - (meta : Meta.meta) (allow_reborrows : bool) (proj_kind : proj_kind) + (span : Meta.span) (allow_reborrows : bool) (proj_kind : proj_kind) (original_sv : symbolic_value) (expansion : symbolic_expansion) (ctx : eval_ctx) : eval_ctx = (* Symbolic values contained in the expansion might contain already ended regions *) let check_symbolic_no_ended = false in (* Prepare reborrows registration *) let fresh_reborrow, apply_registered_reborrows = - prepare_reborrows config meta allow_reborrows + prepare_reborrows config span allow_reborrows in (* Visitor to apply the expansion *) let obj = @@ -66,7 +66,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (** When visiting an abstraction, we remember the regions it owns to be able to properly reduce projectors when expanding symbolic values *) method! visit_abs current_abs abs = - sanity_check __FILE__ __LINE__ (Option.is_none current_abs) meta; + sanity_check __FILE__ __LINE__ (Option.is_none current_abs) span; let current_abs = Some abs in super#visit_abs current_abs abs @@ -80,7 +80,7 @@ let apply_symbolic_expansion_to_target_avalues (config : config) | AProjLoans (sv, _) | AProjBorrows (sv, _) -> sanity_check __FILE__ __LINE__ (not (same_symbolic_id sv original_sv)) - meta + span | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); super#visit_aproj current_abs aproj @@ -100,10 +100,10 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (* Check if this is the symbolic value we are looking for *) if same_symbolic_id sv original_sv then ( (* There mustn't be any given back values *) - sanity_check __FILE__ __LINE__ (given_back = []) meta; + sanity_check __FILE__ __LINE__ (given_back = []) span; (* Apply the projector *) let projected_value = - apply_proj_loans_on_symbolic_expansion meta proj_regions + apply_proj_loans_on_symbolic_expansion span proj_regions ancestors_regions expansion original_sv.sv_ty in (* Replace *) @@ -120,12 +120,12 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (* WARNING: we mustn't get there if the expansion is for a shared * reference. *) let expansion = - symbolic_expansion_non_shared_borrow_to_value meta original_sv + symbolic_expansion_non_shared_borrow_to_value span original_sv expansion in (* Apply the projector *) let projected_value = - apply_proj_borrows meta check_symbolic_no_ended ctx + apply_proj_borrows span check_symbolic_no_ended ctx fresh_reborrow proj_regions ancestors_regions expansion proj_ty in @@ -149,11 +149,11 @@ let apply_symbolic_expansion_to_target_avalues (config : config) (** Auxiliary function. Apply a symbolic expansion to avalues in a context. *) -let apply_symbolic_expansion_to_avalues (config : config) (meta : Meta.meta) +let apply_symbolic_expansion_to_avalues (config : config) (span : Meta.span) (allow_reborrows : bool) (original_sv : symbolic_value) (expansion : symbolic_expansion) (ctx : eval_ctx) : eval_ctx = let apply_expansion proj_kind ctx = - apply_symbolic_expansion_to_target_avalues config meta allow_reborrows + apply_symbolic_expansion_to_target_avalues config span allow_reborrows proj_kind original_sv expansion ctx in (* First target the loan projectors, then the borrow projectors *) @@ -166,12 +166,12 @@ let apply_symbolic_expansion_to_avalues (config : config) (meta : Meta.meta) Simply replace the symbolic values (*not avalues*) in the context with a given value. Will break invariants if not used properly. *) -let replace_symbolic_values (meta : Meta.meta) (at_most_once : bool) +let replace_symbolic_values (span : Meta.span) (at_most_once : bool) (original_sv : symbolic_value) (nv : value) (ctx : eval_ctx) : eval_ctx = (* Count *) let replaced = ref false in let replace () = - if at_most_once then sanity_check __FILE__ __LINE__ (not !replaced) meta; + if at_most_once then sanity_check __FILE__ __LINE__ (not !replaced) span; replaced := true; nv in @@ -190,18 +190,18 @@ let replace_symbolic_values (meta : Meta.meta) (at_most_once : bool) (* Return *) ctx -let apply_symbolic_expansion_non_borrow (config : config) (meta : Meta.meta) - (original_sv : symbolic_value) (expansion : symbolic_expansion) - (ctx : eval_ctx) : eval_ctx = +let apply_symbolic_expansion_non_borrow (config : config) (span : Meta.span) + (original_sv : symbolic_value) (ctx : eval_ctx) + (expansion : symbolic_expansion) : eval_ctx = (* Apply the expansion to non-abstraction values *) - let nv = symbolic_expansion_non_borrow_to_value meta original_sv expansion in + let nv = symbolic_expansion_non_borrow_to_value span original_sv expansion in let at_most_once = false in let ctx = - replace_symbolic_values meta at_most_once original_sv nv.value ctx + replace_symbolic_values span at_most_once original_sv nv.value ctx in (* Apply the expansion to abstraction values *) let allow_reborrows = false in - apply_symbolic_expansion_to_avalues config meta allow_reborrows original_sv + apply_symbolic_expansion_to_avalues config span allow_reborrows original_sv expansion ctx (** Compute the expansion of a non-assumed (i.e.: not [Box], etc.) @@ -214,7 +214,7 @@ let apply_symbolic_expansion_non_borrow (config : config) (meta : Meta.meta) [expand_enumerations] controls the expansion of enumerations: if false, it doesn't allow the expansion of enumerations *containing several variants*. *) -let compute_expanded_symbolic_non_assumed_adt_value (meta : Meta.meta) +let compute_expanded_symbolic_non_assumed_adt_value (span : Meta.span) (expand_enumerations : bool) (def_id : TypeDeclId.id) (generics : generic_args) (ctx : eval_ctx) : symbolic_expansion list = (* Lookup the definition and check if it is an enumeration with several @@ -222,21 +222,21 @@ let compute_expanded_symbolic_non_assumed_adt_value (meta : Meta.meta) let def = ctx_lookup_type_decl ctx def_id in sanity_check __FILE__ __LINE__ (List.length generics.regions = List.length def.generics.regions) - meta; + span; (* Retrieve, for every variant, the list of its instantiated field types *) let variants_fields_types = - AssociatedTypes.type_decl_get_inst_norm_variants_fields_rtypes meta ctx def + AssociatedTypes.type_decl_get_inst_norm_variants_fields_rtypes span ctx def generics in (* Check if there is strictly more than one variant *) if List.length variants_fields_types > 1 && not expand_enumerations then - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Not allowed to expand enumerations with several variants"; (* Initialize the expanded value for a given variant *) let initialize ((variant_id, field_types) : VariantId.id option * rty list) : symbolic_expansion = let field_values = - List.map (fun (ty : rty) -> mk_fresh_symbolic_value meta ty) field_types + List.map (fun (ty : rty) -> mk_fresh_symbolic_value span ty) field_types in let see = SeAdt (variant_id, field_values) in see @@ -244,20 +244,20 @@ let compute_expanded_symbolic_non_assumed_adt_value (meta : Meta.meta) (* Initialize all the expanded values of all the variants *) List.map initialize variants_fields_types -let compute_expanded_symbolic_tuple_value (meta : Meta.meta) +let compute_expanded_symbolic_tuple_value (span : Meta.span) (field_types : rty list) : symbolic_expansion = (* Generate the field values *) let field_values = - List.map (fun sv_ty -> mk_fresh_symbolic_value meta sv_ty) field_types + List.map (fun sv_ty -> mk_fresh_symbolic_value span sv_ty) field_types in let variant_id = None in let see = SeAdt (variant_id, field_values) in see -let compute_expanded_symbolic_box_value (meta : Meta.meta) (boxed_ty : rty) : +let compute_expanded_symbolic_box_value (span : Meta.span) (boxed_ty : rty) : symbolic_expansion = (* Introduce a fresh symbolic value *) - let boxed_value = mk_fresh_symbolic_value meta boxed_ty in + let boxed_value = mk_fresh_symbolic_value span boxed_ty in let see = SeAdt (None, [ boxed_value ]) in see @@ -270,25 +270,25 @@ let compute_expanded_symbolic_box_value (meta : Meta.meta) (boxed_ty : rty) : [expand_enumerations] controls the expansion of enumerations: if [false], it doesn't allow the expansion of enumerations *containing several variants*. *) -let compute_expanded_symbolic_adt_value (meta : Meta.meta) +let compute_expanded_symbolic_adt_value (span : Meta.span) (expand_enumerations : bool) (adt_id : type_id) (generics : generic_args) (ctx : eval_ctx) : symbolic_expansion list = match (adt_id, generics.regions, generics.types) with | TAdtId def_id, _, _ -> - compute_expanded_symbolic_non_assumed_adt_value meta expand_enumerations + compute_expanded_symbolic_non_assumed_adt_value span expand_enumerations def_id generics ctx | TTuple, [], _ -> - [ compute_expanded_symbolic_tuple_value meta generics.types ] + [ compute_expanded_symbolic_tuple_value span generics.types ] | TAssumed TBox, [], [ boxed_ty ] -> - [ compute_expanded_symbolic_box_value meta boxed_ty ] + [ compute_expanded_symbolic_box_value span boxed_ty ] | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "compute_expanded_symbolic_adt_value: unexpected combination" -let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) +let expand_symbolic_value_shared_borrow (config : config) (span : Meta.span) (original_sv : symbolic_value) (original_sv_place : SA.mplace option) (ref_ty : rty) : cm_fun = - fun cf ctx -> + fun ctx -> (* First, replace the projectors on borrows. * The important point is that the symbolic value to expand may appear * several times, if it has been copied. In this case, we need to introduce @@ -318,11 +318,11 @@ let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) Some [ AsbBorrow bid; shared_asb ] else (* Not in the set: ignore *) Some [ shared_asb ] - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" else None in (* The fresh symbolic value for the shared value *) - let shared_sv = mk_fresh_symbolic_value meta ref_ty in + let shared_sv = mk_fresh_symbolic_value span ref_ty in (* Visitor to replace the projectors on borrows *) let obj = object (self) @@ -335,7 +335,7 @@ let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) else super#visit_VSymbolic env sv method! visit_EAbs proj_regions abs = - sanity_check __FILE__ __LINE__ (Option.is_none proj_regions) meta; + sanity_check __FILE__ __LINE__ (Option.is_none proj_regions) span; let proj_regions = Some abs.regions in super#visit_EAbs proj_regions abs @@ -362,7 +362,7 @@ let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) | AProjLoans (sv, _) | AProjBorrows (sv, _) -> sanity_check __FILE__ __LINE__ (not (same_symbolic_id sv original_sv)) - meta + span | AEndedProjLoans _ | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()); super#visit_aproj proj_regions aproj @@ -388,146 +388,93 @@ let expand_symbolic_value_shared_borrow (config : config) (meta : Meta.meta) let ctx = obj#visit_eval_ctx None ctx in (* Finally, replace the projectors on loans *) let bids = !borrows in - sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.is_empty bids)) span; let see = SeSharedRef (bids, shared_sv) in let allow_reborrows = true in let ctx = - apply_symbolic_expansion_to_avalues config meta allow_reborrows original_sv + apply_symbolic_expansion_to_avalues config span allow_reborrows original_sv see ctx in - (* Call the continuation *) - let expr = cf ctx in - (* Update the synthesized program *) - S.synthesize_symbolic_expansion_no_branching meta original_sv - original_sv_place see expr + ( ctx, + (* Update the synthesized program *) + S.synthesize_symbolic_expansion_no_branching span original_sv + original_sv_place see ) (** TODO: simplify and merge with the other expansion function *) -let expand_symbolic_value_borrow (config : config) (meta : Meta.meta) +let expand_symbolic_value_borrow (config : config) (span : Meta.span) (original_sv : symbolic_value) (original_sv_place : SA.mplace option) (region : region) (ref_ty : rty) (rkind : ref_kind) : cm_fun = - fun cf ctx -> - sanity_check __FILE__ __LINE__ (region <> RErased) meta; + fun ctx -> + sanity_check __FILE__ __LINE__ (region <> RErased) span; (* Check that we are allowed to expand the reference *) sanity_check __FILE__ __LINE__ (not (region_in_set region ctx.ended_regions)) - meta; + span; (* Match on the reference kind *) match rkind with | RMut -> (* Simple case: simply create a fresh symbolic value and a fresh * borrow id *) - let sv = mk_fresh_symbolic_value meta ref_ty in + let sv = mk_fresh_symbolic_value span ref_ty in let bid = fresh_borrow_id () in let see = SeMutRef (bid, sv) in (* Expand the symbolic values - we simply perform a substitution (and * check that we perform exactly one substitution) *) let nv = - symbolic_expansion_non_shared_borrow_to_value meta original_sv see + symbolic_expansion_non_shared_borrow_to_value span original_sv see in let at_most_once = true in let ctx = - replace_symbolic_values meta at_most_once original_sv nv.value ctx + replace_symbolic_values span at_most_once original_sv nv.value ctx in (* Expand the symbolic avalues *) let allow_reborrows = true in let ctx = - apply_symbolic_expansion_to_avalues config meta allow_reborrows + apply_symbolic_expansion_to_avalues config span allow_reborrows original_sv see ctx in (* Apply the continuation *) - let expr = cf ctx in - (* Update the synthesized program *) - S.synthesize_symbolic_expansion_no_branching meta original_sv - original_sv_place see expr + ( ctx, + fun e -> + (* Update the synthesized program *) + S.synthesize_symbolic_expansion_no_branching span original_sv + original_sv_place see e ) | RShared -> - expand_symbolic_value_shared_borrow config meta original_sv - original_sv_place ref_ty cf ctx - -(** A small helper. - - Apply a branching symbolic expansion to a context and execute all the - branches. Note that the expansion is optional for every branch (this is - used for integer expansion: see {!expand_symbolic_int}). - - [see_cf_l]: list of pairs (optional symbolic expansion, continuation). - We use [None] for the symbolic expansion for the [_] (default) case of the - integer expansions. - The continuation are used to execute the content of the branches, but not - what comes after. - - [cf_after_join]: this continuation is called *after* the branches have been evaluated. - We need this continuation separately (i.e., we can't compose it with the - continuations in [see_cf_l]) because we perform a join *before* calling it. -*) -let apply_branching_symbolic_expansions_non_borrow (config : config) - (meta : Meta.meta) (sv : symbolic_value) (sv_place : SA.mplace option) - (see_cf_l : (symbolic_expansion option * st_cm_fun) list) - (cf_after_join : st_m_fun) : m_fun = - fun ctx -> - sanity_check __FILE__ __LINE__ (see_cf_l <> []) meta; - (* Apply the symbolic expansion in the context and call the continuation *) - let resl = - List.map - (fun (see_opt, cf_br) -> - (* Remember the initial context for printing purposes *) - let ctx0 = ctx in - (* Expansion *) - let ctx = - match see_opt with - | None -> ctx - | Some see -> - apply_symbolic_expansion_non_borrow config meta sv see ctx - in - (* Debug *) - log#ldebug - (lazy - ("apply_branching_symbolic_expansions_non_borrow: " - ^ symbolic_value_to_string ctx0 sv - ^ "\n\n- original context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx0 - ^ "\n\n- new context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx - ^ "\n")); - (* Continuation *) - cf_br cf_after_join ctx) - see_cf_l - in - (* Collect the result: either we computed no subterm, or we computed all - * of them *) - let subterms = - match resl with - | Some _ :: _ -> Some (List.map Option.get resl) - | None :: _ -> - List.iter - (fun res -> sanity_check __FILE__ __LINE__ (res = None) meta) - resl; - None - | _ -> craise __FILE__ __LINE__ meta "Unreachable" - in - (* Synthesize and return *) - let seel = List.map fst see_cf_l in - S.synthesize_symbolic_expansion meta sv sv_place seel subterms - -let expand_symbolic_bool (config : config) (meta : Meta.meta) - (sv : symbolic_value) (sv_place : SA.mplace option) (cf_true : st_cm_fun) - (cf_false : st_cm_fun) (cf_after_join : st_m_fun) : m_fun = + expand_symbolic_value_shared_borrow config span original_sv + original_sv_place ref_ty ctx + +let expand_symbolic_bool (config : config) (span : Meta.span) + (sv : symbolic_value) (sv_place : SA.mplace option) : + eval_ctx -> + (eval_ctx * eval_ctx) + * ((SymbolicAst.expression * SymbolicAst.expression) option -> eval_result) + = fun ctx -> (* Compute the expanded value *) let original_sv = sv in - let original_sv_place = sv_place in let rty = original_sv.sv_ty in - sanity_check __FILE__ __LINE__ (rty = TLiteral TBool) meta; + sanity_check __FILE__ __LINE__ (rty = TLiteral TBool) span; (* Expand the symbolic value to true or false and continue execution *) let see_true = SeLiteral (VBool true) in let see_false = SeLiteral (VBool false) in - let seel = [ (Some see_true, cf_true); (Some see_false, cf_false) ] in - (* Apply the symbolic expansion (this also outputs the updated symbolic AST) *) - apply_branching_symbolic_expansions_non_borrow config meta original_sv - original_sv_place seel cf_after_join ctx + let seel = [ Some see_true; Some see_false ] in + (* Apply the symbolic expansion *) + let apply_expansion = + apply_symbolic_expansion_non_borrow config span sv ctx + in + let ctx_true = apply_expansion see_true in + let ctx_false = apply_expansion see_false in + (* Compute the continuation to build the expression *) + let cf e = + let el = match e with Some (a, b) -> Some [ a; b ] | None -> None in + S.synthesize_symbolic_expansion span sv sv_place seel el + in + (* Return *) + ((ctx_true, ctx_false), cf) -let expand_symbolic_value_no_branching (config : config) (meta : Meta.meta) +let expand_symbolic_value_no_branching (config : config) (span : Meta.span) (sv : symbolic_value) (sv_place : SA.mplace option) : cm_fun = - fun cf ctx -> + fun ctx -> (* Debug *) log#ldebug (lazy @@ -539,60 +486,57 @@ let expand_symbolic_value_no_branching (config : config) (meta : Meta.meta) let original_sv = sv in let original_sv_place = sv_place in let rty = original_sv.sv_ty in - let cc : cm_fun = - fun cf ctx -> + let ctx, cc = match rty with (* ADTs *) | TAdt (adt_id, generics) -> (* Compute the expanded value *) let allow_branching = false in let seel = - compute_expanded_symbolic_adt_value meta allow_branching adt_id + compute_expanded_symbolic_adt_value span allow_branching adt_id generics ctx in (* There should be exacly one branch *) let see = Collections.List.to_cons_nil seel in (* Apply in the context *) let ctx = - apply_symbolic_expansion_non_borrow config meta original_sv see ctx + apply_symbolic_expansion_non_borrow config span original_sv ctx see in - (* Call the continuation *) - let expr = cf ctx in - (* Update the synthesized program *) - S.synthesize_symbolic_expansion_no_branching meta original_sv - original_sv_place see expr + (* Return*) + ( ctx, + (* Update the synthesized program *) + S.synthesize_symbolic_expansion_no_branching span original_sv + original_sv_place see ) (* Borrows *) | TRef (region, ref_ty, rkind) -> - expand_symbolic_value_borrow config meta original_sv original_sv_place - region ref_ty rkind cf ctx + expand_symbolic_value_borrow config span original_sv original_sv_place + region ref_ty rkind ctx | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("expand_symbolic_value_no_branching: unexpected type: " ^ show_rty rty) in (* Debug *) - let cc = - comp_unit cc (fun ctx -> - log#ldebug - (lazy - ("expand_symbolic_value_no_branching: " - ^ symbolic_value_to_string ctx0 sv - ^ "\n\n- original context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx0 - ^ "\n\n- new context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx - ^ "\n")); - (* Sanity check: the symbolic value has disappeared *) - sanity_check __FILE__ __LINE__ - (not (symbolic_value_id_in_ctx original_sv.sv_id ctx)) - meta) - in - (* Continue *) - cc cf ctx + log#ldebug + (lazy + ("expand_symbolic_value_no_branching: " + ^ symbolic_value_to_string ctx0 sv + ^ "\n\n- original context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx0 + ^ "\n\n- new context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx + ^ "\n")); + (* Sanity check: the symbolic value has disappeared *) + sanity_check __FILE__ __LINE__ + (not (symbolic_value_id_in_ctx original_sv.sv_id ctx)) + span; + (* Return *) + (ctx, cc) -let expand_symbolic_adt (config : config) (meta : Meta.meta) - (sv : symbolic_value) (sv_place : SA.mplace option) - (cf_branches : st_cm_fun) (cf_after_join : st_m_fun) : m_fun = +let expand_symbolic_adt (config : config) (span : Meta.span) + (sv : symbolic_value) (sv_place : SA.mplace option) : + eval_ctx -> + eval_ctx list * (SymbolicAst.expression list option -> eval_result) = fun ctx -> (* Debug *) log#ldebug (lazy ("expand_symbolic_adt:" ^ symbolic_value_to_string ctx sv)); @@ -608,39 +552,52 @@ let expand_symbolic_adt (config : config) (meta : Meta.meta) let allow_branching = true in (* Compute the expanded value *) let seel = - compute_expanded_symbolic_adt_value meta allow_branching adt_id generics + compute_expanded_symbolic_adt_value span allow_branching adt_id generics ctx in (* Apply *) - let seel = List.map (fun see -> (Some see, cf_branches)) seel in - apply_branching_symbolic_expansions_non_borrow config meta original_sv - original_sv_place seel cf_after_join ctx + let ctx_branches = + List.map (apply_symbolic_expansion_non_borrow config span sv ctx) seel + in + ( ctx_branches, + S.synthesize_symbolic_expansion span sv original_sv_place + (List.map (fun el -> Some el) seel) ) | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("expand_symbolic_adt: unexpected type: " ^ show_rty rty) -let expand_symbolic_int (config : config) (meta : Meta.meta) +let expand_symbolic_int (config : config) (span : Meta.span) (sv : symbolic_value) (sv_place : SA.mplace option) - (int_type : integer_type) (tgts : (scalar_value * st_cm_fun) list) - (otherwise : st_cm_fun) (cf_after_join : st_m_fun) : m_fun = + (int_type : integer_type) (tgts : scalar_value list) : + eval_ctx -> + (eval_ctx list * eval_ctx) + * ((SymbolicAst.expression list * SymbolicAst.expression) option -> + eval_result) = + fun ctx -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (sv.sv_ty = TLiteral (TInteger int_type)) meta; + sanity_check __FILE__ __LINE__ (sv.sv_ty = TLiteral (TInteger int_type)) span; (* For all the branches of the switch, we expand the symbolic value * to the value given by the branch and execute the branch statement. * For the otherwise branch, we leave the symbolic value as it is * (because this branch doesn't precisely define which should be the * value of the scrutinee...) and simply execute the otherwise statement. - * - * First, generate the list of pairs: - * (optional expansion, statement to execute) *) - let seel = - List.map (fun (v, cf) -> (Some (SeLiteral (VScalar v)), cf)) tgts + (* Substitute the symbolic values to generate the contexts in the branches *) + let seel = List.map (fun v -> SeLiteral (VScalar v)) tgts in + let ctx_branches = + List.map (apply_symbolic_expansion_non_borrow config span sv ctx) seel in - let seel = List.append seel [ (None, otherwise) ] in - (* Then expand and evaluate - this generates the proper symbolic AST *) - apply_branching_symbolic_expansions_non_borrow config meta sv sv_place seel - cf_after_join + let ctx_otherwise = ctx in + (* Update the symbolic ast *) + let cf e = + match e with + | None -> None + | Some (el, e) -> + let seel = List.map (fun x -> Some x) seel in + S.synthesize_symbolic_expansion span sv sv_place (seel @ [ None ]) + (Some (el @ [ e ])) + in + ((ctx_branches, ctx_otherwise), cf) (** Expand all the symbolic values which contain borrows. Allows us to restrict ourselves to a simpler model for the projectors over @@ -650,9 +607,9 @@ let expand_symbolic_int (config : config) (meta : Meta.meta) an enumeration with strictly more than one variant, a slice, etc.) or if we need to expand a recursive type (because this leads to looping). *) -let greedy_expand_symbolics_with_borrows (config : config) (meta : Meta.meta) : +let greedy_expand_symbolics_with_borrows (config : config) (span : Meta.span) : cm_fun = - fun cf ctx -> + fun ctx -> (* The visitor object, to look for symbolic values in the concrete environment *) let obj = object @@ -669,20 +626,20 @@ let greedy_expand_symbolics_with_borrows (config : config) (meta : Meta.meta) : in let rec expand : cm_fun = - fun cf ctx -> + fun ctx -> try (* We reverse the environment before exploring it - this way the values get expanded in a more "logical" order (this is only for convenience) *) obj#visit_env () (List.rev ctx.env); (* Nothing to expand: continue *) - cf ctx + (ctx, fun e -> e) with FoundSymbolicValue sv -> (* Expand and recheck the environment *) log#ldebug (lazy ("greedy_expand_symbolics_with_borrows: about to expand: " ^ symbolic_value_to_string ctx sv)); - let cc : cm_fun = + let ctx, cc = match sv.sv_ty with | TAdt (TAdtId def_id, _) -> (* {!expand_symbolic_value_no_branching} checks if there are branchings, @@ -692,41 +649,41 @@ let greedy_expand_symbolics_with_borrows (config : config) (meta : Meta.meta) : (match def.kind with | Struct _ | Enum ([] | [ _ ]) -> () | Enum (_ :: _) -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Attempted to greedily expand a symbolic enumeration with > \ 1 variants (option [greedy_expand_symbolics_with_borrows] \ of [config]): " ^ name_to_string ctx def.name) | Opaque -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Attempted to greedily expand an opaque type"); (* Also, we need to check if the definition is recursive *) if ctx_type_decl_is_rec ctx def_id then - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Attempted to greedily expand a recursive definition (option \ [greedy_expand_symbolics_with_borrows] of [config]): " ^ name_to_string ctx def.name) - else expand_symbolic_value_no_branching config meta sv None + else expand_symbolic_value_no_branching config span sv None ctx | TAdt ((TTuple | TAssumed TBox), _) | TRef (_, _, _) -> (* Ok *) - expand_symbolic_value_no_branching config meta sv None + expand_symbolic_value_no_branching config span sv None ctx | TAdt (TAssumed (TArray | TSlice | TStr), _) -> (* We can't expand those *) - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Attempted to greedily expand an ADT which can't be expanded " | TVar _ | TLiteral _ | TNever | TTraitType _ | TArrow _ | TRawPtr _ -> - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in (* Compose and continue *) - comp cc expand cf ctx + comp cc (expand ctx) in (* Apply *) - expand cf ctx + expand ctx -let greedy_expand_symbolic_values (config : config) (meta : Meta.meta) : cm_fun +let greedy_expand_symbolic_values (config : config) (span : Meta.span) : cm_fun = - fun cf ctx -> + fun ctx -> if Config.greedy_expand_symbolics_with_borrows then ( log#ldebug (lazy "greedy_expand_symbolic_values"); - greedy_expand_symbolics_with_borrows config meta cf ctx) - else cf ctx + greedy_expand_symbolics_with_borrows config span ctx) + else (ctx, fun e -> e) diff --git a/compiler/InterpreterExpansion.mli b/compiler/InterpreterExpansion.mli index 2ea27ea6..7f8c3a0a 100644 --- a/compiler/InterpreterExpansion.mli +++ b/compiler/InterpreterExpansion.mli @@ -13,53 +13,45 @@ type proj_kind = LoanProj | BorrowProj *) val apply_symbolic_expansion_non_borrow : config -> - Meta.meta -> + Meta.span -> symbolic_value -> - symbolic_expansion -> eval_ctx -> + symbolic_expansion -> eval_ctx (** Expand a symhbolic value, without branching *) val expand_symbolic_value_no_branching : - config -> Meta.meta -> symbolic_value -> SA.mplace option -> cm_fun + config -> Meta.span -> symbolic_value -> SA.mplace option -> cm_fun (** Expand a symbolic enumeration (leads to branching if the enumeration has more than one variant). Parameters: - [config] + - [span] - [sv] - [sv_place] - - [cf_branches]: the continuation to evaluate the branches. This continuation - typically evaluates a [match] statement *after* we have performed the symbolic - expansion (in particular, we can have one continuation for all the branches). - - [cf_after_join]: the continuation for *after* the match (we perform a join - then call it). *) val expand_symbolic_adt : config -> - Meta.meta -> + Meta.span -> symbolic_value -> SA.mplace option -> - st_cm_fun -> - st_m_fun -> - m_fun + eval_ctx -> + eval_ctx list * (SymbolicAst.expression list option -> eval_result) (** Expand a symbolic boolean. Parameters: see {!expand_symbolic_adt}. - The two parameters of type [st_cm_fun] correspond to the [cf_branches] - parameter (here, there are exactly two branches). *) val expand_symbolic_bool : config -> - Meta.meta -> + Meta.span -> symbolic_value -> SA.mplace option -> - st_cm_fun -> - st_cm_fun -> - st_m_fun -> - m_fun + eval_ctx -> + (eval_ctx * eval_ctx) + * ((SymbolicAst.expression * SymbolicAst.expression) option -> eval_result) (** Symbolic integers are expanded upon evaluating a [SwitchInt]. @@ -69,29 +61,25 @@ val expand_symbolic_bool : then retry evaluating the [if ... then ... else ...] or the [match]: as the scrutinee will then have a concrete value, the interpreter will switch to the proper branch. - - However, when expanding a "regular" integer for a switch, there is always an - *otherwise* branch that we can take, for which the integer must remain symbolic - (because in this branch the scrutinee can take a range of values). We thus - can't simply expand then retry to evaluate the [switch], because then we - would loop... - - For this reason, we take the list of branches to execute as parameters, and - directly jump to those branches after the expansion, without reevaluating the - switch. The continuation is thus for the execution *after* the switch. + + When expanding a "regular" integer for a switch there is always an *otherwise* + branch. We treat it separately: for this reason we return a pair of a list + of evaluation contexts (for the branches which are not the otherwise branch) + and an additional evaluation context for the otherwise branch. *) val expand_symbolic_int : config -> - Meta.meta -> + Meta.span -> symbolic_value -> SA.mplace option -> integer_type -> - (scalar_value * st_cm_fun) list -> - st_cm_fun -> - st_m_fun -> - m_fun + scalar_value list -> + eval_ctx -> + (eval_ctx list * eval_ctx) + * ((SymbolicAst.expression list * SymbolicAst.expression) option -> + eval_result) (** If this mode is activated through the [config], greedily expand the symbolic values which need to be expanded. See {!type:Contexts.config} for more information. *) -val greedy_expand_symbolic_values : config -> Meta.meta -> cm_fun +val greedy_expand_symbolic_values : config -> Meta.span -> cm_fun diff --git a/compiler/InterpreterExpressions.ml b/compiler/InterpreterExpressions.ml index 5a4fe7da..2223897c 100644 --- a/compiler/InterpreterExpressions.ml +++ b/compiler/InterpreterExpressions.ml @@ -24,76 +24,77 @@ let log = Logging.expressions_log Note that the place should have been prepared so that there are no remaining loans. *) -let expand_primitively_copyable_at_place (config : config) (meta : Meta.meta) +let expand_primitively_copyable_at_place (config : config) (span : Meta.span) (access : access_kind) (p : place) : cm_fun = - fun cf ctx -> + fun ctx -> (* Small helper *) let rec expand : cm_fun = - fun cf ctx -> - let v = read_place meta access p ctx in + fun ctx -> + let v = read_place span access p ctx in match find_first_primitively_copyable_sv_with_borrows ctx.type_ctx.type_infos v with - | None -> cf ctx + | None -> (ctx, fun e -> e) | Some sv -> - let cc = - expand_symbolic_value_no_branching config meta sv - (Some (mk_mplace meta p ctx)) + let ctx, cc = + expand_symbolic_value_no_branching config span sv + (Some (mk_mplace span p ctx)) + ctx in - comp cc expand cf ctx + comp cc (expand ctx) in (* Apply *) - expand cf ctx + expand ctx -(** Read a place (CPS-style function). +(** Read a place. - We also check that the value *doesn't contain bottoms or reserved + We check that the value *doesn't contain bottoms or reserved borrows*. *) -let read_place (meta : Meta.meta) (access : access_kind) (p : place) - (cf : typed_value -> m_fun) : m_fun = - fun ctx -> - let v = read_place meta access p ctx in +let read_place_check (span : Meta.span) (access : access_kind) (p : place) + (ctx : eval_ctx) : typed_value = + let v = read_place span access p ctx in (* Check that there are no bottoms in the value *) cassert __FILE__ __LINE__ (not (bottom_in_value ctx.ended_regions v)) - meta "There should be no bottoms in the value"; + span "There should be no bottoms in the value"; (* Check that there are no reserved borrows in the value *) cassert __FILE__ __LINE__ (not (reserved_in_value v)) - meta "There should be no reserved borrows in the value"; - (* Call the continuation *) - cf v ctx + span "There should be no reserved borrows in the value"; + (* Return *) + v -let access_rplace_reorganize_and_read (config : config) (meta : Meta.meta) +let access_rplace_reorganize_and_read (config : config) (span : Meta.span) (expand_prim_copy : bool) (access : access_kind) (p : place) - (cf : typed_value -> m_fun) : m_fun = - fun ctx -> + (ctx : eval_ctx) : typed_value * eval_ctx * (eval_result -> eval_result) = (* Make sure we can evaluate the path *) - let cc = update_ctx_along_read_place config meta access p in + let ctx, cc = update_ctx_along_read_place config span access p ctx in (* End the proper loans at the place itself *) - let cc = comp cc (end_loans_at_place config meta access p) in + let ctx, cc = comp cc (end_loans_at_place config span access p ctx) in (* Expand the copyable values which contain borrows (which are necessarily shared * borrows) *) - let cc = - if expand_prim_copy then - comp cc (expand_primitively_copyable_at_place config meta access p) - else cc + let ctx, cc = + comp cc + (if expand_prim_copy then + expand_primitively_copyable_at_place config span access p ctx + else (ctx, fun e -> e)) in (* Read the place - note that this checks that the value doesn't contain bottoms *) - let read_place = read_place meta access p in + let ty_value = read_place_check span access p ctx in (* Compose *) - comp cc read_place cf ctx + (ty_value, ctx, cc) -let access_rplace_reorganize (config : config) (meta : Meta.meta) +let access_rplace_reorganize (config : config) (span : Meta.span) (expand_prim_copy : bool) (access : access_kind) (p : place) : cm_fun = - fun cf ctx -> - access_rplace_reorganize_and_read config meta expand_prim_copy access p - (fun _v -> cf) - ctx + fun ctx -> + let _, ctx, f = + access_rplace_reorganize_and_read config span expand_prim_copy access p ctx + in + (ctx, f) (** Convert an operand constant operand value to a typed value *) -let literal_to_typed_value (meta : Meta.meta) (ty : literal_type) (cv : literal) +let literal_to_typed_value (span : Meta.span) (ty : literal_type) (cv : literal) : typed_value = (* Check the type while converting - we actually need some information * contained in the type *) @@ -107,11 +108,11 @@ let literal_to_typed_value (meta : Meta.meta) (ty : literal_type) (cv : literal) | TChar, VChar v -> { value = VLiteral (VChar v); ty = TLiteral ty } | TInteger int_ty, VScalar v -> (* Check the type and the ranges *) - sanity_check __FILE__ __LINE__ (int_ty = v.int_ty) meta; - sanity_check __FILE__ __LINE__ (check_scalar_value_in_range v) meta; + sanity_check __FILE__ __LINE__ (int_ty = v.int_ty) span; + sanity_check __FILE__ __LINE__ (check_scalar_value_in_range v) span; { value = VLiteral (VScalar v); ty = TLiteral ty } (* Remaining cases (invalid) *) - | _, _ -> craise __FILE__ __LINE__ meta "Improperly typed constant value" + | _, _ -> craise __FILE__ __LINE__ span "Improperly typed constant value" (** Copy a value, and return the resulting value. @@ -124,14 +125,14 @@ let literal_to_typed_value (meta : Meta.meta) (ty : literal_type) (cv : literal) parameter to control this copy ([allow_adt_copy]). Note that here by ADT we mean the user-defined ADTs (not tuples or assumed types). *) -let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) +let rec copy_value (span : Meta.span) (allow_adt_copy : bool) (config : config) (ctx : eval_ctx) (v : typed_value) : eval_ctx * typed_value = log#ldebug (lazy ("copy_value: " - ^ typed_value_to_string ~meta:(Some meta) ctx v + ^ typed_value_to_string ~span:(Some span) ctx v ^ "\n- context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Remark: at some point we rewrote this function to use iterators, but then * we reverted the changes: the result was less clear actually. In particular, * the fact that we have exhaustive matches below makes very obvious the cases @@ -142,12 +143,12 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) (* Sanity check *) (match v.ty with | TAdt (TAssumed TBox, _) -> - exec_raise __FILE__ __LINE__ meta + exec_raise __FILE__ __LINE__ span "Can't copy an assumed value other than Option" | TAdt (TAdtId _, _) as ty -> sanity_check __FILE__ __LINE__ (allow_adt_copy || ty_is_copyable ty) - meta + span | TAdt (TTuple, _) -> () (* Ok *) | TAdt ( TAssumed (TSlice | TArray), @@ -157,16 +158,16 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) const_generics = []; trait_refs = []; } ) -> - exec_assert __FILE__ __LINE__ (ty_is_copyable ty) meta + exec_assert __FILE__ __LINE__ (ty_is_copyable ty) span "The type is not primitively copyable" - | _ -> exec_raise __FILE__ __LINE__ meta "Unreachable"); + | _ -> exec_raise __FILE__ __LINE__ span "Unreachable"); let ctx, fields = List.fold_left_map - (copy_value meta allow_adt_copy config) + (copy_value span allow_adt_copy config) ctx av.field_values in (ctx, { v with value = VAdt { av with field_values = fields } }) - | VBottom -> exec_raise __FILE__ __LINE__ meta "Can't copy ⊥" + | VBottom -> exec_raise __FILE__ __LINE__ span "Can't copy ⊥" | VBorrow bc -> ( (* We can only copy shared borrows *) match bc with @@ -174,20 +175,20 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) (* We need to create a new borrow id for the copied borrow, and * update the context accordingly *) let bid' = fresh_borrow_id () in - let ctx = InterpreterBorrows.reborrow_shared meta bid bid' ctx in + let ctx = InterpreterBorrows.reborrow_shared span bid bid' ctx in (ctx, { v with value = VBorrow (VSharedBorrow bid') }) | VMutBorrow (_, _) -> - exec_raise __FILE__ __LINE__ meta "Can't copy a mutable borrow" + exec_raise __FILE__ __LINE__ span "Can't copy a mutable borrow" | VReservedMutBorrow _ -> - exec_raise __FILE__ __LINE__ meta "Can't copy a reserved mut borrow") + exec_raise __FILE__ __LINE__ span "Can't copy a reserved mut borrow") | VLoan lc -> ( (* We can only copy shared loans *) match lc with | VMutLoan _ -> - exec_raise __FILE__ __LINE__ meta "Can't copy a mutable loan" + exec_raise __FILE__ __LINE__ span "Can't copy a mutable loan" | VSharedLoan (_, sv) -> (* We don't copy the shared loan: only the shared value inside *) - copy_value meta allow_adt_copy config ctx sv) + copy_value span allow_adt_copy config ctx sv) | VSymbolic sp -> (* We can copy only if the type is "primitively" copyable. * Note that in the general case, copy is a trait: copying values @@ -195,7 +196,7 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) * for very simple types such as integers, shared borrows, etc. *) cassert __FILE__ __LINE__ (ty_is_copyable (Substitute.erase_regions sp.sv_ty)) - meta "Not primitively copyable"; + span "Not primitively copyable"; (* If the type is copyable, we simply return the current value. Side * remark: what is important to look at when copying symbolic values * is symbolic expansion. The important subcase is the expansion of shared @@ -220,86 +221,85 @@ let rec copy_value (meta : Meta.meta) (allow_adt_copy : bool) (config : config) dest <- f(move x, move y); ... ]} + Because of the way {!end_borrow} is implemented, when giving back the borrow - [l0] upon evaluating [move y], we won't notice that [shared_borrow l0] has - disappeared from the environment (it has been moved and not assigned yet, - and so is hanging in "thin air"). + [l0] upon evaluating [move y], if we have already moved the value of x, + we won't notice that [shared_borrow l0] has disappeared from the environment + (it has been moved and not assigned yet, and so is hanging in "thin air"). By first "preparing" the operands evaluation, we make sure no such thing happens. To be more precise, we make sure all the updates to borrows triggered by access *and* move operations have already been applied. - Rk.: in the formalization, we always have an explicit "reorganization" step + Rem.: in the formalization, we always have an explicit "reorganization" step in the rule premises, before the actual operand evaluation, that allows to reorganize the environment so that it satisfies the proper conditions. This function's role is to do the reorganization. - Rk.: doing this is actually not completely necessary because when + Rem.: doing this is actually not completely necessary because when generating MIR, rustc introduces intermediate assignments for all the function parameters. Still, it is better for soundness purposes, and corresponds to what we do in the formalization (because we don't enforce the same constraints as MIR in the formalization). *) -let prepare_eval_operand_reorganize (config : config) (meta : Meta.meta) +let prepare_eval_operand_reorganize (config : config) (span : Meta.span) (op : operand) : cm_fun = - fun cf ctx -> - let prepare : cm_fun = - fun cf ctx -> - match op with - | Constant _ -> - (* No need to reorganize the context *) - cf ctx - | Copy p -> - (* Access the value *) - let access = Read in - (* Expand the symbolic values, if necessary *) - let expand_prim_copy = true in - access_rplace_reorganize config meta expand_prim_copy access p cf ctx - | Move p -> - (* Access the value *) - let access = Move in - let expand_prim_copy = false in - access_rplace_reorganize config meta expand_prim_copy access p cf ctx - in - (* Apply *) - prepare cf ctx + fun ctx -> + match op with + | Constant _ -> + (* No need to reorganize the context *) + (ctx, fun e -> e) + | Copy p -> + (* Access the value *) + let access = Read in + (* Expand the symbolic values, if necessary *) + let expand_prim_copy = true in + access_rplace_reorganize config span expand_prim_copy access p ctx + | Move p -> + (* Access the value *) + let access = Move in + let expand_prim_copy = false in + access_rplace_reorganize config span expand_prim_copy access p ctx (** Evaluate an operand, without reorganizing the context before *) -let eval_operand_no_reorganize (config : config) (meta : Meta.meta) - (op : operand) (cf : typed_value -> m_fun) : m_fun = - fun ctx -> +let eval_operand_no_reorganize (config : config) (span : Meta.span) + (op : operand) (ctx : eval_ctx) : + typed_value * eval_ctx * (eval_result -> eval_result) = (* Debug *) log#ldebug (lazy ("eval_operand_no_reorganize: op: " ^ operand_to_string ctx op ^ "\n- ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n")); (* Evaluate *) match op with | Constant cv -> ( match cv.value with | CLiteral lit -> - cf (literal_to_typed_value meta (ty_as_literal cv.ty) lit) ctx - | CTraitConst (trait_ref, const_name) -> ( + ( literal_to_typed_value span (ty_as_literal cv.ty) lit, + ctx, + fun e -> e ) + | CTraitConst (trait_ref, const_name) -> let ctx0 = ctx in (* Simply introduce a fresh symbolic value *) let ty = cv.ty in - let v = mk_fresh_symbolic_typed_value meta ty in - (* Continue the evaluation *) - let e = cf v ctx in + let v = mk_fresh_symbolic_typed_value span ty in (* Wrap the generated expression *) - match e with - | None -> None - | Some e -> - Some - (SymbolicAst.IntroSymbolic - ( ctx0, - None, - value_as_symbolic meta v.value, - SymbolicAst.VaTraitConstValue (trait_ref, const_name), - e ))) - | CVar vid -> ( + let cf e = + match e with + | None -> None + | Some e -> + Some + (SymbolicAst.IntroSymbolic + ( ctx0, + None, + value_as_symbolic span v.value, + SymbolicAst.VaTraitConstValue (trait_ref, const_name), + e )) + in + (v, ctx, cf) + | CVar vid -> let ctx0 = ctx in (* In concrete mode: lookup the const generic value. In symbolic mode: introduce a fresh symbolic value. @@ -313,221 +313,200 @@ let eval_operand_no_reorganize (config : config) (meta : Meta.meta) | ConcreteMode -> (* Copy the value - this is more of a sanity check *) let allow_adt_copy = false in - copy_value meta allow_adt_copy config ctx cv + copy_value span allow_adt_copy config ctx cv | SymbolicMode -> (* We use the looked up value only for its type *) - let v = mk_fresh_symbolic_typed_value meta cv.ty in + let v = mk_fresh_symbolic_typed_value span cv.ty in (ctx, v) in - (* Continue *) - let e = cf cv ctx in - (* If we are synthesizing a symbolic AST, it means that we are in symbolic - mode: the value of the const generic is necessarily symbolic. *) - sanity_check __FILE__ __LINE__ (e = None || is_symbolic cv.value) meta; (* We have to wrap the generated expression *) - match e with - | None -> None - | Some e -> - (* If we are synthesizing a symbolic AST, it means that we are in symbolic - mode: the value of the const generic is necessarily symbolic. *) - sanity_check __FILE__ __LINE__ (is_symbolic cv.value) meta; - (* *) - Some - (SymbolicAst.IntroSymbolic - ( ctx0, - None, - value_as_symbolic meta cv.value, - SymbolicAst.VaCgValue vid, - e ))) + let cf e = + match e with + | None -> None + | Some e -> + (* If we are synthesizing a symbolic AST, it means that we are in symbolic + mode: the value of the const generic is necessarily symbolic. *) + sanity_check __FILE__ __LINE__ (is_symbolic cv.value) span; + (* *) + Some + (SymbolicAst.IntroSymbolic + ( ctx0, + None, + value_as_symbolic span cv.value, + SymbolicAst.VaCgValue vid, + e )) + in + (cv, ctx, cf) | CFnPtr _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Function pointers are not supported yet") | Copy p -> (* Access the value *) let access = Read in - let cc = read_place meta access p in + let v = read_place_check span access p ctx in + (* Sanity checks *) + exec_assert __FILE__ __LINE__ + (not (bottom_in_value ctx.ended_regions v)) + span "Can not copy a value containing bottom"; + sanity_check __FILE__ __LINE__ + (Option.is_none + (find_first_primitively_copyable_sv_with_borrows + ctx.type_ctx.type_infos v)) + span; (* Copy the value *) - let copy cf v : m_fun = - fun ctx -> - (* Sanity checks *) - exec_assert __FILE__ __LINE__ - (not (bottom_in_value ctx.ended_regions v)) - meta "Can not copy a value containing bottom"; - sanity_check __FILE__ __LINE__ - (Option.is_none - (find_first_primitively_copyable_sv_with_borrows - ctx.type_ctx.type_infos v)) - meta; - (* Actually perform the copy *) - let allow_adt_copy = false in - let ctx, v = copy_value meta allow_adt_copy config ctx v in - (* Continue *) - cf v ctx - in - (* Compose and apply *) - comp cc copy cf ctx + let allow_adt_copy = false in + let ctx, v = copy_value span allow_adt_copy config ctx v in + (v, ctx, fun e -> e) | Move p -> (* Access the value *) let access = Move in - let cc = read_place meta access p in + let v = read_place_check span access p ctx in + (* Check that there are no bottoms in the value we are about to move *) + exec_assert __FILE__ __LINE__ + (not (bottom_in_value ctx.ended_regions v)) + span "There should be no bottoms in the value we are about to move"; (* Move the value *) - let move cf v : m_fun = - fun ctx -> - (* Check that there are no bottoms in the value we are about to move *) - exec_assert __FILE__ __LINE__ - (not (bottom_in_value ctx.ended_regions v)) - meta "There should be no bottoms in the value we are about to move"; - let bottom : typed_value = { value = VBottom; ty = v.ty } in - let ctx = write_place meta access p bottom ctx in - cf v ctx - in - (* Compose and apply *) - comp cc move cf ctx + let bottom : typed_value = { value = VBottom; ty = v.ty } in + let ctx = write_place span access p bottom ctx in + (v, ctx, fun e -> e) -let eval_operand (config : config) (meta : Meta.meta) (op : operand) - (cf : typed_value -> m_fun) : m_fun = - fun ctx -> +let eval_operand (config : config) (span : Meta.span) (op : operand) + (ctx : eval_ctx) : typed_value * eval_ctx * (eval_result -> eval_result) = (* Debug *) log#ldebug (lazy ("eval_operand: op: " ^ operand_to_string ctx op ^ "\n- ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n")); (* We reorganize the context, then evaluate the operand *) - comp - (prepare_eval_operand_reorganize config meta op) - (eval_operand_no_reorganize config meta op) - cf ctx + let ctx, cc = prepare_eval_operand_reorganize config span op ctx in + comp2 cc (eval_operand_no_reorganize config span op ctx) (** Small utility. See [prepare_eval_operand_reorganize]. *) -let prepare_eval_operands_reorganize (config : config) (meta : Meta.meta) +let prepare_eval_operands_reorganize (config : config) (span : Meta.span) (ops : operand list) : cm_fun = - fold_left_apply_continuation (prepare_eval_operand_reorganize config meta) ops + fold_left_apply_continuation (prepare_eval_operand_reorganize config span) ops (** Evaluate several operands. *) -let eval_operands (config : config) (meta : Meta.meta) (ops : operand list) - (cf : typed_value list -> m_fun) : m_fun = - fun ctx -> +let eval_operands (config : config) (span : Meta.span) (ops : operand list) + (ctx : eval_ctx) : + typed_value list * eval_ctx * (eval_result -> eval_result) = (* Prepare the operands *) - let prepare = prepare_eval_operands_reorganize config meta ops in + let ctx, cc = prepare_eval_operands_reorganize config span ops ctx in (* Evaluate the operands *) - let eval = - fold_left_list_apply_continuation - (eval_operand_no_reorganize config meta) - ops - in - (* Compose and apply *) - comp prepare eval cf ctx - -let eval_two_operands (config : config) (meta : Meta.meta) (op1 : operand) - (op2 : operand) (cf : typed_value * typed_value -> m_fun) : m_fun = - let eval_op = eval_operands config meta [ op1; op2 ] in - let use_res cf res = + comp2 cc + (map_apply_continuation (eval_operand_no_reorganize config span) ops ctx) + +let eval_two_operands (config : config) (span : Meta.span) (op1 : operand) + (op2 : operand) (ctx : eval_ctx) : + (typed_value * typed_value) * eval_ctx * (eval_result -> eval_result) = + let res, ctx, cc = eval_operands config span [ op1; op2 ] ctx in + let res = match res with - | [ v1; v2 ] -> cf (v1, v2) - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | [ v1; v2 ] -> (v1, v2) + | _ -> craise __FILE__ __LINE__ span "Unreachable" in - comp eval_op use_res cf + (res, ctx, cc) -let eval_unary_op_concrete (config : config) (meta : Meta.meta) (unop : unop) - (op : operand) (cf : (typed_value, eval_error) result -> m_fun) : m_fun = +let eval_unary_op_concrete (config : config) (span : Meta.span) (unop : unop) + (op : operand) (ctx : eval_ctx) : + (typed_value, eval_error) result * eval_ctx * (eval_result -> eval_result) = (* Evaluate the operand *) - let eval_op = eval_operand config meta op in + let v, ctx, cc = eval_operand config span op ctx in (* Apply the unop *) - let apply cf (v : typed_value) : m_fun = + let r = match (unop, v.value) with - | Not, VLiteral (VBool b) -> - cf (Ok { v with value = VLiteral (VBool (not b)) }) + | Not, VLiteral (VBool b) -> Ok { v with value = VLiteral (VBool (not b)) } | Neg, VLiteral (VScalar sv) -> ( let i = Z.neg sv.value in match mk_scalar sv.int_ty i with - | Error _ -> cf (Error EPanic) - | Ok sv -> cf (Ok { v with value = VLiteral (VScalar sv) })) + | Error _ -> Error EPanic + | Ok sv -> Ok { v with value = VLiteral (VScalar sv) }) | ( Cast (CastScalar (TInteger src_ty, TInteger tgt_ty)), VLiteral (VScalar sv) ) -> ( (* Cast between integers *) - sanity_check __FILE__ __LINE__ (src_ty = sv.int_ty) meta; + sanity_check __FILE__ __LINE__ (src_ty = sv.int_ty) span; let i = sv.value in match mk_scalar tgt_ty i with - | Error _ -> cf (Error EPanic) + | Error _ -> Error EPanic | Ok sv -> let ty = TLiteral (TInteger tgt_ty) in let value = VLiteral (VScalar sv) in - cf (Ok { ty; value })) + Ok { ty; value }) | Cast (CastScalar (TBool, TInteger tgt_ty)), VLiteral (VBool sv) -> ( (* Cast bool -> int *) let i = Z.of_int (if sv then 1 else 0) in match mk_scalar tgt_ty i with - | Error _ -> cf (Error EPanic) + | Error _ -> Error EPanic | Ok sv -> let ty = TLiteral (TInteger tgt_ty) in let value = VLiteral (VScalar sv) in - cf (Ok { ty; value })) + Ok { ty; value }) | Cast (CastScalar (TInteger _, TBool)), VLiteral (VScalar sv) -> (* Cast int -> bool *) let b = if Z.of_int 0 = sv.value then false else if Z.of_int 1 = sv.value then true else - exec_raise __FILE__ __LINE__ meta + exec_raise __FILE__ __LINE__ span "Conversion from int to bool: out of range" in let value = VLiteral (VBool b) in let ty = TLiteral TBool in - cf (Ok { ty; value }) - | _ -> exec_raise __FILE__ __LINE__ meta "Invalid input for unop" + Ok { ty; value } + | _ -> exec_raise __FILE__ __LINE__ span "Invalid input for unop" in - comp eval_op apply cf + (r, ctx, cc) -let eval_unary_op_symbolic (config : config) (meta : Meta.meta) (unop : unop) - (op : operand) (cf : (typed_value, eval_error) result -> m_fun) : m_fun = - fun ctx -> +let eval_unary_op_symbolic (config : config) (span : Meta.span) (unop : unop) + (op : operand) (ctx : eval_ctx) : + (typed_value, eval_error) result * eval_ctx * (eval_result -> eval_result) = (* Evaluate the operand *) - let eval_op = eval_operand config meta op in + let v, ctx, cc = eval_operand config span op ctx in (* Generate a fresh symbolic value to store the result *) - let apply cf (v : typed_value) : m_fun = - fun ctx -> - let res_sv_id = fresh_symbolic_value_id () in - let res_sv_ty = - match (unop, v.ty) with - | Not, (TLiteral TBool as lty) -> lty - | Neg, (TLiteral (TInteger _) as lty) -> lty - | Cast (CastScalar (_, tgt_ty)), _ -> TLiteral tgt_ty - | _ -> exec_raise __FILE__ __LINE__ meta "Invalid input for unop" - in - let res_sv = { sv_id = res_sv_id; sv_ty = res_sv_ty } in - (* Call the continuation *) - let expr = cf (Ok (mk_typed_value_from_symbolic_value res_sv)) ctx in - (* Synthesize the symbolic AST *) - synthesize_unary_op ctx unop v - (mk_opt_place_from_op meta op ctx) - res_sv None expr + let res_sv_id = fresh_symbolic_value_id () in + let res_sv_ty = + match (unop, v.ty) with + | Not, (TLiteral TBool as lty) -> lty + | Neg, (TLiteral (TInteger _) as lty) -> lty + | Cast (CastScalar (_, tgt_ty)), _ -> TLiteral tgt_ty + | _ -> exec_raise __FILE__ __LINE__ span "Invalid input for unop" in - (* Compose and apply *) - comp eval_op apply cf ctx + let res_sv = { sv_id = res_sv_id; sv_ty = res_sv_ty } in + (* Compute the result *) + let res = Ok (mk_typed_value_from_symbolic_value res_sv) in + (* Synthesize the symbolic AST *) + let cc = + cc_comp cc + (synthesize_unary_op ctx unop v + (mk_opt_place_from_op span op ctx) + res_sv None) + in + (res, ctx, cc) -let eval_unary_op (config : config) (meta : Meta.meta) (unop : unop) - (op : operand) (cf : (typed_value, eval_error) result -> m_fun) : m_fun = +let eval_unary_op (config : config) (span : Meta.span) (unop : unop) + (op : operand) (ctx : eval_ctx) : + (typed_value, eval_error) result * eval_ctx * (eval_result -> eval_result) = match config.mode with - | ConcreteMode -> eval_unary_op_concrete config meta unop op cf - | SymbolicMode -> eval_unary_op_symbolic config meta unop op cf + | ConcreteMode -> eval_unary_op_concrete config span unop op ctx + | SymbolicMode -> eval_unary_op_symbolic config span unop op ctx (** Small helper for [eval_binary_op_concrete]: computes the result of applying the binop *after* the operands have been successfully evaluated *) -let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) +let eval_binary_op_concrete_compute (span : Meta.span) (binop : binop) (v1 : typed_value) (v2 : typed_value) : (typed_value, eval_error) result = (* Equality check binops (Eq, Ne) accept values from a wide variety of types. * The remaining binops only operate on scalars. *) if binop = Eq || binop = Ne then ( (* Equality operations *) - exec_assert __FILE__ __LINE__ (v1.ty = v2.ty) meta + exec_assert __FILE__ __LINE__ (v1.ty = v2.ty) span "The arguments given to the binop don't have the same type"; (* Equality/inequality check is primitive only for a subset of types *) - exec_assert __FILE__ __LINE__ (ty_is_copyable v1.ty) meta + exec_assert __FILE__ __LINE__ (ty_is_copyable v1.ty) span "Type is not primitively copyable"; let b = v1 = v2 in Ok { value = VLiteral (VBool b); ty = TLiteral TBool }) @@ -543,7 +522,7 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) match binop with | Lt | Le | Ge | Gt -> (* The two operands must have the same type and the result is a boolean *) - sanity_check __FILE__ __LINE__ (sv1.int_ty = sv2.int_ty) meta; + sanity_check __FILE__ __LINE__ (sv1.int_ty = sv2.int_ty) span; let b = match binop with | Lt -> Z.lt sv1.value sv2.value @@ -552,14 +531,14 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) | Gt -> Z.gt sv1.value sv2.value | Div | Rem | Add | Sub | Mul | BitXor | BitAnd | BitOr | Shl | Shr | Ne | Eq | CheckedAdd | CheckedSub | CheckedMul -> - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in Ok ({ value = VLiteral (VBool b); ty = TLiteral TBool } : typed_value) | Div | Rem | Add | Sub | Mul | BitXor | BitAnd | BitOr -> ( (* The two operands must have the same type and the result is an integer *) - sanity_check __FILE__ __LINE__ (sv1.int_ty = sv2.int_ty) meta; + sanity_check __FILE__ __LINE__ (sv1.int_ty = sv2.int_ty) span; let res = match binop with | Div -> @@ -577,7 +556,7 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) | BitOr -> raise Unimplemented | Lt | Le | Ge | Gt | Shl | Shr | Ne | Eq | CheckedAdd | CheckedSub | CheckedMul -> - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in match res with | Error _ -> Error EPanic @@ -588,183 +567,167 @@ let eval_binary_op_concrete_compute (meta : Meta.meta) (binop : binop) ty = TLiteral (TInteger sv1.int_ty); }) | Shl | Shr | CheckedAdd | CheckedSub | CheckedMul -> - craise __FILE__ __LINE__ meta "Unimplemented binary operation" - | Ne | Eq -> craise __FILE__ __LINE__ meta "Unreachable") - | _ -> craise __FILE__ __LINE__ meta "Invalid inputs for binop" + craise __FILE__ __LINE__ span "Unimplemented binary operation" + | Ne | Eq -> craise __FILE__ __LINE__ span "Unreachable") + | _ -> craise __FILE__ __LINE__ span "Invalid inputs for binop" -let eval_binary_op_concrete (config : config) (meta : Meta.meta) (binop : binop) - (op1 : operand) (op2 : operand) - (cf : (typed_value, eval_error) result -> m_fun) : m_fun = +let eval_binary_op_concrete (config : config) (span : Meta.span) (binop : binop) + (op1 : operand) (op2 : operand) (ctx : eval_ctx) : + (typed_value, eval_error) result * eval_ctx * (eval_result -> eval_result) = (* Evaluate the operands *) - let eval_ops = eval_two_operands config meta op1 op2 in + let (v1, v2), ctx, cc = eval_two_operands config span op1 op2 ctx in (* Compute the result of the binop *) - let compute cf (res : typed_value * typed_value) = - let v1, v2 = res in - cf (eval_binary_op_concrete_compute meta binop v1 v2) - in - (* Compose and apply *) - comp eval_ops compute cf + let r = eval_binary_op_concrete_compute span binop v1 v2 in + (* Return *) + (r, ctx, cc) -let eval_binary_op_symbolic (config : config) (meta : Meta.meta) (binop : binop) - (op1 : operand) (op2 : operand) - (cf : (typed_value, eval_error) result -> m_fun) : m_fun = - fun ctx -> +let eval_binary_op_symbolic (config : config) (span : Meta.span) (binop : binop) + (op1 : operand) (op2 : operand) (ctx : eval_ctx) : + (typed_value, eval_error) result * eval_ctx * (eval_result -> eval_result) = (* Evaluate the operands *) - let eval_ops = eval_two_operands config meta op1 op2 in - (* Compute the result of applying the binop *) - let compute cf ((v1, v2) : typed_value * typed_value) : m_fun = - fun ctx -> - (* Generate a fresh symbolic value to store the result *) - let res_sv_id = fresh_symbolic_value_id () in - let res_sv_ty = - if binop = Eq || binop = Ne then ( - (* Equality operations *) - sanity_check __FILE__ __LINE__ (v1.ty = v2.ty) meta; - (* Equality/inequality check is primitive only for a subset of types *) - exec_assert __FILE__ __LINE__ (ty_is_copyable v1.ty) meta - "The type is not primitively copyable"; - TLiteral TBool) - else - (* Other operations: input types are integers *) - match (v1.ty, v2.ty) with - | TLiteral (TInteger int_ty1), TLiteral (TInteger int_ty2) -> ( - match binop with - | Lt | Le | Ge | Gt -> - sanity_check __FILE__ __LINE__ (int_ty1 = int_ty2) meta; - TLiteral TBool - | Div | Rem | Add | Sub | Mul | BitXor | BitAnd | BitOr -> - sanity_check __FILE__ __LINE__ (int_ty1 = int_ty2) meta; - TLiteral (TInteger int_ty1) - (* These return `(int, bool)` which isn't a literal type *) - | CheckedAdd | CheckedSub | CheckedMul -> - craise __FILE__ __LINE__ meta - "Checked operations are not implemented" - | Shl | Shr -> - (* The number of bits can be of a different integer type - than the operand *) - TLiteral (TInteger int_ty1) - | Ne | Eq -> craise __FILE__ __LINE__ meta "Unreachable") - | _ -> craise __FILE__ __LINE__ meta "Invalid inputs for binop" - in - let res_sv = { sv_id = res_sv_id; sv_ty = res_sv_ty } in - (* Call the continuattion *) - let v = mk_typed_value_from_symbolic_value res_sv in - let expr = cf (Ok v) ctx in - (* Synthesize the symbolic AST *) - let p1 = mk_opt_place_from_op meta op1 ctx in - let p2 = mk_opt_place_from_op meta op2 ctx in - synthesize_binary_op ctx binop v1 p1 v2 p2 res_sv None expr + let (v1, v2), ctx, cc = eval_two_operands config span op1 op2 ctx in + (* Generate a fresh symbolic value to store the result *) + let res_sv_id = fresh_symbolic_value_id () in + let res_sv_ty = + if binop = Eq || binop = Ne then ( + (* Equality operations *) + sanity_check __FILE__ __LINE__ (v1.ty = v2.ty) span; + (* Equality/inequality check is primitive only for a subset of types *) + exec_assert __FILE__ __LINE__ (ty_is_copyable v1.ty) span + "The type is not primitively copyable"; + TLiteral TBool) + else + (* Other operations: input types are integers *) + match (v1.ty, v2.ty) with + | TLiteral (TInteger int_ty1), TLiteral (TInteger int_ty2) -> ( + match binop with + | Lt | Le | Ge | Gt -> + sanity_check __FILE__ __LINE__ (int_ty1 = int_ty2) span; + TLiteral TBool + | Div | Rem | Add | Sub | Mul | BitXor | BitAnd | BitOr -> + sanity_check __FILE__ __LINE__ (int_ty1 = int_ty2) span; + TLiteral (TInteger int_ty1) + (* These return `(int, bool)` which isn't a literal type *) + | CheckedAdd | CheckedSub | CheckedMul -> + craise __FILE__ __LINE__ span + "Checked operations are not implemented" + | Shl | Shr -> + (* The number of bits can be of a different integer type + than the operand *) + TLiteral (TInteger int_ty1) + | Ne | Eq -> craise __FILE__ __LINE__ span "Unreachable") + | _ -> craise __FILE__ __LINE__ span "Invalid inputs for binop" + in + let res_sv = { sv_id = res_sv_id; sv_ty = res_sv_ty } in + let v = mk_typed_value_from_symbolic_value res_sv in + (* Synthesize the symbolic AST *) + let p1 = mk_opt_place_from_op span op1 ctx in + let p2 = mk_opt_place_from_op span op2 ctx in + let cc = + cc_comp cc (synthesize_binary_op ctx binop v1 p1 v2 p2 res_sv None) in (* Compose and apply *) - comp eval_ops compute cf ctx + (Ok v, ctx, cc) -let eval_binary_op (config : config) (meta : Meta.meta) (binop : binop) - (op1 : operand) (op2 : operand) - (cf : (typed_value, eval_error) result -> m_fun) : m_fun = +let eval_binary_op (config : config) (span : Meta.span) (binop : binop) + (op1 : operand) (op2 : operand) (ctx : eval_ctx) : + (typed_value, eval_error) result * eval_ctx * (eval_result -> eval_result) = match config.mode with - | ConcreteMode -> eval_binary_op_concrete config meta binop op1 op2 cf - | SymbolicMode -> eval_binary_op_symbolic config meta binop op1 op2 cf - -let eval_rvalue_ref (config : config) (meta : Meta.meta) (p : place) - (bkind : borrow_kind) (cf : typed_value -> m_fun) : m_fun = - fun ctx -> + | ConcreteMode -> eval_binary_op_concrete config span binop op1 op2 ctx + | SymbolicMode -> eval_binary_op_symbolic config span binop op1 op2 ctx + +(** Evaluate an rvalue which creates a reference (i.e., an rvalue which is + `&p` or `&mut p` or `&two-phase p`) *) +let eval_rvalue_ref (config : config) (span : Meta.span) (p : place) + (bkind : borrow_kind) (ctx : eval_ctx) : + typed_value * eval_ctx * (eval_result -> eval_result) = match bkind with | BShared | BTwoPhaseMut | BShallow -> (* **REMARK**: we initially treated shallow borrows like shared borrows. In practice this restricted the behaviour too much, so for now we - forbid them. + forbid them and remove them in the prepasses (see the comments there + as to why this is sound). *) - sanity_check __FILE__ __LINE__ (bkind <> BShallow) meta; + sanity_check __FILE__ __LINE__ (bkind <> BShallow) span; (* Access the value *) let access = match bkind with | BShared | BShallow -> Read | BTwoPhaseMut -> Write - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in let expand_prim_copy = false in - let prepare = - access_rplace_reorganize_and_read config meta expand_prim_copy access p + let v, ctx, cc = + access_rplace_reorganize_and_read config span expand_prim_copy access p + ctx in - (* Evaluate the borrowing operation *) - let eval (cf : typed_value -> m_fun) (v : typed_value) : m_fun = - fun ctx -> - (* Generate the fresh borrow id *) - let bid = fresh_borrow_id () in - (* Compute the loan value, with which to replace the value at place p *) - let nv = - match v.value with - | VLoan (VSharedLoan (bids, sv)) -> - (* Shared loan: insert the new borrow id *) - let bids1 = BorrowId.Set.add bid bids in - { v with value = VLoan (VSharedLoan (bids1, sv)) } - | _ -> - (* Not a shared loan: add a wrapper *) - let v' = VLoan (VSharedLoan (BorrowId.Set.singleton bid, v)) in - { v with value = v' } - in - (* Update the borrowed value in the context *) - let ctx = write_place meta access p nv ctx in - (* Compute the rvalue - simply a shared borrow with a the fresh id. - * Note that the reference is *mutable* if we do a two-phase borrow *) - let ref_kind = - match bkind with - | BShared | BShallow -> RShared - | BTwoPhaseMut -> RMut - | _ -> craise __FILE__ __LINE__ meta "Unreachable" - in - let rv_ty = TRef (RErased, v.ty, ref_kind) in - let bc = - match bkind with - | BShared | BShallow -> - (* See the remark at the beginning of the match branch: we - handle shallow borrows like shared borrows *) - VSharedBorrow bid - | BTwoPhaseMut -> VReservedMutBorrow bid - | _ -> craise __FILE__ __LINE__ meta "Unreachable" - in - let rv : typed_value = { value = VBorrow bc; ty = rv_ty } in - (* Continue *) - cf rv ctx + (* Generate the fresh borrow id *) + let bid = fresh_borrow_id () in + (* Compute the loan value, with which to replace the value at place p *) + let nv = + match v.value with + | VLoan (VSharedLoan (bids, sv)) -> + (* Shared loan: insert the new borrow id *) + let bids1 = BorrowId.Set.add bid bids in + { v with value = VLoan (VSharedLoan (bids1, sv)) } + | _ -> + (* Not a shared loan: add a wrapper *) + let v' = VLoan (VSharedLoan (BorrowId.Set.singleton bid, v)) in + { v with value = v' } + in + (* Update the value in the context to replace it with the loan *) + let ctx = write_place span access p nv ctx in + (* Compute the rvalue - simply a shared borrow with the fresh id. + * Note that the reference is *mutable* if we do a two-phase borrow *) + let ref_kind = + match bkind with + | BShared | BShallow -> RShared + | BTwoPhaseMut -> RMut + | _ -> craise __FILE__ __LINE__ span "Unreachable" + in + let rv_ty = TRef (RErased, v.ty, ref_kind) in + let bc = + match bkind with + | BShared | BShallow -> + (* See the remark at the beginning of the match branch: we + handle shallow borrows like shared borrows *) + VSharedBorrow bid + | BTwoPhaseMut -> VReservedMutBorrow bid + | _ -> craise __FILE__ __LINE__ span "Unreachable" in - (* Compose and apply *) - comp prepare eval cf ctx + let rv : typed_value = { value = VBorrow bc; ty = rv_ty } in + (* Return *) + (rv, ctx, cc) | BMut -> (* Access the value *) let access = Write in let expand_prim_copy = false in - let prepare = - access_rplace_reorganize_and_read config meta expand_prim_copy access p + let v, ctx, cc = + access_rplace_reorganize_and_read config span expand_prim_copy access p + ctx in - (* Evaluate the borrowing operation *) - let eval (cf : typed_value -> m_fun) (v : typed_value) : m_fun = - fun ctx -> - (* Compute the rvalue - wrap the value in a mutable borrow with a fresh id *) - let bid = fresh_borrow_id () in - let rv_ty = TRef (RErased, v.ty, RMut) in - let rv : typed_value = - { value = VBorrow (VMutBorrow (bid, v)); ty = rv_ty } - in - (* Compute the value with which to replace the value at place p *) - let nv = { v with value = VLoan (VMutLoan bid) } in - (* Update the value in the context *) - let ctx = write_place meta access p nv ctx in - (* Continue *) - cf rv ctx + (* Compute the rvalue - wrap the value in a mutable borrow with a fresh id *) + let bid = fresh_borrow_id () in + let rv_ty = TRef (RErased, v.ty, RMut) in + let rv : typed_value = + { value = VBorrow (VMutBorrow (bid, v)); ty = rv_ty } in - (* Compose and apply *) - comp prepare eval cf ctx - -let eval_rvalue_aggregate (config : config) (meta : Meta.meta) - (aggregate_kind : aggregate_kind) (ops : operand list) - (cf : typed_value -> m_fun) : m_fun = + (* Compute the loan value with which to replace the value at place p *) + let nv = { v with value = VLoan (VMutLoan bid) } in + (* Update the value in the context to replace it with the loan *) + let ctx = write_place span access p nv ctx in + (* Return *) + (rv, ctx, cc) + +let eval_rvalue_aggregate (config : config) (span : Meta.span) + (aggregate_kind : aggregate_kind) (ops : operand list) (ctx : eval_ctx) : + typed_value * eval_ctx * (eval_result -> eval_result) = (* Evaluate the operands *) - let eval_ops = eval_operands config meta ops in + let values, ctx, cc = eval_operands config span ops ctx in (* Compute the value *) - let compute (cf : typed_value -> m_fun) (values : typed_value list) : m_fun = - fun ctx -> + let v, cf_compute = (* Match on the aggregate kind *) match aggregate_kind with | AggregatedAdt (type_id, opt_variant_id, generics) -> ( @@ -775,23 +738,22 @@ let eval_rvalue_aggregate (config : config) (meta : Meta.meta) let generics = mk_generic_args [] tys [] [] in let ty = TAdt (TTuple, generics) in let aggregated : typed_value = { value = v; ty } in - (* Call the continuation *) - cf aggregated ctx + (aggregated, fun e -> e) | TAdtId def_id -> (* Sanity checks *) let type_decl = ctx_lookup_type_decl ctx def_id in sanity_check __FILE__ __LINE__ (List.length type_decl.generics.regions = List.length generics.regions) - meta; + span; let expected_field_types = - AssociatedTypes.ctx_adt_get_inst_norm_field_etypes meta ctx def_id + AssociatedTypes.ctx_adt_get_inst_norm_field_etypes span ctx def_id opt_variant_id generics in sanity_check __FILE__ __LINE__ (expected_field_types = List.map (fun (v : typed_value) -> v.ty) values) - meta; + span; (* Construct the value *) let av : adt_value = { variant_id = opt_variant_id; field_values = values } @@ -799,18 +761,18 @@ let eval_rvalue_aggregate (config : config) (meta : Meta.meta) let aty = TAdt (TAdtId def_id, generics) in let aggregated : typed_value = { value = VAdt av; ty = aty } in (* Call the continuation *) - cf aggregated ctx - | TAssumed _ -> craise __FILE__ __LINE__ meta "Unreachable") - | AggregatedArray (ety, cg) -> ( + (aggregated, fun e -> e) + | TAssumed _ -> craise __FILE__ __LINE__ span "Unreachable") + | AggregatedArray (ety, cg) -> (* Sanity check: all the values have the proper type *) sanity_check __FILE__ __LINE__ (List.for_all (fun (v : typed_value) -> v.ty = ety) values) - meta; + span; (* Sanity check: the number of values is consistent with the length *) let len = (literal_as_scalar (const_generic_as_literal cg)).value in sanity_check __FILE__ __LINE__ (len = Z.of_int (List.length values)) - meta; + span; let generics = TypesUtils.mk_generic_args [] [ ety ] [ cg ] [] in let ty = TAdt (TAssumed TArray, generics) in (* In order to generate a better AST, we introduce a symbolic @@ -818,56 +780,50 @@ let eval_rvalue_aggregate (config : config) (meta : Meta.meta) array we introduce here might be duplicated in the generated code: by introducing a symbolic value we introduce a let-binding in the generated code. *) - let saggregated = mk_fresh_symbolic_typed_value meta ty in - (* Call the continuation *) - match cf saggregated ctx with - | None -> None - | Some e -> - (* Introduce the symbolic value in the AST *) - let sv = ValuesUtils.value_as_symbolic meta saggregated.value in - Some (SymbolicAst.IntroSymbolic (ctx, None, sv, VaArray values, e))) + let saggregated = mk_fresh_symbolic_typed_value span ty in + (* Update the symbolic ast *) + let cf e = + match e with + | None -> None + | Some e -> + (* Introduce the symbolic value in the AST *) + let sv = ValuesUtils.value_as_symbolic span saggregated.value in + Some + (SymbolicAst.IntroSymbolic (ctx, None, sv, VaArray values, e)) + in + (saggregated, cf) | AggregatedClosure _ -> - craise __FILE__ __LINE__ meta "Closures are not supported yet" + craise __FILE__ __LINE__ span "Closures are not supported yet" in - (* Compose and apply *) - comp eval_ops compute cf + (v, ctx, cc_comp cc cf_compute) -let eval_rvalue_not_global (config : config) (meta : Meta.meta) - (rvalue : rvalue) (cf : (typed_value, eval_error) result -> m_fun) : m_fun = - fun ctx -> +let eval_rvalue_not_global (config : config) (span : Meta.span) + (rvalue : rvalue) (ctx : eval_ctx) : + (typed_value, eval_error) result * eval_ctx * (eval_result -> eval_result) = log#ldebug (lazy "eval_rvalue"); - (* Small helpers *) - let wrap_in_result (cf : (typed_value, eval_error) result -> m_fun) - (v : typed_value) : m_fun = - cf (Ok v) - in - let comp_wrap f = comp f wrap_in_result cf in + (* Small helper *) + let wrap_in_result (v, ctx, cc) = (Ok v, ctx, cc) in (* Delegate to the proper auxiliary function *) match rvalue with - | Use op -> comp_wrap (eval_operand config meta op) ctx - | RvRef (p, bkind) -> comp_wrap (eval_rvalue_ref config meta p bkind) ctx - | UnaryOp (unop, op) -> eval_unary_op config meta unop op cf ctx - | BinaryOp (binop, op1, op2) -> - eval_binary_op config meta binop op1 op2 cf ctx + | Use op -> wrap_in_result (eval_operand config span op ctx) + | RvRef (p, bkind) -> wrap_in_result (eval_rvalue_ref config span p bkind ctx) + | UnaryOp (unop, op) -> eval_unary_op config span unop op ctx + | BinaryOp (binop, op1, op2) -> eval_binary_op config span binop op1 op2 ctx | Aggregate (aggregate_kind, ops) -> - comp_wrap (eval_rvalue_aggregate config meta aggregate_kind ops) ctx + wrap_in_result (eval_rvalue_aggregate config span aggregate_kind ops ctx) | Discriminant _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Unreachable: discriminant reads should have been eliminated from the \ AST" - | Global _ -> craise __FILE__ __LINE__ meta "Unreachable" + | Global _ -> craise __FILE__ __LINE__ span "Unreachable" -let eval_fake_read (config : config) (meta : Meta.meta) (p : place) : cm_fun = - fun cf ctx -> +let eval_fake_read (config : config) (span : Meta.span) (p : place) : cm_fun = + fun ctx -> let expand_prim_copy = false in - let cf_prepare cf = - access_rplace_reorganize_and_read config meta expand_prim_copy Read p cf + let v, ctx, cc = + access_rplace_reorganize_and_read config span expand_prim_copy Read p ctx in - let cf_continue cf v : m_fun = - fun ctx -> - cassert __FILE__ __LINE__ - (not (bottom_in_value ctx.ended_regions v)) - meta "Fake read: the value contains bottom"; - cf ctx - in - comp cf_prepare cf_continue cf ctx + cassert __FILE__ __LINE__ + (not (bottom_in_value ctx.ended_regions v)) + span "Fake read: the value contains bottom"; + (ctx, cc) diff --git a/compiler/InterpreterExpressions.mli b/compiler/InterpreterExpressions.mli index 0fb12180..feb641d1 100644 --- a/compiler/InterpreterExpressions.mli +++ b/compiler/InterpreterExpressions.mli @@ -4,41 +4,28 @@ open Contexts open Cps open InterpreterPaths -(** Read a place (CPS-style function). - - We also check that the value *doesn't contain bottoms or reserved - borrows*. - - This function doesn't reorganize the context to make sure we can read - the place. If needs be, you should call {!InterpreterPaths.update_ctx_along_read_place} first. - *) -val read_place : - Meta.meta -> access_kind -> place -> (typed_value -> m_fun) -> m_fun - (** Auxiliary function. - Prepare the access to a place in a right-value (typically an operand) by - reorganizing the environment. + Prepare the access to a place in a right-value (typically an operand) by reorganizing + the environment to end outer loans, then read the value and check that this value + *doesn't contain any bottom nor reserved borrows*. We reorganize the environment so that: - we can access the place (we prepare *along* the path) - the value at the place itself doesn't contain loans (the [access_kind] controls whether we only end mutable loans, or also shared loans). - We also check, after the reorganization, that the value at the place - *doesn't contain any bottom nor reserved borrows*. - [expand_prim_copy]: if [true], expand the symbolic values which are primitively copyable and contain borrows. *) val access_rplace_reorganize_and_read : config -> - Meta.meta -> + Meta.span -> bool -> access_kind -> place -> - (typed_value -> m_fun) -> - m_fun + eval_ctx -> + typed_value * eval_ctx * (eval_result -> eval_result) (** Evaluate an operand. @@ -50,11 +37,19 @@ val access_rplace_reorganize_and_read : Use {!eval_operands} instead. *) val eval_operand : - config -> Meta.meta -> operand -> (typed_value -> m_fun) -> m_fun + config -> + Meta.span -> + operand -> + eval_ctx -> + typed_value * eval_ctx * (eval_result -> eval_result) (** Evaluate several operands at once. *) val eval_operands : - config -> Meta.meta -> operand list -> (typed_value list -> m_fun) -> m_fun + config -> + Meta.span -> + operand list -> + eval_ctx -> + typed_value list * eval_ctx * (eval_result -> eval_result) (** Evaluate an rvalue which is not a global (globals are handled elsewhere). @@ -65,10 +60,10 @@ val eval_operands : *) val eval_rvalue_not_global : config -> - Meta.meta -> + Meta.span -> rvalue -> - ((typed_value, eval_error) result -> m_fun) -> - m_fun + eval_ctx -> + (typed_value, eval_error) result * eval_ctx * (eval_result -> eval_result) (** Evaluate a fake read (update the context so that we can read a place) *) -val eval_fake_read : config -> Meta.meta -> place -> cm_fun +val eval_fake_read : config -> Meta.span -> place -> cm_fun diff --git a/compiler/InterpreterLoops.ml b/compiler/InterpreterLoops.ml index e4370367..776cb6fa 100644 --- a/compiler/InterpreterLoops.ml +++ b/compiler/InterpreterLoops.ml @@ -15,37 +15,37 @@ open Errors let log = Logging.loops_log (** Evaluate a loop in concrete mode *) -let eval_loop_concrete (meta : Meta.meta) (eval_loop_body : st_cm_fun) : - st_cm_fun = - fun cf ctx -> +let eval_loop_concrete (span : Meta.span) (eval_loop_body : stl_cm_fun) : + stl_cm_fun = + fun ctx -> (* We need a loop id for the [LoopReturn]. In practice it won't be used (it is useful only for the symbolic execution *) let loop_id = fresh_loop_id () in - (* Continuation for after we evaluate the loop body: depending the result - of doing one loop iteration: - - redoes a loop iteration - - exits the loop - - other... + (* Function to recursively evaluate the loop We need a specific function because of the {!Continue} case: in case we continue, we might have to reevaluate the current loop body with the new context (and repeat this an indefinite number of times). *) - let rec reeval_loop_body (res : statement_eval_res) : m_fun = + let rec rec_eval_loop_body (ctx : eval_ctx) (res : statement_eval_res) = log#ldebug (lazy "eval_loop_concrete: reeval_loop_body"); match res with - | Return -> cf (LoopReturn loop_id) - | Panic -> cf Panic + | Return -> [ (ctx, LoopReturn loop_id) ] + | Panic -> [ (ctx, Panic) ] | Break i -> - (* Break out of the loop by calling the continuation *) + (* Break out of the loop *) let res = if i = 0 then Unit else Break (i - 1) in - cf res + [ (ctx, res) ] | Continue 0 -> (* Re-evaluate the loop body *) - eval_loop_body reeval_loop_body + let ctx_resl, _ = eval_loop_body ctx in + let ctx_res_cfl = + List.map (fun (ctx, res) -> rec_eval_loop_body ctx res) ctx_resl + in + List.flatten ctx_res_cfl | Continue i -> (* Continue to an outer loop *) - cf (Continue (i - 1)) + [ (ctx, Continue (i - 1)) ] | Unit -> (* We can't get there. * Note that if we decide not to fail here but rather do @@ -54,24 +54,31 @@ let eval_loop_concrete (meta : Meta.meta) (eval_loop_body : st_cm_fun) : * {!Unit} would account for the first iteration of the loop. * We prefer to write it this way for consistency and sanity, * though. *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> (* We can't get there: this is only used in symbolic mode *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in - (* Apply *) - eval_loop_body reeval_loop_body ctx + (* Apply - for the first iteration, we use the result `Continue 0` to evaluate + the loop body at least once *) + let ctx_resl = rec_eval_loop_body ctx (Continue 0) in + (* If we evaluate in concrete mode, we shouldn't have to generate any symbolic expression *) + let cf el = + sanity_check __FILE__ __LINE__ (el = None) span; + None + in + (ctx_resl, cf) (** Evaluate a loop in symbolic mode *) -let eval_loop_symbolic (config : config) (meta : meta) - (eval_loop_body : st_cm_fun) : st_cm_fun = - fun cf ctx -> +let eval_loop_symbolic (config : config) (span : span) + (eval_loop_body : stl_cm_fun) : stl_cm_fun = + fun ctx -> (* Debug *) log#ldebug (lazy ("eval_loop_symbolic:\nContext:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); (* Generate a fresh loop id *) @@ -79,20 +86,20 @@ let eval_loop_symbolic (config : config) (meta : meta) (* Compute the fixed point at the loop entrance *) let fp_ctx, fixed_ids, rg_to_abs = - compute_loop_entry_fixed_point config meta loop_id eval_loop_body ctx + compute_loop_entry_fixed_point config span loop_id eval_loop_body ctx in (* Debug *) log#ldebug (lazy ("eval_loop_symbolic:\nInitial context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\nFixed point:\n" - ^ eval_ctx_to_string ~meta:(Some meta) fp_ctx)); + ^ eval_ctx_to_string ~span:(Some span) fp_ctx)); (* Compute the loop input parameters *) let fresh_sids, input_svalues = - compute_fp_ctx_symbolic_values meta ctx fp_ctx + compute_fp_ctx_symbolic_values span ctx fp_ctx in let fp_input_svalues = List.map (fun sv -> sv.sv_id) input_svalues in @@ -100,21 +107,22 @@ let eval_loop_symbolic (config : config) (meta : meta) loop entry with the fixed point: in the synthesized code, the function will end with a call to the loop translation *) - (* First, preemptively end borrows/move values by matching the current - context with the target context *) - let cf_prepare_ctx cf ctx = - log#ldebug - (lazy - ("eval_loop_symbolic: about to reorganize the original context to \ - match the fixed-point ctx with it:\n\ - - src ctx (fixed-point ctx):\n" ^ eval_ctx_to_string fp_ctx - ^ "\n\n-tgt ctx (original context):\n" ^ eval_ctx_to_string ctx)); + let ((res_fun_end, cf_fun_end), fp_bl_corresp) : + ((eval_ctx * statement_eval_res) * (eval_result -> eval_result)) * _ = + (* First, preemptively end borrows/move values by matching the current + context with the target context *) + let ctx, cf_prepare = + log#ldebug + (lazy + ("eval_loop_symbolic: about to reorganize the original context to \ + match the fixed-point ctx with it:\n\ + - src ctx (fixed-point ctx):\n" ^ eval_ctx_to_string fp_ctx + ^ "\n\n-tgt ctx (original context):\n" ^ eval_ctx_to_string ctx)); - prepare_match_ctx_with_target config meta loop_id fixed_ids fp_ctx cf ctx - in + prepare_match_ctx_with_target config span loop_id fixed_ids fp_ctx ctx + in - (* Actually match *) - let cf_match_ctx cf ctx = + (* Actually match *) log#ldebug (lazy ("eval_loop_symbolic: about to compute the id correspondance between \ @@ -124,96 +132,122 @@ let eval_loop_symbolic (config : config) (meta : meta) (* Compute the id correspondance between the contexts *) let fp_bl_corresp = - compute_fixed_point_id_correspondance meta fixed_ids ctx fp_ctx + compute_fixed_point_id_correspondance span fixed_ids ctx fp_ctx in log#ldebug (lazy ("eval_loop_symbolic: about to match the fixed-point context with the \ original context:\n\ - src ctx (fixed-point ctx)" - ^ eval_ctx_to_string ~meta:(Some meta) fp_ctx + ^ eval_ctx_to_string ~span:(Some span) fp_ctx ^ "\n\n-tgt ctx (original context):\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - let end_expr : SymbolicAst.expression option = - match_ctx_with_target config meta loop_id true fp_bl_corresp - fp_input_svalues fixed_ids fp_ctx cf ctx + ^ eval_ctx_to_string ~span:(Some span) ctx)); + + (* Compute the end expression, that is the expresion corresponding to the + end of the functin where we call the loop (for now, when calling a loop + we never get out) *) + let res_fun_end = + comp cf_prepare + (match_ctx_with_target config span loop_id true fp_bl_corresp + fp_input_svalues fixed_ids fp_ctx ctx) in - log#ldebug - (lazy - "eval_loop_symbolic: matched the fixed-point context with the original \ - context"); - - (* Synthesize the loop body by evaluating it, with the continuation for - after the loop starting at the *fixed point*, but with a special - treatment for the [Break] and [Continue] cases *) - let cf_loop : st_m_fun = - fun res ctx -> - log#ldebug (lazy "eval_loop_symbolic: cf_loop"); + (res_fun_end, fp_bl_corresp) + in + log#ldebug + (lazy + "eval_loop_symbolic: matched the fixed-point context with the original \ + context"); + + (* Synthesize the loop body *) + let (resl_loop_body, cf_loop_body) : + (eval_ctx * statement_eval_res) list + * (SymbolicAst.expression list option -> eval_result) = + (* First, evaluate the loop body starting from the **fixed-point** context *) + let ctx_resl, cf_loop = eval_loop_body fp_ctx in + + (* Then, do a special treatment of the break and continue cases. + For now, we forbid having breaks in loops (and eliminate breaks + in the prepasses) *) + let eval_after_loop_iter (ctx, res) = + log#ldebug (lazy "eval_loop_symbolic: eval_after_loop_iter"); match res with | Return -> (* We replace the [Return] with a [LoopReturn] *) - cf (LoopReturn loop_id) ctx - | Panic -> cf res ctx - | Break i -> - (* Break out of the loop by calling the continuation *) - let res = if i = 0 then Unit else Break (i - 1) in - cf res ctx + ((ctx, LoopReturn loop_id), fun e -> e) + | Panic -> ((ctx, res), fun e -> e) + | Break _ -> + (* Breaks should have been eliminated in the prepasses *) + craise __FILE__ __LINE__ span "Unexpected break" | Continue i -> (* We don't support nested loops for now *) - cassert __FILE__ __LINE__ (i = 0) meta + cassert __FILE__ __LINE__ (i = 0) span "Nested loops are not supported yet"; log#ldebug (lazy ("eval_loop_symbolic: about to match the fixed-point context \ with the context at a continue:\n\ - src ctx (fixed-point ctx)" - ^ eval_ctx_to_string ~meta:(Some meta) fp_ctx + ^ eval_ctx_to_string ~span:(Some span) fp_ctx ^ "\n\n-tgt ctx (ctx at continue):\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - let cc = - match_ctx_with_target config meta loop_id false fp_bl_corresp - fp_input_svalues fixed_ids fp_ctx - in - cc cf ctx + ^ eval_ctx_to_string ~span:(Some span) ctx)); + match_ctx_with_target config span loop_id false fp_bl_corresp + fp_input_svalues fixed_ids fp_ctx ctx | Unit | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> (* For why we can't get [Unit], see the comments inside {!eval_loop_concrete}. For [EndEnterLoop] and [EndContinue]: we don't support nested loops for now. *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in - let loop_expr = eval_loop_body cf_loop fp_ctx in - log#ldebug - (lazy - ("eval_loop_symbolic: result:" ^ "\n- src context:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx - ^ "\n- fixed point:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) fp_ctx - ^ "\n- fixed_sids: " - ^ SymbolicValueId.Set.show fixed_ids.sids - ^ "\n- fresh_sids: " - ^ SymbolicValueId.Set.show fresh_sids - ^ "\n- input_svalues: " - ^ Print.list_to_string (symbolic_value_to_string ctx) input_svalues - ^ "\n\n")); - - (* For every abstraction introduced by the fixed-point, compute the - types of the given back values. - - We need to explore the abstractions, looking for the mutable borrows. - Moreover, we list the borrows in the same order as the loans (this - is important in {!SymbolicToPure}, where we expect the given back - values to have a specific order. - - Also, we filter the backward functions which and - return nothing. - *) + (* Apply and compose *) + let ctx_resl, cfl = List.split (List.map eval_after_loop_iter ctx_resl) in + let cc (el : SymbolicAst.expression list option) : eval_result = + match el with + | None -> None + | Some el -> + let el = + List.map + (fun (cf, e) -> Option.get (cf (Some e))) + (List.combine cfl el) + in + cf_loop (Some el) + in + + (ctx_resl, cc) + in + + log#ldebug + (lazy + ("eval_loop_symbolic: result:" ^ "\n- src context:\n" + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx + ^ "\n- fixed point:\n" + ^ eval_ctx_to_string_no_filter ~span:(Some span) fp_ctx + ^ "\n- fixed_sids: " + ^ SymbolicValueId.Set.show fixed_ids.sids + ^ "\n- fresh_sids: " + ^ SymbolicValueId.Set.show fresh_sids + ^ "\n- input_svalues: " + ^ Print.list_to_string (symbolic_value_to_string ctx) input_svalues + ^ "\n\n")); + + (* For every abstraction introduced by the fixed-point, compute the + types of the given back values. + + We need to explore the abstractions, looking for the mutable borrows. + Moreover, we list the borrows in the same order as the loans (this + is important in {!SymbolicToPure}, where we expect the given back + values to have a specific order. + + Also, we filter the backward functions which and + return nothing. + *) + let rg_to_given_back = let compute_abs_given_back_tys (abs : abs) : rty list = let is_borrow (av : typed_avalue) : bool = match av.value with | ABorrow _ -> true | ALoan _ -> false - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in let borrows, loans = List.partition is_borrow abs.avalues in @@ -222,10 +256,10 @@ let eval_loop_symbolic (config : config) (meta : meta) (fun (av : typed_avalue) -> match av.value with | ABorrow (AMutBorrow (bid, child_av)) -> - sanity_check __FILE__ __LINE__ (is_aignored child_av.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child_av.value) span; Some (bid, child_av.ty) | ABorrow (ASharedBorrow _) -> None - | _ -> craise __FILE__ __LINE__ meta "Unreachable") + | _ -> craise __FILE__ __LINE__ span "Unreachable") borrows in let borrows = ref (BorrowId.Map.of_list borrows) in @@ -235,10 +269,10 @@ let eval_loop_symbolic (config : config) (meta : meta) (fun (av : typed_avalue) -> match av.value with | ALoan (AMutLoan (bid, child_av)) -> - sanity_check __FILE__ __LINE__ (is_aignored child_av.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child_av.value) span; Some bid | ALoan (ASharedLoan _) -> None - | _ -> craise __FILE__ __LINE__ meta "Unreachable") + | _ -> craise __FILE__ __LINE__ span "Unreachable") loans in @@ -254,30 +288,39 @@ let eval_loop_symbolic (config : config) (meta : meta) ty) loan_ids in - sanity_check __FILE__ __LINE__ (BorrowId.Map.is_empty !borrows) meta; + sanity_check __FILE__ __LINE__ (BorrowId.Map.is_empty !borrows) span; given_back_tys in - let rg_to_given_back = - RegionGroupId.Map.map compute_abs_given_back_tys rg_to_abs - in + RegionGroupId.Map.map compute_abs_given_back_tys rg_to_abs + in - (* Put together *) - S.synthesize_loop loop_id input_svalues fresh_sids rg_to_given_back end_expr - loop_expr meta + (* Put everything together *) + let cc (el : SymbolicAst.expression list option) = + match el with + | None -> None + | Some el -> ( + match el with + | [] -> internal_error __FILE__ __LINE__ span + | e :: el -> + let fun_end_expr = cf_fun_end (Some e) in + let loop_expr = cf_loop_body (Some el) in + S.synthesize_loop loop_id input_svalues fresh_sids rg_to_given_back + fun_end_expr loop_expr span) in - (* Compose *) - comp cf_prepare_ctx cf_match_ctx cf ctx + (res_fun_end :: resl_loop_body, cc) -let eval_loop (config : config) (meta : meta) (eval_loop_body : st_cm_fun) : - st_cm_fun = - fun cf ctx -> +let eval_loop (config : config) (span : span) (eval_loop_body : stl_cm_fun) : + stl_cm_fun = + fun ctx -> match config.mode with - | ConcreteMode -> eval_loop_concrete meta eval_loop_body cf ctx + | ConcreteMode -> (eval_loop_concrete span eval_loop_body) ctx | SymbolicMode -> (* Simplify the context by ending the unnecessary borrows/loans and getting rid of the useless symbolic values (which are in anonymous variables) *) - let cc = cleanup_fresh_values_and_abs config meta empty_ids_set in + let ctx, cc = + cleanup_fresh_values_and_abs config span empty_ids_set ctx + in (* We want to make sure the loop will *not* manipulate shared avalues containing themselves shared loans (i.e., nested shared loans in @@ -297,5 +340,5 @@ let eval_loop (config : config) (meta : meta) (eval_loop_body : st_cm_fun) : introduce *fixed* abstractions, and again later to introduce *non-fixed* abstractions. *) - let cc = comp cc (prepare_ashared_loans meta None) in - comp cc (eval_loop_symbolic config meta eval_loop_body) cf ctx + let ctx, cc = comp cc (prepare_ashared_loans span None ctx) in + comp cc (eval_loop_symbolic config span eval_loop_body ctx) diff --git a/compiler/InterpreterLoops.mli b/compiler/InterpreterLoops.mli index 03633861..567250af 100644 --- a/compiler/InterpreterLoops.mli +++ b/compiler/InterpreterLoops.mli @@ -60,5 +60,9 @@ open Contexts open Cps open Meta -(** Evaluate a loop *) -val eval_loop : config -> meta -> st_cm_fun -> st_cm_fun +(** Evaluate a loop. + + The `stl_cm_fun` required as input must be the function to evaluate the + loop body (i.e., `eval_statement` applied to the loop body). + *) +val eval_loop : config -> span -> stl_cm_fun -> stl_cm_fun diff --git a/compiler/InterpreterLoopsCore.ml b/compiler/InterpreterLoopsCore.ml index a5b3a021..991f259f 100644 --- a/compiler/InterpreterLoopsCore.ml +++ b/compiler/InterpreterLoopsCore.ml @@ -53,7 +53,7 @@ type abs_borrows_loans_maps = { regions. *) module type PrimMatcher = sig - val meta : Meta.meta + val span : Meta.span val match_etys : eval_ctx -> eval_ctx -> ety -> ety -> ety val match_rtys : eval_ctx -> eval_ctx -> rty -> rty -> rty @@ -65,7 +65,7 @@ module type PrimMatcher = sig val match_distinct_adts : eval_ctx -> eval_ctx -> ety -> adt_value -> adt_value -> typed_value - (** The meta-value is the result of a match. + (** The span-value is the result of a match. We take an additional function as input, which acts as a matcher over typed values, to be able to lookup the shared values and match them. @@ -256,7 +256,7 @@ module type PrimMatcher = sig end module type Matcher = sig - val meta : Meta.meta + val span : Meta.span (** Match two values. @@ -279,7 +279,7 @@ end Very annoying: functors only take modules as inputs... *) module type MatchCheckEquivState = sig - val meta : Meta.meta + val span : Meta.span (** [true] if we check equivalence between contexts, [false] if we match a source context with a target context. *) @@ -351,7 +351,7 @@ module type MatchJoinState = sig (** The abstractions introduced when performing the matches *) val nabs : abs list ref - val meta : Meta.meta + val span : Meta.span end (** Split an environment between the fixed abstractions, values, etc. and @@ -359,7 +359,7 @@ end Returns: (fixed, new abs, new dummies) *) -let ctx_split_fixed_new (meta : Meta.meta) (fixed_ids : ids_sets) +let ctx_split_fixed_new (span : Meta.span) (fixed_ids : ids_sets) (ctx : eval_ctx) : env * abs list * typed_value list = let is_fresh_did (id : DummyVarId.id) : bool = not (DummyVarId.Set.mem id fixed_ids.dids) @@ -383,7 +383,7 @@ let ctx_split_fixed_new (meta : Meta.meta) (fixed_ids : ids_sets) (fun ee -> match ee with | EAbs abs -> abs - | _ -> craise __FILE__ __LINE__ meta "Unreachable") + | _ -> craise __FILE__ __LINE__ span "Unreachable") new_absl in let new_dummyl = @@ -391,7 +391,7 @@ let ctx_split_fixed_new (meta : Meta.meta) (fixed_ids : ids_sets) (fun ee -> match ee with | EBinding (BDummy _, v) -> v - | _ -> craise __FILE__ __LINE__ meta "Unreachable") + | _ -> craise __FILE__ __LINE__ span "Unreachable") new_dummyl in (filt_env, new_absl, new_dummyl) diff --git a/compiler/InterpreterLoopsFixedPoint.ml b/compiler/InterpreterLoopsFixedPoint.ml index 9ff2fe38..1a0bb090 100644 --- a/compiler/InterpreterLoopsFixedPoint.ml +++ b/compiler/InterpreterLoopsFixedPoint.ml @@ -23,9 +23,9 @@ exception FoundAbsId of AbstractionId.id - end the borrows which appear in fresh anonymous values and don't contain loans - end the fresh region abstractions which can be ended (no loans) *) -let rec end_useless_fresh_borrows_and_abs (config : config) (meta : Meta.meta) +let rec end_useless_fresh_borrows_and_abs (config : config) (span : Meta.span) (fixed_ids : ids_sets) : cm_fun = - fun cf ctx -> + fun ctx -> let rec explore_env (env : env) : unit = match env with | [] -> () (* Done *) @@ -56,7 +56,7 @@ let rec end_useless_fresh_borrows_and_abs (config : config) (meta : Meta.meta) | EAbs abs :: env when not (AbstractionId.Set.mem abs.abs_id fixed_ids.aids) -> ( (* Check if it is possible to end the abstraction: if yes, raise an exception *) - let opt_loan = get_first_non_ignored_aloan_in_abstraction meta abs in + let opt_loan = get_first_non_ignored_aloan_in_abstraction span abs in match opt_loan with | None -> (* No remaining loans: we can end the abstraction *) @@ -66,24 +66,23 @@ let rec end_useless_fresh_borrows_and_abs (config : config) (meta : Meta.meta) explore_env env) | _ :: env -> explore_env env in - let rec_call = end_useless_fresh_borrows_and_abs config meta fixed_ids in + let rec_call = end_useless_fresh_borrows_and_abs config span fixed_ids in try (* Explore the environment *) explore_env ctx.env; - (* No exception raised: call the continuation *) - cf ctx + (* No exception raised: simply continue *) + (ctx, fun e -> e) with | FoundAbsId abs_id -> - let cc = end_abstraction config meta abs_id in - comp cc rec_call cf ctx + let ctx, cc = end_abstraction config span abs_id ctx in + comp cc (rec_call ctx) | FoundBorrowId bid -> - let cc = end_borrow config meta bid in - comp cc rec_call cf ctx + let ctx, cc = end_borrow config span bid ctx in + comp cc (rec_call ctx) (* Explore the fresh anonymous values and replace all the values which are not borrows/loans with ⊥ *) -let cleanup_fresh_values (fixed_ids : ids_sets) : cm_fun = - fun cf ctx -> +let cleanup_fresh_values (fixed_ids : ids_sets) (ctx : eval_ctx) : eval_ctx = let rec explore_env (env : env) : env = match env with | [] -> [] (* Done *) @@ -112,8 +111,7 @@ let cleanup_fresh_values (fixed_ids : ids_sets) : cm_fun = EBinding (BDummy vid, v) :: env | x :: env -> x :: explore_env env in - let ctx = { ctx with env = explore_env ctx.env } in - cf ctx + { ctx with env = explore_env ctx.env } (* Repeat until we can't simplify the context anymore: - explore the fresh anonymous values and replace all the values which are not @@ -121,13 +119,12 @@ let cleanup_fresh_values (fixed_ids : ids_sets) : cm_fun = - also end the borrows which appear in fresh anonymous values and don't contain loans - end the fresh region abstractions which can be ended (no loans) *) -let cleanup_fresh_values_and_abs (config : config) (meta : Meta.meta) +let cleanup_fresh_values_and_abs (config : config) (span : Meta.span) (fixed_ids : ids_sets) : cm_fun = - fun cf ctx -> - comp - (end_useless_fresh_borrows_and_abs config meta fixed_ids) - (cleanup_fresh_values fixed_ids) - cf ctx + fun ctx -> + let ctx, cc = end_useless_fresh_borrows_and_abs config span fixed_ids ctx in + let ctx = cleanup_fresh_values fixed_ids ctx in + (ctx, cc) (** Reorder the loans and borrows in the fresh abstractions. @@ -136,7 +133,7 @@ let cleanup_fresh_values_and_abs (config : config) (meta : Meta.meta) called typically after we merge abstractions together (see {!collapse_ctx} for instance). *) -let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) +let reorder_loans_borrows_in_fresh_abs (span : Meta.span) (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx = let reorder_in_fresh_abs (abs : abs) : abs = (* Split between the loans and borrows *) @@ -144,7 +141,7 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) match av.value with | ABorrow _ -> true | ALoan _ -> false - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in let aborrows, aloans = List.partition is_borrow abs.avalues in @@ -157,13 +154,13 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) let get_borrow_id (av : typed_avalue) : BorrowId.id = match av.value with | ABorrow (AMutBorrow (bid, _) | ASharedBorrow bid) -> bid - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in let get_loan_id (av : typed_avalue) : BorrowId.id = match av.value with | ALoan (AMutLoan (lid, _)) -> lid | ALoan (ASharedLoan (lids, _, _)) -> BorrowId.Set.min_elt lids - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in (* We use ordered maps to reorder the borrows and loans *) let reorder (get_bid : typed_avalue -> BorrowId.id) @@ -187,9 +184,9 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) { ctx with env } -let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : +let prepare_ashared_loans (span : Meta.span) (loop_id : LoopId.id option) : cm_fun = - fun cf ctx0 -> + fun ctx0 -> let ctx = ctx0 in (* Compute the set of borrows which appear in the abstractions, so that we can filter the borrows that we reborrow. @@ -216,7 +213,7 @@ let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : (* Remove the shared loans *) let v = value_remove_shared_loans v in (* Substitute the symbolic values and the region *) - Substitute.typed_value_subst_ids meta + Substitute.typed_value_subst_ids span (fun r -> if RegionId.Set.mem r rids then nrid else r) (fun x -> x) (fun x -> x) @@ -268,32 +265,32 @@ let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : borrow_substs := (lid, nlid) :: !borrow_substs; (* Rem.: the below sanity checks are not really necessary *) - sanity_check __FILE__ __LINE__ (AbstractionId.Set.is_empty abs.parents) meta; - sanity_check __FILE__ __LINE__ (abs.original_parents = []) meta; + sanity_check __FILE__ __LINE__ (AbstractionId.Set.is_empty abs.parents) span; + sanity_check __FILE__ __LINE__ (abs.original_parents = []) span; sanity_check __FILE__ __LINE__ (RegionId.Set.is_empty abs.ancestors_regions) - meta; + span; (* Introduce the new abstraction for the shared values *) - cassert __FILE__ __LINE__ (ty_no_regions sv.ty) meta + cassert __FILE__ __LINE__ (ty_no_regions sv.ty) span "Nested borrows are not supported yet"; let rty = sv.ty in (* Create the shared loan child *) let child_rty = rty in - let child_av = mk_aignored meta child_rty in + let child_av = mk_aignored span child_rty in (* Create the shared loan *) let loan_rty = TRef (RFVar nrid, rty, RShared) in let loan_value = ALoan (ASharedLoan (BorrowId.Set.singleton nlid, nsv, child_av)) in - let loan_value = mk_typed_avalue meta loan_rty loan_value in + let loan_value = mk_typed_avalue span loan_rty loan_value in (* Create the shared borrow *) let borrow_rty = loan_rty in let borrow_value = ABorrow (ASharedBorrow lid) in - let borrow_value = mk_typed_avalue meta borrow_rty borrow_value in + let borrow_value = mk_typed_avalue span borrow_rty borrow_value in (* Create the abstraction *) let avalues = [ borrow_value; loan_value ] in @@ -327,7 +324,7 @@ let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : let collect_shared_values_in_abs (abs : abs) : unit = let collect_shared_value lids (sv : typed_value) = (* Sanity check: we don't support nested borrows for now *) - sanity_check __FILE__ __LINE__ (not (value_has_borrows ctx sv.value)) meta; + sanity_check __FILE__ __LINE__ (not (value_has_borrows ctx sv.value)) span; (* Filter the loan ids whose corresponding borrows appear in abstractions (see the documentation of the function) *) @@ -363,7 +360,7 @@ let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : method! visit_symbolic_value env sv = cassert __FILE__ __LINE__ (not (symbolic_value_has_borrows ctx sv)) - meta + span "There should be no symbolic values with borrows inside the \ abstraction"; super#visit_symbolic_value env sv @@ -427,34 +424,30 @@ let prepare_ashared_loans (meta : Meta.meta) (loop_id : LoopId.id option) : let _, new_ctx_ids_map = compute_ctx_ids ctx in (* Synthesize *) - match cf ctx with - | None -> None - | Some e -> - (* Add the let-bindings which introduce the fresh symbolic values *) - Some - (List.fold_left - (fun e (sid, v) -> - let v = mk_typed_value_from_symbolic_value v in - let sv = - SymbolicValueId.Map.find sid new_ctx_ids_map.sids_to_values - in - SymbolicAst.IntroSymbolic (ctx, None, sv, VaSingleValue v, e)) - e !sid_subst) - -let prepare_ashared_loans_no_synth (meta : Meta.meta) (loop_id : LoopId.id) + let cf e = + match e with + | None -> None + | Some e -> + (* Add the let-bindings which introduce the fresh symbolic values *) + Some + (List.fold_left + (fun e (sid, v) -> + let v = mk_typed_value_from_symbolic_value v in + let sv = + SymbolicValueId.Map.find sid new_ctx_ids_map.sids_to_values + in + SymbolicAst.IntroSymbolic (ctx, None, sv, VaSingleValue v, e)) + e !sid_subst) + in + (ctx, cf) + +let prepare_ashared_loans_no_synth (span : Meta.span) (loop_id : LoopId.id) (ctx : eval_ctx) : eval_ctx = - get_cf_ctx_no_synth meta (prepare_ashared_loans meta (Some loop_id)) ctx + fst (prepare_ashared_loans span (Some loop_id) ctx) -let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) - (loop_id : LoopId.id) (eval_loop_body : st_cm_fun) (ctx0 : eval_ctx) : +let compute_loop_entry_fixed_point (config : config) (span : Meta.span) + (loop_id : LoopId.id) (eval_loop_body : stl_cm_fun) (ctx0 : eval_ctx) : eval_ctx * ids_sets * abs RegionGroupId.Map.t = - (* The continuation for when we exit the loop - we register the - environments upon loop *reentry*, and synthesize nothing by - returning [None] - *) - let ctxs = ref [] in - let register_ctx ctx = ctxs := ctx :: !ctxs in - (* Introduce "reborrows" for the shared values in the abstractions, so that the shared values in the fixed abstractions never get modified (technically, they are immutable, but in practice we can introduce more shared loans, or @@ -462,37 +455,18 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) For more details, see the comments for {!prepare_ashared_loans} *) - let ctx = prepare_ashared_loans_no_synth meta loop_id ctx0 in + let ctx = prepare_ashared_loans_no_synth span loop_id ctx0 in (* Debug *) log#ldebug (lazy ("compute_loop_entry_fixed_point: after prepare_ashared_loans:" ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx0 + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx0 ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx ^ "\n\n")); - let cf_exit_loop_body (res : statement_eval_res) : m_fun = - fun ctx -> - log#ldebug (lazy "compute_loop_entry_fixed_point: cf_exit_loop_body"); - match res with - | Return | Panic | Break _ -> None - | Unit -> - (* See the comment in {!eval_loop} *) - craise __FILE__ __LINE__ meta "Unreachable" - | Continue i -> - (* For now we don't support continues to outer loops *) - cassert __FILE__ __LINE__ (i = 0) meta - "Continues to outer loops not supported yet"; - register_ctx ctx; - None - | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> - (* We don't support nested loops for now *) - craise __FILE__ __LINE__ meta "Nested loops are not supported for now" - in - (* The fixed ids. They are the ids of the original ctx, after we ended the borrows/loans which end during the first loop iteration (we do one loop iteration, then set it to [Some]). @@ -502,27 +476,30 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) (* Join the contexts at the loop entry - ctx1 is the current joined context (the context at the loop entry, after we called {!prepare_ashared_loans}, if this is the first iteration) *) - let join_ctxs (ctx1 : eval_ctx) : eval_ctx = + let join_ctxs (ctx1 : eval_ctx) (ctxs : eval_ctx list) : eval_ctx = log#ldebug (lazy "compute_loop_entry_fixed_point: join_ctxs"); (* If this is the first iteration, end the borrows/loans/abs which appear in ctx1 and not in the other contexts, then compute the set of fixed ids. This means those borrows/loans have to end - in the loop, and we rather end them *before* the loop. *) - let ctx1 = + in the loop, and we rather end them *before* the loop. + + We also end those borrows in the collected contexts. + *) + let ctx1, ctxs = match !fixed_ids with - | Some _ -> ctx1 + | Some _ -> (ctx1, ctxs) | None -> let old_ids, _ = compute_ctx_ids ctx1 in - let new_ids, _ = compute_ctxs_ids !ctxs in + let new_ids, _ = compute_ctxs_ids ctxs in let blids = BorrowId.Set.diff old_ids.blids new_ids.blids in let aids = AbstractionId.Set.diff old_ids.aids new_ids.aids in (* End those borrows and abstractions *) let end_borrows_abs blids aids ctx = let ctx = - InterpreterBorrows.end_borrows_no_synth config meta blids ctx + InterpreterBorrows.end_borrows_no_synth config span blids ctx in let ctx = - InterpreterBorrows.end_abstractions_no_synth config meta aids ctx + InterpreterBorrows.end_abstractions_no_synth config span aids ctx in ctx in @@ -542,21 +519,20 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) others didn't. As we need to end those borrows anyway (the join will detect them and ask to end them) we do it preemptively. *) - ctxs := List.map (end_borrows_abs blids aids) !ctxs; + let ctxs = List.map (end_borrows_abs blids aids) ctxs in (* Note that the fixed ids are given by the original context, from *before* we introduce fresh abstractions/reborrows for the shared values *) fixed_ids := Some (fst (compute_ctx_ids ctx0)); - ctx1 + (ctx1, ctxs) in let fixed_ids = Option.get !fixed_ids in (* Join the context with the context at the loop entry *) let (_, _), ctx2 = - loop_join_origin_with_continue_ctxs config meta loop_id fixed_ids ctx1 - !ctxs + loop_join_origin_with_continue_ctxs config span loop_id fixed_ids ctx1 + ctxs in - ctxs := []; ctx2 in log#ldebug (lazy "compute_loop_entry_fixed_point: after join_ctxs"); @@ -584,31 +560,66 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) log#ldebug (lazy "compute_fixed_point: equiv_ctx:"); let fixed_ids = compute_fixed_ids [ ctx1; ctx2 ] in let check_equivalent = true in - let lookup_shared_value _ = craise __FILE__ __LINE__ meta "Unreachable" in + let lookup_shared_value _ = craise __FILE__ __LINE__ span "Unreachable" in Option.is_some - (match_ctxs meta check_equivalent fixed_ids lookup_shared_value + (match_ctxs span check_equivalent fixed_ids lookup_shared_value lookup_shared_value ctx1 ctx2) in let max_num_iter = Config.loop_fixed_point_max_num_iters in let rec compute_fixed_point (ctx : eval_ctx) (i0 : int) (i : int) : eval_ctx = if i = 0 then - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Could not compute a loop fixed point in " ^ string_of_int i0 ^ " iterations") else (* Evaluate the loop body to register the different contexts upon reentry *) - let _ = eval_loop_body cf_exit_loop_body ctx in + let ctx_resl, _ = eval_loop_body ctx in + (* Keep only the contexts which reached a `continue`. *) + let keep_continue_ctx (ctx, res) = + log#ldebug + (lazy "compute_loop_entry_fixed_point: register_continue_ctx"); + match res with + | Return | Panic | Break _ -> None + | Unit -> + (* See the comment in {!eval_loop} *) + craise __FILE__ __LINE__ span "Unreachable" + | Continue i -> + (* For now we don't support continues to outer loops *) + cassert __FILE__ __LINE__ (i = 0) span + "Continues to outer loops not supported yet"; + Some ctx + | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> + (* We don't support nested loops for now *) + craise __FILE__ __LINE__ span + "Nested loops are not supported for now" + in + let continue_ctxs = List.filter_map keep_continue_ctx ctx_resl in + + log#ldebug + (lazy + ("compute_fixed_point: about to join with continue_ctx" + ^ "\n\n- ctx0:\n" + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx + ^ "\n\n" + ^ String.concat "\n\n" + (List.map + (fun ctx -> + "- continue_ctx:\n" + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx) + continue_ctxs) + ^ "\n\n")); + (* Compute the join between the original contexts and the contexts computed upon reentry *) - let ctx1 = join_ctxs ctx in + let ctx1 = join_ctxs ctx continue_ctxs in (* Debug *) log#ldebug (lazy - ("compute_fixed_point:" ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx + ("compute_fixed_point: after joining continue ctxs" ^ "\n\n- ctx0:\n" + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx1 + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx1 ^ "\n\n")); (* Check if we reached a fixed point: if not, iterate *) @@ -621,7 +632,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) (lazy ("compute_fixed_point: fixed point computed before matching with input \ region groups:" ^ "\n\n- fp:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) fp + ^ eval_ctx_to_string_no_filter ~span:(Some span) fp ^ "\n\n")); (* Make sure we have exactly one loop abstraction per function region (merge @@ -643,10 +654,10 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) method! visit_abs _ abs = match abs.kind with | Loop (loop_id', _, kind) -> - sanity_check __FILE__ __LINE__ (loop_id' = loop_id) meta; - sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) meta; + sanity_check __FILE__ __LINE__ (loop_id' = loop_id) span; + sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) span; (* The abstractions introduced so far should be endable *) - sanity_check __FILE__ __LINE__ (abs.can_end = true) meta; + sanity_check __FILE__ __LINE__ (abs.can_end = true) span; add_aid abs.abs_id; abs | _ -> abs @@ -670,21 +681,18 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) let aids = AbstractionId.Set.union aids aids' in fp_ended_aids := RegionGroupId.Map.add rg_id aids !fp_ended_aids in - let cf_loop : st_m_fun = - fun res ctx -> + let end_at_return (ctx, res) = log#ldebug (lazy "compute_loop_entry_fixed_point: cf_loop"); match res with - | Continue _ | Panic -> - (* We don't want to generate anything *) - None + | Continue _ | Panic -> () | Break _ -> (* We enforce that we can't get there: see {!PrePasses.remove_loop_breaks} *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Unit | LoopReturn _ | EndEnterLoop _ | EndContinue _ -> (* For why we can't get [Unit], see the comments inside {!eval_loop_concrete}. For [EndEnterLoop] and [EndContinue]: we don't support nested loops for now. *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Return -> log#ldebug (lazy "compute_loop_entry_fixed_point: cf_loop: Return"); (* Should we consume the return value and pop the frame? @@ -692,36 +700,30 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) * indeed the correct one, I think it is sound to under-approximate here * (and it shouldn't make any difference). *) - let _ = - List.iter - (fun rg_id -> - (* Lookup the input abstraction - we use the fact that the - abstractions should have been introduced in a specific - order (and we check that it is indeed the case) *) - let abs_id = - AbstractionId.of_int (RegionGroupId.to_int rg_id) - in - (* By default, the [SynthInput] abs can't end *) - let ctx = ctx_set_abs_can_end meta ctx abs_id true in - sanity_check __FILE__ __LINE__ - (let abs = ctx_lookup_abs ctx abs_id in - abs.kind = SynthInput rg_id) - meta; - (* End this abstraction *) - let ctx = - InterpreterBorrows.end_abstraction_no_synth config meta abs_id - ctx - in - (* Explore the context, and check which abstractions are not there anymore *) - let ids, _ = compute_ctx_ids ctx in - let ended_ids = AbstractionId.Set.diff !fp_aids ids.aids in - add_ended_aids rg_id ended_ids) - ctx.region_groups - in - (* We don't want to generate anything *) - None + List.iter + (fun rg_id -> + (* Lookup the input abstraction - we use the fact that the + abstractions should have been introduced in a specific + order (and we check that it is indeed the case) *) + let abs_id = AbstractionId.of_int (RegionGroupId.to_int rg_id) in + (* By default, the [SynthInput] abs can't end *) + let ctx = ctx_set_abs_can_end span ctx abs_id true in + sanity_check __FILE__ __LINE__ + (let abs = ctx_lookup_abs ctx abs_id in + abs.kind = SynthInput rg_id) + span; + (* End this abstraction *) + let ctx = + InterpreterBorrows.end_abstraction_no_synth config span abs_id + ctx + in + (* Explore the context, and check which abstractions are not there anymore *) + let ids, _ = compute_ctx_ids ctx in + let ended_ids = AbstractionId.Set.diff !fp_aids ids.aids in + add_ended_aids rg_id ended_ids) + ctx.region_groups in - let _ = eval_loop_body cf_loop fp in + List.iter end_at_return (fst (eval_loop_body fp)); (* Check that the sets of abstractions we need to end per region group are pairwise * disjoint *) @@ -731,7 +733,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) (fun _ ids -> cassert __FILE__ __LINE__ (AbstractionId.Set.disjoint !aids_union ids) - meta + span "The sets of abstractions we need to end per region group are not \ pairwise disjoint"; aids_union := AbstractionId.Set.union ids !aids_union) @@ -742,7 +744,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) se, but if it doesn't happen it is bizarre and worth investigating... *) sanity_check __FILE__ __LINE__ (AbstractionId.Set.equal !aids_union !fp_aids) - meta; + span; (* Merge the abstractions which need to be merged, and compute the map from region id to abstraction id *) @@ -781,7 +783,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) in let abs = ctx_lookup_abs !fp !id0 in let abs = { abs with kind = abs_kind } in - let fp', _ = ctx_subst_abs meta !fp !id0 abs in + let fp', _ = ctx_subst_abs span !fp !id0 abs in fp := fp'; (* Merge all the abstractions into this one *) List.iter @@ -794,14 +796,14 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) ^ AbstractionId.to_string !id0)); (* Note that we merge *into* [id0] *) let fp', id0' = - merge_into_abstraction meta loop_id abs_kind false !fp id + merge_into_abstraction span loop_id abs_kind false !fp id !id0 in fp := fp'; id0 := id0'; () with ValueMatchFailure _ -> - craise __FILE__ __LINE__ meta "Unexpected") + craise __FILE__ __LINE__ span "Unexpected") ids; (* Register the mapping *) let abs = ctx_lookup_abs !fp !id0 in @@ -812,7 +814,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) (* Reorder the loans and borrows in the fresh abstractions in the fixed-point *) let fp = - reorder_loans_borrows_in_fresh_abs meta (Option.get !fixed_ids).aids !fp + reorder_loans_borrows_in_fresh_abs span (Option.get !fixed_ids).aids !fp in (* Update the abstraction's [can_end] field and their kinds. @@ -834,8 +836,8 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) method! visit_abs _ abs = match abs.kind with | Loop (loop_id', _, kind) -> - sanity_check __FILE__ __LINE__ (loop_id' = loop_id) meta; - sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) meta; + sanity_check __FILE__ __LINE__ (loop_id' = loop_id) span; + sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) span; let kind : abs_kind = if remove_rg_id then Loop (loop_id, None, LoopSynthInput) else abs.kind @@ -857,7 +859,7 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) (lazy ("compute_fixed_point: fixed point after matching with the function \ region groups:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) fp_test)); + ^ eval_ctx_to_string_no_filter ~span:(Some span) fp_test)); compute_fixed_point fp_test 1 1 in @@ -869,30 +871,30 @@ let compute_loop_entry_fixed_point (config : config) (meta : Meta.meta) (* Return *) (fp, fixed_ids, rg_to_abs) -let compute_fixed_point_id_correspondance (meta : Meta.meta) +let compute_fixed_point_id_correspondance (span : Meta.span) (fixed_ids : ids_sets) (src_ctx : eval_ctx) (tgt_ctx : eval_ctx) : borrow_loan_corresp = log#ldebug (lazy ("compute_fixed_point_id_correspondance:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- src_ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) src_ctx + ^ eval_ctx_to_string ~span:(Some span) src_ctx ^ "\n\n- tgt_ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) tgt_ctx + ^ eval_ctx_to_string ~span:(Some span) tgt_ctx ^ "\n\n")); - let filt_src_env, _, _ = ctx_split_fixed_new meta fixed_ids src_ctx in + let filt_src_env, _, _ = ctx_split_fixed_new span fixed_ids src_ctx in let filt_src_ctx = { src_ctx with env = filt_src_env } in - let filt_tgt_env, new_absl, _ = ctx_split_fixed_new meta fixed_ids tgt_ctx in + let filt_tgt_env, new_absl, _ = ctx_split_fixed_new span fixed_ids tgt_ctx in let filt_tgt_ctx = { tgt_ctx with env = filt_tgt_env } in log#ldebug (lazy ("compute_fixed_point_id_correspondance:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- filt_src_ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) filt_src_ctx + ^ eval_ctx_to_string ~span:(Some span) filt_src_ctx ^ "\n\n- filt_tgt_ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) filt_tgt_ctx + ^ eval_ctx_to_string ~span:(Some span) filt_tgt_ctx ^ "\n\n")); (* Match the source context and the filtered target context *) @@ -901,15 +903,15 @@ let compute_fixed_point_id_correspondance (meta : Meta.meta) let fixed_ids = ids_sets_empty_borrows_loans fixed_ids in let open InterpreterBorrowsCore in let lookup_shared_loan lid ctx : typed_value = - match snd (lookup_loan meta ek_all lid ctx) with + match snd (lookup_loan span ek_all lid ctx) with | Concrete (VSharedLoan (_, v)) -> v | Abstract (ASharedLoan (_, v, _)) -> v - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in let lookup_in_tgt id = lookup_shared_loan id tgt_ctx in let lookup_in_src id = lookup_shared_loan id src_ctx in Option.get - (match_ctxs meta check_equiv fixed_ids lookup_in_tgt lookup_in_src + (match_ctxs span check_equiv fixed_ids lookup_in_tgt lookup_in_src filt_tgt_ctx filt_src_ctx) in @@ -966,7 +968,7 @@ let compute_fixed_point_id_correspondance (meta : Meta.meta) (* Check that the loan and borrows are related *) sanity_check __FILE__ __LINE__ (BorrowId.Set.equal ids.borrow_ids loan_ids) - meta) + span) new_absl; (* For every target abstraction (going back to the [list_nth_mut] example, @@ -1009,7 +1011,7 @@ let compute_fixed_point_id_correspondance (meta : Meta.meta) loan_to_borrow_id_map = tgt_loan_to_borrow; } -let compute_fp_ctx_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) +let compute_fp_ctx_symbolic_values (span : Meta.span) (ctx : eval_ctx) (fp_ctx : eval_ctx) : SymbolicValueId.Set.t * symbolic_value list = let old_ids, _ = compute_ctx_ids ctx in let fp_ids, fp_ids_maps = compute_ctx_ids fp_ctx in @@ -1090,10 +1092,10 @@ let compute_fp_ctx_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) method! visit_VSharedBorrow env bid = let open InterpreterBorrowsCore in let v = - match snd (lookup_loan meta ek_all bid fp_ctx) with + match snd (lookup_loan span ek_all bid fp_ctx) with | Concrete (VSharedLoan (_, v)) -> v | Abstract (ASharedLoan (_, v, _)) -> v - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in self#visit_typed_value env v @@ -1114,9 +1116,9 @@ let compute_fp_ctx_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) log#ldebug (lazy ("compute_fp_ctx_symbolic_values:" ^ "\n- src context:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx ^ "\n- fixed point:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) fp_ctx + ^ eval_ctx_to_string_no_filter ~span:(Some span) fp_ctx ^ "\n- fresh_sids: " ^ SymbolicValueId.Set.show fresh_sids ^ "\n- input_svalues: " diff --git a/compiler/InterpreterLoopsFixedPoint.mli b/compiler/InterpreterLoopsFixedPoint.mli index 4fc36598..59d42812 100644 --- a/compiler/InterpreterLoopsFixedPoint.mli +++ b/compiler/InterpreterLoopsFixedPoint.mli @@ -13,7 +13,7 @@ open InterpreterLoopsCore - config - fixed ids (the fixeds ids are the ids we consider as non-fresh) *) -val cleanup_fresh_values_and_abs : config -> Meta.meta -> ids_sets -> Cps.cm_fun +val cleanup_fresh_values_and_abs : config -> Meta.span -> ids_sets -> Cps.cm_fun (** Prepare the shared loans in the abstractions by moving them to fresh abstractions. @@ -60,7 +60,7 @@ val cleanup_fresh_values_and_abs : config -> Meta.meta -> ids_sets -> Cps.cm_fun we only introduce a fresh abstraction for [l1]. *) -val prepare_ashared_loans : Meta.meta -> loop_id option -> Cps.cm_fun +val prepare_ashared_loans : Meta.span -> loop_id option -> Cps.cm_fun (** Compute a fixed-point for the context at the entry of the loop. We also return: @@ -78,9 +78,11 @@ val prepare_ashared_loans : Meta.meta -> loop_id option -> Cps.cm_fun *) val compute_loop_entry_fixed_point : config -> - Meta.meta -> + Meta.span -> loop_id -> - Cps.st_cm_fun -> + (* This function is the function to evaluate the loop body (eval_statement applied + to the proper arguments) *) + Cps.stl_cm_fun -> eval_ctx -> eval_ctx * ids_sets * abs SymbolicAst.region_group_id_map @@ -161,7 +163,7 @@ val compute_loop_entry_fixed_point : through the loan [l1] is actually the value which has to be given back to [l0]. *) val compute_fixed_point_id_correspondance : - Meta.meta -> ids_sets -> eval_ctx -> eval_ctx -> borrow_loan_corresp + Meta.span -> ids_sets -> eval_ctx -> eval_ctx -> borrow_loan_corresp (** Compute the set of "quantified" symbolic value ids in a fixed-point context. @@ -170,7 +172,7 @@ val compute_fixed_point_id_correspondance : - the list of input symbolic values *) val compute_fp_ctx_symbolic_values : - Meta.meta -> + Meta.span -> eval_ctx -> eval_ctx -> symbolic_value_id_set * symbolic_value list diff --git a/compiler/InterpreterLoopsJoinCtxs.ml b/compiler/InterpreterLoopsJoinCtxs.ml index de00cb93..c67869ac 100644 --- a/compiler/InterpreterLoopsJoinCtxs.ml +++ b/compiler/InterpreterLoopsJoinCtxs.ml @@ -19,7 +19,7 @@ let log = Logging.loops_join_ctxs_log called typically after we merge abstractions together (see {!collapse_ctx} for instance). *) -let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) +let reorder_loans_borrows_in_fresh_abs (span : Meta.span) (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx = let reorder_in_fresh_abs (abs : abs) : abs = (* Split between the loans and borrows *) @@ -27,7 +27,7 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) match av.value with | ABorrow _ -> true | ALoan _ -> false - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in let aborrows, aloans = List.partition is_borrow abs.avalues in @@ -40,13 +40,13 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) let get_borrow_id (av : typed_avalue) : BorrowId.id = match av.value with | ABorrow (AMutBorrow (bid, _) | ASharedBorrow bid) -> bid - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in let get_loan_id (av : typed_avalue) : BorrowId.id = match av.value with | ALoan (AMutLoan (lid, _)) -> lid | ALoan (ASharedLoan (lids, _, _)) -> BorrowId.Set.min_elt lids - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in (* We use ordered maps to reorder the borrows and loans *) let reorder (get_bid : typed_avalue -> BorrowId.id) @@ -129,7 +129,7 @@ let reorder_loans_borrows_in_fresh_abs (meta : Meta.meta) This can happen when merging environments (note that such environments are not well-formed - they become well formed again after collapsing). *) -let collapse_ctx (meta : Meta.meta) (loop_id : LoopId.id) +let collapse_ctx (span : Meta.span) (loop_id : LoopId.id) (merge_funs : merge_duplicates_funcs option) (old_ids : ids_sets) (ctx0 : eval_ctx) : eval_ctx = (* Debug *) @@ -137,7 +137,7 @@ let collapse_ctx (meta : Meta.meta) (loop_id : LoopId.id) (lazy ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx0 + ^ eval_ctx_to_string ~span:(Some span) ctx0 ^ "\n\n")); let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in @@ -162,7 +162,7 @@ let collapse_ctx (meta : Meta.meta) (loop_id : LoopId.id) | EBinding (BDummy id, v) -> if is_fresh_did id then let absl = - convert_value_to_abstractions meta abs_kind can_end + convert_value_to_abstractions span abs_kind can_end destructure_shared_values ctx0 v in List.map (fun abs -> EAbs abs) absl @@ -174,20 +174,20 @@ let collapse_ctx (meta : Meta.meta) (loop_id : LoopId.id) (lazy ("collapse_ctx: after converting values to abstractions:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); log#ldebug (lazy ("collapse_ctx: after decomposing the shared values in the abstractions:\n" ^ show_ids_sets old_ids ^ "\n\n- ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); (* Explore all the *new* abstractions, and compute various maps *) let explore (abs : abs) = is_fresh_abs_id abs.abs_id in let ids_maps = - compute_abs_borrows_loans_maps meta (merge_funs = None) explore env + compute_abs_borrows_loans_maps span (merge_funs = None) explore env in let { abs_ids; @@ -257,12 +257,12 @@ let collapse_ctx (meta : Meta.meta) (loop_id : LoopId.id) ^ " into " ^ AbstractionId.to_string abs_id0 ^ ":\n\n" - ^ eval_ctx_to_string ~meta:(Some meta) !ctx)); + ^ eval_ctx_to_string ~span:(Some span) !ctx)); (* Update the environment - pay attention to the order: we we merge [abs_id1] *into* [abs_id0] *) let nctx, abs_id = - merge_into_abstraction meta abs_kind can_end merge_funs + merge_into_abstraction span abs_kind can_end merge_funs !ctx abs_id1 abs_id0 in ctx := nctx; @@ -278,27 +278,27 @@ let collapse_ctx (meta : Meta.meta) (loop_id : LoopId.id) (lazy ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after collapse:\n" - ^ eval_ctx_to_string ~meta:(Some meta) !ctx + ^ eval_ctx_to_string ~span:(Some span) !ctx ^ "\n\n")); (* Reorder the loans and borrows in the fresh abstractions *) - let ctx = reorder_loans_borrows_in_fresh_abs meta old_ids.aids !ctx in + let ctx = reorder_loans_borrows_in_fresh_abs span old_ids.aids !ctx in log#ldebug (lazy ("collapse_ctx:\n\n- fixed_ids:\n" ^ show_ids_sets old_ids ^ "\n\n- after collapse and reorder borrows/loans:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx + ^ eval_ctx_to_string ~span:(Some span) ctx ^ "\n\n")); (* Return the new context *) ctx -let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) +let mk_collapse_ctx_merge_duplicate_funs (span : Meta.span) (loop_id : LoopId.id) (ctx : eval_ctx) : merge_duplicates_funcs = (* Rem.: the merge functions raise exceptions (that we catch). *) let module S : MatchJoinState = struct - let meta = meta + let span = span let loop_id = loop_id let nabs = ref [] end in @@ -316,8 +316,8 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) *) let merge_amut_borrows id ty0 child0 _ty1 child1 = (* Sanity checks *) - sanity_check __FILE__ __LINE__ (is_aignored child0.value) meta; - sanity_check __FILE__ __LINE__ (is_aignored child1.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child0.value) span; + sanity_check __FILE__ __LINE__ (is_aignored child1.value) span; (* We need to pick a type for the avalue. The types on the left and on the right may use different regions: it doesn't really matter (here, we pick @@ -337,10 +337,10 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) let _, ty1, _ = ty_as_ref ty1 in sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos ty0)) - meta; + span; sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx.type_ctx.type_infos ty1)) - meta + span in (* Same remarks as for [merge_amut_borrows] *) @@ -351,8 +351,8 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) let merge_amut_loans id ty0 child0 _ty1 child1 = (* Sanity checks *) - sanity_check __FILE__ __LINE__ (is_aignored child0.value) meta; - sanity_check __FILE__ __LINE__ (is_aignored child1.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child0.value) span; + sanity_check __FILE__ __LINE__ (is_aignored child1.value) span; (* Same remarks as for [merge_amut_borrows] *) let ty = ty0 in let child = child0 in @@ -362,8 +362,8 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) let merge_ashared_loans ids ty0 (sv0 : typed_value) child0 _ty1 (sv1 : typed_value) child1 = (* Sanity checks *) - sanity_check __FILE__ __LINE__ (is_aignored child0.value) meta; - sanity_check __FILE__ __LINE__ (is_aignored child1.value) meta; + sanity_check __FILE__ __LINE__ (is_aignored child0.value) span; + sanity_check __FILE__ __LINE__ (is_aignored child1.value) span; (* Same remarks as for [merge_amut_borrows]. This time we need to also merge the shared values. We rely on the @@ -371,10 +371,10 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) *) sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv0.value)) - meta; + span; sanity_check __FILE__ __LINE__ (not (value_has_loans_or_borrows ctx sv1.value)) - meta; + span; let ty = ty0 in let child = child0 in let sv = M.match_typed_values ctx ctx sv0 sv1 in @@ -388,12 +388,12 @@ let mk_collapse_ctx_merge_duplicate_funs (meta : Meta.meta) merge_ashared_loans; } -let merge_into_abstraction (meta : Meta.meta) (loop_id : LoopId.id) +let merge_into_abstraction (span : Meta.span) (loop_id : LoopId.id) (abs_kind : abs_kind) (can_end : bool) (ctx : eval_ctx) (aid0 : AbstractionId.id) (aid1 : AbstractionId.id) : eval_ctx * AbstractionId.id = - let merge_funs = mk_collapse_ctx_merge_duplicate_funs meta loop_id ctx in - merge_into_abstraction meta abs_kind can_end (Some merge_funs) ctx aid0 aid1 + let merge_funs = mk_collapse_ctx_merge_duplicate_funs span loop_id ctx in + merge_into_abstraction span abs_kind can_end (Some merge_funs) ctx aid0 aid1 (** Collapse an environment, merging the duplicated borrows/loans. @@ -402,22 +402,22 @@ let merge_into_abstraction (meta : Meta.meta) (loop_id : LoopId.id) We do this because when we join environments, we may introduce duplicated loans and borrows. See the explanations for {!join_ctxs}. *) -let collapse_ctx_with_merge (meta : Meta.meta) (loop_id : LoopId.id) +let collapse_ctx_with_merge (span : Meta.span) (loop_id : LoopId.id) (old_ids : ids_sets) (ctx : eval_ctx) : eval_ctx = - let merge_funs = mk_collapse_ctx_merge_duplicate_funs meta loop_id ctx in - try collapse_ctx meta loop_id (Some merge_funs) old_ids ctx - with ValueMatchFailure _ -> craise __FILE__ __LINE__ meta "Unexpected" + let merge_funs = mk_collapse_ctx_merge_duplicate_funs span loop_id ctx in + try collapse_ctx span loop_id (Some merge_funs) old_ids ctx + with ValueMatchFailure _ -> craise __FILE__ __LINE__ span "Unexpected" -let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) +let join_ctxs (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : ctx_or_update = (* Debug *) log#ldebug (lazy ("join_ctxs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx0 + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx0 ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx1 + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx1 ^ "\n\n")); let env0 = List.rev ctx0.env in @@ -431,10 +431,10 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) (lazy ("join_suffixes:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) + ^ eval_ctx_to_string_no_filter ~span:(Some span) { ctx0 with env = List.rev env0 } ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) + ^ eval_ctx_to_string_no_filter ~span:(Some span) { ctx1 with env = List.rev env1 } ^ "\n\n")); @@ -443,18 +443,18 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) match ee with | EBinding (BVar _, _) -> (* Variables are necessarily in the prefix *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | EBinding (BDummy did, _) -> sanity_check __FILE__ __LINE__ (not (DummyVarId.Set.mem did fixed_ids.dids)) - meta + span | EAbs abs -> sanity_check __FILE__ __LINE__ (not (AbstractionId.Set.mem abs.abs_id fixed_ids.aids)) - meta + span | EFrame -> (* This should have been eliminated *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" in List.iter check_valid env0; List.iter check_valid env1; @@ -465,7 +465,7 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) in let module S : MatchJoinState = struct - let meta = meta + let span = span let loop_id = loop_id let nabs = nabs end in @@ -481,9 +481,9 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) (lazy ("join_prefixes: BDummys:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- value0:\n" - ^ env_elem_to_string meta ctx0 var0 + ^ env_elem_to_string span ctx0 var0 ^ "\n\n- value1:\n" - ^ env_elem_to_string meta ctx1 var1 + ^ env_elem_to_string span ctx1 var1 ^ "\n\n")); (* Two cases: the dummy value is an old value, in which case the bindings @@ -491,7 +491,7 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) are not in the prefix anymore *) if DummyVarId.Set.mem b0 fixed_ids.dids then ( (* Still in the prefix: match the values *) - sanity_check __FILE__ __LINE__ (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) span; let b = b0 in let v = M.match_typed_values ctx0 ctx1 v0 v1 in let var = EBinding (BDummy b, v) in @@ -506,14 +506,14 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) (lazy ("join_prefixes: BVars:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- value0:\n" - ^ env_elem_to_string meta ctx0 var0 + ^ env_elem_to_string span ctx0 var0 ^ "\n\n- value1:\n" - ^ env_elem_to_string meta ctx1 var1 + ^ env_elem_to_string span ctx1 var1 ^ "\n\n")); (* Variable bindings *must* be in the prefix and consequently their ids must be the same *) - sanity_check __FILE__ __LINE__ (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) span; (* Match the values *) let b = b0 in let v = M.match_typed_values ctx0 ctx1 v0 v1 in @@ -526,15 +526,15 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) (lazy ("join_prefixes: Abs:\n\n- fixed_ids:\n" ^ "\n" ^ show_ids_sets fixed_ids ^ "\n\n- abs0:\n" - ^ abs_to_string meta ctx0 abs0 + ^ abs_to_string span ctx0 abs0 ^ "\n\n- abs1:\n" - ^ abs_to_string meta ctx1 abs1 + ^ abs_to_string span ctx1 abs1 ^ "\n\n")); (* Same as for the dummy values: there are two cases *) if AbstractionId.Set.mem abs0.abs_id fixed_ids.aids then ( (* Still in the prefix: the abstractions must be the same *) - sanity_check __FILE__ __LINE__ (abs0 = abs1) meta; + sanity_check __FILE__ __LINE__ (abs0 = abs1) span; (* Continue *) abs :: join_prefixes env0' env1') else (* Not in the prefix anymore *) @@ -549,7 +549,7 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) let env0, env1 = match (env0, env1) with | EFrame :: env0, EFrame :: env1 -> (env0, env1) - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in log#ldebug @@ -611,7 +611,7 @@ let join_ctxs (meta : Meta.meta) (loop_id : LoopId.id) (fixed_ids : ids_sets) with ValueMatchFailure e -> Error e (** Destructure all the new abstractions *) -let destructure_new_abs (meta : Meta.meta) (loop_id : LoopId.id) +let destructure_new_abs (span : Meta.span) (loop_id : LoopId.id) (old_abs_ids : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx = let abs_kind : abs_kind = Loop (loop_id, None, LoopSynthInput) in let can_end = true in @@ -624,7 +624,7 @@ let destructure_new_abs (meta : Meta.meta) (loop_id : LoopId.id) (fun abs -> if is_fresh_abs_id abs.abs_id then let abs = - destructure_abs meta abs_kind can_end destructure_shared_values ctx + destructure_abs span abs_kind can_end destructure_shared_values ctx abs in abs @@ -664,7 +664,7 @@ let refresh_abs (old_abs : AbstractionId.Set.t) (ctx : eval_ctx) : eval_ctx = in { ctx with env } -let loop_join_origin_with_continue_ctxs (config : config) (meta : Meta.meta) +let loop_join_origin_with_continue_ctxs (config : config) (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (old_ctx : eval_ctx) (ctxl : eval_ctx list) : (eval_ctx * eval_ctx list) * eval_ctx = (* # Join with the new contexts, one by one @@ -677,7 +677,7 @@ let loop_join_origin_with_continue_ctxs (config : config) (meta : Meta.meta) *) let joined_ctx = ref old_ctx in let rec join_one_aux (ctx : eval_ctx) : eval_ctx = - match join_ctxs meta loop_id fixed_ids !joined_ctx ctx with + match join_ctxs span loop_id fixed_ids !joined_ctx ctx with | Ok nctx -> joined_ctx := nctx; ctx @@ -685,11 +685,11 @@ let loop_join_origin_with_continue_ctxs (config : config) (meta : Meta.meta) let ctx = match err with | LoanInRight bid -> - InterpreterBorrows.end_borrow_no_synth config meta bid ctx + InterpreterBorrows.end_borrow_no_synth config span bid ctx | LoansInRight bids -> - InterpreterBorrows.end_borrows_no_synth config meta bids ctx + InterpreterBorrows.end_borrows_no_synth config span bids ctx | AbsInRight _ | AbsInLeft _ | LoanInLeft _ | LoansInLeft _ -> - craise __FILE__ __LINE__ meta "Unexpected" + craise __FILE__ __LINE__ span "Unexpected" in join_one_aux ctx in @@ -697,21 +697,21 @@ let loop_join_origin_with_continue_ctxs (config : config) (meta : Meta.meta) log#ldebug (lazy ("loop_join_origin_with_continue_ctxs:join_one: initial ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Destructure the abstractions introduced in the new context *) - let ctx = destructure_new_abs meta loop_id fixed_ids.aids ctx in + let ctx = destructure_new_abs span loop_id fixed_ids.aids ctx in log#ldebug (lazy ("loop_join_origin_with_continue_ctxs:join_one: after destructure:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Collapse the context we want to add to the join *) - let ctx = collapse_ctx meta loop_id None fixed_ids ctx in + let ctx = collapse_ctx span loop_id None fixed_ids ctx in log#ldebug (lazy ("loop_join_origin_with_continue_ctxs:join_one: after collapse:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Refresh the fresh abstractions *) let ctx = refresh_abs fixed_ids.aids ctx in @@ -721,19 +721,19 @@ let loop_join_origin_with_continue_ctxs (config : config) (meta : Meta.meta) log#ldebug (lazy ("loop_join_origin_with_continue_ctxs:join_one: after join:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx1)); + ^ eval_ctx_to_string ~span:(Some span) ctx1)); (* Collapse again - the join might have introduce abstractions we want to merge with the others (note that those abstractions may actually lead to borrows/loans duplications) *) - joined_ctx := collapse_ctx_with_merge meta loop_id fixed_ids !joined_ctx; + joined_ctx := collapse_ctx_with_merge span loop_id fixed_ids !joined_ctx; log#ldebug (lazy ("loop_join_origin_with_continue_ctxs:join_one: after join-collapse:\n" - ^ eval_ctx_to_string ~meta:(Some meta) !joined_ctx)); + ^ eval_ctx_to_string ~span:(Some span) !joined_ctx)); (* Sanity check *) - if !Config.sanity_checks then Invariants.check_invariants meta !joined_ctx; + if !Config.sanity_checks then Invariants.check_invariants span !joined_ctx; (* Return *) ctx1 in diff --git a/compiler/InterpreterLoopsJoinCtxs.mli b/compiler/InterpreterLoopsJoinCtxs.mli index 0e84657c..f4b5194a 100644 --- a/compiler/InterpreterLoopsJoinCtxs.mli +++ b/compiler/InterpreterLoopsJoinCtxs.mli @@ -16,7 +16,7 @@ open InterpreterLoopsCore - [aid1] *) val merge_into_abstraction : - Meta.meta -> + Meta.span -> loop_id -> abs_kind -> bool -> @@ -86,7 +86,7 @@ val merge_into_abstraction : - [ctx1] *) val join_ctxs : - Meta.meta -> loop_id -> ids_sets -> eval_ctx -> eval_ctx -> ctx_or_update + Meta.span -> loop_id -> ids_sets -> eval_ctx -> eval_ctx -> ctx_or_update (** Join the context at the entry of the loop with the contexts upon reentry (upon reaching the [Continue] statement - the goal is to compute a fixed @@ -106,7 +106,7 @@ val join_ctxs : *) val loop_join_origin_with_continue_ctxs : config -> - Meta.meta -> + Meta.span -> loop_id -> ids_sets -> eval_ctx -> diff --git a/compiler/InterpreterLoopsMatchCtxs.ml b/compiler/InterpreterLoopsMatchCtxs.ml index 3db68f5d..e25adb2c 100644 --- a/compiler/InterpreterLoopsMatchCtxs.ml +++ b/compiler/InterpreterLoopsMatchCtxs.ml @@ -20,7 +20,7 @@ module S = SynthesizeSymbolic (** The local logger *) let log = Logging.loops_match_ctxs_log -let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) +let compute_abs_borrows_loans_maps (span : Meta.span) (no_duplicates : bool) (explore : abs -> bool) (env : env) : abs_borrows_loans_maps = let abs_ids = ref [] in let abs_to_borrows = ref AbstractionId.Map.empty in @@ -45,7 +45,7 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) | Some set -> sanity_check __FILE__ __LINE__ ((not check_not_already_registered) || not (Id1.Set.mem id1 set)) - meta); + span); (* Update the mapping *) map := Id0.Map.update id0 @@ -54,11 +54,11 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) | None -> Some (Id1.Set.singleton id1) | Some ids -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (not check_singleton_sets) meta; + sanity_check __FILE__ __LINE__ (not check_singleton_sets) span; sanity_check __FILE__ __LINE__ ((not check_not_already_registered) || not (Id1.Set.mem id1 ids)) - meta; + span; (* Update *) Some (Id1.Set.add id1 ids)) !map @@ -92,12 +92,12 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) (* Process those normally *) super#visit_aloan_content abs_id lc | AIgnoredMutLoan (_, child) - | AEndedIgnoredMutLoan { child; given_back = _; given_back_meta = _ } + | AEndedIgnoredMutLoan { child; given_back = _; given_back_span = _ } | AIgnoredSharedLoan child -> (* Ignore the id of the loan, if there is *) self#visit_typed_avalue abs_id child | AEndedMutLoan _ | AEndedSharedLoan _ -> - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" (** Make sure we don't register the ignored ids *) method! visit_aborrow_content abs_id bc = @@ -106,12 +106,12 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) (* Process those normally *) super#visit_aborrow_content abs_id bc | AIgnoredMutBorrow (_, child) - | AEndedIgnoredMutBorrow { child; given_back = _; given_back_meta = _ } + | AEndedIgnoredMutBorrow { child; given_back = _; given_back_span = _ } -> (* Ignore the id of the borrow, if there is *) self#visit_typed_avalue abs_id child | AEndedMutBorrow _ | AEndedSharedBorrow -> - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" method! visit_borrow_id abs_id bid = register_borrow_id abs_id bid method! visit_loan_id abs_id lid = register_loan_id abs_id lid @@ -147,18 +147,18 @@ let compute_abs_borrows_loans_maps (meta : Meta.meta) (no_duplicates : bool) TODO: probably don't need to take [match_regions] as input anymore. *) -let rec match_types (meta : Meta.meta) (match_distinct_types : ty -> ty -> ty) +let rec match_types (span : Meta.span) (match_distinct_types : ty -> ty -> ty) (match_regions : region -> region -> region) (ty0 : ty) (ty1 : ty) : ty = - let match_rec = match_types meta match_distinct_types match_regions in + let match_rec = match_types span match_distinct_types match_regions in match (ty0, ty1) with | TAdt (id0, generics0), TAdt (id1, generics1) -> - sanity_check __FILE__ __LINE__ (id0 = id1) meta; + sanity_check __FILE__ __LINE__ (id0 = id1) span; sanity_check __FILE__ __LINE__ (generics0.const_generics = generics1.const_generics) - meta; + span; sanity_check __FILE__ __LINE__ (generics0.trait_refs = generics1.trait_refs) - meta; + span; let id = id0 in let const_generics = generics1.const_generics in let trait_refs = generics1.trait_refs in @@ -175,23 +175,23 @@ let rec match_types (meta : Meta.meta) (match_distinct_types : ty -> ty -> ty) let generics = { regions; types; const_generics; trait_refs } in TAdt (id, generics) | TVar vid0, TVar vid1 -> - sanity_check __FILE__ __LINE__ (vid0 = vid1) meta; + sanity_check __FILE__ __LINE__ (vid0 = vid1) span; let vid = vid0 in TVar vid | TLiteral lty0, TLiteral lty1 -> - sanity_check __FILE__ __LINE__ (lty0 = lty1) meta; + sanity_check __FILE__ __LINE__ (lty0 = lty1) span; ty0 | TNever, TNever -> ty0 | TRef (r0, ty0, k0), TRef (r1, ty1, k1) -> let r = match_regions r0 r1 in let ty = match_rec ty0 ty1 in - sanity_check __FILE__ __LINE__ (k0 = k1) meta; + sanity_check __FILE__ __LINE__ (k0 = k1) span; let k = k0 in TRef (r, ty, k) | _ -> match_distinct_types ty0 ty1 module MakeMatcher (M : PrimMatcher) : Matcher = struct - let meta = M.meta + let span = M.span let rec match_typed_values (ctx0 : eval_ctx) (ctx1 : eval_ctx) (v0 : typed_value) (v1 : typed_value) : typed_value = @@ -221,10 +221,10 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct (* For now, we don't merge ADTs which contain borrows *) sanity_check __FILE__ __LINE__ (not (value_has_borrows v0.value)) - M.meta; + M.span; sanity_check __FILE__ __LINE__ (not (value_has_borrows v1.value)) - M.meta; + M.span; (* Merge *) M.match_distinct_adts ctx0 ctx1 ty av0 av1) | VBottom, VBottom -> v0 @@ -243,7 +243,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct (not (ValuesUtils.value_has_borrows ctx0.type_ctx.type_infos bv.value)) - M.meta "The join of nested borrows is not supported yet"; + M.span "The join of nested borrows is not supported yet"; let bid, bv = M.match_mut_borrows ctx0 ctx1 ty bid0 bv0 bid1 bv1 bv in @@ -256,7 +256,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct trying to match a reserved borrow, which shouldn't happen because reserved borrow should be eliminated very quickly - they are introduced just before function calls which activate them *) - craise __FILE__ __LINE__ M.meta "Unexpected" + craise __FILE__ __LINE__ M.span "Unexpected" in { value = VBorrow bc; ty } | VLoan lc0, VLoan lc1 -> @@ -268,14 +268,14 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct let sv = match_rec sv0 sv1 in cassert __FILE__ __LINE__ (not (value_has_borrows sv.value)) - M.meta "The join of nested borrows is not supported yet"; + M.span "The join of nested borrows is not supported yet"; let ids, sv = M.match_shared_loans ctx0 ctx1 ty ids0 ids1 sv in VSharedLoan (ids, sv) | VMutLoan id0, VMutLoan id1 -> let id = M.match_mut_loans ctx0 ctx1 ty id0 id1 in VMutLoan id | VSharedLoan _, VMutLoan _ | VMutLoan _, VSharedLoan _ -> - craise __FILE__ __LINE__ M.meta "Unreachable" + craise __FILE__ __LINE__ M.span "Unreachable" in { value = VLoan lc; ty = v1.ty } | VSymbolic sv0, VSymbolic sv1 -> @@ -283,12 +283,12 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct be eagerly expanded, and we don't support nested borrows *) cassert __FILE__ __LINE__ (not (value_has_borrows v0.value)) - M.meta + M.span "Nested borrows are not supported yet and all the symbolic values \ containing borrows are currently forced to be eagerly expanded"; cassert __FILE__ __LINE__ (not (value_has_borrows v1.value)) - M.meta + M.span "Nested borrows are not supported yet and all the symbolic values \ containing borrows are currently forced to be eagerly expanded"; (* Match *) @@ -310,19 +310,19 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct log#ldebug (lazy ("Unexpected match case:\n- value0: " - ^ typed_value_to_string ~meta:(Some M.meta) ctx0 v0 + ^ typed_value_to_string ~span:(Some M.span) ctx0 v0 ^ "\n- value1: " - ^ typed_value_to_string ~meta:(Some M.meta) ctx1 v1)); - craise __FILE__ __LINE__ M.meta "Unexpected match case" + ^ typed_value_to_string ~span:(Some M.span) ctx1 v1)); + craise __FILE__ __LINE__ M.span "Unexpected match case" and match_typed_avalues (ctx0 : eval_ctx) (ctx1 : eval_ctx) (v0 : typed_avalue) (v1 : typed_avalue) : typed_avalue = log#ldebug (lazy ("match_typed_avalues:\n- value0: " - ^ typed_avalue_to_string ~meta:(Some M.meta) ctx0 v0 + ^ typed_avalue_to_string ~span:(Some M.span) ctx0 v0 ^ "\n- value1: " - ^ typed_avalue_to_string ~meta:(Some M.meta) ctx1 v1)); + ^ typed_avalue_to_string ~span:(Some M.span) ctx1 v1)); (* Using ValuesUtils.value_has_borrows on purpose here: we want to make explicit the fact that, though we have to pick @@ -348,8 +348,8 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct { value; ty } else (* Merge *) M.match_distinct_aadts ctx0 ctx1 v0.ty av0 v1.ty av1 ty - | ABottom, ABottom -> mk_abottom M.meta ty - | AIgnored, AIgnored -> mk_aignored M.meta ty + | ABottom, ABottom -> mk_abottom M.span ty + | AIgnored, AIgnored -> mk_aignored M.span ty | ABorrow bc0, ABorrow bc1 -> ( log#ldebug (lazy "match_typed_avalues: borrows"); match (bc0, bc1) with @@ -367,7 +367,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct M.match_amut_borrows ctx0 ctx1 v0.ty bid0 av0 v1.ty bid1 av1 ty av | AIgnoredMutBorrow _, AIgnoredMutBorrow _ -> (* The abstractions are destructured: we shouldn't get there *) - craise __FILE__ __LINE__ M.meta "Unexpected" + craise __FILE__ __LINE__ M.span "Unexpected" | AProjSharedBorrow asb0, AProjSharedBorrow asb1 -> ( match (asb0, asb1) with | [], [] -> @@ -376,7 +376,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct v0 | _ -> (* We should get there only if there are nested borrows *) - craise __FILE__ __LINE__ M.meta "Unexpected") + craise __FILE__ __LINE__ M.span "Unexpected") | _ -> (* TODO: getting there is not necessarily inconsistent (it may just be because the environments don't match) so we may want @@ -387,7 +387,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct we are *currently* ending it, in which case we need to completely end it before continuing. *) - craise __FILE__ __LINE__ M.meta "Unexpected") + craise __FILE__ __LINE__ M.span "Unexpected") | ALoan lc0, ALoan lc1 -> ( log#ldebug (lazy "match_typed_avalues: loans"); (* TODO: maybe we should enforce that the ids are always exactly the same - @@ -399,7 +399,7 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct let av = match_arec av0 av1 in sanity_check __FILE__ __LINE__ (not (value_has_borrows sv.value)) - M.meta; + M.span; M.match_ashared_loans ctx0 ctx1 v0.ty ids0 sv0 av0 v1.ty ids1 sv1 av1 ty sv av | AMutLoan (id0, av0), AMutLoan (id1, av1) -> @@ -414,35 +414,35 @@ module MakeMatcher (M : PrimMatcher) : Matcher = struct | AIgnoredSharedLoan _, AIgnoredSharedLoan _ -> (* Those should have been filtered when destructuring the abstractions - they are necessary only when there are nested borrows *) - craise __FILE__ __LINE__ M.meta "Unreachable" - | _ -> craise __FILE__ __LINE__ M.meta "Unreachable") + craise __FILE__ __LINE__ M.span "Unreachable" + | _ -> craise __FILE__ __LINE__ M.span "Unreachable") | ASymbolic _, ASymbolic _ -> (* For now, we force all the symbolic values containing borrows to be eagerly expanded, and we don't support nested borrows *) - craise __FILE__ __LINE__ M.meta "Unreachable" + craise __FILE__ __LINE__ M.span "Unreachable" | _ -> M.match_avalues ctx0 ctx1 v0 v1 end module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct (** Small utility *) - let meta = S.meta + let span = S.span let push_abs (abs : abs) : unit = S.nabs := abs :: !S.nabs let push_absl (absl : abs list) : unit = List.iter push_abs absl let match_etys _ _ ty0 ty1 = - sanity_check __FILE__ __LINE__ (ty0 = ty1) meta; + sanity_check __FILE__ __LINE__ (ty0 = ty1) span; ty0 let match_rtys _ _ ty0 ty1 = (* The types must be equal - in effect, this forbids to match symbolic values containing borrows *) - sanity_check __FILE__ __LINE__ (ty0 = ty1) meta; + sanity_check __FILE__ __LINE__ (ty0 = ty1) span; ty0 let match_distinct_literals (_ : eval_ctx) (_ : eval_ctx) (ty : ety) (_ : literal) (_ : literal) : typed_value = - mk_fresh_symbolic_typed_value_from_no_regions_ty meta ty + mk_fresh_symbolic_typed_value_from_no_regions_ty span ty let match_distinct_adts (ctx0 : eval_ctx) (ctx1 : eval_ctx) (ty : ety) (adt0 : adt_value) (adt1 : adt_value) : typed_value = @@ -451,7 +451,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct updates *) let check_no_borrows ctx (v : typed_value) = - sanity_check __FILE__ __LINE__ (not (value_has_borrows ctx v.value)) meta + sanity_check __FILE__ __LINE__ (not (value_has_borrows ctx v.value)) span in List.iter (check_no_borrows ctx0) adt0.field_values; List.iter (check_no_borrows ctx1) adt1.field_values; @@ -474,18 +474,18 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct if bottom_in_adt_value ctx0.ended_regions adt0 || bottom_in_adt_value ctx1.ended_regions adt1 - then mk_bottom meta ty + then mk_bottom span ty else (* No borrows, no loans, no bottoms: we can introduce a symbolic value *) - mk_fresh_symbolic_typed_value_from_no_regions_ty meta ty + mk_fresh_symbolic_typed_value_from_no_regions_ty span ty let match_shared_borrows (ctx0 : eval_ctx) (ctx1 : eval_ctx) match_rec (ty : ety) (bid0 : borrow_id) (bid1 : borrow_id) : borrow_id = (* Lookup the shared values and match them - we do this mostly to make sure we end loans which might appear on one side and not on the other. *) - let sv0 = lookup_shared_value meta ctx0 bid0 in - let sv1 = lookup_shared_value meta ctx1 bid1 in + let sv0 = lookup_shared_value span ctx0 bid0 in + let sv1 = lookup_shared_value span ctx1 bid1 in let sv = match_rec sv0 sv1 in if bid0 = bid1 then bid0 else @@ -510,7 +510,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let borrows = [ mk_aborrow bid0; mk_aborrow bid1 ] in let loan = - ASharedLoan (BorrowId.Set.singleton bid2, sv, mk_aignored meta bv_ty) + ASharedLoan (BorrowId.Set.singleton bid2, sv, mk_aignored span bv_ty) in (* Note that an aloan has a borrow type *) let loan : typed_avalue = { value = ALoan loan; ty = borrow_ty } in @@ -588,10 +588,10 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct *) cassert __FILE__ __LINE__ (not (ValuesUtils.value_has_borrows ctx0.type_ctx.type_infos bv.value)) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; if bv0 = bv1 then ( - sanity_check __FILE__ __LINE__ (bv0 = bv) meta; + sanity_check __FILE__ __LINE__ (bv0 = bv) span; (bid0, bv)) else let rid = fresh_region_id () in @@ -599,19 +599,19 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let kind = RMut in let bv_ty = bv.ty in - sanity_check __FILE__ __LINE__ (ty_no_regions bv_ty) meta; + sanity_check __FILE__ __LINE__ (ty_no_regions bv_ty) span; let borrow_ty = mk_ref_ty (RFVar rid) bv_ty kind in let borrow_av = let ty = borrow_ty in - let value = ABorrow (AMutBorrow (bid0, mk_aignored meta bv_ty)) in - mk_typed_avalue meta ty value + let value = ABorrow (AMutBorrow (bid0, mk_aignored span bv_ty)) in + mk_typed_avalue span ty value in let loan_av = let ty = borrow_ty in - let value = ALoan (AMutLoan (nbid, mk_aignored meta bv_ty)) in - mk_typed_avalue meta ty value + let value = ALoan (AMutLoan (nbid, mk_aignored span bv_ty)) in + mk_typed_avalue span ty value in let avalues = [ borrow_av; loan_av ] in @@ -645,21 +645,21 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct (* Generate a fresh symbolic value for the borrowed value *) let _, bv_ty, kind = ty_as_ref ty in - let sv = mk_fresh_symbolic_typed_value_from_no_regions_ty meta bv_ty in + let sv = mk_fresh_symbolic_typed_value_from_no_regions_ty span bv_ty in let borrow_ty = mk_ref_ty (RFVar rid) bv_ty kind in (* Generate the avalues for the abstraction *) let mk_aborrow (bid : borrow_id) (bv : typed_value) : typed_avalue = let bv_ty = bv.ty in - cassert __FILE__ __LINE__ (ty_no_regions bv_ty) meta + cassert __FILE__ __LINE__ (ty_no_regions bv_ty) span "Nested borrows are not supported yet"; - let value = ABorrow (AMutBorrow (bid, mk_aignored meta bv_ty)) in + let value = ABorrow (AMutBorrow (bid, mk_aignored span bv_ty)) in { value; ty = borrow_ty } in let borrows = [ mk_aborrow bid0 bv0; mk_aborrow bid1 bv1 ] in - let loan = AMutLoan (bid2, mk_aignored meta bv_ty) in + let loan = AMutLoan (bid2, mk_aignored span bv_ty) in (* Note that an aloan has a borrow type *) let loan : typed_avalue = { value = ALoan loan; ty = borrow_ty } in @@ -700,7 +700,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct raise (ValueMatchFailure (LoansInRight extra_ids_right)); (* This should always be true if we get here *) - sanity_check __FILE__ __LINE__ (ids0 = ids1) meta; + sanity_check __FILE__ __LINE__ (ids0 = ids1) span; let ids = ids0 in (* Return *) @@ -720,7 +720,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let id1 = sv1.sv_id in if id0 = id1 then ( (* Sanity check *) - sanity_check __FILE__ __LINE__ (sv0 = sv1) meta; + sanity_check __FILE__ __LINE__ (sv0 = sv1) span; (* Return *) sv0) else ( @@ -728,7 +728,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct borrows *) sanity_check __FILE__ __LINE__ (not (ty_has_borrows ctx0.type_ctx.type_infos sv0.sv_ty)) - meta; + span; (* TODO: the symbolic values may contain bottoms: we're being conservatice, and fail (for now) if part of a symbolic value contains a bottom. A more general approach would be to introduce a symbolic value @@ -736,8 +736,8 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct sanity_check __FILE__ __LINE__ ((not (symbolic_value_has_ended_regions ctx0.ended_regions sv0)) && not (symbolic_value_has_ended_regions ctx1.ended_regions sv1)) - meta; - mk_fresh_symbolic_value meta sv0.sv_ty) + span; + mk_fresh_symbolic_value span sv0.sv_ty) let match_symbolic_with_other (ctx0 : eval_ctx) (ctx1 : eval_ctx) (left : bool) (sv : symbolic_value) (v : typed_value) : typed_value = @@ -749,14 +749,14 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let type_infos = ctx0.type_ctx.type_infos in cassert __FILE__ __LINE__ (not (ty_has_borrows type_infos sv.sv_ty)) - meta + span "Check that:\n\ \ - there are no borrows in the symbolic value\n\ \ - there are no borrows in the \"regular\" value\n\ \ If there are loans in the regular value, raise an exception."; cassert __FILE__ __LINE__ (not (ValuesUtils.value_has_borrows type_infos v.value)) - meta + span "Check that:\n\ \ - there are no borrows in the symbolic value\n\ \ - there are no borrows in the \"regular\" value\n\ @@ -778,8 +778,8 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct if symbolic_value_has_ended_regions ctx0.ended_regions sv || bottom_in_value ctx1.ended_regions v - then mk_bottom meta sv.sv_ty - else mk_fresh_symbolic_typed_value meta sv.sv_ty + then mk_bottom span sv.sv_ty + else mk_fresh_symbolic_typed_value span sv.sv_ty let match_bottom_with_other (ctx0 : eval_ctx) (ctx1 : eval_ctx) (left : bool) (v : typed_value) : typed_value = @@ -794,7 +794,7 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct with | Some (BorrowContent _) -> (* Can't get there: we only ask for outer *loans* *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Some (LoanContent lc) -> ( match lc with | VSharedLoan (ids, _) -> @@ -812,37 +812,37 @@ module MakeJoinMatcher (S : MatchJoinState) : PrimMatcher = struct let destructure_shared_values = true in let ctx = if value_is_left then ctx0 else ctx1 in let absl = - convert_value_to_abstractions meta abs_kind can_end + convert_value_to_abstractions span abs_kind can_end destructure_shared_values ctx v in push_absl absl; (* Return [Bottom] *) - mk_bottom meta v.ty + mk_bottom span v.ty (* As explained in comments: we don't use the join matcher to join avalues, only concrete values *) let match_distinct_aadts _ _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" let match_ashared_borrows _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" let match_amut_borrows _ _ _ _ _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" let match_ashared_loans _ _ _ _ _ _ _ _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" let match_amut_loans _ _ _ _ _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" - let match_avalues _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_avalues _ _ _ _ = craise __FILE__ __LINE__ span "Unreachable" end (* Very annoying: functors only take modules as inputs... *) module type MatchMoveState = sig - val meta : Meta.meta + val span : Meta.span (** The current loop *) val loop_id : LoopId.id @@ -868,19 +868,19 @@ end indeed matches the resulting target environment: it will be re-checked later. *) module MakeMoveMatcher (S : MatchMoveState) : PrimMatcher = struct - let meta = S.meta + let span = S.span (** Small utility *) let push_moved_value (v : typed_value) : unit = S.nvalues := v :: !S.nvalues let match_etys _ _ ty0 ty1 = - sanity_check __FILE__ __LINE__ (ty0 = ty1) meta; + sanity_check __FILE__ __LINE__ (ty0 = ty1) span; ty0 let match_rtys _ _ ty0 ty1 = (* The types must be equal - in effect, this forbids to match symbolic values containing borrows *) - sanity_check __FILE__ __LINE__ (ty0 = ty1) meta; + sanity_check __FILE__ __LINE__ (ty0 = ty1) span; ty0 let match_distinct_literals (_ : eval_ctx) (_ : eval_ctx) (ty : ety) @@ -925,7 +925,7 @@ module MakeMoveMatcher (S : MatchMoveState) : PrimMatcher = struct if symbolic_value_has_ended_regions ctx0.ended_regions sv || bottom_in_value ctx1.ended_regions v - then mk_bottom meta sv.sv_ty + then mk_bottom span sv.sv_ty else if left then v else mk_typed_value_from_symbolic_value sv @@ -941,47 +941,47 @@ module MakeMoveMatcher (S : MatchMoveState) : PrimMatcher = struct with | Some (BorrowContent _) -> (* Can't get there: we only ask for outer *loans* *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Some (LoanContent _) -> (* We should have ended all the outer loans *) - craise __FILE__ __LINE__ meta "Unexpected outer loan" + craise __FILE__ __LINE__ span "Unexpected outer loan" | None -> (* Move the value - note that we shouldn't get there if we were not allowed to move the value in the first place. *) push_moved_value v; (* Return [Bottom] *) - mk_bottom meta v.ty) + mk_bottom span v.ty) else (* If we get there it means the source environment (e.g., the fixed-point) has a non-bottom value, while the target environment (e.g., the environment we have when we reach the continue) has bottom: we shouldn't get there. *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" (* As explained in comments: we don't use the join matcher to join avalues, only concrete values *) let match_distinct_aadts _ _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" let match_ashared_borrows _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" let match_amut_borrows _ _ _ _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" let match_ashared_loans _ _ _ _ _ _ _ _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" let match_amut_loans _ _ _ _ _ _ _ _ _ _ = - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" - let match_avalues _ _ _ _ = craise __FILE__ __LINE__ meta "Unreachable" + let match_avalues _ _ _ _ = craise __FILE__ __LINE__ span "Unreachable" end module MakeCheckEquivMatcher (S : MatchCheckEquivState) : CheckEquivMatcher = struct - let meta = S.meta + let span = S.span module MkGetSetM (Id : Identifiers.Id) = struct module Inj = Id.InjSubst @@ -1081,11 +1081,11 @@ struct RFVar rid | _ -> raise (Distinct "match_rtys") in - match_types meta match_distinct_types match_regions ty0 ty1 + match_types span match_distinct_types match_regions ty0 ty1 let match_distinct_literals (_ : eval_ctx) (_ : eval_ctx) (ty : ety) (_ : literal) (_ : literal) : typed_value = - mk_fresh_symbolic_typed_value_from_no_regions_ty meta ty + mk_fresh_symbolic_typed_value_from_no_regions_ty span ty let match_distinct_adts (_ : eval_ctx) (_ : eval_ctx) (_ty : ety) (_adt0 : adt_value) (_adt1 : adt_value) : typed_value = @@ -1112,9 +1112,9 @@ struct (lazy ("MakeCheckEquivMatcher: match_shared_borrows: looked up values:" ^ "sv0: " - ^ typed_value_to_string ~meta:(Some meta) ctx0 v0 + ^ typed_value_to_string ~span:(Some span) ctx0 v0 ^ ", sv1: " - ^ typed_value_to_string ~meta:(Some meta) ctx1 v1)); + ^ typed_value_to_string ~span:(Some span) ctx1 v1)); let _ = match_typed_values v0 v1 in () @@ -1163,7 +1163,7 @@ struct (* Check: fixed values are fixed *) sanity_check __FILE__ __LINE__ (id0 = id1 || not (SymbolicValueId.InjSubst.mem id0 !S.sid_map)) - meta; + span; (* Update the symbolic value mapping *) let sv1 = mk_typed_value_from_symbolic_value sv1 in @@ -1180,12 +1180,12 @@ struct (sv : symbolic_value) (v : typed_value) : typed_value = if S.check_equiv then raise (Distinct "match_symbolic_with_other") else ( - sanity_check __FILE__ __LINE__ left meta; + sanity_check __FILE__ __LINE__ left span; let id = sv.sv_id in (* Check: fixed values are fixed *) sanity_check __FILE__ __LINE__ (not (SymbolicValueId.InjSubst.mem id !S.sid_map)) - meta; + span; (* Update the binding for the target symbolic value *) S.sid_to_value_map := SymbolicValueId.Map.add_strict id v !S.sid_to_value_map; @@ -1202,7 +1202,7 @@ struct let value_is_left = not left in let ctx = if value_is_left then ctx0 else ctx1 in if left && not (value_has_loans_or_borrows ctx v.value) then - mk_bottom meta v.ty + mk_bottom span v.ty else raise (Distinct @@ -1238,7 +1238,7 @@ struct ("MakeCheckEquivMatcher:match_amut_loans:" ^ "\n- id0: " ^ BorrowId.to_string id0 ^ "\n- id1: " ^ BorrowId.to_string id1 ^ "\n- ty: " ^ ty_to_string ctx0 ty ^ "\n- av: " - ^ typed_avalue_to_string ~meta:(Some meta) ctx1 av)); + ^ typed_avalue_to_string ~span:(Some span) ctx1 av)); let id = match_loan_id id0 id1 in let value = ALoan (AMutLoan (id, av)) in @@ -1248,13 +1248,13 @@ struct log#ldebug (lazy ("avalues don't match:\n- v0: " - ^ typed_avalue_to_string ~meta:(Some meta) ctx0 v0 + ^ typed_avalue_to_string ~span:(Some span) ctx0 v0 ^ "\n- v1: " - ^ typed_avalue_to_string ~meta:(Some meta) ctx1 v1)); + ^ typed_avalue_to_string ~span:(Some span) ctx1 v1)); raise (Distinct "match_avalues") end -let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) +let match_ctxs (span : Meta.span) (check_equiv : bool) (fixed_ids : ids_sets) (lookup_shared_value_in_ctx0 : BorrowId.id -> typed_value) (lookup_shared_value_in_ctx1 : BorrowId.id -> typed_value) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : ids_maps option = @@ -1262,9 +1262,9 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) (lazy ("match_ctxs:\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx0 + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx0 ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) ctx1 + ^ eval_ctx_to_string_no_filter ~span:(Some span) ctx1 ^ "\n\n")); (* Initialize the maps and instantiate the matcher *) @@ -1306,7 +1306,7 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) in let module S : MatchCheckEquivState = struct - let meta = meta + let span = span let check_equiv = check_equiv let rid_map = rid_map let blid_map = blid_map @@ -1394,10 +1394,10 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) ^ "\n- aid_map: " ^ AbstractionId.InjSubst.show_t !aid_map ^ "\n\n- ctx0:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) + ^ eval_ctx_to_string_no_filter ~span:(Some span) { ctx0 with env = List.rev env0 } ^ "\n\n- ctx1:\n" - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) + ^ eval_ctx_to_string_no_filter ~span:(Some span) { ctx1 with env = List.rev env1 } ^ "\n\n")); @@ -1407,19 +1407,19 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) be the same and their values equal (and the borrows/loans/symbolic *) if DummyVarId.Set.mem b0 fixed_ids.dids then ( (* Fixed values: the values must be equal *) - sanity_check __FILE__ __LINE__ (b0 = b1) meta; - sanity_check __FILE__ __LINE__ (v0 = v1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) span; + sanity_check __FILE__ __LINE__ (v0 = v1) span; (* The ids present in the left value must be fixed *) let ids, _ = compute_typed_value_ids v0 in sanity_check __FILE__ __LINE__ ((not S.check_equiv) || ids_are_fixed ids) - meta); + span); (* We still match the values - allows to compute mappings (which are the identity actually) *) let _ = M.match_typed_values ctx0 ctx1 v0 v1 in match_envs env0' env1' | EBinding (BVar b0, v0) :: env0', EBinding (BVar b1, v1) :: env1' -> - sanity_check __FILE__ __LINE__ (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) span; (* Match the values *) let _ = M.match_typed_values ctx0 ctx1 v0 v1 in (* Continue *) @@ -1430,12 +1430,12 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) if AbstractionId.Set.mem abs0.abs_id fixed_ids.aids then ( log#ldebug (lazy "match_ctxs: match_envs: matching abs: fixed abs"); (* Still in the prefix: the abstractions must be the same *) - sanity_check __FILE__ __LINE__ (abs0 = abs1) meta; + sanity_check __FILE__ __LINE__ (abs0 = abs1) span; (* Their ids must be fixed *) let ids, _ = compute_abs_ids abs0 in sanity_check __FILE__ __LINE__ ((not S.check_equiv) || ids_are_fixed ids) - meta; + span; (* Continue *) match_envs env0' env1') else ( @@ -1463,7 +1463,7 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) let env0, env1 = match (env0, env1) with | EFrame :: env0, EFrame :: env1 -> (env0, env1) - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in match_envs env0 env1; @@ -1490,40 +1490,41 @@ let match_ctxs (meta : Meta.meta) (check_equiv : bool) (fixed_ids : ids_sets) ^ "\n")); None -let ctxs_are_equivalent (meta : Meta.meta) (fixed_ids : ids_sets) +let ctxs_are_equivalent (span : Meta.span) (fixed_ids : ids_sets) (ctx0 : eval_ctx) (ctx1 : eval_ctx) : bool = let check_equivalent = true in - let lookup_shared_value _ = craise __FILE__ __LINE__ meta "Unreachable" in + let lookup_shared_value _ = craise __FILE__ __LINE__ span "Unreachable" in Option.is_some - (match_ctxs meta check_equivalent fixed_ids lookup_shared_value + (match_ctxs span check_equivalent fixed_ids lookup_shared_value lookup_shared_value ctx0 ctx1) -let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) +let prepare_match_ctx_with_target (config : config) (span : Meta.span) (loop_id : LoopId.id) (fixed_ids : ids_sets) (src_ctx : eval_ctx) : cm_fun = - fun cf tgt_ctx -> + fun tgt_ctx -> (* Debug *) log#ldebug (lazy ("prepare_match_ctx_with_target:\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " - ^ eval_ctx_to_string ~meta:(Some meta) src_ctx + ^ eval_ctx_to_string ~span:(Some span) src_ctx ^ "\n- tgt_ctx: " - ^ eval_ctx_to_string ~meta:(Some meta) tgt_ctx)); + ^ eval_ctx_to_string ~span:(Some span) tgt_ctx)); (* End the loans which lead to mismatches when joining *) - let rec cf_reorganize_join_tgt : cm_fun = - fun cf tgt_ctx -> + let rec reorganize_join_tgt : cm_fun = + fun tgt_ctx -> (* Collect fixed values in the source and target contexts: end the loans in the source context which don't appear in the target context *) - let filt_src_env, _, _ = ctx_split_fixed_new meta fixed_ids src_ctx in - let filt_tgt_env, _, _ = ctx_split_fixed_new meta fixed_ids tgt_ctx in + let filt_src_env, _, _ = ctx_split_fixed_new span fixed_ids src_ctx in + let filt_tgt_env, _, _ = ctx_split_fixed_new span fixed_ids tgt_ctx in log#ldebug (lazy - ("cf_reorganize_join_tgt: match_ctx_with_target:\n" ^ "\n- fixed_ids: " - ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- filt_src_ctx: " - ^ env_to_string meta src_ctx filt_src_env + ("prepare_match_ctx_with_target: reorganize_join_tgt:\n" + ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" + ^ "\n- filt_src_ctx: " + ^ env_to_string span src_ctx filt_src_env ^ "\n- filt_tgt_ctx: " - ^ env_to_string meta tgt_ctx filt_tgt_env)); + ^ env_to_string span tgt_ctx filt_tgt_env)); (* Remove the abstractions *) let filter (ee : env_elem) : bool = @@ -1536,7 +1537,7 @@ let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) let nabs = ref [] in let module S : MatchJoinState = struct - let meta = meta + let span = span let loop_id = loop_id let nabs = nabs end in @@ -1548,25 +1549,25 @@ let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) (fun (var0, var1) -> match (var0, var1) with | EBinding (BDummy b0, v0), EBinding (BDummy b1, v1) -> - sanity_check __FILE__ __LINE__ (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) span; let _ = M.match_typed_values src_ctx tgt_ctx v0 v1 in () | EBinding (BVar b0, v0), EBinding (BVar b1, v1) -> - sanity_check __FILE__ __LINE__ (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) span; let _ = M.match_typed_values src_ctx tgt_ctx v0 v1 in () - | _ -> craise __FILE__ __LINE__ meta "Unexpected") + | _ -> craise __FILE__ __LINE__ span "Unexpected") (List.combine filt_src_env filt_tgt_env) in (* No exception was thrown: continue *) log#ldebug (lazy - ("cf_reorganize_join_tgt: done with borrows/loans:\n" - ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" - ^ "\n- filt_src_ctx: " - ^ env_to_string meta src_ctx filt_src_env + ("prepare_match_ctx_with_target: reorganize_join_tgt: done with \ + borrows/loans:\n" ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids + ^ "\n" ^ "\n- filt_src_ctx: " + ^ env_to_string span src_ctx filt_src_env ^ "\n- filt_tgt_ctx: " - ^ env_to_string meta tgt_ctx filt_tgt_env)); + ^ env_to_string span tgt_ctx filt_tgt_env)); (* We are done with the borrows/loans: now make sure we move all the values which are bottom in the src environment (i.e., the @@ -1575,7 +1576,7 @@ let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) environment *) let nvalues = ref [] in let module S : MatchMoveState = struct - let meta = meta + let span = span let loop_id = loop_id let nvalues = nvalues end in @@ -1586,14 +1587,14 @@ let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) (fun (var0, var1) -> match (var0, var1) with | EBinding (BDummy b0, v0), EBinding ((BDummy b1 as var1), v1) -> - sanity_check __FILE__ __LINE__ (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) span; let v = M.match_typed_values src_ctx tgt_ctx v0 v1 in (var1, v) | EBinding (BVar b0, v0), EBinding ((BVar b1 as var1), v1) -> - sanity_check __FILE__ __LINE__ (b0 = b1) meta; + sanity_check __FILE__ __LINE__ (b0 = b1) span; let v = M.match_typed_values src_ctx tgt_ctx v0 v1 in (var1, v) - | _ -> craise __FILE__ __LINE__ meta "Unexpected") + | _ -> craise __FILE__ __LINE__ span "Unexpected") (List.combine filt_src_env filt_tgt_env) in let var_to_new_val = BinderMap.of_list var_to_new_val in @@ -1619,33 +1620,36 @@ let prepare_match_ctx_with_target (config : config) (meta : Meta.meta) log#ldebug (lazy - ("cf_reorganize_join_tgt: done with borrows/loans and moves:\n" - ^ "\n- fixed_ids: " ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " - ^ eval_ctx_to_string ~meta:(Some meta) src_ctx + ("prepare_match_ctx_with_target: reorganize_join_tgt: done with \ + borrows/loans and moves:\n" ^ "\n- fixed_ids: " + ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " + ^ eval_ctx_to_string ~span:(Some span) src_ctx ^ "\n- tgt_ctx: " - ^ eval_ctx_to_string ~meta:(Some meta) tgt_ctx)); + ^ eval_ctx_to_string ~span:(Some span) tgt_ctx)); - cf tgt_ctx + (tgt_ctx, fun e -> e) with ValueMatchFailure e -> (* Exception: end the corresponding borrows, and continue *) - let cc = + let ctx, cc = match e with - | LoanInRight bid -> InterpreterBorrows.end_borrow config meta bid - | LoansInRight bids -> InterpreterBorrows.end_borrows config meta bids + | LoanInRight bid -> + InterpreterBorrows.end_borrow config span bid tgt_ctx + | LoansInRight bids -> + InterpreterBorrows.end_borrows config span bids tgt_ctx | AbsInRight _ | AbsInLeft _ | LoanInLeft _ | LoansInLeft _ -> - craise __FILE__ __LINE__ meta "Unexpected" + craise __FILE__ __LINE__ span "Unexpected" in - comp cc cf_reorganize_join_tgt cf tgt_ctx + comp cc (reorganize_join_tgt ctx) in (* Apply the reorganization *) - cf_reorganize_join_tgt cf tgt_ctx + reorganize_join_tgt tgt_ctx -let match_ctx_with_target (config : config) (meta : Meta.meta) +let match_ctx_with_target (config : config) (span : Meta.span) (loop_id : LoopId.id) (is_loop_entry : bool) (fp_bl_maps : borrow_loan_corresp) (fp_input_svalues : SymbolicValueId.id list) (fixed_ids : ids_sets) (src_ctx : eval_ctx) : st_cm_fun = - fun cf tgt_ctx -> + fun tgt_ctx -> (* Debug *) log#ldebug (lazy @@ -1658,8 +1662,8 @@ let match_ctx_with_target (config : config) (meta : Meta.meta) context, which results from joins during which we ended the loans which were introduced during the loop iterations) *) - let cf_reorganize_join_tgt = - prepare_match_ctx_with_target config meta loop_id fixed_ids src_ctx + let tgt_ctx, cc = + prepare_match_ctx_with_target config span loop_id fixed_ids src_ctx tgt_ctx in (* Introduce the "identity" abstractions for the loop re-entry. @@ -1679,290 +1683,285 @@ let match_ctx_with_target (config : config) (meta : Meta.meta) We should rely on a more primitive and safer function [add_identity_abs] to add the identity abstractions one by one. *) - let cf_introduce_loop_fp_abs : m_fun = - fun tgt_ctx -> - (* Match the source and target contexts *) - log#ldebug - (lazy - ("cf_introduce_loop_fp_abs:\n" ^ "\n- fixed_ids: " - ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " - ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx: " - ^ eval_ctx_to_string tgt_ctx)); - - let filt_tgt_env, _, _ = ctx_split_fixed_new meta fixed_ids tgt_ctx in - let filt_src_env, new_absl, new_dummyl = - ctx_split_fixed_new meta fixed_ids src_ctx - in - sanity_check __FILE__ __LINE__ (new_dummyl = []) meta; - let filt_tgt_ctx = { tgt_ctx with env = filt_tgt_env } in - let filt_src_ctx = { src_ctx with env = filt_src_env } in - - let src_to_tgt_maps = - let check_equiv = false in - let fixed_ids = ids_sets_empty_borrows_loans fixed_ids in - let open InterpreterBorrowsCore in - let lookup_shared_loan lid ctx : typed_value = - match snd (lookup_loan meta ek_all lid ctx) with - | Concrete (VSharedLoan (_, v)) -> v - | Abstract (ASharedLoan (_, v, _)) -> v - | _ -> craise __FILE__ __LINE__ meta "Unreachable" - in - let lookup_in_src id = lookup_shared_loan id src_ctx in - let lookup_in_tgt id = lookup_shared_loan id tgt_ctx in - (* Match *) - Option.get - (match_ctxs meta check_equiv fixed_ids lookup_in_src lookup_in_tgt - filt_src_ctx filt_tgt_ctx) - in - let tgt_to_src_borrow_map = - BorrowId.Map.of_list - (List.map - (fun (x, y) -> (y, x)) - (BorrowId.InjSubst.bindings src_to_tgt_maps.borrow_id_map)) + (* Match the source and target contexts *) + log#ldebug + (lazy + ("cf_introduce_loop_fp_abs:\n" ^ "\n- fixed_ids: " + ^ show_ids_sets fixed_ids ^ "\n" ^ "\n- src_ctx: " + ^ eval_ctx_to_string src_ctx ^ "\n- tgt_ctx: " ^ eval_ctx_to_string tgt_ctx + )); + + let filt_tgt_env, _, _ = ctx_split_fixed_new span fixed_ids tgt_ctx in + let filt_src_env, new_absl, new_dummyl = + ctx_split_fixed_new span fixed_ids src_ctx + in + sanity_check __FILE__ __LINE__ (new_dummyl = []) span; + let filt_tgt_ctx = { tgt_ctx with env = filt_tgt_env } in + let filt_src_ctx = { src_ctx with env = filt_src_env } in + + let src_to_tgt_maps = + let check_equiv = false in + let fixed_ids = ids_sets_empty_borrows_loans fixed_ids in + let open InterpreterBorrowsCore in + let lookup_shared_loan lid ctx : typed_value = + match snd (lookup_loan span ek_all lid ctx) with + | Concrete (VSharedLoan (_, v)) -> v + | Abstract (ASharedLoan (_, v, _)) -> v + | _ -> craise __FILE__ __LINE__ span "Unreachable" in + let lookup_in_src id = lookup_shared_loan id src_ctx in + let lookup_in_tgt id = lookup_shared_loan id tgt_ctx in + (* Match *) + Option.get + (match_ctxs span check_equiv fixed_ids lookup_in_src lookup_in_tgt + filt_src_ctx filt_tgt_ctx) + in + let tgt_to_src_borrow_map = + BorrowId.Map.of_list + (List.map + (fun (x, y) -> (y, x)) + (BorrowId.InjSubst.bindings src_to_tgt_maps.borrow_id_map)) + in - (* Debug *) - log#ldebug - (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs:" ^ "\n\n- src_ctx: " - ^ eval_ctx_to_string ~meta:(Some meta) src_ctx - ^ "\n\n- tgt_ctx: " - ^ eval_ctx_to_string ~meta:(Some meta) tgt_ctx - ^ "\n\n- filt_tgt_ctx: " - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) filt_tgt_ctx - ^ "\n\n- filt_src_ctx: " - ^ eval_ctx_to_string_no_filter ~meta:(Some meta) filt_src_ctx - ^ "\n\n- new_absl:\n" - ^ eval_ctx_to_string ~meta:(Some meta) - { src_ctx with env = List.map (fun abs -> EAbs abs) new_absl } - ^ "\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- fp_bl_maps:\n" - ^ show_borrow_loan_corresp fp_bl_maps - ^ "\n\n- src_to_tgt_maps: " - ^ show_ids_maps src_to_tgt_maps)); - - (* Update the borrows and symbolic ids in the source context. - - Going back to the [list_nth_mut_example], the original environment upon - re-entering the loop is: - - {[ + (* Debug *) + log#ldebug + (lazy + ("match_ctx_with_target: cf_introduce_loop_fp_abs:" ^ "\n\n- src_ctx: " + ^ eval_ctx_to_string ~span:(Some span) src_ctx + ^ "\n\n- tgt_ctx: " + ^ eval_ctx_to_string ~span:(Some span) tgt_ctx + ^ "\n\n- filt_tgt_ctx: " + ^ eval_ctx_to_string_no_filter ~span:(Some span) filt_tgt_ctx + ^ "\n\n- filt_src_ctx: " + ^ eval_ctx_to_string_no_filter ~span:(Some span) filt_src_ctx + ^ "\n\n- new_absl:\n" + ^ eval_ctx_to_string ~span:(Some span) + { src_ctx with env = List.map (fun abs -> EAbs abs) new_absl } + ^ "\n\n- fixed_ids:\n" ^ show_ids_sets fixed_ids ^ "\n\n- fp_bl_maps:\n" + ^ show_borrow_loan_corresp fp_bl_maps + ^ "\n\n- src_to_tgt_maps: " + ^ show_ids_maps src_to_tgt_maps)); + + (* Update the borrows and symbolic ids in the source context. + + Going back to the [list_nth_mut_example], the original environment upon + re-entering the loop is: + + {[ + abs@0 { ML l0 } + ls -> MB l5 (s@6 : loops::List<T>) + i -> s@7 : u32 + _@1 -> MB l0 (loops::List::Cons (ML l1, ML l2)) + _@2 -> MB l2 (@Box (ML l4)) // tail + _@3 -> MB l1 (s@3 : T) // hd + abs@1 { MB l4, ML l5 } + ]} + + The fixed-point environment is: + {[ + env_fp = { abs@0 { ML l0 } - ls -> MB l5 (s@6 : loops::List<T>) - i -> s@7 : u32 - _@1 -> MB l0 (loops::List::Cons (ML l1, ML l2)) - _@2 -> MB l2 (@Box (ML l4)) // tail - _@3 -> MB l1 (s@3 : T) // hd - abs@1 { MB l4, ML l5 } - ]} - - The fixed-point environment is: - {[ - env_fp = { - abs@0 { ML l0 } - ls -> MB l1 (s3 : loops::List<T>) - i -> s4 : u32 - abs@fp { - MB l0 // this borrow appears in [env0] - ML l1 - } + ls -> MB l1 (s3 : loops::List<T>) + i -> s4 : u32 + abs@fp { + MB l0 // this borrow appears in [env0] + ML l1 } - ]} + } + ]} + + Through matching, we detect that in [env_fp], [l1] is matched + to [l5]. We introduce a fresh borrow [l6] for [l1], and remember + in the map [src_fresh_borrows_map] that: [{ l1 -> l6}]. + + We get: + {[ + abs@0 { ML l0 } + ls -> MB l6 (s@6 : loops::List<T>) // l6 is fresh and doesn't have a corresponding loan + i -> s@7 : u32 + _@1 -> MB l0 (loops::List::Cons (ML l1, ML l2)) + _@2 -> MB l2 (@Box (ML l4)) // tail + _@3 -> MB l1 (s@3 : T) // hd + abs@1 { MB l4, ML l5 } + ]} + + Later, we will introduce the identity abstraction: + {[ + abs@2 { MB l5, ML l6 } + ]} + *) + (* First, compute the set of borrows which appear in the fresh abstractions + of the fixed-point: we want to introduce fresh ids only for those. *) + let new_absl_ids, _ = compute_absl_ids new_absl in + let src_fresh_borrows_map = ref BorrowId.Map.empty in + let visit_tgt = + object + inherit [_] map_eval_ctx + + method! visit_borrow_id _ id = + (* Map the borrow, if it needs to be mapped *) + if + (* We map the borrows for which we computed a mapping *) + BorrowId.InjSubst.Set.mem id + (BorrowId.InjSubst.elements src_to_tgt_maps.borrow_id_map) + (* And which have corresponding loans in the fresh fixed-point abstractions *) + && BorrowId.Set.mem + (BorrowId.Map.find id tgt_to_src_borrow_map) + new_absl_ids.loan_ids + then ( + let src_id = BorrowId.Map.find id tgt_to_src_borrow_map in + let nid = fresh_borrow_id () in + src_fresh_borrows_map := + BorrowId.Map.add src_id nid !src_fresh_borrows_map; + nid) + else id + end + in - Through matching, we detect that in [env_fp], [l1] is matched - to [l5]. We introduce a fresh borrow [l6] for [l1], and remember - in the map [src_fresh_borrows_map] that: [{ l1 -> l6}]. + let tgt_ctx = visit_tgt#visit_eval_ctx () tgt_ctx in - We get: - {[ - abs@0 { ML l0 } - ls -> MB l6 (s@6 : loops::List<T>) // l6 is fresh and doesn't have a corresponding loan - i -> s@7 : u32 - _@1 -> MB l0 (loops::List::Cons (ML l1, ML l2)) - _@2 -> MB l2 (@Box (ML l4)) // tail - _@3 -> MB l1 (s@3 : T) // hd - abs@1 { MB l4, ML l5 } - ]} - - Later, we will introduce the identity abstraction: - {[ - abs@2 { MB l5, ML l6 } - ]} - *) - (* First, compute the set of borrows which appear in the fresh abstractions - of the fixed-point: we want to introduce fresh ids only for those. *) - let new_absl_ids, _ = compute_absl_ids new_absl in - let src_fresh_borrows_map = ref BorrowId.Map.empty in - let visit_tgt = - object - inherit [_] map_eval_ctx - - method! visit_borrow_id _ id = - (* Map the borrow, if it needs to be mapped *) - if - (* We map the borrows for which we computed a mapping *) - BorrowId.InjSubst.Set.mem id - (BorrowId.InjSubst.elements src_to_tgt_maps.borrow_id_map) - (* And which have corresponding loans in the fresh fixed-point abstractions *) - && BorrowId.Set.mem - (BorrowId.Map.find id tgt_to_src_borrow_map) - new_absl_ids.loan_ids - then ( - let src_id = BorrowId.Map.find id tgt_to_src_borrow_map in - let nid = fresh_borrow_id () in - src_fresh_borrows_map := - BorrowId.Map.add src_id nid !src_fresh_borrows_map; - nid) - else id - end - in - let tgt_ctx = visit_tgt#visit_eval_ctx () tgt_ctx in + log#ldebug + (lazy + ("match_ctx_with_target: cf_introduce_loop_fp_abs: src_fresh_borrows_map:\n" + ^ BorrowId.Map.show BorrowId.to_string !src_fresh_borrows_map + ^ "\n")); - log#ldebug - (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: \ - src_fresh_borrows_map:\n" - ^ BorrowId.Map.show BorrowId.to_string !src_fresh_borrows_map - ^ "\n")); + (* Rem.: we don't update the symbolic values. It is not necessary + because there shouldn't be any symbolic value containing borrows. - (* Rem.: we don't update the symbolic values. It is not necessary - because there shouldn't be any symbolic value containing borrows. + Rem.: we will need to do something about the symbolic values in the + abstractions and in the *variable bindings* once we allow symbolic + values containing borrows to not be eagerly expanded. + *) + sanity_check __FILE__ __LINE__ Config.greedy_expand_symbolics_with_borrows + span; + + (* Update the borrows and loans in the abstractions of the target context. + + Going back to the [list_nth_mut] example and by using [src_fresh_borrows_map], + we instantiate the fixed-point abstractions that we will insert into the + context. + The abstraction is [abs { MB l0, ML l1 }]. + Because of [src_fresh_borrows_map], we substitute [l1] with [l6]. + Because of the match between the contexts, we substitute [l0] with [l5]. + We get: + {[ + abs@2 { MB l5, ML l6 } + ]} + *) + let region_id_map = ref RegionId.Map.empty in + let get_rid rid = + match RegionId.Map.find_opt rid !region_id_map with + | Some rid -> rid + | None -> + let nid = fresh_region_id () in + region_id_map := RegionId.Map.add rid nid !region_id_map; + nid + in + let visit_src = + object + inherit [_] map_eval_ctx as super - Rem.: we will need to do something about the symbolic values in the - abstractions and in the *variable bindings* once we allow symbolic - values containing borrows to not be eagerly expanded. - *) - sanity_check __FILE__ __LINE__ Config.greedy_expand_symbolics_with_borrows - meta; - - (* Update the borrows and loans in the abstractions of the target context. - - Going back to the [list_nth_mut] example and by using [src_fresh_borrows_map], - we instantiate the fixed-point abstractions that we will insert into the - context. - The abstraction is [abs { MB l0, ML l1 }]. - Because of [src_fresh_borrows_map], we substitute [l1] with [l6]. - Because of the match between the contexts, we substitute [l0] with [l5]. - We get: - {[ - abs@2 { MB l5, ML l6 } - ]} - *) - let region_id_map = ref RegionId.Map.empty in - let get_rid rid = - match RegionId.Map.find_opt rid !region_id_map with - | Some rid -> rid - | None -> - let nid = fresh_region_id () in - region_id_map := RegionId.Map.add rid nid !region_id_map; - nid - in - let visit_src = - object - inherit [_] map_eval_ctx as super + method! visit_borrow_id _ bid = + log#ldebug + (lazy + ("match_ctx_with_target: cf_introduce_loop_fp_abs: \ + visit_borrow_id: " ^ BorrowId.to_string bid ^ "\n")); - method! visit_borrow_id _ bid = - log#ldebug - (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: \ - visit_borrow_id: " ^ BorrowId.to_string bid ^ "\n")); + (* Lookup the id of the loan corresponding to this borrow *) + let src_lid = + BorrowId.InjSubst.find bid fp_bl_maps.borrow_to_loan_id_map + in - (* Lookup the id of the loan corresponding to this borrow *) - let src_lid = - BorrowId.InjSubst.find bid fp_bl_maps.borrow_to_loan_id_map - in + log#ldebug + (lazy + ("match_ctx_with_target: cf_introduce_loop_fp_abs: looked up \ + src_lid: " ^ BorrowId.to_string src_lid ^ "\n")); - log#ldebug - (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: looked up \ - src_lid: " ^ BorrowId.to_string src_lid ^ "\n")); + (* Lookup the tgt borrow id to which this borrow was mapped *) + let tgt_bid = + BorrowId.InjSubst.find src_lid src_to_tgt_maps.borrow_id_map + in - (* Lookup the tgt borrow id to which this borrow was mapped *) - let tgt_bid = - BorrowId.InjSubst.find src_lid src_to_tgt_maps.borrow_id_map - in + log#ldebug + (lazy + ("match_ctx_with_target: cf_introduce_loop_fp_abs: looked up \ + tgt_bid: " ^ BorrowId.to_string tgt_bid ^ "\n")); - log#ldebug - (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: looked up \ - tgt_bid: " ^ BorrowId.to_string tgt_bid ^ "\n")); + tgt_bid - tgt_bid + method! visit_loan_id _ id = + log#ldebug + (lazy + ("match_ctx_with_target: cf_introduce_loop_fp_abs: visit_loan_id: " + ^ BorrowId.to_string id ^ "\n")); + (* Map the borrow - rem.: we mapped the borrows *in the values*, + meaning we know how to map the *corresponding loans in the + abstractions* *) + match BorrowId.Map.find_opt id !src_fresh_borrows_map with + | None -> + (* No mapping: this means that the borrow was mapped when + we matched values (it doesn't come from a fresh abstraction) + and because of this, it should actually be mapped to itself *) + sanity_check __FILE__ __LINE__ + (BorrowId.InjSubst.find id src_to_tgt_maps.borrow_id_map = id) + span; + id + | Some id -> id + + method! visit_symbolic_value_id _ _ = fresh_symbolic_value_id () + method! visit_abstraction_id _ _ = fresh_abstraction_id () + method! visit_region_id _ id = get_rid id + + (** We also need to change the abstraction kind *) + method! visit_abs env abs = + match abs.kind with + | Loop (loop_id', rg_id, kind) -> + sanity_check __FILE__ __LINE__ (loop_id' = loop_id) span; + sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) span; + let can_end = false in + let kind : abs_kind = Loop (loop_id, rg_id, LoopCall) in + let abs = { abs with kind; can_end } in + super#visit_abs env abs + | _ -> super#visit_abs env abs + end + in + let new_absl = List.map (visit_src#visit_abs ()) new_absl in + let new_absl = List.map (fun abs -> EAbs abs) new_absl in - method! visit_loan_id _ id = - log#ldebug - (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: \ - visit_loan_id: " ^ BorrowId.to_string id ^ "\n")); - (* Map the borrow - rem.: we mapped the borrows *in the values*, - meaning we know how to map the *corresponding loans in the - abstractions* *) - match BorrowId.Map.find_opt id !src_fresh_borrows_map with - | None -> - (* No mapping: this means that the borrow was mapped when - we matched values (it doesn't come from a fresh abstraction) - and because of this, it should actually be mapped to itself *) - sanity_check __FILE__ __LINE__ - (BorrowId.InjSubst.find id src_to_tgt_maps.borrow_id_map = id) - meta; - id - | Some id -> id - - method! visit_symbolic_value_id _ _ = fresh_symbolic_value_id () - method! visit_abstraction_id _ _ = fresh_abstraction_id () - method! visit_region_id _ id = get_rid id - - (** We also need to change the abstraction kind *) - method! visit_abs env abs = - match abs.kind with - | Loop (loop_id', rg_id, kind) -> - sanity_check __FILE__ __LINE__ (loop_id' = loop_id) meta; - sanity_check __FILE__ __LINE__ (kind = LoopSynthInput) meta; - let can_end = false in - let kind : abs_kind = Loop (loop_id, rg_id, LoopCall) in - let abs = { abs with kind; can_end } in - super#visit_abs env abs - | _ -> super#visit_abs env abs - end - in - let new_absl = List.map (visit_src#visit_abs ()) new_absl in - let new_absl = List.map (fun abs -> EAbs abs) new_absl in + (* Add the abstractions from the target context to the source context *) + let nenv = List.append new_absl tgt_ctx.env in + let tgt_ctx = { tgt_ctx with env = nenv } in - (* Add the abstractions from the target context to the source context *) - let nenv = List.append new_absl tgt_ctx.env in - let tgt_ctx = { tgt_ctx with env = nenv } in + log#ldebug + (lazy + ("match_ctx_with_target: cf_introduce_loop_fp_abs: done:\n- result ctx:\n" + ^ eval_ctx_to_string ~span:(Some span) tgt_ctx)); + + (* Sanity check *) + if !Config.sanity_checks then + Invariants.check_borrowed_values_invariant span tgt_ctx; + (* End all the borrows which appear in the *new* abstractions *) + let new_borrows = + BorrowId.Set.of_list + (List.map snd (BorrowId.Map.bindings !src_fresh_borrows_map)) + in + let tgt_ctx, cc = + comp cc (InterpreterBorrows.end_borrows config span new_borrows tgt_ctx) + in - log#ldebug - (lazy - ("match_ctx_with_target: cf_introduce_loop_fp_abs: done:\n\ - - result ctx:\n" - ^ eval_ctx_to_string ~meta:(Some meta) tgt_ctx)); - - (* Sanity check *) - if !Config.sanity_checks then - Invariants.check_borrowed_values_invariant meta tgt_ctx; - (* End all the borrows which appear in the *new* abstractions *) - let new_borrows = - BorrowId.Set.of_list - (List.map snd (BorrowId.Map.bindings !src_fresh_borrows_map)) - in - let cc = InterpreterBorrows.end_borrows config meta new_borrows in - - (* Compute the loop input values *) - let input_values = - SymbolicValueId.Map.of_list - (List.map - (fun sid -> - (sid, SymbolicValueId.Map.find sid src_to_tgt_maps.sid_to_value_map)) - fp_input_svalues) - in + (* Compute the loop input values *) + let input_values = + SymbolicValueId.Map.of_list + (List.map + (fun sid -> + (sid, SymbolicValueId.Map.find sid src_to_tgt_maps.sid_to_value_map)) + fp_input_svalues) + in - (* Continue *) - cc - (cf - (if is_loop_entry then EndEnterLoop (loop_id, input_values) - else EndContinue (loop_id, input_values))) - tgt_ctx + let res = + if is_loop_entry then EndEnterLoop (loop_id, input_values) + else EndContinue (loop_id, input_values) in - (* Compose and continue *) - cf_reorganize_join_tgt cf_introduce_loop_fp_abs tgt_ctx + ((tgt_ctx, res), cc) diff --git a/compiler/InterpreterLoopsMatchCtxs.mli b/compiler/InterpreterLoopsMatchCtxs.mli index a8002ad4..ab585220 100644 --- a/compiler/InterpreterLoopsMatchCtxs.mli +++ b/compiler/InterpreterLoopsMatchCtxs.mli @@ -19,7 +19,7 @@ open InterpreterLoopsCore - [env] *) val compute_abs_borrows_loans_maps : - Meta.meta -> bool -> (abs -> bool) -> env -> abs_borrows_loans_maps + Meta.span -> bool -> (abs -> bool) -> env -> abs_borrows_loans_maps (** Generic functor to implement matching functions between values, environments, etc. @@ -91,7 +91,7 @@ module MakeCheckEquivMatcher : functor (_ : MatchCheckEquivState) -> We return an optional ids map: [Some] if the match succeeded, [None] otherwise. *) val match_ctxs : - Meta.meta -> + Meta.span -> bool -> ids_sets -> (loan_id -> typed_value) -> @@ -136,7 +136,7 @@ val match_ctxs : - [ctx0] - [ctx1] *) -val ctxs_are_equivalent : Meta.meta -> ids_sets -> eval_ctx -> eval_ctx -> bool +val ctxs_are_equivalent : Meta.span -> ids_sets -> eval_ctx -> eval_ctx -> bool (** Reorganize a target context so that we can match it with a source context (remember that the source context is generally the fixed point context, @@ -151,7 +151,7 @@ val ctxs_are_equivalent : Meta.meta -> ids_sets -> eval_ctx -> eval_ctx -> bool *) val prepare_match_ctx_with_target : - config -> Meta.meta -> LoopId.id -> ids_sets -> eval_ctx -> cm_fun + config -> Meta.span -> LoopId.id -> ids_sets -> eval_ctx -> cm_fun (** Match a context with a target context. @@ -301,7 +301,7 @@ val prepare_match_ctx_with_target : *) val match_ctx_with_target : config -> - Meta.meta -> + Meta.span -> loop_id -> bool -> borrow_loan_corresp -> diff --git a/compiler/InterpreterPaths.ml b/compiler/InterpreterPaths.ml index ab3daa72..faba1088 100644 --- a/compiler/InterpreterPaths.ml +++ b/compiler/InterpreterPaths.ml @@ -69,7 +69,7 @@ type projection_access = { TODO: use exceptions? *) -let rec access_projection (meta : Meta.meta) (access : projection_access) +let rec access_projection (span : Meta.span) (access : projection_access) (ctx : eval_ctx) (* Function to (eventually) update the value we find *) (update : typed_value -> typed_value) (p : projection) (v : typed_value) : @@ -87,7 +87,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) (lazy ("Not the same type:\n- nv.ty: " ^ show_ety nv.ty ^ "\n- v.ty: " ^ show_ety v.ty)); - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Assertion failed: new value doesn't have the same type as its \ destination"); Ok (ctx, { read = v; updated = nv }) @@ -100,14 +100,14 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) (* Check consistency *) (match (proj_kind, type_id) with | ProjAdt (def_id, opt_variant_id), TAdtId def_id' -> - sanity_check __FILE__ __LINE__ (def_id = def_id') meta; + sanity_check __FILE__ __LINE__ (def_id = def_id') span; sanity_check __FILE__ __LINE__ (opt_variant_id = adt.variant_id) - meta - | _ -> craise __FILE__ __LINE__ meta "Unreachable"); + span + | _ -> craise __FILE__ __LINE__ span "Unreachable"); (* Actually project *) let fv = FieldId.nth adt.field_values field_id in - match access_projection meta access ctx update p' fv with + match access_projection span access ctx update p' fv with | Error err -> Error err | Ok (ctx, res) -> (* Update the field value *) @@ -121,10 +121,10 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) | Field (ProjTuple arity, field_id), VAdt adt, TAdt (TTuple, _) -> ( sanity_check __FILE__ __LINE__ (arity = List.length adt.field_values) - meta; + span; let fv = FieldId.nth adt.field_values field_id in (* Project *) - match access_projection meta access ctx update p' fv with + match access_projection span access ctx update p' fv with | Error err -> Error err | Ok (ctx, res) -> (* Update the field value *) @@ -151,7 +151,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) * it shouldn't happen due to user code, and we leverage it * when implementing box dereferencement for the concrete * interpreter *) - match access_projection meta access ctx update p' bv with + match access_projection span access ctx update p' bv with | Error err -> Error err | Ok (ctx, res) -> let nv = @@ -168,18 +168,18 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) | VSharedBorrow bid -> (* Lookup the loan content, and explore from there *) if access.lookup_shared_borrows then - match lookup_loan meta ek bid ctx with + match lookup_loan span ek bid ctx with | _, Concrete (VMutLoan _) -> - craise __FILE__ __LINE__ meta "Expected a shared loan" + craise __FILE__ __LINE__ span "Expected a shared loan" | _, Concrete (VSharedLoan (bids, sv)) -> ( (* Explore the shared value *) - match access_projection meta access ctx update p' sv with + match access_projection span access ctx update p' sv with | Error err -> Error err | Ok (ctx, res) -> (* Update the shared loan with the new value returned by {!access_projection} *) let ctx = - update_loan meta ek bid + update_loan span ek bid (VSharedLoan (bids, res.updated)) ctx in @@ -189,29 +189,29 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) Abstract ( AMutLoan (_, _) | AEndedMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AEndedSharedLoan (_, _) | AIgnoredMutLoan (_, _) | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } + { given_back = _; child = _; given_back_span = _ } | AIgnoredSharedLoan _ ) ) -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Expected a shared (abstraction) loan" | _, Abstract (ASharedLoan (bids, sv, _av)) -> ( (* Explore the shared value *) - match access_projection meta access ctx update p' sv with + match access_projection span access ctx update p' sv with | Error err -> Error err | Ok (ctx, res) -> (* Relookup the child avalue *) let av = - match lookup_loan meta ek bid ctx with + match lookup_loan span ek bid ctx with | _, Abstract (ASharedLoan (_, _, av)) -> av - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in (* Update the shared loan with the new value returned by {!access_projection} *) let ctx = - update_aloan meta ek bid + update_aloan span ek bid (ASharedLoan (bids, res.updated, av)) ctx in @@ -221,7 +221,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) | VReservedMutBorrow bid -> Error (FailReservedMutBorrow bid) | VMutBorrow (bid, bv) -> if access.enter_mut_borrows then - match access_projection meta access ctx update p' bv with + match access_projection span access ctx update p' bv with | Error err -> Error err | Ok (ctx, res) -> let nv = @@ -238,7 +238,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) we mustn't ignore the current projection element *) if access.enter_shared_loans then match - access_projection meta access ctx update (pe :: p') sv + access_projection span access ctx update (pe :: p') sv with | Error err -> Error err | Ok (ctx, res) -> @@ -252,7 +252,7 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) let pe = "- pe: " ^ show_projection_elem pe in let v = "- v:\n" ^ show_value v in let ty = "- ty:\n" ^ show_ety ty in - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Inconsistent projection:\n" ^ pe ^ "\n" ^ v ^ "\n" ^ ty)) (** Generic function to access (read/write) the value at a given place. @@ -261,18 +261,18 @@ let rec access_projection (meta : Meta.meta) (access : projection_access) environment, if we managed to access the place, or the precise reason why we failed. *) -let access_place (meta : Meta.meta) (access : projection_access) +let access_place (span : Meta.span) (access : projection_access) (* Function to (eventually) update the value we find *) (update : typed_value -> typed_value) (p : place) (ctx : eval_ctx) : (eval_ctx * typed_value) path_access_result = (* Lookup the variable's value *) - let value = ctx_lookup_var_value meta ctx p.var_id in + let value = ctx_lookup_var_value span ctx p.var_id in (* Apply the projection *) - match access_projection meta access ctx update p.projection value with + match access_projection span access ctx update p.projection value with | Error err -> Error err | Ok (ctx, res) -> (* Update the value *) - let ctx = ctx_update_var_value meta ctx p.var_id res.updated in + let ctx = ctx_update_var_value span ctx p.var_id res.updated in (* Return *) Ok (ctx, res.read) @@ -308,12 +308,12 @@ let access_kind_to_projection_access (access : access_kind) : projection_access Note that we only access the value at the place, and do not check that the value is "well-formed" (for instance that it doesn't contain bottoms). *) -let try_read_place (meta : Meta.meta) (access : access_kind) (p : place) +let try_read_place (span : Meta.span) (access : access_kind) (p : place) (ctx : eval_ctx) : typed_value path_access_result = let access = access_kind_to_projection_access access in (* The update function is the identity *) let update v = v in - match access_place meta access update p ctx with + match access_place span access update p ctx with | Error err -> Error err | Ok (ctx1, read_value) -> (* Note that we ignore the new environment: it should be the same as the @@ -325,41 +325,41 @@ let try_read_place (meta : Meta.meta) (access : access_kind) (p : place) "Unexpected environment update:\nNew environment:\n" ^ show_env ctx1.env ^ "\n\nOld environment:\n" ^ show_env ctx.env in - craise __FILE__ __LINE__ meta msg); + craise __FILE__ __LINE__ span msg); Ok read_value -let read_place (meta : Meta.meta) (access : access_kind) (p : place) +let read_place (span : Meta.span) (access : access_kind) (p : place) (ctx : eval_ctx) : typed_value = - match try_read_place meta access p ctx with + match try_read_place span access p ctx with | Error e -> - craise __FILE__ __LINE__ meta ("Unreachable: " ^ show_path_fail_kind e) + craise __FILE__ __LINE__ span ("Unreachable: " ^ show_path_fail_kind e) | Ok v -> v (** Attempt to update the value at a given place *) -let try_write_place (meta : Meta.meta) (access : access_kind) (p : place) +let try_write_place (span : Meta.span) (access : access_kind) (p : place) (nv : typed_value) (ctx : eval_ctx) : eval_ctx path_access_result = let access = access_kind_to_projection_access access in (* The update function substitutes the value with the new value *) let update _ = nv in - match access_place meta access update p ctx with + match access_place span access update p ctx with | Error err -> Error err | Ok (ctx, _) -> (* We ignore the read value *) Ok ctx -let write_place (meta : Meta.meta) (access : access_kind) (p : place) +let write_place (span : Meta.span) (access : access_kind) (p : place) (nv : typed_value) (ctx : eval_ctx) : eval_ctx = - match try_write_place meta access p nv ctx with + match try_write_place span access p nv ctx with | Error e -> - craise __FILE__ __LINE__ meta ("Unreachable: " ^ show_path_fail_kind e) + craise __FILE__ __LINE__ span ("Unreachable: " ^ show_path_fail_kind e) | Ok ctx -> ctx -let compute_expanded_bottom_adt_value (meta : Meta.meta) (ctx : eval_ctx) +let compute_expanded_bottom_adt_value (span : Meta.span) (ctx : eval_ctx) (def_id : TypeDeclId.id) (opt_variant_id : VariantId.id option) (generics : generic_args) : typed_value = sanity_check __FILE__ __LINE__ (TypesUtils.generic_args_only_erased_regions generics) - meta; + span; (* Lookup the definition and check if it is an enumeration - it should be an enumeration if and only if the projection element is a field projection with *some* variant id. Retrieve the list @@ -367,22 +367,22 @@ let compute_expanded_bottom_adt_value (meta : Meta.meta) (ctx : eval_ctx) let def = ctx_lookup_type_decl ctx def_id in sanity_check __FILE__ __LINE__ (List.length generics.regions = List.length def.generics.regions) - meta; + span; (* Compute the field types *) let field_types = - AssociatedTypes.type_decl_get_inst_norm_field_etypes meta ctx def + AssociatedTypes.type_decl_get_inst_norm_field_etypes span ctx def opt_variant_id generics in (* Initialize the expanded value *) - let fields = List.map (mk_bottom meta) field_types in + let fields = List.map (mk_bottom span) field_types in let av = VAdt { variant_id = opt_variant_id; field_values = fields } in let ty = TAdt (TAdtId def_id, generics) in { value = av; ty } -let compute_expanded_bottom_tuple_value (meta : Meta.meta) +let compute_expanded_bottom_tuple_value (span : Meta.span) (field_types : ety list) : typed_value = (* Generate the field values *) - let fields = List.map (mk_bottom meta) field_types in + let fields = List.map (mk_bottom span) field_types in let v = VAdt { variant_id = None; field_values = fields } in let generics = TypesUtils.mk_generic_args [] field_types [] [] in let ty = TAdt (TTuple, generics) in @@ -409,7 +409,7 @@ let compute_expanded_bottom_tuple_value (meta : Meta.meta) about which variant we should project to, which is why we *can* set the variant index when writing one of its fields). *) -let expand_bottom_value_from_projection (meta : Meta.meta) +let expand_bottom_value_from_projection (span : Meta.span) (access : access_kind) (p : place) (remaining_pes : int) (pe : projection_elem) (ty : ety) (ctx : eval_ctx) : eval_ctx = (* Debugging *) @@ -438,39 +438,39 @@ let expand_bottom_value_from_projection (meta : Meta.meta) (* "Regular" ADTs *) | ( Field (ProjAdt (def_id, opt_variant_id), _), TAdt (TAdtId def_id', generics) ) -> - sanity_check __FILE__ __LINE__ (def_id = def_id') meta; - compute_expanded_bottom_adt_value meta ctx def_id opt_variant_id + sanity_check __FILE__ __LINE__ (def_id = def_id') span; + compute_expanded_bottom_adt_value span ctx def_id opt_variant_id generics (* Tuples *) | ( Field (ProjTuple arity, _), TAdt (TTuple, { regions = []; types; const_generics = []; trait_refs = [] }) ) -> - sanity_check __FILE__ __LINE__ (arity = List.length types) meta; + sanity_check __FILE__ __LINE__ (arity = List.length types) span; (* Generate the field values *) - compute_expanded_bottom_tuple_value meta types + compute_expanded_bottom_tuple_value span types | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Unreachable: " ^ show_projection_elem pe ^ ", " ^ show_ety ty) in (* Update the context by inserting the expanded value at the proper place *) - match try_write_place meta access p' nv ctx with + match try_write_place span access p' nv ctx with | Ok ctx -> ctx - | Error _ -> craise __FILE__ __LINE__ meta "Unreachable" + | Error _ -> craise __FILE__ __LINE__ span "Unreachable" -let rec update_ctx_along_read_place (config : config) (meta : Meta.meta) +let rec update_ctx_along_read_place (config : config) (span : Meta.span) (access : access_kind) (p : place) : cm_fun = - fun cf ctx -> + fun ctx -> (* Attempt to read the place: if it fails, update the environment and retry *) - match try_read_place meta access p ctx with - | Ok _ -> cf ctx + match try_read_place span access p ctx with + | Ok _ -> (ctx, fun e -> e) | Error err -> - let cc = + let ctx, cc = match err with - | FailSharedLoan bids -> end_borrows config meta bids - | FailMutLoan bid -> end_borrow config meta bid + | FailSharedLoan bids -> end_borrows config span bids ctx + | FailMutLoan bid -> end_borrow config span bid ctx | FailReservedMutBorrow bid -> - promote_reserved_mut_borrow config meta bid + promote_reserved_mut_borrow config span bid ctx | FailSymbolic (i, sp) -> (* Expand the symbolic value *) let proj, _ = @@ -478,55 +478,56 @@ let rec update_ctx_along_read_place (config : config) (meta : Meta.meta) (List.length p.projection - i) in let prefix = { p with projection = proj } in - expand_symbolic_value_no_branching config meta sp - (Some (Synth.mk_mplace meta prefix ctx)) + expand_symbolic_value_no_branching config span sp + (Some (Synth.mk_mplace span prefix ctx)) + ctx | FailBottom (_, _, _) -> (* We can't expand {!Bottom} values while reading them *) - craise __FILE__ __LINE__ meta "Found bottom while reading a place" + craise __FILE__ __LINE__ span "Found bottom while reading a place" | FailBorrow _ -> - craise __FILE__ __LINE__ meta "Could not read a borrow" + craise __FILE__ __LINE__ span "Could not read a borrow" in - comp cc (update_ctx_along_read_place config meta access p) cf ctx + comp cc (update_ctx_along_read_place config span access p ctx) -let rec update_ctx_along_write_place (config : config) (meta : Meta.meta) +let rec update_ctx_along_write_place (config : config) (span : Meta.span) (access : access_kind) (p : place) : cm_fun = - fun cf ctx -> + fun ctx -> (* Attempt to *read* (yes, *read*: we check the access to the place, and write to it later) the place: if it fails, update the environment and retry *) - match try_read_place meta access p ctx with - | Ok _ -> cf ctx + match try_read_place span access p ctx with + | Ok _ -> (ctx, fun e -> e) | Error err -> (* Update the context *) - let cc = + let ctx, cc = match err with - | FailSharedLoan bids -> end_borrows config meta bids - | FailMutLoan bid -> end_borrow config meta bid + | FailSharedLoan bids -> end_borrows config span bids ctx + | FailMutLoan bid -> end_borrow config span bid ctx | FailReservedMutBorrow bid -> - promote_reserved_mut_borrow config meta bid + promote_reserved_mut_borrow config span bid ctx | FailSymbolic (_pe, sp) -> (* Expand the symbolic value *) - expand_symbolic_value_no_branching config meta sp - (Some (Synth.mk_mplace meta p ctx)) + expand_symbolic_value_no_branching config span sp + (Some (Synth.mk_mplace span p ctx)) + ctx | FailBottom (remaining_pes, pe, ty) -> (* Expand the {!Bottom} value *) - fun cf ctx -> - let ctx = - expand_bottom_value_from_projection meta access p remaining_pes - pe ty ctx - in - cf ctx + let ctx = + expand_bottom_value_from_projection span access p remaining_pes pe + ty ctx + in + (ctx, fun e -> e) | FailBorrow _ -> - craise __FILE__ __LINE__ meta "Could not write to a borrow" + craise __FILE__ __LINE__ span "Could not write to a borrow" in (* Retry *) - comp cc (update_ctx_along_write_place config meta access p) cf ctx + comp cc (update_ctx_along_write_place config span access p ctx) (** Small utility used to break control-flow *) -exception UpdateCtx of cm_fun +exception UpdateCtx of (eval_ctx * (eval_result -> eval_result)) -let rec end_loans_at_place (config : config) (meta : Meta.meta) +let rec end_loans_at_place (config : config) (span : Meta.span) (access : access_kind) (p : place) : cm_fun = - fun cf ctx -> + fun ctx -> (* Iterator to explore a value and update the context whenever we find * loans. * We use exceptions to make it handy: whenever we update the @@ -542,8 +543,8 @@ let rec end_loans_at_place (config : config) (meta : Meta.meta) (* Nothing special to do *) super#visit_borrow_content env bc | VReservedMutBorrow bid -> (* We need to activate reserved borrows *) - let cc = promote_reserved_mut_borrow config meta bid in - raise (UpdateCtx cc) + let res = promote_reserved_mut_borrow config span bid ctx in + raise (UpdateCtx res) method! visit_loan_content env lc = match lc with @@ -553,17 +554,17 @@ let rec end_loans_at_place (config : config) (meta : Meta.meta) match access with | Read -> super#visit_VSharedLoan env bids v | Write | Move -> - let cc = end_borrows config meta bids in - raise (UpdateCtx cc)) + let res = end_borrows config span bids ctx in + raise (UpdateCtx res)) | VMutLoan bid -> (* We always need to end mutable borrows *) - let cc = end_borrow config meta bid in - raise (UpdateCtx cc) + let res = end_borrow config span bid ctx in + raise (UpdateCtx res) end in (* First, retrieve the value *) - let v = read_place meta access p ctx in + let v = read_place span access p ctx in (* Inspect the value and update the context while doing so. If the context gets updated: perform a recursive call (many things may have been updated in the context: we need to re-read the value @@ -573,82 +574,75 @@ let rec end_loans_at_place (config : config) (meta : Meta.meta) try obj#visit_typed_value () v; (* No context update required: apply the continuation *) - cf ctx - with UpdateCtx cc -> + (ctx, fun e -> e) + with UpdateCtx (ctx, cc) -> (* We need to update the context: compose the caugth continuation with * a recursive call to reinspect the value *) - comp cc (end_loans_at_place config meta access p) cf ctx + comp cc (end_loans_at_place config span access p ctx) -let drop_outer_loans_at_lplace (config : config) (meta : Meta.meta) (p : place) +let drop_outer_loans_at_lplace (config : config) (span : Meta.span) (p : place) : cm_fun = - fun cf ctx -> + fun ctx -> (* Move the current value in the place outside of this place and into - * a dummy variable *) + * a temporary dummy variable *) let access = Write in - let v = read_place meta access p ctx in - let ctx = write_place meta access p (mk_bottom meta v.ty) ctx in + let v = read_place span access p ctx in + let ctx = write_place span access p (mk_bottom span v.ty) ctx in let dummy_id = fresh_dummy_var_id () in let ctx = ctx_push_dummy_var ctx dummy_id v in - (* Auxiliary function *) + (* Auxiliary function: while there are loans to end in the + temporary value, end them *) let rec drop : cm_fun = - fun cf ctx -> + fun ctx -> (* Read the value *) - let v = ctx_lookup_dummy_var meta ctx dummy_id in - (* Check if there are loans or borrows to end *) + let v = ctx_lookup_dummy_var span ctx dummy_id in + (* Check if there are loans (and only loans) to end *) let with_borrows = false in match get_first_outer_loan_or_borrow_in_value with_borrows v with | None -> - (* We are done: simply call the continuation *) - cf ctx + (* We are done *) + (ctx, fun e -> e) | Some c -> - (* There are: end them then retry *) - let cc = + (* End the loans and retry *) + let ctx, cc = match c with - | LoanContent (VSharedLoan (bids, _)) -> end_borrows config meta bids - | LoanContent (VMutLoan bid) -> end_borrow config meta bid - | BorrowContent _ -> craise __FILE__ __LINE__ meta "Unreachable" + | LoanContent (VSharedLoan (bids, _)) -> + end_borrows config span bids ctx + | LoanContent (VMutLoan bid) -> end_borrow config span bid ctx + | BorrowContent _ -> + (* Can't get there: we are only looking up the loans *) + craise __FILE__ __LINE__ span "Unreachable" in (* Retry *) - comp cc drop cf ctx + comp cc (drop ctx) in (* Apply the drop function *) - let cc = drop in + let ctx, cc = drop ctx in (* Pop the temporary value and reinsert it *) - let cc = - comp cc (fun cf ctx -> - (* Pop *) - let ctx, v = ctx_remove_dummy_var meta ctx dummy_id in - (* Reinsert *) - let ctx = write_place meta access p v ctx in - (* Sanity check *) - sanity_check __FILE__ __LINE__ (not (outer_loans_in_value v)) meta; - (* Continue *) - cf ctx) - in - (* Continue *) - cc cf ctx - -let prepare_lplace (config : config) (meta : Meta.meta) (p : place) - (cf : typed_value -> m_fun) : m_fun = - fun ctx -> + (* Pop *) + let ctx, v = ctx_remove_dummy_var span ctx dummy_id in + (* Sanity check *) + sanity_check __FILE__ __LINE__ (not (outer_loans_in_value v)) span; + (* Reinsert *) + let ctx = write_place span access p v ctx in + (* Return *) + (ctx, cc) + +let prepare_lplace (config : config) (span : Meta.span) (p : place) + (ctx : eval_ctx) : typed_value * eval_ctx * (eval_result -> eval_result) = log#ldebug (lazy ("prepare_lplace:" ^ "\n- p: " ^ place_to_string ctx p ^ "\n- Initial context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Access the place *) let access = Write in - let cc = update_ctx_along_write_place config meta access p in - (* End the borrows and loans, starting with the borrows *) - let cc = comp cc (drop_outer_loans_at_lplace config meta p) in + let ctx, cc = update_ctx_along_write_place config span access p ctx in + (* End the loans at the place we are about to overwrite *) + let ctx, cc = comp cc (drop_outer_loans_at_lplace config span p ctx) in (* Read the value and check it *) - let read_check cf : m_fun = - fun ctx -> - let v = read_place meta access p ctx in - (* Sanity checks *) - sanity_check __FILE__ __LINE__ (not (outer_loans_in_value v)) meta; - (* Continue *) - cf v ctx - in - (* Compose and apply the continuations *) - comp cc read_check cf ctx + let v = read_place span access p ctx in + (* Sanity checks *) + sanity_check __FILE__ __LINE__ (not (outer_loans_in_value v)) span; + (* Return *) + (v, ctx, cc) diff --git a/compiler/InterpreterPaths.mli b/compiler/InterpreterPaths.mli index 260f07bf..86f0dcc0 100644 --- a/compiler/InterpreterPaths.mli +++ b/compiler/InterpreterPaths.mli @@ -14,14 +14,14 @@ type access_kind = Read | Write | Move until it manages to fully access the provided place. *) val update_ctx_along_read_place : - config -> Meta.meta -> access_kind -> place -> cm_fun + config -> Meta.span -> access_kind -> place -> cm_fun (** Update the environment to be able to write to a place. See {!update_ctx_along_read_place}. *) val update_ctx_along_write_place : - config -> Meta.meta -> access_kind -> place -> cm_fun + config -> Meta.span -> access_kind -> place -> cm_fun (** Read the value at a given place. @@ -31,7 +31,7 @@ val update_ctx_along_write_place : Note that we only access the value at the place, and do not check that the value is "well-formed" (for instance that it doesn't contain bottoms). *) -val read_place : Meta.meta -> access_kind -> place -> eval_ctx -> typed_value +val read_place : Meta.span -> access_kind -> place -> eval_ctx -> typed_value (** Update the value at a given place. @@ -43,21 +43,21 @@ val read_place : Meta.meta -> access_kind -> place -> eval_ctx -> typed_value overwrite it. *) val write_place : - Meta.meta -> access_kind -> place -> typed_value -> eval_ctx -> eval_ctx + Meta.span -> access_kind -> place -> typed_value -> eval_ctx -> eval_ctx (** Compute an expanded tuple ⊥ value. [compute_expanded_bottom_tuple_value [ty0, ..., tyn]] returns [(⊥:ty0, ..., ⊥:tyn)] *) -val compute_expanded_bottom_tuple_value : Meta.meta -> ety list -> typed_value +val compute_expanded_bottom_tuple_value : Meta.span -> ety list -> typed_value (** Compute an expanded ADT ⊥ value. The types in the generics should use erased regions. *) val compute_expanded_bottom_adt_value : - Meta.meta -> + Meta.span -> eval_ctx -> TypeDeclId.id -> VariantId.id option -> @@ -77,7 +77,7 @@ val compute_expanded_bottom_adt_value : that the place is *inside* a borrow, if we end the borrow, we won't be able to reinsert the value back). *) -val drop_outer_loans_at_lplace : config -> Meta.meta -> place -> cm_fun +val drop_outer_loans_at_lplace : config -> Meta.span -> place -> cm_fun (** End the loans at a given place: read the value, if it contains a loan, end this loan, repeat. @@ -88,7 +88,7 @@ val drop_outer_loans_at_lplace : config -> Meta.meta -> place -> cm_fun when moving values, we can't move a value which contains loans and thus need to end them, etc. *) -val end_loans_at_place : config -> Meta.meta -> access_kind -> place -> cm_fun +val end_loans_at_place : config -> Meta.span -> access_kind -> place -> cm_fun (** Small utility. @@ -100,4 +100,8 @@ val end_loans_at_place : config -> Meta.meta -> access_kind -> place -> cm_fun case). Note that this value is very likely to contain ⊥ subvalues. *) val prepare_lplace : - config -> Meta.meta -> place -> (typed_value -> m_fun) -> m_fun + config -> + Meta.span -> + place -> + eval_ctx -> + typed_value * eval_ctx * (eval_result -> eval_result) diff --git a/compiler/InterpreterProjectors.ml b/compiler/InterpreterProjectors.ml index 3993d845..a887c44c 100644 --- a/compiler/InterpreterProjectors.ml +++ b/compiler/InterpreterProjectors.ml @@ -12,13 +12,13 @@ open Errors let log = Logging.projectors_log (** [ty] shouldn't contain erased regions *) -let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) +let rec apply_proj_borrows_on_shared_borrow (span : Meta.span) (ctx : eval_ctx) (fresh_reborrow : BorrowId.id -> BorrowId.id) (regions : RegionId.Set.t) (v : typed_value) (ty : rty) : abstract_shared_borrows = (* Sanity check - TODO: move those elsewhere (here we perform the check at every * recursive call which is a bit overkill...) *) let ety = Subst.erase_regions ty in - sanity_check __FILE__ __LINE__ (ty_is_rty ty && ety = v.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty && ety = v.ty) span; (* Project - if there are no regions from the abstraction in the type, return [_] *) if not (ty_has_regions_in_set regions ty) then [] else @@ -27,7 +27,7 @@ let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) | VAdt adt, TAdt (id, generics) -> (* Retrieve the types of the fields *) let field_types = - Assoc.ctx_adt_value_get_inst_norm_field_rtypes meta ctx adt id + Assoc.ctx_adt_value_get_inst_norm_field_rtypes span ctx adt id generics in @@ -36,12 +36,12 @@ let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) let proj_fields = List.map (fun (fv, fty) -> - apply_proj_borrows_on_shared_borrow meta ctx fresh_reborrow + apply_proj_borrows_on_shared_borrow span ctx fresh_reborrow regions fv fty) fields_types in List.concat proj_fields - | VBottom, _ -> craise __FILE__ __LINE__ meta "Unreachable" + | VBottom, _ -> craise __FILE__ __LINE__ span "Unreachable" | VBorrow bc, TRef (r, ref_ty, kind) -> (* Retrieve the bid of the borrow and the asb of the projected borrowed value *) let bid, asb = @@ -50,27 +50,27 @@ let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) | VMutBorrow (bid, bv), RMut -> (* Apply the projection on the borrowed value *) let asb = - apply_proj_borrows_on_shared_borrow meta ctx fresh_reborrow + apply_proj_borrows_on_shared_borrow span ctx fresh_reborrow regions bv ref_ty in (bid, asb) | VSharedBorrow bid, RShared -> (* Lookup the shared value *) let ek = ek_all in - let sv = lookup_loan meta ek bid ctx in + let sv = lookup_loan span ek bid ctx in let asb = match sv with | _, Concrete (VSharedLoan (_, sv)) | _, Abstract (ASharedLoan (_, sv, _)) -> - apply_proj_borrows_on_shared_borrow meta ctx fresh_reborrow + apply_proj_borrows_on_shared_borrow span ctx fresh_reborrow regions sv ref_ty - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in (bid, asb) | VReservedMutBorrow _, _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Can't apply a proj_borrow over a reserved mutable borrow" - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in let asb = (* Check if the region is in the set of projected regions (note that @@ -81,24 +81,24 @@ let rec apply_proj_borrows_on_shared_borrow (meta : Meta.meta) (ctx : eval_ctx) else asb in asb - | VLoan _, _ -> craise __FILE__ __LINE__ meta "Unreachable" + | VLoan _, _ -> craise __FILE__ __LINE__ span "Unreachable" | VSymbolic s, _ -> (* Check that the projection doesn't contain ended regions *) sanity_check __FILE__ __LINE__ (not - (projections_intersect meta s.sv_ty ctx.ended_regions ty regions)) - meta; + (projections_intersect span s.sv_ty ctx.ended_regions ty regions)) + span; [ AsbProjReborrows (s, ty) ] - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" -let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) +let rec apply_proj_borrows (span : Meta.span) (check_symbolic_no_ended : bool) (ctx : eval_ctx) (fresh_reborrow : BorrowId.id -> BorrowId.id) (regions : RegionId.Set.t) (ancestors_regions : RegionId.Set.t) (v : typed_value) (ty : rty) : typed_avalue = (* Sanity check - TODO: move this elsewhere (here we perform the check at every * recursive call which is a bit overkill...) *) let ety = Substitute.erase_regions ty in - sanity_check __FILE__ __LINE__ (ty_is_rty ty && ety = v.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty && ety = v.ty) span; (* Project - if there are no regions from the abstraction in the type, return [_] *) if not (ty_has_regions_in_set regions ty) then { value = AIgnored; ty } else @@ -108,7 +108,7 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) | VAdt adt, TAdt (id, generics) -> (* Retrieve the types of the fields *) let field_types = - Assoc.ctx_adt_value_get_inst_norm_field_rtypes meta ctx adt id + Assoc.ctx_adt_value_get_inst_norm_field_rtypes span ctx adt id generics in (* Project over the field values *) @@ -116,12 +116,12 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) let proj_fields = List.map (fun (fv, fty) -> - apply_proj_borrows meta check_symbolic_no_ended ctx + apply_proj_borrows span check_symbolic_no_ended ctx fresh_reborrow regions ancestors_regions fv fty) fields_types in AAdt { variant_id = adt.variant_id; field_values = proj_fields } - | VBottom, _ -> craise __FILE__ __LINE__ meta "Unreachable" + | VBottom, _ -> craise __FILE__ __LINE__ span "Unreachable" | VBorrow bc, TRef (r, ref_ty, kind) -> if (* Check if the region is in the set of projected regions (note that @@ -134,7 +134,7 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) | VMutBorrow (bid, bv), RMut -> (* Apply the projection on the borrowed value *) let bv = - apply_proj_borrows meta check_symbolic_no_ended ctx + apply_proj_borrows span check_symbolic_no_ended ctx fresh_reborrow regions ancestors_regions bv ref_ty in AMutBorrow (bid, bv) @@ -152,9 +152,9 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) *) ASharedBorrow bid | VReservedMutBorrow _, _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Can't apply a proj_borrow over a reserved mutable borrow" - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in ABorrow bc else @@ -166,7 +166,7 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) | VMutBorrow (bid, bv), RMut -> (* Apply the projection on the borrowed value *) let bv = - apply_proj_borrows meta check_symbolic_no_ended ctx + apply_proj_borrows span check_symbolic_no_ended ctx fresh_reborrow regions ancestors_regions bv ref_ty in (* If the borrow id is in the ancestor's regions, we still need @@ -179,23 +179,23 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) | VSharedBorrow bid, RShared -> (* Lookup the shared value *) let ek = ek_all in - let sv = lookup_loan meta ek bid ctx in + let sv = lookup_loan span ek bid ctx in let asb = match sv with | _, Concrete (VSharedLoan (_, sv)) | _, Abstract (ASharedLoan (_, sv, _)) -> - apply_proj_borrows_on_shared_borrow meta ctx + apply_proj_borrows_on_shared_borrow span ctx fresh_reborrow regions sv ref_ty - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" in AProjSharedBorrow asb | VReservedMutBorrow _, _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Can't apply a proj_borrow over a reserved mutable borrow" - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in ABorrow bc - | VLoan _, _ -> craise __FILE__ __LINE__ meta "Unreachable" + | VLoan _, _ -> craise __FILE__ __LINE__ span "Unreachable" | VSymbolic s, _ -> (* Check that the projection doesn't contain already ended regions, * if necessary *) @@ -213,20 +213,20 @@ let rec apply_proj_borrows (meta : Meta.meta) (check_symbolic_no_ended : bool) ^ RegionId.Set.to_string None rset2 ^ "\n")); sanity_check __FILE__ __LINE__ - (not (projections_intersect meta ty1 rset1 ty2 rset2)) - meta); + (not (projections_intersect span ty1 rset1 ty2 rset2)) + span); ASymbolic (AProjBorrows (s, ty)) | _ -> log#ltrace (lazy ("apply_proj_borrows: unexpected inputs:\n- input value: " - ^ typed_value_to_string ~meta:(Some meta) ctx v + ^ typed_value_to_string ~span:(Some span) ctx v ^ "\n- proj rty: " ^ ty_to_string ctx ty)); - internal_error __FILE__ __LINE__ meta + internal_error __FILE__ __LINE__ span in { value; ty } -let symbolic_expansion_non_borrow_to_value (meta : Meta.meta) +let symbolic_expansion_non_borrow_to_value (span : Meta.span) (sv : symbolic_value) (see : symbolic_expansion) : typed_value = let ty = Subst.erase_regions sv.sv_ty in let value = @@ -238,11 +238,11 @@ let symbolic_expansion_non_borrow_to_value (meta : Meta.meta) in VAdt { variant_id; field_values } | SeMutRef (_, _) | SeSharedRef (_, _) -> - craise __FILE__ __LINE__ meta "Unexpected symbolic reference expansion" + craise __FILE__ __LINE__ span "Unexpected symbolic reference expansion" in { value; ty } -let symbolic_expansion_non_shared_borrow_to_value (meta : Meta.meta) +let symbolic_expansion_non_shared_borrow_to_value (span : Meta.span) (sv : symbolic_value) (see : symbolic_expansion) : typed_value = match see with | SeMutRef (bid, bv) -> @@ -251,22 +251,22 @@ let symbolic_expansion_non_shared_borrow_to_value (meta : Meta.meta) let value = VBorrow (VMutBorrow (bid, bv)) in { value; ty } | SeSharedRef (_, _) -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Unexpected symbolic shared reference expansion" - | _ -> symbolic_expansion_non_borrow_to_value meta sv see + | _ -> symbolic_expansion_non_borrow_to_value span sv see (** Apply (and reduce) a projector over loans to a value. TODO: detailed comments. See [apply_proj_borrows] *) -let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) +let apply_proj_loans_on_symbolic_expansion (span : Meta.span) (regions : RegionId.Set.t) (ancestors_regions : RegionId.Set.t) (see : symbolic_expansion) (original_sv_ty : rty) : typed_avalue = (* Sanity check: if we have a proj_loans over a symbolic value, it should * contain regions which we will project *) sanity_check __FILE__ __LINE__ (ty_has_regions_in_set regions original_sv_ty) - meta; + span; (* Match *) let (value, ty) : avalue * ty = match (see, original_sv_ty) with @@ -281,7 +281,7 @@ let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) (AAdt { variant_id; field_values }, original_sv_ty) | SeMutRef (bid, spc), TRef (r, ref_ty, RMut) -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (spc.sv_ty = ref_ty) meta; + sanity_check __FILE__ __LINE__ (spc.sv_ty = ref_ty) span; (* Apply the projector to the borrowed value *) let child_av = mk_aproj_loans_value_from_symbolic_value regions spc in (* Check if the region is in the set of projected regions (note that @@ -299,7 +299,7 @@ let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) (ALoan (AIgnoredMutLoan (opt_bid, child_av)), ref_ty) | SeSharedRef (bids, spc), TRef (r, ref_ty, RShared) -> (* Sanity check *) - sanity_check __FILE__ __LINE__ (spc.sv_ty = ref_ty) meta; + sanity_check __FILE__ __LINE__ (spc.sv_ty = ref_ty) span; (* Apply the projector to the borrowed value *) let child_av = mk_aproj_loans_value_from_symbolic_value regions spc in (* Check if the region is in the set of projected regions (note that @@ -311,7 +311,7 @@ let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) else (* Not in the set: ignore *) (ALoan (AIgnoredSharedLoan child_av), ref_ty) - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in { value; ty } @@ -337,7 +337,7 @@ let apply_proj_loans_on_symbolic_expansion (meta : Meta.meta) borrows - easy - and mutable borrows - in this case, we reborrow the whole borrow: [mut_borrow ... ~~> shared_loan {...} (mut_borrow ...)]). *) -let apply_reborrows (meta : Meta.meta) +let apply_reborrows (span : Meta.span) (reborrows : (BorrowId.id * BorrowId.id) list) (ctx : eval_ctx) : eval_ctx = (* This is a bit brutal, but whenever we insert a reborrow, we remove * it from the list. This allows us to check that all the reborrows were @@ -456,11 +456,11 @@ let apply_reborrows (meta : Meta.meta) super#visit_ASharedLoan env bids sv av | AIgnoredSharedLoan _ | AMutLoan (_, _) - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } | AEndedSharedLoan (_, _) | AIgnoredMutLoan (_, _) | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } -> + { given_back = _; child = _; given_back_span = _ } -> (* Nothing particular to do *) super#visit_aloan_content env lc end @@ -469,11 +469,11 @@ let apply_reborrows (meta : Meta.meta) (* Visit *) let ctx = obj#visit_eval_ctx () ctx in (* Check that there are no reborrows remaining *) - sanity_check __FILE__ __LINE__ (!reborrows = []) meta; + sanity_check __FILE__ __LINE__ (!reborrows = []) span; (* Return *) ctx -let prepare_reborrows (config : config) (meta : Meta.meta) +let prepare_reborrows (config : config) (span : Meta.span) (allow_reborrows : bool) : (BorrowId.id -> BorrowId.id) * (eval_ctx -> eval_ctx) = let reborrows : (BorrowId.id * BorrowId.id) list ref = ref [] in @@ -483,35 +483,35 @@ let prepare_reborrows (config : config) (meta : Meta.meta) let bid' = fresh_borrow_id () in reborrows := (bid, bid') :: !reborrows; bid') - else craise __FILE__ __LINE__ meta "Unexpected reborrow" + else craise __FILE__ __LINE__ span "Unexpected reborrow" in (* The function to apply the reborrows in a context *) let apply_registered_reborrows (ctx : eval_ctx) : eval_ctx = match config.mode with | ConcreteMode -> - sanity_check __FILE__ __LINE__ (!reborrows = []) meta; + sanity_check __FILE__ __LINE__ (!reborrows = []) span; ctx | SymbolicMode -> (* Apply the reborrows *) - apply_reborrows meta !reborrows ctx + apply_reborrows span !reborrows ctx in (fresh_reborrow, apply_registered_reborrows) (** [ty] shouldn't have erased regions *) -let apply_proj_borrows_on_input_value (config : config) (meta : Meta.meta) +let apply_proj_borrows_on_input_value (config : config) (span : Meta.span) (ctx : eval_ctx) (regions : RegionId.Set.t) (ancestors_regions : RegionId.Set.t) (v : typed_value) (ty : rty) : eval_ctx * typed_avalue = - sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty) span; let check_symbolic_no_ended = true in let allow_reborrows = true in (* Prepare the reborrows *) let fresh_reborrow, apply_registered_reborrows = - prepare_reborrows config meta allow_reborrows + prepare_reborrows config span allow_reborrows in (* Apply the projector *) let av = - apply_proj_borrows meta check_symbolic_no_ended ctx fresh_reborrow regions + apply_proj_borrows span check_symbolic_no_ended ctx fresh_reborrow regions ancestors_regions v ty in (* Apply the reborrows *) diff --git a/compiler/InterpreterProjectors.mli b/compiler/InterpreterProjectors.mli index 17569ac8..43cdc09d 100644 --- a/compiler/InterpreterProjectors.mli +++ b/compiler/InterpreterProjectors.mli @@ -15,7 +15,7 @@ open Contexts [original_sv_ty]: shouldn't have erased regions *) val apply_proj_loans_on_symbolic_expansion : - Meta.meta -> + Meta.span -> RegionId.Set.t -> RegionId.Set.t -> symbolic_expansion -> @@ -24,7 +24,7 @@ val apply_proj_loans_on_symbolic_expansion : (** Convert a symbolic expansion *which is not a borrow* to a value *) val symbolic_expansion_non_borrow_to_value : - Meta.meta -> symbolic_value -> symbolic_expansion -> typed_value + Meta.span -> symbolic_value -> symbolic_expansion -> typed_value (** Convert a symbolic expansion *which is not a shared borrow* to a value. @@ -33,7 +33,7 @@ val symbolic_expansion_non_borrow_to_value : during a symbolic expansion. *) val symbolic_expansion_non_shared_borrow_to_value : - Meta.meta -> symbolic_value -> symbolic_expansion -> typed_value + Meta.span -> symbolic_value -> symbolic_expansion -> typed_value (** Auxiliary function to prepare reborrowing operations (used when applying projectors). @@ -49,7 +49,7 @@ val symbolic_expansion_non_shared_borrow_to_value : *) val prepare_reborrows : config -> - Meta.meta -> + Meta.span -> bool -> (BorrowId.id -> BorrowId.id) * (eval_ctx -> eval_ctx) @@ -104,7 +104,7 @@ val prepare_reborrows : then we interpret the borrow [l] as belonging to region [r] *) val apply_proj_borrows : - Meta.meta -> + Meta.span -> bool -> eval_ctx -> (BorrowId.id -> BorrowId.id) -> @@ -125,7 +125,7 @@ val apply_proj_borrows : *) val apply_proj_borrows_on_input_value : config -> - Meta.meta -> + Meta.span -> eval_ctx -> RegionId.Set.t -> RegionId.Set.t -> diff --git a/compiler/InterpreterStatements.ml b/compiler/InterpreterStatements.ml index 9ad6487b..c6a65757 100644 --- a/compiler/InterpreterStatements.ml +++ b/compiler/InterpreterStatements.ml @@ -19,74 +19,68 @@ module S = SynthesizeSymbolic let log = L.statements_log (** Drop a value at a given place - TODO: factorize this with [assign_to_place] *) -let drop_value (config : config) (meta : Meta.meta) (p : place) : cm_fun = - fun cf ctx -> +let drop_value (config : config) (span : Meta.span) (p : place) : cm_fun = + fun ctx -> log#ldebug (lazy ("drop_value: place: " ^ place_to_string ctx p ^ "\n- Initial context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Note that we use [Write], not [Move]: we allow to drop values *below* borrows *) let access = Write in (* First make sure we can access the place, by ending loans or expanding * symbolic values along the path, for instance *) - let cc = update_ctx_along_read_place config meta access p in + let ctx, cc = update_ctx_along_read_place config span access p ctx in (* Prepare the place (by ending the outer loans *at* the place). *) - let cc = comp cc (prepare_lplace config meta p) in + let v, ctx, cc = comp2 cc (prepare_lplace config span p ctx) in (* Replace the value with {!Bottom} *) - let replace cf (v : typed_value) ctx = + let ctx = (* Move the value at destination (that we will overwrite) to a dummy variable * to preserve the borrows it may contain *) - let mv = InterpreterPaths.read_place meta access p ctx in + let mv = InterpreterPaths.read_place span access p ctx in let dummy_id = fresh_dummy_var_id () in let ctx = ctx_push_dummy_var ctx dummy_id mv in (* Update the destination to ⊥ *) let nv = { v with value = VBottom } in - let ctx = write_place meta access p nv ctx in + let ctx = write_place span access p nv ctx in log#ldebug (lazy ("drop_value: place: " ^ place_to_string ctx p ^ "\n- Final context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - cf ctx + ^ eval_ctx_to_string ~span:(Some span) ctx)); + ctx in (* Compose and apply *) - comp cc replace cf ctx + (ctx, cc) (** Push a dummy variable to the environment *) -let push_dummy_var (vid : DummyVarId.id) (v : typed_value) : cm_fun = - fun cf ctx -> - let ctx = ctx_push_dummy_var ctx vid v in - cf ctx +let push_dummy_var (vid : DummyVarId.id) (v : typed_value) (ctx : eval_ctx) : + eval_ctx = + ctx_push_dummy_var ctx vid v (** Remove a dummy variable from the environment *) -let remove_dummy_var (meta : Meta.meta) (vid : DummyVarId.id) - (cf : typed_value -> m_fun) : m_fun = - fun ctx -> - let ctx, v = ctx_remove_dummy_var meta ctx vid in - cf v ctx +let remove_dummy_var (span : Meta.span) (vid : DummyVarId.id) (ctx : eval_ctx) : + typed_value * eval_ctx = + let ctx, v = ctx_remove_dummy_var span ctx vid in + (v, ctx) (** Push an uninitialized variable to the environment *) -let push_uninitialized_var (meta : Meta.meta) (var : var) : cm_fun = - fun cf ctx -> - let ctx = ctx_push_uninitialized_var meta ctx var in - cf ctx +let push_uninitialized_var (span : Meta.span) (var : var) (ctx : eval_ctx) : + eval_ctx = + ctx_push_uninitialized_var span ctx var (** Push a list of uninitialized variables to the environment *) -let push_uninitialized_vars (meta : Meta.meta) (vars : var list) : cm_fun = - fun cf ctx -> - let ctx = ctx_push_uninitialized_vars meta ctx vars in - cf ctx +let push_uninitialized_vars (span : Meta.span) (vars : var list) + (ctx : eval_ctx) : eval_ctx = + ctx_push_uninitialized_vars span ctx vars (** Push a variable to the environment *) -let push_var (meta : Meta.meta) (var : var) (v : typed_value) : cm_fun = - fun cf ctx -> - let ctx = ctx_push_var meta ctx var v in - cf ctx +let push_var (span : Meta.span) (var : var) (v : typed_value) (ctx : eval_ctx) : + eval_ctx = + ctx_push_var span ctx var v (** Push a list of variables to the environment *) -let push_vars (meta : Meta.meta) (vars : (var * typed_value) list) : cm_fun = - fun cf ctx -> - let ctx = ctx_push_vars meta ctx vars in - cf ctx +let push_vars (span : Meta.span) (vars : (var * typed_value) list) + (ctx : eval_ctx) : eval_ctx = + ctx_push_vars span ctx vars (** Assign a value to a given place. @@ -95,69 +89,62 @@ let push_vars (meta : Meta.meta) (vars : (var * typed_value) list) : cm_fun = dummy variable and putting in its destination (after having checked that preparing the destination didn't introduce ⊥). *) -let assign_to_place (config : config) (meta : Meta.meta) (rv : typed_value) +let assign_to_place (config : config) (span : Meta.span) (rv : typed_value) (p : place) : cm_fun = - fun cf ctx -> + fun ctx -> log#ldebug (lazy ("assign_to_place:" ^ "\n- rv: " - ^ typed_value_to_string ~meta:(Some meta) ctx rv + ^ typed_value_to_string ~span:(Some span) ctx rv ^ "\n- p: " ^ place_to_string ctx p ^ "\n- Initial context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Push the rvalue to a dummy variable, for bookkeeping *) let rvalue_vid = fresh_dummy_var_id () in - let cc = push_dummy_var rvalue_vid rv in + let ctx = push_dummy_var rvalue_vid rv ctx in (* Prepare the destination *) - let cc = comp cc (prepare_lplace config meta p) in + let _, ctx, cc = prepare_lplace config span p ctx in (* Retrieve the rvalue from the dummy variable *) - let cc = comp cc (fun cf _lv -> remove_dummy_var meta rvalue_vid cf) in + let rv, ctx = remove_dummy_var span rvalue_vid ctx in + (* Move the value at destination (that we will overwrite) to a dummy variable + to preserve the borrows *) + let mv = InterpreterPaths.read_place span Write p ctx in + let dest_vid = fresh_dummy_var_id () in + let ctx = ctx_push_dummy_var ctx dest_vid mv in + (* Write to the destination *) + (* Checks - maybe the bookkeeping updated the rvalue and introduced bottoms *) + exec_assert __FILE__ __LINE__ + (not (bottom_in_value ctx.ended_regions rv)) + span "The value to move contains bottom"; (* Update the destination *) - let move_dest cf (rv : typed_value) : m_fun = - fun ctx -> - (* Move the value at destination (that we will overwrite) to a dummy variable - * to preserve the borrows *) - let mv = InterpreterPaths.read_place meta Write p ctx in - let dest_vid = fresh_dummy_var_id () in - let ctx = ctx_push_dummy_var ctx dest_vid mv in - (* Write to the destination *) - (* Checks - maybe the bookkeeping updated the rvalue and introduced bottoms *) - exec_assert __FILE__ __LINE__ - (not (bottom_in_value ctx.ended_regions rv)) - meta "The value to move contains bottom"; - (* Update the destination *) - let ctx = write_place meta Write p rv ctx in - (* Debug *) - log#ldebug - (lazy - ("assign_to_place:" ^ "\n- rv: " - ^ typed_value_to_string ~meta:(Some meta) ctx rv - ^ "\n- p: " ^ place_to_string ctx p ^ "\n- Final context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - (* Continue *) - cf ctx - in - (* Compose and apply *) - comp cc move_dest cf ctx + let ctx = write_place span Write p rv ctx in + (* Debug *) + log#ldebug + (lazy + ("assign_to_place:" ^ "\n- rv: " + ^ typed_value_to_string ~span:(Some span) ctx rv + ^ "\n- p: " ^ place_to_string ctx p ^ "\n- Final context:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); + (* Return *) + (ctx, cc) (** Evaluate an assertion, when the scrutinee is not symbolic *) -let eval_assertion_concrete (config : config) (meta : Meta.meta) +let eval_assertion_concrete (config : config) (span : Meta.span) (assertion : assertion) : st_cm_fun = - fun cf ctx -> + fun ctx -> (* There won't be any symbolic expansions: fully evaluate the operand *) - let eval_op = eval_operand config meta assertion.cond in - let eval_assert cf (v : typed_value) : m_fun = - fun ctx -> + let v, ctx, eval_op = eval_operand config span assertion.cond ctx in + let st = match v.value with | VLiteral (VBool b) -> (* Branch *) - if b = assertion.expected then cf Unit ctx else cf Panic ctx + if b = assertion.expected then Unit else Panic | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Expected a boolean, got: " - ^ typed_value_to_string ~meta:(Some meta) ctx v) + ^ typed_value_to_string ~span:(Some span) ctx v) in (* Compose and apply *) - comp eval_op eval_assert cf ctx + ((ctx, st), eval_op) (** Evaluates an assertion. @@ -165,15 +152,14 @@ let eval_assertion_concrete (config : config) (meta : Meta.meta) a call to [assert ...] then continue in the success branch (and thus expand the boolean to [true]). *) -let eval_assertion (config : config) (meta : Meta.meta) (assertion : assertion) +let eval_assertion (config : config) (span : Meta.span) (assertion : assertion) : st_cm_fun = - fun cf ctx -> + fun ctx -> (* Evaluate the operand *) - let eval_op = eval_operand config meta assertion.cond in + let v, ctx, cf_eval_op = eval_operand config span assertion.cond ctx in (* Evaluate the assertion *) - let eval_assert cf (v : typed_value) : m_fun = - fun ctx -> - sanity_check __FILE__ __LINE__ (v.ty = TLiteral TBool) meta; + sanity_check __FILE__ __LINE__ (v.ty = TLiteral TBool) span; + let st, cf_eval_assert = (* We make a choice here: we could completely decouple the concrete and * symbolic executions here but choose not to. In the case where we * know the concrete value of the boolean we test, we use this value @@ -182,29 +168,27 @@ let eval_assertion (config : config) (meta : Meta.meta) (assertion : assertion) match v.value with | VLiteral (VBool _) -> (* Delegate to the concrete evaluation function *) - eval_assertion_concrete config meta assertion cf ctx + eval_assertion_concrete config span assertion ctx | VSymbolic sv -> - sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) meta; - sanity_check __FILE__ __LINE__ (sv.sv_ty = TLiteral TBool) meta; + sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) span; + sanity_check __FILE__ __LINE__ (sv.sv_ty = TLiteral TBool) span; (* We continue the execution as if the test had succeeded, and thus * perform the symbolic expansion: sv ~~> true. * We will of course synthesize an assertion in the generated code * (see below). *) let ctx = - apply_symbolic_expansion_non_borrow config meta sv - (SeLiteral (VBool true)) ctx + apply_symbolic_expansion_non_borrow config span sv ctx + (SeLiteral (VBool true)) in - (* Continue *) - let expr = cf Unit ctx in (* Add the synthesized assertion *) - S.synthesize_assertion ctx v expr + ((ctx, Unit), S.synthesize_assertion ctx v) | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Expected a boolean, got: " - ^ typed_value_to_string ~meta:(Some meta) ctx v) + ^ typed_value_to_string ~span:(Some span) ctx v) in (* Compose and apply *) - comp eval_op eval_assert cf ctx + (st, cc_comp cf_eval_op cf_eval_assert) (** Updates the discriminant of a value at a given place. @@ -217,94 +201,92 @@ let eval_assertion (config : config) (meta : Meta.meta) (assertion : assertion) a variant with all its fields set to {!Bottom}. For instance, something like: [Cons Bottom Bottom]. *) -let set_discriminant (config : config) (meta : Meta.meta) (p : place) +let set_discriminant (config : config) (span : Meta.span) (p : place) (variant_id : VariantId.id) : st_cm_fun = - fun cf ctx -> + fun ctx -> log#ldebug (lazy ("set_discriminant:" ^ "\n- p: " ^ place_to_string ctx p ^ "\n- variant id: " ^ VariantId.to_string variant_id ^ "\n- initial context:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Access the value *) let access = Write in - let cc = update_ctx_along_read_place config meta access p in - let cc = comp cc (prepare_lplace config meta p) in + let ctx, cc = update_ctx_along_read_place config span access p ctx in + let v, ctx, cc = comp2 cc (prepare_lplace config span p ctx) in (* Update the value *) - let update_value cf (v : typed_value) : m_fun = - fun ctx -> - match (v.ty, v.value) with - | TAdt ((TAdtId _ as type_id), generics), VAdt av -> ( - (* There are two situations: - - either the discriminant is already the proper one (in which case we - don't do anything) - - or it is not the proper one, in which case we replace the value with - a variant with all its fields set to {!Bottom} - *) - match av.variant_id with - | None -> - craise __FILE__ __LINE__ meta - "Found a struct value while expected an enum" - | Some variant_id' -> - if variant_id' = variant_id then (* Nothing to do *) - cf Unit ctx - else - (* Replace the value *) - let bottom_v = - match type_id with - | TAdtId def_id -> - compute_expanded_bottom_adt_value meta ctx def_id - (Some variant_id) generics - | _ -> craise __FILE__ __LINE__ meta "Unreachable" - in - assign_to_place config meta bottom_v p (cf Unit) ctx) - | TAdt ((TAdtId _ as type_id), generics), VBottom -> - let bottom_v = - match type_id with - | TAdtId def_id -> - compute_expanded_bottom_adt_value meta ctx def_id - (Some variant_id) generics - | _ -> craise __FILE__ __LINE__ meta "Unreachable" - in - assign_to_place config meta bottom_v p (cf Unit) ctx - | _, VSymbolic _ -> - sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) meta; - (* This is a bit annoying: in theory we should expand the symbolic value - * then set the discriminant, because in the case the discriminant is - * exactly the one we set, the fields are left untouched, and in the - * other cases they are set to Bottom. - * For now, we forbid setting the discriminant of a symbolic value: - * setting a discriminant should only be used to initialize a value, - * or reset an already initialized value, really. *) - craise __FILE__ __LINE__ meta "Unexpected value" - | _, (VAdt _ | VBottom) -> - craise __FILE__ __LINE__ meta "Inconsistent state" - | _, (VLiteral _ | VBorrow _ | VLoan _) -> - craise __FILE__ __LINE__ meta "Unexpected value" - in - (* Compose and apply *) - comp cc update_value cf ctx + match (v.ty, v.value) with + | TAdt ((TAdtId _ as type_id), generics), VAdt av -> ( + (* There are two situations: + - either the discriminant is already the proper one (in which case we + don't do anything) + - or it is not the proper one, in which case we replace the value with + a variant with all its fields set to {!Bottom} + *) + match av.variant_id with + | None -> + craise __FILE__ __LINE__ span + "Found a struct value while expecting an enum" + | Some variant_id' -> + if variant_id' = variant_id then (* Nothing to do *) + ((ctx, Unit), cc) + else + (* Replace the value *) + let bottom_v = + match type_id with + | TAdtId def_id -> + compute_expanded_bottom_adt_value span ctx def_id + (Some variant_id) generics + | _ -> craise __FILE__ __LINE__ span "Unreachable" + in + let ctx, cc = + comp cc (assign_to_place config span bottom_v p ctx) + in + ((ctx, Unit), cc)) + | TAdt ((TAdtId _ as type_id), generics), VBottom -> + let bottom_v = + match type_id with + | TAdtId def_id -> + compute_expanded_bottom_adt_value span ctx def_id (Some variant_id) + generics + | _ -> craise __FILE__ __LINE__ span "Unreachable" + in + let ctx, cc = comp cc (assign_to_place config span bottom_v p ctx) in + ((ctx, Unit), cc) + | _, VSymbolic _ -> + sanity_check __FILE__ __LINE__ (config.mode = SymbolicMode) span; + (* This is a bit annoying: in theory we should expand the symbolic value + * then set the discriminant, because in the case the discriminant is + * exactly the one we set, the fields are left untouched, and in the + * other cases they are set to Bottom. + * For now, we forbid setting the discriminant of a symbolic value: + * setting a discriminant should only be used to initialize a value, + * or reset an already initialized value, really. *) + craise __FILE__ __LINE__ span "Unexpected value" + | _, (VAdt _ | VBottom) -> craise __FILE__ __LINE__ span "Inconsistent state" + | _, (VLiteral _ | VBorrow _ | VLoan _) -> + craise __FILE__ __LINE__ span "Unexpected value" (** Push a frame delimiter in the context's environment *) let ctx_push_frame (ctx : eval_ctx) : eval_ctx = { ctx with env = EFrame :: ctx.env } (** Push a frame delimiter in the context's environment *) -let push_frame : cm_fun = fun cf ctx -> cf (ctx_push_frame ctx) +let push_frame (ctx : eval_ctx) : eval_ctx = ctx_push_frame ctx (** Small helper: compute the type of the return value for a specific instantiation of an assumed function. *) -let get_assumed_function_return_type (meta : Meta.meta) (ctx : eval_ctx) +let get_assumed_function_return_type (span : Meta.span) (ctx : eval_ctx) (fid : assumed_fun_id) (generics : generic_args) : ety = - sanity_check __FILE__ __LINE__ (generics.trait_refs = []) meta; + sanity_check __FILE__ __LINE__ (generics.trait_refs = []) span; (* [Box::free] has a special treatment *) match fid with | BoxFree -> - sanity_check __FILE__ __LINE__ (generics.regions = []) meta; - sanity_check __FILE__ __LINE__ (List.length generics.types = 1) meta; - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.regions = []) span; + sanity_check __FILE__ __LINE__ (List.length generics.types = 1) span; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; mk_unit_ty | _ -> (* Retrieve the function's signature *) @@ -320,28 +302,30 @@ let get_assumed_function_return_type (meta : Meta.meta) (ctx : eval_ctx) Subst.erase_regions_substitute_types ty_subst cg_subst tr_subst tr_self sg.output in - AssociatedTypes.ctx_normalize_erase_ty meta ctx ty + AssociatedTypes.ctx_normalize_erase_ty span ctx ty -let move_return_value (config : config) (meta : Meta.meta) - (pop_return_value : bool) (cf : typed_value option -> m_fun) : m_fun = - fun ctx -> +let move_return_value (config : config) (span : Meta.span) + (pop_return_value : bool) (ctx : eval_ctx) : + typed_value option * eval_ctx * (eval_result -> eval_result) = if pop_return_value then let ret_vid = VarId.zero in - let cc = eval_operand config meta (Move (mk_place_from_var_id ret_vid)) in - cc (fun v ctx -> cf (Some v) ctx) ctx - else cf None ctx + let v, ctx, cc = + eval_operand config span (Move (mk_place_from_var_id ret_vid)) ctx + in + (Some v, ctx, cc) + else (None, ctx, fun e -> e) -let pop_frame (config : config) (meta : Meta.meta) (pop_return_value : bool) - (cf : typed_value option -> m_fun) : m_fun = - fun ctx -> +let pop_frame (config : config) (span : Meta.span) (pop_return_value : bool) + (ctx : eval_ctx) : + typed_value option * eval_ctx * (eval_result -> eval_result) = (* Debug *) - log#ldebug (lazy ("pop_frame:\n" ^ eval_ctx_to_string ~meta:(Some meta) ctx)); + log#ldebug (lazy ("pop_frame:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); (* List the local variables, but the return variable *) let ret_vid = VarId.zero in let rec list_locals env = match env with - | [] -> craise __FILE__ __LINE__ meta "Inconsistent environment" + | [] -> craise __FILE__ __LINE__ span "Inconsistent environment" | EAbs _ :: env -> list_locals env | EBinding (BDummy _, _) :: env -> list_locals env | EBinding (BVar var, _) :: env -> @@ -358,75 +342,60 @@ let pop_frame (config : config) (meta : Meta.meta) (pop_return_value : bool) ^ "]")); (* Move the return value out of the return variable *) - let cc = move_return_value config meta pop_return_value in - (* Sanity check *) - let cc = - comp_check_value cc (fun ret_value ctx -> - match ret_value with - | None -> () - | Some ret_value -> - sanity_check __FILE__ __LINE__ - (not (bottom_in_value ctx.ended_regions ret_value)) - meta) + let v, ctx, cc = move_return_value config span pop_return_value ctx in + let _ = + match v with + | None -> () + | Some ret_value -> + sanity_check __FILE__ __LINE__ + (not (bottom_in_value ctx.ended_regions ret_value)) + span in (* Drop the outer *loans* we find in the local variables *) - let cf_drop_loans_in_locals cf (ret_value : typed_value option) : m_fun = - (* Drop the loans *) - let locals = List.rev locals in - let cf_drop = - List.fold_left - (fun cf lid -> - drop_outer_loans_at_lplace config meta (mk_place_from_var_id lid) cf) - (cf ret_value) locals - in - (* Apply *) - cf_drop + let ctx, cc = + comp cc + ((* Drop the loans *) + let locals = List.rev locals in + fold_left_apply_continuation + (fun lid ctx -> + drop_outer_loans_at_lplace config span (mk_place_from_var_id lid) ctx) + locals ctx) in - let cc = comp cc cf_drop_loans_in_locals in (* Debug *) - let cc = - comp_check_value cc (fun _ ctx -> - log#ldebug - (lazy - ("pop_frame: after dropping outer loans in local variables:\n" - ^ eval_ctx_to_string ~meta:(Some meta) ctx))) - in + log#ldebug + (lazy + ("pop_frame: after dropping outer loans in local variables:\n" + ^ eval_ctx_to_string ~span:(Some span) ctx)); (* Pop the frame - we remove the [Frame] delimiter, and reintroduce all * the local variables (which may still contain borrow permissions - but * no outer loans) as dummy variables in the caller frame *) let rec pop env = match env with - | [] -> craise __FILE__ __LINE__ meta "Inconsistent environment" + | [] -> craise __FILE__ __LINE__ span "Inconsistent environment" | EAbs abs :: env -> EAbs abs :: pop env | EBinding (_, v) :: env -> let vid = fresh_dummy_var_id () in EBinding (BDummy vid, v) :: pop env | EFrame :: env -> (* Stop here *) env in - let cf_pop cf (ret_value : typed_value option) : m_fun = - fun ctx -> - let env = pop ctx.env in - let ctx = { ctx with env } in - cf ret_value ctx - in - (* Compose and apply *) - comp cc cf_pop cf ctx + let env = pop ctx.env in + let ctx = { ctx with env } in + (* Return *) + (v, ctx, cc) (** Pop the current frame and assign the returned value to its destination. *) -let pop_frame_assign (config : config) (meta : Meta.meta) (dest : place) : +let pop_frame_assign (config : config) (span : Meta.span) (dest : place) : cm_fun = - let cf_pop = pop_frame config meta true in - let cf_assign cf ret_value : m_fun = - assign_to_place config meta (Option.get ret_value) dest cf - in - comp cf_pop cf_assign + fun ctx -> + let v, ctx, cc = pop_frame config span true ctx in + comp cc (assign_to_place config span (Option.get v) dest ctx) (** Auxiliary function - see {!eval_assumed_function_call} *) -let eval_box_new_concrete (config : config) (meta : Meta.meta) +let eval_box_new_concrete (config : config) (span : Meta.span) (generics : generic_args) : cm_fun = - fun cf ctx -> + fun ctx -> (* Check and retrieve the arguments *) match (generics.regions, generics.types, generics.const_generics, ctx.env) @@ -440,34 +409,26 @@ let eval_box_new_concrete (config : config) (meta : Meta.meta) (* Required type checking *) cassert __FILE__ __LINE__ (input_value.ty = boxed_ty) - meta "The input given to Box::new doesn't have the proper type"; + span "The input given to Box::new doesn't have the proper type"; (* Move the input value *) - let cf_move = - eval_operand config meta (Move (mk_place_from_var_id input_var.index)) + let v, ctx, cc = + eval_operand config span + (Move (mk_place_from_var_id input_var.index)) + ctx in (* Create the new box *) - let cf_create cf (moved_input_value : typed_value) : m_fun = - (* Create the box value *) - let generics = TypesUtils.mk_generic_args_from_types [ boxed_ty ] in - let box_ty = TAdt (TAssumed TBox, generics) in - let box_v = - VAdt { variant_id = None; field_values = [ moved_input_value ] } - in - let box_v = mk_typed_value meta box_ty box_v in + (* Create the box value *) + let generics = TypesUtils.mk_generic_args_from_types [ boxed_ty ] in + let box_ty = TAdt (TAssumed TBox, generics) in + let box_v = VAdt { variant_id = None; field_values = [ v ] } in + let box_v = mk_typed_value span box_ty box_v in - (* Move this value to the return variable *) - let dest = mk_place_from_var_id VarId.zero in - let cf_assign = assign_to_place config meta box_v dest in - - (* Continue *) - cf_assign cf - in - - (* Compose and apply *) - comp cf_move cf_create cf ctx - | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" + (* Move this value to the return variable *) + let dest = mk_place_from_var_id VarId.zero in + comp cc (assign_to_place config span box_v dest ctx) + | _ -> craise __FILE__ __LINE__ span "Inconsistent state" (** Auxiliary function - see {!eval_assumed_function_call}. @@ -488,43 +449,41 @@ let eval_box_new_concrete (config : config) (meta : Meta.meta) It thus updates the box value (by calling {!drop_value}) and updates the destination (by setting it to [()]). *) -let eval_box_free (config : config) (meta : Meta.meta) (generics : generic_args) +let eval_box_free (config : config) (span : Meta.span) (generics : generic_args) (args : operand list) (dest : place) : cm_fun = - fun cf ctx -> + fun ctx -> match (generics.regions, generics.types, generics.const_generics, args) with | [], [ boxed_ty ], [], [ Move input_box_place ] -> (* Required type checking *) let input_box = - InterpreterPaths.read_place meta Write input_box_place ctx + InterpreterPaths.read_place span Write input_box_place ctx in (let input_ty = ty_get_box input_box.ty in sanity_check __FILE__ __LINE__ (input_ty = boxed_ty)) - meta; + span; (* Drop the value *) - let cc = drop_value config meta input_box_place in + let ctx, cc = drop_value config span input_box_place ctx in (* Update the destination by setting it to [()] *) - let cc = comp cc (assign_to_place config meta mk_unit_value dest) in - - (* Continue *) - cc cf ctx - | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" + comp cc (assign_to_place config span mk_unit_value dest ctx) + | _ -> craise __FILE__ __LINE__ span "Inconsistent state" (** Evaluate a non-local function call in concrete mode *) -let eval_assumed_function_call_concrete (config : config) (meta : Meta.meta) +let eval_assumed_function_call_concrete (config : config) (span : Meta.span) (fid : assumed_fun_id) (call : call) : cm_fun = + fun ctx -> let args = call.args in let dest = call.dest in match call.func with | FnOpMove _ -> (* Closure case: TODO *) - craise __FILE__ __LINE__ meta "Closures are not supported yet" + craise __FILE__ __LINE__ span "Closures are not supported yet" | FnOpRegular func -> ( let generics = func.generics in (* Sanity check: we don't fully handle the const generic vars environment in concrete mode yet *) - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; (* There are two cases (and this is extremely annoying): - the function is not box_free - the function is box_free @@ -533,12 +492,12 @@ let eval_assumed_function_call_concrete (config : config) (meta : Meta.meta) match fid with | BoxFree -> (* Degenerate case: box_free *) - eval_box_free config meta generics args dest + eval_box_free config span generics args dest ctx | _ -> (* "Normal" case: not box_free *) (* Evaluate the operands *) (* let ctx, args_vl = eval_operands config ctx args in *) - let cf_eval_ops = eval_operands config meta args in + let args_vl, ctx, cc = eval_operands config span args ctx in (* Evaluate the call * @@ -547,53 +506,42 @@ let eval_assumed_function_call_concrete (config : config) (meta : Meta.meta) * below, without having to introduce an intermediary function call, * but it made it less clear where the computed values came from, * so we reversed the modifications. *) - let cf_eval_call cf (args_vl : typed_value list) : m_fun = - fun ctx -> - (* Push the stack frame: we initialize the frame with the return variable, - and one variable per input argument *) - let cc = push_frame in - - (* Create and push the return variable *) - let ret_vid = VarId.zero in - let ret_ty = - get_assumed_function_return_type meta ctx fid generics - in - let ret_var = mk_var ret_vid (Some "@return") ret_ty in - let cc = comp cc (push_uninitialized_var meta ret_var) in - - (* Create and push the input variables *) - let input_vars = - VarId.mapi_from1 - (fun id (v : typed_value) -> (mk_var id None v.ty, v)) - args_vl - in - let cc = comp cc (push_vars meta input_vars) in - - (* "Execute" the function body. As the functions are assumed, here we call - * custom functions to perform the proper manipulations: we don't have - * access to a body. *) - let cf_eval_body : cm_fun = - match fid with - | BoxNew -> eval_box_new_concrete config meta generics - | BoxFree -> - (* Should have been treated above *) - craise __FILE__ __LINE__ meta "Unreachable" - | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared - | ArrayToSliceMut | ArrayRepeat | SliceIndexShared | SliceIndexMut - -> - craise __FILE__ __LINE__ meta "Unimplemented" - in - - let cc = comp cc cf_eval_body in - - (* Pop the frame *) - let cc = comp cc (pop_frame_assign config meta dest) in - - (* Continue *) - cc cf ctx + (* Push the stack frame: we initialize the frame with the return variable, + and one variable per input argument *) + let ctx = push_frame ctx in + + (* Create and push the return variable *) + let ret_vid = VarId.zero in + let ret_ty = get_assumed_function_return_type span ctx fid generics in + let ret_var = mk_var ret_vid (Some "@return") ret_ty in + let ctx = push_uninitialized_var span ret_var ctx in + + (* Create and push the input variables *) + let input_vars = + VarId.mapi_from1 + (fun id (v : typed_value) -> (mk_var id None v.ty, v)) + args_vl in - (* Compose and apply *) - comp cf_eval_ops cf_eval_call) + let ctx = push_vars span input_vars ctx in + + (* "Execute" the function body. As the functions are assumed, here we call + * custom functions to perform the proper manipulations: we don't have + * access to a body. *) + let ctx, cf_eval_body = + match fid with + | BoxNew -> eval_box_new_concrete config span generics ctx + | BoxFree -> + (* Should have been treated above *) + craise __FILE__ __LINE__ span "Unreachable" + | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared + | ArrayToSliceMut | ArrayRepeat | SliceIndexShared | SliceIndexMut + -> + craise __FILE__ __LINE__ span "Unimplemented" + in + let cc = cc_comp cc cf_eval_body in + + (* Pop the frame *) + comp cc (pop_frame_assign config span dest ctx)) (** Helper @@ -750,7 +698,7 @@ let create_push_abstractions_from_abs_region_groups which means that whenever we call a provided trait method, we do not refer to a trait clause but directly to the method provided in the trait declaration. *) -let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) +let eval_transparent_function_call_symbolic_inst (span : Meta.span) (call : call) (ctx : eval_ctx) : fun_id_or_trait_method_ref * generic_args @@ -761,7 +709,7 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) match call.func with | FnOpMove _ -> (* Closure case: TODO *) - craise __FILE__ __LINE__ meta "Closures are not supported yet" + craise __FILE__ __LINE__ span "Closures are not supported yet" | FnOpRegular func -> ( match func.func with | FunId (FRegular fid) -> @@ -779,13 +727,13 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) ctx.fun_ctx.regions_hierarchies in let inst_sg = - instantiate_fun_sig meta ctx func.generics tr_self def.signature + instantiate_fun_sig span ctx func.generics tr_self def.signature regions_hierarchy in (func.func, func.generics, None, def, regions_hierarchy, inst_sg) | FunId (FAssumed _) -> (* Unreachable: must be a transparent function *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | TraitMethod (trait_ref, method_name, _) -> ( log#ldebug (lazy @@ -826,7 +774,7 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) ctx.fun_ctx.regions_hierarchies in let inst_sg = - instantiate_fun_sig meta ctx generics tr_self + instantiate_fun_sig span ctx generics tr_self method_def.signature regions_hierarchy in (* Also update the function identifier: we want to forget @@ -847,7 +795,7 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) (remember: for now, we forbid overriding provided methods) *) cassert __FILE__ __LINE__ (trait_impl.provided_methods = []) - meta "Overriding provided methods is currently forbidden"; + span "Overriding provided methods is currently forbidden"; let trait_decl = ctx_lookup_trait_decl ctx trait_ref.trait_decl_ref.trait_decl_id @@ -894,7 +842,7 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) in let tr_self = TraitRef trait_ref in let inst_sg = - instantiate_fun_sig meta ctx all_generics tr_self + instantiate_fun_sig span ctx all_generics tr_self method_def.signature regions_hierarchy in ( func.func, @@ -936,7 +884,7 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) in let tr_self = TraitRef trait_ref in let inst_sg = - instantiate_fun_sig meta ctx generics tr_self + instantiate_fun_sig span ctx generics tr_self method_def.signature regions_hierarchy in ( func.func, @@ -947,28 +895,27 @@ let eval_transparent_function_call_symbolic_inst (meta : Meta.meta) inst_sg ))) (** Evaluate a statement *) -let rec eval_statement (config : config) (st : statement) : st_cm_fun = - fun cf ctx -> +let rec eval_statement (config : config) (st : statement) : stl_cm_fun = + fun ctx -> (* Debugging *) log#ldebug (lazy ("\n**About to evaluate statement**: [\n" ^ statement_to_string_with_tab ctx st ^ "\n]\n\n**Context**:\n" - ^ eval_ctx_to_string ~meta:(Some st.meta) ctx + ^ eval_ctx_to_string ~span:(Some st.span) ctx ^ "\n\n")); (* Take a snapshot of the current context for the purpose of generating pretty names *) - let cc = S.cf_save_snapshot in + let cc = S.save_snapshot ctx in (* Expand the symbolic values if necessary - we need to do that before - * checking the invariants *) - let cc = comp cc (greedy_expand_symbolic_values config st.meta) in + checking the invariants *) + let ctx, cc = comp cc (greedy_expand_symbolic_values config st.span ctx) in (* Sanity check *) - let cc = comp cc (Invariants.cf_check_invariants st.meta) in + Invariants.check_invariants st.span ctx; (* Evaluate *) - let cf_eval_st cf : m_fun = - fun ctx -> + let stl, cf_eval_st = log#ldebug (lazy ("\neval_statement: cf_eval_st: statement:\n" @@ -980,96 +927,118 @@ let rec eval_statement (config : config) (st : statement) : st_cm_fun = match rvalue with | Global (gid, generics) -> (* Evaluate the global *) - eval_global config p gid generics cf ctx + eval_global config st.span p gid generics ctx | _ -> (* Evaluate the rvalue *) - let cf_eval_rvalue = eval_rvalue_not_global config st.meta rvalue in + let res, ctx, cc = + eval_rvalue_not_global config st.span rvalue ctx + in (* Assign *) - let cf_assign cf (res : (typed_value, eval_error) result) ctx = - log#ldebug - (lazy - ("about to assign to place: " ^ place_to_string ctx p - ^ "\n- Context:\n" - ^ eval_ctx_to_string ~meta:(Some st.meta) ctx)); + log#ldebug + (lazy + ("about to assign to place: " ^ place_to_string ctx p + ^ "\n- Context:\n" + ^ eval_ctx_to_string ~span:(Some st.span) ctx)); + let (ctx, res), cf_assign = match res with - | Error EPanic -> cf Panic ctx - | Ok rv -> ( - let expr = - assign_to_place config st.meta rv p (cf Unit) ctx - in - (* Update the synthesized AST - here we store meta-information. + | Error EPanic -> ((ctx, Panic), fun e -> e) + | Ok rv -> + (* Update the synthesized AST - here we store additional span-information. * We do it only in specific cases (it is not always useful, and * also it can lead to issues - for instance, if we borrow a * reserved borrow, we later can't translate it to pure values...) *) - match rvalue with - | Global _ -> craise __FILE__ __LINE__ st.meta "Unreachable" - | Use _ - | RvRef (_, (BShared | BMut | BTwoPhaseMut | BShallow)) - | UnaryOp _ | BinaryOp _ | Discriminant _ | Aggregate _ -> - let rp = rvalue_get_place rvalue in - let rp = - match rp with - | Some rp -> Some (S.mk_mplace st.meta rp ctx) - | None -> None - in - S.synthesize_assignment ctx - (S.mk_mplace st.meta p ctx) - rv rp expr) + let cc = + match rvalue with + | Global _ -> craise __FILE__ __LINE__ st.span "Unreachable" + | Use _ + | RvRef (_, (BShared | BMut | BTwoPhaseMut | BShallow)) + | UnaryOp _ | BinaryOp _ | Discriminant _ | Aggregate _ -> + let rp = rvalue_get_place rvalue in + let rp = + match rp with + | Some rp -> Some (S.mk_mplace st.span rp ctx) + | None -> None + in + S.synthesize_assignment ctx + (S.mk_mplace st.span p ctx) + rv rp + in + let ctx, cc = + comp cc (assign_to_place config st.span rv p ctx) + in + ((ctx, Unit), cc) in - + let cc = cc_comp cc cf_assign in (* Compose and apply *) - comp cf_eval_rvalue cf_assign cf ctx) - | FakeRead p -> eval_fake_read config st.meta p (cf Unit) ctx + ([ (ctx, res) ], cc_singleton __FILE__ __LINE__ st.span cc)) + | FakeRead p -> + let ctx, cc = eval_fake_read config st.span p ctx in + ([ (ctx, Unit) ], cc_singleton __FILE__ __LINE__ st.span cc) | SetDiscriminant (p, variant_id) -> - set_discriminant config st.meta p variant_id cf ctx - | Drop p -> drop_value config st.meta p (cf Unit) ctx - | Assert assertion -> eval_assertion config st.meta assertion cf ctx - | Call call -> eval_function_call config st.meta call cf ctx - | Panic -> cf Panic ctx - | Return -> cf Return ctx - | Break i -> cf (Break i) ctx - | Continue i -> cf (Continue i) ctx - | Nop -> cf Unit ctx + let (ctx, res), cc = set_discriminant config st.span p variant_id ctx in + ([ (ctx, res) ], cc_singleton __FILE__ __LINE__ st.span cc) + | Drop p -> + let ctx, cc = drop_value config st.span p ctx in + ([ (ctx, Unit) ], cc_singleton __FILE__ __LINE__ st.span cc) + | Assert assertion -> + let (ctx, res), cc = eval_assertion config st.span assertion ctx in + ([ (ctx, res) ], cc_singleton __FILE__ __LINE__ st.span cc) + | Call call -> eval_function_call config st.span call ctx + | Panic -> ([ (ctx, Panic) ], cc_singleton __FILE__ __LINE__ st.span cc) + | Return -> ([ (ctx, Return) ], cc_singleton __FILE__ __LINE__ st.span cc) + | Break i -> ([ (ctx, Break i) ], cc_singleton __FILE__ __LINE__ st.span cc) + | Continue i -> + ([ (ctx, Continue i) ], cc_singleton __FILE__ __LINE__ st.span cc) + | Nop -> ([ (ctx, Unit) ], cc_singleton __FILE__ __LINE__ st.span cc) | Sequence (st1, st2) -> (* Evaluate the first statement *) - let cf_st1 = eval_statement config st1 in - (* Evaluate the sequence *) - let cf_st2 cf res = - match res with - (* Evaluation successful: evaluate the second statement *) - | Unit -> eval_statement config st2 cf - (* Control-flow break: transmit. We enumerate the cases on purpose *) - | Panic | Break _ | Continue _ | Return | LoopReturn _ - | EndEnterLoop _ | EndContinue _ -> - cf res + let ctx_resl, cf_st1 = eval_statement config st1 ctx in + (* Evaluate the sequence (evaluate the second statement if the first + statement successfully evaluated, otherwise transfmit the control-flow + break) *) + let ctx_res_cfl = + List.map + (fun (ctx, res) -> + match res with + (* Evaluation successful: evaluate the second statement *) + | Unit -> eval_statement config st2 ctx + (* Control-flow break: transmit. We enumerate the cases on purpose *) + | Panic | Break _ | Continue _ | Return | LoopReturn _ + | EndEnterLoop _ | EndContinue _ -> + ([ (ctx, res) ], cc_singleton __FILE__ __LINE__ st.span cc)) + ctx_resl + in + (* Put everything together: + - we return the flattened list of contexts and results + - we need to build the continuation which will build the whole + expression from the continuations for the individual branches + *) + let ctx_resl, cf_st2 = + comp_seqs __FILE__ __LINE__ st.span ctx_res_cfl in - (* Compose and apply *) - comp cf_st1 cf_st2 cf ctx + (ctx_resl, cc_comp cf_st1 cf_st2) | Loop loop_body -> - InterpreterLoops.eval_loop config st.meta - (eval_statement config loop_body) - cf ctx - | Switch switch -> eval_switch config st.meta switch cf ctx + let eval_loop_body = eval_statement config loop_body in + InterpreterLoops.eval_loop config st.span eval_loop_body ctx + | Switch switch -> eval_switch config st.span switch ctx in (* Compose and apply *) - comp cc cf_eval_st cf ctx + (stl, cc_comp cc cf_eval_st) -and eval_global (config : config) (dest : place) (gid : GlobalDeclId.id) - (generics : generic_args) : st_cm_fun = - fun cf ctx -> +and eval_global (config : config) (span : Meta.span) (dest : place) + (gid : GlobalDeclId.id) (generics : generic_args) : stl_cm_fun = + fun ctx -> let global = ctx_lookup_global_decl ctx gid in match config.mode with | ConcreteMode -> (* Treat the evaluation of the global as a call to the global body *) let func = { func = FunId (FRegular global.body); generics } in let call = { func = FnOpRegular func; args = []; dest } in - (eval_transparent_function_call_concrete config global.item_meta.meta - global.body call) - cf ctx - | SymbolicMode -> + eval_transparent_function_call_concrete config span global.body call ctx + | SymbolicMode -> ( (* Generate a fresh symbolic value. In the translation, this fresh symbolic value will be * defined as equal to the value of the global (see {!S.synthesize_global_eval}). *) - cassert __FILE__ __LINE__ (ty_no_regions global.ty) global.item_meta.meta + cassert __FILE__ __LINE__ (ty_no_regions global.ty) span "Const globals should not contain regions"; (* Instantiate the type *) (* There shouldn't be any reference to Self *) @@ -1082,19 +1051,24 @@ and eval_global (config : config) (dest : place) (gid : GlobalDeclId.id) Subst.erase_regions_substitute_types ty_subst cg_subst tr_subst tr_self global.ty in - let sval = mk_fresh_symbolic_value global.item_meta.meta ty in - let cc = - assign_to_place config global.item_meta.meta + let sval = mk_fresh_symbolic_value span ty in + let ctx, cc = + assign_to_place config span (mk_typed_value_from_symbolic_value sval) - dest + dest ctx in - let e = cc (cf Unit) ctx in - S.synthesize_global_eval gid generics sval e + ( [ (ctx, Unit) ], + fun el -> + match el with + | Some [ e ] -> + (cc_comp (S.synthesize_global_eval gid generics sval) cc) (Some e) + | Some _ -> internal_error __FILE__ __LINE__ span + | _ -> None )) (** Evaluate a switch *) -and eval_switch (config : config) (meta : Meta.meta) (switch : switch) : - st_cm_fun = - fun cf ctx -> +and eval_switch (config : config) (span : Meta.span) (switch : switch) : + stl_cm_fun = + fun ctx -> (* We evaluate the operand in two steps: * first we prepare it, then we check if its value is concrete or * symbolic. If it is concrete, we can then evaluate the operand @@ -1104,286 +1078,317 @@ and eval_switch (config : config) (meta : Meta.meta) (switch : switch) : * (and would thus floating in thin air...)! * *) (* Match on the targets *) - let cf_match : st_cm_fun = - fun cf ctx -> - match switch with - | If (op, st1, st2) -> - (* Evaluate the operand *) - let cf_eval_op = eval_operand config meta op in - (* Switch on the value *) - let cf_if (cf : st_m_fun) (op_v : typed_value) : m_fun = - fun ctx -> - match op_v.value with - | VLiteral (VBool b) -> - (* Evaluate the if and the branch body *) - let cf_branch cf : m_fun = - (* Branch *) - if b then eval_statement config st1 cf - else eval_statement config st2 cf - in - (* Compose the continuations *) - cf_branch cf ctx - | VSymbolic sv -> - (* Expand the symbolic boolean, and continue by evaluating - * the branches *) - let cf_true : st_cm_fun = eval_statement config st1 in - let cf_false : st_cm_fun = eval_statement config st2 in - expand_symbolic_bool config meta sv - (S.mk_opt_place_from_op meta op ctx) - cf_true cf_false cf ctx - | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" - in - (* Compose *) - comp cf_eval_op cf_if cf ctx - | SwitchInt (op, int_ty, stgts, otherwise) -> - (* Evaluate the operand *) - let cf_eval_op = eval_operand config meta op in - (* Switch on the value *) - let cf_switch (cf : st_m_fun) (op_v : typed_value) : m_fun = - fun ctx -> - match op_v.value with - | VLiteral (VScalar sv) -> - (* Evaluate the branch *) - let cf_eval_branch cf = - (* Sanity check *) - sanity_check __FILE__ __LINE__ (sv.int_ty = int_ty) meta; - (* Find the branch *) - match List.find_opt (fun (svl, _) -> List.mem sv svl) stgts with - | None -> eval_statement config otherwise cf - | Some (_, tgt) -> eval_statement config tgt cf - in - (* Compose *) - cf_eval_branch cf ctx - | VSymbolic sv -> - (* Expand the symbolic value and continue by evaluating the - * proper branches *) - let stgts = - List.map - (fun (cv, tgt_st) -> (cv, eval_statement config tgt_st)) - stgts - in - (* Several branches may be grouped together: every branch is described - * by a pair (list of values, branch expression). - * In order to do a symbolic evaluation, we make this "flat" by - * de-grouping the branches. *) - let stgts = - List.concat - (List.map - (fun (vl, st) -> List.map (fun v -> (v, st)) vl) - stgts) - in - (* Translate the otherwise branch *) - let otherwise = eval_statement config otherwise in - (* Expand and continue *) - expand_symbolic_int config meta sv - (S.mk_opt_place_from_op meta op ctx) - int_ty stgts otherwise cf ctx - | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" - in - (* Compose *) - comp cf_eval_op cf_switch cf ctx - | Match (p, stgts, otherwise) -> - (* Access the place *) - let access = Read in - let expand_prim_copy = false in - let cf_read_p cf : m_fun = - access_rplace_reorganize_and_read config meta expand_prim_copy access - p cf - in - (* Match on the value *) - let cf_match (cf : st_m_fun) (p_v : typed_value) : m_fun = - fun ctx -> - (* The value may be shared: we need to ignore the shared loans - to read the value itself *) - let p_v = value_strip_shared_loans p_v in - (* Match *) - match p_v.value with - | VAdt adt -> ( - (* Evaluate the discriminant *) - let dv = Option.get adt.variant_id in - (* Find the branch, evaluate and continue *) - match List.find_opt (fun (svl, _) -> List.mem dv svl) stgts with - | None -> ( - match otherwise with - | None -> craise __FILE__ __LINE__ meta "No otherwise branch" - | Some otherwise -> eval_statement config otherwise cf ctx) - | Some (_, tgt) -> eval_statement config tgt cf ctx) - | VSymbolic sv -> - (* Expand the symbolic value - may lead to branching *) - let cf_expand = - expand_symbolic_adt config meta sv - (Some (S.mk_mplace meta p ctx)) - in - (* Re-evaluate the switch - the value is not symbolic anymore, - which means we will go to the other branch *) - cf_expand (eval_switch config meta switch) cf ctx - | _ -> craise __FILE__ __LINE__ meta "Inconsistent state" - in - (* Compose *) - comp cf_read_p cf_match cf ctx - in - (* Compose the continuations *) - cf_match cf ctx + match switch with + | If (op, st1, st2) -> + (* Evaluate the operand *) + let op_v, ctx, cf_eval_op = eval_operand config span op ctx in + (* Switch on the value *) + let ctx_resl, cf_if = + match op_v.value with + | VLiteral (VBool b) -> + (* Branch *) + if b then eval_statement config st1 ctx + else eval_statement config st2 ctx + | VSymbolic sv -> + (* Expand the symbolic boolean, and continue by evaluating + the branches *) + let (ctx_true, ctx_false), cf_bool = + expand_symbolic_bool config span sv + (S.mk_opt_place_from_op span op ctx) + ctx + in + let resl_true = eval_statement config st1 ctx_true in + let resl_false = eval_statement config st2 ctx_false in + let ctx_resl, cf_branches = + comp_seqs __FILE__ __LINE__ span [ resl_true; resl_false ] + in + let cc el = + match cf_branches el with + | None -> None + | Some [ e_true; e_false ] -> cf_bool (Some (e_true, e_false)) + | _ -> internal_error __FILE__ __LINE__ span + in + (ctx_resl, cc) + | _ -> craise __FILE__ __LINE__ span "Inconsistent state" + in + (* Compose *) + (ctx_resl, cc_comp cf_eval_op cf_if) + | SwitchInt (op, int_ty, stgts, otherwise) -> + (* Evaluate the operand *) + let op_v, ctx, cf_eval_op = eval_operand config span op ctx in + (* Switch on the value *) + let ctx_resl, cf_switch = + match op_v.value with + | VLiteral (VScalar sv) -> ( + (* Sanity check *) + sanity_check __FILE__ __LINE__ (sv.int_ty = int_ty) span; + (* Find the branch *) + match List.find_opt (fun (svl, _) -> List.mem sv svl) stgts with + | None -> eval_statement config otherwise ctx + | Some (_, tgt) -> eval_statement config tgt ctx) + | VSymbolic sv -> + (* Several branches may be grouped together: every branch is described + by a pair (list of values, branch expression). + In order to do a symbolic evaluation, we make this "flat" by + de-grouping the branches. *) + let values, branches = + List.split + (List.concat + (List.map + (fun (vl, st) -> List.map (fun v -> (v, st)) vl) + stgts)) + in + (* Expand the symbolic value *) + let (ctx_branches, ctx_otherwise), cf_int = + expand_symbolic_int config span sv + (S.mk_opt_place_from_op span op ctx) + int_ty values ctx + in + (* Evaluate the branches: first the "regular" branches *) + let resl_branches = + List.map + (fun (ctx, branch) -> eval_statement config branch ctx) + (List.combine ctx_branches branches) + in + (* Then evaluate the "otherwise" branch *) + let resl_otherwise = + eval_statement config otherwise ctx_otherwise + in + (* Compose the continuations *) + let resl, cf = + comp_seqs __FILE__ __LINE__ span + (resl_branches @ [ resl_otherwise ]) + in + let cc el = + match el with + | None -> None + | Some el -> + let el, e_otherwise = Collections.List.pop_last el in + cf_int (Some (el, e_otherwise)) + in + (resl, cc_comp cc cf) + | _ -> craise __FILE__ __LINE__ span "Inconsistent state" + in + (* Compose *) + (ctx_resl, cc_comp cf_eval_op cf_switch) + | Match (p, stgts, otherwise) -> + (* Access the place *) + let access = Read in + let expand_prim_copy = false in + let p_v, ctx, cf_read_p = + access_rplace_reorganize_and_read config span expand_prim_copy access p + ctx + in + (* Match on the value *) + let ctx_resl, cf_match = + (* The value may be shared: we need to ignore the shared loans + to read the value itself *) + let p_v = value_strip_shared_loans p_v in + (* Match *) + match p_v.value with + | VAdt adt -> ( + (* Evaluate the discriminant *) + let dv = Option.get adt.variant_id in + (* Find the branch, evaluate and continue *) + match List.find_opt (fun (svl, _) -> List.mem dv svl) stgts with + | None -> ( + match otherwise with + | None -> craise __FILE__ __LINE__ span "No otherwise branch" + | Some otherwise -> eval_statement config otherwise ctx) + | Some (_, tgt) -> eval_statement config tgt ctx) + | VSymbolic sv -> + (* Expand the symbolic value - may lead to branching *) + let ctxl, cf_expand = + expand_symbolic_adt config span sv + (Some (S.mk_mplace span p ctx)) + ctx + in + (* Re-evaluate the switch - the value is not symbolic anymore, + which means we will go to the other branch *) + let resl = + List.map (fun ctx -> (eval_switch config span switch) ctx) ctxl + in + (* Compose the continuations *) + let ctx_resl, cf = comp_seqs __FILE__ __LINE__ span resl in + (ctx_resl, cc_comp cf_expand cf) + | _ -> craise __FILE__ __LINE__ span "Inconsistent state" + in + (* Compose *) + (ctx_resl, cc_comp cf_read_p cf_match) (** Evaluate a function call (auxiliary helper for [eval_statement]) *) -and eval_function_call (config : config) (meta : Meta.meta) (call : call) : - st_cm_fun = +and eval_function_call (config : config) (span : Meta.span) (call : call) : + stl_cm_fun = (* There are several cases: - this is a local function, in which case we execute its body - this is an assumed function, in which case there is a special treatment - this is a trait method *) match config.mode with - | ConcreteMode -> eval_function_call_concrete config meta call - | SymbolicMode -> eval_function_call_symbolic config meta call + | ConcreteMode -> eval_function_call_concrete config span call + | SymbolicMode -> eval_function_call_symbolic config span call -and eval_function_call_concrete (config : config) (meta : Meta.meta) - (call : call) : st_cm_fun = - fun cf ctx -> +and eval_function_call_concrete (config : config) (span : Meta.span) + (call : call) : stl_cm_fun = + fun ctx -> match call.func with - | FnOpMove _ -> craise __FILE__ __LINE__ meta "Closures are not supported yet" + | FnOpMove _ -> craise __FILE__ __LINE__ span "Closures are not supported yet" | FnOpRegular func -> ( match func.func with | FunId (FRegular fid) -> - eval_transparent_function_call_concrete config meta fid call cf ctx - | FunId (FAssumed fid) -> + eval_transparent_function_call_concrete config span fid call ctx + | FunId (FAssumed fid) -> ( (* Continue - note that we do as if the function call has been successful, * by giving {!Unit} to the continuation, because we place us in the case * where we haven't panicked. Of course, the translation needs to take the * panic case into account... *) - eval_assumed_function_call_concrete config meta fid call (cf Unit) ctx - | TraitMethod _ -> craise __FILE__ __LINE__ meta "Unimplemented") - -and eval_function_call_symbolic (config : config) (meta : Meta.meta) - (call : call) : st_cm_fun = + let ctx, cc = + eval_assumed_function_call_concrete config span fid call ctx + in + ( [ (ctx, Unit) ], + fun el -> + match el with + | Some [ e ] -> cc (Some e) + | Some _ -> internal_error __FILE__ __LINE__ span + | _ -> None )) + | TraitMethod _ -> craise __FILE__ __LINE__ span "Unimplemented") + +and eval_function_call_symbolic (config : config) (span : Meta.span) + (call : call) : stl_cm_fun = match call.func with - | FnOpMove _ -> craise __FILE__ __LINE__ meta "Closures are not supported yet" + | FnOpMove _ -> craise __FILE__ __LINE__ span "Closures are not supported yet" | FnOpRegular func -> ( match func.func with | FunId (FRegular _) | TraitMethod _ -> - eval_transparent_function_call_symbolic config meta call + eval_transparent_function_call_symbolic config span call | FunId (FAssumed fid) -> - eval_assumed_function_call_symbolic config meta fid call func) + eval_assumed_function_call_symbolic config span fid call func) (** Evaluate a local (i.e., non-assumed) function call in concrete mode *) -and eval_transparent_function_call_concrete (config : config) (meta : Meta.meta) - (fid : FunDeclId.id) (call : call) : st_cm_fun = +and eval_transparent_function_call_concrete (config : config) (span : Meta.span) + (fid : FunDeclId.id) (call : call) : stl_cm_fun = + fun ctx -> let args = call.args in let dest = call.dest in match call.func with - | FnOpMove _ -> craise __FILE__ __LINE__ meta "Closures are not supported yet" + | FnOpMove _ -> craise __FILE__ __LINE__ span "Closures are not supported yet" | FnOpRegular func -> let generics = func.generics in (* Sanity check: we don't fully handle the const generic vars environment in concrete mode yet *) - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; - fun cf ctx -> - (* Retrieve the (correctly instantiated) body *) - let def = ctx_lookup_fun_decl ctx fid in - (* We can evaluate the function call only if it is not opaque *) - let body = - match def.body with - | None -> - craise __FILE__ __LINE__ meta - ("Can't evaluate a call to an opaque function: " - ^ name_to_string ctx def.name) - | Some body -> body - in - (* TODO: we need to normalize the types if we want to correctly support traits *) - cassert __FILE__ __LINE__ (generics.trait_refs = []) body.meta - "Traits are not supported yet in concrete mode"; - (* There shouldn't be any reference to Self *) - let tr_self = UnknownTrait __FUNCTION__ in - let subst = - Subst.make_subst_from_generics def.signature.generics generics tr_self - in - let locals, body_st = Subst.fun_body_substitute_in_body subst body in - - (* Evaluate the input operands *) - sanity_check __FILE__ __LINE__ - (List.length args = body.arg_count) - body.meta; - let cc = eval_operands config body.meta args in - - (* Push a frame delimiter - we use {!comp_transmit} to transmit the result - * of the operands evaluation from above to the functions afterwards, while - * ignoring it in this function *) - let cc = comp_transmit cc push_frame in - - (* Compute the initial values for the local variables *) - (* 1. Push the return value *) - let ret_var, locals = - match locals with - | ret_ty :: locals -> (ret_ty, locals) - | _ -> craise __FILE__ __LINE__ meta "Unreachable" - in - let input_locals, locals = - Collections.List.split_at locals body.arg_count - in + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; + (* Retrieve the (correctly instantiated) body *) + let def = ctx_lookup_fun_decl ctx fid in + (* We can evaluate the function call only if it is not opaque *) + let body = + match def.body with + | None -> + craise __FILE__ __LINE__ span + ("Can't evaluate a call to an opaque function: " + ^ name_to_string ctx def.name) + | Some body -> body + in + (* TODO: we need to normalize the types if we want to correctly support traits *) + cassert __FILE__ __LINE__ (generics.trait_refs = []) body.span + "Traits are not supported yet in concrete mode"; + (* There shouldn't be any reference to Self *) + let tr_self = UnknownTrait __FUNCTION__ in + let subst = + Subst.make_subst_from_generics def.signature.generics generics tr_self + in + let locals, body_st = Subst.fun_body_substitute_in_body subst body in + + (* Evaluate the input operands *) + sanity_check __FILE__ __LINE__ + (List.length args = body.arg_count) + body.span; + let vl, ctx, cc = eval_operands config body.span args ctx in + + (* Push a frame delimiter - we use {!comp_transmit} to transmit the result + * of the operands evaluation from above to the functions afterwards, while + * ignoring it in this function *) + let ctx = push_frame ctx in + + (* Compute the initial values for the local variables *) + (* 1. Push the return value *) + let ret_var, locals = + match locals with + | ret_ty :: locals -> (ret_ty, locals) + | _ -> craise __FILE__ __LINE__ span "Unreachable" + in + let input_locals, locals = + Collections.List.split_at locals body.arg_count + in - let cc = - comp_transmit cc - (push_var meta ret_var (mk_bottom meta ret_var.var_ty)) - in + let ctx = push_var span ret_var (mk_bottom span ret_var.var_ty) ctx in - (* 2. Push the input values *) - let cf_push_inputs cf args = - let inputs = List.combine input_locals args in - (* Note that this function checks that the variables and their values - * have the same type (this is important) *) - push_vars meta inputs cf - in - let cc = comp cc cf_push_inputs in - - (* 3. Push the remaining local variables (initialized as {!Bottom}) *) - let cc = comp cc (push_uninitialized_vars meta locals) in - - (* Execute the function body *) - let cc = comp cc (eval_function_body config body_st) in - - (* Pop the stack frame and move the return value to its destination *) - let cf_finish cf res = - match res with - | Panic -> cf Panic - | Return -> - (* Pop the stack frame, retrieve the return value, move it to - * its destination and continue *) - pop_frame_assign config meta dest (cf Unit) - | Break _ | Continue _ | Unit | LoopReturn _ | EndEnterLoop _ - | EndContinue _ -> - craise __FILE__ __LINE__ meta "Unreachable" - in - let cc = comp cc cf_finish in + (* 2. Push the input values *) + let ctx = + let inputs = List.combine input_locals vl in + (* Note that this function checks that the variables and their values + * have the same type (this is important) *) + push_vars span inputs ctx + in - (* Continue *) - cc cf ctx + (* 3. Push the remaining local variables (initialized as {!Bottom}) *) + let ctx = push_uninitialized_vars span locals ctx in + + (* Execute the function body *) + let ctx_resl, cc = comp cc (eval_function_body config body_st ctx) in + + (* Pop the stack frame and move the return value to its destination *) + let ctx_resl_cfl = + List.map + (fun (ctx, res) -> + match res with + | Panic -> ((ctx, Panic), fun e -> e) + | Return -> + (* Pop the stack frame, retrieve the return value, move it to + its destination and continue *) + let ctx, cf = pop_frame_assign config span dest ctx in + ((ctx, Unit), cf) + | Break _ | Continue _ | Unit | LoopReturn _ | EndEnterLoop _ + | EndContinue _ -> + craise __FILE__ __LINE__ span "Unreachable") + ctx_resl + in + let ctx_resl, cfl = List.split ctx_resl_cfl in + let cf_pop el = + match el with + | None -> None + | Some el -> + Some + (List.map Option.get (List.map2 (fun cf e -> cf (Some e)) cfl el)) + in + (* Continue *) + (ctx_resl, cc_comp cc cf_pop) (** Evaluate a local (i.e., non-assumed) function call in symbolic mode *) -and eval_transparent_function_call_symbolic (config : config) (meta : Meta.meta) - (call : call) : st_cm_fun = - fun cf ctx -> +and eval_transparent_function_call_symbolic (config : config) (span : Meta.span) + (call : call) : stl_cm_fun = + fun ctx -> let func, generics, trait_method_generics, def, regions_hierarchy, inst_sg = - eval_transparent_function_call_symbolic_inst meta call ctx + eval_transparent_function_call_symbolic_inst span call ctx in (* Sanity check: same number of inputs *) sanity_check __FILE__ __LINE__ (List.length call.args = List.length def.signature.inputs) - def.item_meta.meta; + def.item_meta.span; (* Sanity check: no nested borrows, borrows in ADTs, etc. *) cassert __FILE__ __LINE__ (List.for_all (fun ty -> not (ty_has_nested_borrows ctx.type_ctx.type_infos ty)) (inst_sg.output :: inst_sg.inputs)) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; cassert __FILE__ __LINE__ (List.for_all (fun ty -> not (ty_has_adt_with_borrows ctx.type_ctx.type_infos ty)) (inst_sg.output :: inst_sg.inputs)) - meta "ADTs containing borrows are not supported yet"; + span "ADTs containing borrows are not supported yet"; (* Evaluate the function call *) - eval_function_call_symbolic_from_inst_sig config def.item_meta.meta func + eval_function_call_symbolic_from_inst_sig config def.item_meta.span func def.signature regions_hierarchy inst_sg generics trait_method_generics - call.args call.dest cf ctx + call.args call.dest ctx (** Evaluate a function call in symbolic mode by using the function signature. @@ -1397,12 +1402,12 @@ and eval_transparent_function_call_symbolic (config : config) (meta : Meta.meta) trait ref as input. *) and eval_function_call_symbolic_from_inst_sig (config : config) - (meta : Meta.meta) (fid : fun_id_or_trait_method_ref) (sg : fun_sig) + (span : Meta.span) (fid : fun_id_or_trait_method_ref) (sg : fun_sig) (regions_hierarchy : region_var_groups) (inst_sg : inst_fun_sig) (generics : generic_args) (trait_method_generics : (generic_args * trait_instance_id) option) - (args : operand list) (dest : place) : st_cm_fun = - fun cf ctx -> + (args : operand list) (dest : place) : stl_cm_fun = + fun ctx -> log#ldebug (lazy ("eval_function_call_symbolic_from_inst_sig:\n- fid: " @@ -1417,81 +1422,76 @@ and eval_function_call_symbolic_from_inst_sig (config : config) (* Generate a fresh symbolic value for the return value *) let ret_sv_ty = inst_sg.output in - let ret_spc = mk_fresh_symbolic_value meta ret_sv_ty in + let ret_spc = mk_fresh_symbolic_value span ret_sv_ty in let ret_value = mk_typed_value_from_symbolic_value ret_spc in let ret_av regions = mk_aproj_loans_value_from_symbolic_value regions ret_spc in let args_places = - List.map (fun p -> S.mk_opt_place_from_op meta p ctx) args + List.map (fun p -> S.mk_opt_place_from_op span p ctx) args in - let dest_place = Some (S.mk_mplace meta dest ctx) in + let dest_place = Some (S.mk_mplace span dest ctx) in (* Evaluate the input operands *) - let cc = eval_operands config meta args in + let args, ctx, cc = eval_operands config span args ctx in (* Generate the abstractions and insert them in the context *) let abs_ids = List.map (fun rg -> rg.id) inst_sg.regions_hierarchy in - let cf_call cf (args : typed_value list) : m_fun = - fun ctx -> - let args_with_rtypes = List.combine args inst_sg.inputs in - - (* Check the type of the input arguments *) - cassert __FILE__ __LINE__ - (List.for_all - (fun ((arg, rty) : typed_value * rty) -> - arg.ty = Subst.erase_regions rty) - args_with_rtypes) - meta "The input arguments don't have the proper type"; - (* Check that the input arguments don't contain symbolic values that can't - * be fed to functions (i.e., symbolic values output from function return - * values and which contain borrows of borrows can't be used as function - * inputs *) - sanity_check __FILE__ __LINE__ - (List.for_all - (fun arg -> - not (value_has_ret_symbolic_value_with_borrow_under_mut ctx arg)) - args) - meta; - - (* Initialize the abstractions and push them in the context. - * First, we define the function which, given an initialized, empty - * abstraction, computes the avalues which should be inserted inside. - *) - let compute_abs_avalues (abs : abs) (ctx : eval_ctx) : - eval_ctx * typed_avalue list = - (* Project over the input values *) - let ctx, args_projs = - List.fold_left_map - (fun ctx (arg, arg_rty) -> - apply_proj_borrows_on_input_value config meta ctx abs.regions - abs.ancestors_regions arg arg_rty) - ctx args_with_rtypes - in - (* Group the input and output values *) - (ctx, List.append args_projs [ ret_av abs.regions ]) - in - (* Actually initialize and insert the abstractions *) - let call_id = fresh_fun_call_id () in - let region_can_end _ = true in - let ctx = - create_push_abstractions_from_abs_region_groups - (fun rg_id -> FunCall (call_id, rg_id)) - inst_sg.regions_hierarchy region_can_end compute_abs_avalues ctx - in - - (* Apply the continuation *) - let expr = cf ctx in + let args_with_rtypes = List.combine args inst_sg.inputs in - (* Synthesize the symbolic AST *) - S.synthesize_regular_function_call fid call_id ctx sg regions_hierarchy - abs_ids generics trait_method_generics args args_places ret_spc dest_place - expr + (* Check the type of the input arguments *) + cassert __FILE__ __LINE__ + (List.for_all + (fun ((arg, rty) : typed_value * rty) -> + arg.ty = Subst.erase_regions rty) + args_with_rtypes) + span "The input arguments don't have the proper type"; + (* Check that the input arguments don't contain symbolic values that can't + * be fed to functions (i.e., symbolic values output from function return + * values and which contain borrows of borrows can't be used as function + * inputs *) + sanity_check __FILE__ __LINE__ + (List.for_all + (fun arg -> + not (value_has_ret_symbolic_value_with_borrow_under_mut ctx arg)) + args) + span; + + (* Initialize the abstractions and push them in the context. + * First, we define the function which, given an initialized, empty + * abstraction, computes the avalues which should be inserted inside. + *) + let compute_abs_avalues (abs : abs) (ctx : eval_ctx) : + eval_ctx * typed_avalue list = + (* Project over the input values *) + let ctx, args_projs = + List.fold_left_map + (fun ctx (arg, arg_rty) -> + apply_proj_borrows_on_input_value config span ctx abs.regions + abs.ancestors_regions arg arg_rty) + ctx args_with_rtypes + in + (* Group the input and output values *) + (ctx, List.append args_projs [ ret_av abs.regions ]) + in + (* Actually initialize and insert the abstractions *) + let call_id = fresh_fun_call_id () in + let region_can_end _ = true in + let ctx = + create_push_abstractions_from_abs_region_groups + (fun rg_id -> FunCall (call_id, rg_id)) + inst_sg.regions_hierarchy region_can_end compute_abs_avalues ctx + in + (* Synthesize the symbolic AST *) + let cc = + cc_comp cc + (S.synthesize_regular_function_call fid call_id ctx sg regions_hierarchy + abs_ids generics trait_method_generics args args_places ret_spc + dest_place) in - let cc = comp cc cf_call in (* Move the return value to its destination *) - let cc = comp cc (assign_to_place config meta ret_value dest) in + let ctx, cc = comp cc (assign_to_place config span ret_value dest ctx) in (* End the abstractions which don't contain loans and don't have parent * abstractions. @@ -1499,8 +1499,7 @@ and eval_function_call_symbolic_from_inst_sig (config : config) * retry (because then we might end their children abstractions) *) let abs_ids = ref abs_ids in - let rec end_abs_with_no_loans cf : m_fun = - fun ctx -> + let rec end_abs_with_no_loans ctx = (* Find the abstractions which don't contain loans *) let no_loans_abs, with_loans_abs = List.partition @@ -1512,7 +1511,7 @@ and eval_function_call_symbolic_from_inst_sig (config : config) (* Check if it contains non-ignored loans *) && Option.is_none (InterpreterBorrowsCore - .get_first_non_ignored_aloan_in_abstraction meta abs)) + .get_first_non_ignored_aloan_in_abstraction span abs)) !abs_ids in (* Check if there are abstractions to end *) @@ -1521,35 +1520,36 @@ and eval_function_call_symbolic_from_inst_sig (config : config) abs_ids := with_loans_abs; (* End the abstractions which can be ended *) let no_loans_abs = AbstractionId.Set.of_list no_loans_abs in - let cc = InterpreterBorrows.end_abstractions config meta no_loans_abs in + let ctx, cc = + InterpreterBorrows.end_abstractions config span no_loans_abs ctx + in (* Recursive call *) - let cc = comp cc end_abs_with_no_loans in - (* Continue *) - cc cf ctx) + comp cc (end_abs_with_no_loans ctx)) else (* No abstractions to end: continue *) - cf ctx + (ctx, fun e -> e) in (* Try to end the abstractions with no loans if: * - the option is enabled * - the function returns unit * (see the documentation of {!config} for more information) *) - let cc = - if Config.return_unit_end_abs_with_no_loans && ty_is_unit inst_sg.output - then comp cc end_abs_with_no_loans - else cc + let ctx, cc = + comp cc + (if Config.return_unit_end_abs_with_no_loans && ty_is_unit inst_sg.output + then end_abs_with_no_loans ctx + else (ctx, fun e -> e)) in (* Continue - note that we do as if the function call has been successful, * by giving {!Unit} to the continuation, because we place us in the case * where we haven't panicked. Of course, the translation needs to take the * panic case into account... *) - cc (cf Unit) ctx + ([ (ctx, Unit) ], cc_singleton __FILE__ __LINE__ span cc) (** Evaluate a non-local function call in symbolic mode *) -and eval_assumed_function_call_symbolic (config : config) (meta : Meta.meta) - (fid : assumed_fun_id) (call : call) (func : fn_ptr) : st_cm_fun = - fun cf ctx -> +and eval_assumed_function_call_symbolic (config : config) (span : Meta.span) + (fid : assumed_fun_id) (call : call) (func : fn_ptr) : stl_cm_fun = + fun ctx -> let generics = func.generics in let args = call.args in let dest = call.dest in @@ -1559,7 +1559,7 @@ and eval_assumed_function_call_symbolic (config : config) (meta : Meta.meta) (List.for_all (fun ty -> not (ty_has_borrows ctx.type_ctx.type_infos ty)) generics.types) - meta; + span; (* There are two cases (and this is extremely annoying): - the function is not box_free @@ -1570,7 +1570,8 @@ and eval_assumed_function_call_symbolic (config : config) (meta : Meta.meta) | BoxFree -> (* Degenerate case: box_free - note that this is not really a function * call: no need to call a "synthesize_..." function *) - eval_box_free config meta generics args dest (cf Unit) ctx + let ctx, cc = eval_box_free config span generics args dest ctx in + ([ (ctx, Unit) ], cc_singleton __FILE__ __LINE__ span cc) | _ -> (* "Normal" case: not box_free *) (* In symbolic mode, the behaviour of a function call is completely defined @@ -1580,7 +1581,7 @@ and eval_assumed_function_call_symbolic (config : config) (meta : Meta.meta) match fid with | BoxFree -> (* Should have been treated above *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | _ -> let regions_hierarchy = LlbcAstUtils.FunIdMap.find (FAssumed fid) @@ -1590,33 +1591,42 @@ and eval_assumed_function_call_symbolic (config : config) (meta : Meta.meta) let tr_self = UnknownTrait __FUNCTION__ in let sg = Assumed.get_assumed_fun_sig fid in let inst_sg = - instantiate_fun_sig meta ctx generics tr_self sg regions_hierarchy + instantiate_fun_sig span ctx generics tr_self sg regions_hierarchy in (sg, regions_hierarchy, inst_sg) in (* Evaluate the function call *) - eval_function_call_symbolic_from_inst_sig config meta + eval_function_call_symbolic_from_inst_sig config span (FunId (FAssumed fid)) sg regions_hierarchy inst_sig generics None args - dest cf ctx + dest ctx (** Evaluate a statement seen as a function body *) -and eval_function_body (config : config) (body : statement) : st_cm_fun = - fun cf ctx -> +and eval_function_body (config : config) (body : statement) : stl_cm_fun = + fun ctx -> log#ldebug (lazy "eval_function_body:"); - let cc = eval_statement config body in - let cf_finish cf res = - log#ldebug (lazy "eval_function_body: cf_finish"); - (* Note that we *don't* check the result ({!Panic}, {!Return}, etc.): we - * delegate the check to the caller. *) - (* Expand the symbolic values if necessary - we need to do that before - * checking the invariants *) - let cc = greedy_expand_symbolic_values config body.meta in - (* Sanity check *) - let cc = comp_check_ctx cc (Invariants.check_invariants body.meta) in - (* Check if right meta *) - (* Continue *) - cc (cf res) + let ctx_resl, cf_body = eval_statement config body ctx in + let ctx_res_cfl = + List.map + (fun (ctx, res) -> + log#ldebug (lazy "eval_function_body: cf_finish"); + (* Note that we *don't* check the result ({!Panic}, {!Return}, etc.): we + * delegate the check to the caller. *) + (* Expand the symbolic values if necessary - we need to do that before + * checking the invariants *) + let ctx, cf = greedy_expand_symbolic_values config body.span ctx in + (* Sanity check *) + Invariants.check_invariants body.span ctx; + (* Continue *) + ((ctx, res), cf)) + ctx_resl + in + let ctx_resl, cfl = List.split ctx_res_cfl in + let cf_end el = + match el with + | None -> None + | Some el -> + Some (List.map Option.get (List.map2 (fun cf e -> cf (Some e)) cfl el)) in (* Compose and continue *) - comp cc cf_finish cf ctx + (ctx_resl, cc_comp cf_body cf_end) diff --git a/compiler/InterpreterStatements.mli b/compiler/InterpreterStatements.mli index 7a2783bb..c70396d6 100644 --- a/compiler/InterpreterStatements.mli +++ b/compiler/InterpreterStatements.mli @@ -17,7 +17,11 @@ open Cps continuation with [None]. *) val pop_frame : - config -> Meta.meta -> bool -> (typed_value option -> m_fun) -> m_fun + config -> + Meta.span -> + bool -> + eval_ctx -> + typed_value option * eval_ctx * (eval_result -> eval_result) (** Helper. @@ -46,7 +50,7 @@ val create_push_abstractions_from_abs_region_groups : eval_ctx (** Evaluate a statement *) -val eval_statement : config -> statement -> st_cm_fun +val eval_statement : config -> statement -> stl_cm_fun (** Evaluate a statement seen as a function body *) -val eval_function_body : config -> statement -> st_cm_fun +val eval_function_body : config -> statement -> stl_cm_fun diff --git a/compiler/InterpreterUtils.ml b/compiler/InterpreterUtils.ml index 4ee11cbd..653a0e24 100644 --- a/compiler/InterpreterUtils.ml +++ b/compiler/InterpreterUtils.ml @@ -5,7 +5,6 @@ open Contexts open LlbcAst open Utils open TypesUtils -open Cps open Errors (* TODO: we should probably rename the file to ContextsUtils *) @@ -15,19 +14,6 @@ let log = Logging.interpreter_log (** Some utilities *) -(** Auxiliary function - call a function which requires a continuation, - and return the let context given to the continuation *) -let get_cf_ctx_no_synth (meta : Meta.meta) (f : cm_fun) (ctx : eval_ctx) : - eval_ctx = - let nctx = ref None in - let cf ctx = - sanity_check __FILE__ __LINE__ (!nctx = None) meta; - nctx := Some ctx; - None - in - let _ = f cf ctx in - Option.get !nctx - let eval_ctx_to_string_no_filter = Print.Contexts.eval_ctx_to_string_no_filter let eval_ctx_to_string = Print.Contexts.eval_ctx_to_string let name_to_string = Print.EvalCtx.name_to_string @@ -63,14 +49,14 @@ let statement_to_string ctx = Print.EvalCtx.statement_to_string ctx "" " " let statement_to_string_with_tab ctx = Print.EvalCtx.statement_to_string ctx " " " " -let env_elem_to_string meta ctx = - Print.EvalCtx.env_elem_to_string ~meta:(Some meta) ctx "" " " +let env_elem_to_string span ctx = + Print.EvalCtx.env_elem_to_string ~span:(Some span) ctx "" " " -let env_to_string meta ctx env = - eval_ctx_to_string ~meta:(Some meta) { ctx with env } +let env_to_string span ctx env = + eval_ctx_to_string ~span:(Some span) { ctx with env } -let abs_to_string meta ctx = - Print.EvalCtx.abs_to_string ~meta:(Some meta) ctx "" " " +let abs_to_string span ctx = + Print.EvalCtx.abs_to_string ~span:(Some span) ctx "" " " let same_symbolic_id (sv0 : symbolic_value) (sv1 : symbolic_value) : bool = sv0.sv_id = sv1.sv_id @@ -83,31 +69,31 @@ let mk_place_from_var_id (var_id : VarId.id) : place = { var_id; projection = [] } (** Create a fresh symbolic value *) -let mk_fresh_symbolic_value (meta : Meta.meta) (ty : ty) : symbolic_value = +let mk_fresh_symbolic_value (span : Meta.span) (ty : ty) : symbolic_value = (* Sanity check *) - sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty) span; let sv_id = fresh_symbolic_value_id () in let svalue = { sv_id; sv_ty = ty } in svalue -let mk_fresh_symbolic_value_from_no_regions_ty (meta : Meta.meta) (ty : ty) : +let mk_fresh_symbolic_value_from_no_regions_ty (span : Meta.span) (ty : ty) : symbolic_value = - sanity_check __FILE__ __LINE__ (ty_no_regions ty) meta; - mk_fresh_symbolic_value meta ty + sanity_check __FILE__ __LINE__ (ty_no_regions ty) span; + mk_fresh_symbolic_value span ty (** Create a fresh symbolic value *) -let mk_fresh_symbolic_typed_value (meta : Meta.meta) (rty : ty) : typed_value = - sanity_check __FILE__ __LINE__ (ty_is_rty rty) meta; +let mk_fresh_symbolic_typed_value (span : Meta.span) (rty : ty) : typed_value = + sanity_check __FILE__ __LINE__ (ty_is_rty rty) span; let ty = Substitute.erase_regions rty in (* Generate the fresh a symbolic value *) - let value = mk_fresh_symbolic_value meta rty in + let value = mk_fresh_symbolic_value span rty in let value = VSymbolic value in { value; ty } -let mk_fresh_symbolic_typed_value_from_no_regions_ty (meta : Meta.meta) +let mk_fresh_symbolic_typed_value_from_no_regions_ty (span : Meta.span) (ty : ty) : typed_value = - sanity_check __FILE__ __LINE__ (ty_no_regions ty) meta; - mk_fresh_symbolic_typed_value meta ty + sanity_check __FILE__ __LINE__ (ty_no_regions ty) span; + mk_fresh_symbolic_typed_value span ty (** Create a typed value from a symbolic value. *) let mk_typed_value_from_symbolic_value (svalue : symbolic_value) : typed_value = @@ -133,10 +119,10 @@ let mk_aproj_loans_value_from_symbolic_value (regions : RegionId.Set.t) else { value = AIgnored; ty = svalue.sv_ty } (** Create a borrows projector from a symbolic value *) -let mk_aproj_borrows_from_symbolic_value (meta : Meta.meta) +let mk_aproj_borrows_from_symbolic_value (span : Meta.span) (proj_regions : RegionId.Set.t) (svalue : symbolic_value) (proj_ty : ty) : aproj = - sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty proj_ty) span; if ty_has_regions_in_set proj_regions proj_ty then AProjBorrows (svalue, proj_ty) else AIgnoredProjBorrows @@ -150,7 +136,7 @@ let borrow_in_asb (bid : BorrowId.id) (asb : abstract_shared_borrows) : bool = List.exists (borrow_is_asb bid) asb (** TODO: move *) -let remove_borrow_from_asb (meta : Meta.meta) (bid : BorrowId.id) +let remove_borrow_from_asb (span : Meta.span) (bid : BorrowId.id) (asb : abstract_shared_borrows) : abstract_shared_borrows = let removed = ref 0 in let asb = @@ -162,7 +148,7 @@ let remove_borrow_from_asb (meta : Meta.meta) (bid : BorrowId.id) false)) asb in - sanity_check __FILE__ __LINE__ (!removed = 1) meta; + sanity_check __FILE__ __LINE__ (!removed = 1) span; asb (** We sometimes need to return a value whose type may vary depending on @@ -299,7 +285,7 @@ let value_has_ret_symbolic_value_with_borrow_under_mut (ctx : eval_ctx) with Found -> true (** Return the place used in an rvalue, if that makes sense. - This is used to compute meta-data, to find pretty names. + This is used to compute span-data, to find pretty names. *) let rvalue_get_place (rv : rvalue) : place option = match rv with @@ -437,7 +423,7 @@ let empty_ids_set = fst (compute_ctxs_ids []) (** **WARNING**: this function doesn't compute the normalized types (for the trait type aliases). This should be computed afterwards. *) -let initialize_eval_ctx (meta : Meta.meta) (ctx : decls_ctx) +let initialize_eval_ctx (span : Meta.span) (ctx : decls_ctx) (region_groups : RegionGroupId.id list) (type_vars : type_var list) (const_generic_vars : const_generic_var list) : eval_ctx = reset_global_counters (); @@ -446,7 +432,7 @@ let initialize_eval_ctx (meta : Meta.meta) (ctx : decls_ctx) (List.map (fun (cg : const_generic_var) -> let ty = TLiteral cg.ty in - let cv = mk_fresh_symbolic_typed_value meta ty in + let cv = mk_fresh_symbolic_typed_value span ty in (cg.index, cv)) const_generic_vars) in @@ -469,7 +455,7 @@ let initialize_eval_ctx (meta : Meta.meta) (ctx : decls_ctx) region ids. This is mostly used in preparation of function calls (when evaluating in symbolic mode). *) -let instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) +let instantiate_fun_sig (span : Meta.span) (ctx : eval_ctx) (generics : generic_args) (tr_self : trait_instance_id) (sg : fun_sig) (regions_hierarchy : region_var_groups) : inst_fun_sig = log#ldebug @@ -510,10 +496,10 @@ let instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) types containing regions. *) sanity_check __FILE__ __LINE__ (List.for_all TypesUtils.ty_no_regions generics.types) - meta; + span; sanity_check __FILE__ __LINE__ (TypesUtils.trait_instance_id_no_regions tr_self) - meta; + span; let tsubst = Substitute.make_type_subst_from_vars sg.generics.types generics.types in @@ -527,7 +513,7 @@ let instantiate_fun_sig (meta : Meta.meta) (ctx : eval_ctx) in (* Substitute the signature *) let inst_sig = - AssociatedTypes.ctx_subst_norm_signature meta ctx asubst rsubst tsubst + AssociatedTypes.ctx_subst_norm_signature span ctx asubst rsubst tsubst cgsubst tr_subst tr_self sg regions_hierarchy in (* Return *) diff --git a/compiler/Invariants.ml b/compiler/Invariants.ml index 689db0c4..51be02c8 100644 --- a/compiler/Invariants.ml +++ b/compiler/Invariants.ml @@ -4,7 +4,6 @@ open Types open Values open Contexts -open Cps open TypesUtils open InterpreterUtils open InterpreterBorrowsCore @@ -48,7 +47,7 @@ type borrow_kind = BMut | BShared | BReserved - loans and borrows are correctly related - a two-phase borrow can't point to a value inside an abstraction *) -let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : +let check_loans_borrows_relation_invariant (span : Meta.span) (ctx : eval_ctx) : unit = (* Link all the borrow ids to a representant - necessary because of shared * borrows/loans *) @@ -56,7 +55,7 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : (* Link all the id representants to a borrow information *) let borrows_infos : borrow_info BorrowId.Map.t ref = ref BorrowId.Map.empty in let context_to_string () : string = - eval_ctx_to_string ~meta:(Some meta) ctx + eval_ctx_to_string ~span:(Some span) ctx ^ "- representants:\n" ^ ids_reprs_to_string " " !ids_reprs ^ "\n- info:\n" @@ -79,12 +78,12 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : let infos = !borrows_infos in (* Use the first borrow id as representant *) let repr_bid = BorrowId.Set.min_elt bids in - sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem repr_bid infos)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem repr_bid infos)) span; (* Insert the mappings to the representant *) let reprs = BorrowId.Set.fold (fun bid reprs -> - sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid reprs)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid reprs)) span; BorrowId.Map.add bid repr_bid reprs) bids reprs in @@ -107,8 +106,8 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : let reprs = !ids_reprs in let infos = !borrows_infos in (* Sanity checks *) - sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid reprs)) meta; - sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid infos)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid reprs)) span; + sanity_check __FILE__ __LINE__ (not (BorrowId.Map.mem bid infos)) span; (* Add the mapping for the representant *) let reprs = BorrowId.Map.add bid bid reprs in (* Add the mapping for the loan info *) @@ -156,10 +155,10 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : | AIgnoredMutLoan (Some bid, _) -> register_ignored_loan RMut bid | AIgnoredMutLoan (None, _) | AIgnoredSharedLoan _ - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } | AEndedSharedLoan (_, _) | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } -> + { given_back = _; child = _; given_back_span = _ } -> (* Do nothing *) () in @@ -185,7 +184,7 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : "find_info: could not find the representant of borrow " ^ BorrowId.to_string bid ^ ":\nContext:\n" ^ context_to_string () in - craise __FILE__ __LINE__ meta err + craise __FILE__ __LINE__ span err in let update_info (bid : BorrowId.id) (info : borrow_info) : unit = @@ -197,7 +196,7 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : (fun x -> match x with | Some _ -> Some info - | None -> craise __FILE__ __LINE__ meta "Unreachable") + | None -> craise __FILE__ __LINE__ span "Unreachable") !borrows_infos in borrows_infos := infos @@ -211,14 +210,14 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : (* Check that the borrow kind is consistent *) (match (info.loan_kind, kind) with | RShared, (BShared | BReserved) | RMut, BMut -> () - | _ -> craise __FILE__ __LINE__ meta "Invariant not satisfied"); + | _ -> craise __FILE__ __LINE__ span "Invariant not satisfied"); (* A reserved borrow can't point to a value inside an abstraction *) sanity_check __FILE__ __LINE__ (kind <> BReserved || not info.loan_in_abs) - meta; + span; (* Insert the borrow id *) let borrow_ids = info.borrow_ids in - sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem bid borrow_ids)) meta; + sanity_check __FILE__ __LINE__ (not (BorrowId.Set.mem bid borrow_ids)) span; let info = { info with borrow_ids = BorrowId.Set.add bid borrow_ids } in (* Update the info in the map *) update_info bid info @@ -273,7 +272,7 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : List.iter (fun (rkind, bid) -> let info = find_info bid in - sanity_check __FILE__ __LINE__ (info.loan_kind = rkind) meta) + sanity_check __FILE__ __LINE__ (info.loan_kind = rkind) span) !ignored_loans; (* Then, check the borrow infos *) @@ -284,12 +283,12 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : sanity_check __FILE__ __LINE__ (BorrowId.Set.elements info.loan_ids = BorrowId.Set.elements info.borrow_ids) - meta; + span; match info.loan_kind with | RMut -> sanity_check __FILE__ __LINE__ (BorrowId.Set.cardinal info.loan_ids = 1) - meta + span | RShared -> ()) !borrows_infos @@ -297,7 +296,7 @@ let check_loans_borrows_relation_invariant (meta : Meta.meta) (ctx : eval_ctx) : - borrows/loans can't contain ⊥ or reserved mut borrows - shared loans can't contain mutable loans *) -let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = +let check_borrowed_values_invariant (span : Meta.span) (ctx : eval_ctx) : unit = let visitor = object inherit [_] iter_eval_ctx as super @@ -306,7 +305,7 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = (* No ⊥ inside borrowed values *) sanity_check __FILE__ __LINE__ (Config.allow_bottom_below_borrow || not info.outer_borrow) - meta + span method! visit_ABottom _info = (* ⊥ inside an abstraction is not the same as in a regular value *) @@ -319,7 +318,7 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = | VSharedLoan (_, _) -> set_outer_shared info | VMutLoan _ -> (* No mutable loan inside a shared loan *) - sanity_check __FILE__ __LINE__ (not info.outer_shared) meta; + sanity_check __FILE__ __LINE__ (not info.outer_shared) span; set_outer_mut info in (* Continue exploring *) @@ -331,7 +330,7 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = match bc with | VSharedBorrow _ -> set_outer_shared info | VReservedMutBorrow _ -> - sanity_check __FILE__ __LINE__ (not info.outer_borrow) meta; + sanity_check __FILE__ __LINE__ (not info.outer_borrow) span; set_outer_shared info | VMutBorrow (_, _) -> set_outer_mut info in @@ -344,12 +343,12 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = match lc with | AMutLoan (_, _) -> set_outer_mut info | ASharedLoan (_, _, _) -> set_outer_shared info - | AEndedMutLoan { given_back = _; child = _; given_back_meta = _ } -> + | AEndedMutLoan { given_back = _; child = _; given_back_span = _ } -> set_outer_mut info | AEndedSharedLoan (_, _) -> set_outer_shared info | AIgnoredMutLoan (_, _) -> set_outer_mut info | AEndedIgnoredMutLoan - { given_back = _; child = _; given_back_meta = _ } -> + { given_back = _; child = _; given_back_span = _ } -> set_outer_mut info | AIgnoredSharedLoan _ -> set_outer_shared info in @@ -376,15 +375,15 @@ let check_borrowed_values_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = let info = { outer_borrow = false; outer_shared = false } in visitor#visit_eval_ctx info ctx -let check_literal_type (meta : Meta.meta) (cv : literal) (ty : literal_type) : +let check_literal_type (span : Meta.span) (cv : literal) (ty : literal_type) : unit = match (cv, ty) with | VScalar sv, TInteger int_ty -> - sanity_check __FILE__ __LINE__ (sv.int_ty = int_ty) meta + sanity_check __FILE__ __LINE__ (sv.int_ty = int_ty) span | VBool _, TBool | VChar _, TChar -> () - | _ -> craise __FILE__ __LINE__ meta "Erroneous typing" + | _ -> craise __FILE__ __LINE__ span "Erroneous typing" -let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = +let check_typing_invariant (span : Meta.span) (ctx : eval_ctx) : unit = (* TODO: the type of aloans doens't make sense: they have a type * of the shape [& (mut) T] where they should have type [T]... * This messes a bit the type invariant checks when checking the @@ -404,20 +403,20 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = method! visit_EBinding info binder v = (* We also check that the regions are erased *) - sanity_check __FILE__ __LINE__ (ty_is_ety v.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_ety v.ty) span; super#visit_EBinding info binder v method! visit_symbolic_value inside_abs v = (* Check that the types have regions *) - sanity_check __FILE__ __LINE__ (ty_is_rty v.sv_ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty v.sv_ty) span; super#visit_symbolic_value inside_abs v method! visit_typed_value info tv = (* Check that the types have erased regions *) - sanity_check __FILE__ __LINE__ (ty_is_ety tv.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_ety tv.ty) span; (* Check the current pair (value, type) *) (match (tv.value, tv.ty) with - | VLiteral cv, TLiteral ty -> check_literal_type meta cv ty + | VLiteral cv, TLiteral ty -> check_literal_type span cv ty (* ADT case *) | VAdt av, TAdt (TAdtId def_id, generics) -> (* Retrieve the definition to check the variant id, the number of @@ -426,33 +425,33 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = (* Check the number of parameters *) sanity_check __FILE__ __LINE__ (List.length generics.regions = List.length def.generics.regions) - meta; + span; sanity_check __FILE__ __LINE__ (List.length generics.types = List.length def.generics.types) - meta; + span; (* Check that the variant id is consistent *) (match (av.variant_id, def.kind) with | Some variant_id, Enum variants -> sanity_check __FILE__ __LINE__ (VariantId.to_int variant_id < List.length variants) - meta + span | None, Struct _ -> () - | _ -> craise __FILE__ __LINE__ meta "Erroneous typing"); + | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); (* Check that the field types are correct *) let field_types = - AssociatedTypes.type_decl_get_inst_norm_field_etypes meta ctx def + AssociatedTypes.type_decl_get_inst_norm_field_etypes span ctx def av.variant_id generics in let fields_with_types = List.combine av.field_values field_types in List.iter (fun ((v, ty) : typed_value * ty) -> - sanity_check __FILE__ __LINE__ (v.ty = ty) meta) + sanity_check __FILE__ __LINE__ (v.ty = ty) span) fields_with_types (* Tuple case *) | VAdt av, TAdt (TTuple, generics) -> - sanity_check __FILE__ __LINE__ (generics.regions = []) meta; - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; - sanity_check __FILE__ __LINE__ (av.variant_id = None) meta; + sanity_check __FILE__ __LINE__ (generics.regions = []) span; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; + sanity_check __FILE__ __LINE__ (av.variant_id = None) span; (* Check that the fields have the proper values - and check that there * are as many fields as field types at the same time *) let fields_with_types = @@ -460,11 +459,11 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = in List.iter (fun ((v, ty) : typed_value * ty) -> - sanity_check __FILE__ __LINE__ (v.ty = ty) meta) + sanity_check __FILE__ __LINE__ (v.ty = ty) span) fields_with_types (* Assumed type case *) | VAdt av, TAdt (TAssumed aty_id, generics) -> ( - sanity_check __FILE__ __LINE__ (av.variant_id = None) meta; + sanity_check __FILE__ __LINE__ (av.variant_id = None) span; match ( aty_id, av.field_values, @@ -474,14 +473,14 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = with (* Box *) | TBox, [ inner_value ], [], [ inner_ty ], [] -> - sanity_check __FILE__ __LINE__ (inner_value.ty = inner_ty) meta + sanity_check __FILE__ __LINE__ (inner_value.ty = inner_ty) span | TArray, inner_values, _, [ inner_ty ], [ cg ] -> (* *) sanity_check __FILE__ __LINE__ (List.for_all (fun (v : typed_value) -> v.ty = inner_ty) inner_values) - meta; + span; (* The length is necessarily concrete *) let len = (ValuesUtils.literal_as_scalar @@ -490,46 +489,46 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = in sanity_check __FILE__ __LINE__ (Z.of_int (List.length inner_values) = len) - meta + span | (TSlice | TStr), _, _, _, _ -> - craise __FILE__ __LINE__ meta "Unexpected" - | _ -> craise __FILE__ __LINE__ meta "Erroneous type") + craise __FILE__ __LINE__ span "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Erroneous type") | VBottom, _ -> (* Nothing to check *) () | VBorrow bc, TRef (_, ref_ty, rkind) -> ( match (bc, rkind) with | VSharedBorrow bid, RShared | VReservedMutBorrow bid, RMut -> ( (* Lookup the borrowed value to check it has the proper type *) - let _, glc = lookup_loan meta ek_all bid ctx in + let _, glc = lookup_loan span ek_all bid ctx in match glc with | Concrete (VSharedLoan (_, sv)) | Abstract (ASharedLoan (_, sv, _)) -> - sanity_check __FILE__ __LINE__ (sv.ty = ref_ty) meta - | _ -> craise __FILE__ __LINE__ meta "Inconsistent context") + sanity_check __FILE__ __LINE__ (sv.ty = ref_ty) span + | _ -> craise __FILE__ __LINE__ span "Inconsistent context") | VMutBorrow (_, bv), RMut -> sanity_check __FILE__ __LINE__ ((* Check that the borrowed value has the proper type *) bv.ty = ref_ty) - meta - | _ -> craise __FILE__ __LINE__ meta "Erroneous typing") + span + | _ -> craise __FILE__ __LINE__ span "Erroneous typing") | VLoan lc, ty -> ( match lc with | VSharedLoan (_, sv) -> - sanity_check __FILE__ __LINE__ (sv.ty = ty) meta + sanity_check __FILE__ __LINE__ (sv.ty = ty) span | VMutLoan bid -> ( (* Lookup the borrowed value to check it has the proper type *) - let glc = lookup_borrow meta ek_all bid ctx in + let glc = lookup_borrow span ek_all bid ctx in match glc with | Concrete (VMutBorrow (_, bv)) -> - sanity_check __FILE__ __LINE__ (bv.ty = ty) meta + sanity_check __FILE__ __LINE__ (bv.ty = ty) span | Abstract (AMutBorrow (_, sv)) -> sanity_check __FILE__ __LINE__ (Substitute.erase_regions sv.ty = ty) - meta - | _ -> craise __FILE__ __LINE__ meta "Inconsistent context")) + span + | _ -> craise __FILE__ __LINE__ span "Inconsistent context")) | VSymbolic sv, ty -> let ty' = Substitute.erase_regions sv.sv_ty in - sanity_check __FILE__ __LINE__ (ty' = ty) meta - | _ -> craise __FILE__ __LINE__ meta "Erroneous typing"); + sanity_check __FILE__ __LINE__ (ty' = ty) span + | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); (* Continue exploring to inspect the subterms *) super#visit_typed_value info tv @@ -543,7 +542,7 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = * *) method! visit_typed_avalue info atv = (* Check that the types have regions *) - sanity_check __FILE__ __LINE__ (ty_is_rty atv.ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty atv.ty) span; (* Check the current pair (value, type) *) (match (atv.value, atv.ty) with (* ADT case *) @@ -554,37 +553,37 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = (* Check the number of parameters *) sanity_check __FILE__ __LINE__ (List.length generics.regions = List.length def.generics.regions) - meta; + span; sanity_check __FILE__ __LINE__ (List.length generics.types = List.length def.generics.types) - meta; + span; sanity_check __FILE__ __LINE__ (List.length generics.const_generics = List.length def.generics.const_generics) - meta; + span; (* Check that the variant id is consistent *) (match (av.variant_id, def.kind) with | Some variant_id, Enum variants -> sanity_check __FILE__ __LINE__ (VariantId.to_int variant_id < List.length variants) - meta + span | None, Struct _ -> () - | _ -> craise __FILE__ __LINE__ meta "Erroneous typing"); + | _ -> craise __FILE__ __LINE__ span "Erroneous typing"); (* Check that the field types are correct *) let field_types = - AssociatedTypes.type_decl_get_inst_norm_field_rtypes meta ctx def + AssociatedTypes.type_decl_get_inst_norm_field_rtypes span ctx def av.variant_id generics in let fields_with_types = List.combine av.field_values field_types in List.iter (fun ((v, ty) : typed_avalue * ty) -> - sanity_check __FILE__ __LINE__ (v.ty = ty) meta) + sanity_check __FILE__ __LINE__ (v.ty = ty) span) fields_with_types (* Tuple case *) | AAdt av, TAdt (TTuple, generics) -> - sanity_check __FILE__ __LINE__ (generics.regions = []) meta; - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; - sanity_check __FILE__ __LINE__ (av.variant_id = None) meta; + sanity_check __FILE__ __LINE__ (generics.regions = []) span; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; + sanity_check __FILE__ __LINE__ (av.variant_id = None) span; (* Check that the fields have the proper values - and check that there * are as many fields as field types at the same time *) let fields_with_types = @@ -592,11 +591,11 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = in List.iter (fun ((v, ty) : typed_avalue * ty) -> - sanity_check __FILE__ __LINE__ (v.ty = ty) meta) + sanity_check __FILE__ __LINE__ (v.ty = ty) span) fields_with_types (* Assumed type case *) | AAdt av, TAdt (TAssumed aty_id, generics) -> ( - sanity_check __FILE__ __LINE__ (av.variant_id = None) meta; + sanity_check __FILE__ __LINE__ (av.variant_id = None) span; match ( aty_id, av.field_values, @@ -606,101 +605,101 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = with (* Box *) | TBox, [ boxed_value ], [], [ boxed_ty ], [] -> - sanity_check __FILE__ __LINE__ (boxed_value.ty = boxed_ty) meta - | _ -> craise __FILE__ __LINE__ meta "Erroneous type") + sanity_check __FILE__ __LINE__ (boxed_value.ty = boxed_ty) span + | _ -> craise __FILE__ __LINE__ span "Erroneous type") | ABottom, _ -> (* Nothing to check *) () | ABorrow bc, TRef (_, ref_ty, rkind) -> ( match (bc, rkind) with | AMutBorrow (_, av), RMut -> (* Check that the child value has the proper type *) - sanity_check __FILE__ __LINE__ (av.ty = ref_ty) meta + sanity_check __FILE__ __LINE__ (av.ty = ref_ty) span | ASharedBorrow bid, RShared -> ( (* Lookup the borrowed value to check it has the proper type *) - let _, glc = lookup_loan meta ek_all bid ctx in + let _, glc = lookup_loan span ek_all bid ctx in match glc with | Concrete (VSharedLoan (_, sv)) | Abstract (ASharedLoan (_, sv, _)) -> sanity_check __FILE__ __LINE__ (sv.ty = Substitute.erase_regions ref_ty) - meta - | _ -> craise __FILE__ __LINE__ meta "Inconsistent context") + span + | _ -> craise __FILE__ __LINE__ span "Inconsistent context") | AIgnoredMutBorrow (_opt_bid, av), RMut -> - sanity_check __FILE__ __LINE__ (av.ty = ref_ty) meta - | ( AEndedIgnoredMutBorrow { given_back; child; given_back_meta = _ }, + sanity_check __FILE__ __LINE__ (av.ty = ref_ty) span + | ( AEndedIgnoredMutBorrow { given_back; child; given_back_span = _ }, RMut ) -> - sanity_check __FILE__ __LINE__ (given_back.ty = ref_ty) meta; - sanity_check __FILE__ __LINE__ (child.ty = ref_ty) meta + sanity_check __FILE__ __LINE__ (given_back.ty = ref_ty) span; + sanity_check __FILE__ __LINE__ (child.ty = ref_ty) span | AProjSharedBorrow _, RShared -> () - | _ -> craise __FILE__ __LINE__ meta "Inconsistent context") + | _ -> craise __FILE__ __LINE__ span "Inconsistent context") | ALoan lc, aty -> ( match lc with | AMutLoan (bid, child_av) | AIgnoredMutLoan (Some bid, child_av) -> ( let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) meta; + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span; (* Lookup the borrowed value to check it has the proper type *) - let glc = lookup_borrow meta ek_all bid ctx in + let glc = lookup_borrow span ek_all bid ctx in match glc with | Concrete (VMutBorrow (_, bv)) -> sanity_check __FILE__ __LINE__ (bv.ty = Substitute.erase_regions borrowed_aty) - meta + span | Abstract (AMutBorrow (_, sv)) -> sanity_check __FILE__ __LINE__ (Substitute.erase_regions sv.ty = Substitute.erase_regions borrowed_aty) - meta - | _ -> craise __FILE__ __LINE__ meta "Inconsistent context") + span + | _ -> craise __FILE__ __LINE__ span "Inconsistent context") | AIgnoredMutLoan (None, child_av) -> let borrowed_aty = aloan_get_expected_child_type aty in - sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) meta + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span | ASharedLoan (_, sv, child_av) | AEndedSharedLoan (sv, child_av) -> let borrowed_aty = aloan_get_expected_child_type aty in sanity_check __FILE__ __LINE__ (sv.ty = Substitute.erase_regions borrowed_aty) - meta; + span; (* TODO: the type of aloans doesn't make sense, see above *) - sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) meta - | AEndedMutLoan { given_back; child; given_back_meta = _ } - | AEndedIgnoredMutLoan { given_back; child; given_back_meta = _ } -> + sanity_check __FILE__ __LINE__ (child_av.ty = borrowed_aty) span + | AEndedMutLoan { given_back; child; given_back_span = _ } + | AEndedIgnoredMutLoan { given_back; child; given_back_span = _ } -> let borrowed_aty = aloan_get_expected_child_type aty in sanity_check __FILE__ __LINE__ (given_back.ty = borrowed_aty) - meta; - sanity_check __FILE__ __LINE__ (child.ty = borrowed_aty) meta + span; + sanity_check __FILE__ __LINE__ (child.ty = borrowed_aty) span | AIgnoredSharedLoan child_av -> sanity_check __FILE__ __LINE__ (child_av.ty = aloan_get_expected_child_type aty) - meta) + span) | ASymbolic aproj, ty -> ( let ty1 = Substitute.erase_regions ty in match aproj with | AProjLoans (sv, _) -> let ty2 = Substitute.erase_regions sv.sv_ty in - sanity_check __FILE__ __LINE__ (ty1 = ty2) meta; + sanity_check __FILE__ __LINE__ (ty1 = ty2) span; (* Also check that the symbolic values contain regions of interest - * otherwise they should have been reduced to [_] *) let abs = Option.get info in sanity_check __FILE__ __LINE__ (ty_has_regions_in_set abs.regions sv.sv_ty) - meta + span | AProjBorrows (sv, proj_ty) -> let ty2 = Substitute.erase_regions sv.sv_ty in - sanity_check __FILE__ __LINE__ (ty1 = ty2) meta; + sanity_check __FILE__ __LINE__ (ty1 = ty2) span; (* Also check that the symbolic values contain regions of interest - * otherwise they should have been reduced to [_] *) let abs = Option.get info in sanity_check __FILE__ __LINE__ (ty_has_regions_in_set abs.regions proj_ty) - meta + span | AEndedProjLoans (_msv, given_back_ls) -> List.iter (fun (_, proj) -> match proj with | AProjBorrows (_sv, ty') -> - sanity_check __FILE__ __LINE__ (ty' = ty) meta + sanity_check __FILE__ __LINE__ (ty' = ty) span | AEndedProjBorrows _ | AIgnoredProjBorrows -> () - | _ -> craise __FILE__ __LINE__ meta "Unexpected") + | _ -> craise __FILE__ __LINE__ span "Unexpected") given_back_ls | AEndedProjBorrows _ | AIgnoredProjBorrows -> ()) | AIgnored, _ -> () @@ -709,9 +708,9 @@ let check_typing_invariant (meta : Meta.meta) (ctx : eval_ctx) : unit = (lazy ("Erroneous typing:" ^ "\n- raw value: " ^ show_typed_avalue atv ^ "\n- value: " - ^ typed_avalue_to_string ~meta:(Some meta) ctx atv + ^ typed_avalue_to_string ~span:(Some span) ctx atv ^ "\n- type: " ^ ty_to_string ctx atv.ty)); - internal_error __FILE__ __LINE__ meta); + internal_error __FILE__ __LINE__ span); (* Continue exploring to inspect the subterms *) super#visit_typed_avalue info atv end @@ -750,7 +749,7 @@ type sv_info = { - the union of the aproj_loans contains the aproj_borrows applied on the same symbolic values *) -let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = +let check_symbolic_values (span : Meta.span) (ctx : eval_ctx) : unit = (* Small utility *) let module M = SymbolicValueId.Map in let infos : sv_info M.t ref = ref M.empty in @@ -820,19 +819,19 @@ let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = * projectors of borrows in abstractions *) sanity_check __FILE__ __LINE__ (info.env_count = 0 || info.aproj_borrows = []) - meta; + span; (* A symbolic value containing borrows can't be duplicated (i.e., copied): * it must be expanded first *) if ty_has_borrows ctx.type_ctx.type_infos info.ty then - sanity_check __FILE__ __LINE__ (info.env_count <= 1) meta; + sanity_check __FILE__ __LINE__ (info.env_count <= 1) span; (* A duplicated symbolic value is necessarily copyable *) sanity_check __FILE__ __LINE__ (info.env_count <= 1 || ty_is_copyable info.ty) - meta; + span; sanity_check __FILE__ __LINE__ (info.aproj_borrows = [] || info.aproj_loans <> []) - meta; + span; (* At the same time: * - check that the loans don't intersect * - compute the set of regions for which we project loans @@ -846,7 +845,7 @@ let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = (fun rid regions -> sanity_check __FILE__ __LINE__ (not (RegionId.Set.mem rid regions)) - meta; + span; RegionId.Set.add rid regions) regions linfo.regions in @@ -857,28 +856,22 @@ let check_symbolic_values (meta : Meta.meta) (ctx : eval_ctx) : unit = List.iter (fun binfo -> sanity_check __FILE__ __LINE__ - (projection_contains meta info.ty loan_regions binfo.proj_ty + (projection_contains span info.ty loan_regions binfo.proj_ty binfo.regions) - meta) + span) info.aproj_borrows; () in M.iter check_info !infos -let check_invariants (meta : Meta.meta) (ctx : eval_ctx) : unit = +let check_invariants (span : Meta.span) (ctx : eval_ctx) : unit = if !Config.sanity_checks then ( log#ldebug (lazy - ("Checking invariants:\n" ^ eval_ctx_to_string ~meta:(Some meta) ctx)); - check_loans_borrows_relation_invariant meta ctx; - check_borrowed_values_invariant meta ctx; - check_typing_invariant meta ctx; - check_symbolic_values meta ctx) + ("Checking invariants:\n" ^ eval_ctx_to_string ~span:(Some span) ctx)); + check_loans_borrows_relation_invariant span ctx; + check_borrowed_values_invariant span ctx; + check_typing_invariant span ctx; + check_symbolic_values span ctx) else log#ldebug (lazy "Not checking invariants (check is not activated)") - -(** Same as {!check_invariants}, but written in CPS *) -let cf_check_invariants (meta : Meta.meta) : cm_fun = - fun cf ctx -> - check_invariants meta ctx; - cf ctx diff --git a/compiler/Main.ml b/compiler/Main.ml index 6161f2f2..29322049 100644 --- a/compiler/Main.ml +++ b/compiler/Main.ml @@ -282,7 +282,7 @@ let () = if !Errors.error_list <> [] then ( List.iter - (fun (meta, msg) -> log#serror (Errors.format_error_message meta msg)) + (fun (span, msg) -> log#serror (Errors.format_error_message span msg)) (* Reverse the list of error messages so that we print them from the earliest to the latest. *) (List.rev !Errors.error_list); diff --git a/compiler/PrePasses.ml b/compiler/PrePasses.ml index c84cd39c..26141c72 100644 --- a/compiler/PrePasses.ml +++ b/compiler/PrePasses.ml @@ -36,7 +36,7 @@ let filter_drop_assigns (f : fun_decl) : fun_decl = | Drop p1, Assign (p2, _) -> if p1 = p2 then (self#visit_statement env st2).content else super#visit_Sequence env st1 st2 - | Drop p1, Sequence ({ content = Assign (p2, _); meta = _ }, _) -> + | Drop p1, Sequence ({ content = Assign (p2, _); span = _ }, _) -> if p1 = p2 then (self#visit_statement env st2).content else super#visit_Sequence env st1 st2 | _ -> super#visit_Sequence env st1 st2 @@ -217,11 +217,11 @@ let remove_loop_breaks (crate : crate) (f : fun_decl) : fun_decl = method! visit_statement entered_loop st = match st.content with | Loop loop -> - cassert __FILE__ __LINE__ (not entered_loop) st.meta + cassert __FILE__ __LINE__ (not entered_loop) st.span "Nested loops are not supported yet"; { st with content = super#visit_Loop true loop } | Break i -> - cassert __FILE__ __LINE__ (i = 0) st.meta + cassert __FILE__ __LINE__ (i = 0) st.span "Breaks to outer loops are not supported yet"; { st with content = nst.content } | _ -> super#visit_statement entered_loop st @@ -240,7 +240,7 @@ let remove_loop_breaks (crate : crate) (f : fun_decl) : fun_decl = | Loop _ -> cassert __FILE__ __LINE__ (statement_has_no_loop_break_continue st2) - st2.meta "Sequences of loops are not supported yet"; + st2.span "Sequences of loops are not supported yet"; (replace_breaks_with st1 st2).content | _ -> super#visit_Sequence env st1 st2 end @@ -404,17 +404,17 @@ let remove_shallow_borrows (crate : crate) (f : fun_decl) : fun_decl = inherit [_] iter_statement as super (* Remember the span of the statement we enter *) - method! visit_statement _ st = super#visit_statement st.meta st + method! visit_statement _ st = super#visit_statement st.span st - method! visit_var_id meta id = + method! visit_var_id span id = cassert __FILE__ __LINE__ (not (VarId.Set.mem id !filtered)) - meta + span "Filtered variables should have completely disappeared from the \ body" end in - check_visitor#visit_statement body.meta body; + check_visitor#visit_statement body.span body; (* Return the updated body *) body @@ -446,7 +446,7 @@ let apply_passes (crate : crate) : crate = report to the user the fact that we will ignore the function body *) let fmt = Print.Crate.crate_to_fmt_env crate in let name = Print.name_to_string fmt f.name in - save_error __FILE__ __LINE__ (Some f.item_meta.meta) + save_error __FILE__ __LINE__ (Some f.item_meta.span) ("Ignoring the body of '" ^ name ^ "' because of previous error"); { f with body = None } in diff --git a/compiler/Print.ml b/compiler/Print.ml index 51286553..f7f1f54b 100644 --- a/compiler/Print.ml +++ b/compiler/Print.ml @@ -44,13 +44,13 @@ module Values = struct * typed_avalue_to_string. At some point we had done it, because [typed_value] * and [typed_avalue] were instances of the same general type [g_typed_value], * but then we removed this general type because it proved to be a bad idea. *) - let rec typed_value_to_string ?(meta : Meta.meta option = None) + let rec typed_value_to_string ?(span : Meta.span option = None) (env : fmt_env) (v : typed_value) : string = match v.value with | VLiteral cv -> literal_to_string cv | VAdt av -> ( let field_values = - List.map (typed_value_to_string ~meta env) av.field_values + List.map (typed_value_to_string ~span env) av.field_values in match v.ty with | TAdt (TTuple, _) -> @@ -86,31 +86,31 @@ module Values = struct (* Happens when we aggregate values *) "@Array[" ^ String.concat ", " field_values ^ "]" | _ -> - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span ("Inconsistent value: " ^ show_typed_value v)) - | _ -> craise_opt_meta __FILE__ __LINE__ meta "Inconsistent typed value" + | _ -> craise_opt_span __FILE__ __LINE__ span "Inconsistent typed value" ) | VBottom -> "⊥ : " ^ ty_to_string env v.ty - | VBorrow bc -> borrow_content_to_string ~meta env bc - | VLoan lc -> loan_content_to_string ~meta env lc + | VBorrow bc -> borrow_content_to_string ~span env bc + | VLoan lc -> loan_content_to_string ~span env lc | VSymbolic s -> symbolic_value_to_string env s - and borrow_content_to_string ?(meta : Meta.meta option = None) (env : fmt_env) + and borrow_content_to_string ?(span : Meta.span option = None) (env : fmt_env) (bc : borrow_content) : string = match bc with | VSharedBorrow bid -> "shared_borrow@" ^ BorrowId.to_string bid | VMutBorrow (bid, tv) -> "mut_borrow@" ^ BorrowId.to_string bid ^ " (" - ^ typed_value_to_string ~meta env tv + ^ typed_value_to_string ~span env tv ^ ")" | VReservedMutBorrow bid -> "reserved_borrow@" ^ BorrowId.to_string bid - and loan_content_to_string ?(meta : Meta.meta option = None) (env : fmt_env) + and loan_content_to_string ?(span : Meta.span option = None) (env : fmt_env) (lc : loan_content) : string = match lc with | VSharedLoan (loans, v) -> let loans = BorrowId.Set.to_string None loans in - "@shared_loan(" ^ loans ^ ", " ^ typed_value_to_string ~meta env v ^ ")" + "@shared_loan(" ^ loans ^ ", " ^ typed_value_to_string ~span env v ^ ")" | VMutLoan bid -> "ml@" ^ BorrowId.to_string bid let abstract_shared_borrow_to_string (env : fmt_env) @@ -148,12 +148,12 @@ module Values = struct | AEndedProjBorrows _mv -> "_" | AIgnoredProjBorrows -> "_" - let rec typed_avalue_to_string ?(meta : Meta.meta option = None) + let rec typed_avalue_to_string ?(span : Meta.span option = None) (env : fmt_env) (v : typed_avalue) : string = match v.value with | AAdt av -> ( let field_values = - List.map (typed_avalue_to_string ~meta env) av.field_values + List.map (typed_avalue_to_string ~span env) av.field_values in match v.ty with | TAdt (TTuple, _) -> @@ -185,77 +185,77 @@ module Values = struct (* Assumed type *) match (aty, field_values) with | TBox, [ bv ] -> "@Box(" ^ bv ^ ")" - | _ -> craise_opt_meta __FILE__ __LINE__ meta "Inconsistent value") - | _ -> craise_opt_meta __FILE__ __LINE__ meta "Inconsistent typed value" + | _ -> craise_opt_span __FILE__ __LINE__ span "Inconsistent value") + | _ -> craise_opt_span __FILE__ __LINE__ span "Inconsistent typed value" ) | ABottom -> "⊥ : " ^ ty_to_string env v.ty - | ABorrow bc -> aborrow_content_to_string ~meta env bc - | ALoan lc -> aloan_content_to_string ~meta env lc + | ABorrow bc -> aborrow_content_to_string ~span env bc + | ALoan lc -> aloan_content_to_string ~span env lc | ASymbolic s -> aproj_to_string env s | AIgnored -> "_" - and aloan_content_to_string ?(meta : Meta.meta option = None) (env : fmt_env) + and aloan_content_to_string ?(span : Meta.span option = None) (env : fmt_env) (lc : aloan_content) : string = match lc with | AMutLoan (bid, av) -> "@mut_loan(" ^ BorrowId.to_string bid ^ ", " - ^ typed_avalue_to_string ~meta env av + ^ typed_avalue_to_string ~span env av ^ ")" | ASharedLoan (loans, v, av) -> let loans = BorrowId.Set.to_string None loans in "@shared_loan(" ^ loans ^ ", " - ^ typed_value_to_string ~meta env v + ^ typed_value_to_string ~span env v ^ ", " - ^ typed_avalue_to_string ~meta env av + ^ typed_avalue_to_string ~span env av ^ ")" | AEndedMutLoan ml -> "@ended_mut_loan{" - ^ typed_avalue_to_string ~meta env ml.child + ^ typed_avalue_to_string ~span env ml.child ^ "; " - ^ typed_avalue_to_string ~meta env ml.given_back + ^ typed_avalue_to_string ~span env ml.given_back ^ " }" | AEndedSharedLoan (v, av) -> "@ended_shared_loan(" - ^ typed_value_to_string ~meta env v + ^ typed_value_to_string ~span env v ^ ", " - ^ typed_avalue_to_string ~meta env av + ^ typed_avalue_to_string ~span env av ^ ")" | AIgnoredMutLoan (opt_bid, av) -> "@ignored_mut_loan(" ^ option_to_string BorrowId.to_string opt_bid ^ ", " - ^ typed_avalue_to_string ~meta env av + ^ typed_avalue_to_string ~span env av ^ ")" | AEndedIgnoredMutLoan ml -> "@ended_ignored_mut_loan{ " - ^ typed_avalue_to_string ~meta env ml.child + ^ typed_avalue_to_string ~span env ml.child ^ "; " - ^ typed_avalue_to_string ~meta env ml.given_back + ^ typed_avalue_to_string ~span env ml.given_back ^ "}" | AIgnoredSharedLoan sl -> - "@ignored_shared_loan(" ^ typed_avalue_to_string ~meta env sl ^ ")" + "@ignored_shared_loan(" ^ typed_avalue_to_string ~span env sl ^ ")" - and aborrow_content_to_string ?(meta : Meta.meta option = None) + and aborrow_content_to_string ?(span : Meta.span option = None) (env : fmt_env) (bc : aborrow_content) : string = match bc with | AMutBorrow (bid, av) -> "mb@" ^ BorrowId.to_string bid ^ " (" - ^ typed_avalue_to_string ~meta env av + ^ typed_avalue_to_string ~span env av ^ ")" | ASharedBorrow bid -> "sb@" ^ BorrowId.to_string bid | AIgnoredMutBorrow (opt_bid, av) -> "@ignored_mut_borrow(" ^ option_to_string BorrowId.to_string opt_bid ^ ", " - ^ typed_avalue_to_string ~meta env av + ^ typed_avalue_to_string ~span env av ^ ")" | AEndedMutBorrow (_mv, child) -> - "@ended_mut_borrow(" ^ typed_avalue_to_string ~meta env child ^ ")" - | AEndedIgnoredMutBorrow { child; given_back; given_back_meta = _ } -> + "@ended_mut_borrow(" ^ typed_avalue_to_string ~span env child ^ ")" + | AEndedIgnoredMutBorrow { child; given_back; given_back_span = _ } -> "@ended_ignored_mut_borrow{ " - ^ typed_avalue_to_string ~meta env child + ^ typed_avalue_to_string ~span env child ^ "; " - ^ typed_avalue_to_string ~meta env given_back + ^ typed_avalue_to_string ~span env given_back ^ ")" | AEndedSharedBorrow -> "@ended_shared_borrow" | AProjSharedBorrow sb -> @@ -285,13 +285,13 @@ module Values = struct ^ ")" | Identity -> "Identity" - let abs_to_string ?(meta : Meta.meta option = None) (env : fmt_env) + let abs_to_string ?(span : Meta.span option = None) (env : fmt_env) (verbose : bool) (indent : string) (indent_incr : string) (abs : abs) : string = let indent2 = indent ^ indent_incr in let avs = List.map - (fun av -> indent2 ^ typed_avalue_to_string ~meta env av) + (fun av -> indent2 ^ typed_avalue_to_string ~span env av) abs.avalues in let avs = String.concat ",\n" avs in @@ -335,7 +335,7 @@ module Contexts = struct | BVar b -> var_binder_to_string env b | BDummy bid -> dummy_var_id_to_string bid - let env_elem_to_string ?(meta : Meta.meta option = None) (env : fmt_env) + let env_elem_to_string ?(span : Meta.span option = None) (env : fmt_env) (verbose : bool) (with_var_types : bool) (indent : string) (indent_incr : string) (ev : env_elem) : string = match ev with @@ -344,18 +344,18 @@ module Contexts = struct let ty = if with_var_types then " : " ^ ty_to_string env tv.ty else "" in - indent ^ bv ^ ty ^ " -> " ^ typed_value_to_string ~meta env tv ^ " ;" - | EAbs abs -> abs_to_string ~meta env verbose indent indent_incr abs + indent ^ bv ^ ty ^ " -> " ^ typed_value_to_string ~span env tv ^ " ;" + | EAbs abs -> abs_to_string ~span env verbose indent indent_incr abs | EFrame -> - craise_opt_meta __FILE__ __LINE__ meta "Can't print a Frame element" + craise_opt_span __FILE__ __LINE__ span "Can't print a Frame element" - let opt_env_elem_to_string ?(meta : Meta.meta option = None) (env : fmt_env) + let opt_env_elem_to_string ?(span : Meta.span option = None) (env : fmt_env) (verbose : bool) (with_var_types : bool) (indent : string) (indent_incr : string) (ev : env_elem option) : string = match ev with | None -> indent ^ "..." | Some ev -> - env_elem_to_string ~meta env verbose with_var_types indent indent_incr + env_elem_to_string ~span env verbose with_var_types indent indent_incr ev (** Filters "dummy" bindings from an environment, to gain space and clarity/ @@ -393,7 +393,7 @@ module Contexts = struct "..." to gain space and clarity. [with_var_types]: if true, print the type of the variables *) - let env_to_string ?(meta : Meta.meta option = None) (filter : bool) + let env_to_string ?(span : Meta.span option = None) (filter : bool) (fmt_env : fmt_env) (verbose : bool) (with_var_types : bool) (env : env) : string = let env = @@ -403,7 +403,7 @@ module Contexts = struct ^ String.concat "\n" (List.map (fun ev -> - opt_env_elem_to_string ~meta fmt_env verbose with_var_types " " + opt_env_elem_to_string ~span fmt_env verbose with_var_types " " " " ev) env) ^ "\n}" @@ -484,7 +484,7 @@ module Contexts = struct let frames = split_aux [] [] env in frames - let eval_ctx_to_string_gen ?(meta : Meta.meta option = None) (verbose : bool) + let eval_ctx_to_string_gen ?(span : Meta.span option = None) (verbose : bool) (filter : bool) (with_var_types : bool) (ctx : eval_ctx) : string = let fmt_env = eval_ctx_to_fmt_env ctx in let ended_regions = RegionId.Set.to_string None ctx.ended_regions in @@ -502,26 +502,26 @@ module Contexts = struct | EBinding (BDummy _, _) -> num_dummies := !num_abs + 1 | EBinding (BVar _, _) -> num_bindings := !num_bindings + 1 | EAbs _ -> num_abs := !num_abs + 1 - | _ -> craise_opt_meta __FILE__ __LINE__ meta "Unreachable") + | _ -> craise_opt_span __FILE__ __LINE__ span "Unreachable") f; "\n# Frame " ^ string_of_int i ^ ":" ^ "\n- locals: " ^ string_of_int !num_bindings ^ "\n- dummy bindings: " ^ string_of_int !num_dummies ^ "\n- abstractions: " ^ string_of_int !num_abs ^ "\n" - ^ env_to_string ~meta filter fmt_env verbose with_var_types f + ^ env_to_string ~span filter fmt_env verbose with_var_types f ^ "\n") frames in "# Ended regions: " ^ ended_regions ^ "\n" ^ "# " ^ string_of_int num_frames ^ " frame(s)\n" ^ String.concat "" frames - let eval_ctx_to_string ?(meta : Meta.meta option = None) (ctx : eval_ctx) : + let eval_ctx_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) : string = - eval_ctx_to_string_gen ~meta false true true ctx + eval_ctx_to_string_gen ~span false true true ctx - let eval_ctx_to_string_no_filter ?(meta : Meta.meta option = None) + let eval_ctx_to_string_no_filter ?(span : Meta.span option = None) (ctx : eval_ctx) : string = - eval_ctx_to_string_gen ~meta false false true ctx + eval_ctx_to_string_gen ~span false false true ctx end (** Pretty-printing for LLBC ASTs (functions based on an evaluation context) *) @@ -559,25 +559,25 @@ module EvalCtx = struct let env = eval_ctx_to_fmt_env ctx in trait_instance_id_to_string env x - let borrow_content_to_string ?(meta : Meta.meta option = None) + let borrow_content_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) (bc : borrow_content) : string = let env = eval_ctx_to_fmt_env ctx in - borrow_content_to_string ~meta env bc + borrow_content_to_string ~span env bc - let loan_content_to_string ?(meta : Meta.meta option = None) (ctx : eval_ctx) + let loan_content_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) (lc : loan_content) : string = let env = eval_ctx_to_fmt_env ctx in - loan_content_to_string ~meta env lc + loan_content_to_string ~span env lc - let aborrow_content_to_string ?(meta : Meta.meta option = None) + let aborrow_content_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) (bc : aborrow_content) : string = let env = eval_ctx_to_fmt_env ctx in - aborrow_content_to_string ~meta env bc + aborrow_content_to_string ~span env bc - let aloan_content_to_string ?(meta : Meta.meta option = None) (ctx : eval_ctx) + let aloan_content_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) (lc : aloan_content) : string = let env = eval_ctx_to_fmt_env ctx in - aloan_content_to_string ~meta env lc + aloan_content_to_string ~span env lc let aproj_to_string (ctx : eval_ctx) (p : aproj) : string = let env = eval_ctx_to_fmt_env ctx in @@ -587,15 +587,15 @@ module EvalCtx = struct let env = eval_ctx_to_fmt_env ctx in symbolic_value_to_string env sv - let typed_value_to_string ?(meta : Meta.meta option = None) (ctx : eval_ctx) + let typed_value_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) (v : typed_value) : string = let env = eval_ctx_to_fmt_env ctx in - typed_value_to_string ~meta env v + typed_value_to_string ~span env v - let typed_avalue_to_string ?(meta : Meta.meta option = None) (ctx : eval_ctx) + let typed_avalue_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) (v : typed_avalue) : string = let env = eval_ctx_to_fmt_env ctx in - typed_avalue_to_string ~meta env v + typed_avalue_to_string ~span env v let place_to_string (ctx : eval_ctx) (op : place) : string = let env = eval_ctx_to_fmt_env ctx in @@ -636,13 +636,13 @@ module EvalCtx = struct let env = eval_ctx_to_fmt_env ctx in trait_impl_to_string env " " " " timpl - let env_elem_to_string ?(meta : Meta.meta option = None) (ctx : eval_ctx) + let env_elem_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) (indent : string) (indent_incr : string) (ev : env_elem) : string = let env = eval_ctx_to_fmt_env ctx in - env_elem_to_string ~meta env false true indent indent_incr ev + env_elem_to_string ~span env false true indent indent_incr ev - let abs_to_string ?(meta : Meta.meta option = None) (ctx : eval_ctx) + let abs_to_string ?(span : Meta.span option = None) (ctx : eval_ctx) (indent : string) (indent_incr : string) (abs : abs) : string = let env = eval_ctx_to_fmt_env ctx in - abs_to_string ~meta env false indent indent_incr abs + abs_to_string ~span env false indent indent_incr abs end diff --git a/compiler/PrintPure.ml b/compiler/PrintPure.ml index db9c583d..b1b42207 100644 --- a/compiler/PrintPure.ml +++ b/compiler/PrintPure.ml @@ -288,14 +288,14 @@ let rec mprojection_to_string (env : fmt_env) (inside : string) let mplace_to_string (env : fmt_env) (p : mplace) : string = let name = match p.name with None -> "" | Some name -> name in - (* We add the "llbc" suffix to the variable index, because meta-places + (* We add the "llbc" suffix to the variable index, because span-places * use indices of the variables in the original LLBC program, while * regular places use indices for the pure variables: we want to make * this explicit, otherwise it is confusing. *) let name = name ^ "^" ^ E.VarId.to_string p.var_id ^ "llbc" in mprojection_to_string env name p.projection -let adt_variant_to_string ?(meta = None) (env : fmt_env) (adt_id : type_id) +let adt_variant_to_string ?(span = None) (env : fmt_env) (adt_id : type_id) (variant_id : VariantId.id option) : string = match adt_id with | TTuple -> "Tuple" @@ -309,34 +309,34 @@ let adt_variant_to_string ?(meta = None) (env : fmt_env) (adt_id : type_id) match aty with | TState | TArray | TSlice | TStr | TRawPtr _ -> (* Those types are opaque: we can't get there *) - craise_opt_meta __FILE__ __LINE__ meta "Unreachable" + craise_opt_span __FILE__ __LINE__ span "Unreachable" | TResult -> let variant_id = Option.get variant_id in if variant_id = result_ok_id then "@Result::Return" else if variant_id = result_fail_id then "@Result::Fail" else - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "Unreachable: improper variant id for result type" | TError -> let variant_id = Option.get variant_id in if variant_id = error_failure_id then "@Error::Failure" else if variant_id = error_out_of_fuel_id then "@Error::OutOfFuel" else - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "Unreachable: improper variant id for error type" | TFuel -> let variant_id = Option.get variant_id in if variant_id = fuel_zero_id then "@Fuel::Zero" else if variant_id = fuel_succ_id then "@Fuel::Succ" else - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "Unreachable: improper variant id for fuel type") -let adt_field_to_string ?(meta = None) (env : fmt_env) (adt_id : type_id) +let adt_field_to_string ?(span = None) (env : fmt_env) (adt_id : type_id) (field_id : FieldId.id) : string = match adt_id with | TTuple -> - craise_opt_meta __FILE__ __LINE__ meta "Unreachable" + craise_opt_span __FILE__ __LINE__ span "Unreachable" (* Tuples don't use the opaque field id for the field indices, but [int] *) | TAdtId def_id -> ( (* "Regular" ADT *) @@ -349,15 +349,15 @@ let adt_field_to_string ?(meta = None) (env : fmt_env) (adt_id : type_id) match aty with | TState | TFuel | TArray | TSlice | TStr -> (* Opaque types: we can't get there *) - craise_opt_meta __FILE__ __LINE__ meta "Unreachable" + craise_opt_span __FILE__ __LINE__ span "Unreachable" | TResult | TError | TRawPtr _ -> (* Enumerations: we can't get there *) - craise_opt_meta __FILE__ __LINE__ meta "Unreachable") + craise_opt_span __FILE__ __LINE__ span "Unreachable") (** TODO: we don't need a general function anymore (it is now only used for patterns) *) -let adt_g_value_to_string ?(meta : Meta.meta option = None) (env : fmt_env) +let adt_g_value_to_string ?(span : Meta.span option = None) (env : fmt_env) (value_to_string : 'v -> string) (variant_id : VariantId.id option) (field_values : 'v list) (ty : ty) : string = let field_values = List.map value_to_string field_values in @@ -392,50 +392,50 @@ let adt_g_value_to_string ?(meta : Meta.meta option = None) (env : fmt_env) match aty with | TState | TRawPtr _ -> (* This type is opaque: we can't get there *) - craise_opt_meta __FILE__ __LINE__ meta "Unreachable" + craise_opt_span __FILE__ __LINE__ span "Unreachable" | TResult -> let variant_id = Option.get variant_id in if variant_id = result_ok_id then match field_values with | [ v ] -> "@Result::Return " ^ v | _ -> - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "Result::Return takes exactly one value" else if variant_id = result_fail_id then match field_values with | [ v ] -> "@Result::Fail " ^ v | _ -> - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "Result::Fail takes exactly one value" else - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "Unreachable: improper variant id for result type" | TError -> - cassert_opt_meta __FILE__ __LINE__ (field_values = []) meta + cassert_opt_span __FILE__ __LINE__ (field_values = []) span "Ill-formed error value"; let variant_id = Option.get variant_id in if variant_id = error_failure_id then "@Error::Failure" else if variant_id = error_out_of_fuel_id then "@Error::OutOfFuel" else - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "Unreachable: improper variant id for error type" | TFuel -> let variant_id = Option.get variant_id in if variant_id = fuel_zero_id then ( - cassert_opt_meta __FILE__ __LINE__ (field_values = []) meta + cassert_opt_span __FILE__ __LINE__ (field_values = []) span "Ill-formed full value"; "@Fuel::Zero") else if variant_id = fuel_succ_id then match field_values with | [ v ] -> "@Fuel::Succ " ^ v | _ -> - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "@Fuel::Succ takes exactly one value" else - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span "Unreachable: improper variant id for fuel type" | TArray | TSlice | TStr -> - cassert_opt_meta __FILE__ __LINE__ (variant_id = None) meta + cassert_opt_span __FILE__ __LINE__ (variant_id = None) span "Ill-formed value"; let field_values = List.mapi (fun i v -> string_of_int i ^ " -> " ^ v) field_values @@ -443,12 +443,12 @@ let adt_g_value_to_string ?(meta : Meta.meta option = None) (env : fmt_env) let id = assumed_ty_to_string aty in id ^ " [" ^ String.concat "; " field_values ^ "]") | _ -> - craise_opt_meta __FILE__ __LINE__ meta + craise_opt_span __FILE__ __LINE__ span ("Inconsistently typed value: expected ADT type but found:" ^ "\n- ty: " ^ ty_to_string env false ty ^ "\n- variant_id: " ^ Print.option_to_string VariantId.to_string variant_id) -let rec typed_pattern_to_string ?(meta : Meta.meta option = None) +let rec typed_pattern_to_string ?(span : Meta.span option = None) (env : fmt_env) (v : typed_pattern) : string = match v.value with | PatConstant cv -> literal_to_string cv @@ -460,8 +460,8 @@ let rec typed_pattern_to_string ?(meta : Meta.meta option = None) ^ ")" | PatDummy -> "_" | PatAdt av -> - adt_g_value_to_string ~meta env - (typed_pattern_to_string ~meta env) + adt_g_value_to_string ~span env + (typed_pattern_to_string ~span env) av.variant_id av.field_values v.ty let fun_sig_to_string (env : fmt_env) (sg : fun_sig) : string = @@ -542,7 +542,7 @@ let fun_or_op_id_to_string (env : fmt_env) (fun_id : fun_or_op_id) : string = binop_to_string binop ^ "<" ^ integer_type_to_string int_ty ^ ">" (** [inside]: controls the introduction of parentheses *) -let rec texpression_to_string ?(metadata : Meta.meta option = None) +let rec texpression_to_string ?(spandata : Meta.span option = None) (env : fmt_env) (inside : bool) (indent : string) (indent_incr : string) (e : texpression) : string = match e.e with @@ -553,26 +553,26 @@ let rec texpression_to_string ?(metadata : Meta.meta option = None) (* Recursively destruct the app, to have a pair (app, arguments list) *) let app, args = destruct_apps e in (* Convert to string *) - app_to_string ~meta:metadata env inside indent indent_incr app args + app_to_string ~span:spandata env inside indent indent_incr app args | Lambda _ -> let xl, e = destruct_lambdas e in - let e = lambda_to_string ~meta:metadata env indent indent_incr xl e in + let e = lambda_to_string ~span:spandata env indent indent_incr xl e in if inside then "(" ^ e ^ ")" else e | Qualif _ -> (* Qualifier without arguments *) - app_to_string ~meta:metadata env inside indent indent_incr e [] + app_to_string ~span:spandata env inside indent indent_incr e [] | Let (monadic, lv, re, e) -> let e = - let_to_string ~meta:metadata env indent indent_incr monadic lv re e + let_to_string ~span:spandata env indent indent_incr monadic lv re e in if inside then "(" ^ e ^ ")" else e | Switch (scrutinee, body) -> let e = - switch_to_string ~meta:metadata env indent indent_incr scrutinee body + switch_to_string ~span:spandata env indent indent_incr scrutinee body in if inside then "(" ^ e ^ ")" else e | Loop loop -> - let e = loop_to_string ~meta:metadata env indent indent_incr loop in + let e = loop_to_string ~span:spandata env indent indent_incr loop in if inside then "(" ^ e ^ ")" else e | StructUpdate supd -> ( let s = @@ -591,7 +591,7 @@ let rec texpression_to_string ?(metadata : Meta.meta option = None) (fun (fid, fe) -> let field = FieldId.nth field_names fid in let fe = - texpression_to_string ~metadata env false indent2 indent_incr + texpression_to_string ~spandata env false indent2 indent_incr fe in "\n" ^ indent1 ^ field ^ " := " ^ fe ^ ";") @@ -603,22 +603,22 @@ let rec texpression_to_string ?(metadata : Meta.meta option = None) let fields = List.map (fun (_, fe) -> - texpression_to_string ~metadata env false indent2 indent_incr fe) + texpression_to_string ~spandata env false indent2 indent_incr fe) supd.updates in "[ " ^ String.concat ", " fields ^ " ]" - | _ -> craise_opt_meta __FILE__ __LINE__ metadata "Unexpected") - | Meta (meta, e) -> ( - let meta_s = emeta_to_string ~metadata env meta in - let e = texpression_to_string ~metadata env inside indent indent_incr e in - match meta with + | _ -> craise_opt_span __FILE__ __LINE__ spandata "Unexpected") + | Meta (span, e) -> ( + let span_s = espan_to_string ~spandata env span in + let e = texpression_to_string ~spandata env inside indent indent_incr e in + match span with | Assignment _ | SymbolicAssignments _ | SymbolicPlaces _ | Tag _ -> - let e = meta_s ^ "\n" ^ indent ^ e in + let e = span_s ^ "\n" ^ indent ^ e in if inside then "(" ^ e ^ ")" else e - | MPlace _ -> "(" ^ meta_s ^ " " ^ e ^ ")") + | MPlace _ -> "(" ^ span_s ^ " " ^ e ^ ")") | EError (_, _) -> "@Error" -and app_to_string ?(meta : Meta.meta option = None) (env : fmt_env) +and app_to_string ?(span : Meta.span option = None) (env : fmt_env) (inside : bool) (indent : string) (indent_incr : string) (app : texpression) (args : texpression list) : string = (* There are two possibilities: either the [app] is an instantiated, @@ -638,13 +638,13 @@ and app_to_string ?(meta : Meta.meta option = None) (env : fmt_env) (global_decl_id_to_string env global_id, generics) | AdtCons adt_cons_id -> let variant_s = - adt_variant_to_string ~meta env adt_cons_id.adt_id + adt_variant_to_string ~span env adt_cons_id.adt_id adt_cons_id.variant_id in (ConstStrings.constructor_prefix ^ variant_s, []) | Proj { adt_id; field_id } -> - let adt_s = adt_variant_to_string ~meta env adt_id None in - let field_s = adt_field_to_string ~meta env adt_id field_id in + let adt_s = adt_variant_to_string ~span env adt_id None in + let field_s = adt_field_to_string ~span env adt_id field_id in (* Adopting an F*-like syntax *) (ConstStrings.constructor_prefix ^ adt_s ^ "?." ^ field_s, []) | TraitConst (trait_ref, const_name) -> @@ -654,7 +654,7 @@ and app_to_string ?(meta : Meta.meta option = None) (env : fmt_env) | _ -> (* "Regular" expression case *) let inside = args <> [] || (args = [] && inside) in - ( texpression_to_string ~metadata:meta env inside indent indent_incr app, + ( texpression_to_string ~spandata:span env inside indent indent_incr app, [] ) in (* Convert the arguments. @@ -663,7 +663,7 @@ and app_to_string ?(meta : Meta.meta option = None) (env : fmt_env) let arg_to_string = let inside = true in let indent1 = indent ^ indent_incr in - texpression_to_string ~metadata:meta env inside indent1 indent_incr + texpression_to_string ~spandata:span env inside indent1 indent_incr in let args = List.map arg_to_string args in let all_args = List.append generics args in @@ -674,29 +674,29 @@ and app_to_string ?(meta : Meta.meta option = None) (env : fmt_env) (* Add parentheses *) if all_args <> [] && inside then "(" ^ e ^ ")" else e -and lambda_to_string ?(meta : Meta.meta option = None) (env : fmt_env) +and lambda_to_string ?(span : Meta.span option = None) (env : fmt_env) (indent : string) (indent_incr : string) (xl : typed_pattern list) (e : texpression) : string = - let xl = List.map (typed_pattern_to_string ~meta env) xl in - let e = texpression_to_string ~metadata:meta env false indent indent_incr e in + let xl = List.map (typed_pattern_to_string ~span env) xl in + let e = texpression_to_string ~spandata:span env false indent indent_incr e in "λ " ^ String.concat " " xl ^ ". " ^ e -and let_to_string ?(meta : Meta.meta option = None) (env : fmt_env) +and let_to_string ?(span : Meta.span option = None) (env : fmt_env) (indent : string) (indent_incr : string) (monadic : bool) (lv : typed_pattern) (re : texpression) (e : texpression) : string = let indent1 = indent ^ indent_incr in let inside = false in let re = - texpression_to_string ~metadata:meta env inside indent1 indent_incr re + texpression_to_string ~spandata:span env inside indent1 indent_incr re in let e = - texpression_to_string ~metadata:meta env inside indent indent_incr e + texpression_to_string ~spandata:span env inside indent indent_incr e in - let lv = typed_pattern_to_string ~meta env lv in + let lv = typed_pattern_to_string ~span env lv in if monadic then lv ^ " <-- " ^ re ^ ";\n" ^ indent ^ e else "let " ^ lv ^ " = " ^ re ^ " in\n" ^ indent ^ e -and switch_to_string ?(meta : Meta.meta option = None) (env : fmt_env) +and switch_to_string ?(span : Meta.span option = None) (env : fmt_env) (indent : string) (indent_incr : string) (scrutinee : texpression) (body : switch_body) : string = let indent1 = indent ^ indent_incr in @@ -704,10 +704,10 @@ and switch_to_string ?(meta : Meta.meta option = None) (env : fmt_env) * in most situations it will be a value or a function call, so it should be * ok*) let scrut = - texpression_to_string ~metadata:meta env true indent1 indent_incr scrutinee + texpression_to_string ~spandata:span env true indent1 indent_incr scrutinee in let e_to_string = - texpression_to_string ~metadata:meta env false indent1 indent_incr + texpression_to_string ~spandata:span env false indent1 indent_incr in match body with | If (e_true, e_false) -> @@ -717,13 +717,13 @@ and switch_to_string ?(meta : Meta.meta option = None) (env : fmt_env) ^ indent ^ "else\n" ^ indent1 ^ e_false | Match branches -> let branch_to_string (b : match_branch) : string = - let pat = typed_pattern_to_string ~meta env b.pat in + let pat = typed_pattern_to_string ~span env b.pat in indent ^ "| " ^ pat ^ " ->\n" ^ indent1 ^ e_to_string b.branch in let branches = List.map branch_to_string branches in "match " ^ scrut ^ " with\n" ^ String.concat "\n" branches -and loop_to_string ?(meta : Meta.meta option = None) (env : fmt_env) +and loop_to_string ?(span : Meta.span option = None) (env : fmt_env) (indent : string) (indent_incr : string) (loop : loop) : string = let indent1 = indent ^ indent_incr in let indent2 = indent1 ^ indent_incr in @@ -734,11 +734,11 @@ and loop_to_string ?(meta : Meta.meta option = None) (env : fmt_env) in let output_ty = "output_ty: " ^ ty_to_string env false loop.output_ty in let fun_end = - texpression_to_string ~metadata:meta env false indent2 indent_incr + texpression_to_string ~spandata:span env false indent2 indent_incr loop.fun_end in let loop_body = - texpression_to_string ~metadata:meta env false indent2 indent_incr + texpression_to_string ~spandata:span env false indent2 indent_incr loop.loop_body in "loop {\n" ^ indent1 ^ loop_inputs ^ "\n" ^ indent1 ^ output_ty ^ "\n" @@ -746,10 +746,10 @@ and loop_to_string ?(meta : Meta.meta option = None) (env : fmt_env) ^ indent1 ^ "loop_body: {\n" ^ indent2 ^ loop_body ^ "\n" ^ indent1 ^ "}\n" ^ indent ^ "}" -and emeta_to_string ?(metadata : Meta.meta option = None) (env : fmt_env) - (meta : emeta) : string = - let meta = - match meta with +and espan_to_string ?(spandata : Meta.span option = None) (env : fmt_env) + (span : espan) : string = + let span = + match span with | Assignment (lp, rv, rp) -> let rp = match rp with @@ -757,14 +757,14 @@ and emeta_to_string ?(metadata : Meta.meta option = None) (env : fmt_env) | Some rp -> " [@src=" ^ mplace_to_string env rp ^ "]" in "@assign(" ^ mplace_to_string env lp ^ " := " - ^ texpression_to_string ~metadata env false "" "" rv + ^ texpression_to_string ~spandata env false "" "" rv ^ rp ^ ")" | SymbolicAssignments info -> let infos = List.map (fun (var_id, rv) -> VarId.to_string var_id ^ " == " - ^ texpression_to_string ~metadata env false "" "" rv) + ^ texpression_to_string ~spandata env false "" "" rv) info in let infos = String.concat ", " infos in @@ -781,7 +781,7 @@ and emeta_to_string ?(metadata : Meta.meta option = None) (env : fmt_env) | MPlace mp -> "@mplace=" ^ mplace_to_string env mp | Tag msg -> "@tag \"" ^ msg ^ "\"" in - "@meta[" ^ meta ^ "]" + "@span[" ^ span ^ "]" let fun_decl_to_string (env : fmt_env) (def : fun_decl) : string = let env = { env with generics = def.signature.generics } in @@ -798,7 +798,7 @@ let fun_decl_to_string (env : fmt_env) (def : fun_decl) : string = else " fun " ^ String.concat " " inputs ^ " ->\n" ^ indent in let body = - texpression_to_string ~metadata:(Some def.meta) env inside indent indent + texpression_to_string ~spandata:(Some def.span) env inside indent indent body.body in "let " ^ name ^ " :\n " ^ signature ^ " =\n" ^ inputs ^ body diff --git a/compiler/Pure.ml b/compiler/Pure.ml index 451767f8..d07b8cfa 100644 --- a/compiler/Pure.ml +++ b/compiler/Pure.ml @@ -50,8 +50,8 @@ type region_group_id = T.region_group_id [@@deriving show, ord] type mutability = Mut | Const [@@deriving show, ord] type loc = Meta.loc [@@deriving show, ord] type file_name = Meta.file_name [@@deriving show, ord] +type raw_span = Meta.raw_span [@@deriving show, ord] type span = Meta.span [@@deriving show, ord] -type meta = Meta.meta [@@deriving show, ord] (** The assumed types for the pure AST. @@ -393,7 +393,7 @@ type type_decl = { the name used at extraction time will be derived from the llbc_name. *) - meta : meta; + span : span; generics : generic_params; llbc_generics : Types.generic_params; (** We use the LLBC generics to generate "pretty" names, for instance @@ -426,7 +426,7 @@ type var = { (* TODO: we might want to redefine field_proj_kind here, to prevent field accesses * on enumerations. * Also: tuples... - * Rmk: projections are actually only used as meta-data. + * Rmk: projections are actually only used as span-data. * *) type mprojection_elem = { pkind : E.field_proj_kind; field_id : FieldId.id } [@@deriving show] @@ -622,7 +622,7 @@ class ['self] iter_expression_base = method visit_qualif : 'env -> qualif -> unit = fun _ _ -> () method visit_loop_id : 'env -> loop_id -> unit = fun _ _ -> () method visit_field_id : 'env -> field_id -> unit = fun _ _ -> () - method visit_meta : 'env -> Meta.meta -> unit = fun _ _ -> () + method visit_span : 'env -> Meta.span -> unit = fun _ _ -> () end (** Ancestor for {!map_expression} visitor *) @@ -634,7 +634,7 @@ class ['self] map_expression_base = method visit_qualif : 'env -> qualif -> qualif = fun _ x -> x method visit_loop_id : 'env -> loop_id -> loop_id = fun _ x -> x method visit_field_id : 'env -> field_id -> field_id = fun _ x -> x - method visit_meta : 'env -> Meta.meta -> Meta.meta = fun _ x -> x + method visit_span : 'env -> Meta.span -> Meta.span = fun _ x -> x end (** Ancestor for {!reduce_expression} visitor *) @@ -646,7 +646,7 @@ class virtual ['self] reduce_expression_base = method visit_qualif : 'env -> qualif -> 'a = fun _ _ -> self#zero method visit_loop_id : 'env -> loop_id -> 'a = fun _ _ -> self#zero method visit_field_id : 'env -> field_id -> 'a = fun _ _ -> self#zero - method visit_meta : 'env -> Meta.meta -> 'a = fun _ _ -> self#zero + method visit_span : 'env -> Meta.span -> 'a = fun _ _ -> self#zero end (** Ancestor for {!mapreduce_expression} visitor *) @@ -667,7 +667,7 @@ class virtual ['self] mapreduce_expression_base = method visit_field_id : 'env -> field_id -> field_id * 'a = fun _ x -> (x, self#zero) - method visit_meta : 'env -> Meta.meta -> Meta.meta * 'a = + method visit_span : 'env -> Meta.span -> Meta.span * 'a = fun _ x -> (x, self#zero) end @@ -732,8 +732,8 @@ type expression = | Switch of texpression * switch_body | Loop of loop (** See the comments for {!loop} *) | StructUpdate of struct_update (** See the comments for {!struct_update} *) - | Meta of (emeta[@opaque]) * texpression (** Meta-information *) - | EError of Meta.meta option * string + | Meta of (espan[@opaque]) * texpression (** Meta-information *) + | EError of Meta.span option * string and switch_body = If of texpression * texpression | Match of match_branch list and match_branch = { pat : typed_pattern; branch : texpression } @@ -752,7 +752,7 @@ and match_branch = { pat : typed_pattern; branch : texpression } and loop = { fun_end : texpression; loop_id : loop_id; - meta : meta; [@opaque] + span : span; [@opaque] fuel0 : var_id; fuel : var_id; input_state : var_id option; @@ -806,7 +806,7 @@ and texpression = { e : expression; ty : ty } and mvalue = (texpression[@opaque]) (** Meta-information stored in the AST *) -and emeta = +and espan = | Assignment of mplace * mvalue * mplace option (** Information about an assignment which occured in LLBC. We use this to guide the heuristics which derive pretty names. @@ -1012,7 +1012,7 @@ type decomposed_fun_sig = { ]} The function's type should be given by [mk_arrows sig.inputs sig.output]. - We provide additional meta-information with {!fun_sig.info}: + We provide additional span-information with {!fun_sig.info}: - we divide between forward inputs and backward inputs (i.e., inputs specific to the forward functions, and additional inputs necessary if the signature is for a backward function) @@ -1080,7 +1080,7 @@ type item_kind = A.item_kind [@@deriving show] type fun_decl = { def_id : FunDeclId.id; is_local : bool; - meta : meta; + span : span; kind : item_kind; num_loops : int; (** The number of loops in the parent forward function (basically the number @@ -1102,7 +1102,7 @@ type fun_decl = { [@@deriving show] type global_decl = { - meta : meta; + span : span; def_id : GlobalDeclId.id; is_local : bool; llbc_name : llbc_name; (** The original LLBC name. *) @@ -1126,7 +1126,7 @@ type trait_decl = { is_local : bool; llbc_name : llbc_name; name : string; - meta : meta; + span : span; generics : generic_params; llbc_generics : Types.generic_params; (** We use the LLBC generics to generate "pretty" names, for instance @@ -1149,7 +1149,7 @@ type trait_impl = { is_local : bool; llbc_name : llbc_name; name : string; - meta : meta; + span : span; impl_trait : trait_decl_ref; llbc_impl_trait : Types.trait_decl_ref; (** Same remark as for {!field:llbc_generics}. *) diff --git a/compiler/PureMicroPasses.ml b/compiler/PureMicroPasses.ml index 004ecfef..a4319b28 100644 --- a/compiler/PureMicroPasses.ml +++ b/compiler/PureMicroPasses.ml @@ -67,17 +67,17 @@ type pn_ctx = { } (** This function computes pretty names for the variables in the pure AST. It - relies on the "meta"-place information in the AST to generate naming + relies on the "span"-place information in the AST to generate naming constraints, and then uses those to compute the names. The way it works is as follows: - we only modify the names of the unnamed variables - whenever we see an rvalue/pattern which is exactly an unnamed variable, - and this value is linked to some meta-place information which contains + and this value is linked to some span-place information which contains a name and an empty path, we consider we should use this name - we try to propagate naming constraints on the pure variables use in the synthesized programs, and also on the LLBC variables from the original - program (information about the LLBC variables is stored in the meta-places) + program (information about the LLBC variables is stored in the span-places) Something important is that, for every variable we find, the name of this @@ -118,7 +118,7 @@ type pn_ctx = { hd -> s2 ]} - When generating the symbolic AST, we save as meta-information that we + When generating the symbolic AST, we save as span-information that we assign [s1] to the place [x] and [s2] to the place [hd]. This way, we learn we can use the names [x] and [hd] for the variables which are introduced by the match: @@ -162,10 +162,10 @@ type pn_ctx = { so we should use "x" as the basename (hence the resulting name "x1"). However, this is non-trivial, because after desugaring the input argument given to [id] is not [&mut x] but [move ^0] (i.e., it comes from a temporary, anonymous - variable). For this reason, we use the meta-place [&mut x] as the meta-place + variable). For this reason, we use the span-place [&mut x] as the span-place for the given back value (this is done during the synthesis), and propagate naming information *also* on the LLBC variables (which are referenced by the - meta-places). + span-places). This way, because of [^0 = &mut x], we can propagate the name "x" to the place [^0], then to the given back variable across the function call. @@ -213,7 +213,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = * - we explore the expressions * - we register the variables introduced by the let-bindings * - we use the naming information we find (through the variables and the - * meta-places) to update our context (i.e., maps from variable ids to + * span-places) to update our context (i.e., maps from variable ids to * names) * - we use this information to update the names of the variables used in the * expressions @@ -224,7 +224,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = let register_var (ctx : pn_ctx) (v : var) : pn_ctx = sanity_check __FILE__ __LINE__ (not (VarId.Map.mem v.id ctx.pure_vars)) - def.meta; + def.span; match v.basename with | None -> ctx | Some name -> @@ -286,8 +286,8 @@ let compute_pretty_names (def : fun_decl) : fun_decl = in { ctx with llbc_vars } in - (* Add a constraint: given a variable id and an associated meta-place, try to - * extract naming information from the meta-place and save it *) + (* Add a constraint: given a variable id and an associated span-place, try to + * extract naming information from the span-place and save it *) let add_constraint (mp : mplace) (var_id : VarId.id) (ctx : pn_ctx) : pn_ctx = (* Register the place *) let ctx = register_mplace mp ctx in @@ -306,12 +306,12 @@ let compute_pretty_names (def : fun_decl) : fun_decl = (* Register the place *) let ctx = register_mplace mp ctx in (* Add the constraint *) - match (unmeta rv).e with Var vid -> add_constraint mp vid ctx | _ -> ctx + match (unspan rv).e with Var vid -> add_constraint mp vid ctx | _ -> ctx in let add_pure_var_value_constraint (var_id : VarId.id) (rv : texpression) (ctx : pn_ctx) : pn_ctx = (* Add the constraint *) - match (unmeta rv).e with + match (unspan rv).e with | Var vid -> ( (* Try to find a name for the vid *) match VarId.Map.find_opt vid ctx.pure_vars with @@ -361,8 +361,8 @@ let compute_pretty_names (def : fun_decl) : fun_decl = VarId.Map.mem lvar.id ctx.pure_vars then ctx else - (* We ignore the left meta-place information: it should have been taken - * care of by [add_left_constraint]. We try to use the right meta-place + (* We ignore the left span-place information: it should have been taken + * care of by [add_left_constraint]. We try to use the right span-place * information *) let add (name : string) (ctx : pn_ctx) : pn_ctx = (* Add the constraint for the pure variable *) @@ -373,7 +373,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = | Some lmp -> add_llbc_var_constraint lmp.var_id name ctx in (* We try to use the right-place information *) - let rmp, re = opt_unmeta_mplace re in + let rmp, re = opt_unspan_mplace re in let ctx = match rmp with | Some { var_id; name; projection = [] } -> ( @@ -386,7 +386,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = in (* We try to use the rvalue information, if it is a variable *) let ctx = - match (unmeta re).e with + match (unspan re).e with | Var rvar_id -> ( match VarId.Map.find_opt rvar_id ctx.pure_vars with | None -> ctx @@ -415,8 +415,8 @@ let compute_pretty_names (def : fun_decl) : fun_decl = | Loop loop -> update_loop loop ctx | StructUpdate supd -> update_struct_update supd ctx | Lambda (lb, e) -> update_lambda lb e ctx - | Meta (meta, e) -> update_emeta meta e ctx - | EError (meta, msg) -> (ctx, EError (meta, msg)) + | Meta (span, e) -> update_espan span e ctx + | EError (span, msg) -> (ctx, EError (span, msg)) in (ctx, { e; ty }) (* *) @@ -475,7 +475,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = let { fun_end; loop_id; - meta; + span; fuel0; fuel; input_state; @@ -494,7 +494,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = { fun_end; loop_id; - meta; + span; fuel0; fuel; input_state; @@ -518,10 +518,10 @@ let compute_pretty_names (def : fun_decl) : fun_decl = let supd = { struct_id; init; updates } in (ctx, StructUpdate supd) (* *) - and update_emeta (meta : emeta) (e : texpression) (ctx : pn_ctx) : + and update_espan (span : espan) (e : texpression) (ctx : pn_ctx) : pn_ctx * expression = let ctx = - match meta with + match span with | Assignment (mp, rvalue, rmp) -> let ctx = add_right_constraint mp rvalue ctx in let ctx = @@ -551,7 +551,7 @@ let compute_pretty_names (def : fun_decl) : fun_decl = | Tag _ -> ctx in let ctx, e = update_texpression e ctx in - let e = mk_emeta meta e in + let e = mk_espan span e in (ctx, e.e) in @@ -578,12 +578,12 @@ let compute_pretty_names (def : fun_decl) : fun_decl = in { def with body } -(** Remove the meta-information *) -let remove_meta (def : fun_decl) : fun_decl = +(** Remove the span-information *) +let remove_span (def : fun_decl) : fun_decl = match def.body with | None -> def | Some body -> - let body = { body with body = PureUtils.remove_meta body.body } in + let body = { body with body = PureUtils.remove_span body.body } in { def with body = Some body } (** Introduce the special structure create/update expressions. @@ -614,7 +614,7 @@ let intro_struct_updates (ctx : trans_ctx) (def : fun_decl) : fun_decl = | App _ -> ( let app, args = destruct_apps e in let ignore () = - mk_apps def.meta + mk_apps def.span (self#visit_texpression env app) (List.map (self#visit_texpression env) args) in @@ -759,7 +759,7 @@ let simplify_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = else if variant_id = result_fail_id then (* Fail case *) self#visit_expression env rv.e - else craise __FILE__ __LINE__ def.meta "Unexpected" + else craise __FILE__ __LINE__ def.span "Unexpected" | App _ -> (* This might be the tuple case *) if not monadic then @@ -914,7 +914,7 @@ let inline_useless_var_reassignments (ctx : trans_ctx) ~(inline_named : bool) } ) -> (* Second case: we deconstruct a structure with one field that we will extract as tuple. *) - let adt_id, _ = PureUtils.ty_as_adt def.meta re.ty in + let adt_id, _ = PureUtils.ty_as_adt def.span re.ty in (* Update the rhs (we may perform substitutions inside, and it is * better to do them *before* we inline it *) let re = self#visit_texpression env re in @@ -1152,7 +1152,7 @@ let simplify_let_then_ok _ctx (def : fun_decl) = | Some e -> if match_pattern_and_expr lv e then (* We need to wrap the right-value in a ret *) - (mk_result_ok_texpression def.meta rv).e + (mk_result_ok_texpression def.span rv).e else not_simpl_e | None -> if match_pattern_and_expr lv next_e then rv.e else not_simpl_e @@ -1203,13 +1203,13 @@ let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl = let fields = match adt_decl.kind with | Enum _ | Opaque -> - craise __FILE__ __LINE__ def.meta "Unreachable" + craise __FILE__ __LINE__ def.span "Unreachable" | Struct fields -> fields in let num_fields = List.length fields in (* In order to simplify, there must be as many arguments as * there are fields *) - sanity_check __FILE__ __LINE__ (num_fields > 0) def.meta; + sanity_check __FILE__ __LINE__ (num_fields > 0) def.span; if num_fields = List.length args then (* We now need to check that all the arguments are of the form: * [x.field] for some variable [x], and where the projection @@ -1249,7 +1249,7 @@ let simplify_aggregates (ctx : trans_ctx) (def : fun_decl) : fun_decl = (List.for_all (fun (generics1, _) -> generics1 = generics) args) - def.meta; + def.span; { e with e = Var x }) else super#visit_texpression env e else super#visit_texpression env e @@ -1406,7 +1406,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : in sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf loop_fwd_sig_info) - def.meta; + def.span; let inputs_tys = let fuel = if !Config.use_fuel then [ mk_fuel_ty ] else [] in @@ -1449,7 +1449,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : sanity_check __FILE__ __LINE__ (loop_fwd_effect_info.stateful = Option.is_some loop.input_state) - def.meta; + def.span; match loop.input_state with | None -> ([], []) | Some input_state -> @@ -1486,7 +1486,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : match fuel_vars with | None -> loop.loop_body | Some (fuel0, fuel) -> - SymbolicToPure.wrap_in_match_fuel def.meta fuel0 fuel + SymbolicToPure.wrap_in_match_fuel def.span fuel0 fuel loop.loop_body in @@ -1496,7 +1496,7 @@ let decompose_loops (_ctx : trans_ctx) (def : fun_decl) : { def_id = def.def_id; is_local = def.is_local; - meta = loop.meta; + span = loop.span; kind = def.kind; num_loops; loop_id = Some loop.loop_id; @@ -1580,9 +1580,9 @@ let eliminate_box_functions (_ctx : trans_ctx) (def : fun_decl) : fun_decl = match aid with | BoxNew -> let arg, args = Collections.List.pop args in - mk_apps def.meta arg args + mk_apps def.span arg args | BoxFree -> - sanity_check __FILE__ __LINE__ (args = []) def.meta; + sanity_check __FILE__ __LINE__ (args = []) def.span; mk_unit_rvalue | SliceIndexShared | SliceIndexMut | ArrayIndexShared | ArrayIndexMut | ArrayToSliceShared | ArrayToSliceMut @@ -1776,8 +1776,8 @@ let unfold_monadic_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = *) (* TODO: this information should be computed in SymbolicToPure and * store in an enum ("monadic" should be an enum, not a bool). *) - let re_ty = Option.get (opt_destruct_result def.meta re.ty) in - sanity_check __FILE__ __LINE__ (lv.ty = re_ty) def.meta; + let re_ty = Option.get (opt_destruct_result def.span re.ty) in + sanity_check __FILE__ __LINE__ (lv.ty = re_ty) def.span; let err_vid = fresh_id () in let err_var : var = { @@ -1789,7 +1789,7 @@ let unfold_monadic_let_bindings (_ctx : trans_ctx) (def : fun_decl) : fun_decl = let err_pat = mk_typed_pattern_from_var err_var None in let fail_pat = mk_result_fail_pattern err_pat.value lv.ty in let err_v = mk_texpression_from_var err_var in - let fail_value = mk_result_fail_texpression def.meta err_v e.ty in + let fail_value = mk_result_fail_texpression def.span err_v e.ty in let fail_branch = { pat = fail_pat; branch = fail_value } in let success_pat = mk_result_ok_pattern lv in let success_branch = { pat = success_pat; branch = e } in @@ -2030,7 +2030,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : ^ String.concat ", " (List.map (var_to_string ctx) inputs_prefix) ^ "\n")); let inputs_set = VarId.Set.of_list (List.map var_get_id inputs_prefix) in - sanity_check __FILE__ __LINE__ (Option.is_some decl.loop_id) decl.meta; + sanity_check __FILE__ __LINE__ (Option.is_some decl.loop_id) decl.span; let fun_id = (E.FRegular decl.def_id, decl.loop_id) in @@ -2182,7 +2182,7 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : in let fwd_info = { fwd_info; effect_info; ignore_output } in - sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf fwd_info) decl.meta; + sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf fwd_info) decl.span; let signature = { generics; @@ -2248,17 +2248,17 @@ let filter_loop_inputs (ctx : trans_ctx) (transl : pure_fun_translation list) : in (* Rebuild *) - mk_apps decl.meta e_app args) + mk_apps decl.span e_app args) | _ -> let e_app = self#visit_texpression env e_app in let args = List.map (self#visit_texpression env) args in - mk_apps decl.meta e_app args) + mk_apps decl.span e_app args) | _ -> let e_app = self#visit_texpression env e_app in let args = List.map (self#visit_texpression env) args in - mk_apps decl.meta e_app args) + mk_apps decl.span e_app args) | _ -> super#visit_texpression env e end in @@ -2297,16 +2297,16 @@ let apply_passes_to_def (ctx : trans_ctx) (def : fun_decl) : fun_and_loops = log#ldebug (lazy ("compute_pretty_name:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); - (* TODO: we might want to leverage more the assignment meta-data, for + (* TODO: we might want to leverage more the assignment span-data, for * aggregates for instance. *) (* TODO: reorder the branches of the matches/switches *) - (* The meta-information is now useless: remove it. - * Rk.: some passes below use the fact that we removed the meta-data - * (otherwise we would have to "unmeta" expressions before matching) *) - let def = remove_meta def in - log#ldebug (lazy ("remove_meta:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); + (* The span-information is now useless: remove it. + * Rk.: some passes below use the fact that we removed the span-data + * (otherwise we would have to "unspan" expressions before matching) *) + let def = remove_span def in + log#ldebug (lazy ("remove_span:\n\n" ^ fun_decl_to_string ctx def ^ "\n")); (* Extract the loop definitions by removing the {!Loop} node *) let def, loops = decompose_loops ctx def in diff --git a/compiler/PureTypeCheck.ml b/compiler/PureTypeCheck.ml index c1da4019..8d2ccf41 100644 --- a/compiler/PureTypeCheck.ml +++ b/compiler/PureTypeCheck.ml @@ -9,15 +9,15 @@ open Errors This function should only be used for "regular" ADTs, where the number of fields is fixed: it shouldn't be used for arrays, slices, etc. *) -let get_adt_field_types (meta : Meta.meta) +let get_adt_field_types (span : Meta.span) (type_decls : type_decl TypeDeclId.Map.t) (type_id : type_id) (variant_id : VariantId.id option) (generics : generic_args) : ty list = match type_id with | TTuple -> (* Tuple *) - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; - sanity_check __FILE__ __LINE__ (generics.trait_refs = []) meta; - sanity_check __FILE__ __LINE__ (variant_id = None) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; + sanity_check __FILE__ __LINE__ (generics.trait_refs = []) span; + sanity_check __FILE__ __LINE__ (variant_id = None) span; generics.types | TAdtId def_id -> (* "Regular" ADT *) @@ -28,33 +28,33 @@ let get_adt_field_types (meta : Meta.meta) match aty with | TState -> (* This type is opaque *) - craise __FILE__ __LINE__ meta "Unreachable: opaque type" + craise __FILE__ __LINE__ span "Unreachable: opaque type" | TResult -> let ty = Collections.List.to_cons_nil generics.types in let variant_id = Option.get variant_id in if variant_id = result_ok_id then [ ty ] else if variant_id = result_fail_id then [ mk_error_ty ] else - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Unreachable: improper variant id for result type" | TError -> - sanity_check __FILE__ __LINE__ (generics = empty_generic_args) meta; + sanity_check __FILE__ __LINE__ (generics = empty_generic_args) span; let variant_id = Option.get variant_id in sanity_check __FILE__ __LINE__ (variant_id = error_failure_id || variant_id = error_out_of_fuel_id) - meta; + span; [] | TFuel -> let variant_id = Option.get variant_id in if variant_id = fuel_zero_id then [] else if variant_id = fuel_succ_id then [ mk_fuel_ty ] else - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Unreachable: improper variant id for fuel type" | TArray | TSlice | TStr | TRawPtr _ -> (* Array: when not symbolic values (for instance, because of aggregates), the array expressions are introduced as struct updates *) - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Attempting to access the fields of an opaque type") type tc_ctx = { @@ -67,38 +67,38 @@ type tc_ctx = { (* TODO: add trait type constraints *) } -let check_literal (meta : Meta.meta) (v : literal) (ty : literal_type) : unit = +let check_literal (span : Meta.span) (v : literal) (ty : literal_type) : unit = match (ty, v) with | TInteger int_ty, VScalar sv -> - sanity_check __FILE__ __LINE__ (int_ty = sv.int_ty) meta + sanity_check __FILE__ __LINE__ (int_ty = sv.int_ty) span | TBool, VBool _ | TChar, VChar _ -> () - | _ -> craise __FILE__ __LINE__ meta "Inconsistent type" + | _ -> craise __FILE__ __LINE__ span "Inconsistent type" -let rec check_typed_pattern (meta : Meta.meta) (ctx : tc_ctx) +let rec check_typed_pattern (span : Meta.span) (ctx : tc_ctx) (v : typed_pattern) : tc_ctx = log#ldebug (lazy ("check_typed_pattern: " ^ show_typed_pattern v)); match v.value with | PatConstant cv -> - check_literal meta cv (ty_as_literal meta v.ty); + check_literal span cv (ty_as_literal span v.ty); ctx | PatDummy -> ctx | PatVar (var, _) -> - sanity_check __FILE__ __LINE__ (var.ty = v.ty) meta; + sanity_check __FILE__ __LINE__ (var.ty = v.ty) span; let env = VarId.Map.add var.id var.ty ctx.env in { ctx with env } | PatAdt av -> (* Compute the field types *) - let type_id, generics = ty_as_adt meta v.ty in + let type_id, generics = ty_as_adt span v.ty in let field_tys = - get_adt_field_types meta ctx.type_decls type_id av.variant_id generics + get_adt_field_types span ctx.type_decls type_id av.variant_id generics in let check_value (ctx : tc_ctx) (ty : ty) (v : typed_pattern) : tc_ctx = if ty <> v.ty then (* TODO: we need to normalize the types *) - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span ("Inconsistent types:" ^ "\n- ty: " ^ show_ty ty ^ "\n- v.ty: " ^ show_ty v.ty); - check_typed_pattern meta ctx v + check_typed_pattern span ctx v in (* Check the field types: check that the field patterns have the expected * types, and check that the field patterns themselves are well-typed *) @@ -107,7 +107,7 @@ let rec check_typed_pattern (meta : Meta.meta) (ctx : tc_ctx) ctx (List.combine field_tys av.field_values) -let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : +let rec check_texpression (span : Meta.span) (ctx : tc_ctx) (e : texpression) : unit = match e.e with | Var var_id -> ( @@ -117,24 +117,24 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : * we use a locally nameless representation *) match VarId.Map.find_opt var_id ctx.env with | None -> () - | Some ty -> sanity_check __FILE__ __LINE__ (ty = e.ty) meta) + | Some ty -> sanity_check __FILE__ __LINE__ (ty = e.ty) span) | CVar cg_id -> let ty = T.ConstGenericVarId.Map.find cg_id ctx.const_generics in - sanity_check __FILE__ __LINE__ (ty = e.ty) meta - | Const cv -> check_literal meta cv (ty_as_literal meta e.ty) + sanity_check __FILE__ __LINE__ (ty = e.ty) span + | Const cv -> check_literal span cv (ty_as_literal span e.ty) | App (app, arg) -> - let input_ty, output_ty = destruct_arrow meta app.ty in - sanity_check __FILE__ __LINE__ (input_ty = arg.ty) meta; - sanity_check __FILE__ __LINE__ (output_ty = e.ty) meta; - check_texpression meta ctx app; - check_texpression meta ctx arg + let input_ty, output_ty = destruct_arrow span app.ty in + sanity_check __FILE__ __LINE__ (input_ty = arg.ty) span; + sanity_check __FILE__ __LINE__ (output_ty = e.ty) span; + check_texpression span ctx app; + check_texpression span ctx arg | Lambda (pat, body) -> - let pat_ty, body_ty = destruct_arrow meta e.ty in - sanity_check __FILE__ __LINE__ (pat.ty = pat_ty) meta; - sanity_check __FILE__ __LINE__ (body.ty = body_ty) meta; + let pat_ty, body_ty = destruct_arrow span e.ty in + sanity_check __FILE__ __LINE__ (pat.ty = pat_ty) span; + sanity_check __FILE__ __LINE__ (body.ty = body_ty) span; (* Check the pattern and register the introduced variables at the same time *) - let ctx = check_typed_pattern meta ctx pat in - check_texpression meta ctx body + let ctx = check_typed_pattern span ctx pat in + check_texpression span ctx body | Qualif qualif -> ( match qualif.id with | FunOrOp _ -> () (* TODO *) @@ -143,86 +143,86 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : | Proj { adt_id = proj_adt_id; field_id } -> (* Note we can only project fields of structures (not enumerations) *) (* Deconstruct the projector type *) - let adt_ty, field_ty = destruct_arrow meta e.ty in - let adt_id, adt_generics = ty_as_adt meta adt_ty in + let adt_ty, field_ty = destruct_arrow span e.ty in + let adt_id, adt_generics = ty_as_adt span adt_ty in (* Check the ADT type *) - sanity_check __FILE__ __LINE__ (adt_id = proj_adt_id) meta; - sanity_check __FILE__ __LINE__ (adt_generics = qualif.generics) meta; + sanity_check __FILE__ __LINE__ (adt_id = proj_adt_id) span; + sanity_check __FILE__ __LINE__ (adt_generics = qualif.generics) span; (* Retrieve and check the expected field type *) let variant_id = None in let expected_field_tys = - get_adt_field_types meta ctx.type_decls proj_adt_id variant_id + get_adt_field_types span ctx.type_decls proj_adt_id variant_id qualif.generics in let expected_field_ty = FieldId.nth expected_field_tys field_id in - sanity_check __FILE__ __LINE__ (expected_field_ty = field_ty) meta + sanity_check __FILE__ __LINE__ (expected_field_ty = field_ty) span | AdtCons id -> ( let expected_field_tys = - get_adt_field_types meta ctx.type_decls id.adt_id id.variant_id + get_adt_field_types span ctx.type_decls id.adt_id id.variant_id qualif.generics in let field_tys, adt_ty = destruct_arrows e.ty in - sanity_check __FILE__ __LINE__ (expected_field_tys = field_tys) meta; + sanity_check __FILE__ __LINE__ (expected_field_tys = field_tys) span; match adt_ty with | TAdt (type_id, generics) -> - sanity_check __FILE__ __LINE__ (type_id = id.adt_id) meta; - sanity_check __FILE__ __LINE__ (generics = qualif.generics) meta - | _ -> craise __FILE__ __LINE__ meta "Unreachable")) + sanity_check __FILE__ __LINE__ (type_id = id.adt_id) span; + sanity_check __FILE__ __LINE__ (generics = qualif.generics) span + | _ -> craise __FILE__ __LINE__ span "Unreachable")) | Let (monadic, pat, re, e_next) -> let expected_pat_ty = - if monadic then destruct_result meta re.ty else re.ty + if monadic then destruct_result span re.ty else re.ty in - sanity_check __FILE__ __LINE__ (pat.ty = expected_pat_ty) meta; - sanity_check __FILE__ __LINE__ (e.ty = e_next.ty) meta; + sanity_check __FILE__ __LINE__ (pat.ty = expected_pat_ty) span; + sanity_check __FILE__ __LINE__ (e.ty = e_next.ty) span; (* Check the right-expression *) - check_texpression meta ctx re; + check_texpression span ctx re; (* Check the pattern and register the introduced variables at the same time *) - let ctx = check_typed_pattern meta ctx pat in + let ctx = check_typed_pattern span ctx pat in (* Check the next expression *) - check_texpression meta ctx e_next + check_texpression span ctx e_next | Switch (scrut, switch_body) -> ( - check_texpression meta ctx scrut; + check_texpression span ctx scrut; match switch_body with | If (e_then, e_else) -> - sanity_check __FILE__ __LINE__ (scrut.ty = TLiteral TBool) meta; - sanity_check __FILE__ __LINE__ (e_then.ty = e.ty) meta; - sanity_check __FILE__ __LINE__ (e_else.ty = e.ty) meta; - check_texpression meta ctx e_then; - check_texpression meta ctx e_else + sanity_check __FILE__ __LINE__ (scrut.ty = TLiteral TBool) span; + sanity_check __FILE__ __LINE__ (e_then.ty = e.ty) span; + sanity_check __FILE__ __LINE__ (e_else.ty = e.ty) span; + check_texpression span ctx e_then; + check_texpression span ctx e_else | Match branches -> let check_branch (br : match_branch) : unit = - sanity_check __FILE__ __LINE__ (br.pat.ty = scrut.ty) meta; - let ctx = check_typed_pattern meta ctx br.pat in - check_texpression meta ctx br.branch + sanity_check __FILE__ __LINE__ (br.pat.ty = scrut.ty) span; + let ctx = check_typed_pattern span ctx br.pat in + check_texpression span ctx br.branch in List.iter check_branch branches) | Loop loop -> - sanity_check __FILE__ __LINE__ (loop.fun_end.ty = e.ty) meta; - check_texpression meta ctx loop.fun_end; - check_texpression meta ctx loop.loop_body + sanity_check __FILE__ __LINE__ (loop.fun_end.ty = e.ty) span; + check_texpression span ctx loop.fun_end; + check_texpression span ctx loop.loop_body | StructUpdate supd -> ( (* Check the init value *) (if Option.is_some supd.init then match VarId.Map.find_opt (Option.get supd.init) ctx.env with | None -> () - | Some ty -> sanity_check __FILE__ __LINE__ (ty = e.ty) meta); + | Some ty -> sanity_check __FILE__ __LINE__ (ty = e.ty) span); (* Check the fields *) (* Retrieve and check the expected field type *) - let adt_id, adt_generics = ty_as_adt meta e.ty in - sanity_check __FILE__ __LINE__ (adt_id = supd.struct_id) meta; + let adt_id, adt_generics = ty_as_adt span e.ty in + sanity_check __FILE__ __LINE__ (adt_id = supd.struct_id) span; (* The id can only be: a custom type decl or an array *) match adt_id with | TAdtId _ -> let variant_id = None in let expected_field_tys = - get_adt_field_types meta ctx.type_decls adt_id variant_id + get_adt_field_types span ctx.type_decls adt_id variant_id adt_generics in List.iter (fun ((fid, fe) : _ * texpression) -> let expected_field_ty = FieldId.nth expected_field_tys fid in - sanity_check __FILE__ __LINE__ (expected_field_ty = fe.ty) meta; - check_texpression meta ctx fe) + sanity_check __FILE__ __LINE__ (expected_field_ty = fe.ty) span; + check_texpression span ctx fe) supd.updates | TAssumed TArray -> let expected_field_ty = @@ -230,11 +230,11 @@ let rec check_texpression (meta : Meta.meta) (ctx : tc_ctx) (e : texpression) : in List.iter (fun ((_, fe) : _ * texpression) -> - sanity_check __FILE__ __LINE__ (expected_field_ty = fe.ty) meta; - check_texpression meta ctx fe) + sanity_check __FILE__ __LINE__ (expected_field_ty = fe.ty) span; + check_texpression span ctx fe) supd.updates - | _ -> craise __FILE__ __LINE__ meta "Unexpected") + | _ -> craise __FILE__ __LINE__ span "Unexpected") | Meta (_, e_next) -> - sanity_check __FILE__ __LINE__ (e_next.ty = e.ty) meta; - check_texpression meta ctx e_next - | EError (meta, msg) -> craise_opt_meta __FILE__ __LINE__ meta msg + sanity_check __FILE__ __LINE__ (e_next.ty = e.ty) span; + check_texpression span ctx e_next + | EError (span, msg) -> craise_opt_span __FILE__ __LINE__ span msg diff --git a/compiler/PureUtils.ml b/compiler/PureUtils.ml index 82a578d9..e7dcd933 100644 --- a/compiler/PureUtils.ml +++ b/compiler/PureUtils.ml @@ -80,10 +80,10 @@ let opt_dest_arrow_ty (ty : ty) : (ty * ty) option = let is_arrow_ty (ty : ty) : bool = Option.is_some (opt_dest_arrow_ty ty) -let dest_arrow_ty (meta : Meta.meta) (ty : ty) : ty * ty = +let dest_arrow_ty (span : Meta.span) (ty : ty) : ty * ty = match opt_dest_arrow_ty ty with | Some (arg_ty, ret_ty) -> (arg_ty, ret_ty) - | None -> craise __FILE__ __LINE__ meta "Not an arrow type" + | None -> craise __FILE__ __LINE__ span "Not an arrow type" let compute_literal_type (cv : literal) : literal_type = match cv with @@ -91,7 +91,7 @@ let compute_literal_type (cv : literal) : literal_type = | VBool _ -> TBool | VChar _ -> TChar | VStr _ | VByteStr _ -> - craise_opt_meta __FILE__ __LINE__ None + craise_opt_span __FILE__ __LINE__ None "String and byte string literals are unsupported" let var_get_id (v : var) : VarId.id = v.id @@ -222,34 +222,34 @@ let fun_sig_substitute (subst : subst) (sg : fun_sig) : inst_fun_sig = Rem.: this function will *fail* if there are {!Pure.Loop} nodes (you should call it on an expression where those nodes have been eliminated). *) -let rec let_group_requires_parentheses (meta : Meta.meta) (e : texpression) : +let rec let_group_requires_parentheses (span : Meta.span) (e : texpression) : bool = match e.e with | Var _ | CVar _ | Const _ | App _ | Qualif _ | StructUpdate _ -> false | Let (monadic, _, _, next_e) -> - if monadic then true else let_group_requires_parentheses meta next_e + if monadic then true else let_group_requires_parentheses span next_e | Switch (_, _) -> false - | Meta (_, next_e) -> let_group_requires_parentheses meta next_e + | Meta (_, next_e) -> let_group_requires_parentheses span next_e | Lambda (_, _) -> (* Being conservative here *) true | Loop _ -> (* Should have been eliminated *) - craise __FILE__ __LINE__ meta "Unreachable" - | EError (meta, msg) -> - craise_opt_meta __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Unreachable" + | EError (span, msg) -> + craise_opt_span __FILE__ __LINE__ span msg (* TODO : check if true should'nt be returned instead ? *) -let texpression_requires_parentheses meta e = +let texpression_requires_parentheses span e = match !Config.backend with | FStar | Lean -> false - | Coq | HOL4 -> let_group_requires_parentheses meta e + | Coq | HOL4 -> let_group_requires_parentheses span e let is_var (e : texpression) : bool = match e.e with Var _ -> true | _ -> false -let as_var (meta : Meta.meta) (e : texpression) : VarId.id = - match e.e with Var v -> v | _ -> craise __FILE__ __LINE__ meta "Not a var" +let as_var (span : Meta.span) (e : texpression) : VarId.id = + match e.e with Var v -> v | _ -> craise __FILE__ __LINE__ span "Not a var" let is_cvar (e : texpression) : bool = match e.e with CVar _ -> true | _ -> false @@ -260,17 +260,17 @@ let is_global (e : texpression) : bool = let is_const (e : texpression) : bool = match e.e with Const _ -> true | _ -> false -let ty_as_adt (meta : Meta.meta) (ty : ty) : type_id * generic_args = +let ty_as_adt (span : Meta.span) (ty : ty) : type_id * generic_args = match ty with | TAdt (id, generics) -> (id, generics) - | _ -> craise __FILE__ __LINE__ meta "Not an ADT" + | _ -> craise __FILE__ __LINE__ span "Not an ADT" (** Remove the external occurrences of {!Meta} *) -let rec unmeta (e : texpression) : texpression = - match e.e with Meta (_, e) -> unmeta e | _ -> e +let rec unspan (e : texpression) : texpression = + match e.e with Meta (_, e) -> unspan e | _ -> e -(** Remove *all* the meta information *) -let remove_meta (e : texpression) : texpression = +(** Remove *all* the span information *) +let remove_span (e : texpression) : texpression = let obj = object inherit [_] map_expression as super @@ -300,13 +300,13 @@ let rec destruct_lets (e : texpression) : (** Destruct an expression into a list of nested lets, where there is no interleaving between monadic and non-monadic lets. *) -let destruct_lets_no_interleave (meta : Meta.meta) (e : texpression) : +let destruct_lets_no_interleave (span : Meta.span) (e : texpression) : (bool * typed_pattern * texpression) list * texpression = (* Find the "kind" of the first let (monadic or non-monadic) *) let m = match e.e with | Let (monadic, _, _, _) -> monadic - | _ -> craise __FILE__ __LINE__ meta "Not a let-binding" + | _ -> craise __FILE__ __LINE__ span "Not a let-binding" in (* Destruct the rest *) let rec destruct_lets (e : texpression) : @@ -333,11 +333,11 @@ let destruct_apps (e : texpression) : texpression * texpression list = aux [] e (** Make an [App (app, arg)] expression *) -let mk_app (meta : Meta.meta) (app : texpression) (arg : texpression) : +let mk_app (span : Meta.span) (app : texpression) (arg : texpression) : texpression = let raise_or_return msg = (* We shouldn't get there, so we save an error (and eventually raise an exception) *) - save_error __FILE__ __LINE__ (Some meta) msg; + save_error __FILE__ __LINE__ (Some span) msg; let e = App (app, arg) in (* Dummy type - TODO: introduce an error type *) let ty = app.ty in @@ -357,9 +357,9 @@ let mk_app (meta : Meta.meta) (app : texpression) (arg : texpression) : | _ -> raise_or_return "Expected an arrow type" (** The reverse of {!destruct_apps} *) -let mk_apps (meta : Meta.meta) (app : texpression) (args : texpression list) : +let mk_apps (span : Meta.span) (app : texpression) (args : texpression list) : texpression = - List.fold_left (fun app arg -> mk_app meta app arg) app args + List.fold_left (fun app arg -> mk_app span app arg) app args (** Destruct an expression into a qualif identifier and a list of arguments, * if possible *) @@ -382,29 +382,29 @@ let opt_destruct_function_call (e : texpression) : | FunOrOp fun_id -> Some (fun_id, qualif.generics, args) | _ -> None) -let opt_destruct_result (meta : Meta.meta) (ty : ty) : ty option = +let opt_destruct_result (span : Meta.span) (ty : ty) : ty option = match ty with | TAdt (TAssumed TResult, generics) -> - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; - sanity_check __FILE__ __LINE__ (generics.trait_refs = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; + sanity_check __FILE__ __LINE__ (generics.trait_refs = []) span; Some (Collections.List.to_cons_nil generics.types) | _ -> None -let destruct_result (meta : Meta.meta) (ty : ty) : ty = - Option.get (opt_destruct_result meta ty) +let destruct_result (span : Meta.span) (ty : ty) : ty = + Option.get (opt_destruct_result span ty) -let opt_destruct_tuple (meta : Meta.meta) (ty : ty) : ty list option = +let opt_destruct_tuple (span : Meta.span) (ty : ty) : ty list option = match ty with | TAdt (TTuple, generics) -> - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; - sanity_check __FILE__ __LINE__ (generics.trait_refs = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; + sanity_check __FILE__ __LINE__ (generics.trait_refs = []) span; Some generics.types | _ -> None -let destruct_arrow (meta : Meta.meta) (ty : ty) : ty * ty = +let destruct_arrow (span : Meta.span) (ty : ty) : ty * ty = match ty with | TArrow (ty0, ty1) -> (ty0, ty1) - | _ -> craise __FILE__ __LINE__ meta "Not an arrow type" + | _ -> craise __FILE__ __LINE__ span "Not an arrow type" let rec destruct_arrows (ty : ty) : ty list * ty = match ty with @@ -438,20 +438,20 @@ let iter_switch_body_branches (f : texpression -> unit) (sb : switch_body) : f e_else | Match branches -> List.iter (fun (b : match_branch) -> f b.branch) branches -let mk_switch (meta : Meta.meta) (scrut : texpression) (sb : switch_body) : +let mk_switch (span : Meta.span) (scrut : texpression) (sb : switch_body) : texpression = (* Sanity check: the scrutinee has the proper type *) (match sb with - | If (_, _) -> sanity_check __FILE__ __LINE__ (scrut.ty = TLiteral TBool) meta + | If (_, _) -> sanity_check __FILE__ __LINE__ (scrut.ty = TLiteral TBool) span | Match branches -> List.iter (fun (b : match_branch) -> - sanity_check __FILE__ __LINE__ (b.pat.ty = scrut.ty) meta) + sanity_check __FILE__ __LINE__ (b.pat.ty = scrut.ty) span) branches); (* Sanity check: all the branches have the same type *) let ty = get_switch_body_ty sb in iter_switch_body_branches - (fun e -> sanity_check __FILE__ __LINE__ (e.ty = ty) meta) + (fun e -> sanity_check __FILE__ __LINE__ (e.ty = ty) span) sb; (* Put together *) let e = Switch (scrut, sb) in @@ -491,13 +491,13 @@ let mk_dummy_pattern (ty : ty) : typed_pattern = let value = PatDummy in { value; ty } -let mk_emeta (m : emeta) (e : texpression) : texpression = +let mk_espan (m : espan) (e : texpression) : texpression = let ty = e.ty in let e = Meta (m, e) in { e; ty } let mk_mplace_texpression (mp : mplace) (e : texpression) : texpression = - mk_emeta (MPlace mp) e + mk_espan (MPlace mp) e let mk_opt_mplace_texpression (mp : mplace option) (e : texpression) : texpression = @@ -517,7 +517,7 @@ let mk_simpl_tuple_pattern (vl : typed_pattern list) : typed_pattern = { value; ty } (** Similar to {!mk_simpl_tuple_pattern} *) -let mk_simpl_tuple_texpression (meta : Meta.meta) (vl : texpression list) : +let mk_simpl_tuple_texpression (span : Meta.span) (vl : texpression list) : texpression = match vl with | [ v ] -> v @@ -531,22 +531,22 @@ let mk_simpl_tuple_texpression (meta : Meta.meta) (vl : texpression list) : let qualif = { id; generics = mk_generic_args_from_types tys } in (* Put everything together *) let cons = { e = Qualif qualif; ty } in - mk_apps meta cons vl + mk_apps span cons vl let mk_adt_pattern (adt_ty : ty) (variant_id : VariantId.id option) (vl : typed_pattern list) : typed_pattern = let value = PatAdt { variant_id; field_values = vl } in { value; ty = adt_ty } -let ty_as_integer (meta : Meta.meta) (t : ty) : T.integer_type = +let ty_as_integer (span : Meta.span) (t : ty) : T.integer_type = match t with | TLiteral (TInteger int_ty) -> int_ty - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" -let ty_as_literal (meta : Meta.meta) (t : ty) : T.literal_type = +let ty_as_literal (span : Meta.span) (t : ty) : T.literal_type = match t with | TLiteral ty -> ty - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" let mk_state_ty : ty = TAdt (TAssumed TState, empty_generic_args) @@ -563,15 +563,15 @@ let mk_error (error : VariantId.id) : texpression = let e = Qualif qualif in { e; ty } -let unwrap_result_ty (meta : Meta.meta) (ty : ty) : ty = +let unwrap_result_ty (span : Meta.span) (ty : ty) : ty = match ty with | TAdt ( TAssumed TResult, { types = [ ty ]; const_generics = []; trait_refs = [] } ) -> ty - | _ -> craise __FILE__ __LINE__ meta "not a result type" + | _ -> craise __FILE__ __LINE__ span "not a result type" -let mk_result_fail_texpression (meta : Meta.meta) (error : texpression) +let mk_result_fail_texpression (span : Meta.span) (error : texpression) (ty : ty) : texpression = let type_args = [ ty ] in let ty = TAdt (TAssumed TResult, mk_generic_args_from_types type_args) in @@ -582,14 +582,14 @@ let mk_result_fail_texpression (meta : Meta.meta) (error : texpression) let cons_e = Qualif qualif in let cons_ty = mk_arrow error.ty ty in let cons = { e = cons_e; ty = cons_ty } in - mk_app meta cons error + mk_app span cons error -let mk_result_fail_texpression_with_error_id (meta : Meta.meta) +let mk_result_fail_texpression_with_error_id (span : Meta.span) (error : VariantId.id) (ty : ty) : texpression = let error = mk_error error in - mk_result_fail_texpression meta error ty + mk_result_fail_texpression span error ty -let mk_result_ok_texpression (meta : Meta.meta) (v : texpression) : texpression +let mk_result_ok_texpression (span : Meta.span) (v : texpression) : texpression = let type_args = [ v.ty ] in let ty = TAdt (TAssumed TResult, mk_generic_args_from_types type_args) in @@ -600,7 +600,7 @@ let mk_result_ok_texpression (meta : Meta.meta) (v : texpression) : texpression let cons_e = Qualif qualif in let cons_ty = mk_arrow v.ty ty in let cons = { e = cons_e; ty = cons_ty } in - mk_app meta cons v + mk_app span cons v (** Create a [Fail err] pattern which captures the error *) let mk_result_fail_pattern (error_pat : pattern) (ty : ty) : typed_pattern = @@ -621,7 +621,7 @@ let mk_result_ok_pattern (v : typed_pattern) : typed_pattern = let value = PatAdt { variant_id = Some result_ok_id; field_values = [ v ] } in { value; ty } -let opt_unmeta_mplace (e : texpression) : mplace option * texpression = +let opt_unspan_mplace (e : texpression) : mplace option * texpression = match e.e with Meta (MPlace mp, e) -> (Some mp, e) | _ -> (None, e) let mk_state_var (id : VarId.id) : var = @@ -636,7 +636,7 @@ let mk_fuel_var (id : VarId.id) : var = let mk_fuel_texpression (id : VarId.id) : texpression = { e = Var id; ty = mk_fuel_ty } -let rec typed_pattern_to_texpression (meta : Meta.meta) (pat : typed_pattern) : +let rec typed_pattern_to_texpression (span : Meta.span) (pat : typed_pattern) : texpression option = let e_opt = match pat.value with @@ -645,14 +645,14 @@ let rec typed_pattern_to_texpression (meta : Meta.meta) (pat : typed_pattern) : | PatDummy -> None | PatAdt av -> let fields = - List.map (typed_pattern_to_texpression meta) av.field_values + List.map (typed_pattern_to_texpression span) av.field_values in if List.mem None fields then None else let fields_values = List.map (fun e -> Option.get e) fields in (* Retrieve the type id and the type args from the pat type (simpler this way *) - let adt_id, generics = ty_as_adt meta pat.ty in + let adt_id, generics = ty_as_adt span pat.ty in (* Create the constructor *) let qualif_id = AdtCons { adt_id; variant_id = av.variant_id } in @@ -665,7 +665,7 @@ let rec typed_pattern_to_texpression (meta : Meta.meta) (pat : typed_pattern) : let cons = { e = cons_e; ty = cons_ty } in (* Apply the constructor *) - Some (mk_apps meta cons fields_values).e + Some (mk_apps span cons fields_values).e in match e_opt with None -> None | Some e -> Some { e; ty = pat.ty } @@ -692,7 +692,7 @@ let trait_decl_is_empty (trait_decl : trait_decl) : bool = is_local = _; name = _; llbc_name = _; - meta = _; + span = _; generics = _; llbc_generics = _; preds = _; @@ -714,7 +714,7 @@ let trait_impl_is_empty (trait_impl : trait_impl) : bool = is_local = _; name = _; llbc_name = _; - meta = _; + span = _; impl_trait = _; llbc_impl_trait = _; generics = _; diff --git a/compiler/RegionsHierarchy.ml b/compiler/RegionsHierarchy.ml index 21be89ee..3ec42f5d 100644 --- a/compiler/RegionsHierarchy.ml +++ b/compiler/RegionsHierarchy.ml @@ -40,7 +40,7 @@ module Subst = Substitute (** The local logger *) let log = Logging.regions_hierarchy_log -let compute_regions_hierarchy_for_sig (meta : Meta.meta option) +let compute_regions_hierarchy_for_sig (span : Meta.span option) (type_decls : type_decl TypeDeclId.Map.t) (fun_decls : fun_decl FunDeclId.Map.t) (global_decls : global_decl GlobalDeclId.Map.t) @@ -52,11 +52,11 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) associated types) *) let norm_ctx : AssociatedTypes.norm_ctx = let norm_trait_types = - AssociatedTypes.compute_norm_trait_types_from_preds meta + AssociatedTypes.compute_norm_trait_types_from_preds span sg.preds.trait_type_constraints in { - meta; + span; norm_trait_types; type_decls; fun_decls; @@ -108,8 +108,8 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) let add_edge ~(short : region) ~(long : region) = (* Sanity checks *) - sanity_check_opt_meta __FILE__ __LINE__ (short <> RErased) meta; - sanity_check_opt_meta __FILE__ __LINE__ (long <> RErased) meta; + sanity_check_opt_span __FILE__ __LINE__ (short <> RErased) span; + sanity_check_opt_span __FILE__ __LINE__ (long <> RErased) span; (* Ignore the locally bound regions (at the level of arrow types for instance *) match (short, long) with | RBVar _, _ | _, RBVar _ -> () @@ -175,14 +175,14 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) | TTraitType (trait_ref, _) -> (* The trait should reference a clause, and not an implementation (otherwise it should have been normalized) *) - sanity_check_opt_meta __FILE__ __LINE__ + sanity_check_opt_span __FILE__ __LINE__ (AssociatedTypes.trait_instance_id_is_local_clause trait_ref.trait_id) - meta; + span; (* We have nothing to do *) () | TArrow (regions, inputs, output) -> (* TODO: *) - cassert_opt_meta __FILE__ __LINE__ (regions = []) meta + cassert_opt_span __FILE__ __LINE__ (regions = []) span "We don't support arrow types with locally quantified regions"; (* We can ignore the outer regions *) List.iter (explore_ty []) (output :: inputs) @@ -226,7 +226,7 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) (SccId.Map.bindings sccs.sccs) in (* The SCC should only contain the 'static *) - sanity_check_opt_meta __FILE__ __LINE__ (static_scc = [ RStatic ]) meta; + sanity_check_opt_span __FILE__ __LINE__ (static_scc = [ RStatic ]) span; (* Remove the group as well as references to this group from the other SCCs *) let { sccs; scc_deps } = sccs in @@ -282,7 +282,7 @@ let compute_regions_hierarchy_for_sig (meta : Meta.meta option) (fun r -> match r with | RFVar rid -> RegionId.Map.find rid region_id_to_var_map - | _ -> craise __FILE__ __LINE__ (Option.get meta) "Unreachable") + | _ -> craise __FILE__ __LINE__ (Option.get span) "Unreachable") scc in @@ -323,7 +323,7 @@ let compute_regions_hierarchies (type_decls : type_decl TypeDeclId.Map.t) List.map (fun ((fid, d) : FunDeclId.id * fun_decl) -> ( FRegular fid, - (Types.name_to_string env d.name, d.signature, Some d.item_meta.meta) + (Types.name_to_string env d.name, d.signature, Some d.item_meta.span) )) (FunDeclId.Map.bindings fun_decls) in @@ -335,8 +335,8 @@ let compute_regions_hierarchies (type_decls : type_decl TypeDeclId.Map.t) in FunIdMap.of_list (List.map - (fun (fid, (name, sg, meta)) -> + (fun (fid, (name, sg, span)) -> ( fid, - compute_regions_hierarchy_for_sig meta type_decls fun_decls + compute_regions_hierarchy_for_sig span type_decls fun_decls global_decls trait_decls trait_impls name sg )) (regular @ assumed)) diff --git a/compiler/Substitute.ml b/compiler/Substitute.ml index 177d8c24..37ef6987 100644 --- a/compiler/Substitute.ml +++ b/compiler/Substitute.ml @@ -68,7 +68,7 @@ let ctx_adt_get_instantiated_field_types (ctx : eval_ctx) **IMPORTANT**: this function doesn't normalize the types, you may want to use the [AssociatedTypes] equivalent instead. *) -let ctx_adt_value_get_instantiated_field_types (meta : Meta.meta) +let ctx_adt_value_get_instantiated_field_types (span : Meta.span) (ctx : eval_ctx) (adt : adt_value) (id : type_id) (generics : generic_args) : ty list = match id with @@ -76,19 +76,19 @@ let ctx_adt_value_get_instantiated_field_types (meta : Meta.meta) (* Retrieve the types of the fields *) ctx_adt_get_instantiated_field_types ctx id adt.variant_id generics | TTuple -> - cassert __FILE__ __LINE__ (generics.regions = []) meta + cassert __FILE__ __LINE__ (generics.regions = []) span "Tuples don't have region parameters"; generics.types | TAssumed aty -> ( match aty with | TBox -> - sanity_check __FILE__ __LINE__ (generics.regions = []) meta; - sanity_check __FILE__ __LINE__ (List.length generics.types = 1) meta; - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.regions = []) span; + sanity_check __FILE__ __LINE__ (List.length generics.types = 1) span; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; generics.types | TArray | TSlice | TStr -> (* Those types don't have fields *) - craise __FILE__ __LINE__ meta "Unreachable") + craise __FILE__ __LINE__ span "Unreachable") (** Substitute a function signature, together with the regions hierarchy associated to that signature. @@ -138,41 +138,41 @@ let subst_ids_visitor (r_subst : RegionId.id -> RegionId.id) method! visit_loan_id _ bid = bsubst bid method! visit_symbolic_value_id _ id = ssubst id - (** We *do* visit meta-values *) + (** We *do* visit span-values *) method! visit_msymbolic_value env sv = self#visit_symbolic_value env sv - (** We *do* visit meta-values *) + (** We *do* visit span-values *) method! visit_mvalue env v = self#visit_typed_value env v method! visit_abstraction_id _ id = asubst id end -let typed_value_subst_ids (meta : Meta.meta) +let typed_value_subst_ids (span : Meta.span) (r_subst : RegionId.id -> RegionId.id) (ty_subst : TypeVarId.id -> TypeVarId.id) (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) (ssubst : SymbolicValueId.id -> SymbolicValueId.id) (bsubst : BorrowId.id -> BorrowId.id) (v : typed_value) : typed_value = - let asubst _ = craise __FILE__ __LINE__ meta "Unreachable" in + let asubst _ = craise __FILE__ __LINE__ span "Unreachable" in let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in vis#visit_typed_value () v -let typed_value_subst_rids (meta : Meta.meta) +let typed_value_subst_rids (span : Meta.span) (r_subst : RegionId.id -> RegionId.id) (v : typed_value) : typed_value = - typed_value_subst_ids meta r_subst + typed_value_subst_ids span r_subst (fun x -> x) (fun x -> x) (fun x -> x) (fun x -> x) v -let typed_avalue_subst_ids (meta : Meta.meta) +let typed_avalue_subst_ids (span : Meta.span) (r_subst : RegionId.id -> RegionId.id) (ty_subst : TypeVarId.id -> TypeVarId.id) (cg_subst : ConstGenericVarId.id -> ConstGenericVarId.id) (ssubst : SymbolicValueId.id -> SymbolicValueId.id) (bsubst : BorrowId.id -> BorrowId.id) (v : typed_avalue) : typed_avalue = - let asubst _ = craise __FILE__ __LINE__ meta "Unreachable" in + let asubst _ = craise __FILE__ __LINE__ span "Unreachable" in let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in vis#visit_typed_avalue () v @@ -194,9 +194,9 @@ let env_subst_ids (r_subst : RegionId.id -> RegionId.id) let vis = subst_ids_visitor r_subst ty_subst cg_subst ssubst bsubst asubst in vis#visit_env () x -let typed_avalue_subst_rids (meta : Meta.meta) +let typed_avalue_subst_rids (span : Meta.span) (r_subst : RegionId.id -> RegionId.id) (x : typed_avalue) : typed_avalue = - let asubst _ = craise __FILE__ __LINE__ meta "Unreachable" in + let asubst _ = craise __FILE__ __LINE__ span "Unreachable" in let vis = subst_ids_visitor r_subst (fun x -> x) diff --git a/compiler/SymbolicAst.ml b/compiler/SymbolicAst.ml index f15a2c23..e9143ab5 100644 --- a/compiler/SymbolicAst.ml +++ b/compiler/SymbolicAst.ml @@ -8,7 +8,7 @@ open Expressions open Values open LlbcAst -(** "Meta"-place: a place stored as meta-data. +(** "Meta"-place: a place stored as span-data. Whenever we need to introduce new symbolic variables, for instance because of symbolic expansions, we try to store a "place", which gives information @@ -62,7 +62,7 @@ type call = { (** Meta information for expressions, not necessary for synthesis but useful to guide it to generate a pretty output. *) -type emeta = +type espan = | Assignment of Contexts.eval_ctx * mplace * typed_value * mplace option (** We generated an assignment (destination, assigned value, src) *) | Snapshot of Contexts.eval_ctx @@ -92,8 +92,8 @@ class ['self] iter_expression_base = fun _ _ -> () method visit_mplace : 'env -> mplace -> unit = fun _ _ -> () - method visit_emeta : 'env -> emeta -> unit = fun _ _ -> () - method visit_meta : 'env -> Meta.meta -> unit = fun _ _ -> () + method visit_espan : 'env -> espan -> unit = fun _ _ -> () + method visit_span : 'env -> Meta.span -> unit = fun _ _ -> () method visit_region_group_id_map : 'a. ('env -> 'a -> unit) -> 'env -> 'a region_group_id_map -> unit = @@ -155,7 +155,7 @@ type expression = | Expansion of mplace option * symbolic_value * expansion (** Expansion of a symbolic value. - The place is "meta": it gives the path to the symbolic value (if available) + The place is "span": it gives the path to the symbolic value (if available) which got expanded (this path is available when the symbolic expansion comes from a path evaluation, during an assignment for instance). We use it to compute meaningful names for the variables we introduce, @@ -211,8 +211,8 @@ type expression = The boolean is [true]. TODO: merge this with Return. *) - | Meta of emeta * expression (** Meta information *) - | Error of Meta.meta option * string + | Meta of espan * expression (** Meta information *) + | Error of Meta.span option * string and loop = { loop_id : loop_id; @@ -226,7 +226,7 @@ and loop = { end_expr : expression; (** The end of the function (upon the moment it enters the loop) *) loop_expr : expression; (** The symbolically executed loop body *) - meta : Meta.meta; (** Information about where the origin of the loop body *) + span : Meta.span; (** Information about where the origin of the loop body *) } and expansion = diff --git a/compiler/SymbolicToPure.ml b/compiler/SymbolicToPure.ml index 351f5cf2..d6d2e018 100644 --- a/compiler/SymbolicToPure.ml +++ b/compiler/SymbolicToPure.ml @@ -144,7 +144,7 @@ type loop_info = { (** Body synthesis context *) type bs_ctx = { (* TODO: there are a lot of duplications with the various decls ctx *) - meta : Meta.meta; (** The meta information about the current declaration *) + span : Meta.span; (** The span information about the current declaration *) decls_ctx : C.decls_ctx; type_ctx : type_ctx; fun_ctx : fun_ctx; @@ -342,7 +342,7 @@ let symbolic_value_to_string (ctx : bs_ctx) (sv : V.symbolic_value) : string = let typed_value_to_string (ctx : bs_ctx) (v : V.typed_value) : string = let env = bs_ctx_to_fmt_env ctx in - Print.Values.typed_value_to_string ~meta:(Some ctx.meta) env v + Print.Values.typed_value_to_string ~span:(Some ctx.span) env v let pure_ty_to_string (ctx : bs_ctx) (ty : ty) : string = let env = bs_ctx_to_pure_fmt_env ctx in @@ -366,7 +366,7 @@ let pure_type_decl_to_string (ctx : bs_ctx) (def : type_decl) : string = let texpression_to_string (ctx : bs_ctx) (e : texpression) : string = let env = bs_ctx_to_pure_fmt_env ctx in - PrintPure.texpression_to_string ~metadata:(Some ctx.meta) env false "" " " e + PrintPure.texpression_to_string ~spandata:(Some ctx.span) env false "" " " e let fun_id_to_string (ctx : bs_ctx) (id : A.fun_id) : string = let env = bs_ctx_to_fmt_env ctx in @@ -382,7 +382,7 @@ let fun_decl_to_string (ctx : bs_ctx) (def : Pure.fun_decl) : string = let typed_pattern_to_string (ctx : bs_ctx) (p : Pure.typed_pattern) : string = let env = bs_ctx_to_pure_fmt_env ctx in - PrintPure.typed_pattern_to_string ~meta:(Some ctx.meta) env p + PrintPure.typed_pattern_to_string ~span:(Some ctx.span) env p let ctx_get_effect_info_for_bid (ctx : bs_ctx) (bid : RegionGroupId.id option) : fun_effect_info = @@ -401,7 +401,7 @@ let abs_to_string (ctx : bs_ctx) (abs : V.abs) : string = let verbose = false in let indent = "" in let indent_incr = " " in - Print.Values.abs_to_string ~meta:(Some ctx.meta) env verbose indent + Print.Values.abs_to_string ~span:(Some ctx.span) env verbose indent indent_incr abs let bs_ctx_lookup_llbc_type_decl (id : TypeDeclId.id) (ctx : bs_ctx) : @@ -414,44 +414,44 @@ let bs_ctx_lookup_llbc_fun_decl (id : A.FunDeclId.id) (ctx : bs_ctx) : (* Some generic translation functions (we need to translate different "flavours" of types: forward types, backward types, etc.) *) -let rec translate_generic_args (meta : Meta.meta) (translate_ty : T.ty -> ty) +let rec translate_generic_args (span : Meta.span) (translate_ty : T.ty -> ty) (generics : T.generic_args) : generic_args = (* We ignore the regions: if they didn't cause trouble for the symbolic execution, then everything's fine *) let types = List.map translate_ty generics.types in let const_generics = generics.const_generics in let trait_refs = - List.map (translate_trait_ref meta translate_ty) generics.trait_refs + List.map (translate_trait_ref span translate_ty) generics.trait_refs in { types; const_generics; trait_refs } -and translate_trait_ref (meta : Meta.meta) (translate_ty : T.ty -> ty) +and translate_trait_ref (span : Meta.span) (translate_ty : T.ty -> ty) (tr : T.trait_ref) : trait_ref = - let trait_id = translate_trait_instance_id meta translate_ty tr.trait_id in - let generics = translate_generic_args meta translate_ty tr.generics in + let trait_id = translate_trait_instance_id span translate_ty tr.trait_id in + let generics = translate_generic_args span translate_ty tr.generics in let trait_decl_ref = - translate_trait_decl_ref meta translate_ty tr.trait_decl_ref + translate_trait_decl_ref span translate_ty tr.trait_decl_ref in { trait_id; generics; trait_decl_ref } -and translate_trait_decl_ref (meta : Meta.meta) (translate_ty : T.ty -> ty) +and translate_trait_decl_ref (span : Meta.span) (translate_ty : T.ty -> ty) (tr : T.trait_decl_ref) : trait_decl_ref = let decl_generics = - translate_generic_args meta translate_ty tr.decl_generics + translate_generic_args span translate_ty tr.decl_generics in { trait_decl_id = tr.trait_decl_id; decl_generics } -and translate_trait_instance_id (meta : Meta.meta) (translate_ty : T.ty -> ty) +and translate_trait_instance_id (span : Meta.span) (translate_ty : T.ty -> ty) (id : T.trait_instance_id) : trait_instance_id = let translate_trait_instance_id = - translate_trait_instance_id meta translate_ty + translate_trait_instance_id span translate_ty in match id with | T.Self -> Self | TraitImpl id -> TraitImpl id | BuiltinOrAuto _ -> (* We should have eliminated those in the prepasses *) - craise __FILE__ __LINE__ meta "Unreachable" + craise __FILE__ __LINE__ span "Unreachable" | Clause id -> Clause id | ParentClause (inst_id, decl_id, clause_id) -> let inst_id = translate_trait_instance_id inst_id in @@ -459,21 +459,22 @@ and translate_trait_instance_id (meta : Meta.meta) (translate_ty : T.ty -> ty) | ItemClause (inst_id, decl_id, item_name, clause_id) -> let inst_id = translate_trait_instance_id inst_id in ItemClause (inst_id, decl_id, item_name, clause_id) - | TraitRef tr -> TraitRef (translate_trait_ref meta translate_ty tr) + | TraitRef tr -> TraitRef (translate_trait_ref span translate_ty tr) | FnPointer _ | Closure _ -> - craise __FILE__ __LINE__ meta "Closures are not supported yet" - | UnknownTrait s -> craise __FILE__ __LINE__ meta ("Unknown trait found: " ^ s) + craise __FILE__ __LINE__ span "Closures are not supported yet" + | Unsolved _ -> craise __FILE__ __LINE__ span "Couldn't solve trait bound" + | UnknownTrait s -> craise __FILE__ __LINE__ span ("Unknown trait found: " ^ s) (** Translate a signature type - TODO: factor out the different translation functions *) -let rec translate_sty (meta : Meta.meta) (ty : T.ty) : ty = +let rec translate_sty (span : Meta.span) (ty : T.ty) : ty = let translate = translate_sty in match ty with | T.TAdt (type_id, generics) -> ( - let generics = translate_sgeneric_args meta generics in + let generics = translate_sgeneric_args span generics in match type_id with | T.TAdtId adt_id -> TAdt (TAdtId adt_id, generics) | T.TTuple -> - sanity_check __FILE__ __LINE__ (generics.const_generics = []) meta; + sanity_check __FILE__ __LINE__ (generics.const_generics = []) span; mk_simpl_tuple_ty generics.types | T.TAssumed aty -> ( match aty with @@ -482,87 +483,87 @@ let rec translate_sty (meta : Meta.meta) (ty : T.ty) : ty = match generics.types with | [ ty ] -> ty | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Box/vec/option type with incorrect number of arguments") | T.TArray -> TAdt (TAssumed TArray, generics) | T.TSlice -> TAdt (TAssumed TSlice, generics) | T.TStr -> TAdt (TAssumed TStr, generics))) | TVar vid -> TVar vid | TLiteral ty -> TLiteral ty - | TNever -> craise __FILE__ __LINE__ meta "Unreachable" - | TRef (_, rty, _) -> translate meta rty + | TNever -> craise __FILE__ __LINE__ span "Unreachable" + | TRef (_, rty, _) -> translate span rty | TRawPtr (ty, rkind) -> let mut = match rkind with RMut -> Mut | RShared -> Const in - let ty = translate meta ty in + let ty = translate span ty in let generics = { types = [ ty ]; const_generics = []; trait_refs = [] } in TAdt (TAssumed (TRawPtr mut), generics) | TTraitType (trait_ref, type_name) -> - let trait_ref = translate_strait_ref meta trait_ref in + let trait_ref = translate_strait_ref span trait_ref in TTraitType (trait_ref, type_name) | TArrow _ -> - craise __FILE__ __LINE__ meta "Arrow types are not supported yet" + craise __FILE__ __LINE__ span "Arrow types are not supported yet" -and translate_sgeneric_args (meta : Meta.meta) (generics : T.generic_args) : +and translate_sgeneric_args (span : Meta.span) (generics : T.generic_args) : generic_args = - translate_generic_args meta (translate_sty meta) generics + translate_generic_args span (translate_sty span) generics -and translate_strait_ref (meta : Meta.meta) (tr : T.trait_ref) : trait_ref = - translate_trait_ref meta (translate_sty meta) tr +and translate_strait_ref (span : Meta.span) (tr : T.trait_ref) : trait_ref = + translate_trait_ref span (translate_sty span) tr -and translate_strait_instance_id (meta : Meta.meta) (id : T.trait_instance_id) : +and translate_strait_instance_id (span : Meta.span) (id : T.trait_instance_id) : trait_instance_id = - translate_trait_instance_id meta (translate_sty meta) id + translate_trait_instance_id span (translate_sty span) id -let translate_trait_clause (meta : Meta.meta) (clause : T.trait_clause) : +let translate_trait_clause (span : Meta.span) (clause : T.trait_clause) : trait_clause = - let { T.clause_id; meta = _; trait_id; clause_generics } = clause in - let generics = translate_sgeneric_args meta clause_generics in + let { T.clause_id; span = _; trait_id; clause_generics } = clause in + let generics = translate_sgeneric_args span clause_generics in { clause_id; trait_id; generics } -let translate_strait_type_constraint (meta : Meta.meta) +let translate_strait_type_constraint (span : Meta.span) (ttc : T.trait_type_constraint) : trait_type_constraint = let { T.trait_ref; type_name; ty } = ttc in - let trait_ref = translate_strait_ref meta trait_ref in - let ty = translate_sty meta ty in + let trait_ref = translate_strait_ref span trait_ref in + let ty = translate_sty span ty in { trait_ref; type_name; ty } -let translate_predicates (meta : Meta.meta) (preds : T.predicates) : predicates +let translate_predicates (span : Meta.span) (preds : T.predicates) : predicates = let trait_type_constraints = List.map - (translate_strait_type_constraint meta) + (translate_strait_type_constraint span) preds.trait_type_constraints in { trait_type_constraints } -let translate_generic_params (meta : Meta.meta) (generics : T.generic_params) : +let translate_generic_params (span : Meta.span) (generics : T.generic_params) : generic_params = let { T.regions = _; types; const_generics; trait_clauses } = generics in - let trait_clauses = List.map (translate_trait_clause meta) trait_clauses in + let trait_clauses = List.map (translate_trait_clause span) trait_clauses in { types; const_generics; trait_clauses } -let translate_field (meta : Meta.meta) (f : T.field) : field = +let translate_field (span : Meta.span) (f : T.field) : field = let field_name = f.field_name in - let field_ty = translate_sty meta f.field_ty in + let field_ty = translate_sty span f.field_ty in { field_name; field_ty } -let translate_fields (meta : Meta.meta) (fl : T.field list) : field list = - List.map (translate_field meta) fl +let translate_fields (span : Meta.span) (fl : T.field list) : field list = + List.map (translate_field span) fl -let translate_variant (meta : Meta.meta) (v : T.variant) : variant = +let translate_variant (span : Meta.span) (v : T.variant) : variant = let variant_name = v.variant_name in - let fields = translate_fields meta v.fields in + let fields = translate_fields span v.fields in { variant_name; fields } -let translate_variants (meta : Meta.meta) (vl : T.variant list) : variant list = - List.map (translate_variant meta) vl +let translate_variants (span : Meta.span) (vl : T.variant list) : variant list = + List.map (translate_variant span) vl (** Translate a type def kind from LLBC *) -let translate_type_decl_kind (meta : Meta.meta) (kind : T.type_decl_kind) : +let translate_type_decl_kind (span : Meta.span) (kind : T.type_decl_kind) : type_decl_kind = match kind with - | T.Struct fields -> Struct (translate_fields meta fields) - | T.Enum variants -> Enum (translate_variants meta variants) + | T.Struct fields -> Struct (translate_fields span fields) + | T.Enum variants -> Enum (translate_variants span variants) | T.Opaque -> Opaque (** Translate a type definition from LLBC @@ -584,29 +585,29 @@ let translate_type_decl (ctx : Contexts.decls_ctx) (def : T.type_decl) : let name = Print.Types.name_to_string env def.name in let { T.regions; types; const_generics; trait_clauses } = def.generics in (* Can't translate types with regions for now *) - cassert __FILE__ __LINE__ (regions = []) def.item_meta.meta + cassert __FILE__ __LINE__ (regions = []) def.item_meta.span "ADTs containing borrows are not supported yet"; let trait_clauses = - List.map (translate_trait_clause def.item_meta.meta) trait_clauses + List.map (translate_trait_clause def.item_meta.span) trait_clauses in let generics = { types; const_generics; trait_clauses } in - let kind = translate_type_decl_kind def.item_meta.meta def.T.kind in - let preds = translate_predicates def.item_meta.meta def.preds in + let kind = translate_type_decl_kind def.item_meta.span def.T.kind in + let preds = translate_predicates def.item_meta.span def.preds in let is_local = def.is_local in - let meta = def.item_meta.meta in + let span = def.item_meta.span in { def_id; is_local; llbc_name; name; - meta; + span; generics; llbc_generics = def.generics; kind; preds; } -let translate_type_id (meta : Meta.meta) (id : T.type_id) : type_id = +let translate_type_id (span : Meta.span) (id : T.type_id) : type_id = match id with | TAdtId adt_id -> TAdtId adt_id | TAssumed aty -> @@ -618,7 +619,7 @@ let translate_type_id (meta : Meta.meta) (id : T.type_id) : type_id = | T.TBox -> (* Boxes have to be eliminated: this type id shouldn't be translated *) - craise __FILE__ __LINE__ meta "Unexpected box type" + craise __FILE__ __LINE__ span "Unexpected box type" in TAssumed aty | TTuple -> TTuple @@ -631,16 +632,16 @@ let translate_type_id (meta : Meta.meta) (id : T.type_id) : type_id = TODO: factor out the various translation functions. *) -let rec translate_fwd_ty (meta : Meta.meta) (type_infos : type_infos) +let rec translate_fwd_ty (span : Meta.span) (type_infos : type_infos) (ty : T.ty) : ty = - let translate = translate_fwd_ty meta type_infos in + let translate = translate_fwd_ty span type_infos in match ty with | T.TAdt (type_id, generics) -> ( - let t_generics = translate_fwd_generic_args meta type_infos generics in + let t_generics = translate_fwd_generic_args span type_infos generics in (* Eliminate boxes and simplify tuples *) match type_id with | TAdtId _ | TAssumed (TArray | TSlice | TStr) -> - let type_id = translate_type_id meta type_id in + let type_id = translate_type_id span type_id in TAdt (type_id, t_generics) | TTuple -> (* Note that if there is exactly one type, [mk_simpl_tuple_ty] is the @@ -654,15 +655,15 @@ let rec translate_fwd_ty (meta : Meta.meta) (type_infos : type_infos) (List.exists (TypesUtils.ty_has_borrows type_infos) generics.types)) - meta "ADTs containing borrows are not supported yet"; + span "ADTs containing borrows are not supported yet"; match t_generics.types with | [ bty ] -> bty | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Unreachable: box/vec/option receives exactly one type \ parameter")) | TVar vid -> TVar vid - | TNever -> craise __FILE__ __LINE__ meta "Unreachable" + | TNever -> craise __FILE__ __LINE__ span "Unreachable" | TLiteral lty -> TLiteral lty | TRef (_, rty, _) -> translate rty | TRawPtr (ty, rkind) -> @@ -671,33 +672,33 @@ let rec translate_fwd_ty (meta : Meta.meta) (type_infos : type_infos) let generics = { types = [ ty ]; const_generics = []; trait_refs = [] } in TAdt (TAssumed (TRawPtr mut), generics) | TTraitType (trait_ref, type_name) -> - let trait_ref = translate_fwd_trait_ref meta type_infos trait_ref in + let trait_ref = translate_fwd_trait_ref span type_infos trait_ref in TTraitType (trait_ref, type_name) | TArrow _ -> - craise __FILE__ __LINE__ meta "Arrow types are not supported yet" + craise __FILE__ __LINE__ span "Arrow types are not supported yet" -and translate_fwd_generic_args (meta : Meta.meta) (type_infos : type_infos) +and translate_fwd_generic_args (span : Meta.span) (type_infos : type_infos) (generics : T.generic_args) : generic_args = - translate_generic_args meta (translate_fwd_ty meta type_infos) generics + translate_generic_args span (translate_fwd_ty span type_infos) generics -and translate_fwd_trait_ref (meta : Meta.meta) (type_infos : type_infos) +and translate_fwd_trait_ref (span : Meta.span) (type_infos : type_infos) (tr : T.trait_ref) : trait_ref = - translate_trait_ref meta (translate_fwd_ty meta type_infos) tr + translate_trait_ref span (translate_fwd_ty span type_infos) tr -and translate_fwd_trait_instance_id (meta : Meta.meta) (type_infos : type_infos) +and translate_fwd_trait_instance_id (span : Meta.span) (type_infos : type_infos) (id : T.trait_instance_id) : trait_instance_id = - translate_trait_instance_id meta (translate_fwd_ty meta type_infos) id + translate_trait_instance_id span (translate_fwd_ty span type_infos) id (** Simply calls [translate_fwd_ty] *) let ctx_translate_fwd_ty (ctx : bs_ctx) (ty : T.ty) : ty = let type_infos = ctx.type_ctx.type_infos in - translate_fwd_ty ctx.meta type_infos ty + translate_fwd_ty ctx.span type_infos ty (** Simply calls [translate_fwd_generic_args] *) let ctx_translate_fwd_generic_args (ctx : bs_ctx) (generics : T.generic_args) : generic_args = let type_infos = ctx.type_ctx.type_infos in - translate_fwd_generic_args ctx.meta type_infos generics + translate_fwd_generic_args ctx.span type_infos generics (** Translate a type, when some regions may have ended. @@ -705,22 +706,22 @@ let ctx_translate_fwd_generic_args (ctx : bs_ctx) (generics : T.generic_args) : [inside_mut]: are we inside a mutable borrow? *) -let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) +let rec translate_back_ty (span : Meta.span) (type_infos : type_infos) (keep_region : T.region -> bool) (inside_mut : bool) (ty : T.ty) : ty option = - let translate = translate_back_ty meta type_infos keep_region inside_mut in + let translate = translate_back_ty span type_infos keep_region inside_mut in (* A small helper for "leave" types *) let wrap ty = if inside_mut then Some ty else None in match ty with | T.TAdt (type_id, generics) -> ( match type_id with | TAdtId _ | TAssumed (TArray | TSlice | TStr) -> - let type_id = translate_type_id meta type_id in + let type_id = translate_type_id span type_id in if inside_mut then (* We do not want to filter anything, so we translate the generics as "forward" types *) let generics = - translate_fwd_generic_args meta type_infos generics + translate_fwd_generic_args span type_infos generics in Some (TAdt (type_id, generics)) else @@ -733,7 +734,7 @@ let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) let types = List.filter_map translate generics.types in if types <> [] then let generics = - translate_fwd_generic_args meta type_infos generics + translate_fwd_generic_args span type_infos generics in Some (TAdt (type_id, generics)) else None @@ -741,12 +742,12 @@ let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) (* Don't accept ADTs (which are not tuples) with borrows for now *) cassert __FILE__ __LINE__ (not (TypesUtils.ty_has_borrows type_infos ty)) - meta "ADTs containing borrows are not supported yet"; + span "ADTs containing borrows are not supported yet"; (* Eliminate the box *) match generics.types with | [ bty ] -> translate bty | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Unreachable: boxes receive exactly one type parameter") | TTuple -> ( (* Tuples can contain borrows (which we eliminate) *) @@ -758,7 +759,7 @@ let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) * is the identity *) Some (mk_simpl_tuple_ty tys_t))) | TVar vid -> wrap (TVar vid) - | TNever -> craise __FILE__ __LINE__ meta "Unreachable" + | TNever -> craise __FILE__ __LINE__ span "Unreachable" | TLiteral lty -> wrap (TLiteral lty) | TRef (r, rty, rkind) -> ( match rkind with @@ -769,7 +770,7 @@ let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) (* Dive in, remembering the fact that we are inside a mutable borrow *) let inside_mut = true in if keep_region r then - translate_back_ty meta type_infos keep_region inside_mut rty + translate_back_ty span type_infos keep_region inside_mut rty else None) | TRawPtr _ -> (* TODO: not sure what to do here *) @@ -780,17 +781,17 @@ let rec translate_back_ty (meta : Meta.meta) (type_infos : type_infos) if inside_mut then (* Translate the trait ref as a "forward" trait ref - we do not want to filter any type *) - let trait_ref = translate_fwd_trait_ref meta type_infos trait_ref in + let trait_ref = translate_fwd_trait_ref span type_infos trait_ref in Some (TTraitType (trait_ref, type_name)) else None | TArrow _ -> - craise __FILE__ __LINE__ meta "Arrow types are not supported yet" + craise __FILE__ __LINE__ span "Arrow types are not supported yet" (** Simply calls [translate_back_ty] *) let ctx_translate_back_ty (ctx : bs_ctx) (keep_region : 'r -> bool) (inside_mut : bool) (ty : T.ty) : ty option = let type_infos = ctx.type_ctx.type_infos in - translate_back_ty ctx.meta type_infos keep_region inside_mut ty + translate_back_ty ctx.span type_infos keep_region inside_mut ty let mk_type_check_ctx (ctx : bs_ctx) : PureTypeCheck.tc_ctx = let const_generics = @@ -809,16 +810,16 @@ let mk_type_check_ctx (ctx : bs_ctx) : PureTypeCheck.tc_ctx = } let type_check_pattern (ctx : bs_ctx) (v : typed_pattern) : unit = - let meta = ctx.meta in + let span = ctx.span in let ctx = mk_type_check_ctx ctx in - let _ = PureTypeCheck.check_typed_pattern meta ctx v in + let _ = PureTypeCheck.check_typed_pattern span ctx v in () let type_check_texpression (ctx : bs_ctx) (e : texpression) : unit = if !Config.type_check_pure_code then - let meta = ctx.meta in + let span = ctx.span in let ctx = mk_type_check_ctx ctx in - PureTypeCheck.check_texpression meta ctx e + PureTypeCheck.check_texpression span ctx e let translate_fun_id_or_trait_method_ref (ctx : bs_ctx) (id : A.fun_id_or_trait_method_ref) : fun_id_or_trait_method_ref = @@ -826,7 +827,7 @@ let translate_fun_id_or_trait_method_ref (ctx : bs_ctx) | FunId fun_id -> FunId fun_id | TraitMethod (trait_ref, method_name, fun_decl_id) -> let type_infos = ctx.type_ctx.type_infos in - let trait_ref = translate_fwd_trait_ref ctx.meta type_infos trait_ref in + let trait_ref = translate_fwd_trait_ref ctx.span type_infos trait_ref in TraitMethod (trait_ref, method_name, fun_decl_id) let bs_ctx_register_forward_call (call_id : V.FunCallId.id) (forward : S.call) @@ -836,7 +837,7 @@ let bs_ctx_register_forward_call (call_id : V.FunCallId.id) (forward : S.call) let calls = ctx.calls in sanity_check __FILE__ __LINE__ (not (V.FunCallId.Map.mem call_id calls)) - ctx.meta; + ctx.span; let info = { forward; forward_inputs = args; back_funs } in let calls = V.FunCallId.Map.add call_id info calls in { ctx with calls } @@ -860,7 +861,7 @@ let bs_ctx_register_backward_call (abs : V.abs) (call_id : V.FunCallId.id) let abstractions = ctx.abstractions in sanity_check __FILE__ __LINE__ (not (V.AbstractionId.Map.mem abs.abs_id abstractions)) - ctx.meta; + ctx.span; let abstractions = V.AbstractionId.Map.add abs.abs_id (abs, back_args) abstractions in @@ -922,7 +923,7 @@ let mk_fuel_input_as_list (ctx : bs_ctx) (info : fun_effect_info) : if function_uses_fuel info then [ mk_fuel_texpression ctx.fuel ] else [] (** Small utility. *) -let compute_raw_fun_effect_info (meta : Meta.meta) +let compute_raw_fun_effect_info (span : Meta.span) (fun_infos : fun_info A.FunDeclId.Map.t) (fun_id : A.fun_id_or_trait_method_ref) (lid : V.LoopId.id option) (gid : T.RegionGroupId.id option) : fun_effect_info = @@ -941,7 +942,7 @@ let compute_raw_fun_effect_info (meta : Meta.meta) is_rec = info.is_rec || Option.is_some lid; } | FunId (FAssumed aid) -> - sanity_check __FILE__ __LINE__ (lid = None) meta; + sanity_check __FILE__ __LINE__ (lid = None) span; { can_fail = Assumed.assumed_fun_can_fail aid; stateful_group = false; @@ -966,20 +967,20 @@ let get_fun_effect_info (ctx : bs_ctx) (fun_id : A.fun_id_or_trait_method_ref) in { info with is_rec = info.is_rec || Option.is_some lid } | FunId (FAssumed _) -> - compute_raw_fun_effect_info ctx.meta ctx.fun_ctx.fun_infos fun_id lid + compute_raw_fun_effect_info ctx.span ctx.fun_ctx.fun_infos fun_id lid gid) | Some lid -> ( (* This is necessarily for the current function *) match fun_id with | FunId (FRegular fid) -> ( - sanity_check __FILE__ __LINE__ (fid = ctx.fun_decl.def_id) ctx.meta; + sanity_check __FILE__ __LINE__ (fid = ctx.fun_decl.def_id) ctx.span; (* Lookup the loop *) let lid = V.LoopId.Map.find lid ctx.loop_ids_map in let loop_info = LoopId.Map.find lid ctx.loops in match gid with | None -> loop_info.fwd_effect_info | Some gid -> RegionGroupId.Map.find gid loop_info.back_effect_infos) - | _ -> craise __FILE__ __LINE__ ctx.meta "Unreachable") + | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") (** Translate a function signature to a decomposed function signature. @@ -992,7 +993,7 @@ let get_fun_effect_info (ctx : bs_ctx) (fun_id : A.fun_id_or_trait_method_ref) We use [bid] ("backward function id") only if we split the forward and the backward functions. *) -let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) +let translate_fun_sig_with_regions_hierarchy_to_decomposed (span : Meta.span) (decls_ctx : C.decls_ctx) (fun_id : A.fun_id_or_trait_method_ref) (regions_hierarchy : T.region_var_groups) (sg : A.fun_sig) (input_names : string option list) : decomposed_fun_sig = @@ -1008,18 +1009,18 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) List.map (fun (g : T.region_var_group) -> g.id) regions_hierarchy in let ctx = - InterpreterUtils.initialize_eval_ctx meta decls_ctx region_groups + InterpreterUtils.initialize_eval_ctx span decls_ctx region_groups sg.generics.types sg.generics.const_generics in (* Compute the normalization map for the *sty* types and add it to the context *) - AssociatedTypes.ctx_add_norm_trait_types_from_preds meta ctx + AssociatedTypes.ctx_add_norm_trait_types_from_preds span ctx sg.preds.trait_type_constraints in (* Normalize the signature *) let sg = let ({ A.inputs; output; _ } : A.fun_sig) = sg in - let norm = AssociatedTypes.ctx_normalize_ty meta ctx in + let norm = AssociatedTypes.ctx_normalize_ty span ctx in let inputs = List.map norm inputs in let output = norm output in { sg with A.inputs; output } @@ -1027,12 +1028,12 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) (* Is the forward function stateful, and can it fail? *) let fwd_effect_info = - compute_raw_fun_effect_info meta fun_infos fun_id None None + compute_raw_fun_effect_info span fun_infos fun_id None None in (* Compute the forward inputs *) let fwd_fuel = mk_fuel_input_ty_as_list fwd_effect_info in let fwd_inputs_no_fuel_no_state = - List.map (translate_fwd_ty meta type_infos) sg.inputs + List.map (translate_fwd_ty span type_infos) sg.inputs in (* State input for the forward function *) let fwd_state_ty = @@ -1044,7 +1045,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) List.concat [ fwd_fuel; fwd_inputs_no_fuel_no_state; fwd_state_ty ] in (* Compute the backward output, without the effect information *) - let fwd_output = translate_fwd_ty meta type_infos sg.output in + let fwd_output = translate_fwd_ty span type_infos sg.output in (* Compute the type information for the backward function *) (* Small helper to translate types for backward functions *) @@ -1066,12 +1067,12 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) let keep_region r = match r with | T.RStatic -> raise Unimplemented - | RErased -> craise __FILE__ __LINE__ meta "Unexpected erased region" - | RBVar _ -> craise __FILE__ __LINE__ meta "Unexpected bound region" + | RErased -> craise __FILE__ __LINE__ span "Unexpected erased region" + | RBVar _ -> craise __FILE__ __LINE__ span "Unexpected bound region" | RFVar rid -> T.RegionId.Set.mem rid gr_regions in let inside_mut = false in - translate_back_ty meta type_infos keep_region inside_mut ty + translate_back_ty span type_infos keep_region inside_mut ty in let translate_back_inputs_for_gid (gid : T.RegionGroupId.id) : ty list = (* For now we don't supported nested borrows, so we check that there @@ -1079,7 +1080,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) let parents = list_ancestor_region_groups regions_hierarchy gid in cassert __FILE__ __LINE__ (T.RegionGroupId.Set.is_empty parents) - meta "Nested borrows are not supported yet"; + span "Nested borrows are not supported yet"; (* For now, we don't allow nested borrows, so the additional inputs to the backward function can only come from borrows that were returned like in (for the backward function we introduce for 'a): @@ -1147,7 +1148,7 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) RegionGroupId.id * back_sg_info = let gid = rg.id in let back_effect_info = - compute_raw_fun_effect_info meta fun_infos fun_id None (Some gid) + compute_raw_fun_effect_info span fun_infos fun_id None (Some gid) in let inputs_no_state = translate_back_inputs_for_gid gid in let inputs_no_state = @@ -1236,15 +1237,15 @@ let translate_fun_sig_with_regions_hierarchy_to_decomposed (meta : Meta.meta) else false in let info = { fwd_info; effect_info = fwd_effect_info; ignore_output } in - sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf info) meta; + sanity_check __FILE__ __LINE__ (fun_sig_info_is_wf info) span; info in (* Generic parameters *) - let generics = translate_generic_params meta sg.generics in + let generics = translate_generic_params span sg.generics in (* Return *) - let preds = translate_predicates meta sg.preds in + let preds = translate_predicates span sg.preds in { generics; llbc_generics = sg.generics; @@ -1262,10 +1263,10 @@ let translate_fun_sig_to_decomposed (decls_ctx : C.decls_ctx) let regions_hierarchy = FunIdMap.find (FRegular fun_id) decls_ctx.fun_ctx.regions_hierarchies in - let meta = - (FunDeclId.Map.find fun_id decls_ctx.fun_ctx.fun_decls).item_meta.meta + let span = + (FunDeclId.Map.find fun_id decls_ctx.fun_ctx.fun_decls).item_meta.span in - translate_fun_sig_with_regions_hierarchy_to_decomposed meta decls_ctx + translate_fun_sig_with_regions_hierarchy_to_decomposed span decls_ctx (FunId (FRegular fun_id)) regions_hierarchy sg input_names let translate_fun_sig_from_decl_to_decomposed (decls_ctx : C.decls_ctx) @@ -1545,18 +1546,18 @@ let lookup_var_for_symbolic_value (sv : V.symbolic_value) (ctx : bs_ctx) : var = match V.SymbolicValueId.Map.find_opt sv.sv_id ctx.sv_to_var with | Some v -> v | None -> - craise __FILE__ __LINE__ ctx.meta + craise __FILE__ __LINE__ ctx.span ("Could not find var for symbolic value: " ^ V.SymbolicValueId.to_string sv.sv_id) (** Peel boxes as long as the value is of the form [Box<T>] *) -let rec unbox_typed_value (meta : Meta.meta) (v : V.typed_value) : V.typed_value +let rec unbox_typed_value (span : Meta.span) (v : V.typed_value) : V.typed_value = match (v.value, v.ty) with | V.VAdt av, T.TAdt (T.TAssumed T.TBox, _) -> ( match av.field_values with - | [ bv ] -> unbox_typed_value meta bv - | _ -> craise __FILE__ __LINE__ meta "Unreachable") + | [ bv ] -> unbox_typed_value span bv + | _ -> craise __FILE__ __LINE__ span "Unreachable") | _ -> v (** Translate a symbolic value. @@ -1595,7 +1596,7 @@ let symbolic_value_to_texpression (ctx : bs_ctx) (sv : V.symbolic_value) : let rec typed_value_to_texpression (ctx : bs_ctx) (ectx : C.eval_ctx) (v : V.typed_value) : texpression = (* We need to ignore boxes *) - let v = unbox_typed_value ctx.meta v in + let v = unbox_typed_value ctx.span v in let translate = typed_value_to_texpression ctx ectx in (* Translate the type *) let ty = ctx_translate_fwd_ty ctx v.ty in @@ -1609,12 +1610,12 @@ let rec typed_value_to_texpression (ctx : bs_ctx) (ectx : C.eval_ctx) (* Eliminate the tuple wrapper if it is a tuple with exactly one field *) match v.ty with | TAdt (TTuple, _) -> - sanity_check __FILE__ __LINE__ (variant_id = None) ctx.meta; - mk_simpl_tuple_texpression ctx.meta field_values + sanity_check __FILE__ __LINE__ (variant_id = None) ctx.span; + mk_simpl_tuple_texpression ctx.span field_values | _ -> (* Retrieve the type and the translated generics from the translated type (simpler this way) *) - let adt_id, generics = ty_as_adt ctx.meta ty in + let adt_id, generics = ty_as_adt ctx.span ty in (* Create the constructor *) let qualif_id = AdtCons { adt_id; variant_id = av.variant_id } in let qualif = { id = qualif_id; generics } in @@ -1625,26 +1626,26 @@ let rec typed_value_to_texpression (ctx : bs_ctx) (ectx : C.eval_ctx) let cons_ty = mk_arrows field_tys ty in let cons = { e = cons_e; ty = cons_ty } in (* Apply the constructor *) - mk_apps ctx.meta cons field_values) - | VBottom -> craise __FILE__ __LINE__ ctx.meta "Unexpected bottom value" + mk_apps ctx.span cons field_values) + | VBottom -> craise __FILE__ __LINE__ ctx.span "Unexpected bottom value" | VLoan lc -> ( match lc with | VSharedLoan (_, v) -> translate v - | VMutLoan _ -> craise __FILE__ __LINE__ ctx.meta "Unreachable") + | VMutLoan _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") | VBorrow bc -> ( match bc with | VSharedBorrow bid -> (* Lookup the shared value in the context, and continue *) let sv = - InterpreterBorrowsCore.lookup_shared_value ctx.meta ectx bid + InterpreterBorrowsCore.lookup_shared_value ctx.span ectx bid in translate sv | VReservedMutBorrow bid -> (* Same as for shared borrows. However, note that we use reserved borrows - * only in *meta-data*: a value *actually used* in the translation can't come + * only in *span-data*: a value *actually used* in the translation can't come * from an unpromoted reserved borrow *) let sv = - InterpreterBorrowsCore.lookup_shared_value ctx.meta ectx bid + InterpreterBorrowsCore.lookup_shared_value ctx.span ectx bid in translate sv | VMutBorrow (_, v) -> @@ -1665,7 +1666,7 @@ let rec typed_value_to_texpression (ctx : bs_ctx) (ectx : C.eval_ctx) value (** Explore an abstraction value and convert it to a consumed value - by collecting all the meta-values from the ended *loans*. + by collecting all the span-values from the ended *loans*. Consumed values are rvalues because when an abstraction ends we introduce a call to a backward function in the synthesized program, @@ -1691,7 +1692,7 @@ let rec typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) let adt_id, _ = TypesUtils.ty_as_adt av.ty in match adt_id with | TAdtId _ | TAssumed (TBox | TArray | TSlice | TStr) -> - cassert __FILE__ __LINE__ (field_values = []) ctx.meta + cassert __FILE__ __LINE__ (field_values = []) ctx.span "ADTs containing borrows are not supported yet"; None | TTuple -> @@ -1700,9 +1701,9 @@ let rec typed_avalue_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) else (* Note that if there is exactly one field value, * [mk_simpl_tuple_rvalue] is the identity *) - let rv = mk_simpl_tuple_texpression ctx.meta field_values in + let rv = mk_simpl_tuple_texpression ctx.span field_values in Some rv) - | ABottom -> craise __FILE__ __LINE__ ctx.meta "Unreachable" + | ABottom -> craise __FILE__ __LINE__ ctx.span "Unreachable" | ALoan lc -> aloan_content_to_consumed ctx ectx lc | ABorrow bc -> aborrow_content_to_consumed ctx bc | ASymbolic aproj -> aproj_to_consumed ctx aproj @@ -1720,10 +1721,10 @@ and aloan_content_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) (lc : V.aloan_content) : texpression option = match lc with | AMutLoan (_, _) | ASharedLoan (_, _, _) -> - craise __FILE__ __LINE__ ctx.meta "Unreachable" - | AEndedMutLoan { child = _; given_back = _; given_back_meta } -> - (* Return the meta-value *) - Some (typed_value_to_texpression ctx ectx given_back_meta) + craise __FILE__ __LINE__ ctx.span "Unreachable" + | AEndedMutLoan { child = _; given_back = _; given_back_span } -> + (* Return the span-value *) + Some (typed_value_to_texpression ctx ectx given_back_span) | AEndedSharedLoan (_, _) -> (* We don't dive into shared loans: there is nothing to give back * inside (note that there could be a mutable borrow in the shared @@ -1732,7 +1733,7 @@ and aloan_content_to_consumed (ctx : bs_ctx) (ectx : C.eval_ctx) None | AIgnoredMutLoan (_, _) -> (* There can be *inner* not ended mutable loans, but not outer ones *) - craise __FILE__ __LINE__ ctx.meta "Unreachable" + craise __FILE__ __LINE__ ctx.span "Unreachable" | AEndedIgnoredMutLoan _ -> (* This happens with nested borrows: we need to dive in *) raise Unimplemented @@ -1744,7 +1745,7 @@ and aborrow_content_to_consumed (_ctx : bs_ctx) (bc : V.aborrow_content) : texpression option = match bc with | V.AMutBorrow (_, _) | ASharedBorrow _ | AIgnoredMutBorrow (_, _) -> - craise __FILE__ __LINE__ _ctx.meta "Unreachable" + craise __FILE__ __LINE__ _ctx.span "Unreachable" | AEndedMutBorrow (_, _) -> (* We collect consumed values: ignore *) None @@ -1763,7 +1764,7 @@ and aproj_to_consumed (ctx : bs_ctx) (aproj : V.aproj) : texpression option = | V.AEndedProjLoans (_, [ (mnv, child_aproj) ]) -> sanity_check __FILE__ __LINE__ (child_aproj = AIgnoredProjBorrows) - ctx.meta; + ctx.span; (* The symbolic value was updated *) Some (symbolic_value_to_texpression ctx mnv) | V.AEndedProjLoans (_, _) -> @@ -1772,7 +1773,7 @@ and aproj_to_consumed (ctx : bs_ctx) (aproj : V.aproj) : texpression option = raise Unimplemented | AEndedProjBorrows _ -> (* We consider consumed values *) None | AIgnoredProjBorrows | AProjLoans (_, _) | AProjBorrows (_, _) -> - craise __FILE__ __LINE__ ctx.meta "Unreachable" + craise __FILE__ __LINE__ ctx.span "Unreachable" (** Convert the abstraction values in an abstraction to consumed values. @@ -1792,7 +1793,7 @@ let translate_mprojection_elem (pe : E.projection_elem) : let translate_mprojection (p : E.projection) : mprojection = List.filter_map translate_mprojection_elem p -(** Translate a "meta"-place *) +(** Translate a "span"-place *) let translate_mplace (p : S.mplace) : mplace = let var_id = p.bv.index in let name = p.bv.name in @@ -1803,7 +1804,7 @@ let translate_opt_mplace (p : S.mplace option) : mplace option = match p with None -> None | Some p -> Some (translate_mplace p) (** Explore an abstraction value and convert it to a given back value - by collecting all the meta-values from the ended *borrows*. + by collecting all the span-values from the ended *borrows*. Given back values are patterns, because when an abstraction ends, we introduce a call to a backward function in the synthesized program, @@ -1813,7 +1814,7 @@ let translate_opt_mplace (p : S.mplace option) : mplace option = ^^^^^^^^ ]} - [mp]: it is possible to provide some meta-place information, to guide + [mp]: it is possible to provide some span-place information, to guide the heuristics which later find pretty names for the variables. *) let rec typed_avalue_to_given_back (mp : mplace option) (av : V.typed_avalue) @@ -1822,7 +1823,7 @@ let rec typed_avalue_to_given_back (mp : mplace option) (av : V.typed_avalue) match av.value with | AAdt adt_v -> ( (* Translate the field values *) - (* For now we forget the meta-place information so that it doesn't get used + (* For now we forget the span-place information so that it doesn't get used * by several fields (which would then all have the same name...), but we * might want to do something smarter *) let mp = None in @@ -1838,20 +1839,20 @@ let rec typed_avalue_to_given_back (mp : mplace option) (av : V.typed_avalue) let adt_id, _ = TypesUtils.ty_as_adt av.ty in match adt_id with | TAdtId _ | TAssumed (TBox | TArray | TSlice | TStr) -> - cassert __FILE__ __LINE__ (field_values = []) ctx.meta + cassert __FILE__ __LINE__ (field_values = []) ctx.span "ADTs with borrows are not supported yet"; (ctx, None) | TTuple -> (* Return *) let variant_id = adt_v.variant_id in - sanity_check __FILE__ __LINE__ (variant_id = None) ctx.meta; + sanity_check __FILE__ __LINE__ (variant_id = None) ctx.span; if field_values = [] then (ctx, None) else (* Note that if there is exactly one field value, [mk_simpl_tuple_pattern] * is the identity *) let lv = mk_simpl_tuple_pattern field_values in (ctx, Some lv)) - | ABottom -> craise __FILE__ __LINE__ ctx.meta "Unreachable" + | ABottom -> craise __FILE__ __LINE__ ctx.span "Unreachable" | ALoan lc -> aloan_content_to_given_back mp lc ctx | ABorrow bc -> aborrow_content_to_given_back mp bc ctx | ASymbolic aproj -> aproj_to_given_back mp aproj ctx @@ -1867,14 +1868,14 @@ and aloan_content_to_given_back (_mp : mplace option) (lc : V.aloan_content) (ctx : bs_ctx) : bs_ctx * typed_pattern option = match lc with | AMutLoan (_, _) | ASharedLoan (_, _, _) -> - craise __FILE__ __LINE__ ctx.meta "Unreachable" - | AEndedMutLoan { child = _; given_back = _; given_back_meta = _ } + craise __FILE__ __LINE__ ctx.span "Unreachable" + | AEndedMutLoan { child = _; given_back = _; given_back_span = _ } | AEndedSharedLoan (_, _) -> (* We consider given back values, and thus ignore those *) (ctx, None) | AIgnoredMutLoan (_, _) -> (* There can be *inner* not ended mutable loans, but not outer ones *) - craise __FILE__ __LINE__ ctx.meta "Unreachable" + craise __FILE__ __LINE__ ctx.span "Unreachable" | AEndedIgnoredMutLoan _ -> (* This happens with nested borrows: we need to dive in *) raise Unimplemented @@ -1886,9 +1887,9 @@ and aborrow_content_to_given_back (mp : mplace option) (bc : V.aborrow_content) (ctx : bs_ctx) : bs_ctx * typed_pattern option = match bc with | V.AMutBorrow (_, _) | ASharedBorrow _ | AIgnoredMutBorrow (_, _) -> - craise __FILE__ __LINE__ ctx.meta "Unreachable" + craise __FILE__ __LINE__ ctx.span "Unreachable" | AEndedMutBorrow (msv, _) -> - (* Return the meta-symbolic-value *) + (* Return the span-symbolic-value *) let ctx, var = fresh_var_for_symbolic_value msv ctx in (ctx, Some (mk_typed_pattern_from_var var mp)) | AEndedIgnoredMutBorrow _ -> @@ -1908,14 +1909,14 @@ and aproj_to_given_back (mp : mplace option) (aproj : V.aproj) (ctx : bs_ctx) : (List.for_all (fun (_, aproj) -> aproj = V.AIgnoredProjBorrows) child_projs) - ctx.meta "Nested borrows are not supported yet"; + ctx.span "Nested borrows are not supported yet"; (ctx, None) | AEndedProjBorrows mv -> - (* Return the meta-value *) + (* Return the span-value *) let ctx, var = fresh_var_for_symbolic_value mv ctx in (ctx, Some (mk_typed_pattern_from_var var mp)) | AIgnoredProjBorrows | AProjLoans (_, _) | AProjBorrows (_, _) -> - craise __FILE__ __LINE__ ctx.meta "Unreachable" + craise __FILE__ __LINE__ ctx.span "Unreachable" (** Convert the abstraction values in an abstraction to given back values. @@ -1953,11 +1954,11 @@ let get_abs_ancestors (ctx : bs_ctx) (abs : V.abs) (call_id : V.FunCallId.id) : let abs_ancestors = list_ancestor_abstractions ctx abs call_id in (call_info.forward, abs_ancestors) -(** Add meta-information to an expression *) -let mk_emeta_symbolic_assignments (vars : var list) (values : texpression list) +(** Add span-information to an expression *) +let mk_espan_symbolic_assignments (vars : var list) (values : texpression list) (e : texpression) : texpression = let var_values = List.combine (List.map var_get_id vars) values in - if var_values <> [] then mk_emeta (SymbolicAssignments var_values) e else e + if var_values <> [] then mk_espan (SymbolicAssignments var_values) e else e (** Derive naming information from a context. @@ -1999,8 +2000,8 @@ let eval_ctx_to_symbolic_assignments_info (ctx : bs_ctx) (* Return the computed information *) !info -let translate_error (meta : Meta.meta option) (msg : string) : texpression = - { e = EError (meta, msg); ty = Error } +let translate_error (span : Meta.span option) (msg : string) : texpression = + { e = EError (span, msg); ty = Error } let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = match e with @@ -2020,7 +2021,7 @@ let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = | Expansion (p, sv, exp) -> translate_expansion p sv exp ctx | IntroSymbolic (ectx, p, sv, v, e) -> translate_intro_symbolic ectx p sv v e ctx - | Meta (meta, e) -> translate_emeta meta e ctx + | Meta (span, e) -> translate_espan span e ctx | ForwardEnd (ectx, loop_input_values, e, back_e) -> (* Translate the end of a function, or the end of a loop. @@ -2028,7 +2029,7 @@ let rec translate_expression (e : S.expression) (ctx : bs_ctx) : texpression = *) translate_forward_end ectx loop_input_values e back_e ctx | Loop loop -> translate_loop loop ctx - | Error (meta, msg) -> translate_error meta msg + | Error (span, msg) -> translate_error span msg and translate_panic (ctx : bs_ctx) : texpression = Option.get ctx.mk_panic @@ -2047,9 +2048,9 @@ and translate_return (ectx : C.eval_ctx) (opt_v : V.typed_value option) and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) (ctx : bs_ctx) : texpression = - sanity_check __FILE__ __LINE__ (is_continue = ctx.inside_loop) ctx.meta; + sanity_check __FILE__ __LINE__ (is_continue = ctx.inside_loop) ctx.span; let loop_id = V.LoopId.Map.find loop_id ctx.loop_ids_map in - sanity_check __FILE__ __LINE__ (loop_id = Option.get ctx.loop_id) ctx.meta; + sanity_check __FILE__ __LINE__ (loop_id = Option.get ctx.loop_id) ctx.span; (* Lookup the loop information *) let loop_id = Option.get ctx.loop_id in @@ -2073,7 +2074,7 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) match ctx.backward_outputs with Some outputs -> outputs | None -> [] in let field_values = List.map mk_texpression_from_var backward_outputs in - mk_simpl_tuple_texpression ctx.meta field_values + mk_simpl_tuple_texpression ctx.span field_values in (* We may need to return a state @@ -2087,11 +2088,11 @@ and translate_return_with_loop (loop_id : V.LoopId.id) (is_continue : bool) let output = if effect_info.stateful then let state_rvalue = mk_state_texpression ctx.state_var in - mk_simpl_tuple_texpression ctx.meta [ state_rvalue; output ] + mk_simpl_tuple_texpression ctx.span [ state_rvalue; output ] else output in (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) - mk_emeta (Tag "return_with_loop") (mk_result_ok_texpression ctx.meta output) + mk_espan (Tag "return_with_loop") (mk_result_ok_texpression ctx.span output) and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : texpression = @@ -2142,7 +2143,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let sg = Option.get call.sg in let decls_ctx = ctx.decls_ctx in let dsg = - translate_fun_sig_with_regions_hierarchy_to_decomposed ctx.meta + translate_fun_sig_with_regions_hierarchy_to_decomposed ctx.span decls_ctx fid call.regions_hierarchy sg (List.map (fun _ -> None) sg.inputs) in @@ -2156,7 +2157,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : ctx_translate_fwd_generic_args ctx all_generics in let tr_self = - translate_fwd_trait_instance_id ctx.meta + translate_fwd_trait_instance_id ctx.span ctx.type_ctx.type_infos tr_self in (tr_self, all_generics) @@ -2188,7 +2189,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : | PeIdent (s, _) -> s | PeImpl _ -> (* We shouldn't get there *) - craise __FILE__ __LINE__ decl.item_meta.meta "Unexpected") + craise __FILE__ __LINE__ decl.item_meta.span "Unexpected") in name ^ "_back" in @@ -2276,7 +2277,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : | S.Unop E.Neg -> ( match args with | [ arg ] -> - let int_ty = ty_as_integer ctx.meta arg.ty in + let int_ty = ty_as_integer ctx.span arg.ty in (* Note that negation can lead to an overflow and thus fail (it * is thus monadic) *) let effect_info = @@ -2291,7 +2292,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in let dest = mk_typed_pattern_from_var dest dest_mplace in (ctx, Unop (Neg int_ty), effect_info, args, dest) - | _ -> craise __FILE__ __LINE__ ctx.meta "Unreachable") + | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") | S.Unop (E.Cast cast_kind) -> ( match cast_kind with | CastScalar (src_ty, tgt_ty) -> @@ -2309,16 +2310,16 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let dest = mk_typed_pattern_from_var dest dest_mplace in (ctx, Unop (Cast (src_ty, tgt_ty)), effect_info, args, dest) | CastFnPtr _ -> - craise __FILE__ __LINE__ ctx.meta "TODO: function casts") + craise __FILE__ __LINE__ ctx.span "TODO: function casts") | S.Binop binop -> ( match args with | [ arg0; arg1 ] -> - let int_ty0 = ty_as_integer ctx.meta arg0.ty in - let int_ty1 = ty_as_integer ctx.meta arg1.ty in + let int_ty0 = ty_as_integer ctx.span arg0.ty in + let int_ty1 = ty_as_integer ctx.span arg1.ty in (match binop with (* The Rust compiler accepts bitshifts for any integer type combination for ty0, ty1 *) | E.Shl | E.Shr -> () - | _ -> sanity_check __FILE__ __LINE__ (int_ty0 = int_ty1) ctx.meta); + | _ -> sanity_check __FILE__ __LINE__ (int_ty0 = int_ty1) ctx.span); let effect_info = { can_fail = ExpressionsUtils.binop_can_fail binop; @@ -2331,7 +2332,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : let ctx, dest = fresh_var_for_symbolic_value call.dest ctx in let dest = mk_typed_pattern_from_var dest dest_mplace in (ctx, Binop (binop, int_ty0), effect_info, args, dest) - | _ -> craise __FILE__ __LINE__ ctx.meta "Unreachable") + | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable") in let func = { id = FunOrOp fun_id; generics } in let input_tys = (List.map (fun (x : texpression) -> x.ty)) args in @@ -2340,7 +2341,7 @@ and translate_function_call (call : S.call) (e : S.expression) (ctx : bs_ctx) : in let func_ty = mk_arrows input_tys ret_ty in let func = { e = Qualif func; ty = func_ty } in - let call = mk_apps ctx.meta func args in + let call = mk_apps ctx.span func args in (* Translate the next expression *) let next_e = translate_expression e ctx in (* Put together *) @@ -2374,7 +2375,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) ^ "\n- loop_id: " ^ Print.option_to_string Pure.LoopId.to_string ctx.loop_id ^ "\n- eval_ctx:\n" - ^ eval_ctx_to_string ~meta:(Some ctx.meta) ectx + ^ eval_ctx_to_string ~span:(Some ctx.span) ectx ^ "\n- abs:\n" ^ abs_to_string ctx abs ^ "\n")); (* When we end an input abstraction, this input abstraction gets back @@ -2388,7 +2389,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) for a parent backward function. *) let bid = Option.get ctx.bid in - sanity_check __FILE__ __LINE__ (rg_id = bid) ctx.meta; + sanity_check __FILE__ __LINE__ (rg_id = bid) ctx.span; (* First, introduce the given back variables. @@ -2438,7 +2439,7 @@ and translate_end_abstraction_synth_input (ectx : C.eval_ctx) (abs : V.abs) (fun (var, v) -> sanity_check __FILE__ __LINE__ ((var : var).ty = (v : texpression).ty) - ctx.meta) + ctx.span) variables_values; (* Translate the next expression *) let next_e = translate_expression e ctx in @@ -2459,7 +2460,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) | S.Fun (fun_id, _) -> fun_id | Unop _ | Binop _ -> (* Those don't have backward functions *) - craise __FILE__ __LINE__ ctx.meta "Unreachable" + craise __FILE__ __LINE__ ctx.span "Unreachable" in let effect_info = get_fun_effect_info ctx fun_id None (Some rg_id) in (* Retrieve the values consumed upon ending the loans inside this @@ -2479,7 +2480,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) let back_inputs = List.append back_inputs back_state in (* Retrieve the values given back by this function: those are the output * values. We rely on the fact that there are no nested borrows to use the - * meta-place information from the input values given to the forward function + * span-place information from the input values given to the forward function * (we need to add [None] for the return avalue) *) let output_mpl = List.append (List.map translate_opt_mplace call.args_places) [ None ] @@ -2521,7 +2522,7 @@ and translate_end_abstraction_fun_call (ectx : C.eval_ctx) (abs : V.abs) ^ "\nfunc type: " ^ pure_ty_to_string ctx func.ty ^ "\n\nargs:\n" ^ String.concat "\n" args)); - let call = mk_apps ctx.meta func args in + let call = mk_apps ctx.span func args in mk_let effect_info.can_fail output call next_e and translate_end_abstraction_identity (ectx : C.eval_ctx) (abs : V.abs) @@ -2532,8 +2533,8 @@ and translate_end_abstraction_identity (ectx : C.eval_ctx) (abs : V.abs) (* We can do this simply by checking that it consumes and gives back nothing *) let inputs = abs_to_consumed ctx ectx abs in let ctx, outputs = abs_to_given_back None abs ctx in - sanity_check __FILE__ __LINE__ (inputs = []) ctx.meta; - sanity_check __FILE__ __LINE__ (outputs = []) ctx.meta; + sanity_check __FILE__ __LINE__ (inputs = []) ctx.span; + sanity_check __FILE__ __LINE__ (outputs = []) ctx.span; (* Translate the next expression *) translate_expression e ctx @@ -2575,10 +2576,10 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) (* Retrieve the values consumed upon ending the loans inside this * abstraction: as there are no nested borrows, there should be none. *) let consumed = abs_to_consumed ctx ectx abs in - cassert __FILE__ __LINE__ (consumed = []) ctx.meta + cassert __FILE__ __LINE__ (consumed = []) ctx.span "Nested borrows are not supported yet"; (* Retrieve the values given back upon ending this abstraction - note that - * we don't provide meta-place information, because those assignments will + * we don't provide span-place information, because those assignments will * be inlined anyway... *) log#ldebug (lazy ("abs: " ^ abs_to_string ctx abs)); let ctx, given_back = abs_to_given_back_no_mp abs ctx in @@ -2594,7 +2595,7 @@ and translate_end_abstraction_synth_ret (ectx : C.eval_ctx) (abs : V.abs) ^ pure_ty_to_string ctx given_back.ty ^ "\n- sig input ty: " ^ pure_ty_to_string ctx input.ty)); - sanity_check __FILE__ __LINE__ (given_back.ty = input.ty) ctx.meta) + sanity_check __FILE__ __LINE__ (given_back.ty = input.ty) ctx.span) given_back_inputs; (* Translate the next expression *) let next_e = translate_expression e ctx in @@ -2611,7 +2612,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) texpression = let vloop_id = loop_id in let loop_id = V.LoopId.Map.find loop_id ctx.loop_ids_map in - sanity_check __FILE__ __LINE__ (loop_id = Option.get ctx.loop_id) ctx.meta; + sanity_check __FILE__ __LINE__ (loop_id = Option.get ctx.loop_id) ctx.span; let rg_id = Option.get rg_id in (* There are two cases depending on the [abs_kind] (whether this is a synth input or a regular loop call) *) @@ -2681,8 +2682,8 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) match func with | None -> next_e | Some func -> - let call = mk_apps ctx.meta func args in - (* Add meta-information - this is slightly hacky: we look at the + let call = mk_apps ctx.span func args in + (* Add span-information - this is slightly hacky: we look at the values consumed by the abstraction (note that those come from *before* we applied the fixed-point context) and use them to guide the naming of the output vars. @@ -2708,7 +2709,7 @@ and translate_end_abstraction_loop (ectx : C.eval_ctx) (abs : V.abs) var_values in let vars, values = List.split var_values in - mk_emeta_symbolic_assignments vars values next_e + mk_espan_symbolic_assignments vars values next_e else next_e in @@ -2738,7 +2739,7 @@ and translate_assertion (ectx : C.eval_ctx) (v : V.typed_value) in let func_ty = mk_arrow (TLiteral TBool) mk_unit_ty in let func = { e = Qualif func; ty = func_ty } in - let assertion = mk_apps ctx.meta func args in + let assertion = mk_apps ctx.span func args in mk_let monadic (mk_dummy_pattern mk_unit_ty) assertion next_e and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) @@ -2753,7 +2754,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) | V.SeLiteral _ -> (* We do not *register* symbolic expansions to literal values in the symbolic ADT *) - craise __FILE__ __LINE__ ctx.meta "Unreachable" + craise __FILE__ __LINE__ ctx.span "Unreachable" | SeMutRef (_, nsv) | SeSharedRef (_, nsv) -> (* The (mut/shared) borrow type is extracted to identity: we thus simply introduce an reassignment *) @@ -2766,11 +2767,11 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) next_e | SeAdt _ -> (* Should be in the [ExpandAdt] case *) - craise __FILE__ __LINE__ ctx.meta "Unreachable") + craise __FILE__ __LINE__ ctx.span "Unreachable") | ExpandAdt branches -> ( (* We don't do the same thing if there is a branching or not *) match branches with - | [] -> craise __FILE__ __LINE__ ctx.meta "Unreachable" + | [] -> craise __FILE__ __LINE__ ctx.span "Unreachable" | [ (variant_id, svl, branch) ] when not (TypesUtils.ty_is_custom_adt sv.V.sv_ty @@ -2811,7 +2812,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) (* Sanity check *) sanity_check __FILE__ __LINE__ (List.for_all (fun br -> br.branch.ty = ty) branches) - ctx.meta; + ctx.span; (* Return *) { e; ty }) | ExpandBool (true_e, false_e) -> @@ -2831,7 +2832,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) ^ pure_ty_to_string ctx true_e.ty ^ "\n\nfalse_e.ty: " ^ pure_ty_to_string ctx false_e.ty)); - sanity_check __FILE__ __LINE__ (ty = false_e.ty) ctx.meta; + sanity_check __FILE__ __LINE__ (ty = false_e.ty) ctx.span; { e; ty } | ExpandInt (int_ty, branches, otherwise) -> let translate_branch ((v, branch_e) : V.scalar_value * S.expression) : @@ -2858,7 +2859,7 @@ and translate_expansion (p : S.mplace option) (sv : V.symbolic_value) let ty = otherwise.branch.ty in sanity_check __FILE__ __LINE__ (List.for_all (fun (br : match_branch) -> br.branch.ty = ty) branches) - ctx.meta; + ctx.span; { e; ty } (* Translate and [ExpandAdt] when there is no branching (i.e., one branch). @@ -2928,14 +2929,14 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value) * field. * We use the [dest] variable in order not to have to recompute * the type of the result of the projection... *) - let adt_id, generics = ty_as_adt ctx.meta scrutinee.ty in + let adt_id, generics = ty_as_adt ctx.span scrutinee.ty in let gen_field_proj (field_id : FieldId.id) (dest : var) : texpression = let proj_kind = { adt_id; field_id } in let qualif = { id = Proj proj_kind; generics } in let proj_e = Qualif qualif in let proj_ty = mk_arrow scrutinee.ty dest.ty in let proj = { e = proj_e; ty = proj_ty } in - mk_app ctx.meta proj scrutinee + mk_app ctx.span proj scrutinee in let id_var_pairs = FieldId.mapi (fun fid v -> (fid, v)) vars in let monadic = false in @@ -2956,7 +2957,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value) let var = match vars with | [ v ] -> v - | _ -> craise __FILE__ __LINE__ ctx.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ ctx.span "Unreachable" in (* We simply introduce an assignment - the box type is the * identity when extracted ([box a = a]) *) @@ -2970,7 +2971,7 @@ and translate_ExpandAdt_one_branch (sv : V.symbolic_value) * through the functions provided by the API (note that we don't * know how to expand values like vectors or arrays, because they have a variable number * of fields!) *) - craise __FILE__ __LINE__ ctx.meta + craise __FILE__ __LINE__ ctx.span "Attempt to expand a non-expandable value" and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option) @@ -3008,7 +3009,7 @@ and translate_intro_symbolic (ectx : C.eval_ctx) (p : S.mplace option) | VaCgValue cg_id -> { e = CVar cg_id; ty = var.ty } | VaTraitConstValue (trait_ref, const_name) -> let type_infos = ctx.type_ctx.type_infos in - let trait_ref = translate_fwd_trait_ref ctx.meta type_infos trait_ref in + let trait_ref = translate_fwd_trait_ref ctx.span type_infos trait_ref in let qualif_id = TraitConst (trait_ref, const_name) in let qualif = { id = qualif_id; generics = empty_generic_args } in { e = Qualif qualif; ty = var.ty } @@ -3065,16 +3066,16 @@ and translate_forward_end (ectx : C.eval_ctx) let field_values = List.map mk_texpression_from_var backward_outputs in - mk_simpl_tuple_texpression ctx.meta field_values + mk_simpl_tuple_texpression ctx.span field_values in let output = if effect_info.stateful then let state_rvalue = mk_state_texpression ctx.state_var in - mk_simpl_tuple_texpression ctx.meta [ state_rvalue; output ] + mk_simpl_tuple_texpression ctx.span [ state_rvalue; output ] else output in (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) - mk_result_ok_texpression ctx.meta output + mk_result_ok_texpression ctx.span output in let mk_panic = (* TODO: we should use a [Fail] function *) @@ -3083,12 +3084,12 @@ and translate_forward_end (ectx : C.eval_ctx) (* Create the [Fail] value *) let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in let ret_v = - mk_result_fail_texpression_with_error_id ctx.meta + mk_result_fail_texpression_with_error_id ctx.span error_failure_id ret_ty in ret_v else - mk_result_fail_texpression_with_error_id ctx.meta + mk_result_fail_texpression_with_error_id ctx.span error_failure_id output_ty in let output = @@ -3194,7 +3195,7 @@ and translate_forward_end (ectx : C.eval_ctx) else pure_fwd_var :: back_vars in let vars = List.map mk_texpression_from_var vars in - let ret = mk_simpl_tuple_texpression ctx.meta vars in + let ret = mk_simpl_tuple_texpression ctx.span vars in (* Introduce a fresh input state variable for the forward expression *) let _ctx, state_var, state_pat = @@ -3205,8 +3206,8 @@ and translate_forward_end (ectx : C.eval_ctx) in let state_var = List.map mk_texpression_from_var state_var in - let ret = mk_simpl_tuple_texpression ctx.meta (state_var @ [ ret ]) in - let ret = mk_result_ok_texpression ctx.meta ret in + let ret = mk_simpl_tuple_texpression ctx.span (state_var @ [ ret ]) in + let ret = mk_result_ok_texpression ctx.span ret in (* Introduce all the let-bindings *) @@ -3379,14 +3380,14 @@ and translate_forward_end (ectx : C.eval_ctx) in let func_ty = mk_arrows input_tys ret_ty in let func = { e = Qualif func; ty = func_ty } in - let call = mk_apps ctx.meta func args in + let call = mk_apps ctx.span func args in call in (* Create the let expression with the loop call *) let e = mk_let effect_info.can_fail out_pat loop_call next_e in - (* Add meta-information linking the loop input parameters and the + (* Add span-information linking the loop input parameters and the loop input values - we use this to derive proper names. There is something important here: as we group the end of the function @@ -3396,10 +3397,10 @@ and translate_forward_end (ectx : C.eval_ctx) the function. It means it is ok to reference some variables which might actually be defined, in the end, in a different branch. - We then remove all the meta information from the body *before* calling + We then remove all the span information from the body *before* calling {!PureMicroPasses.decompose_loops}. *) - mk_emeta_symbolic_assignments loop_info.input_vars org_args e + mk_espan_symbolic_assignments loop_info.input_vars org_args e and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = let loop_id = V.LoopId.Map.find loop.loop_id ctx.loop_ids_map in @@ -3438,7 +3439,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (fun (sv : V.symbolic_value) -> V.SymbolicValueId.Map.mem sv.sv_id ctx.sv_to_var) loop.input_svalues) - ctx.meta; + ctx.span; (* Translate the loop inputs *) let inputs = @@ -3459,7 +3460,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (fun ty -> cassert __FILE__ __LINE__ (not (TypesUtils.ty_has_borrows ctx.type_ctx.type_infos ty)) - ctx.meta "The types shouldn't contain borrows"; + ctx.span "The types shouldn't contain borrows"; ctx_translate_fwd_ty ctx ty) tys) loop.rg_to_given_back_tys @@ -3539,7 +3540,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = let ctx = sanity_check __FILE__ __LINE__ (not (LoopId.Map.mem loop_id ctx.loops)) - ctx.meta; + ctx.span; (* Note that we will retrieve the input values later in the [ForwardEnd] (and will introduce the outputs at that moment, together with the actual @@ -3583,12 +3584,12 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = (* Create the [Fail] value *) let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in let ret_v = - mk_result_fail_texpression_with_error_id ctx.meta error_failure_id + mk_result_fail_texpression_with_error_id ctx.span error_failure_id ret_ty in ret_v else - mk_result_fail_texpression_with_error_id ctx.meta error_failure_id + mk_result_fail_texpression_with_error_id ctx.span error_failure_id output_ty in let mk_return ctx v = @@ -3599,11 +3600,11 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = let output = if effect_info.stateful then let state_rvalue = mk_state_texpression ctx.state_var in - mk_simpl_tuple_texpression ctx.meta [ state_rvalue; output ] + mk_simpl_tuple_texpression ctx.span [ state_rvalue; output ] else output in (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) - mk_result_ok_texpression ctx.meta output + mk_result_ok_texpression ctx.span output in let loop_info = @@ -3645,7 +3646,7 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = { fun_end; loop_id; - meta = loop.meta; + span = loop.span; fuel0 = ctx.fuel0; fuel = ctx.fuel; input_state; @@ -3658,11 +3659,11 @@ and translate_loop (loop : S.loop) (ctx : bs_ctx) : texpression = let ty = fun_end.ty in { e = loop; ty } -and translate_emeta (meta : S.emeta) (e : S.expression) (ctx : bs_ctx) : +and translate_espan (span : S.espan) (e : S.expression) (ctx : bs_ctx) : texpression = let next_e = translate_expression e ctx in - let meta = - match meta with + let span = + match span with | S.Assignment (ectx, lp, rv, rp) -> let lp = translate_mplace lp in let rv = typed_value_to_texpression ctx ectx rv in @@ -3672,28 +3673,28 @@ and translate_emeta (meta : S.emeta) (e : S.expression) (ctx : bs_ctx) : let infos = eval_ctx_to_symbolic_assignments_info ctx ectx in if infos <> [] then (* If often happens that the next expression contains exactly the - same meta information *) + same span information *) match next_e.e with | Meta (SymbolicPlaces infos1, _) when infos1 = infos -> None | _ -> Some (SymbolicPlaces infos) else None in - match meta with - | Some meta -> - let e = Meta (meta, next_e) in + match span with + | Some span -> + let e = Meta (span, next_e) in let ty = next_e.ty in { e; ty } | None -> next_e (** Wrap a function body in a match over the fuel to control termination. *) -let wrap_in_match_fuel (meta : Meta.meta) (fuel0 : VarId.id) (fuel : VarId.id) +let wrap_in_match_fuel (span : Meta.span) (fuel0 : VarId.id) (fuel : VarId.id) (body : texpression) : texpression = let fuel0_var : var = mk_fuel_var fuel0 in let fuel0 = mk_texpression_from_var fuel0_var in let nfuel_var : var = mk_fuel_var fuel in let nfuel_pat = mk_typed_pattern_from_var nfuel_var None in let fail_branch = - mk_result_fail_texpression_with_error_id meta error_out_of_fuel_id body.ty + mk_result_fail_texpression_with_error_id span error_out_of_fuel_id body.ty in match !Config.backend with | FStar -> @@ -3715,7 +3716,7 @@ let wrap_in_match_fuel (meta : Meta.meta) (fuel0 : VarId.id) (fuel : VarId.id) in let func_ty = mk_arrow mk_fuel_ty mk_bool_ty in let func = { e = Qualif func; ty = func_ty } in - mk_app meta func fuel0 + mk_app span func fuel0 in (* Create the expression: [decrease fuel0] *) let decrease_fuel = @@ -3727,7 +3728,7 @@ let wrap_in_match_fuel (meta : Meta.meta) (fuel0 : VarId.id) (fuel : VarId.id) in let func_ty = mk_arrow mk_fuel_ty mk_fuel_ty in let func = { e = Qualif func; ty = func_ty } in - mk_app meta func fuel0 + mk_app span func fuel0 in (* Create the success branch *) @@ -3799,11 +3800,11 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = let output = if effect_info.stateful then let state_rvalue = mk_state_texpression ctx.state_var in - mk_simpl_tuple_texpression ctx.meta [ state_rvalue; output ] + mk_simpl_tuple_texpression ctx.span [ state_rvalue; output ] else output in (* Wrap in a result - TODO: check effect_info.can_fail to not always wrap *) - mk_result_ok_texpression ctx.meta output + mk_result_ok_texpression ctx.span output in let mk_panic = (* TODO: we should use a [Fail] function *) @@ -3812,12 +3813,12 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = (* Create the [Fail] value *) let ret_ty = mk_simpl_tuple_ty [ mk_state_ty; output_ty ] in let ret_v = - mk_result_fail_texpression_with_error_id ctx.meta + mk_result_fail_texpression_with_error_id ctx.span error_failure_id ret_ty in ret_v else - mk_result_fail_texpression_with_error_id ctx.meta error_failure_id + mk_result_fail_texpression_with_error_id ctx.span error_failure_id output_ty in let back_tys = compute_back_tys ctx.sg None in @@ -3836,7 +3837,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = (* Add a match over the fuel, if necessary *) let body = if function_decreases_fuel effect_info then - wrap_in_match_fuel def.item_meta.meta ctx.fuel0 ctx.fuel body + wrap_in_match_fuel def.item_meta.span ctx.fuel0 ctx.fuel body else body in (* Sanity check *) @@ -3881,7 +3882,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = (List.for_all (fun (var, ty) -> (var : var).ty = ty) (List.combine inputs signature.inputs)) - def.item_meta.meta; + def.item_meta.span; Some { inputs; inputs_lvs; body } in @@ -3897,7 +3898,7 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = { def_id; is_local = def.is_local; - meta = def.item_meta.meta; + span = def.item_meta.span; kind = def.kind; num_loops; loop_id; @@ -3918,14 +3919,15 @@ let translate_fun_decl (ctx : bs_ctx) (body : S.expression option) : fun_decl = let translate_type_decls (ctx : Contexts.decls_ctx) : type_decl list = List.filter_map - (fun a -> - try Some (translate_type_decl ctx a) - with CFailure (meta, _) -> + (fun d -> + try Some (translate_type_decl ctx d) + with CFailure (span, _) -> let env = PrintPure.decls_ctx_to_fmt_env ctx in - let name = PrintPure.name_to_string env a.name in - save_error __FILE__ __LINE__ meta + let name = PrintPure.name_to_string env d.name in + let name_pattern = TranslateCore.name_to_pattern_string ctx d.name in + save_error __FILE__ __LINE__ span ("Could not translate type decl '" ^ name - ^ "' because of previous error"); + ^ " because of previous error\nName pattern: '" ^ name_pattern ^ "'"); None) (TypeDeclId.Map.values ctx.type_ctx.type_decls) @@ -3953,18 +3955,18 @@ let translate_trait_decl (ctx : Contexts.decls_ctx) (trait_decl : A.trait_decl) llbc_name in let generics = - translate_generic_params trait_decl.item_meta.meta llbc_generics + translate_generic_params trait_decl.item_meta.span llbc_generics in - let preds = translate_predicates trait_decl.item_meta.meta preds in + let preds = translate_predicates trait_decl.item_meta.span preds in let parent_clauses = List.map - (translate_trait_clause trait_decl.item_meta.meta) + (translate_trait_clause trait_decl.item_meta.span) llbc_parent_clauses in let consts = List.map (fun (name, (ty, id)) -> - (name, (translate_fwd_ty trait_decl.item_meta.meta type_infos ty, id))) + (name, (translate_fwd_ty trait_decl.item_meta.span type_infos ty, id))) consts in let types = @@ -3972,10 +3974,10 @@ let translate_trait_decl (ctx : Contexts.decls_ctx) (trait_decl : A.trait_decl) (fun (name, (trait_clauses, ty)) -> ( name, ( List.map - (translate_trait_clause trait_decl.item_meta.meta) + (translate_trait_clause trait_decl.item_meta.span) trait_clauses, Option.map - (translate_fwd_ty trait_decl.item_meta.meta type_infos) + (translate_fwd_ty trait_decl.item_meta.span type_infos) ty ) )) types in @@ -3984,7 +3986,7 @@ let translate_trait_decl (ctx : Contexts.decls_ctx) (trait_decl : A.trait_decl) is_local; llbc_name; name; - meta = item_meta.meta; + span = item_meta.span; generics; llbc_generics; preds; @@ -4016,8 +4018,8 @@ let translate_trait_impl (ctx : Contexts.decls_ctx) (trait_impl : A.trait_impl) in let type_infos = ctx.type_ctx.type_infos in let impl_trait = - translate_trait_decl_ref trait_impl.item_meta.meta - (translate_fwd_ty trait_impl.item_meta.meta type_infos) + translate_trait_decl_ref trait_impl.item_meta.span + (translate_fwd_ty trait_impl.item_meta.span type_infos) llbc_impl_trait in let name = @@ -4026,16 +4028,16 @@ let translate_trait_impl (ctx : Contexts.decls_ctx) (trait_impl : A.trait_impl) llbc_name in let generics = - translate_generic_params trait_impl.item_meta.meta llbc_generics + translate_generic_params trait_impl.item_meta.span llbc_generics in - let preds = translate_predicates trait_impl.item_meta.meta preds in + let preds = translate_predicates trait_impl.item_meta.span preds in let parent_trait_refs = - List.map (translate_strait_ref trait_impl.item_meta.meta) parent_trait_refs + List.map (translate_strait_ref trait_impl.item_meta.span) parent_trait_refs in let consts = List.map (fun (name, (ty, id)) -> - (name, (translate_fwd_ty trait_impl.item_meta.meta type_infos ty, id))) + (name, (translate_fwd_ty trait_impl.item_meta.span type_infos ty, id))) consts in let types = @@ -4043,9 +4045,9 @@ let translate_trait_impl (ctx : Contexts.decls_ctx) (trait_impl : A.trait_impl) (fun (name, (trait_refs, ty)) -> ( name, ( List.map - (translate_fwd_trait_ref trait_impl.item_meta.meta type_infos) + (translate_fwd_trait_ref trait_impl.item_meta.span type_infos) trait_refs, - translate_fwd_ty trait_impl.item_meta.meta type_infos ty ) )) + translate_fwd_ty trait_impl.item_meta.span type_infos ty ) )) types in { @@ -4053,7 +4055,7 @@ let translate_trait_impl (ctx : Contexts.decls_ctx) (trait_impl : A.trait_impl) is_local; llbc_name; name; - meta = item_meta.meta; + span = item_meta.span; impl_trait; llbc_impl_trait; generics; @@ -4086,11 +4088,11 @@ let translate_global (ctx : Contexts.decls_ctx) (decl : A.global_decl) : (Print.Contexts.decls_ctx_to_fmt_env ctx) llbc_name in - let generics = translate_generic_params decl.item_meta.meta llbc_generics in - let preds = translate_predicates decl.item_meta.meta preds in - let ty = translate_fwd_ty decl.item_meta.meta ctx.type_ctx.type_infos ty in + let generics = translate_generic_params decl.item_meta.span llbc_generics in + let preds = translate_predicates decl.item_meta.span preds in + let ty = translate_fwd_ty decl.item_meta.span ctx.type_ctx.type_infos ty in { - meta = item_meta.meta; + span = item_meta.span; def_id; is_local; llbc_name; diff --git a/compiler/SynthesizeSymbolic.ml b/compiler/SynthesizeSymbolic.ml index 576b2809..ae701c33 100644 --- a/compiler/SynthesizeSymbolic.ml +++ b/compiler/SynthesizeSymbolic.ml @@ -6,24 +6,24 @@ open LlbcAst open SymbolicAst open Errors -let mk_mplace (meta : Meta.meta) (p : place) (ctx : Contexts.eval_ctx) : mplace +let mk_mplace (span : Meta.span) (p : place) (ctx : Contexts.eval_ctx) : mplace = - let bv = Contexts.ctx_lookup_var_binder meta ctx p.var_id in + let bv = Contexts.ctx_lookup_var_binder span ctx p.var_id in { bv; projection = p.projection } -let mk_opt_mplace (meta : Meta.meta) (p : place option) +let mk_opt_mplace (span : Meta.span) (p : place option) (ctx : Contexts.eval_ctx) : mplace option = - Option.map (fun p -> mk_mplace meta p ctx) p + Option.map (fun p -> mk_mplace span p ctx) p -let mk_opt_place_from_op (meta : Meta.meta) (op : operand) +let mk_opt_place_from_op (span : Meta.span) (op : operand) (ctx : Contexts.eval_ctx) : mplace option = match op with - | Copy p | Move p -> Some (mk_mplace meta p ctx) + | Copy p | Move p -> Some (mk_mplace span p ctx) | Constant _ -> None -let mk_emeta (m : emeta) (e : expression) : expression = Meta (m, e) +let mk_espan (m : espan) (e : expression) : expression = Meta (m, e) -let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) +let synthesize_symbolic_expansion (span : Meta.span) (sv : symbolic_value) (place : mplace option) (seel : symbolic_expansion option list) (el : expression list option) : expression option = match el with @@ -41,7 +41,7 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) (Some (SeLiteral (VBool false)), false_exp); ] -> ExpandBool (true_exp, false_exp) - | _ -> craise __FILE__ __LINE__ meta "Ill-formed boolean expansion") + | _ -> craise __FILE__ __LINE__ span "Ill-formed boolean expansion") | TLiteral (TInteger int_ty) -> (* Switch over an integer: split between the "regular" branches and the "otherwise" branch (which should be the last branch) *) @@ -51,9 +51,9 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) let get_scalar (see : symbolic_expansion option) : scalar_value = match see with | Some (SeLiteral (VScalar cv)) -> - sanity_check __FILE__ __LINE__ (cv.int_ty = int_ty) meta; + sanity_check __FILE__ __LINE__ (cv.int_ty = int_ty) span; cv - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" in let branches = List.map (fun (see, exp) -> (get_scalar see, exp)) branches @@ -61,7 +61,7 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) (* For the otherwise branch, the symbolic value should have been left * unchanged *) let otherwise_see, otherwise = otherwise in - sanity_check __FILE__ __LINE__ (otherwise_see = None) meta; + sanity_check __FILE__ __LINE__ (otherwise_see = None) span; (* Return *) ExpandInt (int_ty, branches, otherwise) | TAdt (_, _) -> @@ -71,7 +71,7 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) match see with | Some (SeAdt (vid, fields)) -> (vid, fields) | _ -> - craise __FILE__ __LINE__ meta + craise __FILE__ __LINE__ span "Ill-formed branching ADT expansion" in let exp = @@ -86,18 +86,18 @@ let synthesize_symbolic_expansion (meta : Meta.meta) (sv : symbolic_value) (* Reference expansion: there should be one branch *) match ls with | [ (Some see, exp) ] -> ExpandNoBranch (see, exp) - | _ -> craise __FILE__ __LINE__ meta "Ill-formed borrow expansion") + | _ -> craise __FILE__ __LINE__ span "Ill-formed borrow expansion") | TVar _ | TLiteral TChar | TNever | TTraitType _ | TArrow _ | TRawPtr _ -> - craise __FILE__ __LINE__ meta "Ill-formed symbolic expansion" + craise __FILE__ __LINE__ span "Ill-formed symbolic expansion" in Some (Expansion (place, sv, expansion)) -let synthesize_symbolic_expansion_no_branching (meta : Meta.meta) +let synthesize_symbolic_expansion_no_branching (span : Meta.span) (sv : symbolic_value) (place : mplace option) (see : symbolic_expansion) (e : expression option) : expression option = let el = Option.map (fun e -> [ e ]) e in - synthesize_symbolic_expansion meta sv place [ Some see ] el + synthesize_symbolic_expansion span sv place [ Some see ] el let synthesize_function_call (call_id : call_id) (ctx : Contexts.eval_ctx) (sg : fun_sig option) (regions_hierarchy : region_var_groups) @@ -180,7 +180,7 @@ let synthesize_loop (loop_id : LoopId.id) (input_svalues : symbolic_value list) (fresh_svalues : SymbolicValueId.Set.t) (rg_to_given_back_tys : ty list RegionGroupId.Map.t) (end_expr : expression option) (loop_expr : expression option) - (meta : Meta.meta) : expression option = + (span : Meta.span) : expression option = match (end_expr, loop_expr) with | None, None -> None | Some end_expr, Some loop_expr -> @@ -193,12 +193,10 @@ let synthesize_loop (loop_id : LoopId.id) (input_svalues : symbolic_value list) rg_to_given_back_tys; end_expr; loop_expr; - meta; + span; }) - | _ -> craise __FILE__ __LINE__ meta "Unreachable" + | _ -> craise __FILE__ __LINE__ span "Unreachable" let save_snapshot (ctx : Contexts.eval_ctx) (e : expression option) : expression option = match e with None -> None | Some e -> Some (Meta (Snapshot ctx, e)) - -let cf_save_snapshot : Cps.cm_fun = fun cf ctx -> save_snapshot ctx (cf ctx) diff --git a/compiler/Translate.ml b/compiler/Translate.ml index 72a98c3d..02d495c0 100644 --- a/compiler/Translate.ml +++ b/compiler/Translate.ml @@ -127,7 +127,7 @@ let translate_function_to_pure_aux (trans_ctx : trans_ctx) let ctx = { - meta = fdef.item_meta.meta; + span = fdef.item_meta.span; decls_ctx = trans_ctx; SymbolicToPure.bid = None; sg; @@ -179,7 +179,7 @@ let translate_function_to_pure_aux (trans_ctx : trans_ctx) SymbolicToPure.fresh_named_vars_for_symbolic_values input_svs ctx in { ctx with forward_inputs } - | _ -> craise __FILE__ __LINE__ fdef.item_meta.meta "Unreachable" + | _ -> craise __FILE__ __LINE__ fdef.item_meta.span "Unreachable" in (* Add the backward inputs *) @@ -204,11 +204,12 @@ let translate_function_to_pure (trans_ctx : trans_ctx) try Some (translate_function_to_pure_aux trans_ctx pure_type_decls fun_dsigs fdef) - with CFailure (meta, _) -> + with CFailure (span, _) -> let name = name_to_string trans_ctx fdef.name in - save_error __FILE__ __LINE__ meta + let name_pattern = name_to_pattern_string trans_ctx fdef.name in + save_error __FILE__ __LINE__ span ("Could not translate the function '" ^ name - ^ "' because of previous error"); + ^ " because of previous error\nName pattern: '" ^ name_pattern ^ "'"); None (* TODO: factor out the return type *) @@ -243,11 +244,13 @@ let translate_crate_to_pure (crate : crate) : ( fdef.def_id, SymbolicToPure.translate_fun_sig_from_decl_to_decomposed trans_ctx fdef ) - with CFailure (meta, _) -> + with CFailure (span, _) -> let name = name_to_string trans_ctx fdef.name in - save_error __FILE__ __LINE__ meta + let name_pattern = name_to_pattern_string trans_ctx fdef.name in + save_error __FILE__ __LINE__ span ("Could not translate the function signature of '" ^ name - ^ "' because of previous error"); + ^ " because of previous error\nName pattern: '" ^ name_pattern + ^ "'"); None) (FunDeclId.Map.values crate.fun_decls)) in @@ -262,13 +265,15 @@ let translate_crate_to_pure (crate : crate) : (* Translate the trait declarations *) let trait_decls = List.filter_map - (fun a -> - try Some (SymbolicToPure.translate_trait_decl trans_ctx a) - with CFailure (meta, _) -> - let name = name_to_string trans_ctx a.name in - save_error __FILE__ __LINE__ meta + (fun d -> + try Some (SymbolicToPure.translate_trait_decl trans_ctx d) + with CFailure (span, _) -> + let name = name_to_string trans_ctx d.name in + let name_pattern = name_to_pattern_string trans_ctx d.name in + save_error __FILE__ __LINE__ span ("Could not translate the trait declaration '" ^ name - ^ "' because of previous error"); + ^ " because of previous error\nName pattern: '" ^ name_pattern ^ "'" + ); None) (TraitDeclId.Map.values trans_ctx.trait_decls_ctx.trait_decls) in @@ -276,13 +281,15 @@ let translate_crate_to_pure (crate : crate) : (* Translate the trait implementations *) let trait_impls = List.filter_map - (fun a -> - try Some (SymbolicToPure.translate_trait_impl trans_ctx a) - with CFailure (meta, _) -> - let name = name_to_string trans_ctx a.name in - save_error __FILE__ __LINE__ meta + (fun d -> + try Some (SymbolicToPure.translate_trait_impl trans_ctx d) + with CFailure (span, _) -> + let name = name_to_string trans_ctx d.name in + let name_pattern = name_to_pattern_string trans_ctx d.name in + save_error __FILE__ __LINE__ span ("Could not translate the trait instance '" ^ name - ^ "' because of previous error"); + ^ " because of previous error\nName pattern: '" ^ name_pattern ^ "'" + ); None) (TraitImplId.Map.values trans_ctx.trait_impls_ctx.trait_impls) in @@ -410,9 +417,12 @@ let export_types_group (fmt : Format.formatter) (config : gen_config) else ExtractBase.MutRecInner in - (* Retrieve the declarations *) + (* Retrieve the declarations - note that some of them might have been ignored in + case of errors *) let defs = - List.map (fun id -> Pure.TypeDeclId.Map.find id ctx.trans_types) ids + List.filter_map + (fun id -> Pure.TypeDeclId.Map.find_opt id ctx.trans_types) + ids in (* Check if the definition are builtin - if yes they must be ignored. @@ -486,7 +496,7 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx) let global_decls = ctx.trans_ctx.global_ctx.global_decls in let global = GlobalDeclId.Map.find id global_decls in let trans = FunDeclId.Map.find global.body ctx.trans_funs in - sanity_check __FILE__ __LINE__ (trans.loops = []) global.item_meta.meta; + sanity_check __FILE__ __LINE__ (trans.loops = []) global.item_meta.span; let body = trans.f in let is_opaque = Option.is_none body.Pure.body in @@ -511,11 +521,12 @@ let export_global (fmt : Format.formatter) (config : gen_config) (ctx : gen_ctx) *) let global = try Some (SymbolicToPure.translate_global ctx.trans_ctx global) - with CFailure (meta, _) -> + with CFailure (span, _) -> let name = name_to_string ctx.trans_ctx global.name in - save_error __FILE__ __LINE__ meta + let name_pattern = name_to_pattern_string ctx.trans_ctx global.name in + save_error __FILE__ __LINE__ span ("Could not translate the global declaration '" ^ name - ^ "' because of previous error"); + ^ " because of previous error\nName pattern: '" ^ name_pattern ^ "'"); None in Extract.extract_global_decl ctx fmt global body config.interface @@ -799,7 +810,7 @@ let extract_definitions (fmt : Format.formatter) (config : gen_config) export_functions_group pure_funs | GlobalGroup id -> export_global id | TraitDeclGroup (RecGroup _ids) -> - craise_opt_meta __FILE__ __LINE__ None + craise_opt_span __FILE__ __LINE__ None "Mutually recursive trait declarations are not supported" | TraitDeclGroup (NonRecGroup id) -> (* TODO: update to extract groups *) diff --git a/compiler/TypesAnalysis.ml b/compiler/TypesAnalysis.ml index 987df6ca..0be3a0d4 100644 --- a/compiler/TypesAnalysis.ml +++ b/compiler/TypesAnalysis.ml @@ -289,7 +289,7 @@ let analyze_type_decl (updated : bool ref) (infos : type_infos) (List.map (fun v -> List.map (fun f -> f.field_ty) v.fields) variants) - | Opaque -> craise __FILE__ __LINE__ def.item_meta.meta "unreachable" + | Opaque -> craise __FILE__ __LINE__ def.item_meta.span "unreachable" in (* Explore the types and accumulate information *) let type_decl_info = TypeDeclId.Map.find def.def_id infos in diff --git a/compiler/Values.ml b/compiler/Values.ml index 5473ce3e..e7b96051 100644 --- a/compiler/Values.ml +++ b/compiler/Values.ml @@ -153,11 +153,11 @@ and typed_value = { value : value; ty : ty } (** "Meta"-value: information we store for the synthesis. - Note that we never automatically visit the meta-values with the - visitors: they really are meta information, and shouldn't be considered + Note that we never automatically visit the span-values with the + visitors: they really are span information, and shouldn't be considered as part of the environment during a symbolic execution. - TODO: we may want to create wrappers, to prevent accidently mixing meta + TODO: we may want to create wrappers, to prevent accidently mixing span values and regular values. *) type mvalue = typed_value [@@deriving show, ord] @@ -166,7 +166,7 @@ type mvalue = typed_value [@@deriving show, ord] See the explanations for {!mvalue} - TODO: we may want to create wrappers, to prevent mixing meta values + TODO: we may want to create wrappers, to prevent mixing span values and regular values. *) type msymbolic_value = symbolic_value [@@deriving show, ord] @@ -270,7 +270,7 @@ and aproj = 'a and one for 'b. We accumulate those values in the list of projections (note that - the meta value stores the value which was given back). + the span value stores the value which was given back). We can later end the projector of loans if [s@0] is not referenced anywhere in the context below a projector of borrows which intersects @@ -282,14 +282,14 @@ and aproj = Also note that once given to a borrow projection, a symbolic value can't get updated/expanded: this means that we don't need to save - any meta-value here. + any span-value here. *) | AEndedProjLoans of msymbolic_value * (msymbolic_value * aproj) list (** An ended projector of loans over a symbolic value. See the explanations for {!AProjLoans} - Note that we keep the original symbolic value as a meta-value. + Note that we keep the original symbolic value as a span-value. *) | AEndedProjBorrows of msymbolic_value (** The only purpose of {!AEndedProjBorrows} is to store, for synthesis @@ -376,7 +376,7 @@ and aloan_content = | AEndedMutLoan of { child : typed_avalue; given_back : typed_avalue; - given_back_meta : mvalue; + given_back_span : mvalue; } (** An ended mutable loan in an abstraction. We need it because abstractions must keep track of the values @@ -401,7 +401,7 @@ and aloan_content = After ending [l0]: {[ - abs0 { a_ended_mut_loan { child = _; given_back = _; given_back_meta = U32 3; } + abs0 { a_ended_mut_loan { child = _; given_back = _; given_back_span = U32 3; } x -> ⊥ ]} @@ -420,7 +420,7 @@ and aloan_content = a_ended_mut_loan { child = _; given_back = a_mut_borrow l1 _; - given_back_meta = (mut_borrow l1 (U32 3)); + given_back_span = (mut_borrow l1 (U32 3)); } } ... @@ -464,7 +464,7 @@ and aloan_content = a_ended_ignored_mut_loan { child = a_mut_loan l1 _; given_back = a_mut_borrow l1 _; - given_back_meta = mut_borrow l1 @s1 + given_back_span = mut_borrow l1 @s1 } } x -> ⊥ @@ -474,7 +474,7 @@ and aloan_content = | AEndedIgnoredMutLoan of { child : typed_avalue; given_back : typed_avalue; - given_back_meta : mvalue; + given_back_span : mvalue; } (** Similar to {!AEndedMutLoan}, for ignored loans. See the comments for {!AIgnoredMutLoan}. @@ -613,7 +613,7 @@ and aborrow_content = *) | AEndedMutBorrow of msymbolic_value * typed_avalue (** The sole purpose of {!AEndedMutBorrow} is to store the (symbolic) value - that we gave back as a meta-value, to help with the synthesis. + that we gave back as a span-value, to help with the synthesis. *) | AEndedSharedBorrow (** We don't really need {!AEndedSharedBorrow}: we simply want to be @@ -622,8 +622,8 @@ and aborrow_content = | AEndedIgnoredMutBorrow of { child : typed_avalue; given_back : typed_avalue; - given_back_meta : msymbolic_value; - (** [given_back_meta] is used to store the (symbolic) value we gave back + given_back_span : msymbolic_value; + (** [given_back_span] is used to store the (symbolic) value we gave back upon ending the borrow. Rk.: *DO NOT* use [visit_AEndedIgnoredMutLoan]. diff --git a/compiler/ValuesUtils.ml b/compiler/ValuesUtils.ml index b6ee66f5..7bb50cad 100644 --- a/compiler/ValuesUtils.ml +++ b/compiler/ValuesUtils.ml @@ -11,37 +11,37 @@ exception FoundSymbolicValue of symbolic_value let mk_unit_value : typed_value = { value = VAdt { variant_id = None; field_values = [] }; ty = mk_unit_ty } -let mk_typed_value (meta : Meta.meta) (ty : ty) (value : value) : typed_value = - sanity_check __FILE__ __LINE__ (ty_is_ety ty) meta; +let mk_typed_value (span : Meta.span) (ty : ty) (value : value) : typed_value = + sanity_check __FILE__ __LINE__ (ty_is_ety ty) span; { value; ty } -let mk_typed_avalue (meta : Meta.meta) (ty : ty) (value : avalue) : typed_avalue +let mk_typed_avalue (span : Meta.span) (ty : ty) (value : avalue) : typed_avalue = - sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; + sanity_check __FILE__ __LINE__ (ty_is_rty ty) span; { value; ty } -let mk_bottom (meta : Meta.meta) (ty : ty) : typed_value = - sanity_check __FILE__ __LINE__ (ty_is_ety ty) meta; +let mk_bottom (span : Meta.span) (ty : ty) : typed_value = + sanity_check __FILE__ __LINE__ (ty_is_ety ty) span; { value = VBottom; ty } -let mk_abottom (meta : Meta.meta) (ty : ty) : typed_avalue = - sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; +let mk_abottom (span : Meta.span) (ty : ty) : typed_avalue = + sanity_check __FILE__ __LINE__ (ty_is_rty ty) span; { value = ABottom; ty } -let mk_aignored (meta : Meta.meta) (ty : ty) : typed_avalue = - sanity_check __FILE__ __LINE__ (ty_is_rty ty) meta; +let mk_aignored (span : Meta.span) (ty : ty) : typed_avalue = + sanity_check __FILE__ __LINE__ (ty_is_rty ty) span; { value = AIgnored; ty } -let value_as_symbolic (meta : Meta.meta) (v : value) : symbolic_value = +let value_as_symbolic (span : Meta.span) (v : value) : symbolic_value = match v with | VSymbolic v -> v - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" (** Box a value *) -let mk_box_value (meta : Meta.meta) (v : typed_value) : typed_value = +let mk_box_value (span : Meta.span) (v : typed_value) : typed_value = let box_ty = mk_box_ty v.ty in let box_v = VAdt { variant_id = None; field_values = [ v ] } in - mk_typed_value meta box_ty box_v + mk_typed_value span box_ty box_v let is_bottom (v : value) : bool = match v with VBottom -> true | _ -> false @@ -51,16 +51,16 @@ let is_aignored (v : avalue) : bool = let is_symbolic (v : value) : bool = match v with VSymbolic _ -> true | _ -> false -let as_symbolic (meta : Meta.meta) (v : value) : symbolic_value = +let as_symbolic (span : Meta.span) (v : value) : symbolic_value = match v with | VSymbolic s -> s - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" -let as_mut_borrow (meta : Meta.meta) (v : typed_value) : +let as_mut_borrow (span : Meta.span) (v : typed_value) : BorrowId.id * typed_value = match v.value with | VBorrow (VMutBorrow (bid, bv)) -> (bid, bv) - | _ -> craise __FILE__ __LINE__ meta "Unexpected" + | _ -> craise __FILE__ __LINE__ span "Unexpected" let is_unit (v : typed_value) : bool = ty_is_unit v.ty @@ -9,11 +9,11 @@ "rust-overlay": "rust-overlay" }, "locked": { - "lastModified": 1716398715, - "narHash": "sha256-z4COmDxa3DY6pVLgB85n6EVWFPkx87tr+xkJGiQvpV8=", + "lastModified": 1716552262, + "narHash": "sha256-anBm+nYYp1IDHb+9Dk5oMv28OK/vjcf+wuFI3IRjKrA=", "owner": "aeneasverif", "repo": "charon", - "rev": "c049120c15567d22520c94f570363eb4948d849f", + "rev": "a5fda598f359a2b85e044a884fd977d75f4578b4", "type": "github" }, "original": { @@ -47,28 +47,56 @@ ''; installPhase = "touch $out"; }; + aeneas = ocamlPackages.buildDunePackage { pname = "aeneas"; version = "0.1.0"; duneVersion = "3"; src = ./compiler; - OCAMLPARAM="_,warn-error=+A"; # Turn all warnings into errors. + OCAMLPARAM = "_,warn-error=+A"; # Turn all warnings into errors. propagatedBuildInputs = [ - easy_logging charon.packages.${system}.charon-ml - ] ++ (with ocamlPackages; [ - calendar - core_unix - ppx_deriving - visitors - yojson - zarith - ocamlgraph - unionFind - ]); + easy_logging + charon.packages.${system}.charon-ml + ] ++ (with ocamlPackages; [ + calendar + core_unix + ppx_deriving + visitors + yojson + zarith + ocamlgraph + unionFind + ]); afterBuild = '' - echo charon.packages.${system}.tests + echo charon.packages.${system}.tests + ''; + }; + + test_runner = ocamlPackages.buildDunePackage { + pname = "aeneas_test_runner"; + version = "0.1.0"; + duneVersion = "3"; + src = ./tests/test_runner; + OCAMLPARAM = "_,warn-error=+A"; # Turn all warnings into errors. + propagatedBuildInputs = (with ocamlPackages; [ + core_unix + ppx_deriving + ]); + }; + + # This test is a full crate with dependencies. We generate the + # corresponding llbc file here; this function takes care of cargo + # dependencies for us. + betree-llbc = charon.extractCrateWithCharon.${system} { + name = "betree"; + src = ./tests/src/betree; + charonFlags = "--polonius --opaque=betree_utils --crate betree_main"; + craneExtraArgs.checkPhaseCargoCommand = '' + cargo rustc -- --test -Zpolonius + ./target/debug/betree ''; }; + # Run the translation on various files. # Make sure we don't need to recompile the package whenever we make # unnecessary changes - we list the exact files and folders the package @@ -81,23 +109,26 @@ path == toString ./Makefile || pkgs.lib.hasPrefix (toString ./compiler) path || pkgs.lib.hasPrefix (toString ./backends) path - || pkgs.lib.hasPrefix (toString ./tests) path; + || (pkgs.lib.hasPrefix (toString ./tests) path + && !pkgs.lib.hasSuffix ".llbc" path); }; + buildInputs = [ charon.packages.${system}.rustToolchain ]; buildPhase = '' - # We need to provide the paths to the Charon tests derivations - export CHARON_TEST_DIR=${charon.checks.${system}.tests} + export AENEAS_EXE=${aeneas}/bin/aeneas + export CHARON_EXE=${charon.packages.${system}.charon}/bin/charon + export TEST_RUNNER_EXE=${test_runner}/bin/test_runner - # Copy the Aeneas executable, and update the path to it - cp ${aeneas}/bin/aeneas aeneas - export AENEAS_EXE=./aeneas + mkdir llbc + export LLBC_DIR=llbc + # Copy over the llbc file we can't generate ourselves. + cp ${betree-llbc}/llbc/betree_main.llbc $LLBC_DIR # Copy the tests cp -r tests tests-copy + make clean-generated-aeneas # Run the tests with extra sanity checks enabled - # Remark: we could remove the file - make clean-generated - OPTIONS=-checks make test-all -j $NIX_BUILD_CORES + IN_CI=1 make test-all -j $NIX_BUILD_CORES # Check that there are no differences between the generated tests # and the original tests @@ -114,12 +145,13 @@ # something, otherwise Nix will consider the build has failed. installPhase = "touch $out"; }; + # Replay the F* proofs. aeneas-verify-fstar = pkgs.stdenv.mkDerivation { name = "aeneas_verify_fstar"; src = ./tests/fstar; FSTAR_EXE = "${hacl-nix.packages.${system}.fstar}/bin/fstar.exe"; - buildPhase= '' + buildPhase = '' make prepare-projects make verify -j $NIX_BUILD_CORES ''; @@ -131,7 +163,7 @@ name = "aeneas_verify_coq"; src = ./tests/coq; buildInputs = [ pkgs.coq ]; - buildPhase= '' + buildPhase = '' make prepare-projects make verify -j $NIX_BUILD_CORES ''; @@ -155,7 +187,7 @@ # || pkgs.lib.hasPrefix (toString ./tests/hol4) path; # }; buildInputs = [ pkgs.hol ]; - buildPhase= '' + buildPhase = '' cd ./tests/hol4 make prepare-projects make verify -j $NIX_BUILD_CORES @@ -164,21 +196,23 @@ installPhase = "touch $out"; }; - check-charon-pin = pkgs.runCommand "aeneas-check-charon-pin" { - buildInputs = [ pkgs.jq ]; - } '' - CHARON_REV_FROM_FLAKE="$(jq -r .nodes.charon.locked.rev ${./flake.lock})" - CHARON_REV_FROM_PIN="$(tail -1 ${./charon-pin})" - if [[ "$CHARON_REV_FROM_FLAKE" != "$CHARON_REV_FROM_PIN" ]]; then - echo 'ERROR: The charon version in `flacke.lock` differs from the one in `charon-pin`.' - echo ' In `flake.lock`: '"$CHARON_REV_FROM_FLAKE" - echo ' In `charon-pin`: '"$CHARON_REV_FROM_PIN" - echo 'Use `make charon-pin` to update the `./charon-pin` file.' - exit 1 - fi - touch $out + check-charon-pin = pkgs.runCommand "aeneas-check-charon-pin" + { + buildInputs = [ pkgs.jq ]; + } '' + CHARON_REV_FROM_FLAKE="$(jq -r .nodes.charon.locked.rev ${./flake.lock})" + CHARON_REV_FROM_PIN="$(tail -1 ${./charon-pin})" + if [[ "$CHARON_REV_FROM_FLAKE" != "$CHARON_REV_FROM_PIN" ]]; then + echo 'ERROR: The charon version in `flacke.lock` differs from the one in `charon-pin`.' + echo ' In `flake.lock`: '"$CHARON_REV_FROM_FLAKE" + echo ' In `charon-pin`: '"$CHARON_REV_FROM_PIN" + echo 'Use `make charon-pin` to update the `./charon-pin` file.' + exit 1 + fi + touch $out ''; - in { + in + { packages = { inherit aeneas; default = aeneas; @@ -198,10 +232,11 @@ }; checks = { inherit aeneas aeneas-tests - aeneas-verify-fstar - aeneas-verify-coq - aeneas-verify-hol4 - aeneas-check-tidiness - check-charon-pin; }; + aeneas-verify-fstar + aeneas-verify-coq + aeneas-verify-hol4 + aeneas-check-tidiness + check-charon-pin; + }; }); } diff --git a/tests/.gitignore b/tests/.gitignore new file mode 100644 index 00000000..7eab4f57 --- /dev/null +++ b/tests/.gitignore @@ -0,0 +1,2 @@ +*.llbc +target/ diff --git a/tests/Makefile b/tests/Makefile index 8d40e8da..ff4baaba 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,4 +1,6 @@ +.PHONY: all all: test-fstar test-coq test-lean test-hol4 +.PHONY: test-% test-%: cd $* && $(MAKE) all diff --git a/tests/coq/arrays/Arrays.v b/tests/coq/arrays/Arrays.v index c9696147..371e4a12 100644 --- a/tests/coq/arrays/Arrays.v +++ b/tests/coq/arrays/Arrays.v @@ -9,23 +9,23 @@ Local Open Scope Primitives_scope. Module Arrays. (** [arrays::AB] - Source: 'src/arrays.rs', lines 3:0-3:11 *) + Source: 'tests/src/arrays.rs', lines 6:0-6:11 *) Inductive AB_t := | AB_A : AB_t | AB_B : AB_t. (** [arrays::incr]: - Source: 'src/arrays.rs', lines 8:0-8:24 *) + Source: 'tests/src/arrays.rs', lines 11:0-11:24 *) Definition incr (x : u32) : result u32 := u32_add x 1%u32. (** [arrays::array_to_shared_slice_]: - Source: 'src/arrays.rs', lines 16:0-16:53 *) + Source: 'tests/src/arrays.rs', lines 19:0-19:53 *) Definition array_to_shared_slice_ (T : Type) (s : array T 32%usize) : result (slice T) := array_to_slice T 32%usize s . (** [arrays::array_to_mut_slice_]: - Source: 'src/arrays.rs', lines 21:0-21:58 *) + Source: 'tests/src/arrays.rs', lines 24:0-24:58 *) Definition array_to_mut_slice_ (T : Type) (s : array T 32%usize) : result ((slice T) * (slice T -> result (array T 32%usize))) @@ -34,44 +34,44 @@ Definition array_to_mut_slice_ . (** [arrays::array_len]: - Source: 'src/arrays.rs', lines 25:0-25:40 *) + Source: 'tests/src/arrays.rs', lines 28:0-28:40 *) Definition array_len (T : Type) (s : array T 32%usize) : result usize := s1 <- array_to_slice T 32%usize s; Ok (slice_len T s1) . (** [arrays::shared_array_len]: - Source: 'src/arrays.rs', lines 29:0-29:48 *) + Source: 'tests/src/arrays.rs', lines 32:0-32:48 *) Definition shared_array_len (T : Type) (s : array T 32%usize) : result usize := s1 <- array_to_slice T 32%usize s; Ok (slice_len T s1) . (** [arrays::shared_slice_len]: - Source: 'src/arrays.rs', lines 33:0-33:44 *) + Source: 'tests/src/arrays.rs', lines 36:0-36:44 *) Definition shared_slice_len (T : Type) (s : slice T) : result usize := Ok (slice_len T s) . (** [arrays::index_array_shared]: - Source: 'src/arrays.rs', lines 37:0-37:57 *) + Source: 'tests/src/arrays.rs', lines 40:0-40:57 *) Definition index_array_shared (T : Type) (s : array T 32%usize) (i : usize) : result T := array_index_usize T 32%usize s i . (** [arrays::index_array_u32]: - Source: 'src/arrays.rs', lines 44:0-44:53 *) + Source: 'tests/src/arrays.rs', lines 47:0-47:53 *) Definition index_array_u32 (s : array u32 32%usize) (i : usize) : result u32 := array_index_usize u32 32%usize s i . (** [arrays::index_array_copy]: - Source: 'src/arrays.rs', lines 48:0-48:45 *) + Source: 'tests/src/arrays.rs', lines 51:0-51:45 *) Definition index_array_copy (x : array u32 32%usize) : result u32 := array_index_usize u32 32%usize x 0%usize . (** [arrays::index_mut_array]: - Source: 'src/arrays.rs', lines 52:0-52:62 *) + Source: 'tests/src/arrays.rs', lines 55:0-55:62 *) Definition index_mut_array (T : Type) (s : array T 32%usize) (i : usize) : result (T * (T -> result (array T 32%usize))) @@ -80,13 +80,13 @@ Definition index_mut_array . (** [arrays::index_slice]: - Source: 'src/arrays.rs', lines 56:0-56:46 *) + Source: 'tests/src/arrays.rs', lines 59:0-59:46 *) Definition index_slice (T : Type) (s : slice T) (i : usize) : result T := slice_index_usize T s i . (** [arrays::index_mut_slice]: - Source: 'src/arrays.rs', lines 60:0-60:58 *) + Source: 'tests/src/arrays.rs', lines 63:0-63:58 *) Definition index_mut_slice (T : Type) (s : slice T) (i : usize) : result (T * (T -> result (slice T))) @@ -95,7 +95,7 @@ Definition index_mut_slice . (** [arrays::slice_subslice_shared_]: - Source: 'src/arrays.rs', lines 64:0-64:70 *) + Source: 'tests/src/arrays.rs', lines 67:0-67:70 *) Definition slice_subslice_shared_ (x : slice u32) (y : usize) (z : usize) : result (slice u32) := core_slice_index_Slice_index u32 (core_ops_range_Range usize) @@ -104,7 +104,7 @@ Definition slice_subslice_shared_ . (** [arrays::slice_subslice_mut_]: - Source: 'src/arrays.rs', lines 68:0-68:75 *) + Source: 'tests/src/arrays.rs', lines 71:0-71:75 *) Definition slice_subslice_mut_ (x : slice u32) (y : usize) (z : usize) : result ((slice u32) * (slice u32 -> result (slice u32))) @@ -118,14 +118,14 @@ Definition slice_subslice_mut_ . (** [arrays::array_to_slice_shared_]: - Source: 'src/arrays.rs', lines 72:0-72:54 *) + Source: 'tests/src/arrays.rs', lines 75:0-75:54 *) Definition array_to_slice_shared_ (x : array u32 32%usize) : result (slice u32) := array_to_slice u32 32%usize x . (** [arrays::array_to_slice_mut_]: - Source: 'src/arrays.rs', lines 76:0-76:59 *) + Source: 'tests/src/arrays.rs', lines 79:0-79:59 *) Definition array_to_slice_mut_ (x : array u32 32%usize) : result ((slice u32) * (slice u32 -> result (array u32 32%usize))) @@ -134,7 +134,7 @@ Definition array_to_slice_mut_ . (** [arrays::array_subslice_shared_]: - Source: 'src/arrays.rs', lines 80:0-80:74 *) + Source: 'tests/src/arrays.rs', lines 83:0-83:74 *) Definition array_subslice_shared_ (x : array u32 32%usize) (y : usize) (z : usize) : result (slice u32) := core_array_Array_index u32 (core_ops_range_Range usize) 32%usize @@ -144,7 +144,7 @@ Definition array_subslice_shared_ . (** [arrays::array_subslice_mut_]: - Source: 'src/arrays.rs', lines 84:0-84:79 *) + Source: 'tests/src/arrays.rs', lines 87:0-87:79 *) Definition array_subslice_mut_ (x : array u32 32%usize) (y : usize) (z : usize) : result ((slice u32) * (slice u32 -> result (array u32 32%usize))) @@ -159,19 +159,19 @@ Definition array_subslice_mut_ . (** [arrays::index_slice_0]: - Source: 'src/arrays.rs', lines 88:0-88:38 *) + Source: 'tests/src/arrays.rs', lines 91:0-91:38 *) Definition index_slice_0 (T : Type) (s : slice T) : result T := slice_index_usize T s 0%usize . (** [arrays::index_array_0]: - Source: 'src/arrays.rs', lines 92:0-92:42 *) + Source: 'tests/src/arrays.rs', lines 95:0-95:42 *) Definition index_array_0 (T : Type) (s : array T 32%usize) : result T := array_index_usize T 32%usize s 0%usize . (** [arrays::index_index_array]: - Source: 'src/arrays.rs', lines 103:0-103:71 *) + Source: 'tests/src/arrays.rs', lines 106:0-106:71 *) Definition index_index_array (s : array (array u32 32%usize) 32%usize) (i : usize) (j : usize) : result u32 @@ -181,7 +181,7 @@ Definition index_index_array . (** [arrays::update_update_array]: - Source: 'src/arrays.rs', lines 114:0-114:70 *) + Source: 'tests/src/arrays.rs', lines 117:0-117:70 *) Definition update_update_array (s : array (array u32 32%usize) 32%usize) (i : usize) (j : usize) : result unit @@ -196,46 +196,46 @@ Definition update_update_array . (** [arrays::array_local_deep_copy]: - Source: 'src/arrays.rs', lines 118:0-118:43 *) + Source: 'tests/src/arrays.rs', lines 121:0-121:43 *) Definition array_local_deep_copy (x : array u32 32%usize) : result unit := Ok tt . (** [arrays::take_array]: - Source: 'src/arrays.rs', lines 122:0-122:30 *) + Source: 'tests/src/arrays.rs', lines 125:0-125:30 *) Definition take_array (a : array u32 2%usize) : result unit := Ok tt. (** [arrays::take_array_borrow]: - Source: 'src/arrays.rs', lines 123:0-123:38 *) + Source: 'tests/src/arrays.rs', lines 126:0-126:38 *) Definition take_array_borrow (a : array u32 2%usize) : result unit := Ok tt. (** [arrays::take_slice]: - Source: 'src/arrays.rs', lines 124:0-124:28 *) + Source: 'tests/src/arrays.rs', lines 127:0-127:28 *) Definition take_slice (s : slice u32) : result unit := Ok tt. (** [arrays::take_mut_slice]: - Source: 'src/arrays.rs', lines 125:0-125:36 *) + Source: 'tests/src/arrays.rs', lines 128:0-128:36 *) Definition take_mut_slice (s : slice u32) : result (slice u32) := Ok s. (** [arrays::const_array]: - Source: 'src/arrays.rs', lines 127:0-127:32 *) + Source: 'tests/src/arrays.rs', lines 130:0-130:32 *) Definition const_array : result (array u32 2%usize) := Ok (mk_array u32 2%usize [ 0%u32; 0%u32 ]) . (** [arrays::const_slice]: - Source: 'src/arrays.rs', lines 131:0-131:20 *) + Source: 'tests/src/arrays.rs', lines 134:0-134:20 *) Definition const_slice : result unit := _ <- array_to_slice u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); Ok tt . (** [arrays::take_all]: - Source: 'src/arrays.rs', lines 141:0-141:17 *) + Source: 'tests/src/arrays.rs', lines 144:0-144:17 *) Definition take_all : result unit := _ <- take_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); _ <- take_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); @@ -250,32 +250,32 @@ Definition take_all : result unit := . (** [arrays::index_array]: - Source: 'src/arrays.rs', lines 155:0-155:38 *) + Source: 'tests/src/arrays.rs', lines 158:0-158:38 *) Definition index_array (x : array u32 2%usize) : result u32 := array_index_usize u32 2%usize x 0%usize . (** [arrays::index_array_borrow]: - Source: 'src/arrays.rs', lines 158:0-158:46 *) + Source: 'tests/src/arrays.rs', lines 161:0-161:46 *) Definition index_array_borrow (x : array u32 2%usize) : result u32 := array_index_usize u32 2%usize x 0%usize . (** [arrays::index_slice_u32_0]: - Source: 'src/arrays.rs', lines 162:0-162:42 *) + Source: 'tests/src/arrays.rs', lines 165:0-165:42 *) Definition index_slice_u32_0 (x : slice u32) : result u32 := slice_index_usize u32 x 0%usize . (** [arrays::index_mut_slice_u32_0]: - Source: 'src/arrays.rs', lines 166:0-166:50 *) + Source: 'tests/src/arrays.rs', lines 169:0-169:50 *) Definition index_mut_slice_u32_0 (x : slice u32) : result (u32 * (slice u32)) := i <- slice_index_usize u32 x 0%usize; Ok (i, x) . (** [arrays::index_all]: - Source: 'src/arrays.rs', lines 170:0-170:25 *) + Source: 'tests/src/arrays.rs', lines 173:0-173:25 *) Definition index_all : result u32 := i <- index_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); i1 <- index_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); @@ -295,7 +295,7 @@ Definition index_all : result u32 := . (** [arrays::update_array]: - Source: 'src/arrays.rs', lines 184:0-184:36 *) + Source: 'tests/src/arrays.rs', lines 187:0-187:36 *) Definition update_array (x : array u32 2%usize) : result unit := p <- array_index_mut_usize u32 2%usize x 0%usize; let (_, index_mut_back) := p in @@ -304,7 +304,7 @@ Definition update_array (x : array u32 2%usize) : result unit := . (** [arrays::update_array_mut_borrow]: - Source: 'src/arrays.rs', lines 187:0-187:48 *) + Source: 'tests/src/arrays.rs', lines 190:0-190:48 *) Definition update_array_mut_borrow (x : array u32 2%usize) : result (array u32 2%usize) := p <- array_index_mut_usize u32 2%usize x 0%usize; @@ -313,7 +313,7 @@ Definition update_array_mut_borrow . (** [arrays::update_mut_slice]: - Source: 'src/arrays.rs', lines 190:0-190:38 *) + Source: 'tests/src/arrays.rs', lines 193:0-193:38 *) Definition update_mut_slice (x : slice u32) : result (slice u32) := p <- slice_index_mut_usize u32 x 0%usize; let (_, index_mut_back) := p in @@ -321,7 +321,7 @@ Definition update_mut_slice (x : slice u32) : result (slice u32) := . (** [arrays::update_all]: - Source: 'src/arrays.rs', lines 194:0-194:19 *) + Source: 'tests/src/arrays.rs', lines 197:0-197:19 *) Definition update_all : result unit := _ <- update_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); _ <- update_array (mk_array u32 2%usize [ 0%u32; 0%u32 ]); @@ -334,7 +334,7 @@ Definition update_all : result unit := . (** [arrays::range_all]: - Source: 'src/arrays.rs', lines 205:0-205:18 *) + Source: 'tests/src/arrays.rs', lines 208:0-208:18 *) Definition range_all : result unit := p <- core_array_Array_index_mut u32 (core_ops_range_Range usize) 4%usize @@ -352,31 +352,31 @@ Definition range_all : result unit := . (** [arrays::deref_array_borrow]: - Source: 'src/arrays.rs', lines 214:0-214:46 *) + Source: 'tests/src/arrays.rs', lines 217:0-217:46 *) Definition deref_array_borrow (x : array u32 2%usize) : result u32 := array_index_usize u32 2%usize x 0%usize . (** [arrays::deref_array_mut_borrow]: - Source: 'src/arrays.rs', lines 219:0-219:54 *) + Source: 'tests/src/arrays.rs', lines 222:0-222:54 *) Definition deref_array_mut_borrow (x : array u32 2%usize) : result (u32 * (array u32 2%usize)) := i <- array_index_usize u32 2%usize x 0%usize; Ok (i, x) . (** [arrays::take_array_t]: - Source: 'src/arrays.rs', lines 227:0-227:31 *) + Source: 'tests/src/arrays.rs', lines 230:0-230:31 *) Definition take_array_t (a : array AB_t 2%usize) : result unit := Ok tt. (** [arrays::non_copyable_array]: - Source: 'src/arrays.rs', lines 229:0-229:27 *) + Source: 'tests/src/arrays.rs', lines 232:0-232:27 *) Definition non_copyable_array : result unit := take_array_t (mk_array AB_t 2%usize [ AB_A; AB_B ]) . (** [arrays::sum]: loop 0: - Source: 'src/arrays.rs', lines 242:0-250:1 *) + Source: 'tests/src/arrays.rs', lines 245:0-253:1 *) Fixpoint sum_loop (n : nat) (s : slice u32) (sum1 : u32) (i : usize) : result u32 := match n with @@ -394,13 +394,13 @@ Fixpoint sum_loop . (** [arrays::sum]: - Source: 'src/arrays.rs', lines 242:0-242:28 *) + Source: 'tests/src/arrays.rs', lines 245:0-245:28 *) Definition sum (n : nat) (s : slice u32) : result u32 := sum_loop n s 0%u32 0%usize . (** [arrays::sum2]: loop 0: - Source: 'src/arrays.rs', lines 252:0-261:1 *) + Source: 'tests/src/arrays.rs', lines 255:0-264:1 *) Fixpoint sum2_loop (n : nat) (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) : result u32 @@ -422,7 +422,7 @@ Fixpoint sum2_loop . (** [arrays::sum2]: - Source: 'src/arrays.rs', lines 252:0-252:41 *) + Source: 'tests/src/arrays.rs', lines 255:0-255:41 *) Definition sum2 (n : nat) (s : slice u32) (s2 : slice u32) : result u32 := let i := slice_len u32 s in let i1 := slice_len u32 s2 in @@ -430,7 +430,7 @@ Definition sum2 (n : nat) (s : slice u32) (s2 : slice u32) : result u32 := . (** [arrays::f0]: - Source: 'src/arrays.rs', lines 263:0-263:11 *) + Source: 'tests/src/arrays.rs', lines 266:0-266:11 *) Definition f0 : result unit := p <- array_to_slice_mut u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]); let (s, to_slice_mut_back) := p in @@ -442,7 +442,7 @@ Definition f0 : result unit := . (** [arrays::f1]: - Source: 'src/arrays.rs', lines 268:0-268:11 *) + Source: 'tests/src/arrays.rs', lines 271:0-271:11 *) Definition f1 : result unit := p <- array_index_mut_usize u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) @@ -453,12 +453,12 @@ Definition f1 : result unit := . (** [arrays::f2]: - Source: 'src/arrays.rs', lines 273:0-273:17 *) + Source: 'tests/src/arrays.rs', lines 276:0-276:17 *) Definition f2 (i : u32) : result unit := Ok tt. (** [arrays::f4]: - Source: 'src/arrays.rs', lines 282:0-282:54 *) + Source: 'tests/src/arrays.rs', lines 285:0-285:54 *) Definition f4 (x : array u32 32%usize) (y : usize) (z : usize) : result (slice u32) := core_array_Array_index u32 (core_ops_range_Range usize) 32%usize @@ -468,7 +468,7 @@ Definition f4 . (** [arrays::f3]: - Source: 'src/arrays.rs', lines 275:0-275:18 *) + Source: 'tests/src/arrays.rs', lines 278:0-278:18 *) Definition f3 (n : nat) : result u32 := i <- array_index_usize u32 2%usize (mk_array u32 2%usize [ 1%u32; 2%u32 ]) @@ -481,18 +481,18 @@ Definition f3 (n : nat) : result u32 := . (** [arrays::SZ] - Source: 'src/arrays.rs', lines 286:0-286:19 *) + Source: 'tests/src/arrays.rs', lines 289:0-289:19 *) Definition sz_body : result usize := Ok 32%usize. Definition sz : usize := sz_body%global. (** [arrays::f5]: - Source: 'src/arrays.rs', lines 289:0-289:31 *) + Source: 'tests/src/arrays.rs', lines 292:0-292:31 *) Definition f5 (x : array u32 32%usize) : result u32 := array_index_usize u32 32%usize x 0%usize . (** [arrays::ite]: - Source: 'src/arrays.rs', lines 294:0-294:12 *) + Source: 'tests/src/arrays.rs', lines 297:0-297:12 *) Definition ite : result unit := p <- array_to_slice_mut u32 2%usize (mk_array u32 2%usize [ 0%u32; 0%u32 ]); let (s, to_slice_mut_back) := p in @@ -508,7 +508,7 @@ Definition ite : result unit := . (** [arrays::zero_slice]: loop 0: - Source: 'src/arrays.rs', lines 303:0-310:1 *) + Source: 'tests/src/arrays.rs', lines 306:0-313:1 *) Fixpoint zero_slice_loop (n : nat) (a : slice u8) (i : usize) (len : usize) : result (slice u8) := match n with @@ -526,13 +526,13 @@ Fixpoint zero_slice_loop . (** [arrays::zero_slice]: - Source: 'src/arrays.rs', lines 303:0-303:31 *) + Source: 'tests/src/arrays.rs', lines 306:0-306:31 *) Definition zero_slice (n : nat) (a : slice u8) : result (slice u8) := let len := slice_len u8 a in zero_slice_loop n a 0%usize len . (** [arrays::iter_mut_slice]: loop 0: - Source: 'src/arrays.rs', lines 312:0-318:1 *) + Source: 'tests/src/arrays.rs', lines 315:0-321:1 *) Fixpoint iter_mut_slice_loop (n : nat) (len : usize) (i : usize) : result unit := match n with @@ -545,13 +545,13 @@ Fixpoint iter_mut_slice_loop . (** [arrays::iter_mut_slice]: - Source: 'src/arrays.rs', lines 312:0-312:35 *) + Source: 'tests/src/arrays.rs', lines 315:0-315:35 *) Definition iter_mut_slice (n : nat) (a : slice u8) : result (slice u8) := let len := slice_len u8 a in _ <- iter_mut_slice_loop n len 0%usize; Ok a . (** [arrays::sum_mut_slice]: loop 0: - Source: 'src/arrays.rs', lines 320:0-328:1 *) + Source: 'tests/src/arrays.rs', lines 323:0-331:1 *) Fixpoint sum_mut_slice_loop (n : nat) (a : slice u32) (i : usize) (s : u32) : result u32 := match n with @@ -569,7 +569,7 @@ Fixpoint sum_mut_slice_loop . (** [arrays::sum_mut_slice]: - Source: 'src/arrays.rs', lines 320:0-320:42 *) + Source: 'tests/src/arrays.rs', lines 323:0-323:42 *) Definition sum_mut_slice (n : nat) (a : slice u32) : result (u32 * (slice u32)) := i <- sum_mut_slice_loop n a 0%usize 0%u32; Ok (i, a) diff --git a/tests/coq/demo/Demo.v b/tests/coq/demo/Demo.v index 00b9b889..1cccbeda 100644 --- a/tests/coq/demo/Demo.v +++ b/tests/coq/demo/Demo.v @@ -9,7 +9,7 @@ Local Open Scope Primitives_scope. Module Demo. (** [demo::choose]: - Source: 'src/demo.rs', lines 5:0-5:70 *) + Source: 'tests/src/demo.rs', lines 6:0-6:70 *) Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b @@ -18,30 +18,30 @@ Definition choose . (** [demo::mul2_add1]: - Source: 'src/demo.rs', lines 13:0-13:31 *) + Source: 'tests/src/demo.rs', lines 14:0-14:31 *) Definition mul2_add1 (x : u32) : result u32 := i <- u32_add x x; u32_add i 1%u32 . (** [demo::use_mul2_add1]: - Source: 'src/demo.rs', lines 17:0-17:43 *) + Source: 'tests/src/demo.rs', lines 18:0-18:43 *) Definition use_mul2_add1 (x : u32) (y : u32) : result u32 := i <- mul2_add1 x; u32_add i y . (** [demo::incr]: - Source: 'src/demo.rs', lines 21:0-21:31 *) + Source: 'tests/src/demo.rs', lines 22:0-22:31 *) Definition incr (x : u32) : result u32 := u32_add x 1%u32. (** [demo::use_incr]: - Source: 'src/demo.rs', lines 25:0-25:17 *) + Source: 'tests/src/demo.rs', lines 26:0-26:17 *) Definition use_incr : result unit := x <- incr 0%u32; x1 <- incr x; _ <- incr x1; Ok tt . (** [demo::CList] - Source: 'src/demo.rs', lines 34:0-34:17 *) + Source: 'tests/src/demo.rs', lines 35:0-35:17 *) Inductive CList_t (T : Type) := | CList_CCons : T -> CList_t T -> CList_t T | CList_CNil : CList_t T @@ -51,7 +51,7 @@ Arguments CList_CCons { _ }. Arguments CList_CNil { _ }. (** [demo::list_nth]: - Source: 'src/demo.rs', lines 39:0-39:56 *) + Source: 'tests/src/demo.rs', lines 40:0-40:56 *) Fixpoint list_nth (T : Type) (n : nat) (l : CList_t T) (i : u32) : result T := match n with | O => Fail_ OutOfFuel @@ -65,7 +65,7 @@ Fixpoint list_nth (T : Type) (n : nat) (l : CList_t T) (i : u32) : result T := . (** [demo::list_nth_mut]: - Source: 'src/demo.rs', lines 54:0-54:68 *) + Source: 'tests/src/demo.rs', lines 55:0-55:68 *) Fixpoint list_nth_mut (T : Type) (n : nat) (l : CList_t T) (i : u32) : result (T * (T -> result (CList_t T))) @@ -91,7 +91,7 @@ Fixpoint list_nth_mut . (** [demo::list_nth_mut1]: loop 0: - Source: 'src/demo.rs', lines 69:0-78:1 *) + Source: 'tests/src/demo.rs', lines 70:0-79:1 *) Fixpoint list_nth_mut1_loop (T : Type) (n : nat) (l : CList_t T) (i : u32) : result (T * (T -> result (CList_t T))) @@ -116,7 +116,7 @@ Fixpoint list_nth_mut1_loop . (** [demo::list_nth_mut1]: - Source: 'src/demo.rs', lines 69:0-69:77 *) + Source: 'tests/src/demo.rs', lines 70:0-70:77 *) Definition list_nth_mut1 (T : Type) (n : nat) (l : CList_t T) (i : u32) : result (T * (T -> result (CList_t T))) @@ -125,7 +125,7 @@ Definition list_nth_mut1 . (** [demo::i32_id]: - Source: 'src/demo.rs', lines 80:0-80:28 *) + Source: 'tests/src/demo.rs', lines 81:0-81:28 *) Fixpoint i32_id (n : nat) (i : i32) : result i32 := match n with | O => Fail_ OutOfFuel @@ -137,7 +137,7 @@ Fixpoint i32_id (n : nat) (i : i32) : result i32 := . (** [demo::list_tail]: - Source: 'src/demo.rs', lines 88:0-88:64 *) + Source: 'tests/src/demo.rs', lines 89:0-89:64 *) Fixpoint list_tail (T : Type) (n : nat) (l : CList_t T) : result ((CList_t T) * (CList_t T -> result (CList_t T))) @@ -159,7 +159,7 @@ Fixpoint list_tail . (** Trait declaration: [demo::Counter] - Source: 'src/demo.rs', lines 97:0-97:17 *) + Source: 'tests/src/demo.rs', lines 98:0-98:17 *) Record Counter_t (Self : Type) := mkCounter_t { Counter_t_incr : Self -> result (usize * Self); }. @@ -168,19 +168,19 @@ Arguments mkCounter_t { _ }. Arguments Counter_t_incr { _ }. (** [demo::{(demo::Counter for usize)}::incr]: - Source: 'src/demo.rs', lines 102:4-102:31 *) + Source: 'tests/src/demo.rs', lines 103:4-103:31 *) Definition counterUsize_incr (self : usize) : result (usize * usize) := self1 <- usize_add self 1%usize; Ok (self, self1) . (** Trait implementation: [demo::{(demo::Counter for usize)}] - Source: 'src/demo.rs', lines 101:0-101:22 *) + Source: 'tests/src/demo.rs', lines 102:0-102:22 *) Definition CounterUsize : Counter_t usize := {| Counter_t_incr := counterUsize_incr; |}. (** [demo::use_counter]: - Source: 'src/demo.rs', lines 109:0-109:59 *) + Source: 'tests/src/demo.rs', lines 110:0-110:59 *) Definition use_counter (T : Type) (counterInst : Counter_t T) (cnt : T) : result (usize * T) := counterInst.(Counter_t_incr) cnt diff --git a/tests/coq/hashmap/Hashmap_Funs.v b/tests/coq/hashmap/Hashmap_Funs.v index ebb7897d..778b9d56 100644 --- a/tests/coq/hashmap/Hashmap_Funs.v +++ b/tests/coq/hashmap/Hashmap_Funs.v @@ -11,12 +11,12 @@ Include Hashmap_Types. Module Hashmap_Funs. (** [hashmap::hash_key]: - Source: 'src/hashmap.rs', lines 27:0-27:32 *) + Source: 'tests/src/hashmap.rs', lines 35:0-35:32 *) Definition hash_key (k : usize) : result usize := Ok k. (** [hashmap::{hashmap::HashMap<T>}::allocate_slots]: loop 0: - Source: 'src/hashmap.rs', lines 50:4-56:5 *) + Source: 'tests/src/hashmap.rs', lines 58:4-64:5 *) Fixpoint hashMap_allocate_slots_loop (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (n1 : usize) : result (alloc_vec_Vec (List_t T)) @@ -34,7 +34,7 @@ Fixpoint hashMap_allocate_slots_loop . (** [hashmap::{hashmap::HashMap<T>}::allocate_slots]: - Source: 'src/hashmap.rs', lines 50:4-50:76 *) + Source: 'tests/src/hashmap.rs', lines 58:4-58:76 *) Definition hashMap_allocate_slots (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (n1 : usize) : result (alloc_vec_Vec (List_t T)) @@ -43,7 +43,7 @@ Definition hashMap_allocate_slots . (** [hashmap::{hashmap::HashMap<T>}::new_with_capacity]: - Source: 'src/hashmap.rs', lines 59:4-63:13 *) + Source: 'tests/src/hashmap.rs', lines 67:4-71:13 *) Definition hashMap_new_with_capacity (T : Type) (n : nat) (capacity : usize) (max_load_dividend : usize) (max_load_divisor : usize) : @@ -62,13 +62,13 @@ Definition hashMap_new_with_capacity . (** [hashmap::{hashmap::HashMap<T>}::new]: - Source: 'src/hashmap.rs', lines 75:4-75:24 *) + Source: 'tests/src/hashmap.rs', lines 83:4-83:24 *) Definition hashMap_new (T : Type) (n : nat) : result (HashMap_t T) := hashMap_new_with_capacity T n 32%usize 4%usize 5%usize . (** [hashmap::{hashmap::HashMap<T>}::clear]: loop 0: - Source: 'src/hashmap.rs', lines 80:4-88:5 *) + Source: 'tests/src/hashmap.rs', lines 88:4-96:5 *) Fixpoint hashMap_clear_loop (T : Type) (n : nat) (slots : alloc_vec_Vec (List_t T)) (i : usize) : result (alloc_vec_Vec (List_t T)) @@ -91,7 +91,7 @@ Fixpoint hashMap_clear_loop . (** [hashmap::{hashmap::HashMap<T>}::clear]: - Source: 'src/hashmap.rs', lines 80:4-80:27 *) + Source: 'tests/src/hashmap.rs', lines 88:4-88:27 *) Definition hashMap_clear (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) := hm <- hashMap_clear_loop T n self.(hashMap_slots) 0%usize; @@ -105,13 +105,13 @@ Definition hashMap_clear . (** [hashmap::{hashmap::HashMap<T>}::len]: - Source: 'src/hashmap.rs', lines 90:4-90:30 *) + Source: 'tests/src/hashmap.rs', lines 98:4-98:30 *) Definition hashMap_len (T : Type) (self : HashMap_t T) : result usize := Ok self.(hashMap_num_entries) . (** [hashmap::{hashmap::HashMap<T>}::insert_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 97:4-114:5 *) + Source: 'tests/src/hashmap.rs', lines 105:4-122:5 *) Fixpoint hashMap_insert_in_list_loop (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : result (bool * (List_t T)) @@ -133,7 +133,7 @@ Fixpoint hashMap_insert_in_list_loop . (** [hashmap::{hashmap::HashMap<T>}::insert_in_list]: - Source: 'src/hashmap.rs', lines 97:4-97:71 *) + Source: 'tests/src/hashmap.rs', lines 105:4-105:71 *) Definition hashMap_insert_in_list (T : Type) (n : nat) (key : usize) (value : T) (ls : List_t T) : result (bool * (List_t T)) @@ -142,7 +142,7 @@ Definition hashMap_insert_in_list . (** [hashmap::{hashmap::HashMap<T>}::insert_no_resize]: - Source: 'src/hashmap.rs', lines 117:4-117:54 *) + Source: 'tests/src/hashmap.rs', lines 125:4-125:54 *) Definition hashMap_insert_no_resize (T : Type) (n : nat) (self : HashMap_t T) (key : usize) (value : T) : result (HashMap_t T) @@ -180,7 +180,7 @@ Definition hashMap_insert_no_resize . (** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 183:4-196:5 *) + Source: 'tests/src/hashmap.rs', lines 191:4-204:5 *) Fixpoint hashMap_move_elements_from_list_loop (T : Type) (n : nat) (ntable : HashMap_t T) (ls : List_t T) : result (HashMap_t T) @@ -198,7 +198,7 @@ Fixpoint hashMap_move_elements_from_list_loop . (** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: - Source: 'src/hashmap.rs', lines 183:4-183:72 *) + Source: 'tests/src/hashmap.rs', lines 191:4-191:72 *) Definition hashMap_move_elements_from_list (T : Type) (n : nat) (ntable : HashMap_t T) (ls : List_t T) : result (HashMap_t T) @@ -207,7 +207,7 @@ Definition hashMap_move_elements_from_list . (** [hashmap::{hashmap::HashMap<T>}::move_elements]: loop 0: - Source: 'src/hashmap.rs', lines 171:4-180:5 *) + Source: 'tests/src/hashmap.rs', lines 179:4-188:5 *) Fixpoint hashMap_move_elements_loop (T : Type) (n : nat) (ntable : HashMap_t T) (slots : alloc_vec_Vec (List_t T)) (i : usize) : @@ -233,7 +233,7 @@ Fixpoint hashMap_move_elements_loop . (** [hashmap::{hashmap::HashMap<T>}::move_elements]: - Source: 'src/hashmap.rs', lines 171:4-171:95 *) + Source: 'tests/src/hashmap.rs', lines 179:4-179:95 *) Definition hashMap_move_elements (T : Type) (n : nat) (ntable : HashMap_t T) (slots : alloc_vec_Vec (List_t T)) (i : usize) : @@ -243,7 +243,7 @@ Definition hashMap_move_elements . (** [hashmap::{hashmap::HashMap<T>}::try_resize]: - Source: 'src/hashmap.rs', lines 140:4-140:28 *) + Source: 'tests/src/hashmap.rs', lines 148:4-148:28 *) Definition hashMap_try_resize (T : Type) (n : nat) (self : HashMap_t T) : result (HashMap_t T) := max_usize <- scalar_cast U32 Usize core_u32_max; @@ -275,7 +275,7 @@ Definition hashMap_try_resize . (** [hashmap::{hashmap::HashMap<T>}::insert]: - Source: 'src/hashmap.rs', lines 129:4-129:48 *) + Source: 'tests/src/hashmap.rs', lines 137:4-137:48 *) Definition hashMap_insert (T : Type) (n : nat) (self : HashMap_t T) (key : usize) (value : T) : result (HashMap_t T) @@ -288,7 +288,7 @@ Definition hashMap_insert . (** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 206:4-219:5 *) + Source: 'tests/src/hashmap.rs', lines 214:4-227:5 *) Fixpoint hashMap_contains_key_in_list_loop (T : Type) (n : nat) (key : usize) (ls : List_t T) : result bool := match n with @@ -305,14 +305,14 @@ Fixpoint hashMap_contains_key_in_list_loop . (** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: - Source: 'src/hashmap.rs', lines 206:4-206:68 *) + Source: 'tests/src/hashmap.rs', lines 214:4-214:68 *) Definition hashMap_contains_key_in_list (T : Type) (n : nat) (key : usize) (ls : List_t T) : result bool := hashMap_contains_key_in_list_loop T n key ls . (** [hashmap::{hashmap::HashMap<T>}::contains_key]: - Source: 'src/hashmap.rs', lines 199:4-199:49 *) + Source: 'tests/src/hashmap.rs', lines 207:4-207:49 *) Definition hashMap_contains_key (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result bool := hash <- hash_key key; @@ -326,7 +326,7 @@ Definition hashMap_contains_key . (** [hashmap::{hashmap::HashMap<T>}::get_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 224:4-237:5 *) + Source: 'tests/src/hashmap.rs', lines 232:4-245:5 *) Fixpoint hashMap_get_in_list_loop (T : Type) (n : nat) (key : usize) (ls : List_t T) : result T := match n with @@ -341,14 +341,14 @@ Fixpoint hashMap_get_in_list_loop . (** [hashmap::{hashmap::HashMap<T>}::get_in_list]: - Source: 'src/hashmap.rs', lines 224:4-224:70 *) + Source: 'tests/src/hashmap.rs', lines 232:4-232:70 *) Definition hashMap_get_in_list (T : Type) (n : nat) (key : usize) (ls : List_t T) : result T := hashMap_get_in_list_loop T n key ls . (** [hashmap::{hashmap::HashMap<T>}::get]: - Source: 'src/hashmap.rs', lines 239:4-239:55 *) + Source: 'tests/src/hashmap.rs', lines 247:4-247:55 *) Definition hashMap_get (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result T := hash <- hash_key key; @@ -362,7 +362,7 @@ Definition hashMap_get . (** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 245:4-254:5 *) + Source: 'tests/src/hashmap.rs', lines 253:4-262:5 *) Fixpoint hashMap_get_mut_in_list_loop (T : Type) (n : nat) (ls : List_t T) (key : usize) : result (T * (T -> result (List_t T))) @@ -388,7 +388,7 @@ Fixpoint hashMap_get_mut_in_list_loop . (** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: - Source: 'src/hashmap.rs', lines 245:4-245:86 *) + Source: 'tests/src/hashmap.rs', lines 253:4-253:86 *) Definition hashMap_get_mut_in_list (T : Type) (n : nat) (ls : List_t T) (key : usize) : result (T * (T -> result (List_t T))) @@ -397,7 +397,7 @@ Definition hashMap_get_mut_in_list . (** [hashmap::{hashmap::HashMap<T>}::get_mut]: - Source: 'src/hashmap.rs', lines 257:4-257:67 *) + Source: 'tests/src/hashmap.rs', lines 265:4-265:67 *) Definition hashMap_get_mut (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result (T * (T -> result (HashMap_t T))) @@ -427,7 +427,7 @@ Definition hashMap_get_mut . (** [hashmap::{hashmap::HashMap<T>}::remove_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 265:4-291:5 *) + Source: 'tests/src/hashmap.rs', lines 273:4-299:5 *) Fixpoint hashMap_remove_from_list_loop (T : Type) (n : nat) (key : usize) (ls : List_t T) : result ((option T) * (List_t T)) @@ -455,7 +455,7 @@ Fixpoint hashMap_remove_from_list_loop . (** [hashmap::{hashmap::HashMap<T>}::remove_from_list]: - Source: 'src/hashmap.rs', lines 265:4-265:69 *) + Source: 'tests/src/hashmap.rs', lines 273:4-273:69 *) Definition hashMap_remove_from_list (T : Type) (n : nat) (key : usize) (ls : List_t T) : result ((option T) * (List_t T)) @@ -464,7 +464,7 @@ Definition hashMap_remove_from_list . (** [hashmap::{hashmap::HashMap<T>}::remove]: - Source: 'src/hashmap.rs', lines 294:4-294:52 *) + Source: 'tests/src/hashmap.rs', lines 302:4-302:52 *) Definition hashMap_remove (T : Type) (n : nat) (self : HashMap_t T) (key : usize) : result ((option T) * (HashMap_t T)) @@ -503,7 +503,7 @@ Definition hashMap_remove . (** [hashmap::test1]: - Source: 'src/hashmap.rs', lines 315:0-315:10 *) + Source: 'tests/src/hashmap.rs', lines 323:0-323:10 *) Definition test1 (n : nat) : result unit := hm <- hashMap_new u64 n; hm1 <- hashMap_insert u64 n hm 0%usize 42%u64; diff --git a/tests/coq/hashmap/Hashmap_Types.v b/tests/coq/hashmap/Hashmap_Types.v index 80a43593..8a8137d5 100644 --- a/tests/coq/hashmap/Hashmap_Types.v +++ b/tests/coq/hashmap/Hashmap_Types.v @@ -9,7 +9,7 @@ Local Open Scope Primitives_scope. Module Hashmap_Types. (** [hashmap::List] - Source: 'src/hashmap.rs', lines 19:0-19:16 *) + Source: 'tests/src/hashmap.rs', lines 27:0-27:16 *) Inductive List_t (T : Type) := | List_Cons : usize -> T -> List_t T -> List_t T | List_Nil : List_t T @@ -19,7 +19,7 @@ Arguments List_Cons { _ }. Arguments List_Nil { _ }. (** [hashmap::HashMap] - Source: 'src/hashmap.rs', lines 35:0-35:21 *) + Source: 'tests/src/hashmap.rs', lines 43:0-43:21 *) Record HashMap_t (T : Type) := mkHashMap_t { hashMap_num_entries : usize; diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v index 79da6e80..f6467d5a 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Funs.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Funs.v @@ -13,12 +13,12 @@ Include HashmapMain_FunsExternal. Module HashmapMain_Funs. (** [hashmap_main::hashmap::hash_key]: - Source: 'src/hashmap.rs', lines 27:0-27:32 *) + Source: 'tests/src/hashmap.rs', lines 35:0-35:32 *) Definition hashmap_hash_key (k : usize) : result usize := Ok k. (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::allocate_slots]: loop 0: - Source: 'src/hashmap.rs', lines 50:4-56:5 *) + Source: 'tests/src/hashmap.rs', lines 58:4-64:5 *) Fixpoint hashmap_HashMap_allocate_slots_loop (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (n1 : usize) : @@ -37,7 +37,7 @@ Fixpoint hashmap_HashMap_allocate_slots_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::allocate_slots]: - Source: 'src/hashmap.rs', lines 50:4-50:76 *) + Source: 'tests/src/hashmap.rs', lines 58:4-58:76 *) Definition hashmap_HashMap_allocate_slots (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (n1 : usize) : @@ -47,7 +47,7 @@ Definition hashmap_HashMap_allocate_slots . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::new_with_capacity]: - Source: 'src/hashmap.rs', lines 59:4-63:13 *) + Source: 'tests/src/hashmap.rs', lines 67:4-71:13 *) Definition hashmap_HashMap_new_with_capacity (T : Type) (n : nat) (capacity : usize) (max_load_dividend : usize) (max_load_divisor : usize) : @@ -68,14 +68,14 @@ Definition hashmap_HashMap_new_with_capacity . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::new]: - Source: 'src/hashmap.rs', lines 75:4-75:24 *) + Source: 'tests/src/hashmap.rs', lines 83:4-83:24 *) Definition hashmap_HashMap_new (T : Type) (n : nat) : result (hashmap_HashMap_t T) := hashmap_HashMap_new_with_capacity T n 32%usize 4%usize 5%usize . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: loop 0: - Source: 'src/hashmap.rs', lines 80:4-88:5 *) + Source: 'tests/src/hashmap.rs', lines 88:4-96:5 *) Fixpoint hashmap_HashMap_clear_loop (T : Type) (n : nat) (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) : result (alloc_vec_Vec (hashmap_List_t T)) @@ -99,7 +99,7 @@ Fixpoint hashmap_HashMap_clear_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: - Source: 'src/hashmap.rs', lines 80:4-80:27 *) + Source: 'tests/src/hashmap.rs', lines 88:4-88:27 *) Definition hashmap_HashMap_clear (T : Type) (n : nat) (self : hashmap_HashMap_t T) : result (hashmap_HashMap_t T) @@ -115,14 +115,14 @@ Definition hashmap_HashMap_clear . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::len]: - Source: 'src/hashmap.rs', lines 90:4-90:30 *) + Source: 'tests/src/hashmap.rs', lines 98:4-98:30 *) Definition hashmap_HashMap_len (T : Type) (self : hashmap_HashMap_t T) : result usize := Ok self.(hashmap_HashMap_num_entries) . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 97:4-114:5 *) + Source: 'tests/src/hashmap.rs', lines 105:4-122:5 *) Fixpoint hashmap_HashMap_insert_in_list_loop (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : result (bool * (hashmap_List_t T)) @@ -145,7 +145,7 @@ Fixpoint hashmap_HashMap_insert_in_list_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: - Source: 'src/hashmap.rs', lines 97:4-97:71 *) + Source: 'tests/src/hashmap.rs', lines 105:4-105:71 *) Definition hashmap_HashMap_insert_in_list (T : Type) (n : nat) (key : usize) (value : T) (ls : hashmap_List_t T) : result (bool * (hashmap_List_t T)) @@ -154,7 +154,7 @@ Definition hashmap_HashMap_insert_in_list . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_no_resize]: - Source: 'src/hashmap.rs', lines 117:4-117:54 *) + Source: 'tests/src/hashmap.rs', lines 125:4-125:54 *) Definition hashmap_HashMap_insert_no_resize (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) (value : T) : result (hashmap_HashMap_t T) @@ -194,7 +194,7 @@ Definition hashmap_HashMap_insert_no_resize . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 183:4-196:5 *) + Source: 'tests/src/hashmap.rs', lines 191:4-204:5 *) Fixpoint hashmap_HashMap_move_elements_from_list_loop (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (ls : hashmap_List_t T) : result (hashmap_HashMap_t T) @@ -212,7 +212,7 @@ Fixpoint hashmap_HashMap_move_elements_from_list_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: - Source: 'src/hashmap.rs', lines 183:4-183:72 *) + Source: 'tests/src/hashmap.rs', lines 191:4-191:72 *) Definition hashmap_HashMap_move_elements_from_list (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (ls : hashmap_List_t T) : result (hashmap_HashMap_t T) @@ -221,7 +221,7 @@ Definition hashmap_HashMap_move_elements_from_list . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: loop 0: - Source: 'src/hashmap.rs', lines 171:4-180:5 *) + Source: 'tests/src/hashmap.rs', lines 179:4-188:5 *) Fixpoint hashmap_HashMap_move_elements_loop (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) : @@ -248,7 +248,7 @@ Fixpoint hashmap_HashMap_move_elements_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: - Source: 'src/hashmap.rs', lines 171:4-171:95 *) + Source: 'tests/src/hashmap.rs', lines 179:4-179:95 *) Definition hashmap_HashMap_move_elements (T : Type) (n : nat) (ntable : hashmap_HashMap_t T) (slots : alloc_vec_Vec (hashmap_List_t T)) (i : usize) : @@ -258,7 +258,7 @@ Definition hashmap_HashMap_move_elements . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::try_resize]: - Source: 'src/hashmap.rs', lines 140:4-140:28 *) + Source: 'tests/src/hashmap.rs', lines 148:4-148:28 *) Definition hashmap_HashMap_try_resize (T : Type) (n : nat) (self : hashmap_HashMap_t T) : result (hashmap_HashMap_t T) @@ -295,7 +295,7 @@ Definition hashmap_HashMap_try_resize . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert]: - Source: 'src/hashmap.rs', lines 129:4-129:48 *) + Source: 'tests/src/hashmap.rs', lines 137:4-137:48 *) Definition hashmap_HashMap_insert (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) (value : T) : result (hashmap_HashMap_t T) @@ -308,7 +308,7 @@ Definition hashmap_HashMap_insert . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 206:4-219:5 *) + Source: 'tests/src/hashmap.rs', lines 214:4-227:5 *) Fixpoint hashmap_HashMap_contains_key_in_list_loop (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result bool := match n with @@ -325,14 +325,14 @@ Fixpoint hashmap_HashMap_contains_key_in_list_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: - Source: 'src/hashmap.rs', lines 206:4-206:68 *) + Source: 'tests/src/hashmap.rs', lines 214:4-214:68 *) Definition hashmap_HashMap_contains_key_in_list (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result bool := hashmap_HashMap_contains_key_in_list_loop T n key ls . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key]: - Source: 'src/hashmap.rs', lines 199:4-199:49 *) + Source: 'tests/src/hashmap.rs', lines 207:4-207:49 *) Definition hashmap_HashMap_contains_key (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result bool @@ -348,7 +348,7 @@ Definition hashmap_HashMap_contains_key . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 224:4-237:5 *) + Source: 'tests/src/hashmap.rs', lines 232:4-245:5 *) Fixpoint hashmap_HashMap_get_in_list_loop (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result T := match n with @@ -365,14 +365,14 @@ Fixpoint hashmap_HashMap_get_in_list_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: - Source: 'src/hashmap.rs', lines 224:4-224:70 *) + Source: 'tests/src/hashmap.rs', lines 232:4-232:70 *) Definition hashmap_HashMap_get_in_list (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result T := hashmap_HashMap_get_in_list_loop T n key ls . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get]: - Source: 'src/hashmap.rs', lines 239:4-239:55 *) + Source: 'tests/src/hashmap.rs', lines 247:4-247:55 *) Definition hashmap_HashMap_get (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result T := hash <- hashmap_hash_key key; @@ -386,7 +386,7 @@ Definition hashmap_HashMap_get . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 245:4-254:5 *) + Source: 'tests/src/hashmap.rs', lines 253:4-262:5 *) Fixpoint hashmap_HashMap_get_mut_in_list_loop (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) : result (T * (T -> result (hashmap_List_t T))) @@ -413,7 +413,7 @@ Fixpoint hashmap_HashMap_get_mut_in_list_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: - Source: 'src/hashmap.rs', lines 245:4-245:86 *) + Source: 'tests/src/hashmap.rs', lines 253:4-253:86 *) Definition hashmap_HashMap_get_mut_in_list (T : Type) (n : nat) (ls : hashmap_List_t T) (key : usize) : result (T * (T -> result (hashmap_List_t T))) @@ -422,7 +422,7 @@ Definition hashmap_HashMap_get_mut_in_list . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut]: - Source: 'src/hashmap.rs', lines 257:4-257:67 *) + Source: 'tests/src/hashmap.rs', lines 265:4-265:67 *) Definition hashmap_HashMap_get_mut (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result (T * (T -> result (hashmap_HashMap_t T))) @@ -453,7 +453,7 @@ Definition hashmap_HashMap_get_mut . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 265:4-291:5 *) + Source: 'tests/src/hashmap.rs', lines 273:4-299:5 *) Fixpoint hashmap_HashMap_remove_from_list_loop (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result ((option T) * (hashmap_List_t T)) @@ -482,7 +482,7 @@ Fixpoint hashmap_HashMap_remove_from_list_loop . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: - Source: 'src/hashmap.rs', lines 265:4-265:69 *) + Source: 'tests/src/hashmap.rs', lines 273:4-273:69 *) Definition hashmap_HashMap_remove_from_list (T : Type) (n : nat) (key : usize) (ls : hashmap_List_t T) : result ((option T) * (hashmap_List_t T)) @@ -491,7 +491,7 @@ Definition hashmap_HashMap_remove_from_list . (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove]: - Source: 'src/hashmap.rs', lines 294:4-294:52 *) + Source: 'tests/src/hashmap.rs', lines 302:4-302:52 *) Definition hashmap_HashMap_remove (T : Type) (n : nat) (self : hashmap_HashMap_t T) (key : usize) : result ((option T) * (hashmap_HashMap_t T)) @@ -532,7 +532,7 @@ Definition hashmap_HashMap_remove . (** [hashmap_main::hashmap::test1]: - Source: 'src/hashmap.rs', lines 315:0-315:10 *) + Source: 'tests/src/hashmap.rs', lines 323:0-323:10 *) Definition hashmap_test1 (n : nat) : result unit := hm <- hashmap_HashMap_new u64 n; hm1 <- hashmap_HashMap_insert u64 n hm 0%usize 42%u64; @@ -572,7 +572,7 @@ Definition hashmap_test1 (n : nat) : result unit := . (** [hashmap_main::insert_on_disk]: - Source: 'src/hashmap_main.rs', lines 7:0-7:43 *) + Source: 'tests/src/hashmap_main.rs', lines 13:0-13:43 *) Definition insert_on_disk (n : nat) (key : usize) (value : u64) (st : state) : result (state * unit) := p <- hashmap_utils_deserialize st; @@ -582,7 +582,7 @@ Definition insert_on_disk . (** [hashmap_main::main]: - Source: 'src/hashmap_main.rs', lines 16:0-16:13 *) + Source: 'tests/src/hashmap_main.rs', lines 22:0-22:13 *) Definition main : result unit := Ok tt. diff --git a/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v index fb2e052a..66835e8c 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_FunsExternal_Template.v @@ -12,13 +12,13 @@ Include HashmapMain_Types. Module HashmapMain_FunsExternal_Template. (** [hashmap_main::hashmap_utils::deserialize]: - Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *) + Source: 'tests/src/hashmap_utils.rs', lines 11:0-11:43 *) Axiom hashmap_utils_deserialize : state -> result (state * (hashmap_HashMap_t u64)) . (** [hashmap_main::hashmap_utils::serialize]: - Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *) + Source: 'tests/src/hashmap_utils.rs', lines 6:0-6:42 *) Axiom hashmap_utils_serialize : hashmap_HashMap_t u64 -> state -> result (state * unit) . diff --git a/tests/coq/hashmap_on_disk/HashmapMain_Types.v b/tests/coq/hashmap_on_disk/HashmapMain_Types.v index 8d3d72aa..5656bd9c 100644 --- a/tests/coq/hashmap_on_disk/HashmapMain_Types.v +++ b/tests/coq/hashmap_on_disk/HashmapMain_Types.v @@ -11,7 +11,7 @@ Include HashmapMain_TypesExternal. Module HashmapMain_Types. (** [hashmap_main::hashmap::List] - Source: 'src/hashmap.rs', lines 19:0-19:16 *) + Source: 'tests/src/hashmap.rs', lines 27:0-27:16 *) Inductive hashmap_List_t (T : Type) := | Hashmap_List_Cons : usize -> T -> hashmap_List_t T -> hashmap_List_t T | Hashmap_List_Nil : hashmap_List_t T @@ -21,7 +21,7 @@ Arguments Hashmap_List_Cons { _ }. Arguments Hashmap_List_Nil { _ }. (** [hashmap_main::hashmap::HashMap] - Source: 'src/hashmap.rs', lines 35:0-35:21 *) + Source: 'tests/src/hashmap.rs', lines 43:0-43:21 *) Record hashmap_HashMap_t (T : Type) := mkhashmap_HashMap_t { hashmap_HashMap_num_entries : usize; diff --git a/tests/coq/misc/Bitwise.v b/tests/coq/misc/Bitwise.v index b2339c58..d0dbfd51 100644 --- a/tests/coq/misc/Bitwise.v +++ b/tests/coq/misc/Bitwise.v @@ -9,29 +9,29 @@ Local Open Scope Primitives_scope. Module Bitwise. (** [bitwise::shift_u32]: - Source: 'src/bitwise.rs', lines 3:0-3:31 *) + Source: 'tests/src/bitwise.rs', lines 4:0-4:31 *) Definition shift_u32 (a : u32) : result u32 := t <- u32_shr a 16%usize; u32_shl t 16%usize . (** [bitwise::shift_i32]: - Source: 'src/bitwise.rs', lines 10:0-10:31 *) + Source: 'tests/src/bitwise.rs', lines 11:0-11:31 *) Definition shift_i32 (a : i32) : result i32 := t <- i32_shr a 16%isize; i32_shl t 16%isize . (** [bitwise::xor_u32]: - Source: 'src/bitwise.rs', lines 17:0-17:37 *) + Source: 'tests/src/bitwise.rs', lines 18:0-18:37 *) Definition xor_u32 (a : u32) (b : u32) : result u32 := Ok (u32_xor a b). (** [bitwise::or_u32]: - Source: 'src/bitwise.rs', lines 21:0-21:36 *) + Source: 'tests/src/bitwise.rs', lines 22:0-22:36 *) Definition or_u32 (a : u32) (b : u32) : result u32 := Ok (u32_or a b). (** [bitwise::and_u32]: - Source: 'src/bitwise.rs', lines 25:0-25:37 *) + Source: 'tests/src/bitwise.rs', lines 26:0-26:37 *) Definition and_u32 (a : u32) (b : u32) : result u32 := Ok (u32_and a b). diff --git a/tests/coq/misc/Constants.v b/tests/coq/misc/Constants.v index 71185975..c3ecdb83 100644 --- a/tests/coq/misc/Constants.v +++ b/tests/coq/misc/Constants.v @@ -9,37 +9,37 @@ Local Open Scope Primitives_scope. Module Constants. (** [constants::X0] - Source: 'src/constants.rs', lines 5:0-5:17 *) + Source: 'tests/src/constants.rs', lines 7:0-7:17 *) Definition x0_body : result u32 := Ok 0%u32. Definition x0 : u32 := x0_body%global. (** [constants::X1] - Source: 'src/constants.rs', lines 7:0-7:17 *) + Source: 'tests/src/constants.rs', lines 9:0-9:17 *) Definition x1_body : result u32 := Ok core_u32_max. Definition x1 : u32 := x1_body%global. (** [constants::X2] - Source: 'src/constants.rs', lines 10:0-10:17 *) + Source: 'tests/src/constants.rs', lines 12:0-12:17 *) Definition x2_body : result u32 := Ok 3%u32. Definition x2 : u32 := x2_body%global. (** [constants::incr]: - Source: 'src/constants.rs', lines 17:0-17:32 *) + Source: 'tests/src/constants.rs', lines 19:0-19:32 *) Definition incr (n : u32) : result u32 := u32_add n 1%u32. (** [constants::X3] - Source: 'src/constants.rs', lines 15:0-15:17 *) + Source: 'tests/src/constants.rs', lines 17:0-17:17 *) Definition x3_body : result u32 := incr 32%u32. Definition x3 : u32 := x3_body%global. (** [constants::mk_pair0]: - Source: 'src/constants.rs', lines 23:0-23:51 *) + Source: 'tests/src/constants.rs', lines 25:0-25:51 *) Definition mk_pair0 (x : u32) (y1 : u32) : result (u32 * u32) := Ok (x, y1). (** [constants::Pair] - Source: 'src/constants.rs', lines 36:0-36:23 *) + Source: 'tests/src/constants.rs', lines 38:0-38:23 *) Record Pair_t (T1 T2 : Type) := mkPair_t { pair_x : T1; pair_y : T2; }. Arguments mkPair_t { _ _ }. @@ -47,130 +47,130 @@ Arguments pair_x { _ _ }. Arguments pair_y { _ _ }. (** [constants::mk_pair1]: - Source: 'src/constants.rs', lines 27:0-27:55 *) + Source: 'tests/src/constants.rs', lines 29:0-29:55 *) Definition mk_pair1 (x : u32) (y1 : u32) : result (Pair_t u32 u32) := Ok {| pair_x := x; pair_y := y1 |} . (** [constants::P0] - Source: 'src/constants.rs', lines 31:0-31:24 *) + Source: 'tests/src/constants.rs', lines 33:0-33:24 *) Definition p0_body : result (u32 * u32) := mk_pair0 0%u32 1%u32. Definition p0 : (u32 * u32) := p0_body%global. (** [constants::P1] - Source: 'src/constants.rs', lines 32:0-32:28 *) + Source: 'tests/src/constants.rs', lines 34:0-34:28 *) Definition p1_body : result (Pair_t u32 u32) := mk_pair1 0%u32 1%u32. Definition p1 : Pair_t u32 u32 := p1_body%global. (** [constants::P2] - Source: 'src/constants.rs', lines 33:0-33:24 *) + Source: 'tests/src/constants.rs', lines 35:0-35:24 *) Definition p2_body : result (u32 * u32) := Ok (0%u32, 1%u32). Definition p2 : (u32 * u32) := p2_body%global. (** [constants::P3] - Source: 'src/constants.rs', lines 34:0-34:28 *) + Source: 'tests/src/constants.rs', lines 36:0-36:28 *) Definition p3_body : result (Pair_t u32 u32) := Ok {| pair_x := 0%u32; pair_y := 1%u32 |} . Definition p3 : Pair_t u32 u32 := p3_body%global. (** [constants::Wrap] - Source: 'src/constants.rs', lines 49:0-49:18 *) + Source: 'tests/src/constants.rs', lines 51:0-51:18 *) Record Wrap_t (T : Type) := mkWrap_t { wrap_value : T; }. Arguments mkWrap_t { _ }. Arguments wrap_value { _ }. (** [constants::{constants::Wrap<T>}::new]: - Source: 'src/constants.rs', lines 54:4-54:41 *) + Source: 'tests/src/constants.rs', lines 56:4-56:41 *) Definition wrap_new (T : Type) (value : T) : result (Wrap_t T) := Ok {| wrap_value := value |} . (** [constants::Y] - Source: 'src/constants.rs', lines 41:0-41:22 *) + Source: 'tests/src/constants.rs', lines 43:0-43:22 *) Definition y_body : result (Wrap_t i32) := wrap_new i32 2%i32. Definition y : Wrap_t i32 := y_body%global. (** [constants::unwrap_y]: - Source: 'src/constants.rs', lines 43:0-43:30 *) + Source: 'tests/src/constants.rs', lines 45:0-45:30 *) Definition unwrap_y : result i32 := Ok y.(wrap_value). (** [constants::YVAL] - Source: 'src/constants.rs', lines 47:0-47:19 *) + Source: 'tests/src/constants.rs', lines 49:0-49:19 *) Definition yval_body : result i32 := unwrap_y. Definition yval : i32 := yval_body%global. (** [constants::get_z1::Z1] - Source: 'src/constants.rs', lines 62:4-62:17 *) + Source: 'tests/src/constants.rs', lines 64:4-64:17 *) Definition get_z1_z1_body : result i32 := Ok 3%i32. Definition get_z1_z1 : i32 := get_z1_z1_body%global. (** [constants::get_z1]: - Source: 'src/constants.rs', lines 61:0-61:28 *) + Source: 'tests/src/constants.rs', lines 63:0-63:28 *) Definition get_z1 : result i32 := Ok get_z1_z1. (** [constants::add]: - Source: 'src/constants.rs', lines 66:0-66:39 *) + Source: 'tests/src/constants.rs', lines 68:0-68:39 *) Definition add (a : i32) (b : i32) : result i32 := i32_add a b. (** [constants::Q1] - Source: 'src/constants.rs', lines 74:0-74:17 *) + Source: 'tests/src/constants.rs', lines 76:0-76:17 *) Definition q1_body : result i32 := Ok 5%i32. Definition q1 : i32 := q1_body%global. (** [constants::Q2] - Source: 'src/constants.rs', lines 75:0-75:17 *) + Source: 'tests/src/constants.rs', lines 77:0-77:17 *) Definition q2_body : result i32 := Ok q1. Definition q2 : i32 := q2_body%global. (** [constants::Q3] - Source: 'src/constants.rs', lines 76:0-76:17 *) + Source: 'tests/src/constants.rs', lines 78:0-78:17 *) Definition q3_body : result i32 := add q2 3%i32. Definition q3 : i32 := q3_body%global. (** [constants::get_z2]: - Source: 'src/constants.rs', lines 70:0-70:28 *) + Source: 'tests/src/constants.rs', lines 72:0-72:28 *) Definition get_z2 : result i32 := i <- get_z1; i1 <- add i q3; add q1 i1. (** [constants::S1] - Source: 'src/constants.rs', lines 80:0-80:18 *) + Source: 'tests/src/constants.rs', lines 82:0-82:18 *) Definition s1_body : result u32 := Ok 6%u32. Definition s1 : u32 := s1_body%global. (** [constants::S2] - Source: 'src/constants.rs', lines 81:0-81:18 *) + Source: 'tests/src/constants.rs', lines 83:0-83:18 *) Definition s2_body : result u32 := incr s1. Definition s2 : u32 := s2_body%global. (** [constants::S3] - Source: 'src/constants.rs', lines 82:0-82:29 *) + Source: 'tests/src/constants.rs', lines 84:0-84:29 *) Definition s3_body : result (Pair_t u32 u32) := Ok p3. Definition s3 : Pair_t u32 u32 := s3_body%global. (** [constants::S4] - Source: 'src/constants.rs', lines 83:0-83:29 *) + Source: 'tests/src/constants.rs', lines 85:0-85:29 *) Definition s4_body : result (Pair_t u32 u32) := mk_pair1 7%u32 8%u32. Definition s4 : Pair_t u32 u32 := s4_body%global. (** [constants::V] - Source: 'src/constants.rs', lines 86:0-86:31 *) + Source: 'tests/src/constants.rs', lines 88:0-88:31 *) Record V_t (T : Type) (N : usize) := mkV_t { v_x : array T N; }. Arguments mkV_t { _ _ }. Arguments v_x { _ _ }. (** [constants::{constants::V<T, N>#1}::LEN] - Source: 'src/constants.rs', lines 91:4-91:24 *) + Source: 'tests/src/constants.rs', lines 93:4-93:24 *) Definition v_len_body (T : Type) (N : usize) : result usize := Ok N. Definition v_len (T : Type) (N : usize) : usize := (v_len_body T N)%global. (** [constants::use_v]: - Source: 'src/constants.rs', lines 94:0-94:42 *) + Source: 'tests/src/constants.rs', lines 96:0-96:42 *) Definition use_v (T : Type) (N : usize) : result usize := Ok (v_len T N). diff --git a/tests/coq/misc/External_Funs.v b/tests/coq/misc/External_Funs.v index 85f6e4d1..18586012 100644 --- a/tests/coq/misc/External_Funs.v +++ b/tests/coq/misc/External_Funs.v @@ -20,14 +20,14 @@ Definition core_marker_CopyU32 : core_marker_Copy_t u32 := {| |}. (** [external::use_get]: - Source: 'src/external.rs', lines 5:0-5:37 *) + Source: 'tests/src/external.rs', lines 8:0-8:37 *) Definition use_get (rc : core_cell_Cell_t u32) (st : state) : result (state * u32) := core_cell_Cell_get u32 core_marker_CopyU32 rc st . (** [external::incr]: - Source: 'src/external.rs', lines 9:0-9:31 *) + Source: 'tests/src/external.rs', lines 12:0-12:31 *) Definition incr (rc : core_cell_Cell_t u32) (st : state) : result (state * (core_cell_Cell_t u32)) diff --git a/tests/coq/misc/Loops.v b/tests/coq/misc/Loops.v index f396f16f..bc8708f4 100644 --- a/tests/coq/misc/Loops.v +++ b/tests/coq/misc/Loops.v @@ -9,7 +9,7 @@ Local Open Scope Primitives_scope. Module Loops. (** [loops::sum]: loop 0: - Source: 'src/loops.rs', lines 4:0-14:1 *) + Source: 'tests/src/loops.rs', lines 7:0-17:1 *) Fixpoint sum_loop (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := match n with | O => Fail_ OutOfFuel @@ -21,13 +21,13 @@ Fixpoint sum_loop (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := . (** [loops::sum]: - Source: 'src/loops.rs', lines 4:0-4:27 *) + Source: 'tests/src/loops.rs', lines 7:0-7:27 *) Definition sum (n : nat) (max : u32) : result u32 := sum_loop n max 0%u32 0%u32 . (** [loops::sum_with_mut_borrows]: loop 0: - Source: 'src/loops.rs', lines 19:0-31:1 *) + Source: 'tests/src/loops.rs', lines 22:0-34:1 *) Fixpoint sum_with_mut_borrows_loop (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := match n with @@ -43,13 +43,13 @@ Fixpoint sum_with_mut_borrows_loop . (** [loops::sum_with_mut_borrows]: - Source: 'src/loops.rs', lines 19:0-19:44 *) + Source: 'tests/src/loops.rs', lines 22:0-22:44 *) Definition sum_with_mut_borrows (n : nat) (max : u32) : result u32 := sum_with_mut_borrows_loop n max 0%u32 0%u32 . (** [loops::sum_with_shared_borrows]: loop 0: - Source: 'src/loops.rs', lines 34:0-48:1 *) + Source: 'tests/src/loops.rs', lines 37:0-51:1 *) Fixpoint sum_with_shared_borrows_loop (n : nat) (max : u32) (i : u32) (s : u32) : result u32 := match n with @@ -65,13 +65,13 @@ Fixpoint sum_with_shared_borrows_loop . (** [loops::sum_with_shared_borrows]: - Source: 'src/loops.rs', lines 34:0-34:47 *) + Source: 'tests/src/loops.rs', lines 37:0-37:47 *) Definition sum_with_shared_borrows (n : nat) (max : u32) : result u32 := sum_with_shared_borrows_loop n max 0%u32 0%u32 . (** [loops::sum_array]: loop 0: - Source: 'src/loops.rs', lines 50:0-58:1 *) + Source: 'tests/src/loops.rs', lines 53:0-61:1 *) Fixpoint sum_array_loop (N : usize) (n : nat) (a : array u32 N) (i : usize) (s : u32) : result u32 := match n with @@ -88,13 +88,13 @@ Fixpoint sum_array_loop . (** [loops::sum_array]: - Source: 'src/loops.rs', lines 50:0-50:52 *) + Source: 'tests/src/loops.rs', lines 53:0-53:52 *) Definition sum_array (N : usize) (n : nat) (a : array u32 N) : result u32 := sum_array_loop N n a 0%usize 0%u32 . (** [loops::clear]: loop 0: - Source: 'src/loops.rs', lines 62:0-68:1 *) + Source: 'tests/src/loops.rs', lines 65:0-71:1 *) Fixpoint clear_loop (n : nat) (v : alloc_vec_Vec u32) (i : usize) : result (alloc_vec_Vec u32) := match n with @@ -115,14 +115,14 @@ Fixpoint clear_loop . (** [loops::clear]: - Source: 'src/loops.rs', lines 62:0-62:30 *) + Source: 'tests/src/loops.rs', lines 65:0-65:30 *) Definition clear (n : nat) (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) := clear_loop n v 0%usize . (** [loops::List] - Source: 'src/loops.rs', lines 70:0-70:16 *) + Source: 'tests/src/loops.rs', lines 73:0-73:16 *) Inductive List_t (T : Type) := | List_Cons : T -> List_t T -> List_t T | List_Nil : List_t T @@ -132,7 +132,7 @@ Arguments List_Cons { _ }. Arguments List_Nil { _ }. (** [loops::list_mem]: loop 0: - Source: 'src/loops.rs', lines 76:0-85:1 *) + Source: 'tests/src/loops.rs', lines 79:0-88:1 *) Fixpoint list_mem_loop (n : nat) (x : u32) (ls : List_t u32) : result bool := match n with | O => Fail_ OutOfFuel @@ -145,13 +145,13 @@ Fixpoint list_mem_loop (n : nat) (x : u32) (ls : List_t u32) : result bool := . (** [loops::list_mem]: - Source: 'src/loops.rs', lines 76:0-76:52 *) + Source: 'tests/src/loops.rs', lines 79:0-79:52 *) Definition list_mem (n : nat) (x : u32) (ls : List_t u32) : result bool := list_mem_loop n x ls . (** [loops::list_nth_mut_loop]: loop 0: - Source: 'src/loops.rs', lines 88:0-98:1 *) + Source: 'tests/src/loops.rs', lines 91:0-101:1 *) Fixpoint list_nth_mut_loop_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result (T * (T -> result (List_t T))) @@ -175,7 +175,7 @@ Fixpoint list_nth_mut_loop_loop . (** [loops::list_nth_mut_loop]: - Source: 'src/loops.rs', lines 88:0-88:71 *) + Source: 'tests/src/loops.rs', lines 91:0-91:71 *) Definition list_nth_mut_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result (T * (T -> result (List_t T))) @@ -184,7 +184,7 @@ Definition list_nth_mut_loop . (** [loops::list_nth_shared_loop]: loop 0: - Source: 'src/loops.rs', lines 101:0-111:1 *) + Source: 'tests/src/loops.rs', lines 104:0-114:1 *) Fixpoint list_nth_shared_loop_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := match n with @@ -201,14 +201,14 @@ Fixpoint list_nth_shared_loop_loop . (** [loops::list_nth_shared_loop]: - Source: 'src/loops.rs', lines 101:0-101:66 *) + Source: 'tests/src/loops.rs', lines 104:0-104:66 *) Definition list_nth_shared_loop (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := list_nth_shared_loop_loop T n ls i . (** [loops::get_elem_mut]: loop 0: - Source: 'src/loops.rs', lines 113:0-127:1 *) + Source: 'tests/src/loops.rs', lines 116:0-130:1 *) Fixpoint get_elem_mut_loop (n : nat) (x : usize) (ls : List_t usize) : result (usize * (usize -> result (List_t usize))) @@ -233,7 +233,7 @@ Fixpoint get_elem_mut_loop . (** [loops::get_elem_mut]: - Source: 'src/loops.rs', lines 113:0-113:73 *) + Source: 'tests/src/loops.rs', lines 116:0-116:73 *) Definition get_elem_mut (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) : result (usize * (usize -> result (alloc_vec_Vec (List_t usize)))) @@ -249,7 +249,7 @@ Definition get_elem_mut . (** [loops::get_elem_shared]: loop 0: - Source: 'src/loops.rs', lines 129:0-143:1 *) + Source: 'tests/src/loops.rs', lines 132:0-146:1 *) Fixpoint get_elem_shared_loop (n : nat) (x : usize) (ls : List_t usize) : result usize := match n with @@ -263,7 +263,7 @@ Fixpoint get_elem_shared_loop . (** [loops::get_elem_shared]: - Source: 'src/loops.rs', lines 129:0-129:68 *) + Source: 'tests/src/loops.rs', lines 132:0-132:68 *) Definition get_elem_shared (n : nat) (slots : alloc_vec_Vec (List_t usize)) (x : usize) : result usize @@ -275,7 +275,7 @@ Definition get_elem_shared . (** [loops::id_mut]: - Source: 'src/loops.rs', lines 145:0-145:50 *) + Source: 'tests/src/loops.rs', lines 148:0-148:50 *) Definition id_mut (T : Type) (ls : List_t T) : result ((List_t T) * (List_t T -> result (List_t T))) @@ -284,12 +284,12 @@ Definition id_mut . (** [loops::id_shared]: - Source: 'src/loops.rs', lines 149:0-149:45 *) + Source: 'tests/src/loops.rs', lines 152:0-152:45 *) Definition id_shared (T : Type) (ls : List_t T) : result (List_t T) := Ok ls. (** [loops::list_nth_mut_loop_with_id]: loop 0: - Source: 'src/loops.rs', lines 154:0-165:1 *) + Source: 'tests/src/loops.rs', lines 157:0-168:1 *) Fixpoint list_nth_mut_loop_with_id_loop (T : Type) (n : nat) (i : u32) (ls : List_t T) : result (T * (T -> result (List_t T))) @@ -313,7 +313,7 @@ Fixpoint list_nth_mut_loop_with_id_loop . (** [loops::list_nth_mut_loop_with_id]: - Source: 'src/loops.rs', lines 154:0-154:75 *) + Source: 'tests/src/loops.rs', lines 157:0-157:75 *) Definition list_nth_mut_loop_with_id (T : Type) (n : nat) (ls : List_t T) (i : u32) : result (T * (T -> result (List_t T))) @@ -327,7 +327,7 @@ Definition list_nth_mut_loop_with_id . (** [loops::list_nth_shared_loop_with_id]: loop 0: - Source: 'src/loops.rs', lines 168:0-179:1 *) + Source: 'tests/src/loops.rs', lines 171:0-182:1 *) Fixpoint list_nth_shared_loop_with_id_loop (T : Type) (n : nat) (i : u32) (ls : List_t T) : result T := match n with @@ -345,14 +345,14 @@ Fixpoint list_nth_shared_loop_with_id_loop . (** [loops::list_nth_shared_loop_with_id]: - Source: 'src/loops.rs', lines 168:0-168:70 *) + Source: 'tests/src/loops.rs', lines 171:0-171:70 *) Definition list_nth_shared_loop_with_id (T : Type) (n : nat) (ls : List_t T) (i : u32) : result T := ls1 <- id_shared T ls; list_nth_shared_loop_with_id_loop T n i ls1 . (** [loops::list_nth_mut_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 184:0-205:1 *) + Source: 'tests/src/loops.rs', lines 187:0-208:1 *) Fixpoint list_nth_mut_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T)) * (T -> result (List_t T))) @@ -386,7 +386,7 @@ Fixpoint list_nth_mut_loop_pair_loop . (** [loops::list_nth_mut_loop_pair]: - Source: 'src/loops.rs', lines 184:0-188:27 *) + Source: 'tests/src/loops.rs', lines 187:0-191:27 *) Definition list_nth_mut_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T)) * (T -> result (List_t T))) @@ -395,7 +395,7 @@ Definition list_nth_mut_loop_pair . (** [loops::list_nth_shared_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 208:0-229:1 *) + Source: 'tests/src/loops.rs', lines 211:0-232:1 *) Fixpoint list_nth_shared_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) @@ -419,7 +419,7 @@ Fixpoint list_nth_shared_loop_pair_loop . (** [loops::list_nth_shared_loop_pair]: - Source: 'src/loops.rs', lines 208:0-212:19 *) + Source: 'tests/src/loops.rs', lines 211:0-215:19 *) Definition list_nth_shared_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) @@ -428,7 +428,7 @@ Definition list_nth_shared_loop_pair . (** [loops::list_nth_mut_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 233:0-248:1 *) + Source: 'tests/src/loops.rs', lines 236:0-251:1 *) Fixpoint list_nth_mut_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * ((T * T) -> result ((List_t T) * (List_t T)))) @@ -464,7 +464,7 @@ Fixpoint list_nth_mut_loop_pair_merge_loop . (** [loops::list_nth_mut_loop_pair_merge]: - Source: 'src/loops.rs', lines 233:0-237:27 *) + Source: 'tests/src/loops.rs', lines 236:0-240:27 *) Definition list_nth_mut_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * ((T * T) -> result ((List_t T) * (List_t T)))) @@ -473,7 +473,7 @@ Definition list_nth_mut_loop_pair_merge . (** [loops::list_nth_shared_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 251:0-266:1 *) + Source: 'tests/src/loops.rs', lines 254:0-269:1 *) Fixpoint list_nth_shared_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) @@ -498,7 +498,7 @@ Fixpoint list_nth_shared_loop_pair_merge_loop . (** [loops::list_nth_shared_loop_pair_merge]: - Source: 'src/loops.rs', lines 251:0-255:19 *) + Source: 'tests/src/loops.rs', lines 254:0-258:19 *) Definition list_nth_shared_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result (T * T) @@ -507,7 +507,7 @@ Definition list_nth_shared_loop_pair_merge . (** [loops::list_nth_mut_shared_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 269:0-284:1 *) + Source: 'tests/src/loops.rs', lines 272:0-287:1 *) Fixpoint list_nth_mut_shared_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T))) @@ -538,7 +538,7 @@ Fixpoint list_nth_mut_shared_loop_pair_loop . (** [loops::list_nth_mut_shared_loop_pair]: - Source: 'src/loops.rs', lines 269:0-273:23 *) + Source: 'tests/src/loops.rs', lines 272:0-276:23 *) Definition list_nth_mut_shared_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T))) @@ -547,7 +547,7 @@ Definition list_nth_mut_shared_loop_pair . (** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 288:0-303:1 *) + Source: 'tests/src/loops.rs', lines 291:0-306:1 *) Fixpoint list_nth_mut_shared_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T))) @@ -578,7 +578,7 @@ Fixpoint list_nth_mut_shared_loop_pair_merge_loop . (** [loops::list_nth_mut_shared_loop_pair_merge]: - Source: 'src/loops.rs', lines 288:0-292:23 *) + Source: 'tests/src/loops.rs', lines 291:0-295:23 *) Definition list_nth_mut_shared_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T))) @@ -587,7 +587,7 @@ Definition list_nth_mut_shared_loop_pair_merge . (** [loops::list_nth_shared_mut_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 307:0-322:1 *) + Source: 'tests/src/loops.rs', lines 310:0-325:1 *) Fixpoint list_nth_shared_mut_loop_pair_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T))) @@ -618,7 +618,7 @@ Fixpoint list_nth_shared_mut_loop_pair_loop . (** [loops::list_nth_shared_mut_loop_pair]: - Source: 'src/loops.rs', lines 307:0-311:23 *) + Source: 'tests/src/loops.rs', lines 310:0-314:23 *) Definition list_nth_shared_mut_loop_pair (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T))) @@ -627,7 +627,7 @@ Definition list_nth_shared_mut_loop_pair . (** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 326:0-341:1 *) + Source: 'tests/src/loops.rs', lines 329:0-344:1 *) Fixpoint list_nth_shared_mut_loop_pair_merge_loop (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T))) @@ -658,7 +658,7 @@ Fixpoint list_nth_shared_mut_loop_pair_merge_loop . (** [loops::list_nth_shared_mut_loop_pair_merge]: - Source: 'src/loops.rs', lines 326:0-330:23 *) + Source: 'tests/src/loops.rs', lines 329:0-333:23 *) Definition list_nth_shared_mut_loop_pair_merge (T : Type) (n : nat) (ls0 : List_t T) (ls1 : List_t T) (i : u32) : result ((T * T) * (T -> result (List_t T))) @@ -667,7 +667,7 @@ Definition list_nth_shared_mut_loop_pair_merge . (** [loops::ignore_input_mut_borrow]: loop 0: - Source: 'src/loops.rs', lines 345:0-349:1 *) + Source: 'tests/src/loops.rs', lines 348:0-352:1 *) Fixpoint ignore_input_mut_borrow_loop (n : nat) (i : u32) : result unit := match n with | O => Fail_ OutOfFuel @@ -679,14 +679,14 @@ Fixpoint ignore_input_mut_borrow_loop (n : nat) (i : u32) : result unit := . (** [loops::ignore_input_mut_borrow]: - Source: 'src/loops.rs', lines 345:0-345:56 *) + Source: 'tests/src/loops.rs', lines 348:0-348:56 *) Definition ignore_input_mut_borrow (n : nat) (_a : u32) (i : u32) : result u32 := _ <- ignore_input_mut_borrow_loop n i; Ok _a . (** [loops::incr_ignore_input_mut_borrow]: loop 0: - Source: 'src/loops.rs', lines 353:0-358:1 *) + Source: 'tests/src/loops.rs', lines 356:0-361:1 *) Fixpoint incr_ignore_input_mut_borrow_loop (n : nat) (i : u32) : result unit := match n with | O => Fail_ OutOfFuel @@ -698,14 +698,14 @@ Fixpoint incr_ignore_input_mut_borrow_loop (n : nat) (i : u32) : result unit := . (** [loops::incr_ignore_input_mut_borrow]: - Source: 'src/loops.rs', lines 353:0-353:60 *) + Source: 'tests/src/loops.rs', lines 356:0-356:60 *) Definition incr_ignore_input_mut_borrow (n : nat) (a : u32) (i : u32) : result u32 := a1 <- u32_add a 1%u32; _ <- incr_ignore_input_mut_borrow_loop n i; Ok a1 . (** [loops::ignore_input_shared_borrow]: loop 0: - Source: 'src/loops.rs', lines 362:0-366:1 *) + Source: 'tests/src/loops.rs', lines 365:0-369:1 *) Fixpoint ignore_input_shared_borrow_loop (n : nat) (i : u32) : result unit := match n with | O => Fail_ OutOfFuel @@ -717,7 +717,7 @@ Fixpoint ignore_input_shared_borrow_loop (n : nat) (i : u32) : result unit := . (** [loops::ignore_input_shared_borrow]: - Source: 'src/loops.rs', lines 362:0-362:59 *) + Source: 'tests/src/loops.rs', lines 365:0-365:59 *) Definition ignore_input_shared_borrow (n : nat) (_a : u32) (i : u32) : result u32 := _ <- ignore_input_shared_borrow_loop n i; Ok _a diff --git a/tests/coq/misc/NoNestedBorrows.v b/tests/coq/misc/NoNestedBorrows.v index b19ea2df..434b820c 100644 --- a/tests/coq/misc/NoNestedBorrows.v +++ b/tests/coq/misc/NoNestedBorrows.v @@ -9,7 +9,7 @@ Local Open Scope Primitives_scope. Module NoNestedBorrows. (** [no_nested_borrows::Pair] - Source: 'src/no_nested_borrows.rs', lines 4:0-4:23 *) + Source: 'tests/src/no_nested_borrows.rs', lines 6:0-6:23 *) Record Pair_t (T1 T2 : Type) := mkPair_t { pair_x : T1; pair_y : T2; }. Arguments mkPair_t { _ _ }. @@ -17,7 +17,7 @@ Arguments pair_x { _ _ }. Arguments pair_y { _ _ }. (** [no_nested_borrows::List] - Source: 'src/no_nested_borrows.rs', lines 9:0-9:16 *) + Source: 'tests/src/no_nested_borrows.rs', lines 11:0-11:16 *) Inductive List_t (T : Type) := | List_Cons : T -> List_t T -> List_t T | List_Nil : List_t T @@ -27,25 +27,25 @@ Arguments List_Cons { _ }. Arguments List_Nil { _ }. (** [no_nested_borrows::One] - Source: 'src/no_nested_borrows.rs', lines 20:0-20:16 *) + Source: 'tests/src/no_nested_borrows.rs', lines 22:0-22:16 *) Inductive One_t (T1 : Type) := | One_One : T1 -> One_t T1. Arguments One_One { _ }. (** [no_nested_borrows::EmptyEnum] - Source: 'src/no_nested_borrows.rs', lines 26:0-26:18 *) + Source: 'tests/src/no_nested_borrows.rs', lines 28:0-28:18 *) Inductive EmptyEnum_t := | EmptyEnum_Empty : EmptyEnum_t. (** [no_nested_borrows::Enum] - Source: 'src/no_nested_borrows.rs', lines 32:0-32:13 *) + Source: 'tests/src/no_nested_borrows.rs', lines 34:0-34:13 *) Inductive Enum_t := | Enum_Variant1 : Enum_t | Enum_Variant2 : Enum_t. (** [no_nested_borrows::EmptyStruct] - Source: 'src/no_nested_borrows.rs', lines 39:0-39:22 *) + Source: 'tests/src/no_nested_borrows.rs', lines 41:0-41:22 *) Definition EmptyStruct_t : Type := unit. (** [no_nested_borrows::Sum] - Source: 'src/no_nested_borrows.rs', lines 41:0-41:20 *) + Source: 'tests/src/no_nested_borrows.rs', lines 43:0-43:20 *) Inductive Sum_t (T1 T2 : Type) := | Sum_Left : T1 -> Sum_t T1 T2 | Sum_Right : T2 -> Sum_t T1 T2 @@ -55,22 +55,22 @@ Arguments Sum_Left { _ _ }. Arguments Sum_Right { _ _ }. (** [no_nested_borrows::cast_u32_to_i32]: - Source: 'src/no_nested_borrows.rs', lines 46:0-46:37 *) + Source: 'tests/src/no_nested_borrows.rs', lines 48:0-48:37 *) Definition cast_u32_to_i32 (x : u32) : result i32 := scalar_cast U32 I32 x. (** [no_nested_borrows::cast_bool_to_i32]: - Source: 'src/no_nested_borrows.rs', lines 50:0-50:39 *) + Source: 'tests/src/no_nested_borrows.rs', lines 52:0-52:39 *) Definition cast_bool_to_i32 (x : bool) : result i32 := scalar_cast_bool I32 x. (** [no_nested_borrows::cast_bool_to_bool]: - Source: 'src/no_nested_borrows.rs', lines 55:0-55:41 *) + Source: 'tests/src/no_nested_borrows.rs', lines 57:0-57:41 *) Definition cast_bool_to_bool (x : bool) : result bool := Ok x. (** [no_nested_borrows::test2]: - Source: 'src/no_nested_borrows.rs', lines 60:0-60:14 *) + Source: 'tests/src/no_nested_borrows.rs', lines 62:0-62:14 *) Definition test2 : result unit := _ <- u32_add 23%u32 44%u32; Ok tt. @@ -78,13 +78,13 @@ Definition test2 : result unit := Check (test2 )%return. (** [no_nested_borrows::get_max]: - Source: 'src/no_nested_borrows.rs', lines 72:0-72:37 *) + Source: 'tests/src/no_nested_borrows.rs', lines 74:0-74:37 *) Definition get_max (x : u32) (y : u32) : result u32 := if x s>= y then Ok x else Ok y . (** [no_nested_borrows::test3]: - Source: 'src/no_nested_borrows.rs', lines 80:0-80:14 *) + Source: 'tests/src/no_nested_borrows.rs', lines 82:0-82:14 *) Definition test3 : result unit := x <- get_max 4%u32 3%u32; y <- get_max 10%u32 11%u32; @@ -96,7 +96,7 @@ Definition test3 : result unit := Check (test3 )%return. (** [no_nested_borrows::test_neg1]: - Source: 'src/no_nested_borrows.rs', lines 87:0-87:18 *) + Source: 'tests/src/no_nested_borrows.rs', lines 89:0-89:18 *) Definition test_neg1 : result unit := y <- i32_neg 3%i32; if negb (y s= (-3)%i32) then Fail_ Failure else Ok tt . @@ -105,7 +105,7 @@ Definition test_neg1 : result unit := Check (test_neg1 )%return. (** [no_nested_borrows::refs_test1]: - Source: 'src/no_nested_borrows.rs', lines 94:0-94:19 *) + Source: 'tests/src/no_nested_borrows.rs', lines 96:0-96:19 *) Definition refs_test1 : result unit := if negb (1%i32 s= 1%i32) then Fail_ Failure else Ok tt . @@ -114,7 +114,7 @@ Definition refs_test1 : result unit := Check (refs_test1 )%return. (** [no_nested_borrows::refs_test2]: - Source: 'src/no_nested_borrows.rs', lines 105:0-105:19 *) + Source: 'tests/src/no_nested_borrows.rs', lines 107:0-107:19 *) Definition refs_test2 : result unit := if negb (2%i32 s= 2%i32) then Fail_ Failure @@ -131,7 +131,7 @@ Definition refs_test2 : result unit := Check (refs_test2 )%return. (** [no_nested_borrows::test_list1]: - Source: 'src/no_nested_borrows.rs', lines 121:0-121:19 *) + Source: 'tests/src/no_nested_borrows.rs', lines 123:0-123:19 *) Definition test_list1 : result unit := Ok tt. @@ -139,7 +139,7 @@ Definition test_list1 : result unit := Check (test_list1 )%return. (** [no_nested_borrows::test_box1]: - Source: 'src/no_nested_borrows.rs', lines 126:0-126:18 *) + Source: 'tests/src/no_nested_borrows.rs', lines 128:0-128:18 *) Definition test_box1 : result unit := p <- alloc_boxed_Box_deref_mut i32 0%i32; let (_, deref_mut_back) := p in @@ -152,24 +152,24 @@ Definition test_box1 : result unit := Check (test_box1 )%return. (** [no_nested_borrows::copy_int]: - Source: 'src/no_nested_borrows.rs', lines 136:0-136:30 *) + Source: 'tests/src/no_nested_borrows.rs', lines 138:0-138:30 *) Definition copy_int (x : i32) : result i32 := Ok x. (** [no_nested_borrows::test_unreachable]: - Source: 'src/no_nested_borrows.rs', lines 142:0-142:32 *) + Source: 'tests/src/no_nested_borrows.rs', lines 144:0-144:32 *) Definition test_unreachable (b : bool) : result unit := if b then Fail_ Failure else Ok tt . (** [no_nested_borrows::test_panic]: - Source: 'src/no_nested_borrows.rs', lines 150:0-150:26 *) + Source: 'tests/src/no_nested_borrows.rs', lines 152:0-152:26 *) Definition test_panic (b : bool) : result unit := if b then Fail_ Failure else Ok tt . (** [no_nested_borrows::test_copy_int]: - Source: 'src/no_nested_borrows.rs', lines 157:0-157:22 *) + Source: 'tests/src/no_nested_borrows.rs', lines 159:0-159:22 *) Definition test_copy_int : result unit := y <- copy_int 0%i32; if negb (0%i32 s= y) then Fail_ Failure else Ok tt . @@ -178,13 +178,13 @@ Definition test_copy_int : result unit := Check (test_copy_int )%return. (** [no_nested_borrows::is_cons]: - Source: 'src/no_nested_borrows.rs', lines 164:0-164:38 *) + Source: 'tests/src/no_nested_borrows.rs', lines 166:0-166:38 *) Definition is_cons (T : Type) (l : List_t T) : result bool := match l with | List_Cons _ _ => Ok true | List_Nil => Ok false end . (** [no_nested_borrows::test_is_cons]: - Source: 'src/no_nested_borrows.rs', lines 171:0-171:21 *) + Source: 'tests/src/no_nested_borrows.rs', lines 173:0-173:21 *) Definition test_is_cons : result unit := b <- is_cons i32 (List_Cons 0%i32 List_Nil); if negb b then Fail_ Failure else Ok tt @@ -194,13 +194,13 @@ Definition test_is_cons : result unit := Check (test_is_cons )%return. (** [no_nested_borrows::split_list]: - Source: 'src/no_nested_borrows.rs', lines 177:0-177:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 179:0-179:48 *) Definition split_list (T : Type) (l : List_t T) : result (T * (List_t T)) := match l with | List_Cons hd tl => Ok (hd, tl) | List_Nil => Fail_ Failure end . (** [no_nested_borrows::test_split_list]: - Source: 'src/no_nested_borrows.rs', lines 185:0-185:24 *) + Source: 'tests/src/no_nested_borrows.rs', lines 187:0-187:24 *) Definition test_split_list : result unit := p <- split_list i32 (List_Cons 0%i32 List_Nil); let (hd, _) := p in @@ -211,7 +211,7 @@ Definition test_split_list : result unit := Check (test_split_list )%return. (** [no_nested_borrows::choose]: - Source: 'src/no_nested_borrows.rs', lines 192:0-192:70 *) + Source: 'tests/src/no_nested_borrows.rs', lines 194:0-194:70 *) Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b @@ -220,7 +220,7 @@ Definition choose . (** [no_nested_borrows::choose_test]: - Source: 'src/no_nested_borrows.rs', lines 200:0-200:20 *) + Source: 'tests/src/no_nested_borrows.rs', lines 202:0-202:20 *) Definition choose_test : result unit := p <- choose i32 true 0%i32 0%i32; let (z, choose_back) := p in @@ -239,18 +239,18 @@ Definition choose_test : result unit := Check (choose_test )%return. (** [no_nested_borrows::test_char]: - Source: 'src/no_nested_borrows.rs', lines 212:0-212:26 *) + Source: 'tests/src/no_nested_borrows.rs', lines 214:0-214:26 *) Definition test_char : result char := Ok (char_of_byte Coq.Init.Byte.x61). (** [no_nested_borrows::Tree] - Source: 'src/no_nested_borrows.rs', lines 217:0-217:16 *) + Source: 'tests/src/no_nested_borrows.rs', lines 219:0-219:16 *) Inductive Tree_t (T : Type) := | Tree_Leaf : T -> Tree_t T | Tree_Node : T -> NodeElem_t T -> Tree_t T -> Tree_t T (** [no_nested_borrows::NodeElem] - Source: 'src/no_nested_borrows.rs', lines 222:0-222:20 *) + Source: 'tests/src/no_nested_borrows.rs', lines 224:0-224:20 *) with NodeElem_t (T : Type) := | NodeElem_Cons : Tree_t T -> NodeElem_t T -> NodeElem_t T | NodeElem_Nil : NodeElem_t T @@ -263,7 +263,7 @@ Arguments NodeElem_Cons { _ }. Arguments NodeElem_Nil { _ }. (** [no_nested_borrows::list_length]: - Source: 'src/no_nested_borrows.rs', lines 257:0-257:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 259:0-259:48 *) Fixpoint list_length (T : Type) (l : List_t T) : result u32 := match l with | List_Cons _ l1 => i <- list_length T l1; u32_add 1%u32 i @@ -272,7 +272,7 @@ Fixpoint list_length (T : Type) (l : List_t T) : result u32 := . (** [no_nested_borrows::list_nth_shared]: - Source: 'src/no_nested_borrows.rs', lines 265:0-265:62 *) + Source: 'tests/src/no_nested_borrows.rs', lines 267:0-267:62 *) Fixpoint list_nth_shared (T : Type) (l : List_t T) (i : u32) : result T := match l with | List_Cons x tl => @@ -284,7 +284,7 @@ Fixpoint list_nth_shared (T : Type) (l : List_t T) (i : u32) : result T := . (** [no_nested_borrows::list_nth_mut]: - Source: 'src/no_nested_borrows.rs', lines 281:0-281:67 *) + Source: 'tests/src/no_nested_borrows.rs', lines 283:0-283:67 *) Fixpoint list_nth_mut (T : Type) (l : List_t T) (i : u32) : result (T * (T -> result (List_t T))) @@ -305,7 +305,7 @@ Fixpoint list_nth_mut . (** [no_nested_borrows::list_rev_aux]: - Source: 'src/no_nested_borrows.rs', lines 297:0-297:63 *) + Source: 'tests/src/no_nested_borrows.rs', lines 299:0-299:63 *) Fixpoint list_rev_aux (T : Type) (li : List_t T) (lo : List_t T) : result (List_t T) := match li with @@ -315,14 +315,14 @@ Fixpoint list_rev_aux . (** [no_nested_borrows::list_rev]: - Source: 'src/no_nested_borrows.rs', lines 311:0-311:42 *) + Source: 'tests/src/no_nested_borrows.rs', lines 313:0-313:42 *) Definition list_rev (T : Type) (l : List_t T) : result (List_t T) := let (li, _) := core_mem_replace (List_t T) l List_Nil in list_rev_aux T li List_Nil . (** [no_nested_borrows::test_list_functions]: - Source: 'src/no_nested_borrows.rs', lines 316:0-316:28 *) + Source: 'tests/src/no_nested_borrows.rs', lines 318:0-318:28 *) Definition test_list_functions : result unit := let l := List_Cons 2%i32 List_Nil in let l1 := List_Cons 1%i32 l in @@ -361,7 +361,7 @@ Definition test_list_functions : result unit := Check (test_list_functions )%return. (** [no_nested_borrows::id_mut_pair1]: - Source: 'src/no_nested_borrows.rs', lines 332:0-332:89 *) + Source: 'tests/src/no_nested_borrows.rs', lines 334:0-334:89 *) Definition id_mut_pair1 (T1 T2 : Type) (x : T1) (y : T2) : result ((T1 * T2) * ((T1 * T2) -> result (T1 * T2))) @@ -370,7 +370,7 @@ Definition id_mut_pair1 . (** [no_nested_borrows::id_mut_pair2]: - Source: 'src/no_nested_borrows.rs', lines 336:0-336:88 *) + Source: 'tests/src/no_nested_borrows.rs', lines 338:0-338:88 *) Definition id_mut_pair2 (T1 T2 : Type) (p : (T1 * T2)) : result ((T1 * T2) * ((T1 * T2) -> result (T1 * T2))) @@ -379,7 +379,7 @@ Definition id_mut_pair2 . (** [no_nested_borrows::id_mut_pair3]: - Source: 'src/no_nested_borrows.rs', lines 340:0-340:93 *) + Source: 'tests/src/no_nested_borrows.rs', lines 342:0-342:93 *) Definition id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : result ((T1 * T2) * (T1 -> result T1) * (T2 -> result T2)) @@ -388,7 +388,7 @@ Definition id_mut_pair3 . (** [no_nested_borrows::id_mut_pair4]: - Source: 'src/no_nested_borrows.rs', lines 344:0-344:92 *) + Source: 'tests/src/no_nested_borrows.rs', lines 346:0-346:92 *) Definition id_mut_pair4 (T1 T2 : Type) (p : (T1 * T2)) : result ((T1 * T2) * (T1 -> result T1) * (T2 -> result T2)) @@ -397,7 +397,7 @@ Definition id_mut_pair4 . (** [no_nested_borrows::StructWithTuple] - Source: 'src/no_nested_borrows.rs', lines 351:0-351:34 *) + Source: 'tests/src/no_nested_borrows.rs', lines 353:0-353:34 *) Record StructWithTuple_t (T1 T2 : Type) := mkStructWithTuple_t { structWithTuple_p : (T1 * T2); @@ -408,25 +408,25 @@ Arguments mkStructWithTuple_t { _ _ }. Arguments structWithTuple_p { _ _ }. (** [no_nested_borrows::new_tuple1]: - Source: 'src/no_nested_borrows.rs', lines 355:0-355:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 357:0-357:48 *) Definition new_tuple1 : result (StructWithTuple_t u32 u32) := Ok {| structWithTuple_p := (1%u32, 2%u32) |} . (** [no_nested_borrows::new_tuple2]: - Source: 'src/no_nested_borrows.rs', lines 359:0-359:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 361:0-361:48 *) Definition new_tuple2 : result (StructWithTuple_t i16 i16) := Ok {| structWithTuple_p := (1%i16, 2%i16) |} . (** [no_nested_borrows::new_tuple3]: - Source: 'src/no_nested_borrows.rs', lines 363:0-363:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 365:0-365:48 *) Definition new_tuple3 : result (StructWithTuple_t u64 i64) := Ok {| structWithTuple_p := (1%u64, 2%i64) |} . (** [no_nested_borrows::StructWithPair] - Source: 'src/no_nested_borrows.rs', lines 368:0-368:33 *) + Source: 'tests/src/no_nested_borrows.rs', lines 370:0-370:33 *) Record StructWithPair_t (T1 T2 : Type) := mkStructWithPair_t { structWithPair_p : Pair_t T1 T2; @@ -437,13 +437,13 @@ Arguments mkStructWithPair_t { _ _ }. Arguments structWithPair_p { _ _ }. (** [no_nested_borrows::new_pair1]: - Source: 'src/no_nested_borrows.rs', lines 372:0-372:46 *) + Source: 'tests/src/no_nested_borrows.rs', lines 374:0-374:46 *) Definition new_pair1 : result (StructWithPair_t u32 u32) := Ok {| structWithPair_p := {| pair_x := 1%u32; pair_y := 2%u32 |} |} . (** [no_nested_borrows::test_constants]: - Source: 'src/no_nested_borrows.rs', lines 380:0-380:23 *) + Source: 'tests/src/no_nested_borrows.rs', lines 382:0-382:23 *) Definition test_constants : result unit := swt <- new_tuple1; let (i, _) := swt.(structWithTuple_p) in @@ -470,7 +470,7 @@ Definition test_constants : result unit := Check (test_constants )%return. (** [no_nested_borrows::test_weird_borrows1]: - Source: 'src/no_nested_borrows.rs', lines 389:0-389:28 *) + Source: 'tests/src/no_nested_borrows.rs', lines 391:0-391:28 *) Definition test_weird_borrows1 : result unit := Ok tt. @@ -478,78 +478,78 @@ Definition test_weird_borrows1 : result unit := Check (test_weird_borrows1 )%return. (** [no_nested_borrows::test_mem_replace]: - Source: 'src/no_nested_borrows.rs', lines 399:0-399:37 *) + Source: 'tests/src/no_nested_borrows.rs', lines 401:0-401:37 *) Definition test_mem_replace (px : u32) : result u32 := let (y, _) := core_mem_replace u32 px 1%u32 in if negb (y s= 0%u32) then Fail_ Failure else Ok 2%u32 . (** [no_nested_borrows::test_shared_borrow_bool1]: - Source: 'src/no_nested_borrows.rs', lines 406:0-406:47 *) + Source: 'tests/src/no_nested_borrows.rs', lines 408:0-408:47 *) Definition test_shared_borrow_bool1 (b : bool) : result u32 := if b then Ok 0%u32 else Ok 1%u32 . (** [no_nested_borrows::test_shared_borrow_bool2]: - Source: 'src/no_nested_borrows.rs', lines 419:0-419:40 *) + Source: 'tests/src/no_nested_borrows.rs', lines 421:0-421:40 *) Definition test_shared_borrow_bool2 : result u32 := Ok 0%u32. (** [no_nested_borrows::test_shared_borrow_enum1]: - Source: 'src/no_nested_borrows.rs', lines 434:0-434:52 *) + Source: 'tests/src/no_nested_borrows.rs', lines 436:0-436:52 *) Definition test_shared_borrow_enum1 (l : List_t u32) : result u32 := match l with | List_Cons _ _ => Ok 1%u32 | List_Nil => Ok 0%u32 end . (** [no_nested_borrows::test_shared_borrow_enum2]: - Source: 'src/no_nested_borrows.rs', lines 446:0-446:40 *) + Source: 'tests/src/no_nested_borrows.rs', lines 448:0-448:40 *) Definition test_shared_borrow_enum2 : result u32 := Ok 0%u32. (** [no_nested_borrows::incr]: - Source: 'src/no_nested_borrows.rs', lines 457:0-457:24 *) + Source: 'tests/src/no_nested_borrows.rs', lines 459:0-459:24 *) Definition incr (x : u32) : result u32 := u32_add x 1%u32. (** [no_nested_borrows::call_incr]: - Source: 'src/no_nested_borrows.rs', lines 461:0-461:35 *) + Source: 'tests/src/no_nested_borrows.rs', lines 463:0-463:35 *) Definition call_incr (x : u32) : result u32 := incr x. (** [no_nested_borrows::read_then_incr]: - Source: 'src/no_nested_borrows.rs', lines 466:0-466:41 *) + Source: 'tests/src/no_nested_borrows.rs', lines 468:0-468:41 *) Definition read_then_incr (x : u32) : result (u32 * u32) := x1 <- u32_add x 1%u32; Ok (x, x1) . (** [no_nested_borrows::Tuple] - Source: 'src/no_nested_borrows.rs', lines 472:0-472:24 *) + Source: 'tests/src/no_nested_borrows.rs', lines 474:0-474:24 *) Definition Tuple_t (T1 T2 : Type) : Type := T1 * T2. (** [no_nested_borrows::use_tuple_struct]: - Source: 'src/no_nested_borrows.rs', lines 474:0-474:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 476:0-476:48 *) Definition use_tuple_struct (x : Tuple_t u32 u32) : result (Tuple_t u32 u32) := let (_, i) := x in Ok (1%u32, i) . (** [no_nested_borrows::create_tuple_struct]: - Source: 'src/no_nested_borrows.rs', lines 478:0-478:61 *) + Source: 'tests/src/no_nested_borrows.rs', lines 480:0-480:61 *) Definition create_tuple_struct (x : u32) (y : u64) : result (Tuple_t u32 u64) := Ok (x, y) . (** [no_nested_borrows::IdType] - Source: 'src/no_nested_borrows.rs', lines 483:0-483:20 *) + Source: 'tests/src/no_nested_borrows.rs', lines 485:0-485:20 *) Definition IdType_t (T : Type) : Type := T. (** [no_nested_borrows::use_id_type]: - Source: 'src/no_nested_borrows.rs', lines 485:0-485:40 *) + Source: 'tests/src/no_nested_borrows.rs', lines 487:0-487:40 *) Definition use_id_type (T : Type) (x : IdType_t T) : result T := Ok x. (** [no_nested_borrows::create_id_type]: - Source: 'src/no_nested_borrows.rs', lines 489:0-489:43 *) + Source: 'tests/src/no_nested_borrows.rs', lines 491:0-491:43 *) Definition create_id_type (T : Type) (x : T) : result (IdType_t T) := Ok x. diff --git a/tests/coq/misc/Paper.v b/tests/coq/misc/Paper.v index 5995de15..21e86542 100644 --- a/tests/coq/misc/Paper.v +++ b/tests/coq/misc/Paper.v @@ -9,12 +9,12 @@ Local Open Scope Primitives_scope. Module Paper. (** [paper::ref_incr]: - Source: 'src/paper.rs', lines 4:0-4:28 *) + Source: 'tests/src/paper.rs', lines 6:0-6:28 *) Definition ref_incr (x : i32) : result i32 := i32_add x 1%i32. (** [paper::test_incr]: - Source: 'src/paper.rs', lines 8:0-8:18 *) + Source: 'tests/src/paper.rs', lines 10:0-10:18 *) Definition test_incr : result unit := x <- ref_incr 0%i32; if negb (x s= 1%i32) then Fail_ Failure else Ok tt . @@ -23,7 +23,7 @@ Definition test_incr : result unit := Check (test_incr )%return. (** [paper::choose]: - Source: 'src/paper.rs', lines 15:0-15:70 *) + Source: 'tests/src/paper.rs', lines 17:0-17:70 *) Definition choose (T : Type) (b : bool) (x : T) (y : T) : result (T * (T -> result (T * T))) := if b @@ -32,7 +32,7 @@ Definition choose . (** [paper::test_choose]: - Source: 'src/paper.rs', lines 23:0-23:20 *) + Source: 'tests/src/paper.rs', lines 25:0-25:20 *) Definition test_choose : result unit := p <- choose i32 true 0%i32 0%i32; let (z, choose_back) := p in @@ -51,7 +51,7 @@ Definition test_choose : result unit := Check (test_choose )%return. (** [paper::List] - Source: 'src/paper.rs', lines 35:0-35:16 *) + Source: 'tests/src/paper.rs', lines 37:0-37:16 *) Inductive List_t (T : Type) := | List_Cons : T -> List_t T -> List_t T | List_Nil : List_t T @@ -61,7 +61,7 @@ Arguments List_Cons { _ }. Arguments List_Nil { _ }. (** [paper::list_nth_mut]: - Source: 'src/paper.rs', lines 42:0-42:67 *) + Source: 'tests/src/paper.rs', lines 44:0-44:67 *) Fixpoint list_nth_mut (T : Type) (l : List_t T) (i : u32) : result (T * (T -> result (List_t T))) @@ -82,7 +82,7 @@ Fixpoint list_nth_mut . (** [paper::sum]: - Source: 'src/paper.rs', lines 57:0-57:32 *) + Source: 'tests/src/paper.rs', lines 59:0-59:32 *) Fixpoint sum (l : List_t i32) : result i32 := match l with | List_Cons x tl => i <- sum tl; i32_add x i @@ -91,7 +91,7 @@ Fixpoint sum (l : List_t i32) : result i32 := . (** [paper::test_nth]: - Source: 'src/paper.rs', lines 68:0-68:17 *) + Source: 'tests/src/paper.rs', lines 70:0-70:17 *) Definition test_nth : result unit := let l := List_Cons 3%i32 List_Nil in let l1 := List_Cons 2%i32 l in @@ -107,7 +107,7 @@ Definition test_nth : result unit := Check (test_nth )%return. (** [paper::call_choose]: - Source: 'src/paper.rs', lines 76:0-76:44 *) + Source: 'tests/src/paper.rs', lines 78:0-78:44 *) Definition call_choose (p : (u32 * u32)) : result u32 := let (px, py) := p in p1 <- choose u32 true px py; diff --git a/tests/coq/misc/PoloniusList.v b/tests/coq/misc/PoloniusList.v index 8af7f69c..91cfcdb7 100644 --- a/tests/coq/misc/PoloniusList.v +++ b/tests/coq/misc/PoloniusList.v @@ -9,7 +9,7 @@ Local Open Scope Primitives_scope. Module PoloniusList. (** [polonius_list::List] - Source: 'src/polonius_list.rs', lines 3:0-3:16 *) + Source: 'tests/src/polonius_list.rs', lines 5:0-5:16 *) Inductive List_t (T : Type) := | List_Cons : T -> List_t T -> List_t T | List_Nil : List_t T @@ -19,7 +19,7 @@ Arguments List_Cons { _ }. Arguments List_Nil { _ }. (** [polonius_list::get_list_at_x]: - Source: 'src/polonius_list.rs', lines 13:0-13:76 *) + Source: 'tests/src/polonius_list.rs', lines 15:0-15:76 *) Fixpoint get_list_at_x (ls : List_t u32) (x : u32) : result ((List_t u32) * (List_t u32 -> result (List_t u32))) diff --git a/tests/coq/traits/Traits.v b/tests/coq/traits/Traits.v index 18b06bc1..ad1be7ef 100644 --- a/tests/coq/traits/Traits.v +++ b/tests/coq/traits/Traits.v @@ -9,7 +9,7 @@ Local Open Scope Primitives_scope. Module Traits. (** Trait declaration: [traits::BoolTrait] - Source: 'src/traits.rs', lines 1:0-1:19 *) + Source: 'tests/src/traits.rs', lines 2:0-2:19 *) Record BoolTrait_t (Self : Type) := mkBoolTrait_t { BoolTrait_t_get_bool : Self -> result bool; }. @@ -18,59 +18,59 @@ Arguments mkBoolTrait_t { _ }. Arguments BoolTrait_t_get_bool { _ }. (** [traits::{(traits::BoolTrait for bool)}::get_bool]: - Source: 'src/traits.rs', lines 12:4-12:30 *) + Source: 'tests/src/traits.rs', lines 13:4-13:30 *) Definition boolTraitBool_get_bool (self : bool) : result bool := Ok self. (** Trait implementation: [traits::{(traits::BoolTrait for bool)}] - Source: 'src/traits.rs', lines 11:0-11:23 *) + Source: 'tests/src/traits.rs', lines 12:0-12:23 *) Definition BoolTraitBool : BoolTrait_t bool := {| BoolTrait_t_get_bool := boolTraitBool_get_bool; |}. (** [traits::BoolTrait::ret_true]: - Source: 'src/traits.rs', lines 6:4-6:30 *) + Source: 'tests/src/traits.rs', lines 7:4-7:30 *) Definition boolTrait_ret_true {Self : Type} (self_clause : BoolTrait_t Self) (self : Self) : result bool := Ok true . (** [traits::test_bool_trait_bool]: - Source: 'src/traits.rs', lines 17:0-17:44 *) + Source: 'tests/src/traits.rs', lines 18:0-18:44 *) Definition test_bool_trait_bool (x : bool) : result bool := b <- boolTraitBool_get_bool x; if b then boolTrait_ret_true BoolTraitBool x else Ok false . (** [traits::{(traits::BoolTrait for core::option::Option<T>)#1}::get_bool]: - Source: 'src/traits.rs', lines 23:4-23:30 *) + Source: 'tests/src/traits.rs', lines 24:4-24:30 *) Definition boolTraitOption_get_bool (T : Type) (self : option T) : result bool := match self with | None => Ok false | Some _ => Ok true end . (** Trait implementation: [traits::{(traits::BoolTrait for core::option::Option<T>)#1}] - Source: 'src/traits.rs', lines 22:0-22:31 *) + Source: 'tests/src/traits.rs', lines 23:0-23:31 *) Definition BoolTraitOption (T : Type) : BoolTrait_t (option T) := {| BoolTrait_t_get_bool := boolTraitOption_get_bool T; |}. (** [traits::test_bool_trait_option]: - Source: 'src/traits.rs', lines 31:0-31:54 *) + Source: 'tests/src/traits.rs', lines 32:0-32:54 *) Definition test_bool_trait_option (T : Type) (x : option T) : result bool := b <- boolTraitOption_get_bool T x; if b then boolTrait_ret_true (BoolTraitOption T) x else Ok false . (** [traits::test_bool_trait]: - Source: 'src/traits.rs', lines 35:0-35:50 *) + Source: 'tests/src/traits.rs', lines 36:0-36:50 *) Definition test_bool_trait (T : Type) (boolTraitInst : BoolTrait_t T) (x : T) : result bool := boolTraitInst.(BoolTrait_t_get_bool) x . (** Trait declaration: [traits::ToU64] - Source: 'src/traits.rs', lines 39:0-39:15 *) + Source: 'tests/src/traits.rs', lines 40:0-40:15 *) Record ToU64_t (Self : Type) := mkToU64_t { ToU64_t_to_u64 : Self -> result u64; }. @@ -79,16 +79,16 @@ Arguments mkToU64_t { _ }. Arguments ToU64_t_to_u64 { _ }. (** [traits::{(traits::ToU64 for u64)#2}::to_u64]: - Source: 'src/traits.rs', lines 44:4-44:26 *) + Source: 'tests/src/traits.rs', lines 45:4-45:26 *) Definition toU64U64_to_u64 (self : u64) : result u64 := Ok self. (** Trait implementation: [traits::{(traits::ToU64 for u64)#2}] - Source: 'src/traits.rs', lines 43:0-43:18 *) + Source: 'tests/src/traits.rs', lines 44:0-44:18 *) Definition ToU64U64 : ToU64_t u64 := {| ToU64_t_to_u64 := toU64U64_to_u64; |}. (** [traits::{(traits::ToU64 for (A, A))#3}::to_u64]: - Source: 'src/traits.rs', lines 50:4-50:26 *) + Source: 'tests/src/traits.rs', lines 51:4-51:26 *) Definition toU64Pair_to_u64 (A : Type) (toU64Inst : ToU64_t A) (self : (A * A)) : result u64 := let (t, t1) := self in @@ -98,65 +98,65 @@ Definition toU64Pair_to_u64 . (** Trait implementation: [traits::{(traits::ToU64 for (A, A))#3}] - Source: 'src/traits.rs', lines 49:0-49:31 *) + Source: 'tests/src/traits.rs', lines 50:0-50:31 *) Definition ToU64Pair (A : Type) (toU64Inst : ToU64_t A) : ToU64_t (A * A) := {| ToU64_t_to_u64 := toU64Pair_to_u64 A toU64Inst; |}. (** [traits::f]: - Source: 'src/traits.rs', lines 55:0-55:36 *) + Source: 'tests/src/traits.rs', lines 56:0-56:36 *) Definition f (T : Type) (toU64Inst : ToU64_t T) (x : (T * T)) : result u64 := toU64Pair_to_u64 T toU64Inst x . (** [traits::g]: - Source: 'src/traits.rs', lines 59:0-61:18 *) + Source: 'tests/src/traits.rs', lines 60:0-62:18 *) Definition g (T : Type) (toU64PairInst : ToU64_t (T * T)) (x : (T * T)) : result u64 := toU64PairInst.(ToU64_t_to_u64) x . (** [traits::h0]: - Source: 'src/traits.rs', lines 66:0-66:24 *) + Source: 'tests/src/traits.rs', lines 67:0-67:24 *) Definition h0 (x : u64) : result u64 := toU64U64_to_u64 x. (** [traits::Wrapper] - Source: 'src/traits.rs', lines 70:0-70:21 *) + Source: 'tests/src/traits.rs', lines 71:0-71:21 *) Record Wrapper_t (T : Type) := mkWrapper_t { wrapper_x : T; }. Arguments mkWrapper_t { _ }. Arguments wrapper_x { _ }. (** [traits::{(traits::ToU64 for traits::Wrapper<T>)#4}::to_u64]: - Source: 'src/traits.rs', lines 75:4-75:26 *) + Source: 'tests/src/traits.rs', lines 76:4-76:26 *) Definition toU64traitsWrapper_to_u64 (T : Type) (toU64Inst : ToU64_t T) (self : Wrapper_t T) : result u64 := toU64Inst.(ToU64_t_to_u64) self.(wrapper_x) . (** Trait implementation: [traits::{(traits::ToU64 for traits::Wrapper<T>)#4}] - Source: 'src/traits.rs', lines 74:0-74:35 *) + Source: 'tests/src/traits.rs', lines 75:0-75:35 *) Definition ToU64traitsWrapper (T : Type) (toU64Inst : ToU64_t T) : ToU64_t (Wrapper_t T) := {| ToU64_t_to_u64 := toU64traitsWrapper_to_u64 T toU64Inst; |}. (** [traits::h1]: - Source: 'src/traits.rs', lines 80:0-80:33 *) + Source: 'tests/src/traits.rs', lines 81:0-81:33 *) Definition h1 (x : Wrapper_t u64) : result u64 := toU64traitsWrapper_to_u64 u64 ToU64U64 x . (** [traits::h2]: - Source: 'src/traits.rs', lines 84:0-84:41 *) + Source: 'tests/src/traits.rs', lines 85:0-85:41 *) Definition h2 (T : Type) (toU64Inst : ToU64_t T) (x : Wrapper_t T) : result u64 := toU64traitsWrapper_to_u64 T toU64Inst x . (** Trait declaration: [traits::ToType] - Source: 'src/traits.rs', lines 88:0-88:19 *) + Source: 'tests/src/traits.rs', lines 89:0-89:19 *) Record ToType_t (Self T : Type) := mkToType_t { ToType_t_to_type : Self -> result T; }. @@ -165,19 +165,19 @@ Arguments mkToType_t { _ _ }. Arguments ToType_t_to_type { _ _ }. (** [traits::{(traits::ToType<bool> for u64)#5}::to_type]: - Source: 'src/traits.rs', lines 93:4-93:28 *) + Source: 'tests/src/traits.rs', lines 94:4-94:28 *) Definition toTypeU64Bool_to_type (self : u64) : result bool := Ok (self s> 0%u64) . (** Trait implementation: [traits::{(traits::ToType<bool> for u64)#5}] - Source: 'src/traits.rs', lines 92:0-92:25 *) + Source: 'tests/src/traits.rs', lines 93:0-93:25 *) Definition ToTypeU64Bool : ToType_t u64 bool := {| ToType_t_to_type := toTypeU64Bool_to_type; |}. (** Trait declaration: [traits::OfType] - Source: 'src/traits.rs', lines 98:0-98:16 *) + Source: 'tests/src/traits.rs', lines 99:0-99:16 *) Record OfType_t (Self : Type) := mkOfType_t { OfType_t_of_type : forall (T : Type) (toTypeInst : ToType_t T Self), T -> result Self; @@ -187,7 +187,7 @@ Arguments mkOfType_t { _ }. Arguments OfType_t_of_type { _ }. (** [traits::h3]: - Source: 'src/traits.rs', lines 104:0-104:50 *) + Source: 'tests/src/traits.rs', lines 105:0-105:50 *) Definition h3 (T1 T2 : Type) (ofTypeInst : OfType_t T1) (toTypeInst : ToType_t T2 T1) (y : T2) : @@ -197,7 +197,7 @@ Definition h3 . (** Trait declaration: [traits::OfTypeBis] - Source: 'src/traits.rs', lines 109:0-109:36 *) + Source: 'tests/src/traits.rs', lines 110:0-110:36 *) Record OfTypeBis_t (Self T : Type) := mkOfTypeBis_t { OfTypeBis_tOfTypeBis_t_ToTypeInst : ToType_t T Self; OfTypeBis_t_of_type : T -> result Self; @@ -208,7 +208,7 @@ Arguments OfTypeBis_tOfTypeBis_t_ToTypeInst { _ _ }. Arguments OfTypeBis_t_of_type { _ _ }. (** [traits::h4]: - Source: 'src/traits.rs', lines 118:0-118:57 *) + Source: 'tests/src/traits.rs', lines 119:0-119:57 *) Definition h4 (T1 T2 : Type) (ofTypeBisInst : OfTypeBis_t T1 T2) (toTypeInst : ToType_t T2 T1) (y : T2) : @@ -218,15 +218,15 @@ Definition h4 . (** [traits::TestType] - Source: 'src/traits.rs', lines 122:0-122:22 *) + Source: 'tests/src/traits.rs', lines 123:0-123:22 *) Definition TestType_t (T : Type) : Type := T. (** [traits::{traits::TestType<T>#6}::test::TestType1] - Source: 'src/traits.rs', lines 127:8-127:24 *) + Source: 'tests/src/traits.rs', lines 128:8-128:24 *) Definition TestType_test_TestType1_t : Type := u64. (** Trait declaration: [traits::{traits::TestType<T>#6}::test::TestTrait] - Source: 'src/traits.rs', lines 128:8-128:23 *) + Source: 'tests/src/traits.rs', lines 129:8-129:23 *) Record TestType_test_TestTrait_t (Self : Type) := mkTestType_test_TestTrait_t { TestType_test_TestTrait_t_test : Self -> result bool; }. @@ -235,14 +235,14 @@ Arguments mkTestType_test_TestTrait_t { _ }. Arguments TestType_test_TestTrait_t_test { _ }. (** [traits::{traits::TestType<T>#6}::test::{(traits::{traits::TestType<T>#6}::test::TestTrait for traits::{traits::TestType<T>#6}::test::TestType1)}::test]: - Source: 'src/traits.rs', lines 139:12-139:34 *) + Source: 'tests/src/traits.rs', lines 140:12-140:34 *) Definition testType_test_TestTraittraitsTestTypetestTestType1_test (self : TestType_test_TestType1_t) : result bool := Ok (self s> 1%u64) . (** Trait implementation: [traits::{traits::TestType<T>#6}::test::{(traits::{traits::TestType<T>#6}::test::TestTrait for traits::{traits::TestType<T>#6}::test::TestType1)}] - Source: 'src/traits.rs', lines 138:8-138:36 *) + Source: 'tests/src/traits.rs', lines 139:8-139:36 *) Definition TestType_test_TestTraittraitsTestTypetestTestType1 : TestType_test_TestTrait_t TestType_test_TestType1_t := {| TestType_test_TestTrait_t_test := @@ -250,7 +250,7 @@ Definition TestType_test_TestTraittraitsTestTypetestTestType1 : |}. (** [traits::{traits::TestType<T>#6}::test]: - Source: 'src/traits.rs', lines 126:4-126:36 *) + Source: 'tests/src/traits.rs', lines 127:4-127:36 *) Definition testType_test (T : Type) (toU64Inst : ToU64_t T) (self : TestType_t T) (x : T) : result bool @@ -262,11 +262,11 @@ Definition testType_test . (** [traits::BoolWrapper] - Source: 'src/traits.rs', lines 150:0-150:22 *) + Source: 'tests/src/traits.rs', lines 151:0-151:22 *) Definition BoolWrapper_t : Type := bool. (** [traits::{(traits::ToType<T> for traits::BoolWrapper)#7}::to_type]: - Source: 'src/traits.rs', lines 156:4-156:25 *) + Source: 'tests/src/traits.rs', lines 157:4-157:25 *) Definition toTypetraitsBoolWrapperT_to_type (T : Type) (toTypeBoolTInst : ToType_t bool T) (self : BoolWrapper_t) : result T @@ -275,14 +275,14 @@ Definition toTypetraitsBoolWrapperT_to_type . (** Trait implementation: [traits::{(traits::ToType<T> for traits::BoolWrapper)#7}] - Source: 'src/traits.rs', lines 152:0-152:33 *) + Source: 'tests/src/traits.rs', lines 153:0-153:33 *) Definition ToTypetraitsBoolWrapperT (T : Type) (toTypeBoolTInst : ToType_t bool T) : ToType_t BoolWrapper_t T := {| ToType_t_to_type := toTypetraitsBoolWrapperT_to_type T toTypeBoolTInst; |}. (** [traits::WithConstTy::LEN2] - Source: 'src/traits.rs', lines 164:4-164:21 *) + Source: 'tests/src/traits.rs', lines 165:4-165:21 *) Definition with_const_ty_len2_default_body (Self : Type) (LEN : usize) : result usize := Ok 32%usize @@ -292,7 +292,7 @@ Definition with_const_ty_len2_default (Self : Type) (LEN : usize) : usize := . (** Trait declaration: [traits::WithConstTy] - Source: 'src/traits.rs', lines 161:0-161:39 *) + Source: 'tests/src/traits.rs', lines 162:0-162:39 *) Record WithConstTy_t (Self : Type) (LEN : usize) := mkWithConstTy_t { WithConstTy_tWithConstTy_t_LEN1 : usize; WithConstTy_tWithConstTy_t_LEN2 : usize; @@ -312,21 +312,21 @@ Arguments WithConstTy_tWithConstTy_t_W_clause_0 { _ _ }. Arguments WithConstTy_t_f { _ _ }. (** [traits::{(traits::WithConstTy<32: usize> for bool)#8}::LEN1] - Source: 'src/traits.rs', lines 175:4-175:21 *) + Source: 'tests/src/traits.rs', lines 176:4-176:21 *) Definition with_const_ty_bool32_len1_body : result usize := Ok 12%usize. Definition with_const_ty_bool32_len1 : usize := with_const_ty_bool32_len1_body%global . (** [traits::{(traits::WithConstTy<32: usize> for bool)#8}::f]: - Source: 'src/traits.rs', lines 180:4-180:39 *) + Source: 'tests/src/traits.rs', lines 181:4-181:39 *) Definition withConstTyBool32_f (i : u64) (a : array u8 32%usize) : result u64 := Ok i . (** Trait implementation: [traits::{(traits::WithConstTy<32: usize> for bool)#8}] - Source: 'src/traits.rs', lines 174:0-174:29 *) + Source: 'tests/src/traits.rs', lines 175:0-175:29 *) Definition WithConstTyBool32 : WithConstTy_t bool 32%usize := {| WithConstTy_tWithConstTy_t_LEN1 := with_const_ty_bool32_len1; WithConstTy_tWithConstTy_t_LEN2 := with_const_ty_len2_default bool 32%usize; @@ -337,7 +337,7 @@ Definition WithConstTyBool32 : WithConstTy_t bool 32%usize := {| |}. (** [traits::use_with_const_ty1]: - Source: 'src/traits.rs', lines 183:0-183:75 *) + Source: 'tests/src/traits.rs', lines 184:0-184:75 *) Definition use_with_const_ty1 (H : Type) (LEN : usize) (withConstTyInst : WithConstTy_t H LEN) : result usize @@ -346,7 +346,7 @@ Definition use_with_const_ty1 . (** [traits::use_with_const_ty2]: - Source: 'src/traits.rs', lines 187:0-187:73 *) + Source: 'tests/src/traits.rs', lines 188:0-188:73 *) Definition use_with_const_ty2 (H : Type) (LEN : usize) (withConstTyInst : WithConstTy_t H LEN) (w : withConstTyInst.(WithConstTy_tWithConstTy_t_W)) : @@ -356,7 +356,7 @@ Definition use_with_const_ty2 . (** [traits::use_with_const_ty3]: - Source: 'src/traits.rs', lines 189:0-189:80 *) + Source: 'tests/src/traits.rs', lines 190:0-190:80 *) Definition use_with_const_ty3 (H : Type) (LEN : usize) (withConstTyInst : WithConstTy_t H LEN) (x : withConstTyInst.(WithConstTy_tWithConstTy_t_W)) : @@ -366,12 +366,12 @@ Definition use_with_const_ty3 . (** [traits::test_where1]: - Source: 'src/traits.rs', lines 193:0-193:40 *) + Source: 'tests/src/traits.rs', lines 194:0-194:40 *) Definition test_where1 (T : Type) (_x : T) : result unit := Ok tt. (** [traits::test_where2]: - Source: 'src/traits.rs', lines 194:0-194:57 *) + Source: 'tests/src/traits.rs', lines 195:0-195:57 *) Definition test_where2 (T : Type) (withConstTyT32Inst : WithConstTy_t T 32%usize) (_x : u32) : result unit @@ -380,7 +380,7 @@ Definition test_where2 . (** Trait declaration: [traits::ParentTrait0] - Source: 'src/traits.rs', lines 200:0-200:22 *) + Source: 'tests/src/traits.rs', lines 201:0-201:22 *) Record ParentTrait0_t (Self : Type) := mkParentTrait0_t { ParentTrait0_tParentTrait0_t_W : Type; ParentTrait0_t_get_name : Self -> result string; @@ -393,13 +393,13 @@ Arguments ParentTrait0_t_get_name { _ }. Arguments ParentTrait0_t_get_w { _ }. (** Trait declaration: [traits::ParentTrait1] - Source: 'src/traits.rs', lines 205:0-205:22 *) + Source: 'tests/src/traits.rs', lines 206:0-206:22 *) Record ParentTrait1_t (Self : Type) := mkParentTrait1_t{}. Arguments mkParentTrait1_t { _ }. (** Trait declaration: [traits::ChildTrait] - Source: 'src/traits.rs', lines 206:0-206:49 *) + Source: 'tests/src/traits.rs', lines 207:0-207:49 *) Record ChildTrait_t (Self : Type) := mkChildTrait_t { ChildTrait_tChildTrait_t_ParentTrait0Inst : ParentTrait0_t Self; ChildTrait_tChildTrait_t_ParentTrait1Inst : ParentTrait1_t Self; @@ -410,7 +410,7 @@ Arguments ChildTrait_tChildTrait_t_ParentTrait0Inst { _ }. Arguments ChildTrait_tChildTrait_t_ParentTrait1Inst { _ }. (** [traits::test_child_trait1]: - Source: 'src/traits.rs', lines 209:0-209:56 *) + Source: 'tests/src/traits.rs', lines 210:0-210:56 *) Definition test_child_trait1 (T : Type) (childTraitInst : ChildTrait_t T) (x : T) : result string := childTraitInst.(ChildTrait_tChildTrait_t_ParentTrait0Inst).(ParentTrait0_t_get_name) @@ -418,7 +418,7 @@ Definition test_child_trait1 . (** [traits::test_child_trait2]: - Source: 'src/traits.rs', lines 213:0-213:54 *) + Source: 'tests/src/traits.rs', lines 214:0-214:54 *) Definition test_child_trait2 (T : Type) (childTraitInst : ChildTrait_t T) (x : T) : result @@ -429,7 +429,7 @@ Definition test_child_trait2 . (** [traits::order1]: - Source: 'src/traits.rs', lines 219:0-219:59 *) + Source: 'tests/src/traits.rs', lines 220:0-220:59 *) Definition order1 (T U : Type) (parentTrait0Inst : ParentTrait0_t T) (parentTrait0Inst1 : ParentTrait0_t U) : @@ -439,7 +439,7 @@ Definition order1 . (** Trait declaration: [traits::ChildTrait1] - Source: 'src/traits.rs', lines 222:0-222:35 *) + Source: 'tests/src/traits.rs', lines 223:0-223:35 *) Record ChildTrait1_t (Self : Type) := mkChildTrait1_t { ChildTrait1_tChildTrait1_t_ParentTrait1Inst : ParentTrait1_t Self; }. @@ -448,17 +448,17 @@ Arguments mkChildTrait1_t { _ }. Arguments ChildTrait1_tChildTrait1_t_ParentTrait1Inst { _ }. (** Trait implementation: [traits::{(traits::ParentTrait1 for usize)#9}] - Source: 'src/traits.rs', lines 224:0-224:27 *) + Source: 'tests/src/traits.rs', lines 225:0-225:27 *) Definition ParentTrait1Usize : ParentTrait1_t usize := mkParentTrait1_t. (** Trait implementation: [traits::{(traits::ChildTrait1 for usize)#10}] - Source: 'src/traits.rs', lines 225:0-225:26 *) + Source: 'tests/src/traits.rs', lines 226:0-226:26 *) Definition ChildTrait1Usize : ChildTrait1_t usize := {| ChildTrait1_tChildTrait1_t_ParentTrait1Inst := ParentTrait1Usize; |}. (** Trait declaration: [traits::Iterator] - Source: 'src/traits.rs', lines 229:0-229:18 *) + Source: 'tests/src/traits.rs', lines 230:0-230:18 *) Record Iterator_t (Self : Type) := mkIterator_t { Iterator_tIterator_t_Item : Type; }. @@ -467,7 +467,7 @@ Arguments mkIterator_t { _ }. Arguments Iterator_tIterator_t_Item { _ }. (** Trait declaration: [traits::IntoIterator] - Source: 'src/traits.rs', lines 233:0-233:22 *) + Source: 'tests/src/traits.rs', lines 234:0-234:22 *) Record IntoIterator_t (Self : Type) := mkIntoIterator_t { IntoIterator_tIntoIterator_t_Item : Type; IntoIterator_tIntoIterator_t_IntoIter : Type; @@ -484,13 +484,13 @@ Arguments IntoIterator_tIntoIterator_t_IntoIter_clause_0 { _ }. Arguments IntoIterator_t_into_iter { _ }. (** Trait declaration: [traits::FromResidual] - Source: 'src/traits.rs', lines 250:0-250:21 *) + Source: 'tests/src/traits.rs', lines 251:0-251:21 *) Record FromResidual_t (Self T : Type) := mkFromResidual_t{}. Arguments mkFromResidual_t { _ _ }. (** Trait declaration: [traits::Try] - Source: 'src/traits.rs', lines 246:0-246:48 *) + Source: 'tests/src/traits.rs', lines 247:0-247:48 *) Record Try_t (Self : Type) := mkTry_t { Try_tTry_t_Residual : Type; Try_tTry_t_FromResidualSelftraitsTryResidualInst : FromResidual_t Self @@ -502,7 +502,7 @@ Arguments Try_tTry_t_Residual { _ }. Arguments Try_tTry_t_FromResidualSelftraitsTryResidualInst { _ }. (** Trait declaration: [traits::WithTarget] - Source: 'src/traits.rs', lines 252:0-252:20 *) + Source: 'tests/src/traits.rs', lines 253:0-253:20 *) Record WithTarget_t (Self : Type) := mkWithTarget_t { WithTarget_tWithTarget_t_Target : Type; }. @@ -511,7 +511,7 @@ Arguments mkWithTarget_t { _ }. Arguments WithTarget_tWithTarget_t_Target { _ }. (** Trait declaration: [traits::ParentTrait2] - Source: 'src/traits.rs', lines 256:0-256:22 *) + Source: 'tests/src/traits.rs', lines 257:0-257:22 *) Record ParentTrait2_t (Self : Type) := mkParentTrait2_t { ParentTrait2_tParentTrait2_t_U : Type; ParentTrait2_tParentTrait2_t_U_clause_0 : WithTarget_t @@ -523,7 +523,7 @@ Arguments ParentTrait2_tParentTrait2_t_U { _ }. Arguments ParentTrait2_tParentTrait2_t_U_clause_0 { _ }. (** Trait declaration: [traits::ChildTrait2] - Source: 'src/traits.rs', lines 260:0-260:35 *) + Source: 'tests/src/traits.rs', lines 261:0-261:35 *) Record ChildTrait2_t (Self : Type) := mkChildTrait2_t { ChildTrait2_tChildTrait2_t_ParentTrait2Inst : ParentTrait2_t Self; ChildTrait2_t_convert : @@ -537,32 +537,32 @@ Arguments ChildTrait2_tChildTrait2_t_ParentTrait2Inst { _ }. Arguments ChildTrait2_t_convert { _ }. (** Trait implementation: [traits::{(traits::WithTarget for u32)#11}] - Source: 'src/traits.rs', lines 264:0-264:23 *) + Source: 'tests/src/traits.rs', lines 265:0-265:23 *) Definition WithTargetU32 : WithTarget_t u32 := {| WithTarget_tWithTarget_t_Target := u32; |}. (** Trait implementation: [traits::{(traits::ParentTrait2 for u32)#12}] - Source: 'src/traits.rs', lines 268:0-268:25 *) + Source: 'tests/src/traits.rs', lines 269:0-269:25 *) Definition ParentTrait2U32 : ParentTrait2_t u32 := {| ParentTrait2_tParentTrait2_t_U := u32; ParentTrait2_tParentTrait2_t_U_clause_0 := WithTargetU32; |}. (** [traits::{(traits::ChildTrait2 for u32)#13}::convert]: - Source: 'src/traits.rs', lines 273:4-273:29 *) + Source: 'tests/src/traits.rs', lines 274:4-274:29 *) Definition childTrait2U32_convert (x : u32) : result u32 := Ok x. (** Trait implementation: [traits::{(traits::ChildTrait2 for u32)#13}] - Source: 'src/traits.rs', lines 272:0-272:24 *) + Source: 'tests/src/traits.rs', lines 273:0-273:24 *) Definition ChildTrait2U32 : ChildTrait2_t u32 := {| ChildTrait2_tChildTrait2_t_ParentTrait2Inst := ParentTrait2U32; ChildTrait2_t_convert := childTrait2U32_convert; |}. (** Trait declaration: [traits::CFnOnce] - Source: 'src/traits.rs', lines 286:0-286:23 *) + Source: 'tests/src/traits.rs', lines 287:0-287:23 *) Record CFnOnce_t (Self Args : Type) := mkCFnOnce_t { CFnOnce_tCFnOnce_t_Output : Type; CFnOnce_t_call_once : Self -> Args -> result CFnOnce_tCFnOnce_t_Output; @@ -573,7 +573,7 @@ Arguments CFnOnce_tCFnOnce_t_Output { _ _ }. Arguments CFnOnce_t_call_once { _ _ }. (** Trait declaration: [traits::CFnMut] - Source: 'src/traits.rs', lines 292:0-292:37 *) + Source: 'tests/src/traits.rs', lines 293:0-293:37 *) Record CFnMut_t (Self Args : Type) := mkCFnMut_t { CFnMut_tCFnMut_t_CFnOnceInst : CFnOnce_t Self Args; CFnMut_t_call_mut : Self -> Args -> result @@ -585,7 +585,7 @@ Arguments CFnMut_tCFnMut_t_CFnOnceInst { _ _ }. Arguments CFnMut_t_call_mut { _ _ }. (** Trait declaration: [traits::CFn] - Source: 'src/traits.rs', lines 296:0-296:33 *) + Source: 'tests/src/traits.rs', lines 297:0-297:33 *) Record CFn_t (Self Args : Type) := mkCFn_t { CFn_tCFn_t_CFnMutInst : CFnMut_t Self Args; CFn_t_call : Self -> Args -> result @@ -597,7 +597,7 @@ Arguments CFn_tCFn_t_CFnMutInst { _ _ }. Arguments CFn_t_call { _ _ }. (** Trait declaration: [traits::GetTrait] - Source: 'src/traits.rs', lines 300:0-300:18 *) + Source: 'tests/src/traits.rs', lines 301:0-301:18 *) Record GetTrait_t (Self : Type) := mkGetTrait_t { GetTrait_tGetTrait_t_W : Type; GetTrait_t_get_w : Self -> result GetTrait_tGetTrait_t_W; @@ -608,7 +608,7 @@ Arguments GetTrait_tGetTrait_t_W { _ }. Arguments GetTrait_t_get_w { _ }. (** [traits::test_get_trait]: - Source: 'src/traits.rs', lines 305:0-305:49 *) + Source: 'tests/src/traits.rs', lines 306:0-306:49 *) Definition test_get_trait (T : Type) (getTraitInst : GetTrait_t T) (x : T) : result getTraitInst.(GetTrait_tGetTrait_t_W) @@ -617,27 +617,27 @@ Definition test_get_trait . (** Trait declaration: [traits::Trait] - Source: 'src/traits.rs', lines 310:0-310:15 *) + Source: 'tests/src/traits.rs', lines 311:0-311:15 *) Record Trait_t (Self : Type) := mkTrait_t { Trait_tTrait_t_LEN : usize; }. Arguments mkTrait_t { _ }. Arguments Trait_tTrait_t_LEN { _ }. (** [traits::{(traits::Trait for @Array<T, N>)#14}::LEN] - Source: 'src/traits.rs', lines 315:4-315:20 *) + Source: 'tests/src/traits.rs', lines 316:4-316:20 *) Definition trait_array_len_body (T : Type) (N : usize) : result usize := Ok N. Definition trait_array_len (T : Type) (N : usize) : usize := (trait_array_len_body T N)%global . (** Trait implementation: [traits::{(traits::Trait for @Array<T, N>)#14}] - Source: 'src/traits.rs', lines 314:0-314:40 *) + Source: 'tests/src/traits.rs', lines 315:0-315:40 *) Definition TraitArray (T : Type) (N : usize) : Trait_t (array T N) := {| Trait_tTrait_t_LEN := trait_array_len T N; |}. (** [traits::{(traits::Trait for traits::Wrapper<T>)#15}::LEN] - Source: 'src/traits.rs', lines 319:4-319:20 *) + Source: 'tests/src/traits.rs', lines 320:4-320:20 *) Definition traittraits_wrapper_len_body (T : Type) (traitInst : Trait_t T) : result usize := Ok 0%usize @@ -648,20 +648,20 @@ Definition traittraits_wrapper_len (T : Type) (traitInst : Trait_t T) . (** Trait implementation: [traits::{(traits::Trait for traits::Wrapper<T>)#15}] - Source: 'src/traits.rs', lines 318:0-318:35 *) + Source: 'tests/src/traits.rs', lines 319:0-319:35 *) Definition TraittraitsWrapper (T : Type) (traitInst : Trait_t T) : Trait_t (Wrapper_t T) := {| Trait_tTrait_t_LEN := traittraits_wrapper_len T traitInst; |}. (** [traits::use_wrapper_len]: - Source: 'src/traits.rs', lines 322:0-322:43 *) + Source: 'tests/src/traits.rs', lines 323:0-323:43 *) Definition use_wrapper_len (T : Type) (traitInst : Trait_t T) : result usize := Ok (TraittraitsWrapper T traitInst).(Trait_tTrait_t_LEN) . (** [traits::Foo] - Source: 'src/traits.rs', lines 326:0-326:20 *) + Source: 'tests/src/traits.rs', lines 327:0-327:20 *) Record Foo_t (T U : Type) := mkFoo_t { foo_x : T; foo_y : U; }. Arguments mkFoo_t { _ _ }. @@ -680,7 +680,7 @@ Arguments Core_result_Result_Ok { _ _ }. Arguments Core_result_Result_Err { _ _ }. (** [traits::{traits::Foo<T, U>#16}::FOO] - Source: 'src/traits.rs', lines 332:4-332:33 *) + Source: 'tests/src/traits.rs', lines 333:4-333:33 *) Definition foo_foo_body (T U : Type) (traitInst : Trait_t T) : result (core_result_Result_t T i32) := Ok (Core_result_Result_Err 0%i32) @@ -691,14 +691,14 @@ Definition foo_foo (T U : Type) (traitInst : Trait_t T) . (** [traits::use_foo1]: - Source: 'src/traits.rs', lines 335:0-335:48 *) + Source: 'tests/src/traits.rs', lines 336:0-336:48 *) Definition use_foo1 (T U : Type) (traitInst : Trait_t T) : result (core_result_Result_t T i32) := Ok (foo_foo T U traitInst) . (** [traits::use_foo2]: - Source: 'src/traits.rs', lines 339:0-339:48 *) + Source: 'tests/src/traits.rs', lines 340:0-340:48 *) Definition use_foo2 (T U : Type) (traitInst : Trait_t U) : result (core_result_Result_t U i32) := Ok (foo_foo U T traitInst) diff --git a/tests/fstar/arrays/Arrays.Clauses.Template.fst b/tests/fstar/arrays/Arrays.Clauses.Template.fst index 89654992..914ef44e 100644 --- a/tests/fstar/arrays/Arrays.Clauses.Template.fst +++ b/tests/fstar/arrays/Arrays.Clauses.Template.fst @@ -7,31 +7,31 @@ open Arrays.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [arrays::sum]: decreases clause - Source: 'src/arrays.rs', lines 242:0-250:1 *) + Source: 'tests/src/arrays.rs', lines 245:0-253:1 *) unfold let sum_loop_decreases (s : slice u32) (sum1 : u32) (i : usize) : nat = admit () (** [arrays::sum2]: decreases clause - Source: 'src/arrays.rs', lines 252:0-261:1 *) + Source: 'tests/src/arrays.rs', lines 255:0-264:1 *) unfold let sum2_loop_decreases (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) : nat = admit () (** [arrays::zero_slice]: decreases clause - Source: 'src/arrays.rs', lines 303:0-310:1 *) + Source: 'tests/src/arrays.rs', lines 306:0-313:1 *) unfold let zero_slice_loop_decreases (a : slice u8) (i : usize) (len : usize) : nat = admit () (** [arrays::iter_mut_slice]: decreases clause - Source: 'src/arrays.rs', lines 312:0-318:1 *) + Source: 'tests/src/arrays.rs', lines 315:0-321:1 *) unfold let iter_mut_slice_loop_decreases (len : usize) (i : usize) : nat = admit () (** [arrays::sum_mut_slice]: decreases clause - Source: 'src/arrays.rs', lines 320:0-328:1 *) + Source: 'tests/src/arrays.rs', lines 323:0-331:1 *) unfold let sum_mut_slice_loop_decreases (a : slice u32) (i : usize) (s : u32) : nat = admit () diff --git a/tests/fstar/arrays/Arrays.Funs.fst b/tests/fstar/arrays/Arrays.Funs.fst index 983b3761..289e603d 100644 --- a/tests/fstar/arrays/Arrays.Funs.fst +++ b/tests/fstar/arrays/Arrays.Funs.fst @@ -8,17 +8,17 @@ include Arrays.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [arrays::incr]: - Source: 'src/arrays.rs', lines 8:0-8:24 *) + Source: 'tests/src/arrays.rs', lines 11:0-11:24 *) let incr (x : u32) : result u32 = u32_add x 1 (** [arrays::array_to_shared_slice_]: - Source: 'src/arrays.rs', lines 16:0-16:53 *) + Source: 'tests/src/arrays.rs', lines 19:0-19:53 *) let array_to_shared_slice_ (t : Type0) (s : array t 32) : result (slice t) = array_to_slice t 32 s (** [arrays::array_to_mut_slice_]: - Source: 'src/arrays.rs', lines 21:0-21:58 *) + Source: 'tests/src/arrays.rs', lines 24:0-24:58 *) let array_to_mut_slice_ (t : Type0) (s : array t 32) : result ((slice t) & (slice t -> result (array t 32))) @@ -26,37 +26,37 @@ let array_to_mut_slice_ array_to_slice_mut t 32 s (** [arrays::array_len]: - Source: 'src/arrays.rs', lines 25:0-25:40 *) + Source: 'tests/src/arrays.rs', lines 28:0-28:40 *) let array_len (t : Type0) (s : array t 32) : result usize = let* s1 = array_to_slice t 32 s in Ok (slice_len t s1) (** [arrays::shared_array_len]: - Source: 'src/arrays.rs', lines 29:0-29:48 *) + Source: 'tests/src/arrays.rs', lines 32:0-32:48 *) let shared_array_len (t : Type0) (s : array t 32) : result usize = let* s1 = array_to_slice t 32 s in Ok (slice_len t s1) (** [arrays::shared_slice_len]: - Source: 'src/arrays.rs', lines 33:0-33:44 *) + Source: 'tests/src/arrays.rs', lines 36:0-36:44 *) let shared_slice_len (t : Type0) (s : slice t) : result usize = Ok (slice_len t s) (** [arrays::index_array_shared]: - Source: 'src/arrays.rs', lines 37:0-37:57 *) + Source: 'tests/src/arrays.rs', lines 40:0-40:57 *) let index_array_shared (t : Type0) (s : array t 32) (i : usize) : result t = array_index_usize t 32 s i (** [arrays::index_array_u32]: - Source: 'src/arrays.rs', lines 44:0-44:53 *) + Source: 'tests/src/arrays.rs', lines 47:0-47:53 *) let index_array_u32 (s : array u32 32) (i : usize) : result u32 = array_index_usize u32 32 s i (** [arrays::index_array_copy]: - Source: 'src/arrays.rs', lines 48:0-48:45 *) + Source: 'tests/src/arrays.rs', lines 51:0-51:45 *) let index_array_copy (x : array u32 32) : result u32 = array_index_usize u32 32 x 0 (** [arrays::index_mut_array]: - Source: 'src/arrays.rs', lines 52:0-52:62 *) + Source: 'tests/src/arrays.rs', lines 55:0-55:62 *) let index_mut_array (t : Type0) (s : array t 32) (i : usize) : result (t & (t -> result (array t 32))) @@ -64,12 +64,12 @@ let index_mut_array array_index_mut_usize t 32 s i (** [arrays::index_slice]: - Source: 'src/arrays.rs', lines 56:0-56:46 *) + Source: 'tests/src/arrays.rs', lines 59:0-59:46 *) let index_slice (t : Type0) (s : slice t) (i : usize) : result t = slice_index_usize t s i (** [arrays::index_mut_slice]: - Source: 'src/arrays.rs', lines 60:0-60:58 *) + Source: 'tests/src/arrays.rs', lines 63:0-63:58 *) let index_mut_slice (t : Type0) (s : slice t) (i : usize) : result (t & (t -> result (slice t))) @@ -77,7 +77,7 @@ let index_mut_slice slice_index_mut_usize t s i (** [arrays::slice_subslice_shared_]: - Source: 'src/arrays.rs', lines 64:0-64:70 *) + Source: 'tests/src/arrays.rs', lines 67:0-67:70 *) let slice_subslice_shared_ (x : slice u32) (y : usize) (z : usize) : result (slice u32) = core_slice_index_Slice_index u32 (core_ops_range_Range usize) @@ -85,7 +85,7 @@ let slice_subslice_shared_ { start = y; end_ = z } (** [arrays::slice_subslice_mut_]: - Source: 'src/arrays.rs', lines 68:0-68:75 *) + Source: 'tests/src/arrays.rs', lines 71:0-71:75 *) let slice_subslice_mut_ (x : slice u32) (y : usize) (z : usize) : result ((slice u32) & (slice u32 -> result (slice u32))) @@ -97,12 +97,12 @@ let slice_subslice_mut_ Ok (s, index_mut_back) (** [arrays::array_to_slice_shared_]: - Source: 'src/arrays.rs', lines 72:0-72:54 *) + Source: 'tests/src/arrays.rs', lines 75:0-75:54 *) let array_to_slice_shared_ (x : array u32 32) : result (slice u32) = array_to_slice u32 32 x (** [arrays::array_to_slice_mut_]: - Source: 'src/arrays.rs', lines 76:0-76:59 *) + Source: 'tests/src/arrays.rs', lines 79:0-79:59 *) let array_to_slice_mut_ (x : array u32 32) : result ((slice u32) & (slice u32 -> result (array u32 32))) @@ -110,7 +110,7 @@ let array_to_slice_mut_ array_to_slice_mut u32 32 x (** [arrays::array_subslice_shared_]: - Source: 'src/arrays.rs', lines 80:0-80:74 *) + Source: 'tests/src/arrays.rs', lines 83:0-83:74 *) let array_subslice_shared_ (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = core_array_Array_index u32 (core_ops_range_Range usize) 32 @@ -119,7 +119,7 @@ let array_subslice_shared_ { start = y; end_ = z } (** [arrays::array_subslice_mut_]: - Source: 'src/arrays.rs', lines 84:0-84:79 *) + Source: 'tests/src/arrays.rs', lines 87:0-87:79 *) let array_subslice_mut_ (x : array u32 32) (y : usize) (z : usize) : result ((slice u32) & (slice u32 -> result (array u32 32))) @@ -132,24 +132,24 @@ let array_subslice_mut_ Ok (s, index_mut_back) (** [arrays::index_slice_0]: - Source: 'src/arrays.rs', lines 88:0-88:38 *) + Source: 'tests/src/arrays.rs', lines 91:0-91:38 *) let index_slice_0 (t : Type0) (s : slice t) : result t = slice_index_usize t s 0 (** [arrays::index_array_0]: - Source: 'src/arrays.rs', lines 92:0-92:42 *) + Source: 'tests/src/arrays.rs', lines 95:0-95:42 *) let index_array_0 (t : Type0) (s : array t 32) : result t = array_index_usize t 32 s 0 (** [arrays::index_index_array]: - Source: 'src/arrays.rs', lines 103:0-103:71 *) + Source: 'tests/src/arrays.rs', lines 106:0-106:71 *) let index_index_array (s : array (array u32 32) 32) (i : usize) (j : usize) : result u32 = let* a = array_index_usize (array u32 32) 32 s i in array_index_usize u32 32 a j (** [arrays::update_update_array]: - Source: 'src/arrays.rs', lines 114:0-114:70 *) + Source: 'tests/src/arrays.rs', lines 117:0-117:70 *) let update_update_array (s : array (array u32 32) 32) (i : usize) (j : usize) : result unit = let* (a, index_mut_back) = array_index_mut_usize (array u32 32) 32 s i in @@ -159,42 +159,42 @@ let update_update_array Ok () (** [arrays::array_local_deep_copy]: - Source: 'src/arrays.rs', lines 118:0-118:43 *) + Source: 'tests/src/arrays.rs', lines 121:0-121:43 *) let array_local_deep_copy (x : array u32 32) : result unit = Ok () (** [arrays::take_array]: - Source: 'src/arrays.rs', lines 122:0-122:30 *) + Source: 'tests/src/arrays.rs', lines 125:0-125:30 *) let take_array (a : array u32 2) : result unit = Ok () (** [arrays::take_array_borrow]: - Source: 'src/arrays.rs', lines 123:0-123:38 *) + Source: 'tests/src/arrays.rs', lines 126:0-126:38 *) let take_array_borrow (a : array u32 2) : result unit = Ok () (** [arrays::take_slice]: - Source: 'src/arrays.rs', lines 124:0-124:28 *) + Source: 'tests/src/arrays.rs', lines 127:0-127:28 *) let take_slice (s : slice u32) : result unit = Ok () (** [arrays::take_mut_slice]: - Source: 'src/arrays.rs', lines 125:0-125:36 *) + Source: 'tests/src/arrays.rs', lines 128:0-128:36 *) let take_mut_slice (s : slice u32) : result (slice u32) = Ok s (** [arrays::const_array]: - Source: 'src/arrays.rs', lines 127:0-127:32 *) + Source: 'tests/src/arrays.rs', lines 130:0-130:32 *) let const_array : result (array u32 2) = Ok (mk_array u32 2 [ 0; 0 ]) (** [arrays::const_slice]: - Source: 'src/arrays.rs', lines 131:0-131:20 *) + Source: 'tests/src/arrays.rs', lines 134:0-134:20 *) let const_slice : result unit = let* _ = array_to_slice u32 2 (mk_array u32 2 [ 0; 0 ]) in Ok () (** [arrays::take_all]: - Source: 'src/arrays.rs', lines 141:0-141:17 *) + Source: 'tests/src/arrays.rs', lines 144:0-144:17 *) let take_all : result unit = let* _ = take_array (mk_array u32 2 [ 0; 0 ]) in let* _ = take_array (mk_array u32 2 [ 0; 0 ]) in @@ -208,27 +208,27 @@ let take_all : result unit = Ok () (** [arrays::index_array]: - Source: 'src/arrays.rs', lines 155:0-155:38 *) + Source: 'tests/src/arrays.rs', lines 158:0-158:38 *) let index_array (x : array u32 2) : result u32 = array_index_usize u32 2 x 0 (** [arrays::index_array_borrow]: - Source: 'src/arrays.rs', lines 158:0-158:46 *) + Source: 'tests/src/arrays.rs', lines 161:0-161:46 *) let index_array_borrow (x : array u32 2) : result u32 = array_index_usize u32 2 x 0 (** [arrays::index_slice_u32_0]: - Source: 'src/arrays.rs', lines 162:0-162:42 *) + Source: 'tests/src/arrays.rs', lines 165:0-165:42 *) let index_slice_u32_0 (x : slice u32) : result u32 = slice_index_usize u32 x 0 (** [arrays::index_mut_slice_u32_0]: - Source: 'src/arrays.rs', lines 166:0-166:50 *) + Source: 'tests/src/arrays.rs', lines 169:0-169:50 *) let index_mut_slice_u32_0 (x : slice u32) : result (u32 & (slice u32)) = let* i = slice_index_usize u32 x 0 in Ok (i, x) (** [arrays::index_all]: - Source: 'src/arrays.rs', lines 170:0-170:25 *) + Source: 'tests/src/arrays.rs', lines 173:0-173:25 *) let index_all : result u32 = let* i = index_array (mk_array u32 2 [ 0; 0 ]) in let* i1 = index_array (mk_array u32 2 [ 0; 0 ]) in @@ -246,25 +246,25 @@ let index_all : result u32 = Ok i8 (** [arrays::update_array]: - Source: 'src/arrays.rs', lines 184:0-184:36 *) + Source: 'tests/src/arrays.rs', lines 187:0-187:36 *) let update_array (x : array u32 2) : result unit = let* (_, index_mut_back) = array_index_mut_usize u32 2 x 0 in let* _ = index_mut_back 1 in Ok () (** [arrays::update_array_mut_borrow]: - Source: 'src/arrays.rs', lines 187:0-187:48 *) + Source: 'tests/src/arrays.rs', lines 190:0-190:48 *) let update_array_mut_borrow (x : array u32 2) : result (array u32 2) = let* (_, index_mut_back) = array_index_mut_usize u32 2 x 0 in index_mut_back 1 (** [arrays::update_mut_slice]: - Source: 'src/arrays.rs', lines 190:0-190:38 *) + Source: 'tests/src/arrays.rs', lines 193:0-193:38 *) let update_mut_slice (x : slice u32) : result (slice u32) = let* (_, index_mut_back) = slice_index_mut_usize u32 x 0 in index_mut_back 1 (** [arrays::update_all]: - Source: 'src/arrays.rs', lines 194:0-194:19 *) + Source: 'tests/src/arrays.rs', lines 197:0-197:19 *) let update_all : result unit = let* _ = update_array (mk_array u32 2 [ 0; 0 ]) in let* _ = update_array (mk_array u32 2 [ 0; 0 ]) in @@ -275,7 +275,7 @@ let update_all : result unit = Ok () (** [arrays::range_all]: - Source: 'src/arrays.rs', lines 205:0-205:18 *) + Source: 'tests/src/arrays.rs', lines 208:0-208:18 *) let range_all : result unit = let* (s, index_mut_back) = core_array_Array_index_mut u32 (core_ops_range_Range usize) 4 @@ -287,27 +287,27 @@ let range_all : result unit = Ok () (** [arrays::deref_array_borrow]: - Source: 'src/arrays.rs', lines 214:0-214:46 *) + Source: 'tests/src/arrays.rs', lines 217:0-217:46 *) let deref_array_borrow (x : array u32 2) : result u32 = array_index_usize u32 2 x 0 (** [arrays::deref_array_mut_borrow]: - Source: 'src/arrays.rs', lines 219:0-219:54 *) + Source: 'tests/src/arrays.rs', lines 222:0-222:54 *) let deref_array_mut_borrow (x : array u32 2) : result (u32 & (array u32 2)) = let* i = array_index_usize u32 2 x 0 in Ok (i, x) (** [arrays::take_array_t]: - Source: 'src/arrays.rs', lines 227:0-227:31 *) + Source: 'tests/src/arrays.rs', lines 230:0-230:31 *) let take_array_t (a : array aB_t 2) : result unit = Ok () (** [arrays::non_copyable_array]: - Source: 'src/arrays.rs', lines 229:0-229:27 *) + Source: 'tests/src/arrays.rs', lines 232:0-232:27 *) let non_copyable_array : result unit = take_array_t (mk_array aB_t 2 [ AB_A; AB_B ]) (** [arrays::sum]: loop 0: - Source: 'src/arrays.rs', lines 242:0-250:1 *) + Source: 'tests/src/arrays.rs', lines 245:0-253:1 *) let rec sum_loop (s : slice u32) (sum1 : u32) (i : usize) : Tot (result u32) (decreases (sum_loop_decreases s sum1 i)) @@ -322,12 +322,12 @@ let rec sum_loop else Ok sum1 (** [arrays::sum]: - Source: 'src/arrays.rs', lines 242:0-242:28 *) + Source: 'tests/src/arrays.rs', lines 245:0-245:28 *) let sum (s : slice u32) : result u32 = sum_loop s 0 0 (** [arrays::sum2]: loop 0: - Source: 'src/arrays.rs', lines 252:0-261:1 *) + Source: 'tests/src/arrays.rs', lines 255:0-264:1 *) let rec sum2_loop (s : slice u32) (s2 : slice u32) (sum1 : u32) (i : usize) : Tot (result u32) (decreases (sum2_loop_decreases s s2 sum1 i)) @@ -344,14 +344,14 @@ let rec sum2_loop else Ok sum1 (** [arrays::sum2]: - Source: 'src/arrays.rs', lines 252:0-252:41 *) + Source: 'tests/src/arrays.rs', lines 255:0-255:41 *) let sum2 (s : slice u32) (s2 : slice u32) : result u32 = let i = slice_len u32 s in let i1 = slice_len u32 s2 in if not (i = i1) then Fail Failure else sum2_loop s s2 0 0 (** [arrays::f0]: - Source: 'src/arrays.rs', lines 263:0-263:11 *) + Source: 'tests/src/arrays.rs', lines 266:0-266:11 *) let f0 : result unit = let* (s, to_slice_mut_back) = array_to_slice_mut u32 2 (mk_array u32 2 [ 1; 2 ]) in @@ -361,7 +361,7 @@ let f0 : result unit = Ok () (** [arrays::f1]: - Source: 'src/arrays.rs', lines 268:0-268:11 *) + Source: 'tests/src/arrays.rs', lines 271:0-271:11 *) let f1 : result unit = let* (_, index_mut_back) = array_index_mut_usize u32 2 (mk_array u32 2 [ 1; 2 ]) 0 in @@ -369,12 +369,12 @@ let f1 : result unit = Ok () (** [arrays::f2]: - Source: 'src/arrays.rs', lines 273:0-273:17 *) + Source: 'tests/src/arrays.rs', lines 276:0-276:17 *) let f2 (i : u32) : result unit = Ok () (** [arrays::f4]: - Source: 'src/arrays.rs', lines 282:0-282:54 *) + Source: 'tests/src/arrays.rs', lines 285:0-285:54 *) let f4 (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = core_array_Array_index u32 (core_ops_range_Range usize) 32 (core_ops_index_IndexSliceTIInst u32 (core_ops_range_Range usize) @@ -382,7 +382,7 @@ let f4 (x : array u32 32) (y : usize) (z : usize) : result (slice u32) = { start = y; end_ = z } (** [arrays::f3]: - Source: 'src/arrays.rs', lines 275:0-275:18 *) + Source: 'tests/src/arrays.rs', lines 278:0-278:18 *) let f3 : result u32 = let* i = array_index_usize u32 2 (mk_array u32 2 [ 1; 2 ]) 0 in let* _ = f2 i in @@ -392,17 +392,17 @@ let f3 : result u32 = sum2 s s1 (** [arrays::SZ] - Source: 'src/arrays.rs', lines 286:0-286:19 *) + Source: 'tests/src/arrays.rs', lines 289:0-289:19 *) let sz_body : result usize = Ok 32 let sz : usize = eval_global sz_body (** [arrays::f5]: - Source: 'src/arrays.rs', lines 289:0-289:31 *) + Source: 'tests/src/arrays.rs', lines 292:0-292:31 *) let f5 (x : array u32 32) : result u32 = array_index_usize u32 32 x 0 (** [arrays::ite]: - Source: 'src/arrays.rs', lines 294:0-294:12 *) + Source: 'tests/src/arrays.rs', lines 297:0-297:12 *) let ite : result unit = let* (s, to_slice_mut_back) = array_to_slice_mut u32 2 (mk_array u32 2 [ 0; 0 ]) in @@ -415,7 +415,7 @@ let ite : result unit = Ok () (** [arrays::zero_slice]: loop 0: - Source: 'src/arrays.rs', lines 303:0-310:1 *) + Source: 'tests/src/arrays.rs', lines 306:0-313:1 *) let rec zero_slice_loop (a : slice u8) (i : usize) (len : usize) : Tot (result (slice u8)) (decreases (zero_slice_loop_decreases a i len)) @@ -429,12 +429,12 @@ let rec zero_slice_loop else Ok a (** [arrays::zero_slice]: - Source: 'src/arrays.rs', lines 303:0-303:31 *) + Source: 'tests/src/arrays.rs', lines 306:0-306:31 *) let zero_slice (a : slice u8) : result (slice u8) = let len = slice_len u8 a in zero_slice_loop a 0 len (** [arrays::iter_mut_slice]: loop 0: - Source: 'src/arrays.rs', lines 312:0-318:1 *) + Source: 'tests/src/arrays.rs', lines 315:0-321:1 *) let rec iter_mut_slice_loop (len : usize) (i : usize) : Tot (result unit) (decreases (iter_mut_slice_loop_decreases len i)) @@ -444,12 +444,12 @@ let rec iter_mut_slice_loop else Ok () (** [arrays::iter_mut_slice]: - Source: 'src/arrays.rs', lines 312:0-312:35 *) + Source: 'tests/src/arrays.rs', lines 315:0-315:35 *) let iter_mut_slice (a : slice u8) : result (slice u8) = let len = slice_len u8 a in let* _ = iter_mut_slice_loop len 0 in Ok a (** [arrays::sum_mut_slice]: loop 0: - Source: 'src/arrays.rs', lines 320:0-328:1 *) + Source: 'tests/src/arrays.rs', lines 323:0-331:1 *) let rec sum_mut_slice_loop (a : slice u32) (i : usize) (s : u32) : Tot (result u32) (decreases (sum_mut_slice_loop_decreases a i s)) @@ -464,7 +464,7 @@ let rec sum_mut_slice_loop else Ok s (** [arrays::sum_mut_slice]: - Source: 'src/arrays.rs', lines 320:0-320:42 *) + Source: 'tests/src/arrays.rs', lines 323:0-323:42 *) let sum_mut_slice (a : slice u32) : result (u32 & (slice u32)) = let* i = sum_mut_slice_loop a 0 0 in Ok (i, a) diff --git a/tests/fstar/arrays/Arrays.Types.fst b/tests/fstar/arrays/Arrays.Types.fst index d3596e92..41f892ad 100644 --- a/tests/fstar/arrays/Arrays.Types.fst +++ b/tests/fstar/arrays/Arrays.Types.fst @@ -6,6 +6,6 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [arrays::AB] - Source: 'src/arrays.rs', lines 3:0-3:11 *) + Source: 'tests/src/arrays.rs', lines 6:0-6:11 *) type aB_t = | AB_A : aB_t | AB_B : aB_t diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Clauses.Template.fst b/tests/fstar/betree_back_stateful/BetreeMain.Clauses.Template.fst deleted file mode 100644 index b317dca4..00000000 --- a/tests/fstar/betree_back_stateful/BetreeMain.Clauses.Template.fst +++ /dev/null @@ -1,117 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [betree_main]: templates for the decreases clauses *) -module BetreeMain.Clauses.Template -open Primitives -open BetreeMain.Types - -#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" - -(** [betree_main::betree::{betree_main::betree::List<T>#1}::len]: decreases clause - Source: 'src/betree.rs', lines 276:4-276:24 *) -unfold -let betree_List_len_decreases (t : Type0) (self : betree_List_t t) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::List<T>#1}::split_at]: decreases clause - Source: 'src/betree.rs', lines 284:4-284:51 *) -unfold -let betree_List_split_at_decreases (t : Type0) (self : betree_List_t t) - (n : u64) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: decreases clause - Source: 'src/betree.rs', lines 339:4-339:73 *) -unfold -let betree_ListPairU64T_partition_at_pivot_decreases (t : Type0) - (self : betree_List_t (u64 & t)) (pivot : u64) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: decreases clause - Source: 'src/betree.rs', lines 789:4-792:34 *) -unfold -let betree_Node_lookup_first_message_for_key_decreases (key : u64) - (msgs : betree_List_t (u64 & betree_Message_t)) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: decreases clause - Source: 'src/betree.rs', lines 636:4-636:80 *) -unfold -let betree_Node_lookup_in_bindings_decreases (key : u64) - (bindings : betree_List_t (u64 & u64)) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: decreases clause - Source: 'src/betree.rs', lines 819:4-819:90 *) -unfold -let betree_Node_apply_upserts_decreases - (msgs : betree_List_t (u64 & betree_Message_t)) (prev : option u64) - (key : u64) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: decreases clause - Source: 'src/betree.rs', lines 395:4-395:63 *) -unfold -let betree_Internal_lookup_in_children_decreases (self : betree_Internal_t) - (key : u64) (st : state) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: decreases clause - Source: 'src/betree.rs', lines 709:4-709:58 *) -unfold -let betree_Node_lookup_decreases (self : betree_Node_t) (key : u64) - (st : state) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: decreases clause - Source: 'src/betree.rs', lines 674:4-674:77 *) -unfold -let betree_Node_filter_messages_for_key_decreases (key : u64) - (msgs : betree_List_t (u64 & betree_Message_t)) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: decreases clause - Source: 'src/betree.rs', lines 689:4-692:34 *) -unfold -let betree_Node_lookup_first_message_after_key_decreases (key : u64) - (msgs : betree_List_t (u64 & betree_Message_t)) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_internal]: decreases clause - Source: 'src/betree.rs', lines 502:4-505:5 *) -unfold -let betree_Node_apply_messages_to_internal_decreases - (msgs : betree_List_t (u64 & betree_Message_t)) - (new_msgs : betree_List_t (u64 & betree_Message_t)) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: decreases clause - Source: 'src/betree.rs', lines 653:4-656:32 *) -unfold -let betree_Node_lookup_mut_in_bindings_decreases (key : u64) - (bindings : betree_List_t (u64 & u64)) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_leaf]: decreases clause - Source: 'src/betree.rs', lines 444:4-447:5 *) -unfold -let betree_Node_apply_messages_to_leaf_decreases - (bindings : betree_List_t (u64 & u64)) - (new_msgs : betree_List_t (u64 & betree_Message_t)) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: decreases clause - Source: 'src/betree.rs', lines 410:4-415:26 *) -unfold -let betree_Internal_flush_decreases (self : betree_Internal_t) - (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) - (content : betree_List_t (u64 & betree_Message_t)) (st : state) : nat = - admit () - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: decreases clause - Source: 'src/betree.rs', lines 588:4-593:5 *) -unfold -let betree_Node_apply_messages_decreases (self : betree_Node_t) - (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) - (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) : nat = - admit () - diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Clauses.fst b/tests/fstar/betree_back_stateful/BetreeMain.Clauses.fst deleted file mode 100644 index b95d4c7e..00000000 --- a/tests/fstar/betree_back_stateful/BetreeMain.Clauses.fst +++ /dev/null @@ -1,210 +0,0 @@ -(** [betree_main]: templates for the decreases clauses *) -module BetreeMain.Clauses -open Primitives -open BetreeMain.Types - -#set-options "--z3rlimit 50 --fuel 0 --ifuel 1" - -(*** Well-founded relations *) - -(* We had a few issues when proving termination of the mutually recursive functions: - * - betree_Internal_flush - * - betree_Node_apply_messages - * - * The quantity which effectively decreases is: - * (betree_size, messages_length) - * where messages_length is 0 when there are no messages - * (and where we use the lexicographic ordering, of course) - * - * However, the `%[...]` and `{:well-founded ...} notations are not available outside - * of `decrease` clauses. - * - * We thus resorted to writing and proving correct a well-founded relation over - * pairs of natural numbers. The trick is that `<<` can be used outside of decrease - * clauses, and can be used to trigger SMT patterns. - * - * What follows is adapted from: - * https://www.fstar-lang.org/tutorial/book/part2/part2_well_founded.html - * - * Also, the following PR might make things easier: - * https://github.com/FStarLang/FStar/pull/2561 - *) - -module P = FStar.Preorder -module W = FStar.WellFounded -module L = FStar.LexicographicOrdering - -let lt_nat (x y:nat) : Type = x < y == true -let rec wf_lt_nat (x:nat) - : W.acc lt_nat x - = W.AccIntro (fun y _ -> wf_lt_nat y) - -// A type abbreviation for a pair of nats -let nat_pair = (x:nat & nat) - -// Making a lexicographic ordering from a pair of nat ordering -let lex_order_nat_pair : P.relation nat_pair = - L.lex_t lt_nat (fun _ -> lt_nat) - -// The lex order on nat pairs is well-founded, using our general proof -// of lexicographic composition of well-founded orders -let lex_order_nat_pair_wf : W.well_founded lex_order_nat_pair = - L.lex_t_wf wf_lt_nat (fun _ -> wf_lt_nat) - -// A utility to introduce lt_nat -let mk_lt_nat (x:nat) (y:nat { x < y }) : lt_nat x y = - let _ : equals (x < y) true = Refl in - () - -// A utility to make a lex ordering of nat pairs -let mk_lex_order_nat_pair (xy0:nat_pair) - (xy1:nat_pair { - let (|x0, y0|) = xy0 in - let (|x1, y1|) = xy1 in - x0 < x1 \/ (x0 == x1 /\ y0 < y1) - }) : lex_order_nat_pair xy0 xy1 = - let (|x0, y0|) = xy0 in - let (|x1, y1|) = xy1 in - if x0 < x1 then L.Left_lex x0 x1 y0 y1 (mk_lt_nat x0 x1) - else L.Right_lex x0 y0 y1 (mk_lt_nat y0 y1) - -let rec coerce #a #r #x (p:W.acc #a r x) : Tot (W.acc r x) (decreases p) = - W.AccIntro (fun y r -> coerce (p.access_smaller y r)) - -let coerce_wf #a #r (p: (x:a -> W.acc r x)) : x:a -> W.acc r x = - fun x -> coerce (p x) - -(* We need this axiom, which comes from the following discussion: - * https://github.com/FStarLang/FStar/issues/1916 - * An issue here is that the `{well-founded ... }` notation - *) -assume -val axiom_well_founded (a : Type) (rel : a -> a -> Type0) - (rwf : W.well_founded #a rel) (x y : a) : - Lemma (requires (rel x y)) (ensures (x << y)) - -(* This lemma has a pattern (which makes it work) *) -let wf_nat_pair_lem (p0 p1 : nat_pair) : - Lemma - (requires ( - let (|x0, y0|) = p0 in - let (|x1, y1|) = p1 in - x0 < x1 || (x0 = x1 && y0 < y1))) - (ensures (p0 << p1)) - [SMTPat (p0 << p1)] = - let rel = lex_order_nat_pair in - let rel_wf = lex_order_nat_pair_wf in - let _ = mk_lex_order_nat_pair p0 p1 in - assert(rel p0 p1); - axiom_well_founded nat_pair rel rel_wf p0 p1 - -(*** Decrease clauses *) -/// "Standard" decrease clauses - -(** [betree_main::betree::List::{1}::len]: decreases clause *) -unfold -let betree_List_len_decreases (t : Type0) (self : betree_List_t t) : betree_List_t t = - self - -(** [betree_main::betree::List::{1}::split_at]: decreases clause *) -unfold -let betree_List_split_at_decreases (t : Type0) (self : betree_List_t t) - (n : u64) : nat = - n - -(** [betree_main::betree::List::{2}::partition_at_pivot]: decreases clause *) -unfold -let betree_ListPairU64T_partition_at_pivot_decreases (t : Type0) - (self : betree_List_t (u64 & t)) (pivot : u64) : betree_List_t (u64 & t) = - self - -(** [betree_main::betree::Node::{5}::lookup_in_bindings]: decreases clause *) -unfold -let betree_Node_lookup_in_bindings_decreases (key : u64) - (bindings : betree_List_t (u64 & u64)) : betree_List_t (u64 & u64) = - bindings - -(** [betree_main::betree::Node::{5}::lookup_first_message_for_key]: decreases clause *) -unfold -let betree_Node_lookup_first_message_for_key_decreases (key : u64) - (msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = - msgs - -(** [betree_main::betree::Node::{5}::apply_upserts]: decreases clause *) -unfold -let betree_Node_apply_upserts_decreases - (msgs : betree_List_t (u64 & betree_Message_t)) (prev : option u64) - (key : u64) : betree_List_t (u64 & betree_Message_t) = - msgs - -(** [betree_main::betree::Internal::{4}::lookup_in_children]: decreases clause *) -unfold -let betree_Internal_lookup_in_children_decreases (self : betree_Internal_t) - (key : u64) (st : state) : betree_Internal_t = - self - -(** [betree_main::betree::Node::{5}::lookup]: decreases clause *) -unfold -let betree_Node_lookup_decreases (self : betree_Node_t) (key : u64) - (st : state) : betree_Node_t = - self - -(** [betree_main::betree::Node::{5}::lookup_mut_in_bindings]: decreases clause *) -unfold -let betree_Node_lookup_mut_in_bindings_decreases (key : u64) - (bindings : betree_List_t (u64 & u64)) : betree_List_t (u64 & u64) = - bindings - -unfold -let betree_Node_apply_messages_to_leaf_decreases - (bindings : betree_List_t (u64 & u64)) - (new_msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = - new_msgs - -(** [betree_main::betree::Node::{5}::filter_messages_for_key]: decreases clause *) -unfold -let betree_Node_filter_messages_for_key_decreases (key : u64) - (msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = - msgs - -(** [betree_main::betree::Node::{5}::lookup_first_message_after_key]: decreases clause *) -unfold -let betree_Node_lookup_first_message_after_key_decreases (key : u64) - (msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = - msgs - -let betree_Node_apply_messages_to_internal_decreases - (msgs : betree_List_t (u64 & betree_Message_t)) - (new_msgs : betree_List_t (u64 & betree_Message_t)) : betree_List_t (u64 & betree_Message_t) = - new_msgs - -(*** Decrease clauses - nat_pair *) -/// The following decrease clauses use the [nat_pair] definition and the well-founded -/// relation proven above. - -let rec betree_size (bt : betree_Node_t) : nat = - match bt with - | Betree_Node_Internal node -> 1 + betree_Internal_size node - | Betree_Node_Leaf _ -> 1 - -and betree_Internal_size (node : betree_Internal_t) : nat = - 1 + betree_size node.left + betree_size node.right - -let rec betree_List_len (#a : Type0) (ls : betree_List_t a) : nat = - match ls with - | Betree_List_Cons _ tl -> 1 + betree_List_len tl - | Betree_List_Nil -> 0 - -(** [betree_main::betree::Internal::{4}::flush]: decreases clause *) -unfold -let betree_Internal_flush_decreases (self : betree_Internal_t) - (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) - (content : betree_List_t (u64 & betree_Message_t)) (st : state) : nat_pair = - (|betree_Internal_size self, 0|) - -(** [betree_main::betree::Node::{5}::apply_messages]: decreases clause *) -unfold -let betree_Node_apply_messages_decreases (self : betree_Node_t) - (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) - (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) : nat_pair = - (|betree_size self, betree_List_len msgs|) diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst b/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst deleted file mode 100644 index 9942ef68..00000000 --- a/tests/fstar/betree_back_stateful/BetreeMain.Funs.fst +++ /dev/null @@ -1,676 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [betree_main]: function definitions *) -module BetreeMain.Funs -open Primitives -include BetreeMain.Types -include BetreeMain.FunsExternal -include BetreeMain.Clauses - -#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" - -(** [betree_main::betree::load_internal_node]: - Source: 'src/betree.rs', lines 36:0-36:52 *) -let betree_load_internal_node - (id : u64) (st : state) : - result (state & (betree_List_t (u64 & betree_Message_t))) - = - betree_utils_load_internal_node id st - -(** [betree_main::betree::store_internal_node]: - Source: 'src/betree.rs', lines 41:0-41:60 *) -let betree_store_internal_node - (id : u64) (content : betree_List_t (u64 & betree_Message_t)) (st : state) : - result (state & unit) - = - betree_utils_store_internal_node id content st - -(** [betree_main::betree::load_leaf_node]: - Source: 'src/betree.rs', lines 46:0-46:44 *) -let betree_load_leaf_node - (id : u64) (st : state) : result (state & (betree_List_t (u64 & u64))) = - betree_utils_load_leaf_node id st - -(** [betree_main::betree::store_leaf_node]: - Source: 'src/betree.rs', lines 51:0-51:52 *) -let betree_store_leaf_node - (id : u64) (content : betree_List_t (u64 & u64)) (st : state) : - result (state & unit) - = - betree_utils_store_leaf_node id content st - -(** [betree_main::betree::fresh_node_id]: - Source: 'src/betree.rs', lines 55:0-55:48 *) -let betree_fresh_node_id (counter : u64) : result (u64 & u64) = - let* counter1 = u64_add counter 1 in Ok (counter, counter1) - -(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::new]: - Source: 'src/betree.rs', lines 206:4-206:20 *) -let betree_NodeIdCounter_new : result betree_NodeIdCounter_t = - Ok { next_node_id = 0 } - -(** [betree_main::betree::{betree_main::betree::NodeIdCounter}::fresh_id]: - Source: 'src/betree.rs', lines 210:4-210:36 *) -let betree_NodeIdCounter_fresh_id - (self : betree_NodeIdCounter_t) : result (u64 & betree_NodeIdCounter_t) = - let* i = u64_add self.next_node_id 1 in - Ok (self.next_node_id, { next_node_id = i }) - -(** [betree_main::betree::upsert_update]: - Source: 'src/betree.rs', lines 234:0-234:70 *) -let betree_upsert_update - (prev : option u64) (st : betree_UpsertFunState_t) : result u64 = - begin match prev with - | None -> - begin match st with - | Betree_UpsertFunState_Add v -> Ok v - | Betree_UpsertFunState_Sub _ -> Ok 0 - end - | Some prev1 -> - begin match st with - | Betree_UpsertFunState_Add v -> - let* margin = u64_sub core_u64_max prev1 in - if margin >= v then u64_add prev1 v else Ok core_u64_max - | Betree_UpsertFunState_Sub v -> - if prev1 >= v then u64_sub prev1 v else Ok 0 - end - end - -(** [betree_main::betree::{betree_main::betree::List<T>#1}::len]: - Source: 'src/betree.rs', lines 276:4-276:24 *) -let rec betree_List_len - (t : Type0) (self : betree_List_t t) : - Tot (result u64) (decreases (betree_List_len_decreases t self)) - = - begin match self with - | Betree_List_Cons _ tl -> let* i = betree_List_len t tl in u64_add 1 i - | Betree_List_Nil -> Ok 0 - end - -(** [betree_main::betree::{betree_main::betree::List<T>#1}::split_at]: - Source: 'src/betree.rs', lines 284:4-284:51 *) -let rec betree_List_split_at - (t : Type0) (self : betree_List_t t) (n : u64) : - Tot (result ((betree_List_t t) & (betree_List_t t))) - (decreases (betree_List_split_at_decreases t self n)) - = - if n = 0 - then Ok (Betree_List_Nil, self) - else - begin match self with - | Betree_List_Cons hd tl -> - let* i = u64_sub n 1 in - let* p = betree_List_split_at t tl i in - let (ls0, ls1) = p in - Ok (Betree_List_Cons hd ls0, ls1) - | Betree_List_Nil -> Fail Failure - end - -(** [betree_main::betree::{betree_main::betree::List<T>#1}::push_front]: - Source: 'src/betree.rs', lines 299:4-299:34 *) -let betree_List_push_front - (t : Type0) (self : betree_List_t t) (x : t) : result (betree_List_t t) = - let (tl, _) = core_mem_replace (betree_List_t t) self Betree_List_Nil in - Ok (Betree_List_Cons x tl) - -(** [betree_main::betree::{betree_main::betree::List<T>#1}::pop_front]: - Source: 'src/betree.rs', lines 306:4-306:32 *) -let betree_List_pop_front - (t : Type0) (self : betree_List_t t) : result (t & (betree_List_t t)) = - let (ls, _) = core_mem_replace (betree_List_t t) self Betree_List_Nil in - begin match ls with - | Betree_List_Cons x tl -> Ok (x, tl) - | Betree_List_Nil -> Fail Failure - end - -(** [betree_main::betree::{betree_main::betree::List<T>#1}::hd]: - Source: 'src/betree.rs', lines 318:4-318:22 *) -let betree_List_hd (t : Type0) (self : betree_List_t t) : result t = - begin match self with - | Betree_List_Cons hd _ -> Ok hd - | Betree_List_Nil -> Fail Failure - end - -(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::head_has_key]: - Source: 'src/betree.rs', lines 327:4-327:44 *) -let betree_ListPairU64T_head_has_key - (t : Type0) (self : betree_List_t (u64 & t)) (key : u64) : result bool = - begin match self with - | Betree_List_Cons hd _ -> let (i, _) = hd in Ok (i = key) - | Betree_List_Nil -> Ok false - end - -(** [betree_main::betree::{betree_main::betree::List<(u64, T)>#2}::partition_at_pivot]: - Source: 'src/betree.rs', lines 339:4-339:73 *) -let rec betree_ListPairU64T_partition_at_pivot - (t : Type0) (self : betree_List_t (u64 & t)) (pivot : u64) : - Tot (result ((betree_List_t (u64 & t)) & (betree_List_t (u64 & t)))) - (decreases (betree_ListPairU64T_partition_at_pivot_decreases t self pivot)) - = - begin match self with - | Betree_List_Cons hd tl -> - let (i, x) = hd in - if i >= pivot - then Ok (Betree_List_Nil, Betree_List_Cons (i, x) tl) - else - let* p = betree_ListPairU64T_partition_at_pivot t tl pivot in - let (ls0, ls1) = p in - Ok (Betree_List_Cons (i, x) ls0, ls1) - | Betree_List_Nil -> Ok (Betree_List_Nil, Betree_List_Nil) - end - -(** [betree_main::betree::{betree_main::betree::Leaf#3}::split]: - Source: 'src/betree.rs', lines 359:4-364:17 *) -let betree_Leaf_split - (self : betree_Leaf_t) (content : betree_List_t (u64 & u64)) - (params : betree_Params_t) (node_id_cnt : betree_NodeIdCounter_t) - (st : state) : - result (state & (betree_Internal_t & betree_NodeIdCounter_t)) - = - let* p = betree_List_split_at (u64 & u64) content params.split_size in - let (content0, content1) = p in - let* p1 = betree_List_hd (u64 & u64) content1 in - let (pivot, _) = p1 in - let* (id0, node_id_cnt1) = betree_NodeIdCounter_fresh_id node_id_cnt in - let* (id1, node_id_cnt2) = betree_NodeIdCounter_fresh_id node_id_cnt1 in - let* (st1, _) = betree_store_leaf_node id0 content0 st in - let* (st2, _) = betree_store_leaf_node id1 content1 st1 in - let n = Betree_Node_Leaf { id = id0; size = params.split_size } in - let n1 = Betree_Node_Leaf { id = id1; size = params.split_size } in - Ok (st2, ({ id = self.id; pivot = pivot; left = n; right = n1 }, - node_id_cnt2)) - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_for_key]: - Source: 'src/betree.rs', lines 789:4-792:34 *) -let rec betree_Node_lookup_first_message_for_key - (key : u64) (msgs : betree_List_t (u64 & betree_Message_t)) : - Tot (result ((betree_List_t (u64 & betree_Message_t)) & (betree_List_t (u64 & - betree_Message_t) -> result (betree_List_t (u64 & betree_Message_t))))) - (decreases (betree_Node_lookup_first_message_for_key_decreases key msgs)) - = - begin match msgs with - | Betree_List_Cons x next_msgs -> - let (i, m) = x in - if i >= key - then Ok (Betree_List_Cons (i, m) next_msgs, Ok) - else - let* (l, lookup_first_message_for_key_back) = - betree_Node_lookup_first_message_for_key key next_msgs in - let back = - fun ret -> - let* next_msgs1 = lookup_first_message_for_key_back ret in - Ok (Betree_List_Cons (i, m) next_msgs1) in - Ok (l, back) - | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_in_bindings]: - Source: 'src/betree.rs', lines 636:4-636:80 *) -let rec betree_Node_lookup_in_bindings - (key : u64) (bindings : betree_List_t (u64 & u64)) : - Tot (result (option u64)) - (decreases (betree_Node_lookup_in_bindings_decreases key bindings)) - = - begin match bindings with - | Betree_List_Cons hd tl -> - let (i, i1) = hd in - if i = key - then Ok (Some i1) - else if i > key then Ok None else betree_Node_lookup_in_bindings key tl - | Betree_List_Nil -> Ok None - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_upserts]: - Source: 'src/betree.rs', lines 819:4-819:90 *) -let rec betree_Node_apply_upserts - (msgs : betree_List_t (u64 & betree_Message_t)) (prev : option u64) - (key : u64) : - Tot (result (u64 & (betree_List_t (u64 & betree_Message_t)))) - (decreases (betree_Node_apply_upserts_decreases msgs prev key)) - = - let* b = betree_ListPairU64T_head_has_key betree_Message_t msgs key in - if b - then - let* (msg, msgs1) = betree_List_pop_front (u64 & betree_Message_t) msgs in - let (_, m) = msg in - begin match m with - | Betree_Message_Insert _ -> Fail Failure - | Betree_Message_Delete -> Fail Failure - | Betree_Message_Upsert s -> - let* v = betree_upsert_update prev s in - betree_Node_apply_upserts msgs1 (Some v) key - end - else - let* v = core_option_Option_unwrap u64 prev in - let* msgs1 = - betree_List_push_front (u64 & betree_Message_t) msgs (key, - Betree_Message_Insert v) in - Ok (v, msgs1) - -(** [betree_main::betree::{betree_main::betree::Internal#4}::lookup_in_children]: - Source: 'src/betree.rs', lines 395:4-395:63 *) -let rec betree_Internal_lookup_in_children - (self : betree_Internal_t) (key : u64) (st : state) : - Tot (result (state & ((option u64) & betree_Internal_t))) - (decreases (betree_Internal_lookup_in_children_decreases self key st)) - = - if key < self.pivot - then - let* (st1, (o, n)) = betree_Node_lookup self.left key st in - Ok (st1, (o, { self with left = n })) - else - let* (st1, (o, n)) = betree_Node_lookup self.right key st in - Ok (st1, (o, { self with right = n })) - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup]: - Source: 'src/betree.rs', lines 709:4-709:58 *) -and betree_Node_lookup - (self : betree_Node_t) (key : u64) (st : state) : - Tot (result (state & ((option u64) & betree_Node_t))) - (decreases (betree_Node_lookup_decreases self key st)) - = - begin match self with - | Betree_Node_Internal node -> - let* (st1, msgs) = betree_load_internal_node node.id st in - let* (pending, lookup_first_message_for_key_back) = - betree_Node_lookup_first_message_for_key key msgs in - begin match pending with - | Betree_List_Cons p l -> - let (k, msg) = p in - if k <> key - then - let* (st2, (o, node1)) = - betree_Internal_lookup_in_children node key st1 in - let* _ = - lookup_first_message_for_key_back (Betree_List_Cons (k, msg) l) in - Ok (st2, (o, Betree_Node_Internal node1)) - else - begin match msg with - | Betree_Message_Insert v -> - let* _ = - lookup_first_message_for_key_back (Betree_List_Cons (k, - Betree_Message_Insert v) l) in - Ok (st1, (Some v, Betree_Node_Internal node)) - | Betree_Message_Delete -> - let* _ = - lookup_first_message_for_key_back (Betree_List_Cons (k, - Betree_Message_Delete) l) in - Ok (st1, (None, Betree_Node_Internal node)) - | Betree_Message_Upsert ufs -> - let* (st2, (v, node1)) = - betree_Internal_lookup_in_children node key st1 in - let* (v1, pending1) = - betree_Node_apply_upserts (Betree_List_Cons (k, - Betree_Message_Upsert ufs) l) v key in - let* msgs1 = lookup_first_message_for_key_back pending1 in - let* (st3, _) = betree_store_internal_node node1.id msgs1 st2 in - Ok (st3, (Some v1, Betree_Node_Internal node1)) - end - | Betree_List_Nil -> - let* (st2, (o, node1)) = betree_Internal_lookup_in_children node key st1 - in - let* _ = lookup_first_message_for_key_back Betree_List_Nil in - Ok (st2, (o, Betree_Node_Internal node1)) - end - | Betree_Node_Leaf node -> - let* (st1, bindings) = betree_load_leaf_node node.id st in - let* o = betree_Node_lookup_in_bindings key bindings in - Ok (st1, (o, Betree_Node_Leaf node)) - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::filter_messages_for_key]: - Source: 'src/betree.rs', lines 674:4-674:77 *) -let rec betree_Node_filter_messages_for_key - (key : u64) (msgs : betree_List_t (u64 & betree_Message_t)) : - Tot (result (betree_List_t (u64 & betree_Message_t))) - (decreases (betree_Node_filter_messages_for_key_decreases key msgs)) - = - begin match msgs with - | Betree_List_Cons p l -> - let (k, m) = p in - if k = key - then - let* (_, msgs1) = - betree_List_pop_front (u64 & betree_Message_t) (Betree_List_Cons (k, m) - l) in - betree_Node_filter_messages_for_key key msgs1 - else Ok (Betree_List_Cons (k, m) l) - | Betree_List_Nil -> Ok Betree_List_Nil - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_first_message_after_key]: - Source: 'src/betree.rs', lines 689:4-692:34 *) -let rec betree_Node_lookup_first_message_after_key - (key : u64) (msgs : betree_List_t (u64 & betree_Message_t)) : - Tot (result ((betree_List_t (u64 & betree_Message_t)) & (betree_List_t (u64 & - betree_Message_t) -> result (betree_List_t (u64 & betree_Message_t))))) - (decreases (betree_Node_lookup_first_message_after_key_decreases key msgs)) - = - begin match msgs with - | Betree_List_Cons p next_msgs -> - let (k, m) = p in - if k = key - then - let* (l, lookup_first_message_after_key_back) = - betree_Node_lookup_first_message_after_key key next_msgs in - let back = - fun ret -> - let* next_msgs1 = lookup_first_message_after_key_back ret in - Ok (Betree_List_Cons (k, m) next_msgs1) in - Ok (l, back) - else Ok (Betree_List_Cons (k, m) next_msgs, Ok) - | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_internal]: - Source: 'src/betree.rs', lines 521:4-521:89 *) -let betree_Node_apply_to_internal - (msgs : betree_List_t (u64 & betree_Message_t)) (key : u64) - (new_msg : betree_Message_t) : - result (betree_List_t (u64 & betree_Message_t)) - = - let* (msgs1, lookup_first_message_for_key_back) = - betree_Node_lookup_first_message_for_key key msgs in - let* b = betree_ListPairU64T_head_has_key betree_Message_t msgs1 key in - if b - then - begin match new_msg with - | Betree_Message_Insert i -> - let* msgs2 = betree_Node_filter_messages_for_key key msgs1 in - let* msgs3 = - betree_List_push_front (u64 & betree_Message_t) msgs2 (key, - Betree_Message_Insert i) in - lookup_first_message_for_key_back msgs3 - | Betree_Message_Delete -> - let* msgs2 = betree_Node_filter_messages_for_key key msgs1 in - let* msgs3 = - betree_List_push_front (u64 & betree_Message_t) msgs2 (key, - Betree_Message_Delete) in - lookup_first_message_for_key_back msgs3 - | Betree_Message_Upsert s -> - let* p = betree_List_hd (u64 & betree_Message_t) msgs1 in - let (_, m) = p in - begin match m with - | Betree_Message_Insert prev -> - let* v = betree_upsert_update (Some prev) s in - let* (_, msgs2) = betree_List_pop_front (u64 & betree_Message_t) msgs1 - in - let* msgs3 = - betree_List_push_front (u64 & betree_Message_t) msgs2 (key, - Betree_Message_Insert v) in - lookup_first_message_for_key_back msgs3 - | Betree_Message_Delete -> - let* (_, msgs2) = betree_List_pop_front (u64 & betree_Message_t) msgs1 - in - let* v = betree_upsert_update None s in - let* msgs3 = - betree_List_push_front (u64 & betree_Message_t) msgs2 (key, - Betree_Message_Insert v) in - lookup_first_message_for_key_back msgs3 - | Betree_Message_Upsert _ -> - let* (msgs2, lookup_first_message_after_key_back) = - betree_Node_lookup_first_message_after_key key msgs1 in - let* msgs3 = - betree_List_push_front (u64 & betree_Message_t) msgs2 (key, - Betree_Message_Upsert s) in - let* msgs4 = lookup_first_message_after_key_back msgs3 in - lookup_first_message_for_key_back msgs4 - end - end - else - let* msgs2 = - betree_List_push_front (u64 & betree_Message_t) msgs1 (key, new_msg) in - lookup_first_message_for_key_back msgs2 - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_internal]: - Source: 'src/betree.rs', lines 502:4-505:5 *) -let rec betree_Node_apply_messages_to_internal - (msgs : betree_List_t (u64 & betree_Message_t)) - (new_msgs : betree_List_t (u64 & betree_Message_t)) : - Tot (result (betree_List_t (u64 & betree_Message_t))) - (decreases (betree_Node_apply_messages_to_internal_decreases msgs new_msgs)) - = - begin match new_msgs with - | Betree_List_Cons new_msg new_msgs_tl -> - let (i, m) = new_msg in - let* msgs1 = betree_Node_apply_to_internal msgs i m in - betree_Node_apply_messages_to_internal msgs1 new_msgs_tl - | Betree_List_Nil -> Ok msgs - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::lookup_mut_in_bindings]: - Source: 'src/betree.rs', lines 653:4-656:32 *) -let rec betree_Node_lookup_mut_in_bindings - (key : u64) (bindings : betree_List_t (u64 & u64)) : - Tot (result ((betree_List_t (u64 & u64)) & (betree_List_t (u64 & u64) -> - result (betree_List_t (u64 & u64))))) - (decreases (betree_Node_lookup_mut_in_bindings_decreases key bindings)) - = - begin match bindings with - | Betree_List_Cons hd tl -> - let (i, i1) = hd in - if i >= key - then Ok (Betree_List_Cons (i, i1) tl, Ok) - else - let* (l, lookup_mut_in_bindings_back) = - betree_Node_lookup_mut_in_bindings key tl in - let back = - fun ret -> - let* tl1 = lookup_mut_in_bindings_back ret in - Ok (Betree_List_Cons (i, i1) tl1) in - Ok (l, back) - | Betree_List_Nil -> Ok (Betree_List_Nil, Ok) - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_to_leaf]: - Source: 'src/betree.rs', lines 460:4-460:87 *) -let betree_Node_apply_to_leaf - (bindings : betree_List_t (u64 & u64)) (key : u64) - (new_msg : betree_Message_t) : - result (betree_List_t (u64 & u64)) - = - let* (bindings1, lookup_mut_in_bindings_back) = - betree_Node_lookup_mut_in_bindings key bindings in - let* b = betree_ListPairU64T_head_has_key u64 bindings1 key in - if b - then - let* (hd, bindings2) = betree_List_pop_front (u64 & u64) bindings1 in - begin match new_msg with - | Betree_Message_Insert v -> - let* bindings3 = betree_List_push_front (u64 & u64) bindings2 (key, v) in - lookup_mut_in_bindings_back bindings3 - | Betree_Message_Delete -> lookup_mut_in_bindings_back bindings2 - | Betree_Message_Upsert s -> - let (_, i) = hd in - let* v = betree_upsert_update (Some i) s in - let* bindings3 = betree_List_push_front (u64 & u64) bindings2 (key, v) in - lookup_mut_in_bindings_back bindings3 - end - else - begin match new_msg with - | Betree_Message_Insert v -> - let* bindings2 = betree_List_push_front (u64 & u64) bindings1 (key, v) in - lookup_mut_in_bindings_back bindings2 - | Betree_Message_Delete -> lookup_mut_in_bindings_back bindings1 - | Betree_Message_Upsert s -> - let* v = betree_upsert_update None s in - let* bindings2 = betree_List_push_front (u64 & u64) bindings1 (key, v) in - lookup_mut_in_bindings_back bindings2 - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages_to_leaf]: - Source: 'src/betree.rs', lines 444:4-447:5 *) -let rec betree_Node_apply_messages_to_leaf - (bindings : betree_List_t (u64 & u64)) - (new_msgs : betree_List_t (u64 & betree_Message_t)) : - Tot (result (betree_List_t (u64 & u64))) - (decreases (betree_Node_apply_messages_to_leaf_decreases bindings new_msgs)) - = - begin match new_msgs with - | Betree_List_Cons new_msg new_msgs_tl -> - let (i, m) = new_msg in - let* bindings1 = betree_Node_apply_to_leaf bindings i m in - betree_Node_apply_messages_to_leaf bindings1 new_msgs_tl - | Betree_List_Nil -> Ok bindings - end - -(** [betree_main::betree::{betree_main::betree::Internal#4}::flush]: - Source: 'src/betree.rs', lines 410:4-415:26 *) -let rec betree_Internal_flush - (self : betree_Internal_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) - (content : betree_List_t (u64 & betree_Message_t)) (st : state) : - Tot (result (state & ((betree_List_t (u64 & betree_Message_t)) & - (betree_Internal_t & betree_NodeIdCounter_t)))) - (decreases ( - betree_Internal_flush_decreases self params node_id_cnt content st)) - = - let* p = - betree_ListPairU64T_partition_at_pivot betree_Message_t content self.pivot - in - let (msgs_left, msgs_right) = p in - let* len_left = betree_List_len (u64 & betree_Message_t) msgs_left in - if len_left >= params.min_flush_size - then - let* (st1, p1) = - betree_Node_apply_messages self.left params node_id_cnt msgs_left st in - let (n, node_id_cnt1) = p1 in - let* len_right = betree_List_len (u64 & betree_Message_t) msgs_right in - if len_right >= params.min_flush_size - then - let* (st2, p2) = - betree_Node_apply_messages self.right params node_id_cnt1 msgs_right - st1 in - let (n1, node_id_cnt2) = p2 in - Ok (st2, (Betree_List_Nil, ({ self with left = n; right = n1 }, - node_id_cnt2))) - else Ok (st1, (msgs_right, ({ self with left = n }, node_id_cnt1))) - else - let* (st1, p1) = - betree_Node_apply_messages self.right params node_id_cnt msgs_right st in - let (n, node_id_cnt1) = p1 in - Ok (st1, (msgs_left, ({ self with right = n }, node_id_cnt1))) - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply_messages]: - Source: 'src/betree.rs', lines 588:4-593:5 *) -and betree_Node_apply_messages - (self : betree_Node_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) - (msgs : betree_List_t (u64 & betree_Message_t)) (st : state) : - Tot (result (state & (betree_Node_t & betree_NodeIdCounter_t))) - (decreases ( - betree_Node_apply_messages_decreases self params node_id_cnt msgs st)) - = - begin match self with - | Betree_Node_Internal node -> - let* (st1, content) = betree_load_internal_node node.id st in - let* content1 = betree_Node_apply_messages_to_internal content msgs in - let* num_msgs = betree_List_len (u64 & betree_Message_t) content1 in - if num_msgs >= params.min_flush_size - then - let* (st2, (content2, p)) = - betree_Internal_flush node params node_id_cnt content1 st1 in - let (node1, node_id_cnt1) = p in - let* (st3, _) = betree_store_internal_node node1.id content2 st2 in - Ok (st3, (Betree_Node_Internal node1, node_id_cnt1)) - else - let* (st2, _) = betree_store_internal_node node.id content1 st1 in - Ok (st2, (Betree_Node_Internal node, node_id_cnt)) - | Betree_Node_Leaf node -> - let* (st1, content) = betree_load_leaf_node node.id st in - let* content1 = betree_Node_apply_messages_to_leaf content msgs in - let* len = betree_List_len (u64 & u64) content1 in - let* i = u64_mul 2 params.split_size in - if len >= i - then - let* (st2, (new_node, node_id_cnt1)) = - betree_Leaf_split node content1 params node_id_cnt st1 in - let* (st3, _) = betree_store_leaf_node node.id Betree_List_Nil st2 in - Ok (st3, (Betree_Node_Internal new_node, node_id_cnt1)) - else - let* (st2, _) = betree_store_leaf_node node.id content1 st1 in - Ok (st2, (Betree_Node_Leaf { node with size = len }, node_id_cnt)) - end - -(** [betree_main::betree::{betree_main::betree::Node#5}::apply]: - Source: 'src/betree.rs', lines 576:4-582:5 *) -let betree_Node_apply - (self : betree_Node_t) (params : betree_Params_t) - (node_id_cnt : betree_NodeIdCounter_t) (key : u64) - (new_msg : betree_Message_t) (st : state) : - result (state & (betree_Node_t & betree_NodeIdCounter_t)) - = - let* (st1, p) = - betree_Node_apply_messages self params node_id_cnt (Betree_List_Cons (key, - new_msg) Betree_List_Nil) st in - let (self1, node_id_cnt1) = p in - Ok (st1, (self1, node_id_cnt1)) - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::new]: - Source: 'src/betree.rs', lines 849:4-849:60 *) -let betree_BeTree_new - (min_flush_size : u64) (split_size : u64) (st : state) : - result (state & betree_BeTree_t) - = - let* node_id_cnt = betree_NodeIdCounter_new in - let* (id, node_id_cnt1) = betree_NodeIdCounter_fresh_id node_id_cnt in - let* (st1, _) = betree_store_leaf_node id Betree_List_Nil st in - Ok (st1, - { - params = { min_flush_size = min_flush_size; split_size = split_size }; - node_id_cnt = node_id_cnt1; - root = (Betree_Node_Leaf { id = id; size = 0 }) - }) - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::apply]: - Source: 'src/betree.rs', lines 868:4-868:47 *) -let betree_BeTree_apply - (self : betree_BeTree_t) (key : u64) (msg : betree_Message_t) (st : state) : - result (state & betree_BeTree_t) - = - let* (st1, p) = - betree_Node_apply self.root self.params self.node_id_cnt key msg st in - let (n, nic) = p in - Ok (st1, { self with node_id_cnt = nic; root = n }) - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::insert]: - Source: 'src/betree.rs', lines 874:4-874:52 *) -let betree_BeTree_insert - (self : betree_BeTree_t) (key : u64) (value : u64) (st : state) : - result (state & betree_BeTree_t) - = - betree_BeTree_apply self key (Betree_Message_Insert value) st - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::delete]: - Source: 'src/betree.rs', lines 880:4-880:38 *) -let betree_BeTree_delete - (self : betree_BeTree_t) (key : u64) (st : state) : - result (state & betree_BeTree_t) - = - betree_BeTree_apply self key Betree_Message_Delete st - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::upsert]: - Source: 'src/betree.rs', lines 886:4-886:59 *) -let betree_BeTree_upsert - (self : betree_BeTree_t) (key : u64) (upd : betree_UpsertFunState_t) - (st : state) : - result (state & betree_BeTree_t) - = - betree_BeTree_apply self key (Betree_Message_Upsert upd) st - -(** [betree_main::betree::{betree_main::betree::BeTree#6}::lookup]: - Source: 'src/betree.rs', lines 895:4-895:62 *) -let betree_BeTree_lookup - (self : betree_BeTree_t) (key : u64) (st : state) : - result (state & ((option u64) & betree_BeTree_t)) - = - let* (st1, (o, n)) = betree_Node_lookup self.root key st in - Ok (st1, (o, { self with root = n })) - -(** [betree_main::main]: - Source: 'src/main.rs', lines 4:0-4:9 *) -let main : result unit = - Ok () - -(** Unit test for [betree_main::main] *) -let _ = assert_norm (main = Ok ()) - diff --git a/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti b/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti deleted file mode 100644 index 8be98acf..00000000 --- a/tests/fstar/betree_back_stateful/BetreeMain.FunsExternal.fsti +++ /dev/null @@ -1,30 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [betree_main]: external function declarations *) -module BetreeMain.FunsExternal -open Primitives -include BetreeMain.Types - -#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" - -(** [betree_main::betree_utils::load_internal_node]: - Source: 'src/betree_utils.rs', lines 98:0-98:63 *) -val betree_utils_load_internal_node - : u64 -> state -> result (state & (betree_List_t (u64 & betree_Message_t))) - -(** [betree_main::betree_utils::store_internal_node]: - Source: 'src/betree_utils.rs', lines 115:0-115:71 *) -val betree_utils_store_internal_node - : - u64 -> betree_List_t (u64 & betree_Message_t) -> state -> result (state & - unit) - -(** [betree_main::betree_utils::load_leaf_node]: - Source: 'src/betree_utils.rs', lines 132:0-132:55 *) -val betree_utils_load_leaf_node - : u64 -> state -> result (state & (betree_List_t (u64 & u64))) - -(** [betree_main::betree_utils::store_leaf_node]: - Source: 'src/betree_utils.rs', lines 145:0-145:63 *) -val betree_utils_store_leaf_node - : u64 -> betree_List_t (u64 & u64) -> state -> result (state & unit) - diff --git a/tests/fstar/betree_back_stateful/BetreeMain.Types.fst b/tests/fstar/betree_back_stateful/BetreeMain.Types.fst deleted file mode 100644 index b87219b2..00000000 --- a/tests/fstar/betree_back_stateful/BetreeMain.Types.fst +++ /dev/null @@ -1,61 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [betree_main]: type definitions *) -module BetreeMain.Types -open Primitives -include BetreeMain.TypesExternal - -#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" - -(** [betree_main::betree::List] - Source: 'src/betree.rs', lines 17:0-17:23 *) -type betree_List_t (t : Type0) = -| Betree_List_Cons : t -> betree_List_t t -> betree_List_t t -| Betree_List_Nil : betree_List_t t - -(** [betree_main::betree::UpsertFunState] - Source: 'src/betree.rs', lines 63:0-63:23 *) -type betree_UpsertFunState_t = -| Betree_UpsertFunState_Add : u64 -> betree_UpsertFunState_t -| Betree_UpsertFunState_Sub : u64 -> betree_UpsertFunState_t - -(** [betree_main::betree::Message] - Source: 'src/betree.rs', lines 69:0-69:23 *) -type betree_Message_t = -| Betree_Message_Insert : u64 -> betree_Message_t -| Betree_Message_Delete : betree_Message_t -| Betree_Message_Upsert : betree_UpsertFunState_t -> betree_Message_t - -(** [betree_main::betree::Leaf] - Source: 'src/betree.rs', lines 167:0-167:11 *) -type betree_Leaf_t = { id : u64; size : u64; } - -(** [betree_main::betree::Internal] - Source: 'src/betree.rs', lines 156:0-156:15 *) -type betree_Internal_t = -{ - id : u64; pivot : u64; left : betree_Node_t; right : betree_Node_t; -} - -(** [betree_main::betree::Node] - Source: 'src/betree.rs', lines 179:0-179:9 *) -and betree_Node_t = -| Betree_Node_Internal : betree_Internal_t -> betree_Node_t -| Betree_Node_Leaf : betree_Leaf_t -> betree_Node_t - -(** [betree_main::betree::Params] - Source: 'src/betree.rs', lines 187:0-187:13 *) -type betree_Params_t = { min_flush_size : u64; split_size : u64; } - -(** [betree_main::betree::NodeIdCounter] - Source: 'src/betree.rs', lines 201:0-201:20 *) -type betree_NodeIdCounter_t = { next_node_id : u64; } - -(** [betree_main::betree::BeTree] - Source: 'src/betree.rs', lines 218:0-218:17 *) -type betree_BeTree_t = -{ - params : betree_Params_t; - node_id_cnt : betree_NodeIdCounter_t; - root : betree_Node_t; -} - diff --git a/tests/fstar/betree_back_stateful/BetreeMain.TypesExternal.fsti b/tests/fstar/betree_back_stateful/BetreeMain.TypesExternal.fsti deleted file mode 100644 index 1b2c53a6..00000000 --- a/tests/fstar/betree_back_stateful/BetreeMain.TypesExternal.fsti +++ /dev/null @@ -1,10 +0,0 @@ -(** THIS FILE WAS AUTOMATICALLY GENERATED BY AENEAS *) -(** [betree_main]: external type declarations *) -module BetreeMain.TypesExternal -open Primitives - -#set-options "--z3rlimit 50 --fuel 1 --ifuel 1" - -(** The state type used in the state-error monad *) -val state : Type0 - diff --git a/tests/fstar/betree_back_stateful/Makefile b/tests/fstar/betree_back_stateful/Makefile deleted file mode 100644 index fa7d1f36..00000000 --- a/tests/fstar/betree_back_stateful/Makefile +++ /dev/null @@ -1,49 +0,0 @@ -# This file was automatically generated - modify ../Makefile.template instead -INCLUDE_DIRS = . - -FSTAR_INCLUDES = $(addprefix --include ,$(INCLUDE_DIRS)) - -FSTAR_HINTS ?= --use_hints --use_hint_hashes --record_hints - -FSTAR_OPTIONS = $(FSTAR_HINTS) \ - --cache_checked_modules $(FSTAR_INCLUDES) --cmi \ - --warn_error '+241@247+285-274' \ - -FSTAR_EXE ?= fstar.exe -FSTAR_NO_FLAGS = $(FSTAR_EXE) --already_cached 'Prims FStar LowStar Steel' --odir obj --cache_dir obj - -FSTAR = $(FSTAR_NO_FLAGS) $(FSTAR_OPTIONS) - -# The F* roots are used to compute the dependency graph, and generate the .depend file -FSTAR_ROOTS ?= $(wildcard *.fst *.fsti) - -# Build all the files -all: $(addprefix obj/,$(addsuffix .checked,$(FSTAR_ROOTS))) - -# This is the right way to ensure the .depend file always gets re-built. -ifeq (,$(filter %-in,$(MAKECMDGOALS))) -ifndef NODEPEND -ifndef MAKE_RESTARTS -.depend: .FORCE - $(FSTAR_NO_FLAGS) --dep full $(notdir $(FSTAR_ROOTS)) > $@ - -.PHONY: .FORCE -.FORCE: -endif -endif - -include .depend -endif - -# For the interactive mode -%.fst-in %.fsti-in: - @echo $(FSTAR_OPTIONS) - -# Generete the .checked files in batch mode -%.checked: - $(FSTAR) $(FSTAR_OPTIONS) $< && \ - touch -c $@ - -.PHONY: clean -clean: - rm -f obj/* diff --git a/tests/fstar/betree_back_stateful/Primitives.fst b/tests/fstar/betree_back_stateful/Primitives.fst deleted file mode 100644 index 9951ccc3..00000000 --- a/tests/fstar/betree_back_stateful/Primitives.fst +++ /dev/null @@ -1,929 +0,0 @@ -/// This file lists primitive and assumed functions and types -module Primitives -open FStar.Mul -open FStar.List.Tot - -#set-options "--z3rlimit 15 --fuel 0 --ifuel 1" - -(*** Utilities *) -val list_update (#a : Type0) (ls : list a) (i : nat{i < length ls}) (x : a) : - ls':list a{ - length ls' = length ls /\ - index ls' i == x - } -#push-options "--fuel 1" -let rec list_update #a ls i x = - match ls with - | x' :: ls -> if i = 0 then x :: ls else x' :: list_update ls (i-1) x -#pop-options - -(*** Result *) -type error : Type0 = -| Failure -| OutOfFuel - -type result (a : Type0) : Type0 = -| Ok : v:a -> result a -| Fail : e:error -> result a - -// Monadic return operator -unfold let return (#a : Type0) (x : a) : result a = Ok x - -// Monadic bind operator. -// Allows to use the notation: -// ``` -// let* x = y in -// ... -// ``` -unfold let (let*) (#a #b : Type0) (m: result a) - (f: (x:a) -> Pure (result b) (requires (m == Ok x)) (ensures fun _ -> True)) : - result b = - match m with - | Ok x -> f x - | Fail e -> Fail e - -// Monadic assert(...) -let massert (b:bool) : result unit = if b then Ok () else Fail Failure - -// Normalize and unwrap a successful result (used for globals). -let eval_global (#a : Type0) (x : result a{Ok? (normalize_term x)}) : a = Ok?.v x - -(*** Misc *) -type char = FStar.Char.char -type string = string - -let is_zero (n: nat) : bool = n = 0 -let decrease (n: nat{n > 0}) : nat = n - 1 - -let core_mem_replace (a : Type0) (x : a) (y : a) : a & a = (x, x) - -// We don't really use raw pointers for now -type mut_raw_ptr (t : Type0) = { v : t } -type const_raw_ptr (t : Type0) = { v : t } - -(*** Scalars *) -/// Rem.: most of the following code was partially generated - -assume val size_numbits : pos - -// TODO: we could use FStar.Int.int_t and FStar.UInt.int_t - -let isize_min : int = -9223372036854775808 // TODO: should be opaque -let isize_max : int = 9223372036854775807 // TODO: should be opaque -let i8_min : int = -128 -let i8_max : int = 127 -let i16_min : int = -32768 -let i16_max : int = 32767 -let i32_min : int = -2147483648 -let i32_max : int = 2147483647 -let i64_min : int = -9223372036854775808 -let i64_max : int = 9223372036854775807 -let i128_min : int = -170141183460469231731687303715884105728 -let i128_max : int = 170141183460469231731687303715884105727 -let usize_min : int = 0 -let usize_max : int = 4294967295 // TODO: should be opaque -let u8_min : int = 0 -let u8_max : int = 255 -let u16_min : int = 0 -let u16_max : int = 65535 -let u32_min : int = 0 -let u32_max : int = 4294967295 -let u64_min : int = 0 -let u64_max : int = 18446744073709551615 -let u128_min : int = 0 -let u128_max : int = 340282366920938463463374607431768211455 - -type scalar_ty = -| Isize -| I8 -| I16 -| I32 -| I64 -| I128 -| Usize -| U8 -| U16 -| U32 -| U64 -| U128 - -let is_unsigned = function - | Isize | I8 | I16 | I32 | I64 | I128 -> false - | Usize | U8 | U16 | U32 | U64 | U128 -> true - -let scalar_min (ty : scalar_ty) : int = - match ty with - | Isize -> isize_min - | I8 -> i8_min - | I16 -> i16_min - | I32 -> i32_min - | I64 -> i64_min - | I128 -> i128_min - | Usize -> usize_min - | U8 -> u8_min - | U16 -> u16_min - | U32 -> u32_min - | U64 -> u64_min - | U128 -> u128_min - -let scalar_max (ty : scalar_ty) : int = - match ty with - | Isize -> isize_max - | I8 -> i8_max - | I16 -> i16_max - | I32 -> i32_max - | I64 -> i64_max - | I128 -> i128_max - | Usize -> usize_max - | U8 -> u8_max - | U16 -> u16_max - | U32 -> u32_max - | U64 -> u64_max - | U128 -> u128_max - -type scalar (ty : scalar_ty) : eqtype = x:int{scalar_min ty <= x && x <= scalar_max ty} - -let mk_scalar (ty : scalar_ty) (x : int) : result (scalar ty) = - if scalar_min ty <= x && scalar_max ty >= x then Ok x else Fail Failure - -let scalar_neg (#ty : scalar_ty) (x : scalar ty) : result (scalar ty) = mk_scalar ty (-x) - -let scalar_div (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - if y <> 0 then mk_scalar ty (x / y) else Fail Failure - -/// The remainder operation -let int_rem (x : int) (y : int{y <> 0}) : int = - if x >= 0 then (x % y) else -(x % y) - -(* Checking consistency with Rust *) -let _ = assert_norm(int_rem 1 2 = 1) -let _ = assert_norm(int_rem (-1) 2 = -1) -let _ = assert_norm(int_rem 1 (-2) = 1) -let _ = assert_norm(int_rem (-1) (-2) = -1) - -let scalar_rem (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - if y <> 0 then mk_scalar ty (int_rem x y) else Fail Failure - -let scalar_add (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - mk_scalar ty (x + y) - -let scalar_sub (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - mk_scalar ty (x - y) - -let scalar_mul (#ty : scalar_ty) (x : scalar ty) (y : scalar ty) : result (scalar ty) = - mk_scalar ty (x * y) - -let scalar_xor (#ty : scalar_ty) - (x : scalar ty) (y : scalar ty) : scalar ty = - match ty with - | U8 -> FStar.UInt.logxor #8 x y - | U16 -> FStar.UInt.logxor #16 x y - | U32 -> FStar.UInt.logxor #32 x y - | U64 -> FStar.UInt.logxor #64 x y - | U128 -> FStar.UInt.logxor #128 x y - | Usize -> admit() // TODO - | I8 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 8); - normalize_spec (scalar I8); - FStar.Int.logxor #8 x y - | I16 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 16); - normalize_spec (scalar I16); - FStar.Int.logxor #16 x y - | I32 -> FStar.Int.logxor #32 x y - | I64 -> FStar.Int.logxor #64 x y - | I128 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 128); - normalize_spec (scalar I128); - FStar.Int.logxor #128 x y - | Isize -> admit() // TODO - -let scalar_or (#ty : scalar_ty) - (x : scalar ty) (y : scalar ty) : scalar ty = - match ty with - | U8 -> FStar.UInt.logor #8 x y - | U16 -> FStar.UInt.logor #16 x y - | U32 -> FStar.UInt.logor #32 x y - | U64 -> FStar.UInt.logor #64 x y - | U128 -> FStar.UInt.logor #128 x y - | Usize -> admit() // TODO - | I8 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 8); - normalize_spec (scalar I8); - FStar.Int.logor #8 x y - | I16 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 16); - normalize_spec (scalar I16); - FStar.Int.logor #16 x y - | I32 -> FStar.Int.logor #32 x y - | I64 -> FStar.Int.logor #64 x y - | I128 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 128); - normalize_spec (scalar I128); - FStar.Int.logor #128 x y - | Isize -> admit() // TODO - -let scalar_and (#ty : scalar_ty) - (x : scalar ty) (y : scalar ty) : scalar ty = - match ty with - | U8 -> FStar.UInt.logand #8 x y - | U16 -> FStar.UInt.logand #16 x y - | U32 -> FStar.UInt.logand #32 x y - | U64 -> FStar.UInt.logand #64 x y - | U128 -> FStar.UInt.logand #128 x y - | Usize -> admit() // TODO - | I8 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 8); - normalize_spec (scalar I8); - FStar.Int.logand #8 x y - | I16 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 16); - normalize_spec (scalar I16); - FStar.Int.logand #16 x y - | I32 -> FStar.Int.logand #32 x y - | I64 -> FStar.Int.logand #64 x y - | I128 -> - // Encoding issues... - normalize_spec (FStar.Int.int_t 128); - normalize_spec (scalar I128); - FStar.Int.logand #128 x y - | Isize -> admit() // TODO - -// Shift left -let scalar_shl (#ty0 #ty1 : scalar_ty) - (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = - admit() - -// Shift right -let scalar_shr (#ty0 #ty1 : scalar_ty) - (x : scalar ty0) (y : scalar ty1) : result (scalar ty0) = - admit() - -(** Cast an integer from a [src_ty] to a [tgt_ty] *) -// TODO: check the semantics of casts in Rust -let scalar_cast (src_ty : scalar_ty) (tgt_ty : scalar_ty) (x : scalar src_ty) : result (scalar tgt_ty) = - mk_scalar tgt_ty x - -// This can't fail, but for now we make all casts faillible (easier for the translation) -let scalar_cast_bool (tgt_ty : scalar_ty) (x : bool) : result (scalar tgt_ty) = - mk_scalar tgt_ty (if x then 1 else 0) - -/// The scalar types -type isize : eqtype = scalar Isize -type i8 : eqtype = scalar I8 -type i16 : eqtype = scalar I16 -type i32 : eqtype = scalar I32 -type i64 : eqtype = scalar I64 -type i128 : eqtype = scalar I128 -type usize : eqtype = scalar Usize -type u8 : eqtype = scalar U8 -type u16 : eqtype = scalar U16 -type u32 : eqtype = scalar U32 -type u64 : eqtype = scalar U64 -type u128 : eqtype = scalar U128 - - -let core_isize_min : isize = isize_min -let core_isize_max : isize = isize_max -let core_i8_min : i8 = i8_min -let core_i8_max : i8 = i8_max -let core_i16_min : i16 = i16_min -let core_i16_max : i16 = i16_max -let core_i32_min : i32 = i32_min -let core_i32_max : i32 = i32_max -let core_i64_min : i64 = i64_min -let core_i64_max : i64 = i64_max -let core_i128_min : i128 = i128_min -let core_i128_max : i128 = i128_max - -let core_usize_min : usize = usize_min -let core_usize_max : usize = usize_max -let core_u8_min : u8 = u8_min -let core_u8_max : u8 = u8_max -let core_u16_min : u16 = u16_min -let core_u16_max : u16 = u16_max -let core_u32_min : u32 = u32_min -let core_u32_max : u32 = u32_max -let core_u64_min : u64 = u64_min -let core_u64_max : u64 = u64_max -let core_u128_min : u128 = u128_min -let core_u128_max : u128 = u128_max - -/// Negation -let isize_neg = scalar_neg #Isize -let i8_neg = scalar_neg #I8 -let i16_neg = scalar_neg #I16 -let i32_neg = scalar_neg #I32 -let i64_neg = scalar_neg #I64 -let i128_neg = scalar_neg #I128 - -/// Division -let isize_div = scalar_div #Isize -let i8_div = scalar_div #I8 -let i16_div = scalar_div #I16 -let i32_div = scalar_div #I32 -let i64_div = scalar_div #I64 -let i128_div = scalar_div #I128 -let usize_div = scalar_div #Usize -let u8_div = scalar_div #U8 -let u16_div = scalar_div #U16 -let u32_div = scalar_div #U32 -let u64_div = scalar_div #U64 -let u128_div = scalar_div #U128 - -/// Remainder -let isize_rem = scalar_rem #Isize -let i8_rem = scalar_rem #I8 -let i16_rem = scalar_rem #I16 -let i32_rem = scalar_rem #I32 -let i64_rem = scalar_rem #I64 -let i128_rem = scalar_rem #I128 -let usize_rem = scalar_rem #Usize -let u8_rem = scalar_rem #U8 -let u16_rem = scalar_rem #U16 -let u32_rem = scalar_rem #U32 -let u64_rem = scalar_rem #U64 -let u128_rem = scalar_rem #U128 - -/// Addition -let isize_add = scalar_add #Isize -let i8_add = scalar_add #I8 -let i16_add = scalar_add #I16 -let i32_add = scalar_add #I32 -let i64_add = scalar_add #I64 -let i128_add = scalar_add #I128 -let usize_add = scalar_add #Usize -let u8_add = scalar_add #U8 -let u16_add = scalar_add #U16 -let u32_add = scalar_add #U32 -let u64_add = scalar_add #U64 -let u128_add = scalar_add #U128 - -/// Subtraction -let isize_sub = scalar_sub #Isize -let i8_sub = scalar_sub #I8 -let i16_sub = scalar_sub #I16 -let i32_sub = scalar_sub #I32 -let i64_sub = scalar_sub #I64 -let i128_sub = scalar_sub #I128 -let usize_sub = scalar_sub #Usize -let u8_sub = scalar_sub #U8 -let u16_sub = scalar_sub #U16 -let u32_sub = scalar_sub #U32 -let u64_sub = scalar_sub #U64 -let u128_sub = scalar_sub #U128 - -/// Multiplication -let isize_mul = scalar_mul #Isize -let i8_mul = scalar_mul #I8 -let i16_mul = scalar_mul #I16 -let i32_mul = scalar_mul #I32 -let i64_mul = scalar_mul #I64 -let i128_mul = scalar_mul #I128 -let usize_mul = scalar_mul #Usize -let u8_mul = scalar_mul #U8 -let u16_mul = scalar_mul #U16 -let u32_mul = scalar_mul #U32 -let u64_mul = scalar_mul #U64 -let u128_mul = scalar_mul #U128 - -/// Xor -let u8_xor = scalar_xor #U8 -let u16_xor = scalar_xor #U16 -let u32_xor = scalar_xor #U32 -let u64_xor = scalar_xor #U64 -let u128_xor = scalar_xor #U128 -let usize_xor = scalar_xor #Usize -let i8_xor = scalar_xor #I8 -let i16_xor = scalar_xor #I16 -let i32_xor = scalar_xor #I32 -let i64_xor = scalar_xor #I64 -let i128_xor = scalar_xor #I128 -let isize_xor = scalar_xor #Isize - -/// Or -let u8_or = scalar_or #U8 -let u16_or = scalar_or #U16 -let u32_or = scalar_or #U32 -let u64_or = scalar_or #U64 -let u128_or = scalar_or #U128 -let usize_or = scalar_or #Usize -let i8_or = scalar_or #I8 -let i16_or = scalar_or #I16 -let i32_or = scalar_or #I32 -let i64_or = scalar_or #I64 -let i128_or = scalar_or #I128 -let isize_or = scalar_or #Isize - -/// And -let u8_and = scalar_and #U8 -let u16_and = scalar_and #U16 -let u32_and = scalar_and #U32 -let u64_and = scalar_and #U64 -let u128_and = scalar_and #U128 -let usize_and = scalar_and #Usize -let i8_and = scalar_and #I8 -let i16_and = scalar_and #I16 -let i32_and = scalar_and #I32 -let i64_and = scalar_and #I64 -let i128_and = scalar_and #I128 -let isize_and = scalar_and #Isize - -/// Shift left -let u8_shl #ty = scalar_shl #U8 #ty -let u16_shl #ty = scalar_shl #U16 #ty -let u32_shl #ty = scalar_shl #U32 #ty -let u64_shl #ty = scalar_shl #U64 #ty -let u128_shl #ty = scalar_shl #U128 #ty -let usize_shl #ty = scalar_shl #Usize #ty -let i8_shl #ty = scalar_shl #I8 #ty -let i16_shl #ty = scalar_shl #I16 #ty -let i32_shl #ty = scalar_shl #I32 #ty -let i64_shl #ty = scalar_shl #I64 #ty -let i128_shl #ty = scalar_shl #I128 #ty -let isize_shl #ty = scalar_shl #Isize #ty - -/// Shift right -let u8_shr #ty = scalar_shr #U8 #ty -let u16_shr #ty = scalar_shr #U16 #ty -let u32_shr #ty = scalar_shr #U32 #ty -let u64_shr #ty = scalar_shr #U64 #ty -let u128_shr #ty = scalar_shr #U128 #ty -let usize_shr #ty = scalar_shr #Usize #ty -let i8_shr #ty = scalar_shr #I8 #ty -let i16_shr #ty = scalar_shr #I16 #ty -let i32_shr #ty = scalar_shr #I32 #ty -let i64_shr #ty = scalar_shr #I64 #ty -let i128_shr #ty = scalar_shr #I128 #ty -let isize_shr #ty = scalar_shr #Isize #ty - -(*** core *) - -/// Trait declaration: [core::clone::Clone] -noeq type core_clone_Clone (self : Type0) = { - clone : self → result self -} - -let core_clone_impls_CloneBool_clone (b : bool) : bool = b - -let core_clone_CloneBool : core_clone_Clone bool = { - clone = fun b -> Ok (core_clone_impls_CloneBool_clone b) -} - -let core_clone_impls_CloneUsize_clone (x : usize) : usize = x -let core_clone_impls_CloneU8_clone (x : u8) : u8 = x -let core_clone_impls_CloneU16_clone (x : u16) : u16 = x -let core_clone_impls_CloneU32_clone (x : u32) : u32 = x -let core_clone_impls_CloneU64_clone (x : u64) : u64 = x -let core_clone_impls_CloneU128_clone (x : u128) : u128 = x - -let core_clone_impls_CloneIsize_clone (x : isize) : isize = x -let core_clone_impls_CloneI8_clone (x : i8) : i8 = x -let core_clone_impls_CloneI16_clone (x : i16) : i16 = x -let core_clone_impls_CloneI32_clone (x : i32) : i32 = x -let core_clone_impls_CloneI64_clone (x : i64) : i64 = x -let core_clone_impls_CloneI128_clone (x : i128) : i128 = x - -let core_clone_CloneUsize : core_clone_Clone usize = { - clone = fun x -> Ok (core_clone_impls_CloneUsize_clone x) -} - -let core_clone_CloneU8 : core_clone_Clone u8 = { - clone = fun x -> Ok (core_clone_impls_CloneU8_clone x) -} - -let core_clone_CloneU16 : core_clone_Clone u16 = { - clone = fun x -> Ok (core_clone_impls_CloneU16_clone x) -} - -let core_clone_CloneU32 : core_clone_Clone u32 = { - clone = fun x -> Ok (core_clone_impls_CloneU32_clone x) -} - -let core_clone_CloneU64 : core_clone_Clone u64 = { - clone = fun x -> Ok (core_clone_impls_CloneU64_clone x) -} - -let core_clone_CloneU128 : core_clone_Clone u128 = { - clone = fun x -> Ok (core_clone_impls_CloneU128_clone x) -} - -let core_clone_CloneIsize : core_clone_Clone isize = { - clone = fun x -> Ok (core_clone_impls_CloneIsize_clone x) -} - -let core_clone_CloneI8 : core_clone_Clone i8 = { - clone = fun x -> Ok (core_clone_impls_CloneI8_clone x) -} - -let core_clone_CloneI16 : core_clone_Clone i16 = { - clone = fun x -> Ok (core_clone_impls_CloneI16_clone x) -} - -let core_clone_CloneI32 : core_clone_Clone i32 = { - clone = fun x -> Ok (core_clone_impls_CloneI32_clone x) -} - -let core_clone_CloneI64 : core_clone_Clone i64 = { - clone = fun x -> Ok (core_clone_impls_CloneI64_clone x) -} - -let core_clone_CloneI128 : core_clone_Clone i128 = { - clone = fun x -> Ok (core_clone_impls_CloneI128_clone x) -} - -(** [core::option::{core::option::Option<T>}::unwrap] *) -let core_option_Option_unwrap (t : Type0) (x : option t) : result t = - match x with - | None -> Fail Failure - | Some x -> Ok x - -(*** core::ops *) - -// Trait declaration: [core::ops::index::Index] -noeq type core_ops_index_Index (self idx : Type0) = { - output : Type0; - index : self → idx → result output -} - -// Trait declaration: [core::ops::index::IndexMut] -noeq type core_ops_index_IndexMut (self idx : Type0) = { - indexInst : core_ops_index_Index self idx; - index_mut : self → idx → result (indexInst.output & (indexInst.output → result self)); -} - -// Trait declaration [core::ops::deref::Deref] -noeq type core_ops_deref_Deref (self : Type0) = { - target : Type0; - deref : self → result target; -} - -// Trait declaration [core::ops::deref::DerefMut] -noeq type core_ops_deref_DerefMut (self : Type0) = { - derefInst : core_ops_deref_Deref self; - deref_mut : self → result (derefInst.target & (derefInst.target → result self)); -} - -type core_ops_range_Range (a : Type0) = { - start : a; - end_ : a; -} - -(*** [alloc] *) - -let alloc_boxed_Box_deref (t : Type0) (x : t) : result t = Ok x -let alloc_boxed_Box_deref_mut (t : Type0) (x : t) : result (t & (t -> result t)) = - Ok (x, (fun x -> Ok x)) - -// Trait instance -let alloc_boxed_Box_coreopsDerefInst (self : Type0) : core_ops_deref_Deref self = { - target = self; - deref = alloc_boxed_Box_deref self; -} - -// Trait instance -let alloc_boxed_Box_coreopsDerefMutInst (self : Type0) : core_ops_deref_DerefMut self = { - derefInst = alloc_boxed_Box_coreopsDerefInst self; - deref_mut = alloc_boxed_Box_deref_mut self; -} - -(*** Array *) -type array (a : Type0) (n : usize) = s:list a{length s = n} - -// We tried putting the normalize_term condition as a refinement on the list -// but it didn't work. It works with the requires clause. -let mk_array (a : Type0) (n : usize) - (l : list a) : - Pure (array a n) - (requires (normalize_term(FStar.List.Tot.length l) = n)) - (ensures (fun _ -> True)) = - normalize_term_spec (FStar.List.Tot.length l); - l - -let array_index_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : result a = - if i < length x then Ok (index x i) - else Fail Failure - -let array_update_usize (a : Type0) (n : usize) (x : array a n) (i : usize) (nx : a) : - result (array a n) = - if i < length x then Ok (list_update x i nx) - else Fail Failure - -let array_index_mut_usize (a : Type0) (n : usize) (x : array a n) (i : usize) : - result (a & (a -> result (array a n))) = - match array_index_usize a n x i with - | Fail e -> Fail e - | Ok v -> - Ok (v, array_update_usize a n x i) - -(*** Slice *) -type slice (a : Type0) = s:list a{length s <= usize_max} - -let slice_len (a : Type0) (s : slice a) : usize = length s - -let slice_index_usize (a : Type0) (x : slice a) (i : usize) : result a = - if i < length x then Ok (index x i) - else Fail Failure - -let slice_update_usize (a : Type0) (x : slice a) (i : usize) (nx : a) : result (slice a) = - if i < length x then Ok (list_update x i nx) - else Fail Failure - -let slice_index_mut_usize (a : Type0) (s : slice a) (i : usize) : - result (a & (a -> result (slice a))) = - match slice_index_usize a s i with - | Fail e -> Fail e - | Ok x -> - Ok (x, slice_update_usize a s i) - -(*** Subslices *) - -let array_to_slice (a : Type0) (n : usize) (x : array a n) : result (slice a) = Ok x -let array_from_slice (a : Type0) (n : usize) (x : array a n) (s : slice a) : result (array a n) = - if length s = n then Ok s - else Fail Failure - -let array_to_slice_mut (a : Type0) (n : usize) (x : array a n) : - result (slice a & (slice a -> result (array a n))) = - Ok (x, array_from_slice a n x) - -// TODO: finish the definitions below (there lacks [List.drop] and [List.take] in the standard library *) -let array_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) : result (slice a) = - admit() - -let array_update_subslice (a : Type0) (n : usize) (x : array a n) (r : core_ops_range_Range usize) (ns : slice a) : result (array a n) = - admit() - -let array_repeat (a : Type0) (n : usize) (x : a) : array a n = - admit() - -let slice_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) : result (slice a) = - admit() - -let slice_update_subslice (a : Type0) (x : slice a) (r : core_ops_range_Range usize) (ns : slice a) : result (slice a) = - admit() - -(*** Vector *) -type alloc_vec_Vec (a : Type0) = v:list a{length v <= usize_max} - -let alloc_vec_Vec_new (a : Type0) : alloc_vec_Vec a = assert_norm(length #a [] == 0); [] -let alloc_vec_Vec_len (a : Type0) (v : alloc_vec_Vec a) : usize = length v - -// Helper -let alloc_vec_Vec_index_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : result a = - if i < length v then Ok (index v i) else Fail Failure -// Helper -let alloc_vec_Vec_update_usize (#a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Ok (list_update v i x) else Fail Failure - -let alloc_vec_Vec_index_mut_usize (#a : Type0) (v: alloc_vec_Vec a) (i: usize) : - result (a & (a → result (alloc_vec_Vec a))) = - match alloc_vec_Vec_index_usize v i with - | Ok x -> - Ok (x, alloc_vec_Vec_update_usize v i) - | Fail e -> Fail e - -let alloc_vec_Vec_push (a : Type0) (v : alloc_vec_Vec a) (x : a) : - Pure (result (alloc_vec_Vec a)) - (requires True) - (ensures (fun res -> - match res with - | Fail e -> e == Failure - | Ok v' -> length v' = length v + 1)) = - if length v < usize_max then begin - (**) assert_norm(length [x] == 1); - (**) append_length v [x]; - (**) assert(length (append v [x]) = length v + 1); - Ok (append v [x]) - end - else Fail Failure - -let alloc_vec_Vec_insert (a : Type0) (v : alloc_vec_Vec a) (i : usize) (x : a) : result (alloc_vec_Vec a) = - if i < length v then Ok (list_update v i x) else Fail Failure - -// Trait declaration: [core::slice::index::private_slice_index::Sealed] -type core_slice_index_private_slice_index_Sealed (self : Type0) = unit - -// Trait declaration: [core::slice::index::SliceIndex] -noeq type core_slice_index_SliceIndex (self t : Type0) = { - sealedInst : core_slice_index_private_slice_index_Sealed self; - output : Type0; - get : self → t → result (option output); - get_mut : self → t → result (option output & (option output -> result t)); - get_unchecked : self → const_raw_ptr t → result (const_raw_ptr output); - get_unchecked_mut : self → mut_raw_ptr t → result (mut_raw_ptr output); - index : self → t → result output; - index_mut : self → t → result (output & (output -> result t)); -} - -// [core::slice::index::[T]::index]: forward function -let core_slice_index_Slice_index - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (s : slice t) (i : idx) : result inst.output = - let* x = inst.get i s in - match x with - | None -> Fail Failure - | Some x -> Ok x - -// [core::slice::index::Range:::get]: forward function -let core_slice_index_RangeUsize_get (t : Type0) (i : core_ops_range_Range usize) (s : slice t) : - result (option (slice t)) = - admit () // TODO - -// [core::slice::index::Range::get_mut]: forward function -let core_slice_index_RangeUsize_get_mut (t : Type0) : - core_ops_range_Range usize → slice t → result (option (slice t) & (option (slice t) -> result (slice t))) = - admit () // TODO - -// [core::slice::index::Range::get_unchecked]: forward function -let core_slice_index_RangeUsize_get_unchecked - (t : Type0) : - core_ops_range_Range usize → const_raw_ptr (slice t) → result (const_raw_ptr (slice t)) = - // Don't know what the model should be - for now we always fail to make - // sure code which uses it fails - fun _ _ -> Fail Failure - -// [core::slice::index::Range::get_unchecked_mut]: forward function -let core_slice_index_RangeUsize_get_unchecked_mut - (t : Type0) : - core_ops_range_Range usize → mut_raw_ptr (slice t) → result (mut_raw_ptr (slice t)) = - // Don't know what the model should be - for now we always fail to make - // sure code which uses it fails - fun _ _ -> Fail Failure - -// [core::slice::index::Range::index]: forward function -let core_slice_index_RangeUsize_index - (t : Type0) : core_ops_range_Range usize → slice t → result (slice t) = - admit () // TODO - -// [core::slice::index::Range::index_mut]: forward function -let core_slice_index_RangeUsize_index_mut (t : Type0) : - core_ops_range_Range usize → slice t → result (slice t & (slice t -> result (slice t))) = - admit () // TODO - -// [core::slice::index::[T]::index_mut]: forward function -let core_slice_index_Slice_index_mut - (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) : - slice t → idx → result (inst.output & (inst.output -> result (slice t))) = - admit () // - -// [core::array::[T; N]::index]: forward function -let core_array_Array_index - (t idx : Type0) (n : usize) (inst : core_ops_index_Index (slice t) idx) - (a : array t n) (i : idx) : result inst.output = - admit () // TODO - -// [core::array::[T; N]::index_mut]: forward function -let core_array_Array_index_mut - (t idx : Type0) (n : usize) (inst : core_ops_index_IndexMut (slice t) idx) - (a : array t n) (i : idx) : - result (inst.indexInst.output & (inst.indexInst.output -> result (array t n))) = - admit () // TODO - -// Trait implementation: [core::slice::index::private_slice_index::Range] -let core_slice_index_private_slice_index_SealedRangeUsizeInst - : core_slice_index_private_slice_index_Sealed (core_ops_range_Range usize) = () - -// Trait implementation: [core::slice::index::Range] -let core_slice_index_SliceIndexRangeUsizeSliceTInst (t : Type0) : - core_slice_index_SliceIndex (core_ops_range_Range usize) (slice t) = { - sealedInst = core_slice_index_private_slice_index_SealedRangeUsizeInst; - output = slice t; - get = core_slice_index_RangeUsize_get t; - get_mut = core_slice_index_RangeUsize_get_mut t; - get_unchecked = core_slice_index_RangeUsize_get_unchecked t; - get_unchecked_mut = core_slice_index_RangeUsize_get_unchecked_mut t; - index = core_slice_index_RangeUsize_index t; - index_mut = core_slice_index_RangeUsize_index_mut t; -} - -// Trait implementation: [core::slice::index::[T]] -let core_ops_index_IndexSliceTIInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_Index (slice t) idx = { - output = inst.output; - index = core_slice_index_Slice_index t idx inst; -} - -// Trait implementation: [core::slice::index::[T]] -let core_ops_index_IndexMutSliceTIInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_IndexMut (slice t) idx = { - indexInst = core_ops_index_IndexSliceTIInst t idx inst; - index_mut = core_slice_index_Slice_index_mut t idx inst; -} - -// Trait implementation: [core::array::[T; N]] -let core_ops_index_IndexArrayInst (t idx : Type0) (n : usize) - (inst : core_ops_index_Index (slice t) idx) : - core_ops_index_Index (array t n) idx = { - output = inst.output; - index = core_array_Array_index t idx n inst; -} - -// Trait implementation: [core::array::[T; N]] -let core_ops_index_IndexMutArrayIInst (t idx : Type0) (n : usize) - (inst : core_ops_index_IndexMut (slice t) idx) : - core_ops_index_IndexMut (array t n) idx = { - indexInst = core_ops_index_IndexArrayInst t idx n inst.indexInst; - index_mut = core_array_Array_index_mut t idx n inst; -} - -// [core::slice::index::usize::get]: forward function -let core_slice_index_usize_get - (t : Type0) : usize → slice t → result (option t) = - admit () // TODO - -// [core::slice::index::usize::get_mut]: forward function -let core_slice_index_usize_get_mut (t : Type0) : - usize → slice t → result (option t & (option t -> result (slice t))) = - admit () // TODO - -// [core::slice::index::usize::get_unchecked]: forward function -let core_slice_index_usize_get_unchecked - (t : Type0) : usize → const_raw_ptr (slice t) → result (const_raw_ptr t) = - admit () // TODO - -// [core::slice::index::usize::get_unchecked_mut]: forward function -let core_slice_index_usize_get_unchecked_mut - (t : Type0) : usize → mut_raw_ptr (slice t) → result (mut_raw_ptr t) = - admit () // TODO - -// [core::slice::index::usize::index]: forward function -let core_slice_index_usize_index (t : Type0) : usize → slice t → result t = - admit () // TODO - -// [core::slice::index::usize::index_mut]: forward function -let core_slice_index_usize_index_mut (t : Type0) : - usize → slice t → result (t & (t -> result (slice t))) = - admit () // TODO - -// Trait implementation: [core::slice::index::private_slice_index::usize] -let core_slice_index_private_slice_index_SealedUsizeInst - : core_slice_index_private_slice_index_Sealed usize = () - -// Trait implementation: [core::slice::index::usize] -let core_slice_index_SliceIndexUsizeSliceTInst (t : Type0) : - core_slice_index_SliceIndex usize (slice t) = { - sealedInst = core_slice_index_private_slice_index_SealedUsizeInst; - output = t; - get = core_slice_index_usize_get t; - get_mut = core_slice_index_usize_get_mut t; - get_unchecked = core_slice_index_usize_get_unchecked t; - get_unchecked_mut = core_slice_index_usize_get_unchecked_mut t; - index = core_slice_index_usize_index t; - index_mut = core_slice_index_usize_index_mut t; -} - -// [alloc::vec::Vec::index]: forward function -let alloc_vec_Vec_index (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : result inst.output = - admit () // TODO - -// [alloc::vec::Vec::index_mut]: forward function -let alloc_vec_Vec_index_mut (t idx : Type0) (inst : core_slice_index_SliceIndex idx (slice t)) - (self : alloc_vec_Vec t) (i : idx) : - result (inst.output & (inst.output -> result (alloc_vec_Vec t))) = - admit () // TODO - -// Trait implementation: [alloc::vec::Vec] -let alloc_vec_Vec_coreopsindexIndexInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_Index (alloc_vec_Vec t) idx = { - output = inst.output; - index = alloc_vec_Vec_index t idx inst; -} - -// Trait implementation: [alloc::vec::Vec] -let alloc_vec_Vec_coreopsindexIndexMutInst (t idx : Type0) - (inst : core_slice_index_SliceIndex idx (slice t)) : - core_ops_index_IndexMut (alloc_vec_Vec t) idx = { - indexInst = alloc_vec_Vec_coreopsindexIndexInst t idx inst; - index_mut = alloc_vec_Vec_index_mut t idx inst; -} - -(*** Theorems *) - -let alloc_vec_Vec_index_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : - Lemma ( - alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_usize v i) - [SMTPat (alloc_vec_Vec_index a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] - = - admit() - -let alloc_vec_Vec_index_mut_eq (#a : Type0) (v : alloc_vec_Vec a) (i : usize) : - Lemma ( - alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i == - alloc_vec_Vec_index_mut_usize v i) - [SMTPat (alloc_vec_Vec_index_mut a usize (core_slice_index_SliceIndexUsizeSliceTInst a) v i)] - = - admit() diff --git a/tests/fstar/demo/Demo.fst b/tests/fstar/demo/Demo.fst index b210662f..60722f46 100644 --- a/tests/fstar/demo/Demo.fst +++ b/tests/fstar/demo/Demo.fst @@ -6,7 +6,7 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [demo::choose]: - Source: 'src/demo.rs', lines 5:0-5:70 *) + Source: 'tests/src/demo.rs', lines 6:0-6:70 *) let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b @@ -14,33 +14,33 @@ let choose else let back = fun ret -> Ok (x, ret) in Ok (y, back) (** [demo::mul2_add1]: - Source: 'src/demo.rs', lines 13:0-13:31 *) + Source: 'tests/src/demo.rs', lines 14:0-14:31 *) let mul2_add1 (x : u32) : result u32 = let* i = u32_add x x in u32_add i 1 (** [demo::use_mul2_add1]: - Source: 'src/demo.rs', lines 17:0-17:43 *) + Source: 'tests/src/demo.rs', lines 18:0-18:43 *) let use_mul2_add1 (x : u32) (y : u32) : result u32 = let* i = mul2_add1 x in u32_add i y (** [demo::incr]: - Source: 'src/demo.rs', lines 21:0-21:31 *) + Source: 'tests/src/demo.rs', lines 22:0-22:31 *) let incr (x : u32) : result u32 = u32_add x 1 (** [demo::use_incr]: - Source: 'src/demo.rs', lines 25:0-25:17 *) + Source: 'tests/src/demo.rs', lines 26:0-26:17 *) let use_incr : result unit = let* x = incr 0 in let* x1 = incr x in let* _ = incr x1 in Ok () (** [demo::CList] - Source: 'src/demo.rs', lines 34:0-34:17 *) + Source: 'tests/src/demo.rs', lines 35:0-35:17 *) type cList_t (t : Type0) = | CList_CCons : t -> cList_t t -> cList_t t | CList_CNil : cList_t t (** [demo::list_nth]: - Source: 'src/demo.rs', lines 39:0-39:56 *) + Source: 'tests/src/demo.rs', lines 40:0-40:56 *) let rec list_nth (t : Type0) (n : nat) (l : cList_t t) (i : u32) : result t = if is_zero n then Fail OutOfFuel @@ -53,7 +53,7 @@ let rec list_nth (t : Type0) (n : nat) (l : cList_t t) (i : u32) : result t = end (** [demo::list_nth_mut]: - Source: 'src/demo.rs', lines 54:0-54:68 *) + Source: 'tests/src/demo.rs', lines 55:0-55:68 *) let rec list_nth_mut (t : Type0) (n : nat) (l : cList_t t) (i : u32) : result (t & (t -> result (cList_t t))) @@ -77,7 +77,7 @@ let rec list_nth_mut end (** [demo::list_nth_mut1]: loop 0: - Source: 'src/demo.rs', lines 69:0-78:1 *) + Source: 'tests/src/demo.rs', lines 70:0-79:1 *) let rec list_nth_mut1_loop (t : Type0) (n : nat) (l : cList_t t) (i : u32) : result (t & (t -> result (cList_t t))) @@ -99,7 +99,7 @@ let rec list_nth_mut1_loop end (** [demo::list_nth_mut1]: - Source: 'src/demo.rs', lines 69:0-69:77 *) + Source: 'tests/src/demo.rs', lines 70:0-70:77 *) let list_nth_mut1 (t : Type0) (n : nat) (l : cList_t t) (i : u32) : result (t & (t -> result (cList_t t))) @@ -107,7 +107,7 @@ let list_nth_mut1 list_nth_mut1_loop t n l i (** [demo::i32_id]: - Source: 'src/demo.rs', lines 80:0-80:28 *) + Source: 'tests/src/demo.rs', lines 81:0-81:28 *) let rec i32_id (n : nat) (i : i32) : result i32 = if is_zero n then Fail OutOfFuel @@ -118,7 +118,7 @@ let rec i32_id (n : nat) (i : i32) : result i32 = else let* i1 = i32_sub i 1 in let* i2 = i32_id n1 i1 in i32_add i2 1 (** [demo::list_tail]: - Source: 'src/demo.rs', lines 88:0-88:64 *) + Source: 'tests/src/demo.rs', lines 89:0-89:64 *) let rec list_tail (t : Type0) (n : nat) (l : cList_t t) : result ((cList_t t) & (cList_t t -> result (cList_t t))) @@ -137,20 +137,20 @@ let rec list_tail end (** Trait declaration: [demo::Counter] - Source: 'src/demo.rs', lines 97:0-97:17 *) + Source: 'tests/src/demo.rs', lines 98:0-98:17 *) noeq type counter_t (self : Type0) = { incr : self -> result (usize & self); } (** [demo::{(demo::Counter for usize)}::incr]: - Source: 'src/demo.rs', lines 102:4-102:31 *) + Source: 'tests/src/demo.rs', lines 103:4-103:31 *) let counterUsize_incr (self : usize) : result (usize & usize) = let* self1 = usize_add self 1 in Ok (self, self1) (** Trait implementation: [demo::{(demo::Counter for usize)}] - Source: 'src/demo.rs', lines 101:0-101:22 *) + Source: 'tests/src/demo.rs', lines 102:0-102:22 *) let counterUsize : counter_t usize = { incr = counterUsize_incr; } (** [demo::use_counter]: - Source: 'src/demo.rs', lines 109:0-109:59 *) + Source: 'tests/src/demo.rs', lines 110:0-110:59 *) let use_counter (t : Type0) (counterInst : counter_t t) (cnt : t) : result (usize & t) = counterInst.incr cnt diff --git a/tests/fstar/hashmap/Hashmap.Clauses.Template.fst b/tests/fstar/hashmap/Hashmap.Clauses.Template.fst index 2733b371..3119ded8 100644 --- a/tests/fstar/hashmap/Hashmap.Clauses.Template.fst +++ b/tests/fstar/hashmap/Hashmap.Clauses.Template.fst @@ -7,63 +7,63 @@ open Hashmap.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [hashmap::{hashmap::HashMap<T>}::allocate_slots]: decreases clause - Source: 'src/hashmap.rs', lines 50:4-56:5 *) + Source: 'tests/src/hashmap.rs', lines 58:4-64:5 *) unfold let hashMap_allocate_slots_loop_decreases (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : nat = admit () (** [hashmap::{hashmap::HashMap<T>}::clear]: decreases clause - Source: 'src/hashmap.rs', lines 80:4-88:5 *) + Source: 'tests/src/hashmap.rs', lines 88:4-96:5 *) unfold let hashMap_clear_loop_decreases (t : Type0) (slots : alloc_vec_Vec (list_t t)) (i : usize) : nat = admit () (** [hashmap::{hashmap::HashMap<T>}::insert_in_list]: decreases clause - Source: 'src/hashmap.rs', lines 97:4-114:5 *) + Source: 'tests/src/hashmap.rs', lines 105:4-122:5 *) unfold let hashMap_insert_in_list_loop_decreases (t : Type0) (key : usize) (value : t) (ls : list_t t) : nat = admit () (** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: decreases clause - Source: 'src/hashmap.rs', lines 183:4-196:5 *) + Source: 'tests/src/hashmap.rs', lines 191:4-204:5 *) unfold let hashMap_move_elements_from_list_loop_decreases (t : Type0) (ntable : hashMap_t t) (ls : list_t t) : nat = admit () (** [hashmap::{hashmap::HashMap<T>}::move_elements]: decreases clause - Source: 'src/hashmap.rs', lines 171:4-180:5 *) + Source: 'tests/src/hashmap.rs', lines 179:4-188:5 *) unfold let hashMap_move_elements_loop_decreases (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) (i : usize) : nat = admit () (** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: decreases clause - Source: 'src/hashmap.rs', lines 206:4-219:5 *) + Source: 'tests/src/hashmap.rs', lines 214:4-227:5 *) unfold let hashMap_contains_key_in_list_loop_decreases (t : Type0) (key : usize) (ls : list_t t) : nat = admit () (** [hashmap::{hashmap::HashMap<T>}::get_in_list]: decreases clause - Source: 'src/hashmap.rs', lines 224:4-237:5 *) + Source: 'tests/src/hashmap.rs', lines 232:4-245:5 *) unfold let hashMap_get_in_list_loop_decreases (t : Type0) (key : usize) (ls : list_t t) : nat = admit () (** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: decreases clause - Source: 'src/hashmap.rs', lines 245:4-254:5 *) + Source: 'tests/src/hashmap.rs', lines 253:4-262:5 *) unfold let hashMap_get_mut_in_list_loop_decreases (t : Type0) (ls : list_t t) (key : usize) : nat = admit () (** [hashmap::{hashmap::HashMap<T>}::remove_from_list]: decreases clause - Source: 'src/hashmap.rs', lines 265:4-291:5 *) + Source: 'tests/src/hashmap.rs', lines 273:4-299:5 *) unfold let hashMap_remove_from_list_loop_decreases (t : Type0) (key : usize) (ls : list_t t) : nat = diff --git a/tests/fstar/hashmap/Hashmap.Funs.fst b/tests/fstar/hashmap/Hashmap.Funs.fst index 2be587af..06cdf7f3 100644 --- a/tests/fstar/hashmap/Hashmap.Funs.fst +++ b/tests/fstar/hashmap/Hashmap.Funs.fst @@ -8,12 +8,12 @@ include Hashmap.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [hashmap::hash_key]: - Source: 'src/hashmap.rs', lines 27:0-27:32 *) + Source: 'tests/src/hashmap.rs', lines 35:0-35:32 *) let hash_key (k : usize) : result usize = Ok k (** [hashmap::{hashmap::HashMap<T>}::allocate_slots]: loop 0: - Source: 'src/hashmap.rs', lines 50:4-56:5 *) + Source: 'tests/src/hashmap.rs', lines 58:4-64:5 *) let rec hashMap_allocate_slots_loop (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : Tot (result (alloc_vec_Vec (list_t t))) @@ -27,7 +27,7 @@ let rec hashMap_allocate_slots_loop else Ok slots (** [hashmap::{hashmap::HashMap<T>}::allocate_slots]: - Source: 'src/hashmap.rs', lines 50:4-50:76 *) + Source: 'tests/src/hashmap.rs', lines 58:4-58:76 *) let hashMap_allocate_slots (t : Type0) (slots : alloc_vec_Vec (list_t t)) (n : usize) : result (alloc_vec_Vec (list_t t)) @@ -35,7 +35,7 @@ let hashMap_allocate_slots hashMap_allocate_slots_loop t slots n (** [hashmap::{hashmap::HashMap<T>}::new_with_capacity]: - Source: 'src/hashmap.rs', lines 59:4-63:13 *) + Source: 'tests/src/hashmap.rs', lines 67:4-71:13 *) let hashMap_new_with_capacity (t : Type0) (capacity : usize) (max_load_dividend : usize) (max_load_divisor : usize) : @@ -54,12 +54,12 @@ let hashMap_new_with_capacity } (** [hashmap::{hashmap::HashMap<T>}::new]: - Source: 'src/hashmap.rs', lines 75:4-75:24 *) + Source: 'tests/src/hashmap.rs', lines 83:4-83:24 *) let hashMap_new (t : Type0) : result (hashMap_t t) = hashMap_new_with_capacity t 32 4 5 (** [hashmap::{hashmap::HashMap<T>}::clear]: loop 0: - Source: 'src/hashmap.rs', lines 80:4-88:5 *) + Source: 'tests/src/hashmap.rs', lines 88:4-96:5 *) let rec hashMap_clear_loop (t : Type0) (slots : alloc_vec_Vec (list_t t)) (i : usize) : Tot (result (alloc_vec_Vec (list_t t))) @@ -77,18 +77,18 @@ let rec hashMap_clear_loop else Ok slots (** [hashmap::{hashmap::HashMap<T>}::clear]: - Source: 'src/hashmap.rs', lines 80:4-80:27 *) + Source: 'tests/src/hashmap.rs', lines 88:4-88:27 *) let hashMap_clear (t : Type0) (self : hashMap_t t) : result (hashMap_t t) = let* hm = hashMap_clear_loop t self.slots 0 in Ok { self with num_entries = 0; slots = hm } (** [hashmap::{hashmap::HashMap<T>}::len]: - Source: 'src/hashmap.rs', lines 90:4-90:30 *) + Source: 'tests/src/hashmap.rs', lines 98:4-98:30 *) let hashMap_len (t : Type0) (self : hashMap_t t) : result usize = Ok self.num_entries (** [hashmap::{hashmap::HashMap<T>}::insert_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 97:4-114:5 *) + Source: 'tests/src/hashmap.rs', lines 105:4-122:5 *) let rec hashMap_insert_in_list_loop (t : Type0) (key : usize) (value : t) (ls : list_t t) : Tot (result (bool & (list_t t))) @@ -105,7 +105,7 @@ let rec hashMap_insert_in_list_loop end (** [hashmap::{hashmap::HashMap<T>}::insert_in_list]: - Source: 'src/hashmap.rs', lines 97:4-97:71 *) + Source: 'tests/src/hashmap.rs', lines 105:4-105:71 *) let hashMap_insert_in_list (t : Type0) (key : usize) (value : t) (ls : list_t t) : result (bool & (list_t t)) @@ -113,7 +113,7 @@ let hashMap_insert_in_list hashMap_insert_in_list_loop t key value ls (** [hashmap::{hashmap::HashMap<T>}::insert_no_resize]: - Source: 'src/hashmap.rs', lines 117:4-117:54 *) + Source: 'tests/src/hashmap.rs', lines 125:4-125:54 *) let hashMap_insert_no_resize (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : result (hashMap_t t) @@ -134,7 +134,7 @@ let hashMap_insert_no_resize else let* v = index_mut_back l1 in Ok { self with slots = v } (** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 183:4-196:5 *) + Source: 'tests/src/hashmap.rs', lines 191:4-204:5 *) let rec hashMap_move_elements_from_list_loop (t : Type0) (ntable : hashMap_t t) (ls : list_t t) : Tot (result (hashMap_t t)) @@ -148,13 +148,13 @@ let rec hashMap_move_elements_from_list_loop end (** [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: - Source: 'src/hashmap.rs', lines 183:4-183:72 *) + Source: 'tests/src/hashmap.rs', lines 191:4-191:72 *) let hashMap_move_elements_from_list (t : Type0) (ntable : hashMap_t t) (ls : list_t t) : result (hashMap_t t) = hashMap_move_elements_from_list_loop t ntable ls (** [hashmap::{hashmap::HashMap<T>}::move_elements]: loop 0: - Source: 'src/hashmap.rs', lines 171:4-180:5 *) + Source: 'tests/src/hashmap.rs', lines 179:4-188:5 *) let rec hashMap_move_elements_loop (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) (i : usize) : @@ -175,7 +175,7 @@ let rec hashMap_move_elements_loop else Ok (ntable, slots) (** [hashmap::{hashmap::HashMap<T>}::move_elements]: - Source: 'src/hashmap.rs', lines 171:4-171:95 *) + Source: 'tests/src/hashmap.rs', lines 179:4-179:95 *) let hashMap_move_elements (t : Type0) (ntable : hashMap_t t) (slots : alloc_vec_Vec (list_t t)) (i : usize) : @@ -184,7 +184,7 @@ let hashMap_move_elements hashMap_move_elements_loop t ntable slots i (** [hashmap::{hashmap::HashMap<T>}::try_resize]: - Source: 'src/hashmap.rs', lines 140:4-140:28 *) + Source: 'tests/src/hashmap.rs', lines 148:4-148:28 *) let hashMap_try_resize (t : Type0) (self : hashMap_t t) : result (hashMap_t t) = let* max_usize = scalar_cast U32 Usize core_u32_max in @@ -204,7 +204,7 @@ let hashMap_try_resize else Ok { self with max_load_factor = (i, i1) } (** [hashmap::{hashmap::HashMap<T>}::insert]: - Source: 'src/hashmap.rs', lines 129:4-129:48 *) + Source: 'tests/src/hashmap.rs', lines 137:4-137:48 *) let hashMap_insert (t : Type0) (self : hashMap_t t) (key : usize) (value : t) : result (hashMap_t t) @@ -214,7 +214,7 @@ let hashMap_insert if i > self1.max_load then hashMap_try_resize t self1 else Ok self1 (** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 206:4-219:5 *) + Source: 'tests/src/hashmap.rs', lines 214:4-227:5 *) let rec hashMap_contains_key_in_list_loop (t : Type0) (key : usize) (ls : list_t t) : Tot (result bool) @@ -227,13 +227,13 @@ let rec hashMap_contains_key_in_list_loop end (** [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: - Source: 'src/hashmap.rs', lines 206:4-206:68 *) + Source: 'tests/src/hashmap.rs', lines 214:4-214:68 *) let hashMap_contains_key_in_list (t : Type0) (key : usize) (ls : list_t t) : result bool = hashMap_contains_key_in_list_loop t key ls (** [hashmap::{hashmap::HashMap<T>}::contains_key]: - Source: 'src/hashmap.rs', lines 199:4-199:49 *) + Source: 'tests/src/hashmap.rs', lines 207:4-207:49 *) let hashMap_contains_key (t : Type0) (self : hashMap_t t) (key : usize) : result bool = let* hash = hash_key key in @@ -246,7 +246,7 @@ let hashMap_contains_key hashMap_contains_key_in_list t key l (** [hashmap::{hashmap::HashMap<T>}::get_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 224:4-237:5 *) + Source: 'tests/src/hashmap.rs', lines 232:4-245:5 *) let rec hashMap_get_in_list_loop (t : Type0) (key : usize) (ls : list_t t) : Tot (result t) (decreases (hashMap_get_in_list_loop_decreases t key ls)) @@ -258,12 +258,12 @@ let rec hashMap_get_in_list_loop end (** [hashmap::{hashmap::HashMap<T>}::get_in_list]: - Source: 'src/hashmap.rs', lines 224:4-224:70 *) + Source: 'tests/src/hashmap.rs', lines 232:4-232:70 *) let hashMap_get_in_list (t : Type0) (key : usize) (ls : list_t t) : result t = hashMap_get_in_list_loop t key ls (** [hashmap::{hashmap::HashMap<T>}::get]: - Source: 'src/hashmap.rs', lines 239:4-239:55 *) + Source: 'tests/src/hashmap.rs', lines 247:4-247:55 *) let hashMap_get (t : Type0) (self : hashMap_t t) (key : usize) : result t = let* hash = hash_key key in let i = alloc_vec_Vec_len (list_t t) self.slots in @@ -275,7 +275,7 @@ let hashMap_get (t : Type0) (self : hashMap_t t) (key : usize) : result t = hashMap_get_in_list t key l (** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 245:4-254:5 *) + Source: 'tests/src/hashmap.rs', lines 253:4-262:5 *) let rec hashMap_get_mut_in_list_loop (t : Type0) (ls : list_t t) (key : usize) : Tot (result (t & (t -> result (list_t t)))) @@ -294,7 +294,7 @@ let rec hashMap_get_mut_in_list_loop end (** [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: - Source: 'src/hashmap.rs', lines 245:4-245:86 *) + Source: 'tests/src/hashmap.rs', lines 253:4-253:86 *) let hashMap_get_mut_in_list (t : Type0) (ls : list_t t) (key : usize) : result (t & (t -> result (list_t t))) @@ -302,7 +302,7 @@ let hashMap_get_mut_in_list hashMap_get_mut_in_list_loop t ls key (** [hashmap::{hashmap::HashMap<T>}::get_mut]: - Source: 'src/hashmap.rs', lines 257:4-257:67 *) + Source: 'tests/src/hashmap.rs', lines 265:4-265:67 *) let hashMap_get_mut (t : Type0) (self : hashMap_t t) (key : usize) : result (t & (t -> result (hashMap_t t))) @@ -323,7 +323,7 @@ let hashMap_get_mut Ok (x, back) (** [hashmap::{hashmap::HashMap<T>}::remove_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 265:4-291:5 *) + Source: 'tests/src/hashmap.rs', lines 273:4-299:5 *) let rec hashMap_remove_from_list_loop (t : Type0) (key : usize) (ls : list_t t) : Tot (result ((option t) & (list_t t))) @@ -346,7 +346,7 @@ let rec hashMap_remove_from_list_loop end (** [hashmap::{hashmap::HashMap<T>}::remove_from_list]: - Source: 'src/hashmap.rs', lines 265:4-265:69 *) + Source: 'tests/src/hashmap.rs', lines 273:4-273:69 *) let hashMap_remove_from_list (t : Type0) (key : usize) (ls : list_t t) : result ((option t) & (list_t t)) @@ -354,7 +354,7 @@ let hashMap_remove_from_list hashMap_remove_from_list_loop t key ls (** [hashmap::{hashmap::HashMap<T>}::remove]: - Source: 'src/hashmap.rs', lines 294:4-294:52 *) + Source: 'tests/src/hashmap.rs', lines 302:4-302:52 *) let hashMap_remove (t : Type0) (self : hashMap_t t) (key : usize) : result ((option t) & (hashMap_t t)) @@ -376,7 +376,7 @@ let hashMap_remove end (** [hashmap::test1]: - Source: 'src/hashmap.rs', lines 315:0-315:10 *) + Source: 'tests/src/hashmap.rs', lines 323:0-323:10 *) let test1 : result unit = let* hm = hashMap_new u64 in let* hm1 = hashMap_insert u64 hm 0 42 in diff --git a/tests/fstar/hashmap/Hashmap.Types.fst b/tests/fstar/hashmap/Hashmap.Types.fst index ef96b1e9..962fbee2 100644 --- a/tests/fstar/hashmap/Hashmap.Types.fst +++ b/tests/fstar/hashmap/Hashmap.Types.fst @@ -6,13 +6,13 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [hashmap::List] - Source: 'src/hashmap.rs', lines 19:0-19:16 *) + Source: 'tests/src/hashmap.rs', lines 27:0-27:16 *) type list_t (t : Type0) = | List_Cons : usize -> t -> list_t t -> list_t t | List_Nil : list_t t (** [hashmap::HashMap] - Source: 'src/hashmap.rs', lines 35:0-35:21 *) + Source: 'tests/src/hashmap.rs', lines 43:0-43:21 *) type hashMap_t (t : Type0) = { num_entries : usize; diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Clauses.Template.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Clauses.Template.fst index 7b274f59..cdd73210 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Clauses.Template.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Clauses.Template.fst @@ -7,35 +7,35 @@ open HashmapMain.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::allocate_slots]: decreases clause - Source: 'src/hashmap.rs', lines 50:4-56:5 *) + Source: 'tests/src/hashmap.rs', lines 58:4-64:5 *) unfold let hashmap_HashMap_allocate_slots_loop_decreases (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : nat = admit () (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: decreases clause - Source: 'src/hashmap.rs', lines 80:4-88:5 *) + Source: 'tests/src/hashmap.rs', lines 88:4-96:5 *) unfold let hashmap_HashMap_clear_loop_decreases (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : nat = admit () (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: decreases clause - Source: 'src/hashmap.rs', lines 97:4-114:5 *) + Source: 'tests/src/hashmap.rs', lines 105:4-122:5 *) unfold let hashmap_HashMap_insert_in_list_loop_decreases (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : nat = admit () (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: decreases clause - Source: 'src/hashmap.rs', lines 183:4-196:5 *) + Source: 'tests/src/hashmap.rs', lines 191:4-204:5 *) unfold let hashmap_HashMap_move_elements_from_list_loop_decreases (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : nat = admit () (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: decreases clause - Source: 'src/hashmap.rs', lines 171:4-180:5 *) + Source: 'tests/src/hashmap.rs', lines 179:4-188:5 *) unfold let hashmap_HashMap_move_elements_loop_decreases (t : Type0) (ntable : hashmap_HashMap_t t) (slots : alloc_vec_Vec (hashmap_List_t t)) @@ -43,28 +43,28 @@ let hashmap_HashMap_move_elements_loop_decreases (t : Type0) admit () (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: decreases clause - Source: 'src/hashmap.rs', lines 206:4-219:5 *) + Source: 'tests/src/hashmap.rs', lines 214:4-227:5 *) unfold let hashmap_HashMap_contains_key_in_list_loop_decreases (t : Type0) (key : usize) (ls : hashmap_List_t t) : nat = admit () (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: decreases clause - Source: 'src/hashmap.rs', lines 224:4-237:5 *) + Source: 'tests/src/hashmap.rs', lines 232:4-245:5 *) unfold let hashmap_HashMap_get_in_list_loop_decreases (t : Type0) (key : usize) (ls : hashmap_List_t t) : nat = admit () (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: decreases clause - Source: 'src/hashmap.rs', lines 245:4-254:5 *) + Source: 'tests/src/hashmap.rs', lines 253:4-262:5 *) unfold let hashmap_HashMap_get_mut_in_list_loop_decreases (t : Type0) (ls : hashmap_List_t t) (key : usize) : nat = admit () (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: decreases clause - Source: 'src/hashmap.rs', lines 265:4-291:5 *) + Source: 'tests/src/hashmap.rs', lines 273:4-299:5 *) unfold let hashmap_HashMap_remove_from_list_loop_decreases (t : Type0) (key : usize) (ls : hashmap_List_t t) : nat = diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst index ff86e087..c88a746e 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Funs.fst @@ -9,12 +9,12 @@ include HashmapMain.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [hashmap_main::hashmap::hash_key]: - Source: 'src/hashmap.rs', lines 27:0-27:32 *) + Source: 'tests/src/hashmap.rs', lines 35:0-35:32 *) let hashmap_hash_key (k : usize) : result usize = Ok k (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::allocate_slots]: loop 0: - Source: 'src/hashmap.rs', lines 50:4-56:5 *) + Source: 'tests/src/hashmap.rs', lines 58:4-64:5 *) let rec hashmap_HashMap_allocate_slots_loop (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : Tot (result (alloc_vec_Vec (hashmap_List_t t))) @@ -29,7 +29,7 @@ let rec hashmap_HashMap_allocate_slots_loop else Ok slots (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::allocate_slots]: - Source: 'src/hashmap.rs', lines 50:4-50:76 *) + Source: 'tests/src/hashmap.rs', lines 58:4-58:76 *) let hashmap_HashMap_allocate_slots (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (n : usize) : result (alloc_vec_Vec (hashmap_List_t t)) @@ -37,7 +37,7 @@ let hashmap_HashMap_allocate_slots hashmap_HashMap_allocate_slots_loop t slots n (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::new_with_capacity]: - Source: 'src/hashmap.rs', lines 59:4-63:13 *) + Source: 'tests/src/hashmap.rs', lines 67:4-71:13 *) let hashmap_HashMap_new_with_capacity (t : Type0) (capacity : usize) (max_load_dividend : usize) (max_load_divisor : usize) : @@ -57,12 +57,12 @@ let hashmap_HashMap_new_with_capacity } (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::new]: - Source: 'src/hashmap.rs', lines 75:4-75:24 *) + Source: 'tests/src/hashmap.rs', lines 83:4-83:24 *) let hashmap_HashMap_new (t : Type0) : result (hashmap_HashMap_t t) = hashmap_HashMap_new_with_capacity t 32 4 5 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: loop 0: - Source: 'src/hashmap.rs', lines 80:4-88:5 *) + Source: 'tests/src/hashmap.rs', lines 88:4-96:5 *) let rec hashmap_HashMap_clear_loop (t : Type0) (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : Tot (result (alloc_vec_Vec (hashmap_List_t t))) @@ -81,20 +81,20 @@ let rec hashmap_HashMap_clear_loop else Ok slots (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: - Source: 'src/hashmap.rs', lines 80:4-80:27 *) + Source: 'tests/src/hashmap.rs', lines 88:4-88:27 *) let hashmap_HashMap_clear (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) = let* hm = hashmap_HashMap_clear_loop t self.slots 0 in Ok { self with num_entries = 0; slots = hm } (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::len]: - Source: 'src/hashmap.rs', lines 90:4-90:30 *) + Source: 'tests/src/hashmap.rs', lines 98:4-98:30 *) let hashmap_HashMap_len (t : Type0) (self : hashmap_HashMap_t t) : result usize = Ok self.num_entries (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 97:4-114:5 *) + Source: 'tests/src/hashmap.rs', lines 105:4-122:5 *) let rec hashmap_HashMap_insert_in_list_loop (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : Tot (result (bool & (hashmap_List_t t))) @@ -111,7 +111,7 @@ let rec hashmap_HashMap_insert_in_list_loop end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: - Source: 'src/hashmap.rs', lines 97:4-97:71 *) + Source: 'tests/src/hashmap.rs', lines 105:4-105:71 *) let hashmap_HashMap_insert_in_list (t : Type0) (key : usize) (value : t) (ls : hashmap_List_t t) : result (bool & (hashmap_List_t t)) @@ -119,7 +119,7 @@ let hashmap_HashMap_insert_in_list hashmap_HashMap_insert_in_list_loop t key value ls (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_no_resize]: - Source: 'src/hashmap.rs', lines 117:4-117:54 *) + Source: 'tests/src/hashmap.rs', lines 125:4-125:54 *) let hashmap_HashMap_insert_no_resize (t : Type0) (self : hashmap_HashMap_t t) (key : usize) (value : t) : result (hashmap_HashMap_t t) @@ -140,7 +140,7 @@ let hashmap_HashMap_insert_no_resize else let* v = index_mut_back l1 in Ok { self with slots = v } (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 183:4-196:5 *) + Source: 'tests/src/hashmap.rs', lines 191:4-204:5 *) let rec hashmap_HashMap_move_elements_from_list_loop (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : Tot (result (hashmap_HashMap_t t)) @@ -155,7 +155,7 @@ let rec hashmap_HashMap_move_elements_from_list_loop end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: - Source: 'src/hashmap.rs', lines 183:4-183:72 *) + Source: 'tests/src/hashmap.rs', lines 191:4-191:72 *) let hashmap_HashMap_move_elements_from_list (t : Type0) (ntable : hashmap_HashMap_t t) (ls : hashmap_List_t t) : result (hashmap_HashMap_t t) @@ -163,7 +163,7 @@ let hashmap_HashMap_move_elements_from_list hashmap_HashMap_move_elements_from_list_loop t ntable ls (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: loop 0: - Source: 'src/hashmap.rs', lines 171:4-180:5 *) + Source: 'tests/src/hashmap.rs', lines 179:4-188:5 *) let rec hashmap_HashMap_move_elements_loop (t : Type0) (ntable : hashmap_HashMap_t t) (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : @@ -185,7 +185,7 @@ let rec hashmap_HashMap_move_elements_loop else Ok (ntable, slots) (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: - Source: 'src/hashmap.rs', lines 171:4-171:95 *) + Source: 'tests/src/hashmap.rs', lines 179:4-179:95 *) let hashmap_HashMap_move_elements (t : Type0) (ntable : hashmap_HashMap_t t) (slots : alloc_vec_Vec (hashmap_List_t t)) (i : usize) : @@ -194,7 +194,7 @@ let hashmap_HashMap_move_elements hashmap_HashMap_move_elements_loop t ntable slots i (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::try_resize]: - Source: 'src/hashmap.rs', lines 140:4-140:28 *) + Source: 'tests/src/hashmap.rs', lines 148:4-148:28 *) let hashmap_HashMap_try_resize (t : Type0) (self : hashmap_HashMap_t t) : result (hashmap_HashMap_t t) = let* max_usize = scalar_cast U32 Usize core_u32_max in @@ -214,7 +214,7 @@ let hashmap_HashMap_try_resize else Ok { self with max_load_factor = (i, i1) } (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert]: - Source: 'src/hashmap.rs', lines 129:4-129:48 *) + Source: 'tests/src/hashmap.rs', lines 137:4-137:48 *) let hashmap_HashMap_insert (t : Type0) (self : hashmap_HashMap_t t) (key : usize) (value : t) : result (hashmap_HashMap_t t) @@ -224,7 +224,7 @@ let hashmap_HashMap_insert if i > self1.max_load then hashmap_HashMap_try_resize t self1 else Ok self1 (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 206:4-219:5 *) + Source: 'tests/src/hashmap.rs', lines 214:4-227:5 *) let rec hashmap_HashMap_contains_key_in_list_loop (t : Type0) (key : usize) (ls : hashmap_List_t t) : Tot (result bool) @@ -239,13 +239,13 @@ let rec hashmap_HashMap_contains_key_in_list_loop end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: - Source: 'src/hashmap.rs', lines 206:4-206:68 *) + Source: 'tests/src/hashmap.rs', lines 214:4-214:68 *) let hashmap_HashMap_contains_key_in_list (t : Type0) (key : usize) (ls : hashmap_List_t t) : result bool = hashmap_HashMap_contains_key_in_list_loop t key ls (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key]: - Source: 'src/hashmap.rs', lines 199:4-199:49 *) + Source: 'tests/src/hashmap.rs', lines 207:4-207:49 *) let hashmap_HashMap_contains_key (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result bool = let* hash = hashmap_hash_key key in @@ -258,7 +258,7 @@ let hashmap_HashMap_contains_key hashmap_HashMap_contains_key_in_list t key l (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 224:4-237:5 *) + Source: 'tests/src/hashmap.rs', lines 232:4-245:5 *) let rec hashmap_HashMap_get_in_list_loop (t : Type0) (key : usize) (ls : hashmap_List_t t) : Tot (result t) @@ -271,13 +271,13 @@ let rec hashmap_HashMap_get_in_list_loop end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: - Source: 'src/hashmap.rs', lines 224:4-224:70 *) + Source: 'tests/src/hashmap.rs', lines 232:4-232:70 *) let hashmap_HashMap_get_in_list (t : Type0) (key : usize) (ls : hashmap_List_t t) : result t = hashmap_HashMap_get_in_list_loop t key ls (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get]: - Source: 'src/hashmap.rs', lines 239:4-239:55 *) + Source: 'tests/src/hashmap.rs', lines 247:4-247:55 *) let hashmap_HashMap_get (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result t = let* hash = hashmap_hash_key key in @@ -290,7 +290,7 @@ let hashmap_HashMap_get hashmap_HashMap_get_in_list t key l (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 245:4-254:5 *) + Source: 'tests/src/hashmap.rs', lines 253:4-262:5 *) let rec hashmap_HashMap_get_mut_in_list_loop (t : Type0) (ls : hashmap_List_t t) (key : usize) : Tot (result (t & (t -> result (hashmap_List_t t)))) @@ -312,7 +312,7 @@ let rec hashmap_HashMap_get_mut_in_list_loop end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: - Source: 'src/hashmap.rs', lines 245:4-245:86 *) + Source: 'tests/src/hashmap.rs', lines 253:4-253:86 *) let hashmap_HashMap_get_mut_in_list (t : Type0) (ls : hashmap_List_t t) (key : usize) : result (t & (t -> result (hashmap_List_t t))) @@ -320,7 +320,7 @@ let hashmap_HashMap_get_mut_in_list hashmap_HashMap_get_mut_in_list_loop t ls key (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut]: - Source: 'src/hashmap.rs', lines 257:4-257:67 *) + Source: 'tests/src/hashmap.rs', lines 265:4-265:67 *) let hashmap_HashMap_get_mut (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result (t & (t -> result (hashmap_HashMap_t t))) @@ -341,7 +341,7 @@ let hashmap_HashMap_get_mut Ok (x, back) (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 265:4-291:5 *) + Source: 'tests/src/hashmap.rs', lines 273:4-299:5 *) let rec hashmap_HashMap_remove_from_list_loop (t : Type0) (key : usize) (ls : hashmap_List_t t) : Tot (result ((option t) & (hashmap_List_t t))) @@ -365,7 +365,7 @@ let rec hashmap_HashMap_remove_from_list_loop end (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: - Source: 'src/hashmap.rs', lines 265:4-265:69 *) + Source: 'tests/src/hashmap.rs', lines 273:4-273:69 *) let hashmap_HashMap_remove_from_list (t : Type0) (key : usize) (ls : hashmap_List_t t) : result ((option t) & (hashmap_List_t t)) @@ -373,7 +373,7 @@ let hashmap_HashMap_remove_from_list hashmap_HashMap_remove_from_list_loop t key ls (** [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove]: - Source: 'src/hashmap.rs', lines 294:4-294:52 *) + Source: 'tests/src/hashmap.rs', lines 302:4-302:52 *) let hashmap_HashMap_remove (t : Type0) (self : hashmap_HashMap_t t) (key : usize) : result ((option t) & (hashmap_HashMap_t t)) @@ -395,7 +395,7 @@ let hashmap_HashMap_remove end (** [hashmap_main::hashmap::test1]: - Source: 'src/hashmap.rs', lines 315:0-315:10 *) + Source: 'tests/src/hashmap.rs', lines 323:0-323:10 *) let hashmap_test1 : result unit = let* hm = hashmap_HashMap_new u64 in let* hm1 = hashmap_HashMap_insert u64 hm 0 42 in @@ -432,7 +432,7 @@ let hashmap_test1 : result unit = end (** [hashmap_main::insert_on_disk]: - Source: 'src/hashmap_main.rs', lines 7:0-7:43 *) + Source: 'tests/src/hashmap_main.rs', lines 13:0-13:43 *) let insert_on_disk (key : usize) (value : u64) (st : state) : result (state & unit) = let* (st1, hm) = hashmap_utils_deserialize st in @@ -440,7 +440,7 @@ let insert_on_disk hashmap_utils_serialize hm1 st1 (** [hashmap_main::main]: - Source: 'src/hashmap_main.rs', lines 16:0-16:13 *) + Source: 'tests/src/hashmap_main.rs', lines 22:0-22:13 *) let main : result unit = Ok () diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti b/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti index 50a6509f..cc20d988 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti +++ b/tests/fstar/hashmap_on_disk/HashmapMain.FunsExternal.fsti @@ -7,12 +7,12 @@ include HashmapMain.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [hashmap_main::hashmap_utils::deserialize]: - Source: 'src/hashmap_utils.rs', lines 10:0-10:43 *) + Source: 'tests/src/hashmap_utils.rs', lines 11:0-11:43 *) val hashmap_utils_deserialize : state -> result (state & (hashmap_HashMap_t u64)) (** [hashmap_main::hashmap_utils::serialize]: - Source: 'src/hashmap_utils.rs', lines 5:0-5:42 *) + Source: 'tests/src/hashmap_utils.rs', lines 6:0-6:42 *) val hashmap_utils_serialize : hashmap_HashMap_t u64 -> state -> result (state & unit) diff --git a/tests/fstar/hashmap_on_disk/HashmapMain.Types.fst b/tests/fstar/hashmap_on_disk/HashmapMain.Types.fst index afebcde3..85bcaeea 100644 --- a/tests/fstar/hashmap_on_disk/HashmapMain.Types.fst +++ b/tests/fstar/hashmap_on_disk/HashmapMain.Types.fst @@ -7,13 +7,13 @@ include HashmapMain.TypesExternal #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [hashmap_main::hashmap::List] - Source: 'src/hashmap.rs', lines 19:0-19:16 *) + Source: 'tests/src/hashmap.rs', lines 27:0-27:16 *) type hashmap_List_t (t : Type0) = | Hashmap_List_Cons : usize -> t -> hashmap_List_t t -> hashmap_List_t t | Hashmap_List_Nil : hashmap_List_t t (** [hashmap_main::hashmap::HashMap] - Source: 'src/hashmap.rs', lines 35:0-35:21 *) + Source: 'tests/src/hashmap.rs', lines 43:0-43:21 *) type hashmap_HashMap_t (t : Type0) = { num_entries : usize; diff --git a/tests/fstar/misc/Bitwise.fst b/tests/fstar/misc/Bitwise.fst index 11ef6861..8d6bab58 100644 --- a/tests/fstar/misc/Bitwise.fst +++ b/tests/fstar/misc/Bitwise.fst @@ -6,27 +6,27 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [bitwise::shift_u32]: - Source: 'src/bitwise.rs', lines 3:0-3:31 *) + Source: 'tests/src/bitwise.rs', lines 4:0-4:31 *) let shift_u32 (a : u32) : result u32 = let* t = u32_shr #Usize a 16 in u32_shl #Usize t 16 (** [bitwise::shift_i32]: - Source: 'src/bitwise.rs', lines 10:0-10:31 *) + Source: 'tests/src/bitwise.rs', lines 11:0-11:31 *) let shift_i32 (a : i32) : result i32 = let* t = i32_shr #Isize a 16 in i32_shl #Isize t 16 (** [bitwise::xor_u32]: - Source: 'src/bitwise.rs', lines 17:0-17:37 *) + Source: 'tests/src/bitwise.rs', lines 18:0-18:37 *) let xor_u32 (a : u32) (b : u32) : result u32 = Ok (u32_xor a b) (** [bitwise::or_u32]: - Source: 'src/bitwise.rs', lines 21:0-21:36 *) + Source: 'tests/src/bitwise.rs', lines 22:0-22:36 *) let or_u32 (a : u32) (b : u32) : result u32 = Ok (u32_or a b) (** [bitwise::and_u32]: - Source: 'src/bitwise.rs', lines 25:0-25:37 *) + Source: 'tests/src/bitwise.rs', lines 26:0-26:37 *) let and_u32 (a : u32) (b : u32) : result u32 = Ok (u32_and a b) diff --git a/tests/fstar/misc/Constants.fst b/tests/fstar/misc/Constants.fst index 4fbafb83..4ff5e883 100644 --- a/tests/fstar/misc/Constants.fst +++ b/tests/fstar/misc/Constants.fst @@ -6,154 +6,154 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [constants::X0] - Source: 'src/constants.rs', lines 5:0-5:17 *) + Source: 'tests/src/constants.rs', lines 7:0-7:17 *) let x0_body : result u32 = Ok 0 let x0 : u32 = eval_global x0_body (** [constants::X1] - Source: 'src/constants.rs', lines 7:0-7:17 *) + Source: 'tests/src/constants.rs', lines 9:0-9:17 *) let x1_body : result u32 = Ok core_u32_max let x1 : u32 = eval_global x1_body (** [constants::X2] - Source: 'src/constants.rs', lines 10:0-10:17 *) + Source: 'tests/src/constants.rs', lines 12:0-12:17 *) let x2_body : result u32 = Ok 3 let x2 : u32 = eval_global x2_body (** [constants::incr]: - Source: 'src/constants.rs', lines 17:0-17:32 *) + Source: 'tests/src/constants.rs', lines 19:0-19:32 *) let incr (n : u32) : result u32 = u32_add n 1 (** [constants::X3] - Source: 'src/constants.rs', lines 15:0-15:17 *) + Source: 'tests/src/constants.rs', lines 17:0-17:17 *) let x3_body : result u32 = incr 32 let x3 : u32 = eval_global x3_body (** [constants::mk_pair0]: - Source: 'src/constants.rs', lines 23:0-23:51 *) + Source: 'tests/src/constants.rs', lines 25:0-25:51 *) let mk_pair0 (x : u32) (y1 : u32) : result (u32 & u32) = Ok (x, y1) (** [constants::Pair] - Source: 'src/constants.rs', lines 36:0-36:23 *) + Source: 'tests/src/constants.rs', lines 38:0-38:23 *) type pair_t (t1 t2 : Type0) = { x : t1; y : t2; } (** [constants::mk_pair1]: - Source: 'src/constants.rs', lines 27:0-27:55 *) + Source: 'tests/src/constants.rs', lines 29:0-29:55 *) let mk_pair1 (x : u32) (y1 : u32) : result (pair_t u32 u32) = Ok { x = x; y = y1 } (** [constants::P0] - Source: 'src/constants.rs', lines 31:0-31:24 *) + Source: 'tests/src/constants.rs', lines 33:0-33:24 *) let p0_body : result (u32 & u32) = mk_pair0 0 1 let p0 : (u32 & u32) = eval_global p0_body (** [constants::P1] - Source: 'src/constants.rs', lines 32:0-32:28 *) + Source: 'tests/src/constants.rs', lines 34:0-34:28 *) let p1_body : result (pair_t u32 u32) = mk_pair1 0 1 let p1 : pair_t u32 u32 = eval_global p1_body (** [constants::P2] - Source: 'src/constants.rs', lines 33:0-33:24 *) + Source: 'tests/src/constants.rs', lines 35:0-35:24 *) let p2_body : result (u32 & u32) = Ok (0, 1) let p2 : (u32 & u32) = eval_global p2_body (** [constants::P3] - Source: 'src/constants.rs', lines 34:0-34:28 *) + Source: 'tests/src/constants.rs', lines 36:0-36:28 *) let p3_body : result (pair_t u32 u32) = Ok { x = 0; y = 1 } let p3 : pair_t u32 u32 = eval_global p3_body (** [constants::Wrap] - Source: 'src/constants.rs', lines 49:0-49:18 *) + Source: 'tests/src/constants.rs', lines 51:0-51:18 *) type wrap_t (t : Type0) = { value : t; } (** [constants::{constants::Wrap<T>}::new]: - Source: 'src/constants.rs', lines 54:4-54:41 *) + Source: 'tests/src/constants.rs', lines 56:4-56:41 *) let wrap_new (t : Type0) (value : t) : result (wrap_t t) = Ok { value = value } (** [constants::Y] - Source: 'src/constants.rs', lines 41:0-41:22 *) + Source: 'tests/src/constants.rs', lines 43:0-43:22 *) let y_body : result (wrap_t i32) = wrap_new i32 2 let y : wrap_t i32 = eval_global y_body (** [constants::unwrap_y]: - Source: 'src/constants.rs', lines 43:0-43:30 *) + Source: 'tests/src/constants.rs', lines 45:0-45:30 *) let unwrap_y : result i32 = Ok y.value (** [constants::YVAL] - Source: 'src/constants.rs', lines 47:0-47:19 *) + Source: 'tests/src/constants.rs', lines 49:0-49:19 *) let yval_body : result i32 = unwrap_y let yval : i32 = eval_global yval_body (** [constants::get_z1::Z1] - Source: 'src/constants.rs', lines 62:4-62:17 *) + Source: 'tests/src/constants.rs', lines 64:4-64:17 *) let get_z1_z1_body : result i32 = Ok 3 let get_z1_z1 : i32 = eval_global get_z1_z1_body (** [constants::get_z1]: - Source: 'src/constants.rs', lines 61:0-61:28 *) + Source: 'tests/src/constants.rs', lines 63:0-63:28 *) let get_z1 : result i32 = Ok get_z1_z1 (** [constants::add]: - Source: 'src/constants.rs', lines 66:0-66:39 *) + Source: 'tests/src/constants.rs', lines 68:0-68:39 *) let add (a : i32) (b : i32) : result i32 = i32_add a b (** [constants::Q1] - Source: 'src/constants.rs', lines 74:0-74:17 *) + Source: 'tests/src/constants.rs', lines 76:0-76:17 *) let q1_body : result i32 = Ok 5 let q1 : i32 = eval_global q1_body (** [constants::Q2] - Source: 'src/constants.rs', lines 75:0-75:17 *) + Source: 'tests/src/constants.rs', lines 77:0-77:17 *) let q2_body : result i32 = Ok q1 let q2 : i32 = eval_global q2_body (** [constants::Q3] - Source: 'src/constants.rs', lines 76:0-76:17 *) + Source: 'tests/src/constants.rs', lines 78:0-78:17 *) let q3_body : result i32 = add q2 3 let q3 : i32 = eval_global q3_body (** [constants::get_z2]: - Source: 'src/constants.rs', lines 70:0-70:28 *) + Source: 'tests/src/constants.rs', lines 72:0-72:28 *) let get_z2 : result i32 = let* i = get_z1 in let* i1 = add i q3 in add q1 i1 (** [constants::S1] - Source: 'src/constants.rs', lines 80:0-80:18 *) + Source: 'tests/src/constants.rs', lines 82:0-82:18 *) let s1_body : result u32 = Ok 6 let s1 : u32 = eval_global s1_body (** [constants::S2] - Source: 'src/constants.rs', lines 81:0-81:18 *) + Source: 'tests/src/constants.rs', lines 83:0-83:18 *) let s2_body : result u32 = incr s1 let s2 : u32 = eval_global s2_body (** [constants::S3] - Source: 'src/constants.rs', lines 82:0-82:29 *) + Source: 'tests/src/constants.rs', lines 84:0-84:29 *) let s3_body : result (pair_t u32 u32) = Ok p3 let s3 : pair_t u32 u32 = eval_global s3_body (** [constants::S4] - Source: 'src/constants.rs', lines 83:0-83:29 *) + Source: 'tests/src/constants.rs', lines 85:0-85:29 *) let s4_body : result (pair_t u32 u32) = mk_pair1 7 8 let s4 : pair_t u32 u32 = eval_global s4_body (** [constants::V] - Source: 'src/constants.rs', lines 86:0-86:31 *) + Source: 'tests/src/constants.rs', lines 88:0-88:31 *) type v_t (t : Type0) (n : usize) = { x : array t n; } (** [constants::{constants::V<T, N>#1}::LEN] - Source: 'src/constants.rs', lines 91:4-91:24 *) + Source: 'tests/src/constants.rs', lines 93:4-93:24 *) let v_len_body (t : Type0) (n : usize) : result usize = Ok n let v_len (t : Type0) (n : usize) : usize = eval_global (v_len_body t n) (** [constants::use_v]: - Source: 'src/constants.rs', lines 94:0-94:42 *) + Source: 'tests/src/constants.rs', lines 96:0-96:42 *) let use_v (t : Type0) (n : usize) : result usize = Ok (v_len t n) diff --git a/tests/fstar/misc/External.Funs.fst b/tests/fstar/misc/External.Funs.fst index 3b99ef25..18fc901f 100644 --- a/tests/fstar/misc/External.Funs.fst +++ b/tests/fstar/misc/External.Funs.fst @@ -15,12 +15,12 @@ let core_marker_CopyU32 : core_marker_Copy_t u32 = { } (** [external::use_get]: - Source: 'src/external.rs', lines 5:0-5:37 *) + Source: 'tests/src/external.rs', lines 8:0-8:37 *) let use_get (rc : core_cell_Cell_t u32) (st : state) : result (state & u32) = core_cell_Cell_get u32 core_marker_CopyU32 rc st (** [external::incr]: - Source: 'src/external.rs', lines 9:0-9:31 *) + Source: 'tests/src/external.rs', lines 12:0-12:31 *) let incr (rc : core_cell_Cell_t u32) (st : state) : result (state & (core_cell_Cell_t u32)) diff --git a/tests/fstar/misc/Loops.Clauses.Template.fst b/tests/fstar/misc/Loops.Clauses.Template.fst index e43f8170..7b042375 100644 --- a/tests/fstar/misc/Loops.Clauses.Template.fst +++ b/tests/fstar/misc/Loops.Clauses.Template.fst @@ -7,144 +7,144 @@ open Loops.Types #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [loops::sum]: decreases clause - Source: 'src/loops.rs', lines 4:0-14:1 *) + Source: 'tests/src/loops.rs', lines 7:0-17:1 *) unfold let sum_loop_decreases (max : u32) (i : u32) (s : u32) : nat = admit () (** [loops::sum_with_mut_borrows]: decreases clause - Source: 'src/loops.rs', lines 19:0-31:1 *) + Source: 'tests/src/loops.rs', lines 22:0-34:1 *) unfold let sum_with_mut_borrows_loop_decreases (max : u32) (i : u32) (s : u32) : nat = admit () (** [loops::sum_with_shared_borrows]: decreases clause - Source: 'src/loops.rs', lines 34:0-48:1 *) + Source: 'tests/src/loops.rs', lines 37:0-51:1 *) unfold let sum_with_shared_borrows_loop_decreases (max : u32) (i : u32) (s : u32) : nat = admit () (** [loops::sum_array]: decreases clause - Source: 'src/loops.rs', lines 50:0-58:1 *) + Source: 'tests/src/loops.rs', lines 53:0-61:1 *) unfold let sum_array_loop_decreases (n : usize) (a : array u32 n) (i : usize) (s : u32) : nat = admit () (** [loops::clear]: decreases clause - Source: 'src/loops.rs', lines 62:0-68:1 *) + Source: 'tests/src/loops.rs', lines 65:0-71:1 *) unfold let clear_loop_decreases (v : alloc_vec_Vec u32) (i : usize) : nat = admit () (** [loops::list_mem]: decreases clause - Source: 'src/loops.rs', lines 76:0-85:1 *) + Source: 'tests/src/loops.rs', lines 79:0-88:1 *) unfold let list_mem_loop_decreases (x : u32) (ls : list_t u32) : nat = admit () (** [loops::list_nth_mut_loop]: decreases clause - Source: 'src/loops.rs', lines 88:0-98:1 *) + Source: 'tests/src/loops.rs', lines 91:0-101:1 *) unfold let list_nth_mut_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : nat = admit () (** [loops::list_nth_shared_loop]: decreases clause - Source: 'src/loops.rs', lines 101:0-111:1 *) + Source: 'tests/src/loops.rs', lines 104:0-114:1 *) unfold let list_nth_shared_loop_loop_decreases (t : Type0) (ls : list_t t) (i : u32) : nat = admit () (** [loops::get_elem_mut]: decreases clause - Source: 'src/loops.rs', lines 113:0-127:1 *) + Source: 'tests/src/loops.rs', lines 116:0-130:1 *) unfold let get_elem_mut_loop_decreases (x : usize) (ls : list_t usize) : nat = admit () (** [loops::get_elem_shared]: decreases clause - Source: 'src/loops.rs', lines 129:0-143:1 *) + Source: 'tests/src/loops.rs', lines 132:0-146:1 *) unfold let get_elem_shared_loop_decreases (x : usize) (ls : list_t usize) : nat = admit () (** [loops::list_nth_mut_loop_with_id]: decreases clause - Source: 'src/loops.rs', lines 154:0-165:1 *) + Source: 'tests/src/loops.rs', lines 157:0-168:1 *) unfold let list_nth_mut_loop_with_id_loop_decreases (t : Type0) (i : u32) (ls : list_t t) : nat = admit () (** [loops::list_nth_shared_loop_with_id]: decreases clause - Source: 'src/loops.rs', lines 168:0-179:1 *) + Source: 'tests/src/loops.rs', lines 171:0-182:1 *) unfold let list_nth_shared_loop_with_id_loop_decreases (t : Type0) (i : u32) (ls : list_t t) : nat = admit () (** [loops::list_nth_mut_loop_pair]: decreases clause - Source: 'src/loops.rs', lines 184:0-205:1 *) + Source: 'tests/src/loops.rs', lines 187:0-208:1 *) unfold let list_nth_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = admit () (** [loops::list_nth_shared_loop_pair]: decreases clause - Source: 'src/loops.rs', lines 208:0-229:1 *) + Source: 'tests/src/loops.rs', lines 211:0-232:1 *) unfold let list_nth_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = admit () (** [loops::list_nth_mut_loop_pair_merge]: decreases clause - Source: 'src/loops.rs', lines 233:0-248:1 *) + Source: 'tests/src/loops.rs', lines 236:0-251:1 *) unfold let list_nth_mut_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = admit () (** [loops::list_nth_shared_loop_pair_merge]: decreases clause - Source: 'src/loops.rs', lines 251:0-266:1 *) + Source: 'tests/src/loops.rs', lines 254:0-269:1 *) unfold let list_nth_shared_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = admit () (** [loops::list_nth_mut_shared_loop_pair]: decreases clause - Source: 'src/loops.rs', lines 269:0-284:1 *) + Source: 'tests/src/loops.rs', lines 272:0-287:1 *) unfold let list_nth_mut_shared_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = admit () (** [loops::list_nth_mut_shared_loop_pair_merge]: decreases clause - Source: 'src/loops.rs', lines 288:0-303:1 *) + Source: 'tests/src/loops.rs', lines 291:0-306:1 *) unfold let list_nth_mut_shared_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = admit () (** [loops::list_nth_shared_mut_loop_pair]: decreases clause - Source: 'src/loops.rs', lines 307:0-322:1 *) + Source: 'tests/src/loops.rs', lines 310:0-325:1 *) unfold let list_nth_shared_mut_loop_pair_loop_decreases (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = admit () (** [loops::list_nth_shared_mut_loop_pair_merge]: decreases clause - Source: 'src/loops.rs', lines 326:0-341:1 *) + Source: 'tests/src/loops.rs', lines 329:0-344:1 *) unfold let list_nth_shared_mut_loop_pair_merge_loop_decreases (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : nat = admit () (** [loops::ignore_input_mut_borrow]: decreases clause - Source: 'src/loops.rs', lines 345:0-349:1 *) + Source: 'tests/src/loops.rs', lines 348:0-352:1 *) unfold let ignore_input_mut_borrow_loop_decreases (i : u32) : nat = admit () (** [loops::incr_ignore_input_mut_borrow]: decreases clause - Source: 'src/loops.rs', lines 353:0-358:1 *) + Source: 'tests/src/loops.rs', lines 356:0-361:1 *) unfold let incr_ignore_input_mut_borrow_loop_decreases (i : u32) : nat = admit () (** [loops::ignore_input_shared_borrow]: decreases clause - Source: 'src/loops.rs', lines 362:0-366:1 *) + Source: 'tests/src/loops.rs', lines 365:0-369:1 *) unfold let ignore_input_shared_borrow_loop_decreases (i : u32) : nat = admit () diff --git a/tests/fstar/misc/Loops.Funs.fst b/tests/fstar/misc/Loops.Funs.fst index 26cb91d2..84e9634d 100644 --- a/tests/fstar/misc/Loops.Funs.fst +++ b/tests/fstar/misc/Loops.Funs.fst @@ -8,7 +8,7 @@ include Loops.Clauses #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [loops::sum]: loop 0: - Source: 'src/loops.rs', lines 4:0-14:1 *) + Source: 'tests/src/loops.rs', lines 7:0-17:1 *) let rec sum_loop (max : u32) (i : u32) (s : u32) : Tot (result u32) (decreases (sum_loop_decreases max i s)) @@ -18,12 +18,12 @@ let rec sum_loop else u32_mul s 2 (** [loops::sum]: - Source: 'src/loops.rs', lines 4:0-4:27 *) + Source: 'tests/src/loops.rs', lines 7:0-7:27 *) let sum (max : u32) : result u32 = sum_loop max 0 0 (** [loops::sum_with_mut_borrows]: loop 0: - Source: 'src/loops.rs', lines 19:0-31:1 *) + Source: 'tests/src/loops.rs', lines 22:0-34:1 *) let rec sum_with_mut_borrows_loop (max : u32) (i : u32) (s : u32) : Tot (result u32) (decreases (sum_with_mut_borrows_loop_decreases max i s)) @@ -36,12 +36,12 @@ let rec sum_with_mut_borrows_loop else u32_mul s 2 (** [loops::sum_with_mut_borrows]: - Source: 'src/loops.rs', lines 19:0-19:44 *) + Source: 'tests/src/loops.rs', lines 22:0-22:44 *) let sum_with_mut_borrows (max : u32) : result u32 = sum_with_mut_borrows_loop max 0 0 (** [loops::sum_with_shared_borrows]: loop 0: - Source: 'src/loops.rs', lines 34:0-48:1 *) + Source: 'tests/src/loops.rs', lines 37:0-51:1 *) let rec sum_with_shared_borrows_loop (max : u32) (i : u32) (s : u32) : Tot (result u32) (decreases (sum_with_shared_borrows_loop_decreases max i s)) @@ -54,12 +54,12 @@ let rec sum_with_shared_borrows_loop else u32_mul s 2 (** [loops::sum_with_shared_borrows]: - Source: 'src/loops.rs', lines 34:0-34:47 *) + Source: 'tests/src/loops.rs', lines 37:0-37:47 *) let sum_with_shared_borrows (max : u32) : result u32 = sum_with_shared_borrows_loop max 0 0 (** [loops::sum_array]: loop 0: - Source: 'src/loops.rs', lines 50:0-58:1 *) + Source: 'tests/src/loops.rs', lines 53:0-61:1 *) let rec sum_array_loop (n : usize) (a : array u32 n) (i : usize) (s : u32) : Tot (result u32) (decreases (sum_array_loop_decreases n a i s)) @@ -73,12 +73,12 @@ let rec sum_array_loop else Ok s (** [loops::sum_array]: - Source: 'src/loops.rs', lines 50:0-50:52 *) + Source: 'tests/src/loops.rs', lines 53:0-53:52 *) let sum_array (n : usize) (a : array u32 n) : result u32 = sum_array_loop n a 0 0 (** [loops::clear]: loop 0: - Source: 'src/loops.rs', lines 62:0-68:1 *) + Source: 'tests/src/loops.rs', lines 65:0-71:1 *) let rec clear_loop (v : alloc_vec_Vec u32) (i : usize) : Tot (result (alloc_vec_Vec u32)) (decreases (clear_loop_decreases v i)) @@ -95,12 +95,12 @@ let rec clear_loop else Ok v (** [loops::clear]: - Source: 'src/loops.rs', lines 62:0-62:30 *) + Source: 'tests/src/loops.rs', lines 65:0-65:30 *) let clear (v : alloc_vec_Vec u32) : result (alloc_vec_Vec u32) = clear_loop v 0 (** [loops::list_mem]: loop 0: - Source: 'src/loops.rs', lines 76:0-85:1 *) + Source: 'tests/src/loops.rs', lines 79:0-88:1 *) let rec list_mem_loop (x : u32) (ls : list_t u32) : Tot (result bool) (decreases (list_mem_loop_decreases x ls)) @@ -111,12 +111,12 @@ let rec list_mem_loop end (** [loops::list_mem]: - Source: 'src/loops.rs', lines 76:0-76:52 *) + Source: 'tests/src/loops.rs', lines 79:0-79:52 *) let list_mem (x : u32) (ls : list_t u32) : result bool = list_mem_loop x ls (** [loops::list_nth_mut_loop]: loop 0: - Source: 'src/loops.rs', lines 88:0-98:1 *) + Source: 'tests/src/loops.rs', lines 91:0-101:1 *) let rec list_nth_mut_loop_loop (t : Type0) (ls : list_t t) (i : u32) : Tot (result (t & (t -> result (list_t t)))) @@ -135,7 +135,7 @@ let rec list_nth_mut_loop_loop end (** [loops::list_nth_mut_loop]: - Source: 'src/loops.rs', lines 88:0-88:71 *) + Source: 'tests/src/loops.rs', lines 91:0-91:71 *) let list_nth_mut_loop (t : Type0) (ls : list_t t) (i : u32) : result (t & (t -> result (list_t t))) @@ -143,7 +143,7 @@ let list_nth_mut_loop list_nth_mut_loop_loop t ls i (** [loops::list_nth_shared_loop]: loop 0: - Source: 'src/loops.rs', lines 101:0-111:1 *) + Source: 'tests/src/loops.rs', lines 104:0-114:1 *) let rec list_nth_shared_loop_loop (t : Type0) (ls : list_t t) (i : u32) : Tot (result t) (decreases (list_nth_shared_loop_loop_decreases t ls i)) @@ -157,12 +157,12 @@ let rec list_nth_shared_loop_loop end (** [loops::list_nth_shared_loop]: - Source: 'src/loops.rs', lines 101:0-101:66 *) + Source: 'tests/src/loops.rs', lines 104:0-104:66 *) let list_nth_shared_loop (t : Type0) (ls : list_t t) (i : u32) : result t = list_nth_shared_loop_loop t ls i (** [loops::get_elem_mut]: loop 0: - Source: 'src/loops.rs', lines 113:0-127:1 *) + Source: 'tests/src/loops.rs', lines 116:0-130:1 *) let rec get_elem_mut_loop (x : usize) (ls : list_t usize) : Tot (result (usize & (usize -> result (list_t usize)))) @@ -180,7 +180,7 @@ let rec get_elem_mut_loop end (** [loops::get_elem_mut]: - Source: 'src/loops.rs', lines 113:0-113:73 *) + Source: 'tests/src/loops.rs', lines 116:0-116:73 *) let get_elem_mut (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result (usize & (usize -> result (alloc_vec_Vec (list_t usize)))) @@ -193,7 +193,7 @@ let get_elem_mut Ok (i, back1) (** [loops::get_elem_shared]: loop 0: - Source: 'src/loops.rs', lines 129:0-143:1 *) + Source: 'tests/src/loops.rs', lines 132:0-146:1 *) let rec get_elem_shared_loop (x : usize) (ls : list_t usize) : Tot (result usize) (decreases (get_elem_shared_loop_decreases x ls)) @@ -204,7 +204,7 @@ let rec get_elem_shared_loop end (** [loops::get_elem_shared]: - Source: 'src/loops.rs', lines 129:0-129:68 *) + Source: 'tests/src/loops.rs', lines 132:0-132:68 *) let get_elem_shared (slots : alloc_vec_Vec (list_t usize)) (x : usize) : result usize = let* ls = @@ -213,7 +213,7 @@ let get_elem_shared get_elem_shared_loop x ls (** [loops::id_mut]: - Source: 'src/loops.rs', lines 145:0-145:50 *) + Source: 'tests/src/loops.rs', lines 148:0-148:50 *) let id_mut (t : Type0) (ls : list_t t) : result ((list_t t) & (list_t t -> result (list_t t))) @@ -221,12 +221,12 @@ let id_mut Ok (ls, Ok) (** [loops::id_shared]: - Source: 'src/loops.rs', lines 149:0-149:45 *) + Source: 'tests/src/loops.rs', lines 152:0-152:45 *) let id_shared (t : Type0) (ls : list_t t) : result (list_t t) = Ok ls (** [loops::list_nth_mut_loop_with_id]: loop 0: - Source: 'src/loops.rs', lines 154:0-165:1 *) + Source: 'tests/src/loops.rs', lines 157:0-168:1 *) let rec list_nth_mut_loop_with_id_loop (t : Type0) (i : u32) (ls : list_t t) : Tot (result (t & (t -> result (list_t t)))) @@ -245,7 +245,7 @@ let rec list_nth_mut_loop_with_id_loop end (** [loops::list_nth_mut_loop_with_id]: - Source: 'src/loops.rs', lines 154:0-154:75 *) + Source: 'tests/src/loops.rs', lines 157:0-157:75 *) let list_nth_mut_loop_with_id (t : Type0) (ls : list_t t) (i : u32) : result (t & (t -> result (list_t t))) @@ -256,7 +256,7 @@ let list_nth_mut_loop_with_id Ok (x, back1) (** [loops::list_nth_shared_loop_with_id]: loop 0: - Source: 'src/loops.rs', lines 168:0-179:1 *) + Source: 'tests/src/loops.rs', lines 171:0-182:1 *) let rec list_nth_shared_loop_with_id_loop (t : Type0) (i : u32) (ls : list_t t) : Tot (result t) @@ -271,13 +271,13 @@ let rec list_nth_shared_loop_with_id_loop end (** [loops::list_nth_shared_loop_with_id]: - Source: 'src/loops.rs', lines 168:0-168:70 *) + Source: 'tests/src/loops.rs', lines 171:0-171:70 *) let list_nth_shared_loop_with_id (t : Type0) (ls : list_t t) (i : u32) : result t = let* ls1 = id_shared t ls in list_nth_shared_loop_with_id_loop t i ls1 (** [loops::list_nth_mut_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 184:0-205:1 *) + Source: 'tests/src/loops.rs', lines 187:0-208:1 *) let rec list_nth_mut_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result ((t & t) & (t -> result (list_t t)) & (t -> result (list_t t)))) @@ -306,7 +306,7 @@ let rec list_nth_mut_loop_pair_loop end (** [loops::list_nth_mut_loop_pair]: - Source: 'src/loops.rs', lines 184:0-188:27 *) + Source: 'tests/src/loops.rs', lines 187:0-191:27 *) let list_nth_mut_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result ((t & t) & (t -> result (list_t t)) & (t -> result (list_t t))) @@ -314,7 +314,7 @@ let list_nth_mut_loop_pair list_nth_mut_loop_pair_loop t ls0 ls1 i (** [loops::list_nth_shared_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 208:0-229:1 *) + Source: 'tests/src/loops.rs', lines 211:0-232:1 *) let rec list_nth_shared_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) @@ -333,13 +333,13 @@ let rec list_nth_shared_loop_pair_loop end (** [loops::list_nth_shared_loop_pair]: - Source: 'src/loops.rs', lines 208:0-212:19 *) + Source: 'tests/src/loops.rs', lines 211:0-215:19 *) let list_nth_shared_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = list_nth_shared_loop_pair_loop t ls0 ls1 i (** [loops::list_nth_mut_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 233:0-248:1 *) + Source: 'tests/src/loops.rs', lines 236:0-251:1 *) let rec list_nth_mut_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result ((t & t) & ((t & t) -> result ((list_t t) & (list_t t))))) @@ -369,7 +369,7 @@ let rec list_nth_mut_loop_pair_merge_loop end (** [loops::list_nth_mut_loop_pair_merge]: - Source: 'src/loops.rs', lines 233:0-237:27 *) + Source: 'tests/src/loops.rs', lines 236:0-240:27 *) let list_nth_mut_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result ((t & t) & ((t & t) -> result ((list_t t) & (list_t t)))) @@ -377,7 +377,7 @@ let list_nth_mut_loop_pair_merge list_nth_mut_loop_pair_merge_loop t ls0 ls1 i (** [loops::list_nth_shared_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 251:0-266:1 *) + Source: 'tests/src/loops.rs', lines 254:0-269:1 *) let rec list_nth_shared_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result (t & t)) @@ -398,13 +398,13 @@ let rec list_nth_shared_loop_pair_merge_loop end (** [loops::list_nth_shared_loop_pair_merge]: - Source: 'src/loops.rs', lines 251:0-255:19 *) + Source: 'tests/src/loops.rs', lines 254:0-258:19 *) let list_nth_shared_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result (t & t) = list_nth_shared_loop_pair_merge_loop t ls0 ls1 i (** [loops::list_nth_mut_shared_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 269:0-284:1 *) + Source: 'tests/src/loops.rs', lines 272:0-287:1 *) let rec list_nth_mut_shared_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result ((t & t) & (t -> result (list_t t)))) @@ -428,7 +428,7 @@ let rec list_nth_mut_shared_loop_pair_loop end (** [loops::list_nth_mut_shared_loop_pair]: - Source: 'src/loops.rs', lines 269:0-273:23 *) + Source: 'tests/src/loops.rs', lines 272:0-276:23 *) let list_nth_mut_shared_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result ((t & t) & (t -> result (list_t t))) @@ -436,7 +436,7 @@ let list_nth_mut_shared_loop_pair list_nth_mut_shared_loop_pair_loop t ls0 ls1 i (** [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 288:0-303:1 *) + Source: 'tests/src/loops.rs', lines 291:0-306:1 *) let rec list_nth_mut_shared_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result ((t & t) & (t -> result (list_t t)))) @@ -461,7 +461,7 @@ let rec list_nth_mut_shared_loop_pair_merge_loop end (** [loops::list_nth_mut_shared_loop_pair_merge]: - Source: 'src/loops.rs', lines 288:0-292:23 *) + Source: 'tests/src/loops.rs', lines 291:0-295:23 *) let list_nth_mut_shared_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result ((t & t) & (t -> result (list_t t))) @@ -469,7 +469,7 @@ let list_nth_mut_shared_loop_pair_merge list_nth_mut_shared_loop_pair_merge_loop t ls0 ls1 i (** [loops::list_nth_shared_mut_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 307:0-322:1 *) + Source: 'tests/src/loops.rs', lines 310:0-325:1 *) let rec list_nth_shared_mut_loop_pair_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result ((t & t) & (t -> result (list_t t)))) @@ -493,7 +493,7 @@ let rec list_nth_shared_mut_loop_pair_loop end (** [loops::list_nth_shared_mut_loop_pair]: - Source: 'src/loops.rs', lines 307:0-311:23 *) + Source: 'tests/src/loops.rs', lines 310:0-314:23 *) let list_nth_shared_mut_loop_pair (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result ((t & t) & (t -> result (list_t t))) @@ -501,7 +501,7 @@ let list_nth_shared_mut_loop_pair list_nth_shared_mut_loop_pair_loop t ls0 ls1 i (** [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 326:0-341:1 *) + Source: 'tests/src/loops.rs', lines 329:0-344:1 *) let rec list_nth_shared_mut_loop_pair_merge_loop (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : Tot (result ((t & t) & (t -> result (list_t t)))) @@ -526,7 +526,7 @@ let rec list_nth_shared_mut_loop_pair_merge_loop end (** [loops::list_nth_shared_mut_loop_pair_merge]: - Source: 'src/loops.rs', lines 326:0-330:23 *) + Source: 'tests/src/loops.rs', lines 329:0-333:23 *) let list_nth_shared_mut_loop_pair_merge (t : Type0) (ls0 : list_t t) (ls1 : list_t t) (i : u32) : result ((t & t) & (t -> result (list_t t))) @@ -534,7 +534,7 @@ let list_nth_shared_mut_loop_pair_merge list_nth_shared_mut_loop_pair_merge_loop t ls0 ls1 i (** [loops::ignore_input_mut_borrow]: loop 0: - Source: 'src/loops.rs', lines 345:0-349:1 *) + Source: 'tests/src/loops.rs', lines 348:0-352:1 *) let rec ignore_input_mut_borrow_loop (i : u32) : Tot (result unit) (decreases (ignore_input_mut_borrow_loop_decreases i)) @@ -544,12 +544,12 @@ let rec ignore_input_mut_borrow_loop else Ok () (** [loops::ignore_input_mut_borrow]: - Source: 'src/loops.rs', lines 345:0-345:56 *) + Source: 'tests/src/loops.rs', lines 348:0-348:56 *) let ignore_input_mut_borrow (_a : u32) (i : u32) : result u32 = let* _ = ignore_input_mut_borrow_loop i in Ok _a (** [loops::incr_ignore_input_mut_borrow]: loop 0: - Source: 'src/loops.rs', lines 353:0-358:1 *) + Source: 'tests/src/loops.rs', lines 356:0-361:1 *) let rec incr_ignore_input_mut_borrow_loop (i : u32) : Tot (result unit) (decreases (incr_ignore_input_mut_borrow_loop_decreases i)) @@ -559,14 +559,14 @@ let rec incr_ignore_input_mut_borrow_loop else Ok () (** [loops::incr_ignore_input_mut_borrow]: - Source: 'src/loops.rs', lines 353:0-353:60 *) + Source: 'tests/src/loops.rs', lines 356:0-356:60 *) let incr_ignore_input_mut_borrow (a : u32) (i : u32) : result u32 = let* a1 = u32_add a 1 in let* _ = incr_ignore_input_mut_borrow_loop i in Ok a1 (** [loops::ignore_input_shared_borrow]: loop 0: - Source: 'src/loops.rs', lines 362:0-366:1 *) + Source: 'tests/src/loops.rs', lines 365:0-369:1 *) let rec ignore_input_shared_borrow_loop (i : u32) : Tot (result unit) (decreases (ignore_input_shared_borrow_loop_decreases i)) @@ -576,7 +576,7 @@ let rec ignore_input_shared_borrow_loop else Ok () (** [loops::ignore_input_shared_borrow]: - Source: 'src/loops.rs', lines 362:0-362:59 *) + Source: 'tests/src/loops.rs', lines 365:0-365:59 *) let ignore_input_shared_borrow (_a : u32) (i : u32) : result u32 = let* _ = ignore_input_shared_borrow_loop i in Ok _a diff --git a/tests/fstar/misc/Loops.Types.fst b/tests/fstar/misc/Loops.Types.fst index 29f56e1b..c844d0e0 100644 --- a/tests/fstar/misc/Loops.Types.fst +++ b/tests/fstar/misc/Loops.Types.fst @@ -6,7 +6,7 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [loops::List] - Source: 'src/loops.rs', lines 70:0-70:16 *) + Source: 'tests/src/loops.rs', lines 73:0-73:16 *) type list_t (t : Type0) = | List_Cons : t -> list_t t -> list_t t | List_Nil : list_t t diff --git a/tests/fstar/misc/NoNestedBorrows.fst b/tests/fstar/misc/NoNestedBorrows.fst index 7d965944..b9fbd669 100644 --- a/tests/fstar/misc/NoNestedBorrows.fst +++ b/tests/fstar/misc/NoNestedBorrows.fst @@ -6,54 +6,54 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [no_nested_borrows::Pair] - Source: 'src/no_nested_borrows.rs', lines 4:0-4:23 *) + Source: 'tests/src/no_nested_borrows.rs', lines 6:0-6:23 *) type pair_t (t1 t2 : Type0) = { x : t1; y : t2; } (** [no_nested_borrows::List] - Source: 'src/no_nested_borrows.rs', lines 9:0-9:16 *) + Source: 'tests/src/no_nested_borrows.rs', lines 11:0-11:16 *) type list_t (t : Type0) = | List_Cons : t -> list_t t -> list_t t | List_Nil : list_t t (** [no_nested_borrows::One] - Source: 'src/no_nested_borrows.rs', lines 20:0-20:16 *) + Source: 'tests/src/no_nested_borrows.rs', lines 22:0-22:16 *) type one_t (t1 : Type0) = | One_One : t1 -> one_t t1 (** [no_nested_borrows::EmptyEnum] - Source: 'src/no_nested_borrows.rs', lines 26:0-26:18 *) + Source: 'tests/src/no_nested_borrows.rs', lines 28:0-28:18 *) type emptyEnum_t = | EmptyEnum_Empty : emptyEnum_t (** [no_nested_borrows::Enum] - Source: 'src/no_nested_borrows.rs', lines 32:0-32:13 *) + Source: 'tests/src/no_nested_borrows.rs', lines 34:0-34:13 *) type enum_t = | Enum_Variant1 : enum_t | Enum_Variant2 : enum_t (** [no_nested_borrows::EmptyStruct] - Source: 'src/no_nested_borrows.rs', lines 39:0-39:22 *) + Source: 'tests/src/no_nested_borrows.rs', lines 41:0-41:22 *) type emptyStruct_t = unit (** [no_nested_borrows::Sum] - Source: 'src/no_nested_borrows.rs', lines 41:0-41:20 *) + Source: 'tests/src/no_nested_borrows.rs', lines 43:0-43:20 *) type sum_t (t1 t2 : Type0) = | Sum_Left : t1 -> sum_t t1 t2 | Sum_Right : t2 -> sum_t t1 t2 (** [no_nested_borrows::cast_u32_to_i32]: - Source: 'src/no_nested_borrows.rs', lines 46:0-46:37 *) + Source: 'tests/src/no_nested_borrows.rs', lines 48:0-48:37 *) let cast_u32_to_i32 (x : u32) : result i32 = scalar_cast U32 I32 x (** [no_nested_borrows::cast_bool_to_i32]: - Source: 'src/no_nested_borrows.rs', lines 50:0-50:39 *) + Source: 'tests/src/no_nested_borrows.rs', lines 52:0-52:39 *) let cast_bool_to_i32 (x : bool) : result i32 = scalar_cast_bool I32 x (** [no_nested_borrows::cast_bool_to_bool]: - Source: 'src/no_nested_borrows.rs', lines 55:0-55:41 *) + Source: 'tests/src/no_nested_borrows.rs', lines 57:0-57:41 *) let cast_bool_to_bool (x : bool) : result bool = Ok x (** [no_nested_borrows::test2]: - Source: 'src/no_nested_borrows.rs', lines 60:0-60:14 *) + Source: 'tests/src/no_nested_borrows.rs', lines 62:0-62:14 *) let test2 : result unit = let* _ = u32_add 23 44 in Ok () @@ -61,12 +61,12 @@ let test2 : result unit = let _ = assert_norm (test2 = Ok ()) (** [no_nested_borrows::get_max]: - Source: 'src/no_nested_borrows.rs', lines 72:0-72:37 *) + Source: 'tests/src/no_nested_borrows.rs', lines 74:0-74:37 *) let get_max (x : u32) (y : u32) : result u32 = if x >= y then Ok x else Ok y (** [no_nested_borrows::test3]: - Source: 'src/no_nested_borrows.rs', lines 80:0-80:14 *) + Source: 'tests/src/no_nested_borrows.rs', lines 82:0-82:14 *) let test3 : result unit = let* x = get_max 4 3 in let* y = get_max 10 11 in @@ -77,7 +77,7 @@ let test3 : result unit = let _ = assert_norm (test3 = Ok ()) (** [no_nested_borrows::test_neg1]: - Source: 'src/no_nested_borrows.rs', lines 87:0-87:18 *) + Source: 'tests/src/no_nested_borrows.rs', lines 89:0-89:18 *) let test_neg1 : result unit = let* y = i32_neg 3 in if not (y = -3) then Fail Failure else Ok () @@ -85,7 +85,7 @@ let test_neg1 : result unit = let _ = assert_norm (test_neg1 = Ok ()) (** [no_nested_borrows::refs_test1]: - Source: 'src/no_nested_borrows.rs', lines 94:0-94:19 *) + Source: 'tests/src/no_nested_borrows.rs', lines 96:0-96:19 *) let refs_test1 : result unit = if not (1 = 1) then Fail Failure else Ok () @@ -93,7 +93,7 @@ let refs_test1 : result unit = let _ = assert_norm (refs_test1 = Ok ()) (** [no_nested_borrows::refs_test2]: - Source: 'src/no_nested_borrows.rs', lines 105:0-105:19 *) + Source: 'tests/src/no_nested_borrows.rs', lines 107:0-107:19 *) let refs_test2 : result unit = if not (2 = 2) then Fail Failure @@ -109,7 +109,7 @@ let refs_test2 : result unit = let _ = assert_norm (refs_test2 = Ok ()) (** [no_nested_borrows::test_list1]: - Source: 'src/no_nested_borrows.rs', lines 121:0-121:19 *) + Source: 'tests/src/no_nested_borrows.rs', lines 123:0-123:19 *) let test_list1 : result unit = Ok () @@ -117,7 +117,7 @@ let test_list1 : result unit = let _ = assert_norm (test_list1 = Ok ()) (** [no_nested_borrows::test_box1]: - Source: 'src/no_nested_borrows.rs', lines 126:0-126:18 *) + Source: 'tests/src/no_nested_borrows.rs', lines 128:0-128:18 *) let test_box1 : result unit = let* (_, deref_mut_back) = alloc_boxed_Box_deref_mut i32 0 in let* b = deref_mut_back 1 in @@ -128,22 +128,22 @@ let test_box1 : result unit = let _ = assert_norm (test_box1 = Ok ()) (** [no_nested_borrows::copy_int]: - Source: 'src/no_nested_borrows.rs', lines 136:0-136:30 *) + Source: 'tests/src/no_nested_borrows.rs', lines 138:0-138:30 *) let copy_int (x : i32) : result i32 = Ok x (** [no_nested_borrows::test_unreachable]: - Source: 'src/no_nested_borrows.rs', lines 142:0-142:32 *) + Source: 'tests/src/no_nested_borrows.rs', lines 144:0-144:32 *) let test_unreachable (b : bool) : result unit = if b then Fail Failure else Ok () (** [no_nested_borrows::test_panic]: - Source: 'src/no_nested_borrows.rs', lines 150:0-150:26 *) + Source: 'tests/src/no_nested_borrows.rs', lines 152:0-152:26 *) let test_panic (b : bool) : result unit = if b then Fail Failure else Ok () (** [no_nested_borrows::test_copy_int]: - Source: 'src/no_nested_borrows.rs', lines 157:0-157:22 *) + Source: 'tests/src/no_nested_borrows.rs', lines 159:0-159:22 *) let test_copy_int : result unit = let* y = copy_int 0 in if not (0 = y) then Fail Failure else Ok () @@ -151,12 +151,12 @@ let test_copy_int : result unit = let _ = assert_norm (test_copy_int = Ok ()) (** [no_nested_borrows::is_cons]: - Source: 'src/no_nested_borrows.rs', lines 164:0-164:38 *) + Source: 'tests/src/no_nested_borrows.rs', lines 166:0-166:38 *) let is_cons (t : Type0) (l : list_t t) : result bool = begin match l with | List_Cons _ _ -> Ok true | List_Nil -> Ok false end (** [no_nested_borrows::test_is_cons]: - Source: 'src/no_nested_borrows.rs', lines 171:0-171:21 *) + Source: 'tests/src/no_nested_borrows.rs', lines 173:0-173:21 *) let test_is_cons : result unit = let* b = is_cons i32 (List_Cons 0 List_Nil) in if not b then Fail Failure else Ok () @@ -165,7 +165,7 @@ let test_is_cons : result unit = let _ = assert_norm (test_is_cons = Ok ()) (** [no_nested_borrows::split_list]: - Source: 'src/no_nested_borrows.rs', lines 177:0-177:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 179:0-179:48 *) let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = begin match l with | List_Cons hd tl -> Ok (hd, tl) @@ -173,7 +173,7 @@ let split_list (t : Type0) (l : list_t t) : result (t & (list_t t)) = end (** [no_nested_borrows::test_split_list]: - Source: 'src/no_nested_borrows.rs', lines 185:0-185:24 *) + Source: 'tests/src/no_nested_borrows.rs', lines 187:0-187:24 *) let test_split_list : result unit = let* p = split_list i32 (List_Cons 0 List_Nil) in let (hd, _) = p in @@ -183,7 +183,7 @@ let test_split_list : result unit = let _ = assert_norm (test_split_list = Ok ()) (** [no_nested_borrows::choose]: - Source: 'src/no_nested_borrows.rs', lines 192:0-192:70 *) + Source: 'tests/src/no_nested_borrows.rs', lines 194:0-194:70 *) let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b @@ -191,7 +191,7 @@ let choose else let back = fun ret -> Ok (x, ret) in Ok (y, back) (** [no_nested_borrows::choose_test]: - Source: 'src/no_nested_borrows.rs', lines 200:0-200:20 *) + Source: 'tests/src/no_nested_borrows.rs', lines 202:0-202:20 *) let choose_test : result unit = let* (z, choose_back) = choose i32 true 0 0 in let* z1 = i32_add z 1 in @@ -207,24 +207,24 @@ let choose_test : result unit = let _ = assert_norm (choose_test = Ok ()) (** [no_nested_borrows::test_char]: - Source: 'src/no_nested_borrows.rs', lines 212:0-212:26 *) + Source: 'tests/src/no_nested_borrows.rs', lines 214:0-214:26 *) let test_char : result char = Ok 'a' (** [no_nested_borrows::Tree] - Source: 'src/no_nested_borrows.rs', lines 217:0-217:16 *) + Source: 'tests/src/no_nested_borrows.rs', lines 219:0-219:16 *) type tree_t (t : Type0) = | Tree_Leaf : t -> tree_t t | Tree_Node : t -> nodeElem_t t -> tree_t t -> tree_t t (** [no_nested_borrows::NodeElem] - Source: 'src/no_nested_borrows.rs', lines 222:0-222:20 *) + Source: 'tests/src/no_nested_borrows.rs', lines 224:0-224:20 *) and nodeElem_t (t : Type0) = | NodeElem_Cons : tree_t t -> nodeElem_t t -> nodeElem_t t | NodeElem_Nil : nodeElem_t t (** [no_nested_borrows::list_length]: - Source: 'src/no_nested_borrows.rs', lines 257:0-257:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 259:0-259:48 *) let rec list_length (t : Type0) (l : list_t t) : result u32 = begin match l with | List_Cons _ l1 -> let* i = list_length t l1 in u32_add 1 i @@ -232,7 +232,7 @@ let rec list_length (t : Type0) (l : list_t t) : result u32 = end (** [no_nested_borrows::list_nth_shared]: - Source: 'src/no_nested_borrows.rs', lines 265:0-265:62 *) + Source: 'tests/src/no_nested_borrows.rs', lines 267:0-267:62 *) let rec list_nth_shared (t : Type0) (l : list_t t) (i : u32) : result t = begin match l with | List_Cons x tl -> @@ -241,7 +241,7 @@ let rec list_nth_shared (t : Type0) (l : list_t t) (i : u32) : result t = end (** [no_nested_borrows::list_nth_mut]: - Source: 'src/no_nested_borrows.rs', lines 281:0-281:67 *) + Source: 'tests/src/no_nested_borrows.rs', lines 283:0-283:67 *) let rec list_nth_mut (t : Type0) (l : list_t t) (i : u32) : result (t & (t -> result (list_t t))) @@ -260,7 +260,7 @@ let rec list_nth_mut end (** [no_nested_borrows::list_rev_aux]: - Source: 'src/no_nested_borrows.rs', lines 297:0-297:63 *) + Source: 'tests/src/no_nested_borrows.rs', lines 299:0-299:63 *) let rec list_rev_aux (t : Type0) (li : list_t t) (lo : list_t t) : result (list_t t) = begin match li with @@ -269,13 +269,13 @@ let rec list_rev_aux end (** [no_nested_borrows::list_rev]: - Source: 'src/no_nested_borrows.rs', lines 311:0-311:42 *) + Source: 'tests/src/no_nested_borrows.rs', lines 313:0-313:42 *) let list_rev (t : Type0) (l : list_t t) : result (list_t t) = let (li, _) = core_mem_replace (list_t t) l List_Nil in list_rev_aux t li List_Nil (** [no_nested_borrows::test_list_functions]: - Source: 'src/no_nested_borrows.rs', lines 316:0-316:28 *) + Source: 'tests/src/no_nested_borrows.rs', lines 318:0-318:28 *) let test_list_functions : result unit = let l = List_Cons 2 List_Nil in let l1 = List_Cons 1 l in @@ -312,7 +312,7 @@ let test_list_functions : result unit = let _ = assert_norm (test_list_functions = Ok ()) (** [no_nested_borrows::id_mut_pair1]: - Source: 'src/no_nested_borrows.rs', lines 332:0-332:89 *) + Source: 'tests/src/no_nested_borrows.rs', lines 334:0-334:89 *) let id_mut_pair1 (t1 t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & ((t1 & t2) -> result (t1 & t2))) @@ -320,7 +320,7 @@ let id_mut_pair1 Ok ((x, y), Ok) (** [no_nested_borrows::id_mut_pair2]: - Source: 'src/no_nested_borrows.rs', lines 336:0-336:88 *) + Source: 'tests/src/no_nested_borrows.rs', lines 338:0-338:88 *) let id_mut_pair2 (t1 t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & ((t1 & t2) -> result (t1 & t2))) @@ -328,7 +328,7 @@ let id_mut_pair2 let (x, x1) = p in Ok ((x, x1), Ok) (** [no_nested_borrows::id_mut_pair3]: - Source: 'src/no_nested_borrows.rs', lines 340:0-340:93 *) + Source: 'tests/src/no_nested_borrows.rs', lines 342:0-342:93 *) let id_mut_pair3 (t1 t2 : Type0) (x : t1) (y : t2) : result ((t1 & t2) & (t1 -> result t1) & (t2 -> result t2)) @@ -336,7 +336,7 @@ let id_mut_pair3 Ok ((x, y), Ok, Ok) (** [no_nested_borrows::id_mut_pair4]: - Source: 'src/no_nested_borrows.rs', lines 344:0-344:92 *) + Source: 'tests/src/no_nested_borrows.rs', lines 346:0-346:92 *) let id_mut_pair4 (t1 t2 : Type0) (p : (t1 & t2)) : result ((t1 & t2) & (t1 -> result t1) & (t2 -> result t2)) @@ -344,35 +344,35 @@ let id_mut_pair4 let (x, x1) = p in Ok ((x, x1), Ok, Ok) (** [no_nested_borrows::StructWithTuple] - Source: 'src/no_nested_borrows.rs', lines 351:0-351:34 *) + Source: 'tests/src/no_nested_borrows.rs', lines 353:0-353:34 *) type structWithTuple_t (t1 t2 : Type0) = { p : (t1 & t2); } (** [no_nested_borrows::new_tuple1]: - Source: 'src/no_nested_borrows.rs', lines 355:0-355:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 357:0-357:48 *) let new_tuple1 : result (structWithTuple_t u32 u32) = Ok { p = (1, 2) } (** [no_nested_borrows::new_tuple2]: - Source: 'src/no_nested_borrows.rs', lines 359:0-359:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 361:0-361:48 *) let new_tuple2 : result (structWithTuple_t i16 i16) = Ok { p = (1, 2) } (** [no_nested_borrows::new_tuple3]: - Source: 'src/no_nested_borrows.rs', lines 363:0-363:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 365:0-365:48 *) let new_tuple3 : result (structWithTuple_t u64 i64) = Ok { p = (1, 2) } (** [no_nested_borrows::StructWithPair] - Source: 'src/no_nested_borrows.rs', lines 368:0-368:33 *) + Source: 'tests/src/no_nested_borrows.rs', lines 370:0-370:33 *) type structWithPair_t (t1 t2 : Type0) = { p : pair_t t1 t2; } (** [no_nested_borrows::new_pair1]: - Source: 'src/no_nested_borrows.rs', lines 372:0-372:46 *) + Source: 'tests/src/no_nested_borrows.rs', lines 374:0-374:46 *) let new_pair1 : result (structWithPair_t u32 u32) = Ok { p = { x = 1; y = 2 } } (** [no_nested_borrows::test_constants]: - Source: 'src/no_nested_borrows.rs', lines 380:0-380:23 *) + Source: 'tests/src/no_nested_borrows.rs', lines 382:0-382:23 *) let test_constants : result unit = let* swt = new_tuple1 in let (i, _) = swt.p in @@ -396,7 +396,7 @@ let test_constants : result unit = let _ = assert_norm (test_constants = Ok ()) (** [no_nested_borrows::test_weird_borrows1]: - Source: 'src/no_nested_borrows.rs', lines 389:0-389:28 *) + Source: 'tests/src/no_nested_borrows.rs', lines 391:0-391:28 *) let test_weird_borrows1 : result unit = Ok () @@ -404,71 +404,71 @@ let test_weird_borrows1 : result unit = let _ = assert_norm (test_weird_borrows1 = Ok ()) (** [no_nested_borrows::test_mem_replace]: - Source: 'src/no_nested_borrows.rs', lines 399:0-399:37 *) + Source: 'tests/src/no_nested_borrows.rs', lines 401:0-401:37 *) let test_mem_replace (px : u32) : result u32 = let (y, _) = core_mem_replace u32 px 1 in if not (y = 0) then Fail Failure else Ok 2 (** [no_nested_borrows::test_shared_borrow_bool1]: - Source: 'src/no_nested_borrows.rs', lines 406:0-406:47 *) + Source: 'tests/src/no_nested_borrows.rs', lines 408:0-408:47 *) let test_shared_borrow_bool1 (b : bool) : result u32 = if b then Ok 0 else Ok 1 (** [no_nested_borrows::test_shared_borrow_bool2]: - Source: 'src/no_nested_borrows.rs', lines 419:0-419:40 *) + Source: 'tests/src/no_nested_borrows.rs', lines 421:0-421:40 *) let test_shared_borrow_bool2 : result u32 = Ok 0 (** [no_nested_borrows::test_shared_borrow_enum1]: - Source: 'src/no_nested_borrows.rs', lines 434:0-434:52 *) + Source: 'tests/src/no_nested_borrows.rs', lines 436:0-436:52 *) let test_shared_borrow_enum1 (l : list_t u32) : result u32 = begin match l with | List_Cons _ _ -> Ok 1 | List_Nil -> Ok 0 end (** [no_nested_borrows::test_shared_borrow_enum2]: - Source: 'src/no_nested_borrows.rs', lines 446:0-446:40 *) + Source: 'tests/src/no_nested_borrows.rs', lines 448:0-448:40 *) let test_shared_borrow_enum2 : result u32 = Ok 0 (** [no_nested_borrows::incr]: - Source: 'src/no_nested_borrows.rs', lines 457:0-457:24 *) + Source: 'tests/src/no_nested_borrows.rs', lines 459:0-459:24 *) let incr (x : u32) : result u32 = u32_add x 1 (** [no_nested_borrows::call_incr]: - Source: 'src/no_nested_borrows.rs', lines 461:0-461:35 *) + Source: 'tests/src/no_nested_borrows.rs', lines 463:0-463:35 *) let call_incr (x : u32) : result u32 = incr x (** [no_nested_borrows::read_then_incr]: - Source: 'src/no_nested_borrows.rs', lines 466:0-466:41 *) + Source: 'tests/src/no_nested_borrows.rs', lines 468:0-468:41 *) let read_then_incr (x : u32) : result (u32 & u32) = let* x1 = u32_add x 1 in Ok (x, x1) (** [no_nested_borrows::Tuple] - Source: 'src/no_nested_borrows.rs', lines 472:0-472:24 *) + Source: 'tests/src/no_nested_borrows.rs', lines 474:0-474:24 *) type tuple_t (t1 t2 : Type0) = t1 * t2 (** [no_nested_borrows::use_tuple_struct]: - Source: 'src/no_nested_borrows.rs', lines 474:0-474:48 *) + Source: 'tests/src/no_nested_borrows.rs', lines 476:0-476:48 *) let use_tuple_struct (x : tuple_t u32 u32) : result (tuple_t u32 u32) = let (_, i) = x in Ok (1, i) (** [no_nested_borrows::create_tuple_struct]: - Source: 'src/no_nested_borrows.rs', lines 478:0-478:61 *) + Source: 'tests/src/no_nested_borrows.rs', lines 480:0-480:61 *) let create_tuple_struct (x : u32) (y : u64) : result (tuple_t u32 u64) = Ok (x, y) (** [no_nested_borrows::IdType] - Source: 'src/no_nested_borrows.rs', lines 483:0-483:20 *) + Source: 'tests/src/no_nested_borrows.rs', lines 485:0-485:20 *) type idType_t (t : Type0) = t (** [no_nested_borrows::use_id_type]: - Source: 'src/no_nested_borrows.rs', lines 485:0-485:40 *) + Source: 'tests/src/no_nested_borrows.rs', lines 487:0-487:40 *) let use_id_type (t : Type0) (x : idType_t t) : result t = Ok x (** [no_nested_borrows::create_id_type]: - Source: 'src/no_nested_borrows.rs', lines 489:0-489:43 *) + Source: 'tests/src/no_nested_borrows.rs', lines 491:0-491:43 *) let create_id_type (t : Type0) (x : t) : result (idType_t t) = Ok x diff --git a/tests/fstar/misc/Paper.fst b/tests/fstar/misc/Paper.fst index e6b4eb25..c78293f1 100644 --- a/tests/fstar/misc/Paper.fst +++ b/tests/fstar/misc/Paper.fst @@ -6,12 +6,12 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [paper::ref_incr]: - Source: 'src/paper.rs', lines 4:0-4:28 *) + Source: 'tests/src/paper.rs', lines 6:0-6:28 *) let ref_incr (x : i32) : result i32 = i32_add x 1 (** [paper::test_incr]: - Source: 'src/paper.rs', lines 8:0-8:18 *) + Source: 'tests/src/paper.rs', lines 10:0-10:18 *) let test_incr : result unit = let* x = ref_incr 0 in if not (x = 1) then Fail Failure else Ok () @@ -19,7 +19,7 @@ let test_incr : result unit = let _ = assert_norm (test_incr = Ok ()) (** [paper::choose]: - Source: 'src/paper.rs', lines 15:0-15:70 *) + Source: 'tests/src/paper.rs', lines 17:0-17:70 *) let choose (t : Type0) (b : bool) (x : t) (y : t) : result (t & (t -> result (t & t))) = if b @@ -27,7 +27,7 @@ let choose else let back = fun ret -> Ok (x, ret) in Ok (y, back) (** [paper::test_choose]: - Source: 'src/paper.rs', lines 23:0-23:20 *) + Source: 'tests/src/paper.rs', lines 25:0-25:20 *) let test_choose : result unit = let* (z, choose_back) = choose i32 true 0 0 in let* z1 = i32_add z 1 in @@ -43,13 +43,13 @@ let test_choose : result unit = let _ = assert_norm (test_choose = Ok ()) (** [paper::List] - Source: 'src/paper.rs', lines 35:0-35:16 *) + Source: 'tests/src/paper.rs', lines 37:0-37:16 *) type list_t (t : Type0) = | List_Cons : t -> list_t t -> list_t t | List_Nil : list_t t (** [paper::list_nth_mut]: - Source: 'src/paper.rs', lines 42:0-42:67 *) + Source: 'tests/src/paper.rs', lines 44:0-44:67 *) let rec list_nth_mut (t : Type0) (l : list_t t) (i : u32) : result (t & (t -> result (list_t t))) @@ -68,7 +68,7 @@ let rec list_nth_mut end (** [paper::sum]: - Source: 'src/paper.rs', lines 57:0-57:32 *) + Source: 'tests/src/paper.rs', lines 59:0-59:32 *) let rec sum (l : list_t i32) : result i32 = begin match l with | List_Cons x tl -> let* i = sum tl in i32_add x i @@ -76,7 +76,7 @@ let rec sum (l : list_t i32) : result i32 = end (** [paper::test_nth]: - Source: 'src/paper.rs', lines 68:0-68:17 *) + Source: 'tests/src/paper.rs', lines 70:0-70:17 *) let test_nth : result unit = let l = List_Cons 3 List_Nil in let l1 = List_Cons 2 l in @@ -90,7 +90,7 @@ let test_nth : result unit = let _ = assert_norm (test_nth = Ok ()) (** [paper::call_choose]: - Source: 'src/paper.rs', lines 76:0-76:44 *) + Source: 'tests/src/paper.rs', lines 78:0-78:44 *) let call_choose (p : (u32 & u32)) : result u32 = let (px, py) = p in let* (pz, choose_back) = choose u32 true px py in diff --git a/tests/fstar/misc/PoloniusList.fst b/tests/fstar/misc/PoloniusList.fst index c0bc592e..94c1b445 100644 --- a/tests/fstar/misc/PoloniusList.fst +++ b/tests/fstar/misc/PoloniusList.fst @@ -6,13 +6,13 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** [polonius_list::List] - Source: 'src/polonius_list.rs', lines 3:0-3:16 *) + Source: 'tests/src/polonius_list.rs', lines 5:0-5:16 *) type list_t (t : Type0) = | List_Cons : t -> list_t t -> list_t t | List_Nil : list_t t (** [polonius_list::get_list_at_x]: - Source: 'src/polonius_list.rs', lines 13:0-13:76 *) + Source: 'tests/src/polonius_list.rs', lines 15:0-15:76 *) let rec get_list_at_x (ls : list_t u32) (x : u32) : result ((list_t u32) & (list_t u32 -> result (list_t u32))) diff --git a/tests/fstar/traits/Traits.fst b/tests/fstar/traits/Traits.fst index 0904e506..70c345ba 100644 --- a/tests/fstar/traits/Traits.fst +++ b/tests/fstar/traits/Traits.fst @@ -6,20 +6,20 @@ open Primitives #set-options "--z3rlimit 50 --fuel 1 --ifuel 1" (** Trait declaration: [traits::BoolTrait] - Source: 'src/traits.rs', lines 1:0-1:19 *) + Source: 'tests/src/traits.rs', lines 2:0-2:19 *) noeq type boolTrait_t (self : Type0) = { get_bool : self -> result bool; } (** [traits::{(traits::BoolTrait for bool)}::get_bool]: - Source: 'src/traits.rs', lines 12:4-12:30 *) + Source: 'tests/src/traits.rs', lines 13:4-13:30 *) let boolTraitBool_get_bool (self : bool) : result bool = Ok self (** Trait implementation: [traits::{(traits::BoolTrait for bool)}] - Source: 'src/traits.rs', lines 11:0-11:23 *) + Source: 'tests/src/traits.rs', lines 12:0-12:23 *) let boolTraitBool : boolTrait_t bool = { get_bool = boolTraitBool_get_bool; } (** [traits::BoolTrait::ret_true]: - Source: 'src/traits.rs', lines 6:4-6:30 *) + Source: 'tests/src/traits.rs', lines 7:4-7:30 *) let boolTrait_ret_true (#self : Type0) (self_clause : boolTrait_t self) (self1 : self) : result bool @@ -27,49 +27,49 @@ let boolTrait_ret_true Ok true (** [traits::test_bool_trait_bool]: - Source: 'src/traits.rs', lines 17:0-17:44 *) + Source: 'tests/src/traits.rs', lines 18:0-18:44 *) let test_bool_trait_bool (x : bool) : result bool = let* b = boolTraitBool_get_bool x in if b then boolTrait_ret_true boolTraitBool x else Ok false (** [traits::{(traits::BoolTrait for core::option::Option<T>)#1}::get_bool]: - Source: 'src/traits.rs', lines 23:4-23:30 *) + Source: 'tests/src/traits.rs', lines 24:4-24:30 *) let boolTraitOption_get_bool (t : Type0) (self : option t) : result bool = begin match self with | None -> Ok false | Some _ -> Ok true end (** Trait implementation: [traits::{(traits::BoolTrait for core::option::Option<T>)#1}] - Source: 'src/traits.rs', lines 22:0-22:31 *) + Source: 'tests/src/traits.rs', lines 23:0-23:31 *) let boolTraitOption (t : Type0) : boolTrait_t (option t) = { get_bool = boolTraitOption_get_bool t; } (** [traits::test_bool_trait_option]: - Source: 'src/traits.rs', lines 31:0-31:54 *) + Source: 'tests/src/traits.rs', lines 32:0-32:54 *) let test_bool_trait_option (t : Type0) (x : option t) : result bool = let* b = boolTraitOption_get_bool t x in if b then boolTrait_ret_true (boolTraitOption t) x else Ok false (** [traits::test_bool_trait]: - Source: 'src/traits.rs', lines 35:0-35:50 *) + Source: 'tests/src/traits.rs', lines 36:0-36:50 *) let test_bool_trait (t : Type0) (boolTraitInst : boolTrait_t t) (x : t) : result bool = boolTraitInst.get_bool x (** Trait declaration: [traits::ToU64] - Source: 'src/traits.rs', lines 39:0-39:15 *) + Source: 'tests/src/traits.rs', lines 40:0-40:15 *) noeq type toU64_t (self : Type0) = { to_u64 : self -> result u64; } (** [traits::{(traits::ToU64 for u64)#2}::to_u64]: - Source: 'src/traits.rs', lines 44:4-44:26 *) + Source: 'tests/src/traits.rs', lines 45:4-45:26 *) let toU64U64_to_u64 (self : u64) : result u64 = Ok self (** Trait implementation: [traits::{(traits::ToU64 for u64)#2}] - Source: 'src/traits.rs', lines 43:0-43:18 *) + Source: 'tests/src/traits.rs', lines 44:0-44:18 *) let toU64U64 : toU64_t u64 = { to_u64 = toU64U64_to_u64; } (** [traits::{(traits::ToU64 for (A, A))#3}::to_u64]: - Source: 'src/traits.rs', lines 50:4-50:26 *) + Source: 'tests/src/traits.rs', lines 51:4-51:26 *) let toU64Pair_to_u64 (a : Type0) (toU64Inst : toU64_t a) (self : (a & a)) : result u64 = let (x, x1) = self in @@ -78,75 +78,75 @@ let toU64Pair_to_u64 u64_add i i1 (** Trait implementation: [traits::{(traits::ToU64 for (A, A))#3}] - Source: 'src/traits.rs', lines 49:0-49:31 *) + Source: 'tests/src/traits.rs', lines 50:0-50:31 *) let toU64Pair (a : Type0) (toU64Inst : toU64_t a) : toU64_t (a & a) = { to_u64 = toU64Pair_to_u64 a toU64Inst; } (** [traits::f]: - Source: 'src/traits.rs', lines 55:0-55:36 *) + Source: 'tests/src/traits.rs', lines 56:0-56:36 *) let f (t : Type0) (toU64Inst : toU64_t t) (x : (t & t)) : result u64 = toU64Pair_to_u64 t toU64Inst x (** [traits::g]: - Source: 'src/traits.rs', lines 59:0-61:18 *) + Source: 'tests/src/traits.rs', lines 60:0-62:18 *) let g (t : Type0) (toU64PairInst : toU64_t (t & t)) (x : (t & t)) : result u64 = toU64PairInst.to_u64 x (** [traits::h0]: - Source: 'src/traits.rs', lines 66:0-66:24 *) + Source: 'tests/src/traits.rs', lines 67:0-67:24 *) let h0 (x : u64) : result u64 = toU64U64_to_u64 x (** [traits::Wrapper] - Source: 'src/traits.rs', lines 70:0-70:21 *) + Source: 'tests/src/traits.rs', lines 71:0-71:21 *) type wrapper_t (t : Type0) = { x : t; } (** [traits::{(traits::ToU64 for traits::Wrapper<T>)#4}::to_u64]: - Source: 'src/traits.rs', lines 75:4-75:26 *) + Source: 'tests/src/traits.rs', lines 76:4-76:26 *) let toU64traitsWrapper_to_u64 (t : Type0) (toU64Inst : toU64_t t) (self : wrapper_t t) : result u64 = toU64Inst.to_u64 self.x (** Trait implementation: [traits::{(traits::ToU64 for traits::Wrapper<T>)#4}] - Source: 'src/traits.rs', lines 74:0-74:35 *) + Source: 'tests/src/traits.rs', lines 75:0-75:35 *) let toU64traitsWrapper (t : Type0) (toU64Inst : toU64_t t) : toU64_t (wrapper_t t) = { to_u64 = toU64traitsWrapper_to_u64 t toU64Inst; } (** [traits::h1]: - Source: 'src/traits.rs', lines 80:0-80:33 *) + Source: 'tests/src/traits.rs', lines 81:0-81:33 *) let h1 (x : wrapper_t u64) : result u64 = toU64traitsWrapper_to_u64 u64 toU64U64 x (** [traits::h2]: - Source: 'src/traits.rs', lines 84:0-84:41 *) + Source: 'tests/src/traits.rs', lines 85:0-85:41 *) let h2 (t : Type0) (toU64Inst : toU64_t t) (x : wrapper_t t) : result u64 = toU64traitsWrapper_to_u64 t toU64Inst x (** Trait declaration: [traits::ToType] - Source: 'src/traits.rs', lines 88:0-88:19 *) + Source: 'tests/src/traits.rs', lines 89:0-89:19 *) noeq type toType_t (self t : Type0) = { to_type : self -> result t; } (** [traits::{(traits::ToType<bool> for u64)#5}::to_type]: - Source: 'src/traits.rs', lines 93:4-93:28 *) + Source: 'tests/src/traits.rs', lines 94:4-94:28 *) let toTypeU64Bool_to_type (self : u64) : result bool = Ok (self > 0) (** Trait implementation: [traits::{(traits::ToType<bool> for u64)#5}] - Source: 'src/traits.rs', lines 92:0-92:25 *) + Source: 'tests/src/traits.rs', lines 93:0-93:25 *) let toTypeU64Bool : toType_t u64 bool = { to_type = toTypeU64Bool_to_type; } (** Trait declaration: [traits::OfType] - Source: 'src/traits.rs', lines 98:0-98:16 *) + Source: 'tests/src/traits.rs', lines 99:0-99:16 *) noeq type ofType_t (self : Type0) = { of_type : (t : Type0) -> (toTypeInst : toType_t t self) -> t -> result self; } (** [traits::h3]: - Source: 'src/traits.rs', lines 104:0-104:50 *) + Source: 'tests/src/traits.rs', lines 105:0-105:50 *) let h3 (t1 t2 : Type0) (ofTypeInst : ofType_t t1) (toTypeInst : toType_t t2 t1) (y : t2) : @@ -155,14 +155,14 @@ let h3 ofTypeInst.of_type t2 toTypeInst y (** Trait declaration: [traits::OfTypeBis] - Source: 'src/traits.rs', lines 109:0-109:36 *) + Source: 'tests/src/traits.rs', lines 110:0-110:36 *) noeq type ofTypeBis_t (self t : Type0) = { toTypeInst : toType_t t self; of_type : t -> result self; } (** [traits::h4]: - Source: 'src/traits.rs', lines 118:0-118:57 *) + Source: 'tests/src/traits.rs', lines 119:0-119:57 *) let h4 (t1 t2 : Type0) (ofTypeBisInst : ofTypeBis_t t1 t2) (toTypeInst : toType_t t2 t1) (y : t2) : @@ -171,34 +171,34 @@ let h4 ofTypeBisInst.of_type y (** [traits::TestType] - Source: 'src/traits.rs', lines 122:0-122:22 *) + Source: 'tests/src/traits.rs', lines 123:0-123:22 *) type testType_t (t : Type0) = t (** [traits::{traits::TestType<T>#6}::test::TestType1] - Source: 'src/traits.rs', lines 127:8-127:24 *) + Source: 'tests/src/traits.rs', lines 128:8-128:24 *) type testType_test_TestType1_t = u64 (** Trait declaration: [traits::{traits::TestType<T>#6}::test::TestTrait] - Source: 'src/traits.rs', lines 128:8-128:23 *) + Source: 'tests/src/traits.rs', lines 129:8-129:23 *) noeq type testType_test_TestTrait_t (self : Type0) = { test : self -> result bool; } (** [traits::{traits::TestType<T>#6}::test::{(traits::{traits::TestType<T>#6}::test::TestTrait for traits::{traits::TestType<T>#6}::test::TestType1)}::test]: - Source: 'src/traits.rs', lines 139:12-139:34 *) + Source: 'tests/src/traits.rs', lines 140:12-140:34 *) let testType_test_TestTraittraitsTestTypetestTestType1_test (self : testType_test_TestType1_t) : result bool = Ok (self > 1) (** Trait implementation: [traits::{traits::TestType<T>#6}::test::{(traits::{traits::TestType<T>#6}::test::TestTrait for traits::{traits::TestType<T>#6}::test::TestType1)}] - Source: 'src/traits.rs', lines 138:8-138:36 *) + Source: 'tests/src/traits.rs', lines 139:8-139:36 *) let testType_test_TestTraittraitsTestTypetestTestType1 : testType_test_TestTrait_t testType_test_TestType1_t = { test = testType_test_TestTraittraitsTestTypetestTestType1_test; } (** [traits::{traits::TestType<T>#6}::test]: - Source: 'src/traits.rs', lines 126:4-126:36 *) + Source: 'tests/src/traits.rs', lines 127:4-127:36 *) let testType_test (t : Type0) (toU64Inst : toU64_t t) (self : testType_t t) (x : t) : result bool @@ -209,11 +209,11 @@ let testType_test else Ok false (** [traits::BoolWrapper] - Source: 'src/traits.rs', lines 150:0-150:22 *) + Source: 'tests/src/traits.rs', lines 151:0-151:22 *) type boolWrapper_t = bool (** [traits::{(traits::ToType<T> for traits::BoolWrapper)#7}::to_type]: - Source: 'src/traits.rs', lines 156:4-156:25 *) + Source: 'tests/src/traits.rs', lines 157:4-157:25 *) let toTypetraitsBoolWrapperT_to_type (t : Type0) (toTypeBoolTInst : toType_t bool t) (self : boolWrapper_t) : result t @@ -221,14 +221,14 @@ let toTypetraitsBoolWrapperT_to_type toTypeBoolTInst.to_type self (** Trait implementation: [traits::{(traits::ToType<T> for traits::BoolWrapper)#7}] - Source: 'src/traits.rs', lines 152:0-152:33 *) + Source: 'tests/src/traits.rs', lines 153:0-153:33 *) let toTypetraitsBoolWrapperT (t : Type0) (toTypeBoolTInst : toType_t bool t) : toType_t boolWrapper_t t = { to_type = toTypetraitsBoolWrapperT_to_type t toTypeBoolTInst; } (** [traits::WithConstTy::LEN2] - Source: 'src/traits.rs', lines 164:4-164:21 *) + Source: 'tests/src/traits.rs', lines 165:4-165:21 *) let with_const_ty_len2_default_body (self : Type0) (len : usize) : result usize = Ok 32 @@ -236,7 +236,7 @@ let with_const_ty_len2_default (self : Type0) (len : usize) : usize = eval_global (with_const_ty_len2_default_body self len) (** Trait declaration: [traits::WithConstTy] - Source: 'src/traits.rs', lines 161:0-161:39 *) + Source: 'tests/src/traits.rs', lines 162:0-162:39 *) noeq type withConstTy_t (self : Type0) (len : usize) = { cLEN1 : usize; cLEN2 : usize; @@ -247,18 +247,18 @@ noeq type withConstTy_t (self : Type0) (len : usize) = { } (** [traits::{(traits::WithConstTy<32: usize> for bool)#8}::LEN1] - Source: 'src/traits.rs', lines 175:4-175:21 *) + Source: 'tests/src/traits.rs', lines 176:4-176:21 *) let with_const_ty_bool32_len1_body : result usize = Ok 12 let with_const_ty_bool32_len1 : usize = eval_global with_const_ty_bool32_len1_body (** [traits::{(traits::WithConstTy<32: usize> for bool)#8}::f]: - Source: 'src/traits.rs', lines 180:4-180:39 *) + Source: 'tests/src/traits.rs', lines 181:4-181:39 *) let withConstTyBool32_f (i : u64) (a : array u8 32) : result u64 = Ok i (** Trait implementation: [traits::{(traits::WithConstTy<32: usize> for bool)#8}] - Source: 'src/traits.rs', lines 174:0-174:29 *) + Source: 'tests/src/traits.rs', lines 175:0-175:29 *) let withConstTyBool32 : withConstTy_t bool 32 = { cLEN1 = with_const_ty_bool32_len1; cLEN2 = with_const_ty_len2_default bool 32; @@ -269,7 +269,7 @@ let withConstTyBool32 : withConstTy_t bool 32 = { } (** [traits::use_with_const_ty1]: - Source: 'src/traits.rs', lines 183:0-183:75 *) + Source: 'tests/src/traits.rs', lines 184:0-184:75 *) let use_with_const_ty1 (h : Type0) (len : usize) (withConstTyInst : withConstTy_t h len) : result usize @@ -277,7 +277,7 @@ let use_with_const_ty1 Ok withConstTyInst.cLEN1 (** [traits::use_with_const_ty2]: - Source: 'src/traits.rs', lines 187:0-187:73 *) + Source: 'tests/src/traits.rs', lines 188:0-188:73 *) let use_with_const_ty2 (h : Type0) (len : usize) (withConstTyInst : withConstTy_t h len) (w : withConstTyInst.tW) : @@ -286,7 +286,7 @@ let use_with_const_ty2 Ok () (** [traits::use_with_const_ty3]: - Source: 'src/traits.rs', lines 189:0-189:80 *) + Source: 'tests/src/traits.rs', lines 190:0-190:80 *) let use_with_const_ty3 (h : Type0) (len : usize) (withConstTyInst : withConstTy_t h len) (x : withConstTyInst.tW) : @@ -295,12 +295,12 @@ let use_with_const_ty3 withConstTyInst.tW_clause_0.to_u64 x (** [traits::test_where1]: - Source: 'src/traits.rs', lines 193:0-193:40 *) + Source: 'tests/src/traits.rs', lines 194:0-194:40 *) let test_where1 (t : Type0) (_x : t) : result unit = Ok () (** [traits::test_where2]: - Source: 'src/traits.rs', lines 194:0-194:57 *) + Source: 'tests/src/traits.rs', lines 195:0-195:57 *) let test_where2 (t : Type0) (withConstTyT32Inst : withConstTy_t t 32) (_x : u32) : result unit @@ -308,7 +308,7 @@ let test_where2 Ok () (** Trait declaration: [traits::ParentTrait0] - Source: 'src/traits.rs', lines 200:0-200:22 *) + Source: 'tests/src/traits.rs', lines 201:0-201:22 *) noeq type parentTrait0_t (self : Type0) = { tW : Type0; get_name : self -> result string; @@ -316,24 +316,24 @@ noeq type parentTrait0_t (self : Type0) = { } (** Trait declaration: [traits::ParentTrait1] - Source: 'src/traits.rs', lines 205:0-205:22 *) + Source: 'tests/src/traits.rs', lines 206:0-206:22 *) type parentTrait1_t (self : Type0) = unit (** Trait declaration: [traits::ChildTrait] - Source: 'src/traits.rs', lines 206:0-206:49 *) + Source: 'tests/src/traits.rs', lines 207:0-207:49 *) noeq type childTrait_t (self : Type0) = { parentTrait0Inst : parentTrait0_t self; parentTrait1Inst : parentTrait1_t self; } (** [traits::test_child_trait1]: - Source: 'src/traits.rs', lines 209:0-209:56 *) + Source: 'tests/src/traits.rs', lines 210:0-210:56 *) let test_child_trait1 (t : Type0) (childTraitInst : childTrait_t t) (x : t) : result string = childTraitInst.parentTrait0Inst.get_name x (** [traits::test_child_trait2]: - Source: 'src/traits.rs', lines 213:0-213:54 *) + Source: 'tests/src/traits.rs', lines 214:0-214:54 *) let test_child_trait2 (t : Type0) (childTraitInst : childTrait_t t) (x : t) : result childTraitInst.parentTrait0Inst.tW @@ -341,7 +341,7 @@ let test_child_trait2 childTraitInst.parentTrait0Inst.get_w x (** [traits::order1]: - Source: 'src/traits.rs', lines 219:0-219:59 *) + Source: 'tests/src/traits.rs', lines 220:0-220:59 *) let order1 (t u : Type0) (parentTrait0Inst : parentTrait0_t t) (parentTrait0Inst1 : parentTrait0_t u) : @@ -350,27 +350,27 @@ let order1 Ok () (** Trait declaration: [traits::ChildTrait1] - Source: 'src/traits.rs', lines 222:0-222:35 *) + Source: 'tests/src/traits.rs', lines 223:0-223:35 *) noeq type childTrait1_t (self : Type0) = { parentTrait1Inst : parentTrait1_t self; } (** Trait implementation: [traits::{(traits::ParentTrait1 for usize)#9}] - Source: 'src/traits.rs', lines 224:0-224:27 *) + Source: 'tests/src/traits.rs', lines 225:0-225:27 *) let parentTrait1Usize : parentTrait1_t usize = () (** Trait implementation: [traits::{(traits::ChildTrait1 for usize)#10}] - Source: 'src/traits.rs', lines 225:0-225:26 *) + Source: 'tests/src/traits.rs', lines 226:0-226:26 *) let childTrait1Usize : childTrait1_t usize = { parentTrait1Inst = parentTrait1Usize; } (** Trait declaration: [traits::Iterator] - Source: 'src/traits.rs', lines 229:0-229:18 *) + Source: 'tests/src/traits.rs', lines 230:0-230:18 *) noeq type iterator_t (self : Type0) = { tItem : Type0; } (** Trait declaration: [traits::IntoIterator] - Source: 'src/traits.rs', lines 233:0-233:22 *) + Source: 'tests/src/traits.rs', lines 234:0-234:22 *) noeq type intoIterator_t (self : Type0) = { tItem : Type0; tIntoIter : Type0; @@ -379,107 +379,107 @@ noeq type intoIterator_t (self : Type0) = { } (** Trait declaration: [traits::FromResidual] - Source: 'src/traits.rs', lines 250:0-250:21 *) + Source: 'tests/src/traits.rs', lines 251:0-251:21 *) type fromResidual_t (self t : Type0) = unit (** Trait declaration: [traits::Try] - Source: 'src/traits.rs', lines 246:0-246:48 *) + Source: 'tests/src/traits.rs', lines 247:0-247:48 *) noeq type try_t (self : Type0) = { tResidual : Type0; fromResidualSelftraitsTryResidualInst : fromResidual_t self tResidual; } (** Trait declaration: [traits::WithTarget] - Source: 'src/traits.rs', lines 252:0-252:20 *) + Source: 'tests/src/traits.rs', lines 253:0-253:20 *) noeq type withTarget_t (self : Type0) = { tTarget : Type0; } (** Trait declaration: [traits::ParentTrait2] - Source: 'src/traits.rs', lines 256:0-256:22 *) + Source: 'tests/src/traits.rs', lines 257:0-257:22 *) noeq type parentTrait2_t (self : Type0) = { tU : Type0; tU_clause_0 : withTarget_t tU; } (** Trait declaration: [traits::ChildTrait2] - Source: 'src/traits.rs', lines 260:0-260:35 *) + Source: 'tests/src/traits.rs', lines 261:0-261:35 *) noeq type childTrait2_t (self : Type0) = { parentTrait2Inst : parentTrait2_t self; convert : parentTrait2Inst.tU -> result parentTrait2Inst.tU_clause_0.tTarget; } (** Trait implementation: [traits::{(traits::WithTarget for u32)#11}] - Source: 'src/traits.rs', lines 264:0-264:23 *) + Source: 'tests/src/traits.rs', lines 265:0-265:23 *) let withTargetU32 : withTarget_t u32 = { tTarget = u32; } (** Trait implementation: [traits::{(traits::ParentTrait2 for u32)#12}] - Source: 'src/traits.rs', lines 268:0-268:25 *) + Source: 'tests/src/traits.rs', lines 269:0-269:25 *) let parentTrait2U32 : parentTrait2_t u32 = { tU = u32; tU_clause_0 = withTargetU32; } (** [traits::{(traits::ChildTrait2 for u32)#13}::convert]: - Source: 'src/traits.rs', lines 273:4-273:29 *) + Source: 'tests/src/traits.rs', lines 274:4-274:29 *) let childTrait2U32_convert (x : u32) : result u32 = Ok x (** Trait implementation: [traits::{(traits::ChildTrait2 for u32)#13}] - Source: 'src/traits.rs', lines 272:0-272:24 *) + Source: 'tests/src/traits.rs', lines 273:0-273:24 *) let childTrait2U32 : childTrait2_t u32 = { parentTrait2Inst = parentTrait2U32; convert = childTrait2U32_convert; } (** Trait declaration: [traits::CFnOnce] - Source: 'src/traits.rs', lines 286:0-286:23 *) + Source: 'tests/src/traits.rs', lines 287:0-287:23 *) noeq type cFnOnce_t (self args : Type0) = { tOutput : Type0; call_once : self -> args -> result tOutput; } (** Trait declaration: [traits::CFnMut] - Source: 'src/traits.rs', lines 292:0-292:37 *) + Source: 'tests/src/traits.rs', lines 293:0-293:37 *) noeq type cFnMut_t (self args : Type0) = { cFnOnceInst : cFnOnce_t self args; call_mut : self -> args -> result (cFnOnceInst.tOutput & self); } (** Trait declaration: [traits::CFn] - Source: 'src/traits.rs', lines 296:0-296:33 *) + Source: 'tests/src/traits.rs', lines 297:0-297:33 *) noeq type cFn_t (self args : Type0) = { cFnMutInst : cFnMut_t self args; call : self -> args -> result cFnMutInst.cFnOnceInst.tOutput; } (** Trait declaration: [traits::GetTrait] - Source: 'src/traits.rs', lines 300:0-300:18 *) + Source: 'tests/src/traits.rs', lines 301:0-301:18 *) noeq type getTrait_t (self : Type0) = { tW : Type0; get_w : self -> result tW; } (** [traits::test_get_trait]: - Source: 'src/traits.rs', lines 305:0-305:49 *) + Source: 'tests/src/traits.rs', lines 306:0-306:49 *) let test_get_trait (t : Type0) (getTraitInst : getTrait_t t) (x : t) : result getTraitInst.tW = getTraitInst.get_w x (** Trait declaration: [traits::Trait] - Source: 'src/traits.rs', lines 310:0-310:15 *) + Source: 'tests/src/traits.rs', lines 311:0-311:15 *) noeq type trait_t (self : Type0) = { cLEN : usize; } (** [traits::{(traits::Trait for @Array<T, N>)#14}::LEN] - Source: 'src/traits.rs', lines 315:4-315:20 *) + Source: 'tests/src/traits.rs', lines 316:4-316:20 *) let trait_array_len_body (t : Type0) (n : usize) : result usize = Ok n let trait_array_len (t : Type0) (n : usize) : usize = eval_global (trait_array_len_body t n) (** Trait implementation: [traits::{(traits::Trait for @Array<T, N>)#14}] - Source: 'src/traits.rs', lines 314:0-314:40 *) + Source: 'tests/src/traits.rs', lines 315:0-315:40 *) let traitArray (t : Type0) (n : usize) : trait_t (array t n) = { cLEN = trait_array_len t n; } (** [traits::{(traits::Trait for traits::Wrapper<T>)#15}::LEN] - Source: 'src/traits.rs', lines 319:4-319:20 *) + Source: 'tests/src/traits.rs', lines 320:4-320:20 *) let traittraits_wrapper_len_body (t : Type0) (traitInst : trait_t t) : result usize = Ok 0 @@ -487,19 +487,19 @@ let traittraits_wrapper_len (t : Type0) (traitInst : trait_t t) : usize = eval_global (traittraits_wrapper_len_body t traitInst) (** Trait implementation: [traits::{(traits::Trait for traits::Wrapper<T>)#15}] - Source: 'src/traits.rs', lines 318:0-318:35 *) + Source: 'tests/src/traits.rs', lines 319:0-319:35 *) let traittraitsWrapper (t : Type0) (traitInst : trait_t t) : trait_t (wrapper_t t) = { cLEN = traittraits_wrapper_len t traitInst; } (** [traits::use_wrapper_len]: - Source: 'src/traits.rs', lines 322:0-322:43 *) + Source: 'tests/src/traits.rs', lines 323:0-323:43 *) let use_wrapper_len (t : Type0) (traitInst : trait_t t) : result usize = Ok (traittraitsWrapper t traitInst).cLEN (** [traits::Foo] - Source: 'src/traits.rs', lines 326:0-326:20 *) + Source: 'tests/src/traits.rs', lines 327:0-327:20 *) type foo_t (t u : Type0) = { x : t; y : u; } (** [core::result::Result] @@ -510,7 +510,7 @@ type core_result_Result_t (t e : Type0) = | Core_result_Result_Err : e -> core_result_Result_t t e (** [traits::{traits::Foo<T, U>#16}::FOO] - Source: 'src/traits.rs', lines 332:4-332:33 *) + Source: 'tests/src/traits.rs', lines 333:4-333:33 *) let foo_foo_body (t u : Type0) (traitInst : trait_t t) : result (core_result_Result_t t i32) = Ok (Core_result_Result_Err 0) @@ -519,13 +519,13 @@ let foo_foo (t u : Type0) (traitInst : trait_t t) eval_global (foo_foo_body t u traitInst) (** [traits::use_foo1]: - Source: 'src/traits.rs', lines 335:0-335:48 *) + Source: 'tests/src/traits.rs', lines 336:0-336:48 *) let use_foo1 (t u : Type0) (traitInst : trait_t t) : result (core_result_Result_t t i32) = Ok (foo_foo t u traitInst) (** [traits::use_foo2]: - Source: 'src/traits.rs', lines 339:0-339:48 *) + Source: 'tests/src/traits.rs', lines 340:0-340:48 *) let use_foo2 (t u : Type0) (traitInst : trait_t u) : result (core_result_Result_t u i32) = Ok (foo_foo u t traitInst) diff --git a/tests/lean/Arrays.lean b/tests/lean/Arrays.lean index d606640a..c2c3ac90 100644 --- a/tests/lean/Arrays.lean +++ b/tests/lean/Arrays.lean @@ -6,24 +6,24 @@ open Primitives namespace arrays /- [arrays::AB] - Source: 'src/arrays.rs', lines 3:0-3:11 -/ + Source: 'tests/src/arrays.rs', lines 6:0-6:11 -/ inductive AB := | A : AB | B : AB /- [arrays::incr]: - Source: 'src/arrays.rs', lines 8:0-8:24 -/ + Source: 'tests/src/arrays.rs', lines 11:0-11:24 -/ def incr (x : U32) : Result U32 := x + 1#u32 /- [arrays::array_to_shared_slice_]: - Source: 'src/arrays.rs', lines 16:0-16:53 -/ + Source: 'tests/src/arrays.rs', lines 19:0-19:53 -/ def array_to_shared_slice_ (T : Type) (s : Array T 32#usize) : Result (Slice T) := Array.to_slice T 32#usize s /- [arrays::array_to_mut_slice_]: - Source: 'src/arrays.rs', lines 21:0-21:58 -/ + Source: 'tests/src/arrays.rs', lines 24:0-24:58 -/ def array_to_mut_slice_ (T : Type) (s : Array T 32#usize) : Result ((Slice T) × (Slice T → Result (Array T 32#usize))) @@ -31,42 +31,42 @@ def array_to_mut_slice_ Array.to_slice_mut T 32#usize s /- [arrays::array_len]: - Source: 'src/arrays.rs', lines 25:0-25:40 -/ + Source: 'tests/src/arrays.rs', lines 28:0-28:40 -/ def array_len (T : Type) (s : Array T 32#usize) : Result Usize := do let s1 ← Array.to_slice T 32#usize s Result.ok (Slice.len T s1) /- [arrays::shared_array_len]: - Source: 'src/arrays.rs', lines 29:0-29:48 -/ + Source: 'tests/src/arrays.rs', lines 32:0-32:48 -/ def shared_array_len (T : Type) (s : Array T 32#usize) : Result Usize := do let s1 ← Array.to_slice T 32#usize s Result.ok (Slice.len T s1) /- [arrays::shared_slice_len]: - Source: 'src/arrays.rs', lines 33:0-33:44 -/ + Source: 'tests/src/arrays.rs', lines 36:0-36:44 -/ def shared_slice_len (T : Type) (s : Slice T) : Result Usize := Result.ok (Slice.len T s) /- [arrays::index_array_shared]: - Source: 'src/arrays.rs', lines 37:0-37:57 -/ + Source: 'tests/src/arrays.rs', lines 40:0-40:57 -/ def index_array_shared (T : Type) (s : Array T 32#usize) (i : Usize) : Result T := Array.index_usize T 32#usize s i /- [arrays::index_array_u32]: - Source: 'src/arrays.rs', lines 44:0-44:53 -/ + Source: 'tests/src/arrays.rs', lines 47:0-47:53 -/ def index_array_u32 (s : Array U32 32#usize) (i : Usize) : Result U32 := Array.index_usize U32 32#usize s i /- [arrays::index_array_copy]: - Source: 'src/arrays.rs', lines 48:0-48:45 -/ + Source: 'tests/src/arrays.rs', lines 51:0-51:45 -/ def index_array_copy (x : Array U32 32#usize) : Result U32 := Array.index_usize U32 32#usize x 0#usize /- [arrays::index_mut_array]: - Source: 'src/arrays.rs', lines 52:0-52:62 -/ + Source: 'tests/src/arrays.rs', lines 55:0-55:62 -/ def index_mut_array (T : Type) (s : Array T 32#usize) (i : Usize) : Result (T × (T → Result (Array T 32#usize))) @@ -74,12 +74,12 @@ def index_mut_array Array.index_mut_usize T 32#usize s i /- [arrays::index_slice]: - Source: 'src/arrays.rs', lines 56:0-56:46 -/ + Source: 'tests/src/arrays.rs', lines 59:0-59:46 -/ def index_slice (T : Type) (s : Slice T) (i : Usize) : Result T := Slice.index_usize T s i /- [arrays::index_mut_slice]: - Source: 'src/arrays.rs', lines 60:0-60:58 -/ + Source: 'tests/src/arrays.rs', lines 63:0-63:58 -/ def index_mut_slice (T : Type) (s : Slice T) (i : Usize) : Result (T × (T → Result (Slice T))) @@ -87,7 +87,7 @@ def index_mut_slice Slice.index_mut_usize T s i /- [arrays::slice_subslice_shared_]: - Source: 'src/arrays.rs', lines 64:0-64:70 -/ + Source: 'tests/src/arrays.rs', lines 67:0-67:70 -/ def slice_subslice_shared_ (x : Slice U32) (y : Usize) (z : Usize) : Result (Slice U32) := core.slice.index.Slice.index U32 (core.ops.range.Range Usize) @@ -95,7 +95,7 @@ def slice_subslice_shared_ { start := y, end_ := z } /- [arrays::slice_subslice_mut_]: - Source: 'src/arrays.rs', lines 68:0-68:75 -/ + Source: 'tests/src/arrays.rs', lines 71:0-71:75 -/ def slice_subslice_mut_ (x : Slice U32) (y : Usize) (z : Usize) : Result ((Slice U32) × (Slice U32 → Result (Slice U32))) @@ -108,12 +108,12 @@ def slice_subslice_mut_ Result.ok (s, index_mut_back) /- [arrays::array_to_slice_shared_]: - Source: 'src/arrays.rs', lines 72:0-72:54 -/ + Source: 'tests/src/arrays.rs', lines 75:0-75:54 -/ def array_to_slice_shared_ (x : Array U32 32#usize) : Result (Slice U32) := Array.to_slice U32 32#usize x /- [arrays::array_to_slice_mut_]: - Source: 'src/arrays.rs', lines 76:0-76:59 -/ + Source: 'tests/src/arrays.rs', lines 79:0-79:59 -/ def array_to_slice_mut_ (x : Array U32 32#usize) : Result ((Slice U32) × (Slice U32 → Result (Array U32 32#usize))) @@ -121,7 +121,7 @@ def array_to_slice_mut_ Array.to_slice_mut U32 32#usize x /- [arrays::array_subslice_shared_]: - Source: 'src/arrays.rs', lines 80:0-80:74 -/ + Source: 'tests/src/arrays.rs', lines 83:0-83:74 -/ def array_subslice_shared_ (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := core.array.Array.index U32 (core.ops.range.Range Usize) 32#usize @@ -130,7 +130,7 @@ def array_subslice_shared_ { start := y, end_ := z } /- [arrays::array_subslice_mut_]: - Source: 'src/arrays.rs', lines 84:0-84:79 -/ + Source: 'tests/src/arrays.rs', lines 87:0-87:79 -/ def array_subslice_mut_ (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result ((Slice U32) × (Slice U32 → Result (Array U32 32#usize))) @@ -144,17 +144,17 @@ def array_subslice_mut_ Result.ok (s, index_mut_back) /- [arrays::index_slice_0]: - Source: 'src/arrays.rs', lines 88:0-88:38 -/ + Source: 'tests/src/arrays.rs', lines 91:0-91:38 -/ def index_slice_0 (T : Type) (s : Slice T) : Result T := Slice.index_usize T s 0#usize /- [arrays::index_array_0]: - Source: 'src/arrays.rs', lines 92:0-92:42 -/ + Source: 'tests/src/arrays.rs', lines 95:0-95:42 -/ def index_array_0 (T : Type) (s : Array T 32#usize) : Result T := Array.index_usize T 32#usize s 0#usize /- [arrays::index_index_array]: - Source: 'src/arrays.rs', lines 103:0-103:71 -/ + Source: 'tests/src/arrays.rs', lines 106:0-106:71 -/ def index_index_array (s : Array (Array U32 32#usize) 32#usize) (i : Usize) (j : Usize) : Result U32 @@ -164,7 +164,7 @@ def index_index_array Array.index_usize U32 32#usize a j /- [arrays::update_update_array]: - Source: 'src/arrays.rs', lines 114:0-114:70 -/ + Source: 'tests/src/arrays.rs', lines 117:0-117:70 -/ def update_update_array (s : Array (Array U32 32#usize) 32#usize) (i : Usize) (j : Usize) : Result Unit @@ -178,37 +178,37 @@ def update_update_array Result.ok () /- [arrays::array_local_deep_copy]: - Source: 'src/arrays.rs', lines 118:0-118:43 -/ + Source: 'tests/src/arrays.rs', lines 121:0-121:43 -/ def array_local_deep_copy (x : Array U32 32#usize) : Result Unit := Result.ok () /- [arrays::take_array]: - Source: 'src/arrays.rs', lines 122:0-122:30 -/ + Source: 'tests/src/arrays.rs', lines 125:0-125:30 -/ def take_array (a : Array U32 2#usize) : Result Unit := Result.ok () /- [arrays::take_array_borrow]: - Source: 'src/arrays.rs', lines 123:0-123:38 -/ + Source: 'tests/src/arrays.rs', lines 126:0-126:38 -/ def take_array_borrow (a : Array U32 2#usize) : Result Unit := Result.ok () /- [arrays::take_slice]: - Source: 'src/arrays.rs', lines 124:0-124:28 -/ + Source: 'tests/src/arrays.rs', lines 127:0-127:28 -/ def take_slice (s : Slice U32) : Result Unit := Result.ok () /- [arrays::take_mut_slice]: - Source: 'src/arrays.rs', lines 125:0-125:36 -/ + Source: 'tests/src/arrays.rs', lines 128:0-128:36 -/ def take_mut_slice (s : Slice U32) : Result (Slice U32) := Result.ok s /- [arrays::const_array]: - Source: 'src/arrays.rs', lines 127:0-127:32 -/ + Source: 'tests/src/arrays.rs', lines 130:0-130:32 -/ def const_array : Result (Array U32 2#usize) := Result.ok (Array.make U32 2#usize [ 0#u32, 0#u32 ]) /- [arrays::const_slice]: - Source: 'src/arrays.rs', lines 131:0-131:20 -/ + Source: 'tests/src/arrays.rs', lines 134:0-134:20 -/ def const_slice : Result Unit := do let _ ← @@ -216,7 +216,7 @@ def const_slice : Result Unit := Result.ok () /- [arrays::take_all]: - Source: 'src/arrays.rs', lines 141:0-141:17 -/ + Source: 'tests/src/arrays.rs', lines 144:0-144:17 -/ def take_all : Result Unit := do let _ ← take_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) @@ -232,29 +232,29 @@ def take_all : Result Unit := Result.ok () /- [arrays::index_array]: - Source: 'src/arrays.rs', lines 155:0-155:38 -/ + Source: 'tests/src/arrays.rs', lines 158:0-158:38 -/ def index_array (x : Array U32 2#usize) : Result U32 := Array.index_usize U32 2#usize x 0#usize /- [arrays::index_array_borrow]: - Source: 'src/arrays.rs', lines 158:0-158:46 -/ + Source: 'tests/src/arrays.rs', lines 161:0-161:46 -/ def index_array_borrow (x : Array U32 2#usize) : Result U32 := Array.index_usize U32 2#usize x 0#usize /- [arrays::index_slice_u32_0]: - Source: 'src/arrays.rs', lines 162:0-162:42 -/ + Source: 'tests/src/arrays.rs', lines 165:0-165:42 -/ def index_slice_u32_0 (x : Slice U32) : Result U32 := Slice.index_usize U32 x 0#usize /- [arrays::index_mut_slice_u32_0]: - Source: 'src/arrays.rs', lines 166:0-166:50 -/ + Source: 'tests/src/arrays.rs', lines 169:0-169:50 -/ def index_mut_slice_u32_0 (x : Slice U32) : Result (U32 × (Slice U32)) := do let i ← Slice.index_usize U32 x 0#usize Result.ok (i, x) /- [arrays::index_all]: - Source: 'src/arrays.rs', lines 170:0-170:25 -/ + Source: 'tests/src/arrays.rs', lines 173:0-173:25 -/ def index_all : Result U32 := do let i ← index_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) @@ -274,7 +274,7 @@ def index_all : Result U32 := Result.ok i8 /- [arrays::update_array]: - Source: 'src/arrays.rs', lines 184:0-184:36 -/ + Source: 'tests/src/arrays.rs', lines 187:0-187:36 -/ def update_array (x : Array U32 2#usize) : Result Unit := do let (_, index_mut_back) ← Array.index_mut_usize U32 2#usize x 0#usize @@ -282,7 +282,7 @@ def update_array (x : Array U32 2#usize) : Result Unit := Result.ok () /- [arrays::update_array_mut_borrow]: - Source: 'src/arrays.rs', lines 187:0-187:48 -/ + Source: 'tests/src/arrays.rs', lines 190:0-190:48 -/ def update_array_mut_borrow (x : Array U32 2#usize) : Result (Array U32 2#usize) := do @@ -290,14 +290,14 @@ def update_array_mut_borrow index_mut_back 1#u32 /- [arrays::update_mut_slice]: - Source: 'src/arrays.rs', lines 190:0-190:38 -/ + Source: 'tests/src/arrays.rs', lines 193:0-193:38 -/ def update_mut_slice (x : Slice U32) : Result (Slice U32) := do let (_, index_mut_back) ← Slice.index_mut_usize U32 x 0#usize index_mut_back 1#u32 /- [arrays::update_all]: - Source: 'src/arrays.rs', lines 194:0-194:19 -/ + Source: 'tests/src/arrays.rs', lines 197:0-197:19 -/ def update_all : Result Unit := do let _ ← update_array (Array.make U32 2#usize [ 0#u32, 0#u32 ]) @@ -309,7 +309,7 @@ def update_all : Result Unit := Result.ok () /- [arrays::range_all]: - Source: 'src/arrays.rs', lines 205:0-205:18 -/ + Source: 'tests/src/arrays.rs', lines 208:0-208:18 -/ def range_all : Result Unit := do let (s, index_mut_back) ← @@ -323,12 +323,12 @@ def range_all : Result Unit := Result.ok () /- [arrays::deref_array_borrow]: - Source: 'src/arrays.rs', lines 214:0-214:46 -/ + Source: 'tests/src/arrays.rs', lines 217:0-217:46 -/ def deref_array_borrow (x : Array U32 2#usize) : Result U32 := Array.index_usize U32 2#usize x 0#usize /- [arrays::deref_array_mut_borrow]: - Source: 'src/arrays.rs', lines 219:0-219:54 -/ + Source: 'tests/src/arrays.rs', lines 222:0-222:54 -/ def deref_array_mut_borrow (x : Array U32 2#usize) : Result (U32 × (Array U32 2#usize)) := do @@ -336,17 +336,17 @@ def deref_array_mut_borrow Result.ok (i, x) /- [arrays::take_array_t]: - Source: 'src/arrays.rs', lines 227:0-227:31 -/ + Source: 'tests/src/arrays.rs', lines 230:0-230:31 -/ def take_array_t (a : Array AB 2#usize) : Result Unit := Result.ok () /- [arrays::non_copyable_array]: - Source: 'src/arrays.rs', lines 229:0-229:27 -/ + Source: 'tests/src/arrays.rs', lines 232:0-232:27 -/ def non_copyable_array : Result Unit := take_array_t (Array.make AB 2#usize [ AB.A, AB.B ]) /- [arrays::sum]: loop 0: - Source: 'src/arrays.rs', lines 242:0-250:1 -/ + Source: 'tests/src/arrays.rs', lines 245:0-253:1 -/ divergent def sum_loop (s : Slice U32) (sum1 : U32) (i : Usize) : Result U32 := let i1 := Slice.len U32 s if i < i1 @@ -359,12 +359,12 @@ divergent def sum_loop (s : Slice U32) (sum1 : U32) (i : Usize) : Result U32 := else Result.ok sum1 /- [arrays::sum]: - Source: 'src/arrays.rs', lines 242:0-242:28 -/ + Source: 'tests/src/arrays.rs', lines 245:0-245:28 -/ def sum (s : Slice U32) : Result U32 := sum_loop s 0#u32 0#usize /- [arrays::sum2]: loop 0: - Source: 'src/arrays.rs', lines 252:0-261:1 -/ + Source: 'tests/src/arrays.rs', lines 255:0-264:1 -/ divergent def sum2_loop (s : Slice U32) (s2 : Slice U32) (sum1 : U32) (i : Usize) : Result U32 := let i1 := Slice.len U32 s @@ -380,7 +380,7 @@ divergent def sum2_loop else Result.ok sum1 /- [arrays::sum2]: - Source: 'src/arrays.rs', lines 252:0-252:41 -/ + Source: 'tests/src/arrays.rs', lines 255:0-255:41 -/ def sum2 (s : Slice U32) (s2 : Slice U32) : Result U32 := let i := Slice.len U32 s let i1 := Slice.len U32 s2 @@ -389,7 +389,7 @@ def sum2 (s : Slice U32) (s2 : Slice U32) : Result U32 := else sum2_loop s s2 0#u32 0#usize /- [arrays::f0]: - Source: 'src/arrays.rs', lines 263:0-263:11 -/ + Source: 'tests/src/arrays.rs', lines 266:0-266:11 -/ def f0 : Result Unit := do let (s, to_slice_mut_back) ← @@ -400,7 +400,7 @@ def f0 : Result Unit := Result.ok () /- [arrays::f1]: - Source: 'src/arrays.rs', lines 268:0-268:11 -/ + Source: 'tests/src/arrays.rs', lines 271:0-271:11 -/ def f1 : Result Unit := do let (_, index_mut_back) ← @@ -410,12 +410,12 @@ def f1 : Result Unit := Result.ok () /- [arrays::f2]: - Source: 'src/arrays.rs', lines 273:0-273:17 -/ + Source: 'tests/src/arrays.rs', lines 276:0-276:17 -/ def f2 (i : U32) : Result Unit := Result.ok () /- [arrays::f4]: - Source: 'src/arrays.rs', lines 282:0-282:54 -/ + Source: 'tests/src/arrays.rs', lines 285:0-285:54 -/ def f4 (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := core.array.Array.index U32 (core.ops.range.Range Usize) 32#usize (core.ops.index.IndexSliceTIInst U32 (core.ops.range.Range Usize) @@ -423,7 +423,7 @@ def f4 (x : Array U32 32#usize) (y : Usize) (z : Usize) : Result (Slice U32) := { start := y, end_ := z } /- [arrays::f3]: - Source: 'src/arrays.rs', lines 275:0-275:18 -/ + Source: 'tests/src/arrays.rs', lines 278:0-278:18 -/ def f3 : Result U32 := do let i ← @@ -437,17 +437,17 @@ def f3 : Result U32 := sum2 s s1 /- [arrays::SZ] - Source: 'src/arrays.rs', lines 286:0-286:19 -/ + Source: 'tests/src/arrays.rs', lines 289:0-289:19 -/ def SZ_body : Result Usize := Result.ok 32#usize def SZ : Usize := eval_global SZ_body /- [arrays::f5]: - Source: 'src/arrays.rs', lines 289:0-289:31 -/ + Source: 'tests/src/arrays.rs', lines 292:0-292:31 -/ def f5 (x : Array U32 32#usize) : Result U32 := Array.index_usize U32 32#usize x 0#usize /- [arrays::ite]: - Source: 'src/arrays.rs', lines 294:0-294:12 -/ + Source: 'tests/src/arrays.rs', lines 297:0-297:12 -/ def ite : Result Unit := do let (s, to_slice_mut_back) ← @@ -461,7 +461,7 @@ def ite : Result Unit := Result.ok () /- [arrays::zero_slice]: loop 0: - Source: 'src/arrays.rs', lines 303:0-310:1 -/ + Source: 'tests/src/arrays.rs', lines 306:0-313:1 -/ divergent def zero_slice_loop (a : Slice U8) (i : Usize) (len : Usize) : Result (Slice U8) := if i < len @@ -474,13 +474,13 @@ divergent def zero_slice_loop else Result.ok a /- [arrays::zero_slice]: - Source: 'src/arrays.rs', lines 303:0-303:31 -/ + Source: 'tests/src/arrays.rs', lines 306:0-306:31 -/ def zero_slice (a : Slice U8) : Result (Slice U8) := let len := Slice.len U8 a zero_slice_loop a 0#usize len /- [arrays::iter_mut_slice]: loop 0: - Source: 'src/arrays.rs', lines 312:0-318:1 -/ + Source: 'tests/src/arrays.rs', lines 315:0-321:1 -/ divergent def iter_mut_slice_loop (len : Usize) (i : Usize) : Result Unit := if i < len then do @@ -489,7 +489,7 @@ divergent def iter_mut_slice_loop (len : Usize) (i : Usize) : Result Unit := else Result.ok () /- [arrays::iter_mut_slice]: - Source: 'src/arrays.rs', lines 312:0-312:35 -/ + Source: 'tests/src/arrays.rs', lines 315:0-315:35 -/ def iter_mut_slice (a : Slice U8) : Result (Slice U8) := do let len := Slice.len U8 a @@ -497,7 +497,7 @@ def iter_mut_slice (a : Slice U8) : Result (Slice U8) := Result.ok a /- [arrays::sum_mut_slice]: loop 0: - Source: 'src/arrays.rs', lines 320:0-328:1 -/ + Source: 'tests/src/arrays.rs', lines 323:0-331:1 -/ divergent def sum_mut_slice_loop (a : Slice U32) (i : Usize) (s : U32) : Result U32 := let i1 := Slice.len U32 a @@ -511,7 +511,7 @@ divergent def sum_mut_slice_loop else Result.ok s /- [arrays::sum_mut_slice]: - Source: 'src/arrays.rs', lines 320:0-320:42 -/ + Source: 'tests/src/arrays.rs', lines 323:0-323:42 -/ def sum_mut_slice (a : Slice U32) : Result (U32 × (Slice U32)) := do let i ← sum_mut_slice_loop a 0#usize 0#u32 diff --git a/tests/lean/Bitwise.lean b/tests/lean/Bitwise.lean index c13129f1..3c381233 100644 --- a/tests/lean/Bitwise.lean +++ b/tests/lean/Bitwise.lean @@ -6,31 +6,31 @@ open Primitives namespace bitwise /- [bitwise::shift_u32]: - Source: 'src/bitwise.rs', lines 3:0-3:31 -/ + Source: 'tests/src/bitwise.rs', lines 4:0-4:31 -/ def shift_u32 (a : U32) : Result U32 := do let t ← a >>> 16#usize t <<< 16#usize /- [bitwise::shift_i32]: - Source: 'src/bitwise.rs', lines 10:0-10:31 -/ + Source: 'tests/src/bitwise.rs', lines 11:0-11:31 -/ def shift_i32 (a : I32) : Result I32 := do let t ← a >>> 16#isize t <<< 16#isize /- [bitwise::xor_u32]: - Source: 'src/bitwise.rs', lines 17:0-17:37 -/ + Source: 'tests/src/bitwise.rs', lines 18:0-18:37 -/ def xor_u32 (a : U32) (b : U32) : Result U32 := Result.ok (a ^^^ b) /- [bitwise::or_u32]: - Source: 'src/bitwise.rs', lines 21:0-21:36 -/ + Source: 'tests/src/bitwise.rs', lines 22:0-22:36 -/ def or_u32 (a : U32) (b : U32) : Result U32 := Result.ok (a ||| b) /- [bitwise::and_u32]: - Source: 'src/bitwise.rs', lines 25:0-25:37 -/ + Source: 'tests/src/bitwise.rs', lines 26:0-26:37 -/ def and_u32 (a : U32) (b : U32) : Result U32 := Result.ok (a &&& b) diff --git a/tests/lean/Constants.lean b/tests/lean/Constants.lean index 3cc3ca40..334f4707 100644 --- a/tests/lean/Constants.lean +++ b/tests/lean/Constants.lean @@ -6,123 +6,123 @@ open Primitives namespace constants /- [constants::X0] - Source: 'src/constants.rs', lines 5:0-5:17 -/ + Source: 'tests/src/constants.rs', lines 7:0-7:17 -/ def X0_body : Result U32 := Result.ok 0#u32 def X0 : U32 := eval_global X0_body /- [constants::X1] - Source: 'src/constants.rs', lines 7:0-7:17 -/ + Source: 'tests/src/constants.rs', lines 9:0-9:17 -/ def X1_body : Result U32 := Result.ok core_u32_max def X1 : U32 := eval_global X1_body /- [constants::X2] - Source: 'src/constants.rs', lines 10:0-10:17 -/ + Source: 'tests/src/constants.rs', lines 12:0-12:17 -/ def X2_body : Result U32 := Result.ok 3#u32 def X2 : U32 := eval_global X2_body /- [constants::incr]: - Source: 'src/constants.rs', lines 17:0-17:32 -/ + Source: 'tests/src/constants.rs', lines 19:0-19:32 -/ def incr (n : U32) : Result U32 := n + 1#u32 /- [constants::X3] - Source: 'src/constants.rs', lines 15:0-15:17 -/ + Source: 'tests/src/constants.rs', lines 17:0-17:17 -/ def X3_body : Result U32 := incr 32#u32 def X3 : U32 := eval_global X3_body /- [constants::mk_pair0]: - Source: 'src/constants.rs', lines 23:0-23:51 -/ + Source: 'tests/src/constants.rs', lines 25:0-25:51 -/ def mk_pair0 (x : U32) (y : U32) : Result (U32 × U32) := Result.ok (x, y) /- [constants::Pair] - Source: 'src/constants.rs', lines 36:0-36:23 -/ + Source: 'tests/src/constants.rs', lines 38:0-38:23 -/ structure Pair (T1 T2 : Type) where x : T1 y : T2 /- [constants::mk_pair1]: - Source: 'src/constants.rs', lines 27:0-27:55 -/ + Source: 'tests/src/constants.rs', lines 29:0-29:55 -/ def mk_pair1 (x : U32) (y : U32) : Result (Pair U32 U32) := Result.ok { x := x, y := y } /- [constants::P0] - Source: 'src/constants.rs', lines 31:0-31:24 -/ + Source: 'tests/src/constants.rs', lines 33:0-33:24 -/ def P0_body : Result (U32 × U32) := mk_pair0 0#u32 1#u32 def P0 : (U32 × U32) := eval_global P0_body /- [constants::P1] - Source: 'src/constants.rs', lines 32:0-32:28 -/ + Source: 'tests/src/constants.rs', lines 34:0-34:28 -/ def P1_body : Result (Pair U32 U32) := mk_pair1 0#u32 1#u32 def P1 : Pair U32 U32 := eval_global P1_body /- [constants::P2] - Source: 'src/constants.rs', lines 33:0-33:24 -/ + Source: 'tests/src/constants.rs', lines 35:0-35:24 -/ def P2_body : Result (U32 × U32) := Result.ok (0#u32, 1#u32) def P2 : (U32 × U32) := eval_global P2_body /- [constants::P3] - Source: 'src/constants.rs', lines 34:0-34:28 -/ + Source: 'tests/src/constants.rs', lines 36:0-36:28 -/ def P3_body : Result (Pair U32 U32) := Result.ok { x := 0#u32, y := 1#u32 } def P3 : Pair U32 U32 := eval_global P3_body /- [constants::Wrap] - Source: 'src/constants.rs', lines 49:0-49:18 -/ + Source: 'tests/src/constants.rs', lines 51:0-51:18 -/ structure Wrap (T : Type) where value : T /- [constants::{constants::Wrap<T>}::new]: - Source: 'src/constants.rs', lines 54:4-54:41 -/ + Source: 'tests/src/constants.rs', lines 56:4-56:41 -/ def Wrap.new (T : Type) (value : T) : Result (Wrap T) := Result.ok { value := value } /- [constants::Y] - Source: 'src/constants.rs', lines 41:0-41:22 -/ + Source: 'tests/src/constants.rs', lines 43:0-43:22 -/ def Y_body : Result (Wrap I32) := Wrap.new I32 2#i32 def Y : Wrap I32 := eval_global Y_body /- [constants::unwrap_y]: - Source: 'src/constants.rs', lines 43:0-43:30 -/ + Source: 'tests/src/constants.rs', lines 45:0-45:30 -/ def unwrap_y : Result I32 := Result.ok Y.value /- [constants::YVAL] - Source: 'src/constants.rs', lines 47:0-47:19 -/ + Source: 'tests/src/constants.rs', lines 49:0-49:19 -/ def YVAL_body : Result I32 := unwrap_y def YVAL : I32 := eval_global YVAL_body /- [constants::get_z1::Z1] - Source: 'src/constants.rs', lines 62:4-62:17 -/ + Source: 'tests/src/constants.rs', lines 64:4-64:17 -/ def get_z1.Z1_body : Result I32 := Result.ok 3#i32 def get_z1.Z1 : I32 := eval_global get_z1.Z1_body /- [constants::get_z1]: - Source: 'src/constants.rs', lines 61:0-61:28 -/ + Source: 'tests/src/constants.rs', lines 63:0-63:28 -/ def get_z1 : Result I32 := Result.ok get_z1.Z1 /- [constants::add]: - Source: 'src/constants.rs', lines 66:0-66:39 -/ + Source: 'tests/src/constants.rs', lines 68:0-68:39 -/ def add (a : I32) (b : I32) : Result I32 := a + b /- [constants::Q1] - Source: 'src/constants.rs', lines 74:0-74:17 -/ + Source: 'tests/src/constants.rs', lines 76:0-76:17 -/ def Q1_body : Result I32 := Result.ok 5#i32 def Q1 : I32 := eval_global Q1_body /- [constants::Q2] - Source: 'src/constants.rs', lines 75:0-75:17 -/ + Source: 'tests/src/constants.rs', lines 77:0-77:17 -/ def Q2_body : Result I32 := Result.ok Q1 def Q2 : I32 := eval_global Q2_body /- [constants::Q3] - Source: 'src/constants.rs', lines 76:0-76:17 -/ + Source: 'tests/src/constants.rs', lines 78:0-78:17 -/ def Q3_body : Result I32 := add Q2 3#i32 def Q3 : I32 := eval_global Q3_body /- [constants::get_z2]: - Source: 'src/constants.rs', lines 70:0-70:28 -/ + Source: 'tests/src/constants.rs', lines 72:0-72:28 -/ def get_z2 : Result I32 := do let i ← get_z1 @@ -130,37 +130,37 @@ def get_z2 : Result I32 := add Q1 i1 /- [constants::S1] - Source: 'src/constants.rs', lines 80:0-80:18 -/ + Source: 'tests/src/constants.rs', lines 82:0-82:18 -/ def S1_body : Result U32 := Result.ok 6#u32 def S1 : U32 := eval_global S1_body /- [constants::S2] - Source: 'src/constants.rs', lines 81:0-81:18 -/ + Source: 'tests/src/constants.rs', lines 83:0-83:18 -/ def S2_body : Result U32 := incr S1 def S2 : U32 := eval_global S2_body /- [constants::S3] - Source: 'src/constants.rs', lines 82:0-82:29 -/ + Source: 'tests/src/constants.rs', lines 84:0-84:29 -/ def S3_body : Result (Pair U32 U32) := Result.ok P3 def S3 : Pair U32 U32 := eval_global S3_body /- [constants::S4] - Source: 'src/constants.rs', lines 83:0-83:29 -/ + Source: 'tests/src/constants.rs', lines 85:0-85:29 -/ def S4_body : Result (Pair U32 U32) := mk_pair1 7#u32 8#u32 def S4 : Pair U32 U32 := eval_global S4_body /- [constants::V] - Source: 'src/constants.rs', lines 86:0-86:31 -/ + Source: 'tests/src/constants.rs', lines 88:0-88:31 -/ structure V (T : Type) (N : Usize) where x : Array T N /- [constants::{constants::V<T, N>#1}::LEN] - Source: 'src/constants.rs', lines 91:4-91:24 -/ + Source: 'tests/src/constants.rs', lines 93:4-93:24 -/ def V.LEN_body (T : Type) (N : Usize) : Result Usize := Result.ok N def V.LEN (T : Type) (N : Usize) : Usize := eval_global (V.LEN_body T N) /- [constants::use_v]: - Source: 'src/constants.rs', lines 94:0-94:42 -/ + Source: 'tests/src/constants.rs', lines 96:0-96:42 -/ def use_v (T : Type) (N : Usize) : Result Usize := Result.ok (V.LEN T N) diff --git a/tests/lean/Demo/Demo.lean b/tests/lean/Demo/Demo.lean index 3a3aeb96..a7683eb0 100644 --- a/tests/lean/Demo/Demo.lean +++ b/tests/lean/Demo/Demo.lean @@ -6,7 +6,7 @@ open Primitives namespace demo /- [demo::choose]: - Source: 'src/demo.rs', lines 5:0-5:70 -/ + Source: 'tests/src/demo.rs', lines 6:0-6:70 -/ def choose (T : Type) (b : Bool) (x : T) (y : T) : Result (T × (T → Result (T × T))) @@ -18,26 +18,26 @@ def choose Result.ok (y, back) /- [demo::mul2_add1]: - Source: 'src/demo.rs', lines 13:0-13:31 -/ + Source: 'tests/src/demo.rs', lines 14:0-14:31 -/ def mul2_add1 (x : U32) : Result U32 := do let i ← x + x i + 1#u32 /- [demo::use_mul2_add1]: - Source: 'src/demo.rs', lines 17:0-17:43 -/ + Source: 'tests/src/demo.rs', lines 18:0-18:43 -/ def use_mul2_add1 (x : U32) (y : U32) : Result U32 := do let i ← mul2_add1 x i + y /- [demo::incr]: - Source: 'src/demo.rs', lines 21:0-21:31 -/ + Source: 'tests/src/demo.rs', lines 22:0-22:31 -/ def incr (x : U32) : Result U32 := x + 1#u32 /- [demo::use_incr]: - Source: 'src/demo.rs', lines 25:0-25:17 -/ + Source: 'tests/src/demo.rs', lines 26:0-26:17 -/ def use_incr : Result Unit := do let x ← incr 0#u32 @@ -46,13 +46,13 @@ def use_incr : Result Unit := Result.ok () /- [demo::CList] - Source: 'src/demo.rs', lines 34:0-34:17 -/ + Source: 'tests/src/demo.rs', lines 35:0-35:17 -/ inductive CList (T : Type) := | CCons : T → CList T → CList T | CNil : CList T /- [demo::list_nth]: - Source: 'src/demo.rs', lines 39:0-39:56 -/ + Source: 'tests/src/demo.rs', lines 40:0-40:56 -/ divergent def list_nth (T : Type) (l : CList T) (i : U32) : Result T := match l with | CList.CCons x tl => @@ -64,7 +64,7 @@ divergent def list_nth (T : Type) (l : CList T) (i : U32) : Result T := | CList.CNil => Result.fail .panic /- [demo::list_nth_mut]: - Source: 'src/demo.rs', lines 54:0-54:68 -/ + Source: 'tests/src/demo.rs', lines 55:0-55:68 -/ divergent def list_nth_mut (T : Type) (l : CList T) (i : U32) : Result (T × (T → Result (CList T))) @@ -88,7 +88,7 @@ divergent def list_nth_mut | CList.CNil => Result.fail .panic /- [demo::list_nth_mut1]: loop 0: - Source: 'src/demo.rs', lines 69:0-78:1 -/ + Source: 'tests/src/demo.rs', lines 70:0-79:1 -/ divergent def list_nth_mut1_loop (T : Type) (l : CList T) (i : U32) : Result (T × (T → Result (CList T))) @@ -111,7 +111,7 @@ divergent def list_nth_mut1_loop | CList.CNil => Result.fail .panic /- [demo::list_nth_mut1]: - Source: 'src/demo.rs', lines 69:0-69:77 -/ + Source: 'tests/src/demo.rs', lines 70:0-70:77 -/ def list_nth_mut1 (T : Type) (l : CList T) (i : U32) : Result (T × (T → Result (CList T))) @@ -119,7 +119,7 @@ def list_nth_mut1 list_nth_mut1_loop T l i /- [demo::i32_id]: - Source: 'src/demo.rs', lines 80:0-80:28 -/ + Source: 'tests/src/demo.rs', lines 81:0-81:28 -/ divergent def i32_id (i : I32) : Result I32 := if i = 0#i32 then Result.ok 0#i32 @@ -129,7 +129,7 @@ divergent def i32_id (i : I32) : Result I32 := i2 + 1#i32 /- [demo::list_tail]: - Source: 'src/demo.rs', lines 88:0-88:64 -/ + Source: 'tests/src/demo.rs', lines 89:0-89:64 -/ divergent def list_tail (T : Type) (l : CList T) : Result ((CList T) × (CList T → Result (CList T))) @@ -147,25 +147,25 @@ divergent def list_tail | CList.CNil => Result.ok (CList.CNil, Result.ok) /- Trait declaration: [demo::Counter] - Source: 'src/demo.rs', lines 97:0-97:17 -/ + Source: 'tests/src/demo.rs', lines 98:0-98:17 -/ structure Counter (Self : Type) where incr : Self → Result (Usize × Self) /- [demo::{(demo::Counter for usize)}::incr]: - Source: 'src/demo.rs', lines 102:4-102:31 -/ + Source: 'tests/src/demo.rs', lines 103:4-103:31 -/ def CounterUsize.incr (self : Usize) : Result (Usize × Usize) := do let self1 ← self + 1#usize Result.ok (self, self1) /- Trait implementation: [demo::{(demo::Counter for usize)}] - Source: 'src/demo.rs', lines 101:0-101:22 -/ + Source: 'tests/src/demo.rs', lines 102:0-102:22 -/ def CounterUsize : Counter Usize := { incr := CounterUsize.incr } /- [demo::use_counter]: - Source: 'src/demo.rs', lines 109:0-109:59 -/ + Source: 'tests/src/demo.rs', lines 110:0-110:59 -/ def use_counter (T : Type) (CounterInst : Counter T) (cnt : T) : Result (Usize × T) := CounterInst.incr cnt diff --git a/tests/lean/External/Funs.lean b/tests/lean/External/Funs.lean index 0b0a2476..84fe1a28 100644 --- a/tests/lean/External/Funs.lean +++ b/tests/lean/External/Funs.lean @@ -15,12 +15,12 @@ def core.marker.CopyU32 : core.marker.Copy U32 := { } /- [external::use_get]: - Source: 'src/external.rs', lines 5:0-5:37 -/ + Source: 'tests/src/external.rs', lines 8:0-8:37 -/ def use_get (rc : core.cell.Cell U32) (st : State) : Result (State × U32) := core.cell.Cell.get U32 core.marker.CopyU32 rc st /- [external::incr]: - Source: 'src/external.rs', lines 9:0-9:31 -/ + Source: 'tests/src/external.rs', lines 12:0-12:31 -/ def incr (rc : core.cell.Cell U32) (st : State) : Result (State × (core.cell.Cell U32)) diff --git a/tests/lean/Hashmap/Funs.lean b/tests/lean/Hashmap/Funs.lean index 9cbd958c..4f05fbc8 100644 --- a/tests/lean/Hashmap/Funs.lean +++ b/tests/lean/Hashmap/Funs.lean @@ -7,12 +7,12 @@ open Primitives namespace hashmap /- [hashmap::hash_key]: - Source: 'src/hashmap.rs', lines 27:0-27:32 -/ + Source: 'tests/src/hashmap.rs', lines 35:0-35:32 -/ def hash_key (k : Usize) : Result Usize := Result.ok k /- [hashmap::{hashmap::HashMap<T>}::allocate_slots]: loop 0: - Source: 'src/hashmap.rs', lines 50:4-56:5 -/ + Source: 'tests/src/hashmap.rs', lines 58:4-64:5 -/ divergent def HashMap.allocate_slots_loop (T : Type) (slots : alloc.vec.Vec (List T)) (n : Usize) : Result (alloc.vec.Vec (List T)) @@ -26,7 +26,7 @@ divergent def HashMap.allocate_slots_loop else Result.ok slots /- [hashmap::{hashmap::HashMap<T>}::allocate_slots]: - Source: 'src/hashmap.rs', lines 50:4-50:76 -/ + Source: 'tests/src/hashmap.rs', lines 58:4-58:76 -/ def HashMap.allocate_slots (T : Type) (slots : alloc.vec.Vec (List T)) (n : Usize) : Result (alloc.vec.Vec (List T)) @@ -34,7 +34,7 @@ def HashMap.allocate_slots HashMap.allocate_slots_loop T slots n /- [hashmap::{hashmap::HashMap<T>}::new_with_capacity]: - Source: 'src/hashmap.rs', lines 59:4-63:13 -/ + Source: 'tests/src/hashmap.rs', lines 67:4-71:13 -/ def HashMap.new_with_capacity (T : Type) (capacity : Usize) (max_load_dividend : Usize) (max_load_divisor : Usize) : @@ -53,12 +53,12 @@ def HashMap.new_with_capacity } /- [hashmap::{hashmap::HashMap<T>}::new]: - Source: 'src/hashmap.rs', lines 75:4-75:24 -/ + Source: 'tests/src/hashmap.rs', lines 83:4-83:24 -/ def HashMap.new (T : Type) : Result (HashMap T) := HashMap.new_with_capacity T 32#usize 4#usize 5#usize /- [hashmap::{hashmap::HashMap<T>}::clear]: loop 0: - Source: 'src/hashmap.rs', lines 80:4-88:5 -/ + Source: 'tests/src/hashmap.rs', lines 88:4-96:5 -/ divergent def HashMap.clear_loop (T : Type) (slots : alloc.vec.Vec (List T)) (i : Usize) : Result (alloc.vec.Vec (List T)) @@ -76,19 +76,19 @@ divergent def HashMap.clear_loop else Result.ok slots /- [hashmap::{hashmap::HashMap<T>}::clear]: - Source: 'src/hashmap.rs', lines 80:4-80:27 -/ + Source: 'tests/src/hashmap.rs', lines 88:4-88:27 -/ def HashMap.clear (T : Type) (self : HashMap T) : Result (HashMap T) := do let hm ← HashMap.clear_loop T self.slots 0#usize Result.ok { self with num_entries := 0#usize, slots := hm } /- [hashmap::{hashmap::HashMap<T>}::len]: - Source: 'src/hashmap.rs', lines 90:4-90:30 -/ + Source: 'tests/src/hashmap.rs', lines 98:4-98:30 -/ def HashMap.len (T : Type) (self : HashMap T) : Result Usize := Result.ok self.num_entries /- [hashmap::{hashmap::HashMap<T>}::insert_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 97:4-114:5 -/ + Source: 'tests/src/hashmap.rs', lines 105:4-122:5 -/ divergent def HashMap.insert_in_list_loop (T : Type) (key : Usize) (value : T) (ls : List T) : Result (Bool × (List T)) @@ -104,7 +104,7 @@ divergent def HashMap.insert_in_list_loop | List.Nil => Result.ok (true, List.Cons key value List.Nil) /- [hashmap::{hashmap::HashMap<T>}::insert_in_list]: - Source: 'src/hashmap.rs', lines 97:4-97:71 -/ + Source: 'tests/src/hashmap.rs', lines 105:4-105:71 -/ def HashMap.insert_in_list (T : Type) (key : Usize) (value : T) (ls : List T) : Result (Bool × (List T)) @@ -112,7 +112,7 @@ def HashMap.insert_in_list HashMap.insert_in_list_loop T key value ls /- [hashmap::{hashmap::HashMap<T>}::insert_no_resize]: - Source: 'src/hashmap.rs', lines 117:4-117:54 -/ + Source: 'tests/src/hashmap.rs', lines 125:4-125:54 -/ def HashMap.insert_no_resize (T : Type) (self : HashMap T) (key : Usize) (value : T) : Result (HashMap T) @@ -136,7 +136,7 @@ def HashMap.insert_no_resize Result.ok { self with slots := v } /- [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 183:4-196:5 -/ + Source: 'tests/src/hashmap.rs', lines 191:4-204:5 -/ divergent def HashMap.move_elements_from_list_loop (T : Type) (ntable : HashMap T) (ls : List T) : Result (HashMap T) := match ls with @@ -147,13 +147,13 @@ divergent def HashMap.move_elements_from_list_loop | List.Nil => Result.ok ntable /- [hashmap::{hashmap::HashMap<T>}::move_elements_from_list]: - Source: 'src/hashmap.rs', lines 183:4-183:72 -/ + Source: 'tests/src/hashmap.rs', lines 191:4-191:72 -/ def HashMap.move_elements_from_list (T : Type) (ntable : HashMap T) (ls : List T) : Result (HashMap T) := HashMap.move_elements_from_list_loop T ntable ls /- [hashmap::{hashmap::HashMap<T>}::move_elements]: loop 0: - Source: 'src/hashmap.rs', lines 171:4-180:5 -/ + Source: 'tests/src/hashmap.rs', lines 179:4-188:5 -/ divergent def HashMap.move_elements_loop (T : Type) (ntable : HashMap T) (slots : alloc.vec.Vec (List T)) (i : Usize) : @@ -174,7 +174,7 @@ divergent def HashMap.move_elements_loop else Result.ok (ntable, slots) /- [hashmap::{hashmap::HashMap<T>}::move_elements]: - Source: 'src/hashmap.rs', lines 171:4-171:95 -/ + Source: 'tests/src/hashmap.rs', lines 179:4-179:95 -/ def HashMap.move_elements (T : Type) (ntable : HashMap T) (slots : alloc.vec.Vec (List T)) (i : Usize) : @@ -183,7 +183,7 @@ def HashMap.move_elements HashMap.move_elements_loop T ntable slots i /- [hashmap::{hashmap::HashMap<T>}::try_resize]: - Source: 'src/hashmap.rs', lines 140:4-140:28 -/ + Source: 'tests/src/hashmap.rs', lines 148:4-148:28 -/ def HashMap.try_resize (T : Type) (self : HashMap T) : Result (HashMap T) := do let max_usize ← Scalar.cast .Usize core_u32_max @@ -207,7 +207,7 @@ def HashMap.try_resize (T : Type) (self : HashMap T) : Result (HashMap T) := else Result.ok { self with max_load_factor := (i, i1) } /- [hashmap::{hashmap::HashMap<T>}::insert]: - Source: 'src/hashmap.rs', lines 129:4-129:48 -/ + Source: 'tests/src/hashmap.rs', lines 137:4-137:48 -/ def HashMap.insert (T : Type) (self : HashMap T) (key : Usize) (value : T) : Result (HashMap T) @@ -220,7 +220,7 @@ def HashMap.insert else Result.ok self1 /- [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 206:4-219:5 -/ + Source: 'tests/src/hashmap.rs', lines 214:4-227:5 -/ divergent def HashMap.contains_key_in_list_loop (T : Type) (key : Usize) (ls : List T) : Result Bool := match ls with @@ -231,13 +231,13 @@ divergent def HashMap.contains_key_in_list_loop | List.Nil => Result.ok false /- [hashmap::{hashmap::HashMap<T>}::contains_key_in_list]: - Source: 'src/hashmap.rs', lines 206:4-206:68 -/ + Source: 'tests/src/hashmap.rs', lines 214:4-214:68 -/ def HashMap.contains_key_in_list (T : Type) (key : Usize) (ls : List T) : Result Bool := HashMap.contains_key_in_list_loop T key ls /- [hashmap::{hashmap::HashMap<T>}::contains_key]: - Source: 'src/hashmap.rs', lines 199:4-199:49 -/ + Source: 'tests/src/hashmap.rs', lines 207:4-207:49 -/ def HashMap.contains_key (T : Type) (self : HashMap T) (key : Usize) : Result Bool := do @@ -250,7 +250,7 @@ def HashMap.contains_key HashMap.contains_key_in_list T key l /- [hashmap::{hashmap::HashMap<T>}::get_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 224:4-237:5 -/ + Source: 'tests/src/hashmap.rs', lines 232:4-245:5 -/ divergent def HashMap.get_in_list_loop (T : Type) (key : Usize) (ls : List T) : Result T := match ls with @@ -261,12 +261,12 @@ divergent def HashMap.get_in_list_loop | List.Nil => Result.fail .panic /- [hashmap::{hashmap::HashMap<T>}::get_in_list]: - Source: 'src/hashmap.rs', lines 224:4-224:70 -/ + Source: 'tests/src/hashmap.rs', lines 232:4-232:70 -/ def HashMap.get_in_list (T : Type) (key : Usize) (ls : List T) : Result T := HashMap.get_in_list_loop T key ls /- [hashmap::{hashmap::HashMap<T>}::get]: - Source: 'src/hashmap.rs', lines 239:4-239:55 -/ + Source: 'tests/src/hashmap.rs', lines 247:4-247:55 -/ def HashMap.get (T : Type) (self : HashMap T) (key : Usize) : Result T := do let hash ← hash_key key @@ -278,7 +278,7 @@ def HashMap.get (T : Type) (self : HashMap T) (key : Usize) : Result T := HashMap.get_in_list T key l /- [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 245:4-254:5 -/ + Source: 'tests/src/hashmap.rs', lines 253:4-262:5 -/ divergent def HashMap.get_mut_in_list_loop (T : Type) (ls : List T) (key : Usize) : Result (T × (T → Result (List T))) @@ -301,7 +301,7 @@ divergent def HashMap.get_mut_in_list_loop | List.Nil => Result.fail .panic /- [hashmap::{hashmap::HashMap<T>}::get_mut_in_list]: - Source: 'src/hashmap.rs', lines 245:4-245:86 -/ + Source: 'tests/src/hashmap.rs', lines 253:4-253:86 -/ def HashMap.get_mut_in_list (T : Type) (ls : List T) (key : Usize) : Result (T × (T → Result (List T))) @@ -309,7 +309,7 @@ def HashMap.get_mut_in_list HashMap.get_mut_in_list_loop T ls key /- [hashmap::{hashmap::HashMap<T>}::get_mut]: - Source: 'src/hashmap.rs', lines 257:4-257:67 -/ + Source: 'tests/src/hashmap.rs', lines 265:4-265:67 -/ def HashMap.get_mut (T : Type) (self : HashMap T) (key : Usize) : Result (T × (T → Result (HashMap T))) @@ -331,7 +331,7 @@ def HashMap.get_mut Result.ok (t, back) /- [hashmap::{hashmap::HashMap<T>}::remove_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 265:4-291:5 -/ + Source: 'tests/src/hashmap.rs', lines 273:4-299:5 -/ divergent def HashMap.remove_from_list_loop (T : Type) (key : Usize) (ls : List T) : Result ((Option T) × (List T)) := match ls with @@ -350,13 +350,13 @@ divergent def HashMap.remove_from_list_loop | List.Nil => Result.ok (none, List.Nil) /- [hashmap::{hashmap::HashMap<T>}::remove_from_list]: - Source: 'src/hashmap.rs', lines 265:4-265:69 -/ + Source: 'tests/src/hashmap.rs', lines 273:4-273:69 -/ def HashMap.remove_from_list (T : Type) (key : Usize) (ls : List T) : Result ((Option T) × (List T)) := HashMap.remove_from_list_loop T key ls /- [hashmap::{hashmap::HashMap<T>}::remove]: - Source: 'src/hashmap.rs', lines 294:4-294:52 -/ + Source: 'tests/src/hashmap.rs', lines 302:4-302:52 -/ def HashMap.remove (T : Type) (self : HashMap T) (key : Usize) : Result ((Option T) × (HashMap T)) @@ -381,7 +381,7 @@ def HashMap.remove Result.ok (some x1, { self with num_entries := i1, slots := v }) /- [hashmap::test1]: - Source: 'src/hashmap.rs', lines 315:0-315:10 -/ + Source: 'tests/src/hashmap.rs', lines 323:0-323:10 -/ def test1 : Result Unit := do let hm ← HashMap.new U64 diff --git a/tests/lean/Hashmap/Types.lean b/tests/lean/Hashmap/Types.lean index fa454123..a98b972f 100644 --- a/tests/lean/Hashmap/Types.lean +++ b/tests/lean/Hashmap/Types.lean @@ -6,13 +6,13 @@ open Primitives namespace hashmap /- [hashmap::List] - Source: 'src/hashmap.rs', lines 19:0-19:16 -/ + Source: 'tests/src/hashmap.rs', lines 27:0-27:16 -/ inductive List (T : Type) := | Cons : Usize → T → List T → List T | Nil : List T /- [hashmap::HashMap] - Source: 'src/hashmap.rs', lines 35:0-35:21 -/ + Source: 'tests/src/hashmap.rs', lines 43:0-43:21 -/ structure HashMap (T : Type) where num_entries : Usize max_load_factor : (Usize × Usize) diff --git a/tests/lean/HashmapMain/Funs.lean b/tests/lean/HashmapMain/Funs.lean index e985ec6a..45d6b058 100644 --- a/tests/lean/HashmapMain/Funs.lean +++ b/tests/lean/HashmapMain/Funs.lean @@ -8,12 +8,12 @@ open Primitives namespace hashmap_main /- [hashmap_main::hashmap::hash_key]: - Source: 'src/hashmap.rs', lines 27:0-27:32 -/ + Source: 'tests/src/hashmap.rs', lines 35:0-35:32 -/ def hashmap.hash_key (k : Usize) : Result Usize := Result.ok k /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::allocate_slots]: loop 0: - Source: 'src/hashmap.rs', lines 50:4-56:5 -/ + Source: 'tests/src/hashmap.rs', lines 58:4-64:5 -/ divergent def hashmap.HashMap.allocate_slots_loop (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (n : Usize) : Result (alloc.vec.Vec (hashmap.List T)) @@ -27,7 +27,7 @@ divergent def hashmap.HashMap.allocate_slots_loop else Result.ok slots /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::allocate_slots]: - Source: 'src/hashmap.rs', lines 50:4-50:76 -/ + Source: 'tests/src/hashmap.rs', lines 58:4-58:76 -/ def hashmap.HashMap.allocate_slots (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (n : Usize) : Result (alloc.vec.Vec (hashmap.List T)) @@ -35,7 +35,7 @@ def hashmap.HashMap.allocate_slots hashmap.HashMap.allocate_slots_loop T slots n /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::new_with_capacity]: - Source: 'src/hashmap.rs', lines 59:4-63:13 -/ + Source: 'tests/src/hashmap.rs', lines 67:4-71:13 -/ def hashmap.HashMap.new_with_capacity (T : Type) (capacity : Usize) (max_load_dividend : Usize) (max_load_divisor : Usize) : @@ -56,12 +56,12 @@ def hashmap.HashMap.new_with_capacity } /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::new]: - Source: 'src/hashmap.rs', lines 75:4-75:24 -/ + Source: 'tests/src/hashmap.rs', lines 83:4-83:24 -/ def hashmap.HashMap.new (T : Type) : Result (hashmap.HashMap T) := hashmap.HashMap.new_with_capacity T 32#usize 4#usize 5#usize /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: loop 0: - Source: 'src/hashmap.rs', lines 80:4-88:5 -/ + Source: 'tests/src/hashmap.rs', lines 88:4-96:5 -/ divergent def hashmap.HashMap.clear_loop (T : Type) (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : Result (alloc.vec.Vec (hashmap.List T)) @@ -79,7 +79,7 @@ divergent def hashmap.HashMap.clear_loop else Result.ok slots /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::clear]: - Source: 'src/hashmap.rs', lines 80:4-80:27 -/ + Source: 'tests/src/hashmap.rs', lines 88:4-88:27 -/ def hashmap.HashMap.clear (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do @@ -87,12 +87,12 @@ def hashmap.HashMap.clear Result.ok { self with num_entries := 0#usize, slots := hm } /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::len]: - Source: 'src/hashmap.rs', lines 90:4-90:30 -/ + Source: 'tests/src/hashmap.rs', lines 98:4-98:30 -/ def hashmap.HashMap.len (T : Type) (self : hashmap.HashMap T) : Result Usize := Result.ok self.num_entries /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 97:4-114:5 -/ + Source: 'tests/src/hashmap.rs', lines 105:4-122:5 -/ divergent def hashmap.HashMap.insert_in_list_loop (T : Type) (key : Usize) (value : T) (ls : hashmap.List T) : Result (Bool × (hashmap.List T)) @@ -109,7 +109,7 @@ divergent def hashmap.HashMap.insert_in_list_loop Result.ok (true, hashmap.List.Cons key value hashmap.List.Nil) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_in_list]: - Source: 'src/hashmap.rs', lines 97:4-97:71 -/ + Source: 'tests/src/hashmap.rs', lines 105:4-105:71 -/ def hashmap.HashMap.insert_in_list (T : Type) (key : Usize) (value : T) (ls : hashmap.List T) : Result (Bool × (hashmap.List T)) @@ -117,7 +117,7 @@ def hashmap.HashMap.insert_in_list hashmap.HashMap.insert_in_list_loop T key value ls /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert_no_resize]: - Source: 'src/hashmap.rs', lines 117:4-117:54 -/ + Source: 'tests/src/hashmap.rs', lines 125:4-125:54 -/ def hashmap.HashMap.insert_no_resize (T : Type) (self : hashmap.HashMap T) (key : Usize) (value : T) : Result (hashmap.HashMap T) @@ -142,7 +142,7 @@ def hashmap.HashMap.insert_no_resize Result.ok { self with slots := v } /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 183:4-196:5 -/ + Source: 'tests/src/hashmap.rs', lines 191:4-204:5 -/ divergent def hashmap.HashMap.move_elements_from_list_loop (T : Type) (ntable : hashmap.HashMap T) (ls : hashmap.List T) : Result (hashmap.HashMap T) @@ -155,7 +155,7 @@ divergent def hashmap.HashMap.move_elements_from_list_loop | hashmap.List.Nil => Result.ok ntable /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements_from_list]: - Source: 'src/hashmap.rs', lines 183:4-183:72 -/ + Source: 'tests/src/hashmap.rs', lines 191:4-191:72 -/ def hashmap.HashMap.move_elements_from_list (T : Type) (ntable : hashmap.HashMap T) (ls : hashmap.List T) : Result (hashmap.HashMap T) @@ -163,7 +163,7 @@ def hashmap.HashMap.move_elements_from_list hashmap.HashMap.move_elements_from_list_loop T ntable ls /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: loop 0: - Source: 'src/hashmap.rs', lines 171:4-180:5 -/ + Source: 'tests/src/hashmap.rs', lines 179:4-188:5 -/ divergent def hashmap.HashMap.move_elements_loop (T : Type) (ntable : hashmap.HashMap T) (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : @@ -184,7 +184,7 @@ divergent def hashmap.HashMap.move_elements_loop else Result.ok (ntable, slots) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::move_elements]: - Source: 'src/hashmap.rs', lines 171:4-171:95 -/ + Source: 'tests/src/hashmap.rs', lines 179:4-179:95 -/ def hashmap.HashMap.move_elements (T : Type) (ntable : hashmap.HashMap T) (slots : alloc.vec.Vec (hashmap.List T)) (i : Usize) : @@ -193,7 +193,7 @@ def hashmap.HashMap.move_elements hashmap.HashMap.move_elements_loop T ntable slots i /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::try_resize]: - Source: 'src/hashmap.rs', lines 140:4-140:28 -/ + Source: 'tests/src/hashmap.rs', lines 148:4-148:28 -/ def hashmap.HashMap.try_resize (T : Type) (self : hashmap.HashMap T) : Result (hashmap.HashMap T) := do @@ -218,7 +218,7 @@ def hashmap.HashMap.try_resize else Result.ok { self with max_load_factor := (i, i1) } /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::insert]: - Source: 'src/hashmap.rs', lines 129:4-129:48 -/ + Source: 'tests/src/hashmap.rs', lines 137:4-137:48 -/ def hashmap.HashMap.insert (T : Type) (self : hashmap.HashMap T) (key : Usize) (value : T) : Result (hashmap.HashMap T) @@ -231,7 +231,7 @@ def hashmap.HashMap.insert else Result.ok self1 /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 206:4-219:5 -/ + Source: 'tests/src/hashmap.rs', lines 214:4-227:5 -/ divergent def hashmap.HashMap.contains_key_in_list_loop (T : Type) (key : Usize) (ls : hashmap.List T) : Result Bool := match ls with @@ -242,13 +242,13 @@ divergent def hashmap.HashMap.contains_key_in_list_loop | hashmap.List.Nil => Result.ok false /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key_in_list]: - Source: 'src/hashmap.rs', lines 206:4-206:68 -/ + Source: 'tests/src/hashmap.rs', lines 214:4-214:68 -/ def hashmap.HashMap.contains_key_in_list (T : Type) (key : Usize) (ls : hashmap.List T) : Result Bool := hashmap.HashMap.contains_key_in_list_loop T key ls /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::contains_key]: - Source: 'src/hashmap.rs', lines 199:4-199:49 -/ + Source: 'tests/src/hashmap.rs', lines 207:4-207:49 -/ def hashmap.HashMap.contains_key (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result Bool := do @@ -262,7 +262,7 @@ def hashmap.HashMap.contains_key hashmap.HashMap.contains_key_in_list T key l /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 224:4-237:5 -/ + Source: 'tests/src/hashmap.rs', lines 232:4-245:5 -/ divergent def hashmap.HashMap.get_in_list_loop (T : Type) (key : Usize) (ls : hashmap.List T) : Result T := match ls with @@ -273,13 +273,13 @@ divergent def hashmap.HashMap.get_in_list_loop | hashmap.List.Nil => Result.fail .panic /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_in_list]: - Source: 'src/hashmap.rs', lines 224:4-224:70 -/ + Source: 'tests/src/hashmap.rs', lines 232:4-232:70 -/ def hashmap.HashMap.get_in_list (T : Type) (key : Usize) (ls : hashmap.List T) : Result T := hashmap.HashMap.get_in_list_loop T key ls /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get]: - Source: 'src/hashmap.rs', lines 239:4-239:55 -/ + Source: 'tests/src/hashmap.rs', lines 247:4-247:55 -/ def hashmap.HashMap.get (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result T := do @@ -293,7 +293,7 @@ def hashmap.HashMap.get hashmap.HashMap.get_in_list T key l /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: loop 0: - Source: 'src/hashmap.rs', lines 245:4-254:5 -/ + Source: 'tests/src/hashmap.rs', lines 253:4-262:5 -/ divergent def hashmap.HashMap.get_mut_in_list_loop (T : Type) (ls : hashmap.List T) (key : Usize) : Result (T × (T → Result (hashmap.List T))) @@ -316,7 +316,7 @@ divergent def hashmap.HashMap.get_mut_in_list_loop | hashmap.List.Nil => Result.fail .panic /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut_in_list]: - Source: 'src/hashmap.rs', lines 245:4-245:86 -/ + Source: 'tests/src/hashmap.rs', lines 253:4-253:86 -/ def hashmap.HashMap.get_mut_in_list (T : Type) (ls : hashmap.List T) (key : Usize) : Result (T × (T → Result (hashmap.List T))) @@ -324,7 +324,7 @@ def hashmap.HashMap.get_mut_in_list hashmap.HashMap.get_mut_in_list_loop T ls key /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::get_mut]: - Source: 'src/hashmap.rs', lines 257:4-257:67 -/ + Source: 'tests/src/hashmap.rs', lines 265:4-265:67 -/ def hashmap.HashMap.get_mut (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result (T × (T → Result (hashmap.HashMap T))) @@ -347,7 +347,7 @@ def hashmap.HashMap.get_mut Result.ok (t, back) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: loop 0: - Source: 'src/hashmap.rs', lines 265:4-291:5 -/ + Source: 'tests/src/hashmap.rs', lines 273:4-299:5 -/ divergent def hashmap.HashMap.remove_from_list_loop (T : Type) (key : Usize) (ls : hashmap.List T) : Result ((Option T) × (hashmap.List T)) @@ -369,7 +369,7 @@ divergent def hashmap.HashMap.remove_from_list_loop | hashmap.List.Nil => Result.ok (none, hashmap.List.Nil) /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove_from_list]: - Source: 'src/hashmap.rs', lines 265:4-265:69 -/ + Source: 'tests/src/hashmap.rs', lines 273:4-273:69 -/ def hashmap.HashMap.remove_from_list (T : Type) (key : Usize) (ls : hashmap.List T) : Result ((Option T) × (hashmap.List T)) @@ -377,7 +377,7 @@ def hashmap.HashMap.remove_from_list hashmap.HashMap.remove_from_list_loop T key ls /- [hashmap_main::hashmap::{hashmap_main::hashmap::HashMap<T>}::remove]: - Source: 'src/hashmap.rs', lines 294:4-294:52 -/ + Source: 'tests/src/hashmap.rs', lines 302:4-302:52 -/ def hashmap.HashMap.remove (T : Type) (self : hashmap.HashMap T) (key : Usize) : Result ((Option T) × (hashmap.HashMap T)) @@ -403,7 +403,7 @@ def hashmap.HashMap.remove Result.ok (some x1, { self with num_entries := i1, slots := v }) /- [hashmap_main::hashmap::test1]: - Source: 'src/hashmap.rs', lines 315:0-315:10 -/ + Source: 'tests/src/hashmap.rs', lines 323:0-323:10 -/ def hashmap.test1 : Result Unit := do let hm ← hashmap.HashMap.new U64 @@ -447,7 +447,7 @@ def hashmap.test1 : Result Unit := else Result.ok () /- [hashmap_main::insert_on_disk]: - Source: 'src/hashmap_main.rs', lines 7:0-7:43 -/ + Source: 'tests/src/hashmap_main.rs', lines 13:0-13:43 -/ def insert_on_disk (key : Usize) (value : U64) (st : State) : Result (State × Unit) := do @@ -456,7 +456,7 @@ def insert_on_disk hashmap_utils.serialize hm1 st1 /- [hashmap_main::main]: - Source: 'src/hashmap_main.rs', lines 16:0-16:13 -/ + Source: 'tests/src/hashmap_main.rs', lines 22:0-22:13 -/ def main : Result Unit := Result.ok () diff --git a/tests/lean/HashmapMain/FunsExternal_Template.lean b/tests/lean/HashmapMain/FunsExternal_Template.lean index c09edbd2..1a6c40d5 100644 --- a/tests/lean/HashmapMain/FunsExternal_Template.lean +++ b/tests/lean/HashmapMain/FunsExternal_Template.lean @@ -7,12 +7,12 @@ open Primitives open hashmap_main /- [hashmap_main::hashmap_utils::deserialize]: - Source: 'src/hashmap_utils.rs', lines 10:0-10:43 -/ + Source: 'tests/src/hashmap_utils.rs', lines 11:0-11:43 -/ axiom hashmap_utils.deserialize : State → Result (State × (hashmap.HashMap U64)) /- [hashmap_main::hashmap_utils::serialize]: - Source: 'src/hashmap_utils.rs', lines 5:0-5:42 -/ + Source: 'tests/src/hashmap_utils.rs', lines 6:0-6:42 -/ axiom hashmap_utils.serialize : hashmap.HashMap U64 → State → Result (State × Unit) diff --git a/tests/lean/HashmapMain/Types.lean b/tests/lean/HashmapMain/Types.lean index ae9ac999..54f11e1e 100644 --- a/tests/lean/HashmapMain/Types.lean +++ b/tests/lean/HashmapMain/Types.lean @@ -7,13 +7,13 @@ open Primitives namespace hashmap_main /- [hashmap_main::hashmap::List] - Source: 'src/hashmap.rs', lines 19:0-19:16 -/ + Source: 'tests/src/hashmap.rs', lines 27:0-27:16 -/ inductive hashmap.List (T : Type) := | Cons : Usize → T → hashmap.List T → hashmap.List T | Nil : hashmap.List T /- [hashmap_main::hashmap::HashMap] - Source: 'src/hashmap.rs', lines 35:0-35:21 -/ + Source: 'tests/src/hashmap.rs', lines 43:0-43:21 -/ structure hashmap.HashMap (T : Type) where num_entries : Usize max_load_factor : (Usize × Usize) diff --git a/tests/lean/Loops.lean b/tests/lean/Loops.lean index eeba1add..54f1b24f 100644 --- a/tests/lean/Loops.lean +++ b/tests/lean/Loops.lean @@ -6,7 +6,7 @@ open Primitives namespace loops /- [loops::sum]: loop 0: - Source: 'src/loops.rs', lines 4:0-14:1 -/ + Source: 'tests/src/loops.rs', lines 7:0-17:1 -/ divergent def sum_loop (max : U32) (i : U32) (s : U32) : Result U32 := if i < max then do @@ -16,12 +16,12 @@ divergent def sum_loop (max : U32) (i : U32) (s : U32) : Result U32 := else s * 2#u32 /- [loops::sum]: - Source: 'src/loops.rs', lines 4:0-4:27 -/ + Source: 'tests/src/loops.rs', lines 7:0-7:27 -/ def sum (max : U32) : Result U32 := sum_loop max 0#u32 0#u32 /- [loops::sum_with_mut_borrows]: loop 0: - Source: 'src/loops.rs', lines 19:0-31:1 -/ + Source: 'tests/src/loops.rs', lines 22:0-34:1 -/ divergent def sum_with_mut_borrows_loop (max : U32) (i : U32) (s : U32) : Result U32 := if i < max @@ -33,12 +33,12 @@ divergent def sum_with_mut_borrows_loop else s * 2#u32 /- [loops::sum_with_mut_borrows]: - Source: 'src/loops.rs', lines 19:0-19:44 -/ + Source: 'tests/src/loops.rs', lines 22:0-22:44 -/ def sum_with_mut_borrows (max : U32) : Result U32 := sum_with_mut_borrows_loop max 0#u32 0#u32 /- [loops::sum_with_shared_borrows]: loop 0: - Source: 'src/loops.rs', lines 34:0-48:1 -/ + Source: 'tests/src/loops.rs', lines 37:0-51:1 -/ divergent def sum_with_shared_borrows_loop (max : U32) (i : U32) (s : U32) : Result U32 := if i < max @@ -50,12 +50,12 @@ divergent def sum_with_shared_borrows_loop else s * 2#u32 /- [loops::sum_with_shared_borrows]: - Source: 'src/loops.rs', lines 34:0-34:47 -/ + Source: 'tests/src/loops.rs', lines 37:0-37:47 -/ def sum_with_shared_borrows (max : U32) : Result U32 := sum_with_shared_borrows_loop max 0#u32 0#u32 /- [loops::sum_array]: loop 0: - Source: 'src/loops.rs', lines 50:0-58:1 -/ + Source: 'tests/src/loops.rs', lines 53:0-61:1 -/ divergent def sum_array_loop (N : Usize) (a : Array U32 N) (i : Usize) (s : U32) : Result U32 := if i < N @@ -68,12 +68,12 @@ divergent def sum_array_loop else Result.ok s /- [loops::sum_array]: - Source: 'src/loops.rs', lines 50:0-50:52 -/ + Source: 'tests/src/loops.rs', lines 53:0-53:52 -/ def sum_array (N : Usize) (a : Array U32 N) : Result U32 := sum_array_loop N a 0#usize 0#u32 /- [loops::clear]: loop 0: - Source: 'src/loops.rs', lines 62:0-68:1 -/ + Source: 'tests/src/loops.rs', lines 65:0-71:1 -/ divergent def clear_loop (v : alloc.vec.Vec U32) (i : Usize) : Result (alloc.vec.Vec U32) := let i1 := alloc.vec.Vec.len U32 v @@ -89,18 +89,18 @@ divergent def clear_loop else Result.ok v /- [loops::clear]: - Source: 'src/loops.rs', lines 62:0-62:30 -/ + Source: 'tests/src/loops.rs', lines 65:0-65:30 -/ def clear (v : alloc.vec.Vec U32) : Result (alloc.vec.Vec U32) := clear_loop v 0#usize /- [loops::List] - Source: 'src/loops.rs', lines 70:0-70:16 -/ + Source: 'tests/src/loops.rs', lines 73:0-73:16 -/ inductive List (T : Type) := | Cons : T → List T → List T | Nil : List T /- [loops::list_mem]: loop 0: - Source: 'src/loops.rs', lines 76:0-85:1 -/ + Source: 'tests/src/loops.rs', lines 79:0-88:1 -/ divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool := match ls with | List.Cons y tl => if y = x @@ -109,12 +109,12 @@ divergent def list_mem_loop (x : U32) (ls : List U32) : Result Bool := | List.Nil => Result.ok false /- [loops::list_mem]: - Source: 'src/loops.rs', lines 76:0-76:52 -/ + Source: 'tests/src/loops.rs', lines 79:0-79:52 -/ def list_mem (x : U32) (ls : List U32) : Result Bool := list_mem_loop x ls /- [loops::list_nth_mut_loop]: loop 0: - Source: 'src/loops.rs', lines 88:0-98:1 -/ + Source: 'tests/src/loops.rs', lines 91:0-101:1 -/ divergent def list_nth_mut_loop_loop (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) := match ls with @@ -135,13 +135,13 @@ divergent def list_nth_mut_loop_loop | List.Nil => Result.fail .panic /- [loops::list_nth_mut_loop]: - Source: 'src/loops.rs', lines 88:0-88:71 -/ + Source: 'tests/src/loops.rs', lines 91:0-91:71 -/ def list_nth_mut_loop (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) := list_nth_mut_loop_loop T ls i /- [loops::list_nth_shared_loop]: loop 0: - Source: 'src/loops.rs', lines 101:0-111:1 -/ + Source: 'tests/src/loops.rs', lines 104:0-114:1 -/ divergent def list_nth_shared_loop_loop (T : Type) (ls : List T) (i : U32) : Result T := match ls with @@ -154,12 +154,12 @@ divergent def list_nth_shared_loop_loop | List.Nil => Result.fail .panic /- [loops::list_nth_shared_loop]: - Source: 'src/loops.rs', lines 101:0-101:66 -/ + Source: 'tests/src/loops.rs', lines 104:0-104:66 -/ def list_nth_shared_loop (T : Type) (ls : List T) (i : U32) : Result T := list_nth_shared_loop_loop T ls i /- [loops::get_elem_mut]: loop 0: - Source: 'src/loops.rs', lines 113:0-127:1 -/ + Source: 'tests/src/loops.rs', lines 116:0-130:1 -/ divergent def get_elem_mut_loop (x : Usize) (ls : List Usize) : Result (Usize × (Usize → Result (List Usize))) @@ -181,7 +181,7 @@ divergent def get_elem_mut_loop | List.Nil => Result.fail .panic /- [loops::get_elem_mut]: - Source: 'src/loops.rs', lines 113:0-113:73 -/ + Source: 'tests/src/loops.rs', lines 116:0-116:73 -/ def get_elem_mut (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result (Usize × (Usize → Result (alloc.vec.Vec (List Usize)))) @@ -197,7 +197,7 @@ def get_elem_mut Result.ok (i, back1) /- [loops::get_elem_shared]: loop 0: - Source: 'src/loops.rs', lines 129:0-143:1 -/ + Source: 'tests/src/loops.rs', lines 132:0-146:1 -/ divergent def get_elem_shared_loop (x : Usize) (ls : List Usize) : Result Usize := match ls with @@ -207,7 +207,7 @@ divergent def get_elem_shared_loop | List.Nil => Result.fail .panic /- [loops::get_elem_shared]: - Source: 'src/loops.rs', lines 129:0-129:68 -/ + Source: 'tests/src/loops.rs', lines 132:0-132:68 -/ def get_elem_shared (slots : alloc.vec.Vec (List Usize)) (x : Usize) : Result Usize := do @@ -217,7 +217,7 @@ def get_elem_shared get_elem_shared_loop x ls /- [loops::id_mut]: - Source: 'src/loops.rs', lines 145:0-145:50 -/ + Source: 'tests/src/loops.rs', lines 148:0-148:50 -/ def id_mut (T : Type) (ls : List T) : Result ((List T) × (List T → Result (List T))) @@ -225,12 +225,12 @@ def id_mut Result.ok (ls, Result.ok) /- [loops::id_shared]: - Source: 'src/loops.rs', lines 149:0-149:45 -/ + Source: 'tests/src/loops.rs', lines 152:0-152:45 -/ def id_shared (T : Type) (ls : List T) : Result (List T) := Result.ok ls /- [loops::list_nth_mut_loop_with_id]: loop 0: - Source: 'src/loops.rs', lines 154:0-165:1 -/ + Source: 'tests/src/loops.rs', lines 157:0-168:1 -/ divergent def list_nth_mut_loop_with_id_loop (T : Type) (i : U32) (ls : List T) : Result (T × (T → Result (List T))) := match ls with @@ -251,7 +251,7 @@ divergent def list_nth_mut_loop_with_id_loop | List.Nil => Result.fail .panic /- [loops::list_nth_mut_loop_with_id]: - Source: 'src/loops.rs', lines 154:0-154:75 -/ + Source: 'tests/src/loops.rs', lines 157:0-157:75 -/ def list_nth_mut_loop_with_id (T : Type) (ls : List T) (i : U32) : Result (T × (T → Result (List T))) := do @@ -263,7 +263,7 @@ def list_nth_mut_loop_with_id Result.ok (t, back1) /- [loops::list_nth_shared_loop_with_id]: loop 0: - Source: 'src/loops.rs', lines 168:0-179:1 -/ + Source: 'tests/src/loops.rs', lines 171:0-182:1 -/ divergent def list_nth_shared_loop_with_id_loop (T : Type) (i : U32) (ls : List T) : Result T := match ls with @@ -276,7 +276,7 @@ divergent def list_nth_shared_loop_with_id_loop | List.Nil => Result.fail .panic /- [loops::list_nth_shared_loop_with_id]: - Source: 'src/loops.rs', lines 168:0-168:70 -/ + Source: 'tests/src/loops.rs', lines 171:0-171:70 -/ def list_nth_shared_loop_with_id (T : Type) (ls : List T) (i : U32) : Result T := do @@ -284,7 +284,7 @@ def list_nth_shared_loop_with_id list_nth_shared_loop_with_id_loop T i ls1 /- [loops::list_nth_mut_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 184:0-205:1 -/ + Source: 'tests/src/loops.rs', lines 187:0-208:1 -/ divergent def list_nth_mut_loop_pair_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T)) × (T → Result (List T))) @@ -315,7 +315,7 @@ divergent def list_nth_mut_loop_pair_loop | List.Nil => Result.fail .panic /- [loops::list_nth_mut_loop_pair]: - Source: 'src/loops.rs', lines 184:0-188:27 -/ + Source: 'tests/src/loops.rs', lines 187:0-191:27 -/ def list_nth_mut_loop_pair (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T)) × (T → Result (List T))) @@ -323,7 +323,7 @@ def list_nth_mut_loop_pair list_nth_mut_loop_pair_loop T ls0 ls1 i /- [loops::list_nth_shared_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 208:0-229:1 -/ + Source: 'tests/src/loops.rs', lines 211:0-232:1 -/ divergent def list_nth_shared_loop_pair_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := match ls0 with @@ -339,13 +339,13 @@ divergent def list_nth_shared_loop_pair_loop | List.Nil => Result.fail .panic /- [loops::list_nth_shared_loop_pair]: - Source: 'src/loops.rs', lines 208:0-212:19 -/ + Source: 'tests/src/loops.rs', lines 211:0-215:19 -/ def list_nth_shared_loop_pair (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := list_nth_shared_loop_pair_loop T ls0 ls1 i /- [loops::list_nth_mut_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 233:0-248:1 -/ + Source: 'tests/src/loops.rs', lines 236:0-251:1 -/ divergent def list_nth_mut_loop_pair_merge_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × ((T × T) → Result ((List T) × (List T)))) @@ -375,7 +375,7 @@ divergent def list_nth_mut_loop_pair_merge_loop | List.Nil => Result.fail .panic /- [loops::list_nth_mut_loop_pair_merge]: - Source: 'src/loops.rs', lines 233:0-237:27 -/ + Source: 'tests/src/loops.rs', lines 236:0-240:27 -/ def list_nth_mut_loop_pair_merge (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × ((T × T) → Result ((List T) × (List T)))) @@ -383,7 +383,7 @@ def list_nth_mut_loop_pair_merge list_nth_mut_loop_pair_merge_loop T ls0 ls1 i /- [loops::list_nth_shared_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 251:0-266:1 -/ + Source: 'tests/src/loops.rs', lines 254:0-269:1 -/ divergent def list_nth_shared_loop_pair_merge_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := match ls0 with @@ -400,13 +400,13 @@ divergent def list_nth_shared_loop_pair_merge_loop | List.Nil => Result.fail .panic /- [loops::list_nth_shared_loop_pair_merge]: - Source: 'src/loops.rs', lines 251:0-255:19 -/ + Source: 'tests/src/loops.rs', lines 254:0-258:19 -/ def list_nth_shared_loop_pair_merge (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result (T × T) := list_nth_shared_loop_pair_merge_loop T ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 269:0-284:1 -/ + Source: 'tests/src/loops.rs', lines 272:0-287:1 -/ divergent def list_nth_mut_shared_loop_pair_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T))) @@ -432,7 +432,7 @@ divergent def list_nth_mut_shared_loop_pair_loop | List.Nil => Result.fail .panic /- [loops::list_nth_mut_shared_loop_pair]: - Source: 'src/loops.rs', lines 269:0-273:23 -/ + Source: 'tests/src/loops.rs', lines 272:0-276:23 -/ def list_nth_mut_shared_loop_pair (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T))) @@ -440,7 +440,7 @@ def list_nth_mut_shared_loop_pair list_nth_mut_shared_loop_pair_loop T ls0 ls1 i /- [loops::list_nth_mut_shared_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 288:0-303:1 -/ + Source: 'tests/src/loops.rs', lines 291:0-306:1 -/ divergent def list_nth_mut_shared_loop_pair_merge_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T))) @@ -466,7 +466,7 @@ divergent def list_nth_mut_shared_loop_pair_merge_loop | List.Nil => Result.fail .panic /- [loops::list_nth_mut_shared_loop_pair_merge]: - Source: 'src/loops.rs', lines 288:0-292:23 -/ + Source: 'tests/src/loops.rs', lines 291:0-295:23 -/ def list_nth_mut_shared_loop_pair_merge (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T))) @@ -474,7 +474,7 @@ def list_nth_mut_shared_loop_pair_merge list_nth_mut_shared_loop_pair_merge_loop T ls0 ls1 i /- [loops::list_nth_shared_mut_loop_pair]: loop 0: - Source: 'src/loops.rs', lines 307:0-322:1 -/ + Source: 'tests/src/loops.rs', lines 310:0-325:1 -/ divergent def list_nth_shared_mut_loop_pair_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T))) @@ -500,7 +500,7 @@ divergent def list_nth_shared_mut_loop_pair_loop | List.Nil => Result.fail .panic /- [loops::list_nth_shared_mut_loop_pair]: - Source: 'src/loops.rs', lines 307:0-311:23 -/ + Source: 'tests/src/loops.rs', lines 310:0-314:23 -/ def list_nth_shared_mut_loop_pair (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T))) @@ -508,7 +508,7 @@ def list_nth_shared_mut_loop_pair list_nth_shared_mut_loop_pair_loop T ls0 ls1 i /- [loops::list_nth_shared_mut_loop_pair_merge]: loop 0: - Source: 'src/loops.rs', lines 326:0-341:1 -/ + Source: 'tests/src/loops.rs', lines 329:0-344:1 -/ divergent def list_nth_shared_mut_loop_pair_merge_loop (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T))) @@ -534,7 +534,7 @@ divergent def list_nth_shared_mut_loop_pair_merge_loop | List.Nil => Result.fail .panic /- [loops::list_nth_shared_mut_loop_pair_merge]: - Source: 'src/loops.rs', lines 326:0-330:23 -/ + Source: 'tests/src/loops.rs', lines 329:0-333:23 -/ def list_nth_shared_mut_loop_pair_merge (T : Type) (ls0 : List T) (ls1 : List T) (i : U32) : Result ((T × T) × (T → Result (List T))) @@ -542,7 +542,7 @@ def list_nth_shared_mut_loop_pair_merge list_nth_shared_mut_loop_pair_merge_loop T ls0 ls1 i /- [loops::ignore_input_mut_borrow]: loop 0: - Source: 'src/loops.rs', lines 345:0-349:1 -/ + Source: 'tests/src/loops.rs', lines 348:0-352:1 -/ divergent def ignore_input_mut_borrow_loop (i : U32) : Result Unit := if i > 0#u32 then do @@ -551,14 +551,14 @@ divergent def ignore_input_mut_borrow_loop (i : U32) : Result Unit := else Result.ok () /- [loops::ignore_input_mut_borrow]: - Source: 'src/loops.rs', lines 345:0-345:56 -/ + Source: 'tests/src/loops.rs', lines 348:0-348:56 -/ def ignore_input_mut_borrow (_a : U32) (i : U32) : Result U32 := do let _ ← ignore_input_mut_borrow_loop i Result.ok _a /- [loops::incr_ignore_input_mut_borrow]: loop 0: - Source: 'src/loops.rs', lines 353:0-358:1 -/ + Source: 'tests/src/loops.rs', lines 356:0-361:1 -/ divergent def incr_ignore_input_mut_borrow_loop (i : U32) : Result Unit := if i > 0#u32 then do @@ -567,7 +567,7 @@ divergent def incr_ignore_input_mut_borrow_loop (i : U32) : Result Unit := else Result.ok () /- [loops::incr_ignore_input_mut_borrow]: - Source: 'src/loops.rs', lines 353:0-353:60 -/ + Source: 'tests/src/loops.rs', lines 356:0-356:60 -/ def incr_ignore_input_mut_borrow (a : U32) (i : U32) : Result U32 := do let a1 ← a + 1#u32 @@ -575,7 +575,7 @@ def incr_ignore_input_mut_borrow (a : U32) (i : U32) : Result U32 := Result.ok a1 /- [loops::ignore_input_shared_borrow]: loop 0: - Source: 'src/loops.rs', lines 362:0-366:1 -/ + Source: 'tests/src/loops.rs', lines 365:0-369:1 -/ divergent def ignore_input_shared_borrow_loop (i : U32) : Result Unit := if i > 0#u32 then do @@ -584,7 +584,7 @@ divergent def ignore_input_shared_borrow_loop (i : U32) : Result Unit := else Result.ok () /- [loops::ignore_input_shared_borrow]: - Source: 'src/loops.rs', lines 362:0-362:59 -/ + Source: 'tests/src/loops.rs', lines 365:0-365:59 -/ def ignore_input_shared_borrow (_a : U32) (i : U32) : Result U32 := do let _ ← ignore_input_shared_borrow_loop i diff --git a/tests/lean/NoNestedBorrows.lean b/tests/lean/NoNestedBorrows.lean index 66ec917b..1781ac71 100644 --- a/tests/lean/NoNestedBorrows.lean +++ b/tests/lean/NoNestedBorrows.lean @@ -6,60 +6,60 @@ open Primitives namespace no_nested_borrows /- [no_nested_borrows::Pair] - Source: 'src/no_nested_borrows.rs', lines 4:0-4:23 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 6:0-6:23 -/ structure Pair (T1 T2 : Type) where x : T1 y : T2 /- [no_nested_borrows::List] - Source: 'src/no_nested_borrows.rs', lines 9:0-9:16 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 11:0-11:16 -/ inductive List (T : Type) := | Cons : T → List T → List T | Nil : List T /- [no_nested_borrows::One] - Source: 'src/no_nested_borrows.rs', lines 20:0-20:16 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 22:0-22:16 -/ inductive One (T1 : Type) := | One : T1 → One T1 /- [no_nested_borrows::EmptyEnum] - Source: 'src/no_nested_borrows.rs', lines 26:0-26:18 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 28:0-28:18 -/ inductive EmptyEnum := | Empty : EmptyEnum /- [no_nested_borrows::Enum] - Source: 'src/no_nested_borrows.rs', lines 32:0-32:13 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 34:0-34:13 -/ inductive Enum := | Variant1 : Enum | Variant2 : Enum /- [no_nested_borrows::EmptyStruct] - Source: 'src/no_nested_borrows.rs', lines 39:0-39:22 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 41:0-41:22 -/ @[reducible] def EmptyStruct := Unit /- [no_nested_borrows::Sum] - Source: 'src/no_nested_borrows.rs', lines 41:0-41:20 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 43:0-43:20 -/ inductive Sum (T1 T2 : Type) := | Left : T1 → Sum T1 T2 | Right : T2 → Sum T1 T2 /- [no_nested_borrows::cast_u32_to_i32]: - Source: 'src/no_nested_borrows.rs', lines 46:0-46:37 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 48:0-48:37 -/ def cast_u32_to_i32 (x : U32) : Result I32 := Scalar.cast .I32 x /- [no_nested_borrows::cast_bool_to_i32]: - Source: 'src/no_nested_borrows.rs', lines 50:0-50:39 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 52:0-52:39 -/ def cast_bool_to_i32 (x : Bool) : Result I32 := Scalar.cast_bool .I32 x /- [no_nested_borrows::cast_bool_to_bool]: - Source: 'src/no_nested_borrows.rs', lines 55:0-55:41 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 57:0-57:41 -/ def cast_bool_to_bool (x : Bool) : Result Bool := Result.ok x /- [no_nested_borrows::test2]: - Source: 'src/no_nested_borrows.rs', lines 60:0-60:14 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 62:0-62:14 -/ def test2 : Result Unit := do let _ ← 23#u32 + 44#u32 @@ -69,14 +69,14 @@ def test2 : Result Unit := #assert (test2 == Result.ok ()) /- [no_nested_borrows::get_max]: - Source: 'src/no_nested_borrows.rs', lines 72:0-72:37 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 74:0-74:37 -/ def get_max (x : U32) (y : U32) : Result U32 := if x >= y then Result.ok x else Result.ok y /- [no_nested_borrows::test3]: - Source: 'src/no_nested_borrows.rs', lines 80:0-80:14 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 82:0-82:14 -/ def test3 : Result Unit := do let x ← get_max 4#u32 3#u32 @@ -90,7 +90,7 @@ def test3 : Result Unit := #assert (test3 == Result.ok ()) /- [no_nested_borrows::test_neg1]: - Source: 'src/no_nested_borrows.rs', lines 87:0-87:18 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 89:0-89:18 -/ def test_neg1 : Result Unit := do let y ← -. 3#i32 @@ -102,7 +102,7 @@ def test_neg1 : Result Unit := #assert (test_neg1 == Result.ok ()) /- [no_nested_borrows::refs_test1]: - Source: 'src/no_nested_borrows.rs', lines 94:0-94:19 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 96:0-96:19 -/ def refs_test1 : Result Unit := if ¬ (1#i32 = 1#i32) then Result.fail .panic @@ -112,7 +112,7 @@ def refs_test1 : Result Unit := #assert (refs_test1 == Result.ok ()) /- [no_nested_borrows::refs_test2]: - Source: 'src/no_nested_borrows.rs', lines 105:0-105:19 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 107:0-107:19 -/ def refs_test2 : Result Unit := if ¬ (2#i32 = 2#i32) then Result.fail .panic @@ -130,7 +130,7 @@ def refs_test2 : Result Unit := #assert (refs_test2 == Result.ok ()) /- [no_nested_borrows::test_list1]: - Source: 'src/no_nested_borrows.rs', lines 121:0-121:19 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 123:0-123:19 -/ def test_list1 : Result Unit := Result.ok () @@ -138,7 +138,7 @@ def test_list1 : Result Unit := #assert (test_list1 == Result.ok ()) /- [no_nested_borrows::test_box1]: - Source: 'src/no_nested_borrows.rs', lines 126:0-126:18 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 128:0-128:18 -/ def test_box1 : Result Unit := do let (_, deref_mut_back) ← alloc.boxed.Box.deref_mut I32 0#i32 @@ -152,26 +152,26 @@ def test_box1 : Result Unit := #assert (test_box1 == Result.ok ()) /- [no_nested_borrows::copy_int]: - Source: 'src/no_nested_borrows.rs', lines 136:0-136:30 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 138:0-138:30 -/ def copy_int (x : I32) : Result I32 := Result.ok x /- [no_nested_borrows::test_unreachable]: - Source: 'src/no_nested_borrows.rs', lines 142:0-142:32 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 144:0-144:32 -/ def test_unreachable (b : Bool) : Result Unit := if b then Result.fail .panic else Result.ok () /- [no_nested_borrows::test_panic]: - Source: 'src/no_nested_borrows.rs', lines 150:0-150:26 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 152:0-152:26 -/ def test_panic (b : Bool) : Result Unit := if b then Result.fail .panic else Result.ok () /- [no_nested_borrows::test_copy_int]: - Source: 'src/no_nested_borrows.rs', lines 157:0-157:22 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 159:0-159:22 -/ def test_copy_int : Result Unit := do let y ← copy_int 0#i32 @@ -183,14 +183,14 @@ def test_copy_int : Result Unit := #assert (test_copy_int == Result.ok ()) /- [no_nested_borrows::is_cons]: - Source: 'src/no_nested_borrows.rs', lines 164:0-164:38 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 166:0-166:38 -/ def is_cons (T : Type) (l : List T) : Result Bool := match l with | List.Cons _ _ => Result.ok true | List.Nil => Result.ok false /- [no_nested_borrows::test_is_cons]: - Source: 'src/no_nested_borrows.rs', lines 171:0-171:21 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 173:0-173:21 -/ def test_is_cons : Result Unit := do let b ← is_cons I32 (List.Cons 0#i32 List.Nil) @@ -202,14 +202,14 @@ def test_is_cons : Result Unit := #assert (test_is_cons == Result.ok ()) /- [no_nested_borrows::split_list]: - Source: 'src/no_nested_borrows.rs', lines 177:0-177:48 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 179:0-179:48 -/ def split_list (T : Type) (l : List T) : Result (T × (List T)) := match l with | List.Cons hd tl => Result.ok (hd, tl) | List.Nil => Result.fail .panic /- [no_nested_borrows::test_split_list]: - Source: 'src/no_nested_borrows.rs', lines 185:0-185:24 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 187:0-187:24 -/ def test_split_list : Result Unit := do let p ← split_list I32 (List.Cons 0#i32 List.Nil) @@ -222,7 +222,7 @@ def test_split_list : Result Unit := #assert (test_split_list == Result.ok ()) /- [no_nested_borrows::choose]: - Source: 'src/no_nested_borrows.rs', lines 192:0-192:70 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 194:0-194:70 -/ def choose (T : Type) (b : Bool) (x : T) (y : T) : Result (T × (T → Result (T × T))) @@ -234,7 +234,7 @@ def choose Result.ok (y, back) /- [no_nested_borrows::choose_test]: - Source: 'src/no_nested_borrows.rs', lines 200:0-200:20 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 202:0-202:20 -/ def choose_test : Result Unit := do let (z, choose_back) ← choose I32 true 0#i32 0#i32 @@ -254,20 +254,20 @@ def choose_test : Result Unit := #assert (choose_test == Result.ok ()) /- [no_nested_borrows::test_char]: - Source: 'src/no_nested_borrows.rs', lines 212:0-212:26 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 214:0-214:26 -/ def test_char : Result Char := Result.ok 'a' mutual /- [no_nested_borrows::Tree] - Source: 'src/no_nested_borrows.rs', lines 217:0-217:16 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 219:0-219:16 -/ inductive Tree (T : Type) := | Leaf : T → Tree T | Node : T → NodeElem T → Tree T → Tree T /- [no_nested_borrows::NodeElem] - Source: 'src/no_nested_borrows.rs', lines 222:0-222:20 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 224:0-224:20 -/ inductive NodeElem (T : Type) := | Cons : Tree T → NodeElem T → NodeElem T | Nil : NodeElem T @@ -275,7 +275,7 @@ inductive NodeElem (T : Type) := end /- [no_nested_borrows::list_length]: - Source: 'src/no_nested_borrows.rs', lines 257:0-257:48 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 259:0-259:48 -/ divergent def list_length (T : Type) (l : List T) : Result U32 := match l with | List.Cons _ l1 => do @@ -284,7 +284,7 @@ divergent def list_length (T : Type) (l : List T) : Result U32 := | List.Nil => Result.ok 0#u32 /- [no_nested_borrows::list_nth_shared]: - Source: 'src/no_nested_borrows.rs', lines 265:0-265:62 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 267:0-267:62 -/ divergent def list_nth_shared (T : Type) (l : List T) (i : U32) : Result T := match l with | List.Cons x tl => @@ -296,7 +296,7 @@ divergent def list_nth_shared (T : Type) (l : List T) (i : U32) : Result T := | List.Nil => Result.fail .panic /- [no_nested_borrows::list_nth_mut]: - Source: 'src/no_nested_borrows.rs', lines 281:0-281:67 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 283:0-283:67 -/ divergent def list_nth_mut (T : Type) (l : List T) (i : U32) : Result (T × (T → Result (List T))) := match l with @@ -318,7 +318,7 @@ divergent def list_nth_mut | List.Nil => Result.fail .panic /- [no_nested_borrows::list_rev_aux]: - Source: 'src/no_nested_borrows.rs', lines 297:0-297:63 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 299:0-299:63 -/ divergent def list_rev_aux (T : Type) (li : List T) (lo : List T) : Result (List T) := match li with @@ -326,13 +326,13 @@ divergent def list_rev_aux | List.Nil => Result.ok lo /- [no_nested_borrows::list_rev]: - Source: 'src/no_nested_borrows.rs', lines 311:0-311:42 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 313:0-313:42 -/ def list_rev (T : Type) (l : List T) : Result (List T) := let (li, _) := core.mem.replace (List T) l List.Nil list_rev_aux T li List.Nil /- [no_nested_borrows::test_list_functions]: - Source: 'src/no_nested_borrows.rs', lines 316:0-316:28 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 318:0-318:28 -/ def test_list_functions : Result Unit := do let l := List.Cons 2#i32 List.Nil @@ -379,7 +379,7 @@ def test_list_functions : Result Unit := #assert (test_list_functions == Result.ok ()) /- [no_nested_borrows::id_mut_pair1]: - Source: 'src/no_nested_borrows.rs', lines 332:0-332:89 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 334:0-334:89 -/ def id_mut_pair1 (T1 T2 : Type) (x : T1) (y : T2) : Result ((T1 × T2) × ((T1 × T2) → Result (T1 × T2))) @@ -387,7 +387,7 @@ def id_mut_pair1 Result.ok ((x, y), Result.ok) /- [no_nested_borrows::id_mut_pair2]: - Source: 'src/no_nested_borrows.rs', lines 336:0-336:88 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 338:0-338:88 -/ def id_mut_pair2 (T1 T2 : Type) (p : (T1 × T2)) : Result ((T1 × T2) × ((T1 × T2) → Result (T1 × T2))) @@ -396,7 +396,7 @@ def id_mut_pair2 Result.ok ((t, t1), Result.ok) /- [no_nested_borrows::id_mut_pair3]: - Source: 'src/no_nested_borrows.rs', lines 340:0-340:93 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 342:0-342:93 -/ def id_mut_pair3 (T1 T2 : Type) (x : T1) (y : T2) : Result ((T1 × T2) × (T1 → Result T1) × (T2 → Result T2)) @@ -404,7 +404,7 @@ def id_mut_pair3 Result.ok ((x, y), Result.ok, Result.ok) /- [no_nested_borrows::id_mut_pair4]: - Source: 'src/no_nested_borrows.rs', lines 344:0-344:92 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 346:0-346:92 -/ def id_mut_pair4 (T1 T2 : Type) (p : (T1 × T2)) : Result ((T1 × T2) × (T1 → Result T1) × (T2 → Result T2)) @@ -413,37 +413,37 @@ def id_mut_pair4 Result.ok ((t, t1), Result.ok, Result.ok) /- [no_nested_borrows::StructWithTuple] - Source: 'src/no_nested_borrows.rs', lines 351:0-351:34 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 353:0-353:34 -/ structure StructWithTuple (T1 T2 : Type) where p : (T1 × T2) /- [no_nested_borrows::new_tuple1]: - Source: 'src/no_nested_borrows.rs', lines 355:0-355:48 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 357:0-357:48 -/ def new_tuple1 : Result (StructWithTuple U32 U32) := Result.ok { p := (1#u32, 2#u32) } /- [no_nested_borrows::new_tuple2]: - Source: 'src/no_nested_borrows.rs', lines 359:0-359:48 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 361:0-361:48 -/ def new_tuple2 : Result (StructWithTuple I16 I16) := Result.ok { p := (1#i16, 2#i16) } /- [no_nested_borrows::new_tuple3]: - Source: 'src/no_nested_borrows.rs', lines 363:0-363:48 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 365:0-365:48 -/ def new_tuple3 : Result (StructWithTuple U64 I64) := Result.ok { p := (1#u64, 2#i64) } /- [no_nested_borrows::StructWithPair] - Source: 'src/no_nested_borrows.rs', lines 368:0-368:33 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 370:0-370:33 -/ structure StructWithPair (T1 T2 : Type) where p : Pair T1 T2 /- [no_nested_borrows::new_pair1]: - Source: 'src/no_nested_borrows.rs', lines 372:0-372:46 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 374:0-374:46 -/ def new_pair1 : Result (StructWithPair U32 U32) := Result.ok { p := { x := 1#u32, y := 2#u32 } } /- [no_nested_borrows::test_constants]: - Source: 'src/no_nested_borrows.rs', lines 380:0-380:23 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 382:0-382:23 -/ def test_constants : Result Unit := do let swt ← new_tuple1 @@ -473,7 +473,7 @@ def test_constants : Result Unit := #assert (test_constants == Result.ok ()) /- [no_nested_borrows::test_weird_borrows1]: - Source: 'src/no_nested_borrows.rs', lines 389:0-389:28 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 391:0-391:28 -/ def test_weird_borrows1 : Result Unit := Result.ok () @@ -481,7 +481,7 @@ def test_weird_borrows1 : Result Unit := #assert (test_weird_borrows1 == Result.ok ()) /- [no_nested_borrows::test_mem_replace]: - Source: 'src/no_nested_borrows.rs', lines 399:0-399:37 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 401:0-401:37 -/ def test_mem_replace (px : U32) : Result U32 := let (y, _) := core.mem.replace U32 px 1#u32 if ¬ (y = 0#u32) @@ -489,71 +489,71 @@ def test_mem_replace (px : U32) : Result U32 := else Result.ok 2#u32 /- [no_nested_borrows::test_shared_borrow_bool1]: - Source: 'src/no_nested_borrows.rs', lines 406:0-406:47 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 408:0-408:47 -/ def test_shared_borrow_bool1 (b : Bool) : Result U32 := if b then Result.ok 0#u32 else Result.ok 1#u32 /- [no_nested_borrows::test_shared_borrow_bool2]: - Source: 'src/no_nested_borrows.rs', lines 419:0-419:40 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 421:0-421:40 -/ def test_shared_borrow_bool2 : Result U32 := Result.ok 0#u32 /- [no_nested_borrows::test_shared_borrow_enum1]: - Source: 'src/no_nested_borrows.rs', lines 434:0-434:52 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 436:0-436:52 -/ def test_shared_borrow_enum1 (l : List U32) : Result U32 := match l with | List.Cons _ _ => Result.ok 1#u32 | List.Nil => Result.ok 0#u32 /- [no_nested_borrows::test_shared_borrow_enum2]: - Source: 'src/no_nested_borrows.rs', lines 446:0-446:40 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 448:0-448:40 -/ def test_shared_borrow_enum2 : Result U32 := Result.ok 0#u32 /- [no_nested_borrows::incr]: - Source: 'src/no_nested_borrows.rs', lines 457:0-457:24 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 459:0-459:24 -/ def incr (x : U32) : Result U32 := x + 1#u32 /- [no_nested_borrows::call_incr]: - Source: 'src/no_nested_borrows.rs', lines 461:0-461:35 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 463:0-463:35 -/ def call_incr (x : U32) : Result U32 := incr x /- [no_nested_borrows::read_then_incr]: - Source: 'src/no_nested_borrows.rs', lines 466:0-466:41 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 468:0-468:41 -/ def read_then_incr (x : U32) : Result (U32 × U32) := do let x1 ← x + 1#u32 Result.ok (x, x1) /- [no_nested_borrows::Tuple] - Source: 'src/no_nested_borrows.rs', lines 472:0-472:24 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 474:0-474:24 -/ def Tuple (T1 T2 : Type) := T1 × T2 /- [no_nested_borrows::use_tuple_struct]: - Source: 'src/no_nested_borrows.rs', lines 474:0-474:48 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 476:0-476:48 -/ def use_tuple_struct (x : Tuple U32 U32) : Result (Tuple U32 U32) := Result.ok (1#u32, x.#1) /- [no_nested_borrows::create_tuple_struct]: - Source: 'src/no_nested_borrows.rs', lines 478:0-478:61 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 480:0-480:61 -/ def create_tuple_struct (x : U32) (y : U64) : Result (Tuple U32 U64) := Result.ok (x, y) /- [no_nested_borrows::IdType] - Source: 'src/no_nested_borrows.rs', lines 483:0-483:20 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 485:0-485:20 -/ @[reducible] def IdType (T : Type) := T /- [no_nested_borrows::use_id_type]: - Source: 'src/no_nested_borrows.rs', lines 485:0-485:40 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 487:0-487:40 -/ def use_id_type (T : Type) (x : IdType T) : Result T := Result.ok x /- [no_nested_borrows::create_id_type]: - Source: 'src/no_nested_borrows.rs', lines 489:0-489:43 -/ + Source: 'tests/src/no_nested_borrows.rs', lines 491:0-491:43 -/ def create_id_type (T : Type) (x : T) : Result (IdType T) := Result.ok x diff --git a/tests/lean/Paper.lean b/tests/lean/Paper.lean index 32203eca..e98ada42 100644 --- a/tests/lean/Paper.lean +++ b/tests/lean/Paper.lean @@ -6,12 +6,12 @@ open Primitives namespace paper /- [paper::ref_incr]: - Source: 'src/paper.rs', lines 4:0-4:28 -/ + Source: 'tests/src/paper.rs', lines 6:0-6:28 -/ def ref_incr (x : I32) : Result I32 := x + 1#i32 /- [paper::test_incr]: - Source: 'src/paper.rs', lines 8:0-8:18 -/ + Source: 'tests/src/paper.rs', lines 10:0-10:18 -/ def test_incr : Result Unit := do let x ← ref_incr 0#i32 @@ -23,7 +23,7 @@ def test_incr : Result Unit := #assert (test_incr == Result.ok ()) /- [paper::choose]: - Source: 'src/paper.rs', lines 15:0-15:70 -/ + Source: 'tests/src/paper.rs', lines 17:0-17:70 -/ def choose (T : Type) (b : Bool) (x : T) (y : T) : Result (T × (T → Result (T × T))) @@ -35,7 +35,7 @@ def choose Result.ok (y, back) /- [paper::test_choose]: - Source: 'src/paper.rs', lines 23:0-23:20 -/ + Source: 'tests/src/paper.rs', lines 25:0-25:20 -/ def test_choose : Result Unit := do let (z, choose_back) ← choose I32 true 0#i32 0#i32 @@ -55,13 +55,13 @@ def test_choose : Result Unit := #assert (test_choose == Result.ok ()) /- [paper::List] - Source: 'src/paper.rs', lines 35:0-35:16 -/ + Source: 'tests/src/paper.rs', lines 37:0-37:16 -/ inductive List (T : Type) := | Cons : T → List T → List T | Nil : List T /- [paper::list_nth_mut]: - Source: 'src/paper.rs', lines 42:0-42:67 -/ + Source: 'tests/src/paper.rs', lines 44:0-44:67 -/ divergent def list_nth_mut (T : Type) (l : List T) (i : U32) : Result (T × (T → Result (List T))) := match l with @@ -83,7 +83,7 @@ divergent def list_nth_mut | List.Nil => Result.fail .panic /- [paper::sum]: - Source: 'src/paper.rs', lines 57:0-57:32 -/ + Source: 'tests/src/paper.rs', lines 59:0-59:32 -/ divergent def sum (l : List I32) : Result I32 := match l with | List.Cons x tl => do @@ -92,7 +92,7 @@ divergent def sum (l : List I32) : Result I32 := | List.Nil => Result.ok 0#i32 /- [paper::test_nth]: - Source: 'src/paper.rs', lines 68:0-68:17 -/ + Source: 'tests/src/paper.rs', lines 70:0-70:17 -/ def test_nth : Result Unit := do let l := List.Cons 3#i32 List.Nil @@ -109,7 +109,7 @@ def test_nth : Result Unit := #assert (test_nth == Result.ok ()) /- [paper::call_choose]: - Source: 'src/paper.rs', lines 76:0-76:44 -/ + Source: 'tests/src/paper.rs', lines 78:0-78:44 -/ def call_choose (p : (U32 × U32)) : Result U32 := do let (px, py) := p diff --git a/tests/lean/PoloniusList.lean b/tests/lean/PoloniusList.lean index 09f41056..defa48c7 100644 --- a/tests/lean/PoloniusList.lean +++ b/tests/lean/PoloniusList.lean @@ -6,13 +6,13 @@ open Primitives namespace polonius_list /- [polonius_list::List] - Source: 'src/polonius_list.rs', lines 3:0-3:16 -/ + Source: 'tests/src/polonius_list.rs', lines 5:0-5:16 -/ inductive List (T : Type) := | Cons : T → List T → List T | Nil : List T /- [polonius_list::get_list_at_x]: - Source: 'src/polonius_list.rs', lines 13:0-13:76 -/ + Source: 'tests/src/polonius_list.rs', lines 15:0-15:76 -/ divergent def get_list_at_x (ls : List U32) (x : U32) : Result ((List U32) × (List U32 → Result (List U32))) diff --git a/tests/lean/Traits.lean b/tests/lean/Traits.lean index 3746d494..7cacb836 100644 --- a/tests/lean/Traits.lean +++ b/tests/lean/Traits.lean @@ -6,29 +6,29 @@ open Primitives namespace traits /- Trait declaration: [traits::BoolTrait] - Source: 'src/traits.rs', lines 1:0-1:19 -/ + Source: 'tests/src/traits.rs', lines 2:0-2:19 -/ structure BoolTrait (Self : Type) where get_bool : Self → Result Bool /- [traits::{(traits::BoolTrait for bool)}::get_bool]: - Source: 'src/traits.rs', lines 12:4-12:30 -/ + Source: 'tests/src/traits.rs', lines 13:4-13:30 -/ def BoolTraitBool.get_bool (self : Bool) : Result Bool := Result.ok self /- Trait implementation: [traits::{(traits::BoolTrait for bool)}] - Source: 'src/traits.rs', lines 11:0-11:23 -/ + Source: 'tests/src/traits.rs', lines 12:0-12:23 -/ def BoolTraitBool : BoolTrait Bool := { get_bool := BoolTraitBool.get_bool } /- [traits::BoolTrait::ret_true]: - Source: 'src/traits.rs', lines 6:4-6:30 -/ + Source: 'tests/src/traits.rs', lines 7:4-7:30 -/ def BoolTrait.ret_true {Self : Type} (self_clause : BoolTrait Self) (self : Self) : Result Bool := Result.ok true /- [traits::test_bool_trait_bool]: - Source: 'src/traits.rs', lines 17:0-17:44 -/ + Source: 'tests/src/traits.rs', lines 18:0-18:44 -/ def test_bool_trait_bool (x : Bool) : Result Bool := do let b ← BoolTraitBool.get_bool x @@ -37,20 +37,20 @@ def test_bool_trait_bool (x : Bool) : Result Bool := else Result.ok false /- [traits::{(traits::BoolTrait for core::option::Option<T>)#1}::get_bool]: - Source: 'src/traits.rs', lines 23:4-23:30 -/ + Source: 'tests/src/traits.rs', lines 24:4-24:30 -/ def BoolTraitOption.get_bool (T : Type) (self : Option T) : Result Bool := match self with | none => Result.ok false | some _ => Result.ok true /- Trait implementation: [traits::{(traits::BoolTrait for core::option::Option<T>)#1}] - Source: 'src/traits.rs', lines 22:0-22:31 -/ + Source: 'tests/src/traits.rs', lines 23:0-23:31 -/ def BoolTraitOption (T : Type) : BoolTrait (Option T) := { get_bool := BoolTraitOption.get_bool T } /- [traits::test_bool_trait_option]: - Source: 'src/traits.rs', lines 31:0-31:54 -/ + Source: 'tests/src/traits.rs', lines 32:0-32:54 -/ def test_bool_trait_option (T : Type) (x : Option T) : Result Bool := do let b ← BoolTraitOption.get_bool T x @@ -59,29 +59,29 @@ def test_bool_trait_option (T : Type) (x : Option T) : Result Bool := else Result.ok false /- [traits::test_bool_trait]: - Source: 'src/traits.rs', lines 35:0-35:50 -/ + Source: 'tests/src/traits.rs', lines 36:0-36:50 -/ def test_bool_trait (T : Type) (BoolTraitInst : BoolTrait T) (x : T) : Result Bool := BoolTraitInst.get_bool x /- Trait declaration: [traits::ToU64] - Source: 'src/traits.rs', lines 39:0-39:15 -/ + Source: 'tests/src/traits.rs', lines 40:0-40:15 -/ structure ToU64 (Self : Type) where to_u64 : Self → Result U64 /- [traits::{(traits::ToU64 for u64)#2}::to_u64]: - Source: 'src/traits.rs', lines 44:4-44:26 -/ + Source: 'tests/src/traits.rs', lines 45:4-45:26 -/ def ToU64U64.to_u64 (self : U64) : Result U64 := Result.ok self /- Trait implementation: [traits::{(traits::ToU64 for u64)#2}] - Source: 'src/traits.rs', lines 43:0-43:18 -/ + Source: 'tests/src/traits.rs', lines 44:0-44:18 -/ def ToU64U64 : ToU64 U64 := { to_u64 := ToU64U64.to_u64 } /- [traits::{(traits::ToU64 for (A, A))#3}::to_u64]: - Source: 'src/traits.rs', lines 50:4-50:26 -/ + Source: 'tests/src/traits.rs', lines 51:4-51:26 -/ def ToU64Pair.to_u64 (A : Type) (ToU64Inst : ToU64 A) (self : (A × A)) : Result U64 := do @@ -91,78 +91,78 @@ def ToU64Pair.to_u64 i + i1 /- Trait implementation: [traits::{(traits::ToU64 for (A, A))#3}] - Source: 'src/traits.rs', lines 49:0-49:31 -/ + Source: 'tests/src/traits.rs', lines 50:0-50:31 -/ def ToU64Pair (A : Type) (ToU64Inst : ToU64 A) : ToU64 (A × A) := { to_u64 := ToU64Pair.to_u64 A ToU64Inst } /- [traits::f]: - Source: 'src/traits.rs', lines 55:0-55:36 -/ + Source: 'tests/src/traits.rs', lines 56:0-56:36 -/ def f (T : Type) (ToU64Inst : ToU64 T) (x : (T × T)) : Result U64 := ToU64Pair.to_u64 T ToU64Inst x /- [traits::g]: - Source: 'src/traits.rs', lines 59:0-61:18 -/ + Source: 'tests/src/traits.rs', lines 60:0-62:18 -/ def g (T : Type) (ToU64PairInst : ToU64 (T × T)) (x : (T × T)) : Result U64 := ToU64PairInst.to_u64 x /- [traits::h0]: - Source: 'src/traits.rs', lines 66:0-66:24 -/ + Source: 'tests/src/traits.rs', lines 67:0-67:24 -/ def h0 (x : U64) : Result U64 := ToU64U64.to_u64 x /- [traits::Wrapper] - Source: 'src/traits.rs', lines 70:0-70:21 -/ + Source: 'tests/src/traits.rs', lines 71:0-71:21 -/ structure Wrapper (T : Type) where x : T /- [traits::{(traits::ToU64 for traits::Wrapper<T>)#4}::to_u64]: - Source: 'src/traits.rs', lines 75:4-75:26 -/ + Source: 'tests/src/traits.rs', lines 76:4-76:26 -/ def ToU64traitsWrapper.to_u64 (T : Type) (ToU64Inst : ToU64 T) (self : Wrapper T) : Result U64 := ToU64Inst.to_u64 self.x /- Trait implementation: [traits::{(traits::ToU64 for traits::Wrapper<T>)#4}] - Source: 'src/traits.rs', lines 74:0-74:35 -/ + Source: 'tests/src/traits.rs', lines 75:0-75:35 -/ def ToU64traitsWrapper (T : Type) (ToU64Inst : ToU64 T) : ToU64 (Wrapper T) := { to_u64 := ToU64traitsWrapper.to_u64 T ToU64Inst } /- [traits::h1]: - Source: 'src/traits.rs', lines 80:0-80:33 -/ + Source: 'tests/src/traits.rs', lines 81:0-81:33 -/ def h1 (x : Wrapper U64) : Result U64 := ToU64traitsWrapper.to_u64 U64 ToU64U64 x /- [traits::h2]: - Source: 'src/traits.rs', lines 84:0-84:41 -/ + Source: 'tests/src/traits.rs', lines 85:0-85:41 -/ def h2 (T : Type) (ToU64Inst : ToU64 T) (x : Wrapper T) : Result U64 := ToU64traitsWrapper.to_u64 T ToU64Inst x /- Trait declaration: [traits::ToType] - Source: 'src/traits.rs', lines 88:0-88:19 -/ + Source: 'tests/src/traits.rs', lines 89:0-89:19 -/ structure ToType (Self T : Type) where to_type : Self → Result T /- [traits::{(traits::ToType<bool> for u64)#5}::to_type]: - Source: 'src/traits.rs', lines 93:4-93:28 -/ + Source: 'tests/src/traits.rs', lines 94:4-94:28 -/ def ToTypeU64Bool.to_type (self : U64) : Result Bool := Result.ok (self > 0#u64) /- Trait implementation: [traits::{(traits::ToType<bool> for u64)#5}] - Source: 'src/traits.rs', lines 92:0-92:25 -/ + Source: 'tests/src/traits.rs', lines 93:0-93:25 -/ def ToTypeU64Bool : ToType U64 Bool := { to_type := ToTypeU64Bool.to_type } /- Trait declaration: [traits::OfType] - Source: 'src/traits.rs', lines 98:0-98:16 -/ + Source: 'tests/src/traits.rs', lines 99:0-99:16 -/ structure OfType (Self : Type) where of_type : forall (T : Type) (ToTypeInst : ToType T Self), T → Result Self /- [traits::h3]: - Source: 'src/traits.rs', lines 104:0-104:50 -/ + Source: 'tests/src/traits.rs', lines 105:0-105:50 -/ def h3 (T1 T2 : Type) (OfTypeInst : OfType T1) (ToTypeInst : ToType T2 T1) (y : T2) : @@ -171,13 +171,13 @@ def h3 OfTypeInst.of_type T2 ToTypeInst y /- Trait declaration: [traits::OfTypeBis] - Source: 'src/traits.rs', lines 109:0-109:36 -/ + Source: 'tests/src/traits.rs', lines 110:0-110:36 -/ structure OfTypeBis (Self T : Type) where ToTypeInst : ToType T Self of_type : T → Result Self /- [traits::h4]: - Source: 'src/traits.rs', lines 118:0-118:57 -/ + Source: 'tests/src/traits.rs', lines 119:0-119:57 -/ def h4 (T1 T2 : Type) (OfTypeBisInst : OfTypeBis T1 T2) (ToTypeInst : ToType T2 T1) (y : T2) : @@ -186,33 +186,33 @@ def h4 OfTypeBisInst.of_type y /- [traits::TestType] - Source: 'src/traits.rs', lines 122:0-122:22 -/ + Source: 'tests/src/traits.rs', lines 123:0-123:22 -/ @[reducible] def TestType (T : Type) := T /- [traits::{traits::TestType<T>#6}::test::TestType1] - Source: 'src/traits.rs', lines 127:8-127:24 -/ + Source: 'tests/src/traits.rs', lines 128:8-128:24 -/ @[reducible] def TestType.test.TestType1 := U64 /- Trait declaration: [traits::{traits::TestType<T>#6}::test::TestTrait] - Source: 'src/traits.rs', lines 128:8-128:23 -/ + Source: 'tests/src/traits.rs', lines 129:8-129:23 -/ structure TestType.test.TestTrait (Self : Type) where test : Self → Result Bool /- [traits::{traits::TestType<T>#6}::test::{(traits::{traits::TestType<T>#6}::test::TestTrait for traits::{traits::TestType<T>#6}::test::TestType1)}::test]: - Source: 'src/traits.rs', lines 139:12-139:34 -/ + Source: 'tests/src/traits.rs', lines 140:12-140:34 -/ def TestType.test.TestTraittraitsTestTypetestTestType1.test (self : TestType.test.TestType1) : Result Bool := Result.ok (self > 1#u64) /- Trait implementation: [traits::{traits::TestType<T>#6}::test::{(traits::{traits::TestType<T>#6}::test::TestTrait for traits::{traits::TestType<T>#6}::test::TestType1)}] - Source: 'src/traits.rs', lines 138:8-138:36 -/ + Source: 'tests/src/traits.rs', lines 139:8-139:36 -/ def TestType.test.TestTraittraitsTestTypetestTestType1 : TestType.test.TestTrait TestType.test.TestType1 := { test := TestType.test.TestTraittraitsTestTypetestTestType1.test } /- [traits::{traits::TestType<T>#6}::test]: - Source: 'src/traits.rs', lines 126:4-126:36 -/ + Source: 'tests/src/traits.rs', lines 127:4-127:36 -/ def TestType.test (T : Type) (ToU64Inst : ToU64 T) (self : TestType T) (x : T) : Result Bool := do @@ -222,11 +222,11 @@ def TestType.test else Result.ok false /- [traits::BoolWrapper] - Source: 'src/traits.rs', lines 150:0-150:22 -/ + Source: 'tests/src/traits.rs', lines 151:0-151:22 -/ @[reducible] def BoolWrapper := Bool /- [traits::{(traits::ToType<T> for traits::BoolWrapper)#7}::to_type]: - Source: 'src/traits.rs', lines 156:4-156:25 -/ + Source: 'tests/src/traits.rs', lines 157:4-157:25 -/ def ToTypetraitsBoolWrapperT.to_type (T : Type) (ToTypeBoolTInst : ToType Bool T) (self : BoolWrapper) : Result T @@ -234,21 +234,21 @@ def ToTypetraitsBoolWrapperT.to_type ToTypeBoolTInst.to_type self /- Trait implementation: [traits::{(traits::ToType<T> for traits::BoolWrapper)#7}] - Source: 'src/traits.rs', lines 152:0-152:33 -/ + Source: 'tests/src/traits.rs', lines 153:0-153:33 -/ def ToTypetraitsBoolWrapperT (T : Type) (ToTypeBoolTInst : ToType Bool T) : ToType BoolWrapper T := { to_type := ToTypetraitsBoolWrapperT.to_type T ToTypeBoolTInst } /- [traits::WithConstTy::LEN2] - Source: 'src/traits.rs', lines 164:4-164:21 -/ + Source: 'tests/src/traits.rs', lines 165:4-165:21 -/ def WithConstTy.LEN2_default_body (Self : Type) (LEN : Usize) : Result Usize := Result.ok 32#usize def WithConstTy.LEN2_default (Self : Type) (LEN : Usize) : Usize := eval_global (WithConstTy.LEN2_default_body Self LEN) /- Trait declaration: [traits::WithConstTy] - Source: 'src/traits.rs', lines 161:0-161:39 -/ + Source: 'tests/src/traits.rs', lines 162:0-162:39 -/ structure WithConstTy (Self : Type) (LEN : Usize) where LEN1 : Usize LEN2 : Usize @@ -258,17 +258,17 @@ structure WithConstTy (Self : Type) (LEN : Usize) where f : W → Array U8 LEN → Result W /- [traits::{(traits::WithConstTy<32: usize> for bool)#8}::LEN1] - Source: 'src/traits.rs', lines 175:4-175:21 -/ + Source: 'tests/src/traits.rs', lines 176:4-176:21 -/ def WithConstTyBool32.LEN1_body : Result Usize := Result.ok 12#usize def WithConstTyBool32.LEN1 : Usize := eval_global WithConstTyBool32.LEN1_body /- [traits::{(traits::WithConstTy<32: usize> for bool)#8}::f]: - Source: 'src/traits.rs', lines 180:4-180:39 -/ + Source: 'tests/src/traits.rs', lines 181:4-181:39 -/ def WithConstTyBool32.f (i : U64) (a : Array U8 32#usize) : Result U64 := Result.ok i /- Trait implementation: [traits::{(traits::WithConstTy<32: usize> for bool)#8}] - Source: 'src/traits.rs', lines 174:0-174:29 -/ + Source: 'tests/src/traits.rs', lines 175:0-175:29 -/ def WithConstTyBool32 : WithConstTy Bool 32#usize := { LEN1 := WithConstTyBool32.LEN1 LEN2 := WithConstTy.LEN2_default Bool 32#usize @@ -279,7 +279,7 @@ def WithConstTyBool32 : WithConstTy Bool 32#usize := { } /- [traits::use_with_const_ty1]: - Source: 'src/traits.rs', lines 183:0-183:75 -/ + Source: 'tests/src/traits.rs', lines 184:0-184:75 -/ def use_with_const_ty1 (H : Type) (LEN : Usize) (WithConstTyInst : WithConstTy H LEN) : Result Usize @@ -287,7 +287,7 @@ def use_with_const_ty1 Result.ok WithConstTyInst.LEN1 /- [traits::use_with_const_ty2]: - Source: 'src/traits.rs', lines 187:0-187:73 -/ + Source: 'tests/src/traits.rs', lines 188:0-188:73 -/ def use_with_const_ty2 (H : Type) (LEN : Usize) (WithConstTyInst : WithConstTy H LEN) (w : WithConstTyInst.W) : @@ -296,7 +296,7 @@ def use_with_const_ty2 Result.ok () /- [traits::use_with_const_ty3]: - Source: 'src/traits.rs', lines 189:0-189:80 -/ + Source: 'tests/src/traits.rs', lines 190:0-190:80 -/ def use_with_const_ty3 (H : Type) (LEN : Usize) (WithConstTyInst : WithConstTy H LEN) (x : WithConstTyInst.W) : @@ -305,12 +305,12 @@ def use_with_const_ty3 WithConstTyInst.W_clause_0.to_u64 x /- [traits::test_where1]: - Source: 'src/traits.rs', lines 193:0-193:40 -/ + Source: 'tests/src/traits.rs', lines 194:0-194:40 -/ def test_where1 (T : Type) (_x : T) : Result Unit := Result.ok () /- [traits::test_where2]: - Source: 'src/traits.rs', lines 194:0-194:57 -/ + Source: 'tests/src/traits.rs', lines 195:0-195:57 -/ def test_where2 (T : Type) (WithConstTyT32Inst : WithConstTy T 32#usize) (_x : U32) : Result Unit @@ -318,30 +318,30 @@ def test_where2 Result.ok () /- Trait declaration: [traits::ParentTrait0] - Source: 'src/traits.rs', lines 200:0-200:22 -/ + Source: 'tests/src/traits.rs', lines 201:0-201:22 -/ structure ParentTrait0 (Self : Type) where W : Type get_name : Self → Result String get_w : Self → Result W /- Trait declaration: [traits::ParentTrait1] - Source: 'src/traits.rs', lines 205:0-205:22 -/ + Source: 'tests/src/traits.rs', lines 206:0-206:22 -/ structure ParentTrait1 (Self : Type) where /- Trait declaration: [traits::ChildTrait] - Source: 'src/traits.rs', lines 206:0-206:49 -/ + Source: 'tests/src/traits.rs', lines 207:0-207:49 -/ structure ChildTrait (Self : Type) where ParentTrait0Inst : ParentTrait0 Self ParentTrait1Inst : ParentTrait1 Self /- [traits::test_child_trait1]: - Source: 'src/traits.rs', lines 209:0-209:56 -/ + Source: 'tests/src/traits.rs', lines 210:0-210:56 -/ def test_child_trait1 (T : Type) (ChildTraitInst : ChildTrait T) (x : T) : Result String := ChildTraitInst.ParentTrait0Inst.get_name x /- [traits::test_child_trait2]: - Source: 'src/traits.rs', lines 213:0-213:54 -/ + Source: 'tests/src/traits.rs', lines 214:0-214:54 -/ def test_child_trait2 (T : Type) (ChildTraitInst : ChildTrait T) (x : T) : Result ChildTraitInst.ParentTrait0Inst.W @@ -349,7 +349,7 @@ def test_child_trait2 ChildTraitInst.ParentTrait0Inst.get_w x /- [traits::order1]: - Source: 'src/traits.rs', lines 219:0-219:59 -/ + Source: 'tests/src/traits.rs', lines 220:0-220:59 -/ def order1 (T U : Type) (ParentTrait0Inst : ParentTrait0 T) (ParentTrait0Inst1 : ParentTrait0 U) : @@ -358,28 +358,28 @@ def order1 Result.ok () /- Trait declaration: [traits::ChildTrait1] - Source: 'src/traits.rs', lines 222:0-222:35 -/ + Source: 'tests/src/traits.rs', lines 223:0-223:35 -/ structure ChildTrait1 (Self : Type) where ParentTrait1Inst : ParentTrait1 Self /- Trait implementation: [traits::{(traits::ParentTrait1 for usize)#9}] - Source: 'src/traits.rs', lines 224:0-224:27 -/ + Source: 'tests/src/traits.rs', lines 225:0-225:27 -/ def ParentTrait1Usize : ParentTrait1 Usize := { } /- Trait implementation: [traits::{(traits::ChildTrait1 for usize)#10}] - Source: 'src/traits.rs', lines 225:0-225:26 -/ + Source: 'tests/src/traits.rs', lines 226:0-226:26 -/ def ChildTrait1Usize : ChildTrait1 Usize := { ParentTrait1Inst := ParentTrait1Usize } /- Trait declaration: [traits::Iterator] - Source: 'src/traits.rs', lines 229:0-229:18 -/ + Source: 'tests/src/traits.rs', lines 230:0-230:18 -/ structure Iterator (Self : Type) where Item : Type /- Trait declaration: [traits::IntoIterator] - Source: 'src/traits.rs', lines 233:0-233:22 -/ + Source: 'tests/src/traits.rs', lines 234:0-234:22 -/ structure IntoIterator (Self : Type) where Item : Type IntoIter : Type @@ -387,106 +387,106 @@ structure IntoIterator (Self : Type) where into_iter : Self → Result IntoIter /- Trait declaration: [traits::FromResidual] - Source: 'src/traits.rs', lines 250:0-250:21 -/ + Source: 'tests/src/traits.rs', lines 251:0-251:21 -/ structure FromResidual (Self T : Type) where /- Trait declaration: [traits::Try] - Source: 'src/traits.rs', lines 246:0-246:48 -/ + Source: 'tests/src/traits.rs', lines 247:0-247:48 -/ structure Try (Self : Type) where Residual : Type FromResidualSelftraitsTryResidualInst : FromResidual Self Residual /- Trait declaration: [traits::WithTarget] - Source: 'src/traits.rs', lines 252:0-252:20 -/ + Source: 'tests/src/traits.rs', lines 253:0-253:20 -/ structure WithTarget (Self : Type) where Target : Type /- Trait declaration: [traits::ParentTrait2] - Source: 'src/traits.rs', lines 256:0-256:22 -/ + Source: 'tests/src/traits.rs', lines 257:0-257:22 -/ structure ParentTrait2 (Self : Type) where U : Type U_clause_0 : WithTarget U /- Trait declaration: [traits::ChildTrait2] - Source: 'src/traits.rs', lines 260:0-260:35 -/ + Source: 'tests/src/traits.rs', lines 261:0-261:35 -/ structure ChildTrait2 (Self : Type) where ParentTrait2Inst : ParentTrait2 Self convert : ParentTrait2Inst.U → Result ParentTrait2Inst.U_clause_0.Target /- Trait implementation: [traits::{(traits::WithTarget for u32)#11}] - Source: 'src/traits.rs', lines 264:0-264:23 -/ + Source: 'tests/src/traits.rs', lines 265:0-265:23 -/ def WithTargetU32 : WithTarget U32 := { Target := U32 } /- Trait implementation: [traits::{(traits::ParentTrait2 for u32)#12}] - Source: 'src/traits.rs', lines 268:0-268:25 -/ + Source: 'tests/src/traits.rs', lines 269:0-269:25 -/ def ParentTrait2U32 : ParentTrait2 U32 := { U := U32 U_clause_0 := WithTargetU32 } /- [traits::{(traits::ChildTrait2 for u32)#13}::convert]: - Source: 'src/traits.rs', lines 273:4-273:29 -/ + Source: 'tests/src/traits.rs', lines 274:4-274:29 -/ def ChildTrait2U32.convert (x : U32) : Result U32 := Result.ok x /- Trait implementation: [traits::{(traits::ChildTrait2 for u32)#13}] - Source: 'src/traits.rs', lines 272:0-272:24 -/ + Source: 'tests/src/traits.rs', lines 273:0-273:24 -/ def ChildTrait2U32 : ChildTrait2 U32 := { ParentTrait2Inst := ParentTrait2U32 convert := ChildTrait2U32.convert } /- Trait declaration: [traits::CFnOnce] - Source: 'src/traits.rs', lines 286:0-286:23 -/ + Source: 'tests/src/traits.rs', lines 287:0-287:23 -/ structure CFnOnce (Self Args : Type) where Output : Type call_once : Self → Args → Result Output /- Trait declaration: [traits::CFnMut] - Source: 'src/traits.rs', lines 292:0-292:37 -/ + Source: 'tests/src/traits.rs', lines 293:0-293:37 -/ structure CFnMut (Self Args : Type) where CFnOnceInst : CFnOnce Self Args call_mut : Self → Args → Result (CFnOnceInst.Output × Self) /- Trait declaration: [traits::CFn] - Source: 'src/traits.rs', lines 296:0-296:33 -/ + Source: 'tests/src/traits.rs', lines 297:0-297:33 -/ structure CFn (Self Args : Type) where CFnMutInst : CFnMut Self Args call : Self → Args → Result CFnMutInst.CFnOnceInst.Output /- Trait declaration: [traits::GetTrait] - Source: 'src/traits.rs', lines 300:0-300:18 -/ + Source: 'tests/src/traits.rs', lines 301:0-301:18 -/ structure GetTrait (Self : Type) where W : Type get_w : Self → Result W /- [traits::test_get_trait]: - Source: 'src/traits.rs', lines 305:0-305:49 -/ + Source: 'tests/src/traits.rs', lines 306:0-306:49 -/ def test_get_trait (T : Type) (GetTraitInst : GetTrait T) (x : T) : Result GetTraitInst.W := GetTraitInst.get_w x /- Trait declaration: [traits::Trait] - Source: 'src/traits.rs', lines 310:0-310:15 -/ + Source: 'tests/src/traits.rs', lines 311:0-311:15 -/ structure Trait (Self : Type) where LEN : Usize /- [traits::{(traits::Trait for @Array<T, N>)#14}::LEN] - Source: 'src/traits.rs', lines 315:4-315:20 -/ + Source: 'tests/src/traits.rs', lines 316:4-316:20 -/ def TraitArray.LEN_body (T : Type) (N : Usize) : Result Usize := Result.ok N def TraitArray.LEN (T : Type) (N : Usize) : Usize := eval_global (TraitArray.LEN_body T N) /- Trait implementation: [traits::{(traits::Trait for @Array<T, N>)#14}] - Source: 'src/traits.rs', lines 314:0-314:40 -/ + Source: 'tests/src/traits.rs', lines 315:0-315:40 -/ def TraitArray (T : Type) (N : Usize) : Trait (Array T N) := { LEN := TraitArray.LEN T N } /- [traits::{(traits::Trait for traits::Wrapper<T>)#15}::LEN] - Source: 'src/traits.rs', lines 319:4-319:20 -/ + Source: 'tests/src/traits.rs', lines 320:4-320:20 -/ def TraittraitsWrapper.LEN_body (T : Type) (TraitInst : Trait T) : Result Usize := Result.ok 0#usize @@ -494,19 +494,19 @@ def TraittraitsWrapper.LEN (T : Type) (TraitInst : Trait T) : Usize := eval_global (TraittraitsWrapper.LEN_body T TraitInst) /- Trait implementation: [traits::{(traits::Trait for traits::Wrapper<T>)#15}] - Source: 'src/traits.rs', lines 318:0-318:35 -/ + Source: 'tests/src/traits.rs', lines 319:0-319:35 -/ def TraittraitsWrapper (T : Type) (TraitInst : Trait T) : Trait (Wrapper T) := { LEN := TraittraitsWrapper.LEN T TraitInst } /- [traits::use_wrapper_len]: - Source: 'src/traits.rs', lines 322:0-322:43 -/ + Source: 'tests/src/traits.rs', lines 323:0-323:43 -/ def use_wrapper_len (T : Type) (TraitInst : Trait T) : Result Usize := Result.ok (TraittraitsWrapper T TraitInst).LEN /- [traits::Foo] - Source: 'src/traits.rs', lines 326:0-326:20 -/ + Source: 'tests/src/traits.rs', lines 327:0-327:20 -/ structure Foo (T U : Type) where x : T y : U @@ -519,7 +519,7 @@ inductive core.result.Result (T E : Type) := | Err : E → core.result.Result T E /- [traits::{traits::Foo<T, U>#16}::FOO] - Source: 'src/traits.rs', lines 332:4-332:33 -/ + Source: 'tests/src/traits.rs', lines 333:4-333:33 -/ def Foo.FOO_body (T U : Type) (TraitInst : Trait T) : Result (core.result.Result T I32) := Result.ok (core.result.Result.Err 0#i32) @@ -527,13 +527,13 @@ def Foo.FOO (T U : Type) (TraitInst : Trait T) : core.result.Result T I32 := eval_global (Foo.FOO_body T U TraitInst) /- [traits::use_foo1]: - Source: 'src/traits.rs', lines 335:0-335:48 -/ + Source: 'tests/src/traits.rs', lines 336:0-336:48 -/ def use_foo1 (T U : Type) (TraitInst : Trait T) : Result (core.result.Result T I32) := Result.ok (Foo.FOO T U TraitInst) /- [traits::use_foo2]: - Source: 'src/traits.rs', lines 339:0-339:48 -/ + Source: 'tests/src/traits.rs', lines 340:0-340:48 -/ def use_foo2 (T U : Type) (TraitInst : Trait U) : Result (core.result.Result U I32) := Result.ok (Foo.FOO U T TraitInst) diff --git a/tests/src/arrays.rs b/tests/src/arrays.rs new file mode 100644 index 00000000..ddad2ad3 --- /dev/null +++ b/tests/src/arrays.rs @@ -0,0 +1,331 @@ +//@ [coq] aeneas-args=-use-fuel +//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +//@ [fstar] aeneas-args=-split-files +//! Exercise the translation of arrays, with features supported by Eurydice + +pub enum AB { + A, + B, +} + +pub fn incr(x: &mut u32) { + *x += 1; +} + +// Nano-tests +// ---------- + +// The suffix `_` prevents name collisions in some backends +pub fn array_to_shared_slice_<T>(s: &[T; 32]) -> &[T] { + s +} + +// The suffix `_` prevents name collisions in some backends +pub fn array_to_mut_slice_<T>(s: &mut [T; 32]) -> &mut [T] { + s +} + +pub fn array_len<T>(s: [T; 32]) -> usize { + s.len() +} + +pub fn shared_array_len<T>(s: &[T; 32]) -> usize { + s.len() +} + +pub fn shared_slice_len<T>(s: &[T]) -> usize { + s.len() +} + +pub fn index_array_shared<T>(s: &[T; 32], i: usize) -> &T { + &s[i] +} + +// Remark: can't move out of an array +// Also: can't move out of a slice. + +pub fn index_array_u32(s: [u32; 32], i: usize) -> u32 { + s[i] +} + +pub fn index_array_copy(x: &[u32; 32]) -> u32 { + x[0] +} + +pub fn index_mut_array<T>(s: &mut [T; 32], i: usize) -> &mut T { + &mut s[i] +} + +pub fn index_slice<T>(s: &[T], i: usize) -> &T { + &s[i] +} + +pub fn index_mut_slice<T>(s: &mut [T], i: usize) -> &mut T { + &mut s[i] +} + +pub fn slice_subslice_shared_(x: &[u32], y: usize, z: usize) -> &[u32] { + &x[y..z] +} + +pub fn slice_subslice_mut_(x: &mut [u32], y: usize, z: usize) -> &mut [u32] { + &mut x[y..z] +} + +pub fn array_to_slice_shared_(x: &[u32; 32]) -> &[u32] { + x +} + +pub fn array_to_slice_mut_(x: &mut [u32; 32]) -> &mut [u32] { + x +} + +pub fn array_subslice_shared_(x: &[u32; 32], y: usize, z: usize) -> &[u32] { + &x[y..z] +} + +pub fn array_subslice_mut_(x: &mut [u32; 32], y: usize, z: usize) -> &mut [u32] { + &mut x[y..z] +} + +pub fn index_slice_0<T>(s: &[T]) -> &T { + &s[0] +} + +pub fn index_array_0<T>(s: &[T; 32]) -> &T { + &s[0] +} + +/* +// Unsupported by Aeneas for now +pub fn index_index_slice<'a, T>(s: &'a [&[T]], i: usize, j: usize) -> &'a T { + &s[i][j] +} +*/ + +pub fn index_index_array(s: [[u32; 32]; 32], i: usize, j: usize) -> u32 { + s[i][j] +} + +/* +// Unsupported by Aeneas for now +pub fn update_update_slice(s: &mut [&mut [u32]], i: usize, j: usize) { + s[i][j] = 0; +} +*/ + +pub fn update_update_array(mut s: [[u32; 32]; 32], i: usize, j: usize) { + s[i][j] = 0; +} + +pub fn array_local_deep_copy(x: &[u32; 32]) { + let _y = *x; +} + +pub fn take_array(_: [u32; 2]) {} +pub fn take_array_borrow(_: &[u32; 2]) {} +pub fn take_slice(_: &[u32]) {} +pub fn take_mut_slice(_: &mut [u32]) {} + +pub fn const_array() -> [u32; 2] { + [0, 0] +} + +pub fn const_slice() { + let _: &[u32] = &[0, 0]; +} + +/* +// This triggers a special case in the constant expressions +pub fn const_string() { + let _ = "hello"; +}*/ + +pub fn take_all() { + let mut x: [u32; 2] = [0, 0]; + // x is deep copied (copy node appears in Charon, followed by a move) + take_array(x); + take_array(x); + // x passed by address, there is a reborrow here + take_array_borrow(&x); + // automatic cast from array to slice (spanning entire array) + take_slice(&x); + // note that both appear as SliceNew expressions, meaning the SliceNew UnOp is overloaded for + // mut and non-mut cases + take_mut_slice(&mut x); +} + +pub fn index_array(x: [u32; 2]) -> u32 { + x[0] +} +pub fn index_array_borrow(x: &[u32; 2]) -> u32 { + x[0] +} + +pub fn index_slice_u32_0(x: &[u32]) -> u32 { + x[0] +} + +pub fn index_mut_slice_u32_0(x: &mut [u32]) -> u32 { + x[0] +} + +pub fn index_all() -> u32 { + let mut x: [u32; 2] = [0, 0]; + if true { + let _y: [u32; 2] = [0, 0]; + } else { + let _z: [u32; 1] = [0]; + } + index_array(x) + + index_array(x) + + index_array_borrow(&x) + + index_slice_u32_0(&x) + + index_mut_slice_u32_0(&mut x) +} + +pub fn update_array(mut x: [u32; 2]) { + x[0] = 1 +} +pub fn update_array_mut_borrow(x: &mut [u32; 2]) { + x[0] = 1 +} +pub fn update_mut_slice(x: &mut [u32]) { + x[0] = 1 +} + +pub fn update_all() { + let mut x: [u32; 2] = [0, 0]; + update_array(x); + update_array(x); + update_array_mut_borrow(&mut x); + update_mut_slice(&mut x); +} + +// Nano-tests, with ranges +// ----------------------- + +pub fn range_all() { + let mut x: [u32; 4] = [0, 0, 0, 0]; + // CONFIRM: there is no way to shrink [T;N] into [T;M] with M<N? + update_mut_slice(&mut x[1..3]); +} + +// Nano-tests, with dereferences +// ----------------------------- + +pub fn deref_array_borrow(x: &[u32; 2]) -> u32 { + let x: [u32; 2] = *x; + x[0] +} + +pub fn deref_array_mut_borrow(x: &mut [u32; 2]) -> u32 { + let x: [u32; 2] = *x; + x[0] +} + +// Non-copiable arrays +// ------------------- + +pub fn take_array_t(_: [AB; 2]) {} + +pub fn non_copyable_array() { + let x: [AB; 2] = [AB::A, AB::B]; + // x is moved (not deep copied!) + // TODO: determine whether the translation needs to be aware of that and pass by ref instead of by copy + take_array_t(x); + + // this fails, naturally: + // take_array_t(x); +} + +// Larger, random tests +// -------------------- + +pub fn sum(s: &[u32]) -> u32 { + let mut sum = 0; + let mut i = 0; + while i < s.len() { + sum += s[i]; + i += 1; + } + sum +} + +pub fn sum2(s: &[u32], s2: &[u32]) -> u32 { + let mut sum = 0; + assert!(s.len() == s2.len()); + let mut i = 0; + while i < s.len() { + sum += s[i] + s2[i]; + i += 1; + } + sum +} + +pub fn f0() { + let s: &mut [u32] = &mut [1, 2]; + s[0] = 1; +} + +pub fn f1() { + let mut s: [u32; 2] = [1, 2]; + s[0] = 1; +} + +pub fn f2(_: u32) {} + +pub fn f3() -> u32 { + let a: [u32; 2] = [1, 2]; + f2(a[0]); + let b = [0; 32]; + sum2(&a, f4(&b, 16, 18)) +} + +pub fn f4(x: &[u32; 32], y: usize, z: usize) -> &[u32] { + &x[y..z] +} + +pub const SZ: usize = 32; + +// There is something slightly annoying here: the SZ constant gets inlined +pub fn f5(x: &[u32; SZ]) -> u32 { + x[0] +} + +// To avoid lifetime shortening +pub fn ite() { + let mut x: [u32; 2] = [0, 0]; + if true { + let mut y: [u32; 2] = [0, 0]; + index_mut_slice_u32_0(&mut x); + index_mut_slice_u32_0(&mut y); + } +} + +pub fn zero_slice(a: &mut [u8]) { + let mut i: usize = 0; + let len = a.len(); + while i < len { + a[i] = 0; + i += 1; + } +} + +pub fn iter_mut_slice(a: &mut [u8]) { + let len = a.len(); + let mut i = 0; + while i < len { + i += 1; + } +} + +pub fn sum_mut_slice(a: &mut [u32]) -> u32 { + let mut i = 0; + let mut s = 0; + while i < a.len() { + s += a[i]; + i += 1; + } + s +} diff --git a/tests/src/betree/Cargo.lock b/tests/src/betree/Cargo.lock new file mode 100644 index 00000000..1bd274ad --- /dev/null +++ b/tests/src/betree/Cargo.lock @@ -0,0 +1,299 @@ +# This file is automatically @generated by Cargo. +# It is not intended for manual editing. +version = 3 + +[[package]] +name = "aho-corasick" +version = "1.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8e60d3430d3a69478ad0993f19238d2df97c507009a52b3c10addcd7f6bcb916" +dependencies = [ + "memchr", +] + +[[package]] +name = "atty" +version = "0.2.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d9b39be18770d11421cdb1b9947a45dd3f37e93092cbf377614828a319d5fee8" +dependencies = [ + "hermit-abi", + "libc", + "winapi", +] + +[[package]] +name = "betree" +version = "0.1.0" +dependencies = [ + "env_logger", + "log", + "serde", + "serde_json", +] + +[[package]] +name = "env_logger" +version = "0.8.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a19187fea3ac7e84da7dacf48de0c45d63c6a76f9490dae389aead16c243fce3" +dependencies = [ + "atty", + "humantime", + "log", + "regex", + "termcolor", +] + +[[package]] +name = "hermit-abi" +version = "0.1.19" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "62b467343b94ba476dcb2500d242dadbb39557df889310ac77c5d99100aaac33" +dependencies = [ + "libc", +] + +[[package]] +name = "humantime" +version = "2.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9a3a5bfb195931eeb336b2a7b4d761daec841b97f947d34394601737a7bba5e4" + +[[package]] +name = "itoa" +version = "1.0.11" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "49f1f14873335454500d59611f1cf4a4b0f786f9ac11f4312a78e4cf2566695b" + +[[package]] +name = "libc" +version = "0.2.155" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "97b3888a4aecf77e811145cadf6eef5901f4782c53886191b2f693f24761847c" + +[[package]] +name = "log" +version = "0.4.21" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "90ed8c1e510134f979dbc4f070f87d4313098b704861a105fe34231c70a3901c" + +[[package]] +name = "memchr" +version = "2.7.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6c8640c5d730cb13ebd907d8d04b52f55ac9a2eec55b440c8892f40d56c76c1d" + +[[package]] +name = "proc-macro2" +version = "1.0.83" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0b33eb56c327dec362a9e55b3ad14f9d2f0904fb5a5b03b513ab5465399e9f43" +dependencies = [ + "unicode-ident", +] + +[[package]] +name = "quote" +version = "1.0.36" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0fa76aaf39101c457836aec0ce2316dbdc3ab723cdda1c6bd4e6ad4208acaca7" +dependencies = [ + "proc-macro2", +] + +[[package]] +name = "regex" +version = "1.10.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c117dbdfde9c8308975b6a18d71f3f385c89461f7b3fb054288ecf2a2058ba4c" +dependencies = [ + "aho-corasick", + "memchr", + "regex-automata", + "regex-syntax", +] + +[[package]] +name = "regex-automata" +version = "0.4.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "86b83b8b9847f9bf95ef68afb0b8e6cdb80f498442f5179a29fad448fcc1eaea" +dependencies = [ + "aho-corasick", + "memchr", + "regex-syntax", +] + +[[package]] +name = "regex-syntax" +version = "0.8.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "adad44e29e4c806119491a7f06f03de4d1af22c3a680dd47f1e6e179439d1f56" + +[[package]] +name = "ryu" +version = "1.0.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f3cb5ba0dc43242ce17de99c180e96db90b235b8a9fdc9543c96d2209116bd9f" + +[[package]] +name = "serde" +version = "1.0.202" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "226b61a0d411b2ba5ff6d7f73a476ac4f8bb900373459cd00fab8512828ba395" +dependencies = [ + "serde_derive", +] + +[[package]] +name = "serde_derive" +version = "1.0.202" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6048858004bcff69094cd972ed40a32500f153bd3be9f716b2eed2e8217c4838" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "serde_json" +version = "1.0.117" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "455182ea6142b14f93f4bc5320a2b31c1f266b66a4a5c858b013302a5d8cbfc3" +dependencies = [ + "itoa", + "ryu", + "serde", +] + +[[package]] +name = "syn" +version = "2.0.65" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d2863d96a84c6439701d7a38f9de935ec562c8832cc55d1dde0f513b52fad106" +dependencies = [ + "proc-macro2", + "quote", + "unicode-ident", +] + +[[package]] +name = "termcolor" +version = "1.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "06794f8f6c5c898b3275aebefa6b8a1cb24cd2c6c79397ab15774837a0bc5755" +dependencies = [ + "winapi-util", +] + +[[package]] +name = "unicode-ident" +version = "1.0.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3354b9ac3fae1ff6755cb6db53683adb661634f67557942dea4facebec0fee4b" + +[[package]] +name = "winapi" +version = "0.3.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5c839a674fcd7a98952e593242ea400abe93992746761e38641405d28b00f419" +dependencies = [ + "winapi-i686-pc-windows-gnu", + "winapi-x86_64-pc-windows-gnu", +] + +[[package]] +name = "winapi-i686-pc-windows-gnu" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ac3b87c63620426dd9b991e5ce0329eff545bccbbb34f3be09ff6fb6ab51b7b6" + +[[package]] +name = "winapi-util" +version = "0.1.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4d4cc384e1e73b93bafa6fb4f1df8c41695c8a91cf9c4c64358067d15a7b6c6b" +dependencies = [ + "windows-sys", +] + +[[package]] +name = "winapi-x86_64-pc-windows-gnu" +version = "0.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "712e227841d057c1ee1cd2fb22fa7e5a5461ae8e48fa2ca79ec42cfc1931183f" + +[[package]] +name = "windows-sys" +version = "0.52.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "282be5f36a8ce781fad8c8ae18fa3f9beff57ec1b52cb3de0789201425d9a33d" +dependencies = [ + "windows-targets", +] + +[[package]] +name = "windows-targets" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6f0713a46559409d202e70e28227288446bf7841d3211583a4b53e3f6d96e7eb" +dependencies = [ + "windows_aarch64_gnullvm", + "windows_aarch64_msvc", + "windows_i686_gnu", + "windows_i686_gnullvm", + "windows_i686_msvc", + "windows_x86_64_gnu", + "windows_x86_64_gnullvm", + "windows_x86_64_msvc", +] + +[[package]] +name = "windows_aarch64_gnullvm" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7088eed71e8b8dda258ecc8bac5fb1153c5cffaf2578fc8ff5d61e23578d3263" + +[[package]] +name = "windows_aarch64_msvc" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9985fd1504e250c615ca5f281c3f7a6da76213ebd5ccc9561496568a2752afb6" + +[[package]] +name = "windows_i686_gnu" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "88ba073cf16d5372720ec942a8ccbf61626074c6d4dd2e745299726ce8b89670" + +[[package]] +name = "windows_i686_gnullvm" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "87f4261229030a858f36b459e748ae97545d6f1ec60e5e0d6a3d32e0dc232ee9" + +[[package]] +name = "windows_i686_msvc" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "db3c2bf3d13d5b658be73463284eaf12830ac9a26a90c717b7f771dfe97487bf" + +[[package]] +name = "windows_x86_64_gnu" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4e4246f76bdeff09eb48875a0fd3e2af6aada79d409d33011886d3e1581517d9" + +[[package]] +name = "windows_x86_64_gnullvm" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "852298e482cd67c356ddd9570386e2862b5673c85bd5f88df9ab6802b334c596" + +[[package]] +name = "windows_x86_64_msvc" +version = "0.52.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bec47e5bfd1bff0eeaf6d8b485cc1074891a197ab4225d504cb7a1ab88b02bf0" diff --git a/tests/src/betree/Cargo.toml b/tests/src/betree/Cargo.toml new file mode 100644 index 00000000..c05c7d93 --- /dev/null +++ b/tests/src/betree/Cargo.toml @@ -0,0 +1,13 @@ +[package] +name = "betree" +version = "0.1.0" +authors = ["Son Ho <hosonmarc@gmail.com>"] +edition = "2018" + +[dependencies] +serde_json = "1.0.91" +serde = { version = "1.0.152", features = ["derive"] } +log = "0.4.17" +env_logger = "0.8.4" + +# TODO: If we turn this package into a library, building the tests fails. diff --git a/tests/src/betree/Makefile b/tests/src/betree/Makefile new file mode 100644 index 00000000..7b41e56d --- /dev/null +++ b/tests/src/betree/Makefile @@ -0,0 +1,11 @@ +.PHONY: all +all: tests + +.PHONY: test +test: + cargo rustc -- --test -Zpolonius + cd target/debug/ && ./betree + +.PHONY: clean +clean: + cargo clean diff --git a/tests/src/betree/README.md b/tests/src/betree/README.md new file mode 100644 index 00000000..a71fe884 --- /dev/null +++ b/tests/src/betree/README.md @@ -0,0 +1 @@ +This project contains tests which require the Polonius borrow checker. diff --git a/tests/src/betree/rust-toolchain b/tests/src/betree/rust-toolchain new file mode 100644 index 00000000..9460b1a8 --- /dev/null +++ b/tests/src/betree/rust-toolchain @@ -0,0 +1,3 @@ +[toolchain] +channel = "nightly-2023-06-02" +components = [ "rustc-dev", "llvm-tools-preview" ] diff --git a/tests/src/betree/src/betree.rs b/tests/src/betree/src/betree.rs new file mode 100644 index 00000000..12f2847d --- /dev/null +++ b/tests/src/betree/src/betree.rs @@ -0,0 +1,1084 @@ +//! The following module implements a minimal betree. +//! We don't have loops for now, so we will need to update the code to remove +//! the recursive functions at some point. +//! We drew a lot of inspiration from the C++ [Be-Tree](https://github.com/oscarlab/Be-Tree). +//! implementation. +#![allow(dead_code)] + +use crate::betree_utils as utils; + +pub type NodeId = u64; +pub type Key = u64; +pub type Value = u64; + +type Map<K, V> = List<(K, V)>; + +/// We use linked lists for the maps from keys to messages/bindings +pub(crate) enum List<T> { + Cons(T, Box<List<T>>), + Nil, +} + +/// Every node has a unique identifier (the betree has a counter). +/// Whenever we need to read/update the content of a node, we read/update +/// the whole content from disk at once. +/// +/// In order to make things simple, the content of each node is saved in +/// a single file, identified by the node index. Also, we use json. +/// +/// We don't reason about the content of the load/store node functions +/// (which are assumed), while the purpose of this example is to illustrate the +/// proof experience we have with Aeneas: we are not looking for performance here. +/// +/// Rk.: in the future, we will directly use the functions from betree_utils +/// and setup the translation to consider this module as assumed (i.e., no +/// wrappers) +fn load_internal_node(id: NodeId) -> InternalContent { + utils::load_internal_node(id) +} + +/// See [load_internal_node]. +fn store_internal_node(id: NodeId, content: InternalContent) { + utils::store_internal_node(id, content) +} + +/// See [load_internal_node]. +fn load_leaf_node(id: NodeId) -> LeafContent { + utils::load_leaf_node(id) +} + +/// See [load_internal_node]. +fn store_leaf_node(id: NodeId, content: LeafContent) { + utils::store_leaf_node(id, content) +} + +fn fresh_node_id(counter: &mut NodeId) -> NodeId { + let id = *counter; + *counter += 1; + id +} + +/// We use this type to encode closures. +/// See [Message::Upsert] and [upsert_update] +pub enum UpsertFunState { + Add(u64), + Sub(u64), +} + +/// A message - note that all those messages have to be linked to a key +pub(crate) enum Message { + /// Insert a binding from value to key + Insert(Value), + /// Delete a binding from value to key + Delete, + /// [Upsert] is "query then update" (query a value, then update the binding + /// by using the result of the query). This is pretty expensive if we + /// actually *do* query, *then* update: queries are expensive, because + /// we potentially have to explore the tree in depth (and every time we + /// lookup a node, we have an expensive I/O operation). + /// Instead, we insert this [Upsert] message in the tree, which progressively + /// gets propagated to the children untils it gets applied (when we find an + /// [Insert], or when we reach a leaf). + /// + /// In practice, [Upsert] should store a closure. For now we don't have + /// support for function pointers and closures, so [Upsert] doesn't store + /// a closure and always applies the same update function. Note that the + /// [Value] stored in [Upsert] acts as a closure's state. + /// + /// The interest of this example is to split the proof in two: + /// 1. a very simple refinement proof (which is made simple by the fact that + /// Aeneas takes care of the memory management proof obligations through + /// the translation) + /// 2. a more complex functional proof. + /// We write a very general model of the b-epsilon tree, prove that it is + /// refined by the translated code in 1., then prove the general functional + /// correctness case once and for all in 2. + /// The idea is that once we add support for closures, we should be able to + /// update the Rust code, and all we would need to do on the proof side is + /// to update the refinement proof in 1., which should hopefully be + /// straightforward. + /// + /// Also note that if we don't have [Upsert], there is no point in using + /// b-epsilon trees, which have the particularity of storing messages: + /// b-trees and their variants work very well (and don't use messages). + /// + /// Note there is something interesting about the proofs we do for [Upsert]. + /// When we use [Insert] or [Delete], we remove the upserts which are pending + /// for the key, because there is no point in applying them (there would be + /// if we wanted to leverage the fact that the update functions we apply may + /// be stateful). + /// The consequence is that we don't observe potentially failing executions of + /// the update functions. At the opposite, the specification of [Upsert] is + /// "greedy": we see [Upsert] as query then update. This means that the + /// implementation refines the specification only if we make sure that the + /// update function used for the upsert doesn't fail on the input we give it + /// (all this can be seen in the specification we prove about the be-tree). + Upsert(UpsertFunState), +} + +/// Internal node content. +/// +/// An internal node contains a map from keys to pending messages +/// +/// Invariants: +/// - the pairs (key, message) are sorted so that the keys are in increasing order +/// - for a given key, there can be: +/// - no message +/// - one insert or delete message +/// - a list of upsert messages. In that case, the upsert message are sorted +/// from the *first* to the *last* added in the betree. +pub(crate) type InternalContent = Map<Key, Message>; + +/// Leaf node content. +/// +/// A leaf node contains a map from keys to values. +/// We store the bindings in order of increasing key. +pub(crate) type LeafContent = Map<Key, Value>; + +/// Internal node. See [Node]. +/// +/// An internal node contains a stack of messages (stored on disk and thus +/// absent from the node itself), and two children. +/// +/// When transmitting messages to the children: the messages/bindings for the +/// keys < pivot are given to the left child, and those for the keys >= pivot +/// are given to the right child. +/// +/// Note that in Be-Tree the internal nodes have lists of children, which +/// allows to do even smarter things: if an internal node has too many +/// messages, then: +/// - either it can transmit big batches of those messages to some of its +/// children, in which case it does +/// - or it can't, in which case it splits, because otherwise we have too +/// many unefficient updates to perform (the aim really is to amortize +/// the cost of I/O, which is achieved by minimizing the number of +/// accesses to node contents) +struct Internal { + id: NodeId, + pivot: Key, + left: Box<Node>, + right: Box<Node>, +} + +/// Leaf node. See [Node] +/// +/// A leaf node contains bindings (stored on disk, and thus absent from the +/// node itself). +struct Leaf { + id: NodeId, + /// The number of bindings in the node + size: u64, +} + +/// A node in the BeTree. +/// +/// The node's content is stored on disk (and hence absent from the node itself). +/// +/// Note that we don't have clean/dirty nodes: all node contents are immediately +/// written on disk upon being updated. +enum Node { + /// An internal node (with children). + Internal(Internal), + /// A leaf node. + Leaf(Leaf), +} + +/// The parameters of a BeTree, which control when to flush or split. +struct Params { + /// The minimum number of messages we flush to the children. + /// We wait to reach 2 * min_flush_size before flushing to children. + /// If one of the children doesn't receive a number of + /// messages >= min_flush_size, we keep those messages in the parent + /// node. Of course, at least one of the two children will receive + /// flushed messages: this gives us that an internal node has at most + /// 2 * min_flush_size pending messages - 1. + min_flush_size: u64, + /// The maximum number of bindings we can store in a leaf node (if we + /// reach this number, we split). + split_size: u64, +} + +struct NodeIdCounter { + next_node_id: NodeId, +} + +impl NodeIdCounter { + fn new() -> Self { + NodeIdCounter { next_node_id: 0 } + } + + fn fresh_id(&mut self) -> NodeId { + let id = self.next_node_id; + self.next_node_id += 1; + id + } +} + +/// The BeTree itself +pub struct BeTree { + /// The parameters of the BeTree + params: Params, + /// Every node has a unique id: we keep a counter to generate fresh ids + node_id_cnt: NodeIdCounter, + /// The root of the tree + root: Node, +} + +/// The update function used for [Upsert]. +/// Will be removed once we have closures (or at least function pointers). +/// This function just computes a saturated sum. +/// Also note that it takes an option as input, for the previous value: +/// we draw inspiration from the C++ Be-Tree implemenation, where +/// in case the binding is not present, the closure stored in upsert is +/// given a default value. +pub fn upsert_update(prev: Option<Value>, st: UpsertFunState) -> Value { + // We just compute the sum, until it saturates + match prev { + Option::None => { + match st { + UpsertFunState::Add(v) => { + // We consider the default value is 0, so we return 0 + v + // (or we could fail - it doesn't really matter) + v + } + UpsertFunState::Sub(_) => { + // Same logic as for [sub], but this time we saturate at 0 + 0 + } + } + } + Option::Some(prev) => { + match st { + UpsertFunState::Add(v) => { + // Note that Aeneas is a bit conservative about the max_usize + let margin = u64::MAX - prev; + // Check if we saturate + if margin >= v { + prev + v + } else { + u64::MAX + } + } + UpsertFunState::Sub(v) => { + // Check if we saturate + if prev >= v { + prev - v + } else { + 0 + } + } + } + } + } +} + +impl<T> List<T> { + fn len(&self) -> u64 { + match self { + List::Nil => 0, + List::Cons(_, tl) => 1 + tl.len(), + } + } + + /// Split a list at a given length + fn split_at(self, n: u64) -> (List<T>, List<T>) { + if n == 0 { + (List::Nil, self) + } else { + match self { + List::Nil => unreachable!(), + List::Cons(hd, tl) => { + let (ls0, ls1) = tl.split_at(n - 1); + (List::Cons(hd, Box::new(ls0)), ls1) + } + } + } + } + + /// Push an element at the front of the list. + fn push_front(&mut self, x: T) { + // Move under borrows: annoying... + let tl = std::mem::replace(self, List::Nil); + *self = List::Cons(x, Box::new(tl)); + } + + /// Pop the element at the front of the list + fn pop_front(&mut self) -> T { + // Move under borrows: annoying... + let ls = std::mem::replace(self, List::Nil); + match ls { + List::Nil => panic!(), + List::Cons(x, tl) => { + *self = *tl; + x + } + } + } + + fn hd(&self) -> &T { + match self { + List::Nil => panic!(), + List::Cons(hd, _) => hd, + } + } +} + +impl<T> Map<Key, T> { + fn head_has_key(&self, key: Key) -> bool { + match self { + List::Nil => false, + List::Cons(hd, _) => hd.0 == key, + } + } + + /// Partition the map between two maps: + /// - a first map where the keys < pivot + /// - a second map where the keys >= pivot + /// Note that the bindings in the map are supposed to be sorted in + /// order of increasing keys. + fn partition_at_pivot(self, pivot: Key) -> (Map<Key, T>, Map<Key, T>) { + match self { + List::Nil => (List::Nil, List::Nil), + List::Cons(hd, tl) => { + if hd.0 >= pivot { + (List::Nil, List::Cons(hd, tl)) + } else { + let (ls0, ls1) = tl.partition_at_pivot(pivot); + (List::Cons(hd, Box::new(ls0)), ls1) + } + } + } + } +} + +impl Leaf { + /// Split a leaf into an internal node with two children. + /// + /// The leaf should have exactly 2 * split_size elements. + /// Also, we use the fact that the keys are sorted in increasing order. + fn split( + &self, + content: Map<Key, Value>, + params: &Params, + node_id_cnt: &mut NodeIdCounter, + ) -> Internal { + // Split the content + let (content0, content1) = content.split_at(params.split_size); + // Get the pivot + let pivot = content1.hd().0; + // Create the two nodes + let id0 = node_id_cnt.fresh_id(); + let id1 = node_id_cnt.fresh_id(); + let left = Leaf { + id: id0, + size: params.split_size, + }; + let right = Leaf { + id: id1, + size: params.split_size, + }; + // Store the content + store_leaf_node(id0, content0); + store_leaf_node(id1, content1); + // Return + Internal { + id: self.id, + pivot, + left: Box::new(Node::Leaf(left)), + right: Box::new(Node::Leaf(right)), + } + } +} + +impl Internal { + /// Small utility: lookup a value in the children nodes. + fn lookup_in_children(&mut self, key: Key) -> Option<Value> { + if key < self.pivot { + self.left.lookup(key) + } else { + self.right.lookup(key) + } + } + + /// Flush the messages in an internal node to its children. + /// Note that when flushing, we send messages to a child only if there + /// are more than min_flush_size messages to send. Also, we flush only + /// if the number of messages in the current node is >= 2* num_flush_size. + /// + /// The function returns the messages we couldn't flush to the children + /// nodes. + fn flush<'a>( + &'a mut self, + params: &Params, + node_id_cnt: &'a mut NodeIdCounter, + content: Map<Key, Message>, + ) -> Map<Key, Message> { + // Partition the messages + let (msgs_left, msgs_right) = content.partition_at_pivot(self.pivot); + // Check if we need to flush to the left child + let len_left = msgs_left.len(); + if len_left >= params.min_flush_size { + // Flush to the left + self.left.apply_messages(params, node_id_cnt, msgs_left); + // Check if we need to flush to the right + let len_right = msgs_right.len(); + if len_right >= params.min_flush_size { + self.right.apply_messages(params, node_id_cnt, msgs_right); + // No messages remain in the current node + List::Nil + } else { + // We keep the messages which belong to the right node + msgs_right + } + } else { + // Don't flush to the left: we necessarily flush to the right + self.right.apply_messages(params, node_id_cnt, msgs_right); + // We keep the messages which belong to the left node + msgs_left + } + } +} + +impl Node { + /// Apply a list of message to ourselves: leaf node case + fn apply_messages_to_leaf<'a>( + bindings: &'a mut Map<Key, Value>, + new_msgs: List<(Key, Message)>, + ) { + match new_msgs { + List::Nil => (), + List::Cons(new_msg, new_msgs_tl) => { + Node::apply_to_leaf(bindings, new_msg.0, new_msg.1); + Node::apply_messages_to_leaf(bindings, *new_msgs_tl); + } + } + } + + /// Apply a message to ourselves: leaf node case + /// + /// This simply updates the bindings. + fn apply_to_leaf<'a>(bindings: &'a mut Map<Key, Value>, key: Key, new_msg: Message) { + // Retrieve a mutable borrow to the position of the binding, if there is + // one, or to the end of the list + let bindings = Node::lookup_mut_in_bindings(key, bindings); + // Check if we point to a binding which has the key we are looking for + if bindings.head_has_key(key) { + // We need to pop the binding, and may need to reuse the + // previous value (for an upsert) + let hd = bindings.pop_front(); + // Match over the message + match new_msg { + Message::Insert(v) => { + bindings.push_front((key, v)); + } + Message::Delete => { + // Nothing to do: we popped the binding + () + } + Message::Upsert(s) => { + let v = upsert_update(Option::Some(hd.1), s); + bindings.push_front((key, v)); + } + } + } else { + // Key not found: simply insert + match new_msg { + Message::Insert(v) => { + bindings.push_front((key, v)); + } + Message::Delete => { + // Nothing to do + () + } + Message::Upsert(s) => { + let v = upsert_update(Option::None, s); + bindings.push_front((key, v)); + } + } + } + } + + /// Apply a list of message to ourselves: internal node case + fn apply_messages_to_internal<'a>( + msgs: &'a mut Map<Key, Message>, + new_msgs: List<(Key, Message)>, + ) { + match new_msgs { + List::Nil => (), + List::Cons(new_msg, new_msgs_tl) => { + Node::apply_to_internal(msgs, new_msg.0, new_msg.1); + Node::apply_messages_to_internal(msgs, *new_msgs_tl); + } + } + } + + /// Apply a message to ourselves: internal node case + /// + /// This basically inserts a message in a messages stack. However, + /// we may need to filter previous messages: for insert, if we insert an + /// [Insert] in a stack which contains an [Insert] or a [Delete] for the + /// same key, we replace this old message with the new one. + fn apply_to_internal<'a>(msgs: &'a mut Map<Key, Message>, key: Key, new_msg: Message) { + // Lookup the first message for [key] (if there is no message for [key], + // we get a mutable borrow to the position in the list where we need + // to insert the new message). + let msgs = Node::lookup_first_message_for_key(key, msgs); + // What we do is not the same, depending on whether there is already + // a message or not. + if msgs.head_has_key(key) { + // We need to check the current message + match new_msg { + Message::Insert(_) | Message::Delete => { + // If [Insert] or [Delete]: filter the current + // messages, and insert the new one + Node::filter_messages_for_key(key, msgs); + msgs.push_front((key, new_msg)); + } + Message::Upsert(s) => { + // If [Update]: we need to take into account the + // previous messages. + match msgs.hd().1 { + Message::Insert(prev) => { + // There should be exactly one [Insert]: + // pop it, compute the result of the [Upsert] + // and insert this result + let v = upsert_update(Option::Some(prev), s); + let _ = msgs.pop_front(); + msgs.push_front((key, Message::Insert(v))); + } + Message::Delete => { + // There should be exactly one [Delete] + // message : pop it, compute the result of + // the [Upsert], and insert this result + let _ = msgs.pop_front(); + let v = upsert_update(Option::None, s); + msgs.push_front((key, Message::Insert(v))); + } + Message::Upsert(_) => { + // There may be several msgs upserts: + // we need to insert the new message at + // the end of the list of upserts (so + // that later we can apply them all in + // proper order). + let msgs = Node::lookup_first_message_after_key(key, msgs); + msgs.push_front((key, Message::Upsert(s))); + } + } + } + } + } else { + // No pending message for [key]: simply add the new message + msgs.push_front((key, new_msg)) + } + } + + /// Apply a message to ourselves + fn apply<'a>( + &'a mut self, + params: &Params, + node_id_cnt: &'a mut NodeIdCounter, + key: Key, + new_msg: Message, + ) { + let msgs = List::Cons((key, new_msg), Box::new(List::Nil)); + self.apply_messages(params, node_id_cnt, msgs); + } + + /// Apply a list of messages to ourselves + fn apply_messages<'a>( + &'a mut self, + params: &Params, + node_id_cnt: &'a mut NodeIdCounter, + msgs: List<(Key, Message)>, + ) { + match self { + Node::Leaf(node) => { + // Load the content from disk + let mut content = load_leaf_node(node.id); + // Insert + Node::apply_messages_to_leaf(&mut content, msgs); + // Check if we need to split - in the future, we might want to + // do something smarter to compute the number of messages + let len = content.len(); + if len >= 2 * params.split_size { + // Split + let new_node = node.split(content, params, node_id_cnt); + // Store the content to disk + store_leaf_node(node.id, List::Nil); + // Update the node + *self = Node::Internal(new_node); + } else { + // Update the size if necessary + node.size = len; + // Store the content to disk + store_leaf_node(node.id, content); + } + } + Node::Internal(node) => { + // Load the content from disk + let mut content = load_internal_node(node.id); + // Insert + Node::apply_messages_to_internal(&mut content, msgs); + // Check if we need to flush - in the future, we might want to + // do something smarter to compute the number of messages + let num_msgs = content.len(); + if num_msgs >= params.min_flush_size { + content = node.flush(params, node_id_cnt, content); + } + // Store the content to disk + store_internal_node(node.id, content) + } + } + } + + /// Lookup a value in a list of bindings. + /// Note that the values should be stored in order of increasing key. + fn lookup_in_bindings(key: Key, bindings: &Map<Key, Value>) -> Option<Value> { + match bindings { + List::Nil => Option::None, + List::Cons(hd, tl) => { + if hd.0 == key { + Option::Some(hd.1) + } else if hd.0 > key { + Option::None + } else { + Node::lookup_in_bindings(key, tl) + } + } + } + } + + /// Lookup a value in a list of bindings, and return a borrow to the position + /// where the value is (or should be inserted, if the key is not in the bindings). + fn lookup_mut_in_bindings<'a>( + key: Key, + bindings: &'a mut Map<Key, Value>, + ) -> &'a mut Map<Key, Value> { + match bindings { + List::Nil => bindings, + List::Cons(hd, tl) => { + // This requires Polonius + if hd.0 >= key { + bindings + } else { + Node::lookup_mut_in_bindings(key, tl) + } + } + } + } + + /// Filter all the messages which concern [key]. + /// + /// Note that the stack of messages must start with a message for [key]: + /// we stop filtering at the first message which is not about [key]. + fn filter_messages_for_key<'a>(key: Key, msgs: &'a mut Map<Key, Message>) { + match msgs { + List::Nil => (), + List::Cons((k, _), _) => { + if *k == key { + msgs.pop_front(); + Node::filter_messages_for_key(key, msgs); + } else { + // Stop + () + } + } + } + } + + fn lookup_first_message_after_key<'a>( + key: Key, + msgs: &'a mut Map<Key, Message>, + ) -> &'a mut Map<Key, Message> { + match msgs { + List::Nil => msgs, + List::Cons((k, _), next_msgs) => { + if *k == key { + Node::lookup_first_message_after_key(key, next_msgs) + } else { + msgs + } + } + } + } + + /// Returns the value bound to a key. + /// Note that while looking for the binding, we might reorganize the + /// internals of the betree to apply or flush messages: hence the mutable + /// borrow. + fn lookup<'a>(&'a mut self, key: Key) -> Option<Value> { + match self { + Node::Leaf(node) => { + // Load the node content + let bindings = load_leaf_node(node.id); + // Just lookup the binding in the map + Node::lookup_in_bindings(key, &bindings) + } + Node::Internal(node) => { + // Load the node content + let mut msgs = load_internal_node(node.id); + // Look for the first message pending for the key. + // Note that we maintain the following invariants: + // - if there are > 1 messages, they must be upsert messages only + // - the upsert messages are sorted from the *first* added to the + // *last* added to the betree. + // Also note that if there are upsert messages, we have to apply + // them immediately. + // + // Rk.: [lookup_first_message_for_key] below returns a borrow to + // the portion of the list we will update (if we have upserts, + // we will apply the messages, filter them while doing so, + // insert an [Insert] message, etc.). Should be interesting + // to see how the proof experience with the backward functions + // is at this for this piece of code. Note that this was inpired + // by Be-Tree. + // Also, can't wait to see how all this will work with loops. + let pending = Node::lookup_first_message_for_key(key, &mut msgs); + match pending { + List::Nil => { + // Nothing: dive into the children + node.lookup_in_children(key) + } + List::Cons((k, msg), _) => { + // Check if the borrow which points inside the messages + // stack points to a message for [key] + if *k != key { + // Note the same key: dive into the children + node.lookup_in_children(key) + } else { + // Same key: match over the message for this key + match msg { + Message::Insert(v) => Some(*v), + Message::Delete => None, + Message::Upsert(_) => { + // There are pending upserts: we have no choice but to + // apply them. + // + // Rk.: rather than calling [lookup], we could actually + // go down the tree accumulating upserts. On the other + // hand, the key is now "hotter", so it is not a bad + // idea to keep it as close to the root as possible. + // Note that what we do is what Be-Tree does. + // + // First, lookup the value from the children. + let v = node.lookup_in_children(key); + // Apply the pending updates, and replace them with + // an [Insert] containing the updated value. + // + // Rk.: Be-Tree doesn't seem to store the newly computed + // value, which I don't understand. + let v = Node::apply_upserts(pending, v, key); + // Update the node content + store_internal_node(node.id, msgs); + // Return the value + Option::Some(v) + } + } + } + } + } + } + } + } + + /// Return a mutable borrow to the first message whose key is <= than [key]. + /// If the key is [key], then it is the first message about [key]. + /// Otherwise, it gives us a mutable borrow to the place where we need + /// to insert new messages (note that the borrow may point to the end + /// of the list). + fn lookup_first_message_for_key<'a>( + key: Key, + msgs: &'a mut Map<Key, Message>, + ) -> &'a mut Map<Key, Message> { + match msgs { + List::Nil => msgs, + List::Cons(x, next_msgs) => { + // Rk.: we need Polonius here + // We wouldn't need Polonius if directly called the proper + // function to make the modifications here (because we wouldn't + // need to return anything). However, it would not be very + // idiomatic, especially with regards to the fact that we will + // rewrite everything with loops at some point. + if x.0 >= key { + msgs + } else { + Node::lookup_first_message_for_key(key, next_msgs) + } + } + } + } + + /// Apply the upserts from the current messages stack to a looked up value. + /// + /// The input mutable borrow must point to the first upsert message in the + /// messages stack of the current node. We remove the messages from the stack + /// while applying them. + /// Note that if there are no more upserts to apply, then the value must be + /// `Some`. Also note that we use the invariant that in the message stack, + /// upsert messages are sorted from the first to the last to apply. + fn apply_upserts(msgs: &mut Map<Key, Message>, prev: Option<Value>, key: Key) -> Value { + if msgs.head_has_key(key) { + // Pop the front message. + // Note that it *must* be an upsert. + let msg = msgs.pop_front(); + match msg.1 { + Message::Upsert(s) => { + // Apply the update + let v = upsert_update(prev, s); + let prev = Option::Some(v); + // Continue + Node::apply_upserts(msgs, prev, key) + } + _ => { + // Unreachable: we can only have [Upsert] messages + // for the key + unreachable!(); + } + } + } else { + // We applied all the upsert messages: simply put an [Insert] + // message and return the value. + let v = prev.unwrap(); + msgs.push_front((key, Message::Insert(v))); + return v; + } + } +} + +impl BeTree { + pub fn new(min_flush_size: u64, split_size: u64) -> Self { + let mut node_id_cnt = NodeIdCounter::new(); + let id = node_id_cnt.fresh_id(); + let root = Node::Leaf(Leaf { id, size: 0 }); + store_leaf_node(id, List::Nil); + let params = Params { + min_flush_size, + split_size, + }; + BeTree { + params, + node_id_cnt, + root, + } + } + + /// Apply a message to the tree. + /// + /// This is an auxiliary function. + fn apply(&mut self, key: Key, msg: Message) { + self.root + .apply(&self.params, &mut self.node_id_cnt, key, msg) + } + + /// Insert a binding from [key] to [value] + pub fn insert(&mut self, key: Key, value: Value) { + let msg = Message::Insert(value); + self.apply(key, msg); + } + + /// Delete the bindings for [key] + pub fn delete(&mut self, key: Key) { + let msg = Message::Delete; + self.apply(key, msg); + } + + /// Apply a query-update + pub fn upsert(&mut self, key: Key, upd: UpsertFunState) { + let msg = Message::Upsert(upd); + self.apply(key, msg); + } + + /// Returns the value bound to a key. + /// Note that while looking for the binding, we might reorganize the + /// internals of the betree to apply or flush messages: hence the mutable + /// borrow. + pub fn lookup<'a>(&'a mut self, key: Key) -> Option<Value> { + self.root.lookup(key) + } +} + +#[cfg(test)] +mod tests { + use crate::betree::*; + use std::collections::HashMap; + use std::fmt::{Display, Error, Formatter}; + use std::vec::Vec; + + struct Maps { + betree: BeTree, + refmap: HashMap<Key, Value>, + } + + impl Maps { + fn insert(&mut self, k: Key, v: Value) { + log::trace!("insert: {} -> {}", k, v); + self.betree.insert(k, v); + self.refmap.insert(k, v); + } + + fn delete(&mut self, k: Key) { + log::trace!("delete: {}", k); + self.betree.delete(k); + self.refmap.remove(&k); + } + + /// This function doesn't return a value: it simply checks that the + /// b-epsilon tree and the reference map have the same bindings. + fn lookup(&mut self, k: Key) { + let v0 = self.betree.lookup(k); + let v1 = self.refmap.get(&k).map(|x| *x); + log::trace!("lookup {k}: betree: {:?}, ref: {:?}", v0, v1); + assert!(v0 == v1); + } + + /// Only testing the addition (the choice of the update function doesn't + /// make much difference) + fn upsert(&mut self, k: Key, v: Value) { + log::trace!("upsert: {} -> add({})", k, v); + self.betree.upsert(k, UpsertFunState::Add(v)); + let prev = self.refmap.get(&k).map(|x| *x); + let nv = upsert_update(prev, UpsertFunState::Add(v)); + self.refmap.insert(k, nv); + } + + /// Check that all the bindings in the betree give the same result as the + /// reference. + /// + /// Rk.: looking up actually updates the b-epsilon tree. + fn check_equal(&mut self) { + let keys: Vec<Key> = self.refmap.keys().map(|k| *k).collect(); + for k in keys { + self.lookup(k); + } + } + } + + impl Display for Map<Key, Value> { + fn fmt(&self, f: &mut Formatter<'_>) -> Result<(), Error> { + match self { + List::Nil => write!(f, ""), + List::Cons(hd, tl) => { + write!(f, "{} -> {}, ", hd.0, hd.1).unwrap(); + tl.fmt(f) + } + } + } + } + + impl Display for UpsertFunState { + fn fmt(&self, f: &mut Formatter<'_>) -> Result<(), Error> { + match self { + UpsertFunState::Add(v) => write!(f, "add({})", v), + UpsertFunState::Sub(v) => write!(f, "sub({})", v), + } + } + } + + impl Display for Message { + fn fmt(&self, f: &mut Formatter<'_>) -> Result<(), Error> { + match self { + Message::Insert(v) => write!(f, "insert({})", v), + Message::Delete => write!(f, "delete"), + Message::Upsert(v) => write!(f, "upsert({})", v), + } + } + } + + impl Display for Map<Key, Message> { + fn fmt(&self, f: &mut Formatter<'_>) -> Result<(), Error> { + match self { + List::Nil => write!(f, ""), + List::Cons(hd, tl) => { + write!(f, "{} -> {}, ", hd.0, hd.1).unwrap(); + tl.fmt(f) + } + } + } + } + + impl Node { + fn fmt(&self, indent: &String, f: &mut Formatter<'_>) -> Result<(), Error> { + match self { + Node::Leaf(node) => { + let content = load_leaf_node(node.id); + write!(f, "{}{}: [{}]", indent, node.id, content) + } + Node::Internal(node) => { + let content = load_internal_node(node.id); + let indent1 = format!("{} ", indent).to_string(); + write!( + f, + "{}{{\n{}{},\n{}[{}],", + indent, indent, node.id, indent, &content + ) + .unwrap(); + write!(f, "\n{}", indent1).unwrap(); + node.left.fmt(&indent1, f).unwrap(); + write!(f, "\n{}", indent1).unwrap(); + node.right.fmt(&indent1, f).unwrap(); + write!(f, "\n{}}}", indent) + } + } + } + } + + impl Display for BeTree { + fn fmt(&self, f: &mut Formatter<'_>) -> Result<(), Error> { + self.root.fmt(&"".to_string(), f) + } + } + + #[test] + fn test1() { + // Initialize the logger + env_logger::init(); + + let mut m = Maps { + betree: BeTree::new(5, 5), + refmap: HashMap::new(), + }; + let num_keys = 100; + + // Insert bindings + for k in 0..num_keys { + let v = 2 * k + 1; + m.insert(k, v); + log::trace!("\n{}", &m.betree); + } + + // Make various queries + for kb in 0..(10 * num_keys) { + let k = kb % num_keys; + match k % 4 { + 0 => { + let v = 3 * k + 2; + m.insert(k, v); + } + 1 => { + m.delete(k); + } + 2 => { + let v = kb % 7; + m.upsert(k, v); + } + 3 => { + m.lookup(k); + } + _ => { + unreachable!(); + } + } + log::trace!("\n{}", &m.betree); + } + + // Check that the b-epsilon tree didn't diverge (we check twice, + // because looking up performs updates that we also want to test) + m.check_equal(); + m.check_equal(); + } + fn range_insert(tree: &mut BeTree, start: Key, end: Key) { + for k in start..end { + tree.insert(k, 2 * k + 1); + } + } +} diff --git a/tests/src/betree/src/betree_utils.rs b/tests/src/betree/src/betree_utils.rs new file mode 100644 index 00000000..fd269f4d --- /dev/null +++ b/tests/src/betree/src/betree_utils.rs @@ -0,0 +1,155 @@ +//! The following module implements utilities for [betree.rs]. +//! Those utilities are only used for serialization/deserialization (we don't +//! reason about them). +//! +//! The issue is that we can't derive serialization/deserialization +//! implementations directly in betree.rs, otherwise we can't translate. +//! We could have hacked in Aeneas to skip those implementations, but I'd +//! rather put a little bit of engineering time into this file, while thinking +//! about a cleaner way of doing this in general. The following file is not +//! difficult to write and maintain anyway. +#![allow(dead_code)] + +use crate::betree::{ + InternalContent, Key, LeafContent, List, Message, NodeId, UpsertFunState, Value, +}; +use serde::{Deserialize, Serialize}; +use std::fs::File; +use std::vec::Vec; + +/// Note that I tried using Serde's facilities to define serialization/ +/// deserialization functions for external types, but it proved cumbersome +/// for the betree case. +#[derive(Serialize, Deserialize)] +pub enum UpsertFunStateSerde { + Add(u64), + Sub(u64), +} + +impl UpsertFunStateSerde { + fn to_state(self) -> UpsertFunState { + match self { + UpsertFunStateSerde::Add(v) => UpsertFunState::Add(v), + UpsertFunStateSerde::Sub(v) => UpsertFunState::Sub(v), + } + } + + fn from_state(msg: UpsertFunState) -> Self { + match msg { + UpsertFunState::Add(v) => UpsertFunStateSerde::Add(v), + UpsertFunState::Sub(v) => UpsertFunStateSerde::Sub(v), + } + } +} + +/// Same remark as for [UpsertFunStateSerde] +#[derive(Serialize, Deserialize)] +enum MessageSerde { + Insert(Value), + Delete, + Upsert(UpsertFunStateSerde), +} + +impl MessageSerde { + fn to_msg(self) -> Message { + match self { + MessageSerde::Insert(v) => Message::Insert(v), + MessageSerde::Delete => Message::Delete, + MessageSerde::Upsert(v) => Message::Upsert(v.to_state()), + } + } + + fn from_msg(msg: Message) -> Self { + match msg { + Message::Insert(v) => MessageSerde::Insert(v), + Message::Delete => MessageSerde::Delete, + Message::Upsert(v) => MessageSerde::Upsert(UpsertFunStateSerde::from_state(v)), + } + } +} + +// For some reason, I don't manage to make that in an impl... +pub(crate) fn list_from_vec<T>(mut v: Vec<T>) -> List<T> { + // We need to reverse + v.reverse(); + let mut l = List::Nil; + for x in v.into_iter() { + l = List::Cons(x, Box::new(l)); + } + l +} + +// For some reason, I don't manage to make that in an impl... +pub(crate) fn list_to_vec<T>(mut l: List<T>) -> Vec<T> { + let mut v = Vec::new(); + loop { + match l { + List::Nil => break, + List::Cons(hd, tl) => { + v.push(hd); + l = *tl; + } + } + } + v +} + +/// See the equivalent function in betree.rs +pub(crate) fn load_internal_node(id: NodeId) -> InternalContent { + // Open the file + std::fs::create_dir_all("tmp").unwrap(); + let filename = format!("tmp/node{}", id).to_string(); + // Read + let f = File::open(filename).unwrap(); + // Serde makes things easy + let c: Vec<(Key, MessageSerde)> = serde_json::from_reader(&f).unwrap(); + let c: Vec<(Key, Message)> = c + .into_iter() + .map(|(key, msg)| (key, msg.to_msg())) + .collect(); + // Convert + list_from_vec(c) +} + +/// See the equivalent function in betree.rs +pub(crate) fn store_internal_node(id: NodeId, content: InternalContent) { + // Open the file + std::fs::create_dir_all("tmp").unwrap(); + let filename = format!("tmp/node{}", id).to_string(); + // Write + let f = File::create(filename).unwrap(); + // Convert + let v: Vec<(Key, Message)> = list_to_vec(content); + let v: Vec<(Key, MessageSerde)> = v + .into_iter() + .map(|(k, msg)| (k, MessageSerde::from_msg(msg))) + .collect(); + // Serde makes things easy + serde_json::to_writer(&f, &v).unwrap(); +} + +/// See the equivalent function in betree.rs +pub(crate) fn load_leaf_node(id: NodeId) -> LeafContent { + // Open the file + std::fs::create_dir_all("tmp").unwrap(); + let filename = format!("tmp/node{}", id).to_string(); + // Read + let f = File::open(filename).unwrap(); + // Serde makes things easy + let c: Vec<(Key, Value)> = serde_json::from_reader(&f).unwrap(); + // Convert + list_from_vec(c) +} + +/// See the equivalent function in betree.rs +pub(crate) fn store_leaf_node(id: NodeId, content: LeafContent) { + // Open the file + std::fs::create_dir_all("tmp").unwrap(); + let filename = format!("tmp/node{}", id).to_string(); + // Write + let f = File::create(filename).unwrap(); + // Convert + let v: Vec<(Key, Value)> = list_to_vec(content); + // Serde makes things easy + serde_json::to_writer(&f, &v).unwrap(); +} diff --git a/tests/src/betree/src/main.rs b/tests/src/betree/src/main.rs new file mode 100644 index 00000000..64e9f7db --- /dev/null +++ b/tests/src/betree/src/main.rs @@ -0,0 +1,4 @@ +mod betree; +mod betree_utils; + +fn main() {} diff --git a/tests/src/bitwise.rs b/tests/src/bitwise.rs new file mode 100644 index 00000000..15962047 --- /dev/null +++ b/tests/src/bitwise.rs @@ -0,0 +1,28 @@ +//@ aeneas-args=-test-trans-units +//! Exercise the bitwise operations + +pub fn shift_u32(a: u32) -> u32 { + let i: usize = 16; + let mut t = a >> i; + t <<= i; + t +} + +pub fn shift_i32(a: i32) -> i32 { + let i: isize = 16; + let mut t = a >> i; + t <<= i; + t +} + +pub fn xor_u32(a: u32, b: u32) -> u32 { + a ^ b +} + +pub fn or_u32(a: u32, b: u32) -> u32 { + a | b +} + +pub fn and_u32(a: u32, b: u32) -> u32 { + a & b +} diff --git a/tests/src/constants.rs b/tests/src/constants.rs new file mode 100644 index 00000000..925c62b1 --- /dev/null +++ b/tests/src/constants.rs @@ -0,0 +1,98 @@ +//@ charon-args=--no-code-duplication +//@ aeneas-args=-test-trans-units +//! Tests with constants + +// Integers + +pub const X0: u32 = 0; + +pub const X1: u32 = u32::MAX; + +#[allow(clippy::let_and_return)] +pub const X2: u32 = { + let x = 3; + x +}; + +pub const X3: u32 = incr(32); + +pub const fn incr(n: u32) -> u32 { + n + 1 +} + +// Pairs + +pub const fn mk_pair0(x: u32, y: u32) -> (u32, u32) { + (x, y) +} + +pub const fn mk_pair1(x: u32, y: u32) -> Pair<u32, u32> { + Pair { x, y } +} + +pub const P0: (u32, u32) = mk_pair0(0, 1); +pub const P1: Pair<u32, u32> = mk_pair1(0, 1); +pub const P2: (u32, u32) = (0, 1); +pub const P3: Pair<u32, u32> = Pair { x: 0, y: 1 }; + +pub struct Pair<T1, T2> { + pub x: T1, + pub y: T2, +} + +pub const Y: Wrap<i32> = Wrap::new(2); + +pub const fn unwrap_y() -> i32 { + Y.value +} + +pub const YVAL: i32 = unwrap_y(); + +pub struct Wrap<T> { + value: T, +} + +impl<T> Wrap<T> { + pub const fn new(value: T) -> Wrap<T> { + Wrap { value } + } +} + +// Additions + +pub const fn get_z1() -> i32 { + const Z1: i32 = 3; + Z1 +} + +pub const fn add(a: i32, b: i32) -> i32 { + a + b +} + +pub const fn get_z2() -> i32 { + add(Q1, add(get_z1(), Q3)) +} + +pub const Q1: i32 = 5; +pub const Q2: i32 = Q1; +pub const Q3: i32 = add(Q2, 3); + +// Static + +pub static S1: u32 = 6; +pub static S2: u32 = incr(S1); +pub static S3: Pair<u32, u32> = P3; +pub static S4: Pair<u32, u32> = mk_pair1(7, 8); + +// Constants with generics +pub struct V<const N: usize, T> { + pub x: [T; N], +} + +impl<const N: usize, T> V<N, T> { + pub const LEN: usize = N; +} + +pub fn use_v<const N: usize, T>() -> usize { + V::<N, T>::LEN +} diff --git a/tests/src/demo.rs b/tests/src/demo.rs new file mode 100644 index 00000000..b9bb7ca2 --- /dev/null +++ b/tests/src/demo.rs @@ -0,0 +1,112 @@ +//@ [coq,fstar] aeneas-args=-use-fuel +#![allow(clippy::needless_lifetimes)] + +/* Simple functions */ + +pub fn choose<'a, T>(b: bool, x: &'a mut T, y: &'a mut T) -> &'a mut T { + if b { + x + } else { + y + } +} + +pub fn mul2_add1(x: u32) -> u32 { + (x + x) + 1 +} + +pub fn use_mul2_add1(x: u32, y: u32) -> u32 { + mul2_add1(x) + y +} + +pub fn incr<'a>(x: &'a mut u32) { + *x += 1; +} + +pub fn use_incr() { + let mut x = 0; + incr(&mut x); + incr(&mut x); + incr(&mut x); +} + +/* Recursion, loops */ + +pub enum CList<T> { + CCons(T, Box<CList<T>>), + CNil, +} + +pub fn list_nth<'a, T>(l: &'a CList<T>, i: u32) -> &'a T { + match l { + CList::CCons(x, tl) => { + if i == 0 { + x + } else { + list_nth(tl, i - 1) + } + } + CList::CNil => { + panic!() + } + } +} + +pub fn list_nth_mut<'a, T>(l: &'a mut CList<T>, i: u32) -> &'a mut T { + match l { + CList::CCons(x, tl) => { + if i == 0 { + x + } else { + list_nth_mut(tl, i - 1) + } + } + CList::CNil => { + panic!() + } + } +} + +pub fn list_nth_mut1<'a, T>(mut l: &'a mut CList<T>, mut i: u32) -> &'a mut T { + while let CList::CCons(x, tl) = l { + if i == 0 { + return x; + } + i -= 1; + l = tl; + } + panic!() +} + +pub fn i32_id(i: i32) -> i32 { + if i == 0 { + 0 + } else { + i32_id(i - 1) + 1 + } +} + +pub fn list_tail<'a, T>(l: &'a mut CList<T>) -> &'a mut CList<T> { + match l { + CList::CCons(_, tl) => list_tail(tl), + CList::CNil => l, + } +} + +/* Traits */ + +pub trait Counter { + fn incr(&mut self) -> usize; +} + +impl Counter for usize { + fn incr(&mut self) -> usize { + let x = *self; + *self += 1; + x + } +} + +pub fn use_counter<'a, T: Counter>(cnt: &'a mut T) -> usize { + cnt.incr() +} diff --git a/tests/src/external.rs b/tests/src/external.rs new file mode 100644 index 00000000..ddd5539f --- /dev/null +++ b/tests/src/external.rs @@ -0,0 +1,14 @@ +//@ charon-args=--no-code-duplication +//@ aeneas-args=-state -split-files +//@ aeneas-args=-test-trans-units +//! This module uses external types and functions + +use std::cell::Cell; + +pub fn use_get(rc: &Cell<u32>) -> u32 { + rc.get() +} + +pub fn incr(rc: &mut Cell<u32>) { + *rc.get_mut() += 1; +} diff --git a/tests/src/hashmap.rs b/tests/src/hashmap.rs new file mode 100644 index 00000000..4552e4f2 --- /dev/null +++ b/tests/src/hashmap.rs @@ -0,0 +1,360 @@ +//@ [coq] aeneas-args=-use-fuel +//@ aeneas-args=-split-files +//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +//@ [lean] aeneas-args=-no-gen-lib-entry +// ^ the `-no-gen-lib-entry` is because we add a custom import in the Hashmap.lean file: we do not +// want to overwrite it. +// TODO: reactivate -test-trans-units + +//! A hashmap implementation. +//! +//! Current limitations: +//! - all the recursive functions should be rewritten with loops, once +//! we have support for this. +//! - we will need function pointers/closures if we want to make the map +//! generic in the key type (having function pointers allows to mimic traits) +//! - for the "get" functions: we don't support borrows inside of enumerations +//! for now, so we can't return a type like `Option<&T>`. The real restriction +//! we currently have on borrows is that we forbid *nested* borrows in function +//! signatures, like in `&'a mut &'b mut T` (and the real problem comes from +//! nested *lifetimes*, not nested borrows). Getting the borrows inside of +//! enumerations mostly requires to pour some implementation time in it. + +use std::vec::Vec; +pub type Key = usize; // TODO: make this generic +pub type Hash = usize; + +pub enum List<T> { + Cons(Key, T, Box<List<T>>), + Nil, +} + +/// A hash function for the keys. +/// Rk.: we use shared references because we anticipate on the generic +/// hash map version. +pub fn hash_key(k: &Key) -> Hash { + // Do nothing for now, we might want to implement something smarter + // in the future, or to call an external function (which will be + // abstract): we don't need to reason about the hash function. + *k +} + +/// A hash map from [u64] to values +pub struct HashMap<T> { + /// The current number of entries in the table + num_entries: usize, + /// The max load factor, expressed as a fraction + max_load_factor: (usize, usize), + /// The max load factor applied to the current table length: + /// gives the threshold at which to resize the table. + max_load: usize, + /// The table itself + slots: Vec<List<T>>, +} + +impl<T> HashMap<T> { + /// Allocate a vector of slots of a given size. + /// We would need a loop, but can't use loops for now... + fn allocate_slots(mut slots: Vec<List<T>>, mut n: usize) -> Vec<List<T>> { + while n > 0 { + slots.push(List::Nil); + n -= 1; + } + slots + } + + /// Create a new table, with a given capacity + fn new_with_capacity( + capacity: usize, + max_load_dividend: usize, + max_load_divisor: usize, + ) -> Self { + // TODO: better to use `Vec::with_capacity(capacity)` instead + // of `Vec::new()` + let slots = HashMap::allocate_slots(Vec::new(), capacity); + HashMap { + num_entries: 0, + max_load_factor: (max_load_dividend, max_load_divisor), + max_load: (capacity * max_load_dividend) / max_load_divisor, + slots, + } + } + + pub fn new() -> Self { + // For now we create a table with 32 slots and a max load factor of 4/5 + HashMap::new_with_capacity(32, 4, 5) + } + + pub fn clear(&mut self) { + self.num_entries = 0; + let slots = &mut self.slots; + let mut i = 0; + while i < slots.len() { + slots[i] = List::Nil; + i += 1; + } + } + + pub fn len(&self) -> usize { + self.num_entries + } + + /// Insert in a list. + /// Return `true` if we inserted an element, `false` if we simply updated + /// a value. + fn insert_in_list(key: Key, value: T, mut ls: &mut List<T>) -> bool { + loop { + match ls { + List::Nil => { + *ls = List::Cons(key, value, Box::new(List::Nil)); + return true; + } + List::Cons(ckey, cvalue, tl) => { + if *ckey == key { + *cvalue = value; + return false; + } else { + ls = tl; + } + } + } + } + } + + /// Auxiliary function to insert in the hashmap without triggering a resize + fn insert_no_resize(&mut self, key: Key, value: T) { + let hash = hash_key(&key); + let hash_mod = hash % self.slots.len(); + // We may want to use slots[...] instead of get_mut... + let inserted = HashMap::insert_in_list(key, value, &mut self.slots[hash_mod]); + if inserted { + self.num_entries += 1; + } + } + + /// Insertion function. + /// May trigger a resize of the hash table. + pub fn insert(&mut self, key: Key, value: T) { + // Insert + self.insert_no_resize(key, value); + // Resize if necessary + if self.len() > self.max_load { + self.try_resize() + } + } + + /// The resize function, called if we need to resize the table after + /// an insertion. + fn try_resize(&mut self) { + // Check that we can resize: we need to check that there are no overflows. + // Note that we are conservative about the usize::MAX. + // Also note that `as usize` is a trait, but we apply it to a constant + // here, which gets compiled by the MIR interpreter (so we don't see + // the conversion, actually). + // Rk.: this is a hit heavy... + let max_usize = u32::MAX as usize; + let capacity = self.slots.len(); + // Checking that there won't be overflows by using the fact that, if m > 0: + // n * m <= p <==> n <= p / m + let n1 = max_usize / 2; + if capacity <= n1 / self.max_load_factor.0 { + // Create a new table with a higher capacity + let mut ntable = HashMap::new_with_capacity( + capacity * 2, + self.max_load_factor.0, + self.max_load_factor.1, + ); + + // Move the elements to the new table + HashMap::move_elements(&mut ntable, &mut self.slots, 0); + + // Replace the current table with the new table + self.slots = ntable.slots; + self.max_load = ntable.max_load; + } + } + + /// Auxiliary function called by [try_resize] to move all the elements + /// from the table to a new table + fn move_elements<'a>(ntable: &'a mut HashMap<T>, slots: &'a mut Vec<List<T>>, mut i: usize) { + while i < slots.len() { + // Move the elements out of the slot i + let ls = std::mem::replace(&mut slots[i], List::Nil); + // Move all those elements to the new table + HashMap::move_elements_from_list(ntable, ls); + // Do the same for slot i+1 + i += 1; + } + } + + /// Auxiliary function. + fn move_elements_from_list(ntable: &mut HashMap<T>, mut ls: List<T>) { + // As long as there are elements in the list, move them + loop { + match ls { + List::Nil => return, // We're done + List::Cons(k, v, tl) => { + // Insert the element in the new table + ntable.insert_no_resize(k, v); + // Move the elements out of the tail + ls = *tl; + } + } + } + } + + /// Returns `true` if the map contains a value for the specified key. + pub fn contains_key(&self, key: &Key) -> bool { + let hash = hash_key(key); + let hash_mod = hash % self.slots.len(); + HashMap::contains_key_in_list(key, &self.slots[hash_mod]) + } + + /// Returns `true` if the list contains a value for the specified key. + pub fn contains_key_in_list(key: &Key, mut ls: &List<T>) -> bool { + loop { + match ls { + List::Nil => return false, + List::Cons(ckey, _, tl) => { + if *ckey == *key { + return true; + } else { + ls = tl; + } + } + } + } + } + + /// We don't support borrows inside of enumerations for now, so we + /// can't return an option... + /// TODO: add support for that + fn get_in_list<'a, 'k>(key: &'k Key, mut ls: &'a List<T>) -> &'a T { + loop { + match ls { + List::Nil => panic!(), + List::Cons(ckey, cvalue, tl) => { + if *ckey == *key { + return cvalue; + } else { + ls = tl; + } + } + } + } + } + + pub fn get<'a, 'k>(&'a self, key: &'k Key) -> &'a T { + let hash = hash_key(key); + let hash_mod = hash % self.slots.len(); + HashMap::get_in_list(key, &self.slots[hash_mod]) + } + + pub fn get_mut_in_list<'a, 'k>(mut ls: &'a mut List<T>, key: &'k Key) -> &'a mut T { + while let List::Cons(ckey, cvalue, tl) = ls { + if *ckey == *key { + return cvalue; + } else { + ls = tl; + } + } + panic!() + } + + /// Same remark as for [get]. + pub fn get_mut<'a, 'k>(&'a mut self, key: &'k Key) -> &'a mut T { + let hash = hash_key(key); + let hash_mod = hash % self.slots.len(); + HashMap::get_mut_in_list(&mut self.slots[hash_mod], key) + } + + /// Remove an element from the list. + /// Return the removed element. + fn remove_from_list(key: &Key, mut ls: &mut List<T>) -> Option<T> { + loop { + match ls { + List::Nil => return None, + // We have to use a guard and split the Cons case into two + // branches, otherwise the borrow checker is not happy. + List::Cons(ckey, _, _) if *ckey == *key => { + // We have to move under borrows, so we need to use + // [std::mem::replace] in several steps. + // Retrieve the tail + let mv_ls = std::mem::replace(ls, List::Nil); + match mv_ls { + List::Nil => unreachable!(), + List::Cons(_, cvalue, tl) => { + // Make the list equal to its tail + *ls = *tl; + // Return the dropped value + return Some(cvalue); + } + } + } + List::Cons(_, _, tl) => { + ls = tl; + } + } + } + } + + /// Same remark as for [get]. + pub fn remove(&mut self, key: &Key) -> Option<T> { + let hash = hash_key(key); + let hash_mod = hash % self.slots.len(); + + let x = HashMap::remove_from_list(key, &mut self.slots[hash_mod]); + match x { + Option::None => Option::None, + Option::Some(x) => { + self.num_entries -= 1; + Option::Some(x) + } + } + } +} + +/// I currently can't retrieve functions marked with the attribute #[test], +/// while I want to extract the unit tests and use the normalize on them, +/// so I have to define the test functions somewhere and call them from +/// a test function. +/// TODO: find a way to do that. +#[allow(dead_code)] +fn test1() { + let mut hm: HashMap<u64> = HashMap::new(); + hm.insert(0, 42); + hm.insert(128, 18); + hm.insert(1024, 138); + hm.insert(1056, 256); + // Rk.: `&128` introduces a ref constant value + // TODO: add support for this + // Rk.: this only happens if we query the MIR too late (for instance, + // the optimized MIR). It is not a problem if we query, say, the + // "built" MIR. + let k = 128; + assert!(*hm.get(&k) == 18); + let k = 1024; + let x = hm.get_mut(&k); + *x = 56; + assert!(*hm.get(&k) == 56); + let x = hm.remove(&k); + // If we write `x == Option::Some(56)` rust introduces + // a call to `core::cmp::PartialEq::eq`, which is a trait + // I don't support for now. + // Also, I haven't implemented support for `unwrap` yet... + match x { + Option::None => panic!(), + Option::Some(x) => assert!(x == 56), + }; + let k = 0; + assert!(*hm.get(&k) == 42); + let k = 128; + assert!(*hm.get(&k) == 18); + let k = 1056; + assert!(*hm.get(&k) == 256); +} + +#[test] +fn tests() { + test1(); +} diff --git a/tests/src/hashmap_main.rs b/tests/src/hashmap_main.rs new file mode 100644 index 00000000..0c827844 --- /dev/null +++ b/tests/src/hashmap_main.rs @@ -0,0 +1,22 @@ +//@ charon-args=--opaque=hashmap_utils +//@ aeneas-args=-state -split-files +//@ [coq] aeneas-args=-use-fuel +//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +// Possible to add `--no-code-duplication` if we use the optimized MIR +// TODO: reactivate -test-trans-units +mod hashmap; +mod hashmap_utils; + +use crate::hashmap::*; +use crate::hashmap_utils::*; + +pub fn insert_on_disk(key: Key, value: u64) { + // Deserialize + let mut hm = deserialize(); + // Update + hm.insert(key, value); + // Serialize + serialize(hm); +} + +pub fn main() {} diff --git a/tests/src/hashmap_utils.rs b/tests/src/hashmap_utils.rs new file mode 100644 index 00000000..33de49e1 --- /dev/null +++ b/tests/src/hashmap_utils.rs @@ -0,0 +1,13 @@ +//@ skip +use crate::hashmap::*; + +/// Serialize a hash map - we don't have traits, so we fix the type of the +/// values (this is not the interesting part anyway) +pub(crate) fn serialize(_hm: HashMap<u64>) { + unimplemented!(); +} +/// Deserialize a hash map - we don't have traits, so we fix the type of the +/// values (this is not the interesting part anyway) +pub(crate) fn deserialize() -> HashMap<u64> { + unimplemented!(); +} diff --git a/tests/src/loops.rs b/tests/src/loops.rs new file mode 100644 index 00000000..8692c60e --- /dev/null +++ b/tests/src/loops.rs @@ -0,0 +1,369 @@ +//@ [coq] aeneas-args=-use-fuel +//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +//@ [fstar] aeneas-args=-split-files +use std::vec::Vec; + +/// No borrows +pub fn sum(max: u32) -> u32 { + let mut i = 0; + let mut s = 0; + while i < max { + s += i; + i += 1; + } + + s *= 2; + s +} + +/// Same as [sum], but we use borrows in order tocreate loans inside a loop +/// iteration, and those borrows will have to be ended by the end of the +/// iteration. +pub fn sum_with_mut_borrows(max: u32) -> u32 { + let mut i = 0; + let mut s = 0; + while i < max { + let ms = &mut s; + *ms += i; + let mi = &mut i; + *mi += 1; + } + + s *= 2; + s +} + +/// Similar to [sum_with_mut_borrows]. +pub fn sum_with_shared_borrows(max: u32) -> u32 { + let mut i = 0; + let mut s = 0; + while i < max { + i += 1; + // We changed the order compared to [sum_with_mut_borrows]: + // we want to have a shared borrow surviving until the end + // of the iteration. + let mi = &i; + s += *mi; + } + + s *= 2; + s +} + +pub fn sum_array<const N: usize>(a: [u32; N]) -> u32 { + let mut i = 0; + let mut s = 0; + while i < N { + s += a[i]; + i += 1; + } + s +} + +/// This case is interesting, because the fixed point for the loop doesn't +/// introduce new abstractions. +pub fn clear(v: &mut Vec<u32>) { + let mut i = 0; + while i < v.len() { + v[i] = 0; + i += 1; + } +} + +pub enum List<T> { + Cons(T, Box<List<T>>), + Nil, +} + +/// The parameter `x` is a borrow on purpose +pub fn list_mem(x: &u32, mut ls: &List<u32>) -> bool { + while let List::Cons(y, tl) = ls { + if *y == *x { + return true; + } else { + ls = tl; + } + } + false +} + +/// Same as [list_nth_mut] but with a loop +pub fn list_nth_mut_loop<T>(mut ls: &mut List<T>, mut i: u32) -> &mut T { + while let List::Cons(x, tl) = ls { + if i == 0 { + return x; + } else { + ls = tl; + i -= 1; + } + } + panic!() +} + +/// Same as [list_nth_mut_loop] but with shared borrows +pub fn list_nth_shared_loop<T>(mut ls: &List<T>, mut i: u32) -> &T { + while let List::Cons(x, tl) = ls { + if i == 0 { + return x; + } else { + ls = tl; + i -= 1; + } + } + panic!() +} + +pub fn get_elem_mut(slots: &mut Vec<List<usize>>, x: usize) -> &mut usize { + let mut ls = &mut slots[0]; + loop { + match ls { + List::Nil => panic!(), + List::Cons(y, tl) => { + if *y == x { + return y; + } else { + ls = tl; + } + } + } + } +} + +pub fn get_elem_shared(slots: &Vec<List<usize>>, x: usize) -> &usize { + let mut ls = &slots[0]; + loop { + match ls { + List::Nil => panic!(), + List::Cons(y, tl) => { + if *y == x { + return y; + } else { + ls = tl; + } + } + } + } +} + +pub fn id_mut<T>(ls: &mut List<T>) -> &mut List<T> { + ls +} + +pub fn id_shared<T>(ls: &List<T>) -> &List<T> { + ls +} + +/// Small variation of [list_nth_mut_loop] +pub fn list_nth_mut_loop_with_id<T>(ls: &mut List<T>, mut i: u32) -> &mut T { + let mut ls = id_mut(ls); + while let List::Cons(x, tl) = ls { + if i == 0 { + return x; + } else { + ls = tl; + i -= 1; + } + } + panic!() +} + +/// Small variation of [list_nth_shared_loop] +pub fn list_nth_shared_loop_with_id<T>(ls: &List<T>, mut i: u32) -> &T { + let mut ls = id_shared(ls); + while let List::Cons(x, tl) = ls { + if i == 0 { + return x; + } else { + ls = tl; + i -= 1; + } + } + panic!() +} + +/// Same as [list_nth_mut] but on a pair of lists. +/// +/// This test checks that we manage to decompose a loop into disjoint regions. +pub fn list_nth_mut_loop_pair<'a, 'b, T>( + mut ls0: &'a mut List<T>, + mut ls1: &'b mut List<T>, + mut i: u32, +) -> (&'a mut T, &'b mut T) { + loop { + match (ls0, ls1) { + (List::Nil, _) | (_, List::Nil) => { + panic!() + } + (List::Cons(x0, tl0), List::Cons(x1, tl1)) => { + if i == 0 { + return (x0, x1); + } else { + ls0 = tl0; + ls1 = tl1; + i -= 1; + } + } + } + } +} + +/// Same as [list_nth_mut_loop_pair] but with shared borrows. +pub fn list_nth_shared_loop_pair<'a, 'b, T>( + mut ls0: &'a List<T>, + mut ls1: &'b List<T>, + mut i: u32, +) -> (&'a T, &'b T) { + loop { + match (ls0, ls1) { + (List::Nil, _) | (_, List::Nil) => { + panic!() + } + (List::Cons(x0, tl0), List::Cons(x1, tl1)) => { + if i == 0 { + return (x0, x1); + } else { + ls0 = tl0; + ls1 = tl1; + i -= 1; + } + } + } + } +} + +/// Same as [list_nth_mut_loop_pair] but this time we force the two loop +/// regions to be merged. +pub fn list_nth_mut_loop_pair_merge<'a, T>( + mut ls0: &'a mut List<T>, + mut ls1: &'a mut List<T>, + mut i: u32, +) -> (&'a mut T, &'a mut T) { + while let (List::Cons(x0, tl0), List::Cons(x1, tl1)) = (ls0, ls1) { + if i == 0 { + return (x0, x1); + } else { + ls0 = tl0; + ls1 = tl1; + i -= 1; + } + } + panic!() +} + +/// Same as [list_nth_mut_loop_pair_merge] but with shared borrows. +pub fn list_nth_shared_loop_pair_merge<'a, T>( + mut ls0: &'a List<T>, + mut ls1: &'a List<T>, + mut i: u32, +) -> (&'a T, &'a T) { + while let (List::Cons(x0, tl0), List::Cons(x1, tl1)) = (ls0, ls1) { + if i == 0 { + return (x0, x1); + } else { + ls0 = tl0; + ls1 = tl1; + i -= 1; + } + } + panic!() +} + +/// Mixing mutable and shared borrows. +pub fn list_nth_mut_shared_loop_pair<'a, 'b, T>( + mut ls0: &'a mut List<T>, + mut ls1: &'b List<T>, + mut i: u32, +) -> (&'a mut T, &'b T) { + while let (List::Cons(x0, tl0), List::Cons(x1, tl1)) = (ls0, ls1) { + if i == 0 { + return (x0, x1); + } else { + ls0 = tl0; + ls1 = tl1; + i -= 1; + } + } + panic!() +} + +/// Same as [list_nth_mut_shared_loop_pair] but this time we force the two loop +/// regions to be merged. +pub fn list_nth_mut_shared_loop_pair_merge<'a, T>( + mut ls0: &'a mut List<T>, + mut ls1: &'a List<T>, + mut i: u32, +) -> (&'a mut T, &'a T) { + while let (List::Cons(x0, tl0), List::Cons(x1, tl1)) = (ls0, ls1) { + if i == 0 { + return (x0, x1); + } else { + ls0 = tl0; + ls1 = tl1; + i -= 1; + } + } + panic!() +} + +/// Same as [list_nth_mut_shared_loop_pair], but we switched the positions of +/// the mutable and shared borrows. +pub fn list_nth_shared_mut_loop_pair<'a, 'b, T>( + mut ls0: &'a List<T>, + mut ls1: &'b mut List<T>, + mut i: u32, +) -> (&'a T, &'b mut T) { + while let (List::Cons(x0, tl0), List::Cons(x1, tl1)) = (ls0, ls1) { + if i == 0 { + return (x0, x1); + } else { + ls0 = tl0; + ls1 = tl1; + i -= 1; + } + } + panic!() +} + +/// Same as [list_nth_mut_shared_loop_pair_merge], but we switch the positions of +/// the mutable and shared borrows. +pub fn list_nth_shared_mut_loop_pair_merge<'a, T>( + mut ls0: &'a List<T>, + mut ls1: &'a mut List<T>, + mut i: u32, +) -> (&'a T, &'a mut T) { + while let (List::Cons(x0, tl0), List::Cons(x1, tl1)) = (ls0, ls1) { + if i == 0 { + return (x0, x1); + } else { + ls0 = tl0; + ls1 = tl1; + i -= 1; + } + } + panic!() +} + +// We do not use the input borrow inside the loop +#[allow(clippy::empty_loop)] +pub fn ignore_input_mut_borrow(_a: &mut u32, mut i: u32) { + while i > 0 { + i -= 1; + } +} + +// We do not use the input borrow inside the loop +#[allow(clippy::empty_loop)] +pub fn incr_ignore_input_mut_borrow(a: &mut u32, mut i: u32) { + *a += 1; + while i > 0 { + i -= 1; + } +} + +// We do not use the input borrow inside the loop +#[allow(clippy::empty_loop)] +pub fn ignore_input_shared_borrow(_a: &mut u32, mut i: u32) { + while i > 0 { + i -= 1; + } +} diff --git a/tests/src/nested_borrows.rs b/tests/src/nested_borrows.rs new file mode 100644 index 00000000..d4d8cf73 --- /dev/null +++ b/tests/src/nested_borrows.rs @@ -0,0 +1,183 @@ +//@ skip +//@ charon-args=--no-code-duplication +//! This module contains functions with nested borrows in their signatures. + +pub fn id_mut_mut<'a, 'b, T>(x: &'a mut &'b mut T) -> &'a mut &'b mut T { + x +} + +pub fn id_mut_pair<'a, T>(x: &'a mut (&'a mut T, u32)) -> &'a mut (&'a mut T, u32) { + x +} + +pub fn id_mut_pair_test1() { + let mut x: u32 = 0; + let px = &mut x; + let mut p = (px, 1); + let pp0 = &mut p; + let pp1 = id_mut_pair(pp0); + let mut y = 2; + *pp1 = (&mut y, 3); +} + +pub fn id_mut_mut_pair<'a, T>( + x: &'a mut &'a mut (&'a mut T, u32), +) -> &'a mut &'a mut (&'a mut T, u32) { + x +} + +pub fn id_mut_mut_mut_same<'a, T>(x: &'a mut &'a mut &'a mut u32) -> &'a mut &'a mut &'a mut u32 { + x +} + +pub fn id_borrow1<'a, 'b, 'c>(_x: &'a mut &'b u32, _y: &'a &'a mut u32) { + () +} + +/// For symbolic execution: testing what happens with several abstractions. +pub fn id_mut_mut_test1() { + let mut x = 0; + let mut px = &mut x; + let ppx = &mut px; + let ppy = id_mut_mut(ppx); + **ppy = 1; + // Ending one abstraction + assert!(*px == 1); + // Ending the other abstraction + assert!(x == 1); +} + +/* +/// For symbolic execution: testing what happens with several abstractions. +/// This case is a bit trickier, because we modify the borrow graph through +/// a value returned by a function call. +/// TODO: not supported! We overwrite a borrow in a returned value. +pub fn id_mut_mut_test2() { + let mut x = 0; + let mut px = &mut x; + let ppx = &mut px; + let ppy = id_mut_mut(ppx); + **ppy = 1; + // This time, we replace one of the borrows + let mut y = 2; + let py = &mut y; + *ppy = py; + // Ending one abstraction + assert!(*px == 2); + *px = 3; + // Ending the other abstraction + assert!(x == 1); + assert!(y == 3); +} +*/ + +/* +/// For symbolic execution: testing what happens with several abstractions. +/// See what happens when chaining function calls. +/// TODO: not supported! We overwrite a borrow in a returned value. +pub fn id_mut_mut_test3() { + let mut x = 0; + let mut px = &mut x; + let ppx = &mut px; + let ppy = id_mut_mut(ppx); // &'a mut &'b mut i32 + **ppy = 1; + let ppz = id_mut_mut(ppy); // &'c mut &'b mut i32 + **ppz = 2; + // End 'a and 'c + assert!(*px == 2); + // End 'b (2 abstractions at once) + assert!(x == 2); +}*/ + +/* +/// For symbolic execution: testing what happens with several abstractions. +/// See what happens when chaining function calls. +/// This one is slightly more complex than the previous one. +pub fn id_mut_mut_test4() { + let mut x = 0; + let mut px = &mut x; + let ppx = &mut px; + let ppy = id_mut_mut(ppx); // &'a mut &'b mut i32 + **ppy = 1; + let ppz = id_mut_mut(ppy); // &'c mut &'b mut i32 + **ppz = 2; + // End 'c + assert!(**ppy == 2); + // End 'a + assert!(*px == 2); + // End 'b (2 abstractions at once) + assert!(x == 2); +} +*/ + +fn id<'a, T>(x: &'a mut T) -> &'a mut T { + x +} + +/// Checking projectors over symbolic values +pub fn test_borrows1() { + let mut x = 3; + let y = id(&mut x); + let z = id(y); + // We do not write a statement which would expand `z` on purpose: + // we want to test that the handling of non-expanded symbolic values + // is correct + assert!(x == 3); +} + +fn id_pair<'a, 'b, T>(x: &'a mut T, y: &'b mut T) -> (&'a mut T, &'b mut T) { + (x, y) +} + +/// Similar to the previous one +pub fn test_borrows2() { + let mut x = 3; + let mut y = 4; + let z = id_pair(&mut x, &mut y); + // We do not write a statement which would expand `z` on purpose: + // we want to test that the handling of non-expanded symbolic values + // is correct + assert!(x == 3); + assert!(y == 4); +} + +/// input type: 'b must last longer than 'a +/// output type: 'a must last longer than 'b +/// So: 'a = 'b, and the function is legal. +pub fn nested_mut_borrows1<'a, 'b>(x: &'a mut &'b mut u32) -> &'b mut &'a mut u32 { + x +} + +pub fn nested_shared_borrows1<'a, 'b>(x: &'a &'b u32) -> &'a &'b u32 { + x +} + +pub fn nested_borrows1<'a, 'b>(x: &'a mut &'b u32) -> &'a mut &'b u32 { + x +} + +pub fn nested_borrows2<'a, 'b>(x: &'a &'b mut u32) -> &'a &'b mut u32 { + x +} + +fn nested_borrows1_test1() { + let x = 0; + let mut px = &x; + let ppx = &mut px; + let ppy = nested_borrows1(ppx); + assert!(**ppy == 0); + assert!(x == 0); +} + +fn nested_borrows1_test2<'a, 'b>(x: &'a mut &'b u32) -> &'a mut &'b u32 { + nested_borrows1(x) +} + +fn nested_borrows2_test1() { + let mut x = 0; + let px = &mut x; + let ppx = &px; + let ppy = nested_borrows2(ppx); + assert!(**ppy == 0); + assert!(x == 0); +} diff --git a/tests/src/no_nested_borrows.rs b/tests/src/no_nested_borrows.rs new file mode 100644 index 00000000..78163371 --- /dev/null +++ b/tests/src/no_nested_borrows.rs @@ -0,0 +1,493 @@ +//@ charon-args=--no-code-duplication +//@ aeneas-args=-test-trans-units +//! This module doesn't contain **functions which use nested borrows in their +//! signatures**, and doesn't contain functions with loops. + +pub struct Pair<T1, T2> { + pub x: T1, + pub y: T2, +} + +pub enum List<T> { + Cons(T, Box<List<T>>), + Nil, +} + +/// Sometimes, enumerations with one variant are not treated +/// the same way as the other variants (for example, downcasts +/// are not always introduced). +/// A downcast is the cast of an enum to a specific variant, like +/// in the left value of: +/// `((_0 as Right).0: T2) = move _1;` +pub enum One<T1> { + One(T1), +} + +/// Truely degenerate case +/// Instantiations of this are encoded as constant values by rust. +pub enum EmptyEnum { + Empty, +} + +/// Enumeration (several variants with no parameters) +/// Those are not encoded as constant values. +pub enum Enum { + Variant1, + Variant2, +} + +/// Degenerate struct +/// Instanciations of this are encoded as constant values by rust. +pub struct EmptyStruct {} + +pub enum Sum<T1, T2> { + Left(T1), + Right(T2), +} + +pub fn cast_u32_to_i32(x: u32) -> i32 { + x as i32 +} + +pub fn cast_bool_to_i32(x: bool) -> i32 { + x as i32 +} + +#[allow(clippy::unnecessary_cast)] +pub fn cast_bool_to_bool(x: bool) -> bool { + x as bool +} + +#[allow(unused_variables)] +pub fn test2() { + let x: u32 = 23; + let y: u32 = 44; + let z = x + y; + let p: Pair<u32, u32> = Pair { x, y: z }; + let s: Sum<u32, bool> = Sum::Right(true); + let o: One<u64> = One::One(3); + let e0 = EmptyEnum::Empty; + let e1 = e0; + let enum0 = Enum::Variant1; +} + +pub fn get_max(x: u32, y: u32) -> u32 { + if x >= y { + x + } else { + y + } +} + +pub fn test3() { + let x = get_max(4, 3); + let y = get_max(10, 11); + let z = x + y; + assert!(z == 15); +} + +pub fn test_neg1() { + let x: i32 = 3; + let y = -x; + assert!(y == -3); +} + +/// Testing nested references. +pub fn refs_test1() { + let mut x = 0; + let mut px = &mut x; + let ppx = &mut px; + **ppx = 1; + // The interesting thing happening here is that the borrow of x is inside + // the borrow of px: ending the borrow of x requires ending the borrow of + // px first. + assert!(x == 1); +} + +pub fn refs_test2() { + let mut x = 0; + let mut y = 1; + let mut px = &mut x; + let py = &mut y; + let ppx = &mut px; + *ppx = py; + **ppx = 2; + assert!(*px == 2); + assert!(x == 0); + assert!(*py == 2); + assert!(y == 2); +} + +/// Box creation +#[allow(unused_variables)] +pub fn test_list1() { + let l: List<i32> = List::Cons(0, Box::new(List::Nil)); +} + +/// Box deref +pub fn test_box1() { + use std::ops::Deref; + use std::ops::DerefMut; + let mut b: Box<i32> = Box::new(0); + let x = b.deref_mut(); + *x = 1; + let x = b.deref(); + assert!(*x == 1); +} + +pub fn copy_int(x: i32) -> i32 { + x +} + +/// Just checking the parameters given to unreachable +/// Rk.: the input parameter prevents using the function as a unit test. +pub fn test_unreachable(b: bool) { + if b { + unreachable!(); + } +} + +/// Just checking the parameters given to panic +/// Rk.: the input parameter prevents using the function as a unit test. +pub fn test_panic(b: bool) { + if b { + panic!("Panicked!"); + } +} + +// Just testing that shared loans are correctly handled +pub fn test_copy_int() { + let x = 0; + let px = &x; + let y = copy_int(x); + assert!(*px == y); +} + +pub fn is_cons<T>(l: &List<T>) -> bool { + match l { + List::Cons(_, _) => true, + List::Nil => false, + } +} + +pub fn test_is_cons() { + let l: List<i32> = List::Cons(0, Box::new(List::Nil)); + + assert!(is_cons(&l)); +} + +pub fn split_list<T>(l: List<T>) -> (T, List<T>) { + match l { + List::Cons(hd, tl) => (hd, *tl), + _ => panic!(), + } +} + +#[allow(unused_variables)] +pub fn test_split_list() { + let l: List<i32> = List::Cons(0, Box::new(List::Nil)); + + let (hd, tl) = split_list(l); + assert!(hd == 0); +} + +pub fn choose<'a, T>(b: bool, x: &'a mut T, y: &'a mut T) -> &'a mut T { + if b { + x + } else { + y + } +} + +pub fn choose_test() { + let mut x = 0; + let mut y = 0; + let z = choose(true, &mut x, &mut y); + *z += 1; + assert!(*z == 1); + // drop(z) + assert!(x == 1); + assert!(y == 0); +} + +/// Test with a char literal - testing serialization +pub fn test_char() -> char { + 'a' +} + +/// Mutually recursive types +pub enum Tree<T> { + Leaf(T), + Node(T, NodeElem<T>, Box<Tree<T>>), +} + +pub enum NodeElem<T> { + Cons(Box<Tree<T>>, Box<NodeElem<T>>), + Nil, +} + +/* +// TODO: those definitions requires semantic termination (breaks the Coq backend +// because we don't use fuel in this case). + +/// Mutually recursive functions +pub fn even(x: u32) -> bool { + if x == 0 { + true + } else { + odd(x - 1) + } +} + +pub fn odd(x: u32) -> bool { + if x == 0 { + false + } else { + even(x - 1) + } +} + +pub fn test_even_odd() { + assert!(even(0)); + assert!(even(4)); + assert!(odd(1)); + assert!(odd(5)); +} +*/ + +#[allow(clippy::needless_lifetimes)] +pub fn list_length<'a, T>(l: &'a List<T>) -> u32 { + match l { + List::Nil => 0, + List::Cons(_, l1) => 1 + list_length(l1), + } +} + +#[allow(clippy::needless_lifetimes)] +pub fn list_nth_shared<'a, T>(l: &'a List<T>, i: u32) -> &'a T { + match l { + List::Nil => { + panic!() + } + List::Cons(x, tl) => { + if i == 0 { + x + } else { + list_nth_shared(tl, i - 1) + } + } + } +} + +#[allow(clippy::needless_lifetimes)] +pub fn list_nth_mut<'a, T>(l: &'a mut List<T>, i: u32) -> &'a mut T { + match l { + List::Nil => { + panic!() + } + List::Cons(x, tl) => { + if i == 0 { + x + } else { + list_nth_mut(tl, i - 1) + } + } + } +} + +/// In-place list reversal - auxiliary function +pub fn list_rev_aux<T>(li: List<T>, mut lo: List<T>) -> List<T> { + match li { + List::Nil => lo, + List::Cons(hd, mut tl) => { + let next = *tl; + *tl = lo; + lo = List::Cons(hd, tl); + list_rev_aux(next, lo) + } + } +} + +/// In-place list reversal +#[allow(clippy::needless_lifetimes)] +pub fn list_rev<'a, T>(l: &'a mut List<T>) { + let li = std::mem::replace(l, List::Nil); + *l = list_rev_aux(li, List::Nil); +} + +pub fn test_list_functions() { + let mut ls = List::Cons( + 0, + Box::new(List::Cons(1, Box::new(List::Cons(2, Box::new(List::Nil))))), + ); + assert!(list_length(&ls) == 3); + assert!(*list_nth_shared(&ls, 0) == 0); + assert!(*list_nth_shared(&ls, 1) == 1); + assert!(*list_nth_shared(&ls, 2) == 2); + let x = list_nth_mut(&mut ls, 1); + *x = 3; + assert!(*list_nth_shared(&ls, 0) == 0); + assert!(*list_nth_shared(&ls, 1) == 3); // Updated + assert!(*list_nth_shared(&ls, 2) == 2); +} + +pub fn id_mut_pair1<'a, T1, T2>(x: &'a mut T1, y: &'a mut T2) -> (&'a mut T1, &'a mut T2) { + (x, y) +} + +pub fn id_mut_pair2<'a, T1, T2>(p: (&'a mut T1, &'a mut T2)) -> (&'a mut T1, &'a mut T2) { + p +} + +pub fn id_mut_pair3<'a, 'b, T1, T2>(x: &'a mut T1, y: &'b mut T2) -> (&'a mut T1, &'b mut T2) { + (x, y) +} + +pub fn id_mut_pair4<'a, 'b, T1, T2>(p: (&'a mut T1, &'b mut T2)) -> (&'a mut T1, &'b mut T2) { + p +} + +/// Testing constants (some constants are hard to retrieve from MIR, because +/// they are compiled to very low values). +/// We resort to the following structure to make rustc generate constants... +pub struct StructWithTuple<T1, T2> { + p: (T1, T2), +} + +pub fn new_tuple1() -> StructWithTuple<u32, u32> { + StructWithTuple { p: (1, 2) } +} + +pub fn new_tuple2() -> StructWithTuple<i16, i16> { + StructWithTuple { p: (1, 2) } +} + +pub fn new_tuple3() -> StructWithTuple<u64, i64> { + StructWithTuple { p: (1, 2) } +} + +/// Similar to [StructWithTuple] +pub struct StructWithPair<T1, T2> { + p: Pair<T1, T2>, +} + +pub fn new_pair1() -> StructWithPair<u32, u32> { + // This actually doesn't make rustc generate a constant... + // I guess it only happens for tuples. + StructWithPair { + p: Pair { x: 1, y: 2 }, + } +} + +pub fn test_constants() { + assert!(new_tuple1().p.0 == 1); + assert!(new_tuple2().p.0 == 1); + assert!(new_tuple3().p.0 == 1); + assert!(new_pair1().p.x == 1); +} + +/// This assignment is trickier than it seems +#[allow(unused_assignments)] +pub fn test_weird_borrows1() { + let mut x = 0; + let mut px = &mut x; + // Context: + // x -> [l0] + // px -> &mut l0 (0:i32) + + px = &mut (*px); +} + +pub fn test_mem_replace(px: &mut u32) { + let y = std::mem::replace(px, 1); + assert!(y == 0); + *px = 2; +} + +/// Check that matching on borrowed values works well. +pub fn test_shared_borrow_bool1(b: bool) -> u32 { + // Create a shared borrow of b + let _pb = &b; + // Match on b + if b { + 0 + } else { + 1 + } +} + +/// Check that matching on borrowed values works well. +/// Testing the concrete execution here. +pub fn test_shared_borrow_bool2() -> u32 { + let b = true; + // Create a shared borrow of b + let _pb = &b; + // Match on b + if b { + 0 + } else { + 1 + } +} + +/// Check that matching on borrowed values works well. +/// In case of enumerations, we need to strip the outer loans before evaluating +/// the discriminant. +pub fn test_shared_borrow_enum1(l: List<u32>) -> u32 { + // Create a shared borrow of l + let _pl = &l; + // Match on l - must ignore the shared loan + match l { + List::Nil => 0, + List::Cons(_, _) => 1, + } +} + +/// Check that matching on borrowed values works well. +/// Testing the concrete execution here. +pub fn test_shared_borrow_enum2() -> u32 { + let l: List<u32> = List::Nil; + // Create a shared borrow of l + let _pl = &l; + // Match on l - must ignore the shared loan + match l { + List::Nil => 0, + List::Cons(_, _) => 1, + } +} + +pub fn incr(x: &mut u32) { + *x += 1; +} + +pub fn call_incr(mut x: u32) -> u32 { + incr(&mut x); + x +} + +pub fn read_then_incr(x: &mut u32) -> u32 { + let r = *x; + *x += 1; + r +} + +pub struct Tuple<T1, T2>(T1, T2); + +pub fn use_tuple_struct(x: &mut Tuple<u32, u32>) { + x.0 = 1; +} + +pub fn create_tuple_struct(x: u32, y: u64) -> Tuple<u32, u64> { + Tuple(x, y) +} + +/// Structure with one field +pub struct IdType<T>(T); + +pub fn use_id_type<T>(x: IdType<T>) -> T { + x.0 +} + +pub fn create_id_type<T>(x: T) -> IdType<T> { + IdType(x) +} diff --git a/tests/src/paper.rs b/tests/src/paper.rs new file mode 100644 index 00000000..07453098 --- /dev/null +++ b/tests/src/paper.rs @@ -0,0 +1,84 @@ +//@ charon-args=--no-code-duplication +//@ aeneas-args=-test-trans-units +//! The examples from the ICFP submission, all in one place. + +// 2.1 +pub fn ref_incr(x: &mut i32) { + *x = *x + 1; +} + +pub fn test_incr() { + let mut x = 0i32; + ref_incr(&mut x); + assert!(x == 1); +} + +// 2.2 +pub fn choose<'a, T>(b: bool, x: &'a mut T, y: &'a mut T) -> &'a mut T { + if b { + return x; + } else { + return y; + } +} + +pub fn test_choose() { + let mut x = 0; + let mut y = 0; + let z = choose(true, &mut x, &mut y); + *z = *z + 1; + assert!(*z == 1); + assert!(x == 1); + assert!(y == 0); +} + +// 2.3 + +pub enum List<T> { + Cons(T, Box<List<T>>), + Nil, +} +use List::Cons; +use List::Nil; + +pub fn list_nth_mut<'a, T>(l: &'a mut List<T>, i: u32) -> &'a mut T { + match l { + Nil => { + panic!() + } + Cons(x, tl) => { + if i == 0 { + return x; + } else { + return list_nth_mut(tl, i - 1); + } + } + } +} + +pub fn sum(l: &List<i32>) -> i32 { + match l { + Nil => { + return 0; + } + Cons(x, tl) => { + return *x + sum(tl); + } + } +} + +pub fn test_nth() { + let mut l = Cons(1, Box::new(Cons(2, Box::new(Cons(3, Box::new(Nil)))))); + let x = list_nth_mut(&mut l, 2); + *x = *x + 1; + assert!(sum(&l) == 7); +} + +// 4.3 +pub fn call_choose(mut p: (u32, u32)) -> u32 { + let px = &mut p.0; + let py = &mut p.1; + let pz = choose(true, px, py); + *pz = *pz + 1; + return p.0; +} diff --git a/tests/src/polonius_list.rs b/tests/src/polonius_list.rs new file mode 100644 index 00000000..a8d51e40 --- /dev/null +++ b/tests/src/polonius_list.rs @@ -0,0 +1,29 @@ +//@ charon-args=--polonius +//@ aeneas-args=-test-trans-units +#![allow(dead_code)] + +pub enum List<T> { + Cons(T, Box<List<T>>), + Nil, +} + +/// An example which comes from the b-epsilon tree. +/// +/// Returns a mutable borrow to the first portion of the list where we +/// can find [x]. This allows to do in-place modifications (insertion, filtering) +/// in a natural manner (this piece of code was inspired by the C++ BeTree). +pub fn get_list_at_x<'a>(ls: &'a mut List<u32>, x: u32) -> &'a mut List<u32> { + match ls { + List::Nil => { + // We reached the end: just return it + ls + } + List::Cons(hd, tl) => { + if *hd == x { + ls // Doing this requires NLL + } else { + get_list_at_x(tl, x) + } + } + } +} diff --git a/tests/src/traits.rs b/tests/src/traits.rs new file mode 100644 index 00000000..fd50db8c --- /dev/null +++ b/tests/src/traits.rs @@ -0,0 +1,342 @@ +//@ [fstar] aeneas-args=-decreases-clauses -template-clauses +pub trait BoolTrait { + // Required method + fn get_bool(&self) -> bool; + + // Provided method + fn ret_true(&self) -> bool { + true + } +} + +impl BoolTrait for bool { + fn get_bool(&self) -> bool { + *self + } +} + +pub fn test_bool_trait_bool(x: bool) -> bool { + x.get_bool() && x.ret_true() +} + +#[allow(clippy::redundant_pattern_matching)] +impl<T> BoolTrait for Option<T> { + fn get_bool(&self) -> bool { + match self { + Option::Some(_) => true, + Option::None => false, + } + } +} + +pub fn test_bool_trait_option<T>(x: Option<T>) -> bool { + x.get_bool() && x.ret_true() +} + +pub fn test_bool_trait<T: BoolTrait>(x: T) -> bool { + x.get_bool() +} + +pub trait ToU64 { + fn to_u64(self) -> u64; +} + +impl ToU64 for u64 { + fn to_u64(self) -> u64 { + self + } +} + +impl<A: ToU64> ToU64 for (A, A) { + fn to_u64(self) -> u64 { + self.0.to_u64() + self.1.to_u64() + } +} + +pub fn f<T: ToU64>(x: (T, T)) -> u64 { + x.to_u64() +} + +pub fn g<T>(x: (T, T)) -> u64 +where + (T, T): ToU64, +{ + x.to_u64() +} + +pub fn h0(x: u64) -> u64 { + x.to_u64() +} + +pub struct Wrapper<T> { + x: T, +} + +impl<T: ToU64> ToU64 for Wrapper<T> { + fn to_u64(self) -> u64 { + self.x.to_u64() + } +} + +pub fn h1(x: Wrapper<u64>) -> u64 { + x.to_u64() +} + +pub fn h2<T: ToU64>(x: Wrapper<T>) -> u64 { + x.to_u64() +} + +pub trait ToType<T> { + fn to_type(self) -> T; +} + +impl ToType<bool> for u64 { + fn to_type(self) -> bool { + self > 0 + } +} + +pub trait OfType { + fn of_type<T: ToType<Self>>(x: T) -> Self + where + Self: std::marker::Sized; +} + +pub fn h3<T1: OfType, T2: ToType<T1>>(y: T2) -> T1 { + T1::of_type(y) +} + +// Checking what happens if we move trait clauses from a method to its enclosing block +pub trait OfTypeBis<T: ToType<Self>> +where + Self: std::marker::Sized, +{ + fn of_type(x: T) -> Self + where + Self: std::marker::Sized; +} + +pub fn h4<T1: OfTypeBis<T2>, T2: ToType<T1>>(y: T2) -> T1 { + T1::of_type(y) +} + +pub struct TestType<T>(T); + +// Checking what happens with nested blocks +impl<T: ToU64> TestType<T> { + pub fn test(&self, x: T) -> bool { + struct TestType1(u64); + trait TestTrait { + fn test(&self) -> bool; + } + + // Remark: we can't write: impl TestTrait for TestType<T>, + // we have to use a *local* parameter (can't use the outer T). + // In other words: the parameters used in the items inside + // an impl must be bound by the impl block (can't come from outer + // blocks). + + impl TestTrait for TestType1 { + fn test(&self) -> bool { + self.0 > 1 + } + } + + let x = x.to_u64(); + let y = TestType1(0); + x > 0 && y.test() + } +} + +pub struct BoolWrapper(pub bool); + +impl<T> ToType<T> for BoolWrapper +where + bool: ToType<T>, +{ + fn to_type(self) -> T { + self.0.to_type() + } +} + +pub trait WithConstTy<const LEN: usize> { + const LEN1: usize; + // Testing default values + const LEN2: usize = 32; + + type V; + type W: ToU64; + + // Below: we can't use [Self::Len1] in the type of the array. + // Probably because of dyn traits... + fn f(x: &mut Self::W, y: &[u8; LEN]); +} + +impl WithConstTy<32> for bool { + const LEN1: usize = 12; + + type V = u8; + type W = u64; + + fn f(_: &mut Self::W, _: &[u8; 32]) {} +} + +pub fn use_with_const_ty1<const LEN: usize, H: WithConstTy<LEN>>() -> usize { + H::LEN1 +} + +pub fn use_with_const_ty2<const LEN: usize, H: WithConstTy<LEN>>(_: H::W) {} + +pub fn use_with_const_ty3<const LEN: usize, H: WithConstTy<LEN>>(x: H::W) -> u64 { + x.to_u64() +} + +pub fn test_where1<'a, T: 'a>(_x: &'a T) {} +pub fn test_where2<T: WithConstTy<32, V = u32>>(_x: T::V) {} + +// Below: testing super traits. +// +// Actually, this comes for free: ChildTrait : ParentTrait just adds a trait +// clause for Self: `Self : ParentTrait`. +pub trait ParentTrait0 { + type W; + fn get_name(&self) -> String; + fn get_w(&self) -> Self::W; +} +pub trait ParentTrait1 {} +pub trait ChildTrait: ParentTrait0 + ParentTrait1 {} + +// But we still need to correctly reference the traits +pub fn test_child_trait1<T: ChildTrait>(x: &T) -> String { + x.get_name() +} + +pub fn test_child_trait2<T: ChildTrait>(x: &T) -> T::W { + x.get_w() +} + +// Checking if the order has an importance (we use U::W before we declare that +// U:ParentTrait0) +pub fn order1<T: ParentTrait0<W = U::W>, U: ParentTrait0>() {} + +/* */ +pub trait ChildTrait1: ParentTrait1 {} + +impl ParentTrait1 for usize {} +impl ChildTrait1 for usize {} + +/* [IntoIterator] is interesting because of the condition [Item = Self::Item] +for the [IntoIter] associated type. */ +pub trait Iterator { + type Item; +} + +pub trait IntoIterator { + type Item; + type IntoIter: Iterator<Item = Self::Item>; + + // Required method + fn into_iter(self) -> Self::IntoIter; +} + +/* The traits below are inspired by [Try] and [FromResidual]. + + The reference to `Self as Try` in the `FromResidual` clause used to + cause a bug. +*/ +trait Try: FromResidual<<Self as Try>::Residual> { + type Residual; +} + +trait FromResidual<T> {} + +pub trait WithTarget { + type Target; +} + +pub trait ParentTrait2 { + type U: WithTarget; +} + +pub trait ChildTrait2: ParentTrait2 { + fn convert(x: Self::U) -> <Self::U as WithTarget>::Target; +} + +impl WithTarget for u32 { + type Target = u32; +} + +impl ParentTrait2 for u32 { + type U = u32; +} + +impl ChildTrait2 for u32 { + fn convert(x: u32) -> u32 { + x + } +} + +/* +// This one requires a lot of traits +pub fn test_enumerate(x: usize) { + for _ in 0..x {} +} +*/ + +/* Custom function pointers */ +pub trait CFnOnce<Args> { + type Output; + + fn call_once(self, args: Args) -> Self::Output; +} + +pub trait CFnMut<Args>: CFnOnce<Args> { + fn call_mut(&mut self, args: Args) -> Self::Output; +} + +pub trait CFn<Args>: CFnMut<Args> { + fn call(&self, args: Args) -> Self::Output; +} + +pub trait GetTrait { + type W; + fn get_w(&self) -> Self::W; +} + +pub fn test_get_trait<T: GetTrait>(x: &T) -> T::W { + x.get_w() +} + +// Constants with generics +pub trait Trait { + const LEN: usize; +} + +impl<const N: usize, T> Trait for [T; N] { + const LEN: usize = N; +} + +impl<T: Trait> Trait for Wrapper<T> { + const LEN: usize = 0; +} + +pub fn use_wrapper_len<T: Trait>() -> usize { + Wrapper::<T>::LEN +} + +pub struct Foo<T, U> { + pub x: T, + pub y: U, +} + +impl<T: Trait, U> Foo<T, U> { + pub const FOO: Result<T, i32> = Err(0); +} + +pub fn use_foo1<T: Trait, U>() -> Result<T, i32> { + Foo::<T, U>::FOO +} + +pub fn use_foo2<T, U: Trait>() -> Result<U, i32> { + Foo::<U, T>::FOO +} diff --git a/backends/lean/Base/Arith/Arith.lean b/tests/test_runner/.ocamlformat index e69de29b..e69de29b 100644 --- a/backends/lean/Base/Arith/Arith.lean +++ b/tests/test_runner/.ocamlformat diff --git a/tests/test_runner/aeneas_test_runner.opam b/tests/test_runner/aeneas_test_runner.opam new file mode 100644 index 00000000..b57cc9f6 --- /dev/null +++ b/tests/test_runner/aeneas_test_runner.opam @@ -0,0 +1,27 @@ +# This file is generated by dune, edit dune-project instead +opam-version: "2.0" +version: "0.1" +authors: ["Son Ho" "Guillaume Boisseau"] +license: "Apache-2.0" +homepage: "https://github.com/AeneasVerif/aeneas" +bug-reports: "https://github.com/AeneasVerif/aeneas/issues" +depends: [ + "ocaml" + "dune" {>= "3.12"} + "odoc" {with-doc} +] +build: [ + ["dune" "subst"] {dev} + [ + "dune" + "build" + "-p" + name + "-j" + jobs + "@install" + "@runtest" {with-test} + "@doc" {with-doc} + ] +] +dev-repo: "git+https://github.com/AeneasVerif/aeneas.git" diff --git a/tests/test_runner/dune b/tests/test_runner/dune new file mode 100644 index 00000000..e8b29d66 --- /dev/null +++ b/tests/test_runner/dune @@ -0,0 +1,10 @@ +(executable + (public_name test_runner) + (libraries core_unix.sys_unix re unix) + (preprocess + (pps ppx_deriving.show ppx_deriving.ord ppx_sexp_conv)) + (name run_test)) + +(env + (dev + (flags :standard -warn-error -5@8-11-14-32-33-20-21-26-27-39))) diff --git a/tests/test_runner/dune-project b/tests/test_runner/dune-project new file mode 100644 index 00000000..dc352bd0 --- /dev/null +++ b/tests/test_runner/dune-project @@ -0,0 +1,25 @@ +(lang dune 3.7) + +(name aeneas_test_runner) + +(version 0.1) + +(generate_opam_files true) + +(source + (uri git+https://github.com/AeneasVerif/aeneas.git)) + +(homepage "https://github.com/AeneasVerif/aeneas") + +(bug_reports "https://github.com/AeneasVerif/aeneas/issues") + +(authors + "Son Ho" + "Guillaume Boisseau") + +(license Apache-2.0) + +(package + (name aeneas_test_runner) + (depends ocaml dune) +) diff --git a/tests/test_runner/run_test.ml b/tests/test_runner/run_test.ml new file mode 100644 index 00000000..25efbcfd --- /dev/null +++ b/tests/test_runner/run_test.ml @@ -0,0 +1,290 @@ +(* Convenience functions *) +let map_while (f : 'a -> 'b option) (input : 'a list) : 'b list = + let _, result = + List.fold_left + (fun (continue, out) a -> + if continue then + match f a with None -> (false, out) | Some b -> (true, b :: out) + else (continue, out)) + (true, []) input + in + List.rev result + +(* Paths to use for tests *) +type runner_env = { + charon_path : string; + aeneas_path : string; + llbc_dir : string; +} + +module Backend = struct + type t = Coq | Lean | FStar | HOL4 [@@deriving ord, sexp] + + (* TODO: reactivate HOL4 once traits are parameterized by their associated types *) + let all = [ Coq; Lean; FStar ] + + let of_string = function + | "coq" -> Coq + | "lean" -> Lean + | "fstar" -> FStar + | "hol4" -> HOL4 + | backend -> failwith ("Unknown backend: `" ^ backend ^ "`") + + let to_string = function + | Coq -> "coq" + | Lean -> "lean" + | FStar -> "fstar" + | HOL4 -> "hol4" +end + +module BackendMap = Map.Make (Backend) + +let concat_path = List.fold_left Filename.concat "" + +let run_command args = + (* Debug arguments *) + print_string "[test_runner] Running: "; + Array.iter + (fun x -> + print_string x; + print_string " ") + args; + print_endline ""; + + (* Run the command *) + let pid = + Unix.create_process args.(0) args Unix.stdin Unix.stdout Unix.stderr + in + let _ = Unix.waitpid [] pid in + () + +(* File-specific options *) +let aeneas_options_for_test backend test_name = + if test_name = "betree" then + let options = + [ + "-backward-no-state-update"; + "-test-trans-units"; + "-state"; + "-split-files"; + ] + in + let extra_options = + match backend with + | Backend.Coq -> [ "-use-fuel" ] + | Backend.FStar -> [ "-decreases-clauses"; "-template-clauses" ] + | _ -> [] + in + List.append extra_options options + else [] + +(* File-specific options *) +let charon_options_for_test test_name = + match test_name with + | "betree" -> + [ "--polonius"; "--opaque=betree_utils"; "--crate"; "betree_main" ] + | _ -> [] + +(* The subdirectory in which to store the outputs. *) +(* This reproduces the file layout that was set by the old Makefile. FIXME: cleanup *) +let test_subdir backend test_name = + let backend = Backend.to_string backend in + match (backend, test_name) with + | "lean", "demo" -> "Demo" + | "lean", _ -> "." + | _, ("arrays" | "demo" | "hashmap" | "traits") -> test_name + | _, "betree" -> "betree" + | _, "hashmap_main" -> "hashmap_on_disk" + | "hol4", _ -> "misc-" ^ test_name + | ( _, + ( "bitwise" | "constants" | "external" | "loops" | "no_nested_borrows" + | "paper" | "polonius_list" ) ) -> + "misc" + | _ -> test_name + +(* The data for a specific test input *) +module Input = struct + type kind = SingleFile | Crate + type action = Normal | Skip | KnownFailure + + type t = { + name : string; + path : string; + kind : kind; + action : action; + charon_options : string list; + aeneas_options : string list BackendMap.t; + subdir : string BackendMap.t; + } + + (* Parse lines that start `//@`. Each of them modifies the options we use for the test. + Supported comments: + - `skip`: don't process the file; + - `known-failure`: TODO; + - `charon-args=...`: extra arguments to pass to charon; + - `aeneas-args=...`: extra arguments to pass to aeneas; + - `[backend,..]...`: where each `backend` is the name of a backend supported by + aeneas; this sets options for these backends only. Only supported for `aeneas-args`. + *) + let apply_special_comment comment input = + let comment = String.trim comment in + (* Parse the backends if any *) + let re = Re.compile (Re.Pcre.re "^\\[([a-zA-Z,]+)\\](.*)$") in + let comment, (backends : Backend.t list) = + match Re.exec_opt re comment with + | Some groups -> + let backends = Re.Group.get groups 1 in + let backends = String.split_on_char ',' backends in + let backends = List.map Backend.of_string backends in + let rest = Re.Group.get groups 2 in + (String.trim rest, backends) + | None -> (comment, Backend.all) + in + (* Parse the other options *) + let charon_args = Core.String.chop_prefix comment ~prefix:"charon-args=" in + let aeneas_args = Core.String.chop_prefix comment ~prefix:"aeneas-args=" in + + if comment = "skip" then { input with action = Skip } + else if comment = "known-failure" then { input with action = KnownFailure } + else if Option.is_some charon_args then + let args = Option.get charon_args in + let args = String.split_on_char ' ' args in + { input with charon_options = List.append input.charon_options args } + else if Option.is_some aeneas_args then + let args = Option.get aeneas_args in + let args = String.split_on_char ' ' args in + let add_args opts = List.append opts args in + { + input with + aeneas_options = + List.fold_left + (fun map backend -> + BackendMap.update backend (Option.map add_args) map) + input.aeneas_options backends; + } + else failwith ("Unrecognized special comment: `" ^ comment ^ "`") + + (* Given a path to a rust file or crate, gather the details and options about how to build the test. *) + let build (path : string) : t = + let name = Filename.remove_extension (Filename.basename path) in + let kind = + if Sys_unix.is_file_exn path then SingleFile + else if Sys_unix.is_directory_exn path then Crate + else failwith ("`" ^ path ^ "` is not a file or a directory.") + in + let action = Normal in + let charon_options = charon_options_for_test name in + let subdir = + List.fold_left + (fun map backend -> + let subdir = test_subdir backend name in + BackendMap.add backend subdir map) + BackendMap.empty Backend.all + in + let aeneas_options = + List.fold_left + (fun map backend -> + let opts = aeneas_options_for_test backend name in + BackendMap.add backend opts map) + BackendMap.empty Backend.all + in + let input = + { path; name; kind; action; charon_options; subdir; aeneas_options } + in + match kind with + | SingleFile -> + let file_lines = Core.In_channel.read_lines path in + (* Extract the special lines. Stop at the first non-special line. *) + let special_comments = + map_while + (fun line -> Core.String.chop_prefix line ~prefix:"//@") + file_lines + in + (* Apply the changes from the special lines to our input. *) + List.fold_left + (fun input comment -> apply_special_comment comment input) + input special_comments + | Crate -> input +end + +(* Run Aeneas on a specific input with the given options *) +let run_aeneas (env : runner_env) (case : Input.t) (backend : Backend.t) = + (* FIXME: remove this special case *) + let test_name = if case.name = "betree" then "betree_main" else case.name in + let input_file = concat_path [ env.llbc_dir; test_name ] ^ ".llbc" in + let subdir = BackendMap.find backend case.subdir in + let aeneas_options = BackendMap.find backend case.aeneas_options in + let backend_str = Backend.to_string backend in + let dest_dir = concat_path [ "tests"; backend_str; subdir ] in + let args = + [| + env.aeneas_path; input_file; "-dest"; dest_dir; "-backend"; backend_str; + |] + in + let args = Array.append args (Array.of_list aeneas_options) in + (* Run Aeneas *) + run_command args + +(* Run Charon on a specific input with the given options *) +let run_charon (env : runner_env) (case : Input.t) = + match case.kind with + | SingleFile -> + let args = + [| + env.charon_path; + "--no-cargo"; + "--input"; + case.path; + "--crate"; + case.name; + "--dest"; + env.llbc_dir; + |] + in + let args = Array.append args (Array.of_list case.charon_options) in + (* Run Charon on the rust file *) + run_command args + | Crate -> ( + match Sys.getenv_opt "IN_CI" with + | None -> + let args = [| env.charon_path; "--dest"; env.llbc_dir |] in + let args = Array.append args (Array.of_list case.charon_options) in + (* Run Charon inside the crate *) + let old_pwd = Unix.getcwd () in + Unix.chdir case.path; + run_command args; + Unix.chdir old_pwd + | Some _ -> + (* Crates with dependencies must be generated separately in CI. We skip + here and trust that CI takes care to generate the necessary llbc + file. *) + print_endline + "Warn: IN_CI is set; we skip generating llbc files for whole crates" + ) + +let () = + match Array.to_list Sys.argv with + (* Ad-hoc argument passing for now. *) + | _exe_path :: charon_path :: aeneas_path :: llbc_dir :: test_path + :: aeneas_options -> ( + let runner_env = { charon_path; aeneas_path; llbc_dir } in + let test_case = Input.build test_path in + let test_case = + { + test_case with + aeneas_options = + BackendMap.map (List.append aeneas_options) test_case.aeneas_options; + } + in + + match test_case.action with + | Skip -> () + | Normal -> + (* Generate the llbc file *) + run_charon runner_env test_case; + (* Process the llbc file for the each backend *) + List.iter + (fun backend -> run_aeneas runner_env test_case backend) + Backend.all + | KnownFailure -> failwith "KnownFailure is unimplemented") + | _ -> failwith "Incorrect options passed to test runner" |