diff --git a/.github/workflows/README.md b/.github/workflows/README.md index 929cf121d92..6d458b143a9 100644 --- a/.github/workflows/README.md +++ b/.github/workflows/README.md @@ -141,11 +141,11 @@ Runs Lean verification for the repository, with each package checked in an isola All five packages (consensus, common, consistency, disaster-recovery, and kv) run in one matrix. Package checks use the `gha-vmss-d16av7-ci` pool and trace replays use `gha-vmss-d16av7-ci-b`, both in Ubuntu 26.04 containers. Native trace captures remain on `gha-vmss-d16av7-ci-c` with Azure Linux containers, and the lightweight final gate uses GitHub-hosted Ubuntu. -Each matrix job caches its third-party dependency checkouts and build outputs, including Mathlib and (where used) leanfmt, using GitHub Actions caching. +Each matrix job caches its third-party dependency checkouts and build outputs, leanfmt and (for disaster-recovery and kv) Batteries, using GitHub Actions caching. Caches are isolated by package and runner architecture and invalidated by changes to the Ubuntu version, Lean toolchain, package and common dependency manifests/configuration, or reusable workflow. -CCF package and common build outputs are not cached, and all verification steps still run, including Mathlib's upstream cache retrieval. +CCF package and common build outputs are not cached, and all verification steps still run. CCF consensus, KV, and consistency trace captures run in parallel with package checks. -Three independent trace-validation jobs each restore Mathlib caches, build their own replayer, download the corresponding capture artifacts, and replay the traces without depending on the package matrix. +Three independent trace-validation jobs each build their own replayer, download the corresponding capture artifacts, and replay the traces without depending on the package matrix. Consistency capture reuses the existing `consistency_trace_validation` e2e test, and its replay job also checks the consistency replay fixtures, including election and rollback traces. A final summary job requires every package and trace job to succeed. @@ -175,12 +175,23 @@ The KV package job checks `lean/kv/replayer/check-fixtures.sh` against the KV fi The dedicated replay job builds `kv-replay` separately to validate the captured traces; no replay executables are transferred between jobs. After the build, `scripts/lean-format-checks.sh` checks every tracked `.lean` file with the pinned leanfmt dependency. -The workflow runs on pull requests that change `lean/`, any `.lean` file, the formatter script, or the workflow. +The workflow runs on pull requests that change `lean/` (except `lean/mathlib-equivalence/`), any `.lean` file, the formatter script, or the workflow. It also runs on changes to the C++ sources and trace runners checked against the CCF consensus and KV models: `src/consensus/aft/`, the CCF consensus scenario tests, `src/kv/`, the public KV and transaction headers, and the KV trace runner. See the [local formatting commands](../../lean/disaster-recovery/README.md#formatting) to apply fixes. File: `lean.yml` -3rd party dependencies: Mathlib and leanfmt (pinned in the Lake package), and elan. +3rd party dependencies: leanfmt and Batteries (pinned in the Lake packages), and elan. + +# Lean Mathlib equivalence + +Proves that the local replacements for Mathlib definitions in `lean/common` (`CCF.Seq`, `CCF.Finset` and `CCF.Function`) and the consensus successor ranking are equivalent to the Mathlib definitions they replaced. +The proofs live in the separate `lean/mathlib-equivalence` package, which is the only Lean package that depends on Mathlib; the main Lean workflow does not schedule it. +The job restores Mathlib's upstream build cache, runs `lake check --inadvisably-no-sandbox` to build the proofs and replay them through the kernel with only the standard axioms, and checks the package's formatting. +It caches third-party dependency checkouts and build outputs like the main Lean package jobs. +The workflow runs only on pull requests that change the replacement definitions, the equivalence package, the Lean toolchain, the formatter script, or the workflow, and can be run manually. + +File: `lean-mathlib-equivalence.yml` +3rd party dependencies: Mathlib (pinned in the Lake package), leanfmt and elan. # Vendored Dependency Verification diff --git a/.github/workflows/lean-mathlib-equivalence.yml b/.github/workflows/lean-mathlib-equivalence.yml new file mode 100644 index 00000000000..39d9ccf9429 --- /dev/null +++ b/.github/workflows/lean-mathlib-equivalence.yml @@ -0,0 +1,76 @@ +name: "Lean Mathlib equivalence" + +# Proves that the local replacements for Mathlib definitions are equivalent to +# Mathlib's, so this only runs when those definitions or the proofs change. +on: + pull_request: + paths: + - "lean/common/CCF/Finset.lean" + - "lean/common/CCF/Function.lean" + - "lean/common/CCF/Seq.lean" + - "lean/consensus/Consensus/Model/Node.lean" + - "lean/mathlib-equivalence/**" + - "lean/lean-toolchain" + - "scripts/lean-format-checks.sh" + - ".github/workflows/lean-mathlib-equivalence.yml" + workflow_dispatch: + +concurrency: + group: ${{ github.workflow }}-${{ github.ref }} + cancel-in-progress: true + +permissions: + contents: read + +jobs: + equivalence: + name: Prove equivalence with Mathlib + runs-on: [gha-vmss-d16av7-ci] + container: + image: ubuntu:26.04 + options: --user root + timeout-minutes: 90 + defaults: + run: + shell: bash + + steps: + - name: Install container prerequisites + run: | + set -euo pipefail + apt-get update + DEBIAN_FRONTEND=noninteractive apt-get install -y \ + ca-certificates git curl tar zstd build-essential libgmp-dev elan + echo "ELAN_HOME=$RUNNER_TEMP/elan" >> "$GITHUB_ENV" + + - uses: actions/checkout@3d3c42e5aac5ba805825da76410c181273ba90b1 # v7.0.1 + + - name: Install Lean + run: | + set -euo pipefail + git config --global --add safe.directory "$GITHUB_WORKSPACE" + echo "TMPDIR=$RUNNER_TEMP" >> "$GITHUB_ENV" + elan run --install "$(cat lean/lean-toolchain)" lean --version + + - name: Restore dependency builds + uses: actions/cache@55cc8345863c7cc4c66a329aec7e433d2d1c52a9 # v6.1.0 + with: + path: lean/mathlib-equivalence/.lake/packages + key: lean-deps-v2-vmss-ubuntu-26.04-${{ runner.arch }}-mathlib-equivalence-${{ hashFiles('lean/lean-toolchain', 'lean/mathlib-equivalence/lake-manifest.json', 'lean/mathlib-equivalence/lakefile.toml', 'lean/common/lake-manifest.json', 'lean/common/lakefile.toml', 'lean/consensus/lake-manifest.json', 'lean/consensus/lakefile.toml', '.github/workflows/lean-mathlib-equivalence.yml') }} + + - name: Restore Mathlib cache + working-directory: lean/mathlib-equivalence + run: | + set -euo pipefail + lake exe cache get + + - name: Build, kernel and axiom check + working-directory: lean/mathlib-equivalence + run: | + set -euo pipefail + lake check --inadvisably-no-sandbox + + - name: Check formatting + run: | + set -euo pipefail + ./scripts/lean-format-checks.sh mathlib-equivalence diff --git a/.github/workflows/lean-package.yml b/.github/workflows/lean-package.yml index bca41d6bcd5..35e0c08fa49 100644 --- a/.github/workflows/lean-package.yml +++ b/.github/workflows/lean-package.yml @@ -62,12 +62,6 @@ jobs: path: lean/${{ inputs.package }}/.lake/packages key: lean-deps-v2-vmss-ubuntu-26.04-${{ runner.arch }}-${{ inputs.package }}-${{ hashFiles('lean/lean-toolchain', format('lean/{0}/lake-manifest.json', inputs.package), format('lean/{0}/lakefile.toml', inputs.package), 'lean/common/lake-manifest.json', 'lean/common/lakefile.toml', '.github/workflows/lean-package.yml') }} - - name: Restore Mathlib cache - working-directory: lean/${{ inputs.package }} - run: | - set -euo pipefail - lake exe cache get - - name: Build, kernel and axiom check working-directory: lean/${{ inputs.package }} run: | diff --git a/.github/workflows/lean.yml b/.github/workflows/lean.yml index 350340e4284..a093af0ef44 100644 --- a/.github/workflows/lean.yml +++ b/.github/workflows/lean.yml @@ -20,6 +20,8 @@ on: - "CMakeLists.txt" - ".github/workflows/lean.yml" - ".github/workflows/lean-package.yml" + # Checked by lean-mathlib-equivalence.yml. + - "!lean/mathlib-equivalence/**" workflow_dispatch: concurrency: @@ -240,12 +242,6 @@ jobs: git config --global --add safe.directory "$GITHUB_WORKSPACE" elan run --install "$(cat lean/lean-toolchain)" lean --version - - name: Restore Mathlib cache - working-directory: lean/consensus - run: | - set -euo pipefail - lake exe cache get - - name: Build CCF consensus replay working-directory: lean/consensus run: | @@ -323,7 +319,9 @@ jobs: import pathlib expected = {"consensus", "common", "consistency", "disaster-recovery", "kv"} - actual = {config.parent.name for config in pathlib.Path("lean").glob("*/lakefile.toml")} + # Checked by lean-mathlib-equivalence.yml. + separate = {"mathlib-equivalence"} + actual = {config.parent.name for config in pathlib.Path("lean").glob("*/lakefile.toml")} - separate if actual != expected: raise SystemExit( f"::error::Lean package inventory changed: expected {sorted(expected)}, got {sorted(actual)}; " @@ -362,12 +360,6 @@ jobs: git config --global --add safe.directory "$GITHUB_WORKSPACE" elan run --install "$(cat lean/lean-toolchain)" lean --version - - name: Restore Mathlib cache - working-directory: lean/kv - run: | - set -euo pipefail - lake exe cache get - - name: Build KV replay working-directory: lean/kv run: | @@ -421,12 +413,6 @@ jobs: git config --global --add safe.directory "$GITHUB_WORKSPACE" elan run --install "$(cat lean/lean-toolchain)" lean --version - - name: Restore Mathlib cache - working-directory: lean/consistency - run: | - set -euo pipefail - lake exe cache get - - name: Build consistency replay working-directory: lean/consistency run: | diff --git a/doc/architecture/verification.rst b/doc/architecture/verification.rst index 0b4a7579b60..9007c6218cf 100644 --- a/doc/architecture/verification.rst +++ b/doc/architecture/verification.rst @@ -84,6 +84,8 @@ The :ccf_repo:`Lean workflow <.github/workflows/lean.yml>` runs on pull requests The disaster recovery traces are replayed by the SNP Genoa job in the main CI workflow instead, since that is where the recovery scenarios run. +A separate ``Lean Mathlib equivalence`` workflow proves that the replacements for Mathlib definitions in ``lean/common`` are equivalent to the Mathlib originals, and runs only when those definitions change; see :ccf_repo:`lean/mathlib-equivalence/README.md`. + Running locally --------------- @@ -93,7 +95,6 @@ From a package directory under ``lean/``, the common checks are: .. code-block:: bash - lake exe cache get lake build --wfail --fail-fast lake check --inadvisably-no-sandbox lake exe check-imports diff --git a/doc/build_apps/kv/semantics.rst b/doc/build_apps/kv/semantics.rst index b428338d917..d25c79a4e64 100644 --- a/doc/build_apps/kv/semantics.rst +++ b/doc/build_apps/kv/semantics.rst @@ -221,7 +221,6 @@ Lean is pinned by ``lean/kv/lean-toolchain`` and is independent of normal CCF bu .. code-block:: bash cd lean/kv - lake exe cache get lake build --wfail cd ../.. cmake -S . -B build-kv-trace -GNinja \ diff --git a/lean/AGENT.md b/lean/AGENT.md index 642cb8795e3..8cd35baaead 100644 --- a/lean/AGENT.md +++ b/lean/AGENT.md @@ -35,7 +35,8 @@ Within a model's library directory, use this layout: `Properties.lean` publicly imports the types and helpers needed to understand its statements and privately imports proof implementations. Write the full logical statement in each public safety theorem and existential witness lemma, rather than defining a separate named proposition. -Use the `theorem` declaration keyword for public safety claims and `lemma` for their existential `_witness` declarations, including the witness implementations under `Proofs/`. +Declare public safety claims and their existential witnesses with the `theorem` keyword, since Lean core has no `lemma` command. +Name each witness after its safety theorem with a `_witness` suffix, including the witness implementations under `Proofs/`. Keep each proof body a one-line `by exact Proofs.` reference, and place each witness lemma next to its corresponding safety theorem. For example: diff --git a/lean/common/CCF.lean b/lean/common/CCF.lean index 42564752fac..d204739cfc8 100644 --- a/lean/common/CCF.lean +++ b/lean/common/CCF.lean @@ -3,6 +3,11 @@ module -- shake: keep-all --deprecated_module: ignore public import CCF.Architecture public import CCF.Capabilities public import CCF.Execution +public import CCF.Finset +public import CCF.Function public import CCF.MultiNodeTransitionSystem public import CCF.Parsec +public import CCF.Proofs.Execution +public import CCF.Proofs.Finset +public import CCF.Seq public import CCF.TransitionSystem diff --git a/lean/common/CCF/Architecture.lean b/lean/common/CCF/Architecture.lean index 90467cdefb2..7acdc4a0a4d 100644 --- a/lean/common/CCF/Architecture.lean +++ b/lean/common/CCF/Architecture.lean @@ -8,6 +8,15 @@ namespace CCF.Architecture open Lean +/-- Check an import against the layers of the shared `CCF` modules: only the `CCF` entrypoint +and other `CCF.Proofs` modules can import `CCF.Proofs`. -/ +def allowedCommonImport (owner dependency : Name) : Bool := + let proofs := `CCF.Proofs + !(`CCF).isPrefixOf owner + || owner == `CCF + || proofs.isPrefixOf owner + || !proofs.isPrefixOf dependency + /-- Check an import against the standard layers of the specification rooted at `root`. -/ def allowedImport (root owner dependency : Name) : Bool := let model := root ++ `Model @@ -16,7 +25,9 @@ def allowedImport (root owner dependency : Name) : Bool := if (`CCF).isPrefixOf owner then !root.isPrefixOf dependency else if !root.isPrefixOf dependency then - true + -- The `CCF` entrypoint reexports `CCF.Proofs`, so models must import definitions directly. + !(model.isPrefixOf owner + && ((`CCF.Proofs).isPrefixOf dependency || dependency == `CCF)) else if model.isPrefixOf owner then model.isPrefixOf dependency && (owner == model || dependency != model) else if owner == properties then @@ -33,12 +44,14 @@ def allowedImport (root owner dependency : Name) : Bool := else true -/-- Reject forbidden imports in an environment, including private transitive imports. -/ +/-- Reject forbidden imports in an environment, including private transitive imports. The +shared `CCF` root is checked only against the common layers. -/ def checkImports (root : Name) (environment : Environment) : Except String Unit := do let header := environment.header for (owner, data) in header.moduleNames.zip header.moduleData do for dependency in data.imports do - unless allowedImport root owner dependency.module do + unless allowedCommonImport owner dependency.module + && (root == `CCF || allowedImport root owner dependency.module) do throw s!"Forbidden layer dependency: {owner} imports {dependency.module}" end CCF.Architecture diff --git a/lean/common/CCF/Execution.lean b/lean/common/CCF/Execution.lean index 7dbe92ec9ef..f06bc7ed86e 100644 --- a/lean/common/CCF/Execution.lean +++ b/lean/common/CCF/Execution.lean @@ -1,10 +1,7 @@ module public import CCF.TransitionSystem -public import Mathlib.Data.Seq.Defs - -import Mathlib.Data.Seq.Basic -import Std.Tactic.BVDecide.Normalize.Prop +public import CCF.Seq @[expose] public section @@ -14,6 +11,7 @@ namespace CCF.Execution Executions of a `TransitionSystem`. `Run` relates a start state, a finite action list, and an end state. `Trace` records an initial state and a finite or infinite sequence of actions paired with their successor states, with a validity proof. +Theorems about executions are in `CCF.Proofs.Execution`. -/ /-- `Run system start actions final`: executing `actions` from `start` reaches `final`. -/ @@ -33,13 +31,13 @@ structure TraceImpl (system : TransitionSystem) where /-- The initial state. -/ init : system.State /-- Each action is paired with the state it reaches. -/ - steps : Stream'.Seq (system.Action × system.State) + steps : CCF.Seq (system.Action × system.State) /-- The initial state is allowed and each recorded action reaches its paired state. -/ def TraceImpl.Valid {system : TransitionSystem} (trace : TraceImpl system) : Prop := system.init trace.init /\ forall n before action, - (Stream'.Seq.cons trace.init (trace.steps.map Prod.snd)).get? n = some before + (CCF.Seq.cons trace.init (trace.steps.map Prod.snd)).get? n = some before -> (trace.steps.map Prod.fst).get? n = some action -> system.step before action = (trace.steps.map Prod.snd).get? n @@ -50,13 +48,11 @@ abbrev Trace (system : TransitionSystem) := namespace Trace /-- The visited states, initial state first. -/ -def states {system : TransitionSystem} (trace : Trace system) - : Stream'.Seq system.State := - Stream'.Seq.cons trace.val.init (trace.val.steps.map Prod.snd) +def states {system : TransitionSystem} (trace : Trace system) : CCF.Seq system.State := + CCF.Seq.cons trace.val.init (trace.val.steps.map Prod.snd) /-- The actions recorded by the execution. -/ -def actions {system : TransitionSystem} (trace : Trace system) - : Stream'.Seq system.Action := +def actions {system : TransitionSystem} (trace : Trace system) : CCF.Seq system.Action := trace.val.steps.map Prod.fst /-- The state at an index, or `none` beyond a finite trace. -/ @@ -71,135 +67,9 @@ def actionAt {system : TransitionSystem} (trace : Trace system) (n : Nat) : Option system.Action := trace.actions.get? n -/-- The first state exists and is initial. -/ -theorem valid_init {system : TransitionSystem} (trace : Trace system) - : exists initial, trace.stateAt 0 = some initial /\ system.init initial := - ⟨trace.val.init, Stream'.Seq.get?_cons_zero _ _, trace.property.1⟩ - -/-- Each recorded action executes the corresponding transition. -/ -theorem valid_step {system : TransitionSystem} (trace : Trace system) - (n : Nat) (before : system.State) (action : system.Action) - (first : trace.stateAt n = some before) (chosen : trace.actionAt n = some action) - : system.step before action = trace.stateAt (n + 1) := - trace.property.2 n before action first chosen - -/-- Actions exist exactly where a successor state exists, by construction. -/ -theorem valid_domains {system : TransitionSystem} (trace : Trace system) (n : Nat) - : (trace.actions.get? n).isSome <-> (trace.states.get? (n + 1)).isSome := by - simp [actions, states] - instance {system : TransitionSystem} : Membership system.State (Trace system) := ⟨fun trace state => state ∈ trace.states⟩ -/-- State membership is membership in the recorded state sequence. -/ -@[simp] -theorem mem_states {system : TransitionSystem} {trace : Trace system} - {state : system.State} - : state ∈ trace.states <-> state ∈ trace := - Iff.rfl - -/-- A trace state is present at some index. -/ -theorem mem_iff_exists_stateAt {system : TransitionSystem} {trace : Trace system} - {state : system.State} - : state ∈ trace <-> exists n, some state = trace.stateAt n := - Stream'.Seq.mem_iff_exists_get? - -/-- A state found at an index belongs to the trace. -/ -theorem stateAt_mem {system : TransitionSystem} {trace : Trace system} - {n : Nat} {state : system.State} (found : trace.stateAt n = some state) - : state ∈ trace := - Stream'.Seq.get?_mem found - -/-- Adjacent states are connected by the action recorded at their shared step. -/ -theorem step {system : TransitionSystem} (trace : Trace system) (n : Nat) - (before after : system.State) - (first : trace.stateAt n = some before) (next : trace.stateAt (n + 1) = some after) - : exists action, system.step before action = some after := by - have present : (trace.actions.get? n).isSome := (trace.valid_domains n).mpr - (by change (trace.stateAt (n + 1)).isSome; rw [next]; rfl) - obtain ⟨action, found⟩ := Option.isSome_iff_exists.mp present - exact ⟨action, (trace.valid_step n before action first found).trans next⟩ - -/-- Every state in a trace is reachable. -/ -theorem reachable {system : TransitionSystem} (trace : Trace system) - {state : system.State} (member : state ∈ trace) - : system.Reachable state := by - obtain ⟨index, found⟩ := mem_iff_exists_stateAt.mp member - clear member - induction index generalizing state with - | zero => - obtain ⟨initial, first, initialized⟩ := trace.valid_init - rw [first] at found - cases found - exact .initial initialized - | succ index ih => - cases previous : trace.stateAt index with - | none => - have absent := trace.states.le_stable (Nat.le_succ index) previous - change trace.stateAt (index + 1) = none at absent - rw [absent] at found - cases found - | some before => - obtain ⟨action, stepped⟩ := trace.step index before state previous found.symm - exact .step (ih previous.symm) stepped - end Trace -/-- Valid traces cover exactly the reachable states. Every reachable state is the -last state of some valid finite trace. -/ -theorem reachable_iff_trace {system : TransitionSystem} {state : system.State} - : system.Reachable state <-> exists trace : Trace system, state ∈ trace := by - constructor - · intro reachable - suffices finite : exists (initial : system.State) (steps : List (system.Action × system.State)), - system.init initial - /\ (initial :: steps.map Prod.snd)[steps.length]? = some state - /\ forall i : Fin steps.length, - system.step ((initial :: steps.map Prod.snd)[i.val]'(by simp; omega)) - steps[i.val].1 = some steps[i.val].2 by - obtain ⟨initial, steps, initialized, last, enabled⟩ := finite - have indexed (n : Nat) - : (Stream'.Seq.cons initial ((Stream'.Seq.ofList steps).map Prod.snd)).get? n - = (initial :: steps.map Prod.snd)[n]? := by - cases n <;> simp - refine ⟨⟨{ - init := initial - steps := Stream'.Seq.ofList steps - }, initialized, ?_⟩, ?_⟩ - · intro n before action first chosen - change (steps[n]?).map Prod.fst = some action at chosen - obtain ⟨pair, present, actionEq⟩ := Option.map_eq_some_iff.mp chosen - obtain ⟨bound, pairEq⟩ := List.getElem?_eq_some_iff.mp present - have firstEq : (initial :: steps.map Prod.snd)[n]? = some before := - (indexed n).symm.trans first - obtain ⟨_, beforeEq⟩ := List.getElem?_eq_some_iff.mp firstEq - change system.step before action = (steps[n]?).map Prod.snd - rw [present] - simpa only [← beforeEq, ← actionEq, ← pairEq, Option.map_some] using enabled ⟨n, bound⟩ - · apply Trace.stateAt_mem (n := steps.length) - exact (indexed steps.length).trans last - induction reachable with - | initial initialized => - exact ⟨_, [], initialized, rfl, fun i => Fin.elim0 i⟩ - | @step before after action _ step ih => - obtain ⟨initial, steps, initialized, last, enabled⟩ := ih - refine ⟨initial, steps ++ [(action, after)], initialized, ?_, ?_⟩ - · simp [List.map_append] - · intro ⟨index, bounded⟩ - simp only [List.map_append, List.map_cons, List.map_nil] - simp only [← List.cons_append] - by_cases inside : index < steps.length - · rw [List.getElem_append_left - (as := initial :: steps.map Prod.snd) (i := index) (by simp; omega), - List.getElem_append_left inside] - exact enabled ⟨index, inside⟩ - · have lastIndex : index = steps.length := by simp at bounded; omega - subst index - have beforeEq := (List.getElem?_eq_some_iff.mp last).2 - rw [List.getElem_append_left - (as := initial :: steps.map Prod.snd) (i := steps.length) (by simp)] - simpa [← beforeEq] using step - · rintro ⟨trace, member⟩ - exact trace.reachable member - end CCF.Execution diff --git a/lean/common/CCF/Finset.lean b/lean/common/CCF/Finset.lean new file mode 100644 index 00000000000..dcc085d3153 --- /dev/null +++ b/lean/common/CCF/Finset.lean @@ -0,0 +1,179 @@ +module + +@[expose] public section + +namespace CCF + +/-! +Finite sets, covering the part of Mathlib's `Finset` that the models use. + +A set is stored as a strictly increasing list. Equal sets therefore have equal +representations, so equality is decidable, `Finset.ext` holds, and the kernel +can evaluate set operations on concrete values by reducing list functions. + +This module holds the definitions and the sortedness proofs they carry; lemmas +about them are in `CCF.Proofs.Finset`. +-/ + +/-- A strict total order, enough to store finite sets as sorted lists. -/ +class StrictTotalOrder (α : Type) [LT α] : Prop where + /-- No element is below itself. -/ + lt_irrefl : forall a : α, Not (a < a) + /-- The order is transitive. -/ + lt_trans : forall {a b c : α}, a < b -> b < c -> a < c + /-- Any two elements are ordered or equal. -/ + lt_trichotomy : forall a b : α, a < b \/ a = b \/ b < a + +instance : StrictTotalOrder Nat := + ⟨Nat.lt_irrefl, Nat.lt_trans, Nat.lt_trichotomy⟩ + +/-- A finite set of elements, stored in increasing order without duplicates. -/ +structure Finset (α : Type) [LT α] where + /-- The elements in increasing order. -/ + val : List α + /-- The elements are strictly increasing. -/ + sorted : val.Pairwise (· < ·) + +namespace Finset + +variable {α : Type} [LT α] + +instance : Membership α (Finset α) := + ⟨fun s a => a ∈ s.val⟩ + +instance decidableMem [DecidableEq α] (a : α) (s : Finset α) : Decidable (a ∈ s) := + inferInstanceAs (Decidable (a ∈ s.val)) + +instance [DecidableEq α] : DecidableEq (Finset α) + | ⟨l₁, _⟩, ⟨l₂, _⟩ => + if same : l₁ = l₂ then + isTrue (by subst same; rfl) + else + isFalse fun equal => same (congrArg Finset.val equal) + +instance : EmptyCollection (Finset α) := + ⟨⟨[], .nil⟩⟩ + +instance : Singleton α (Finset α) := + ⟨fun a => ⟨[a], List.pairwise_singleton _ a⟩⟩ + +/-- Insert into a strictly increasing list, keeping it strictly increasing. -/ +def insertSorted [DecidableLT α] (a : α) : List α -> List α + | [] => [a] + | x :: xs => + if a < x then + a :: x :: xs + else if x < a then + x :: insertSorted a xs + else + x :: xs + +theorem mem_insertSorted [DecidableLT α] [StrictTotalOrder α] {a b : α} + : forall {l : List α}, b ∈ insertSorted a l <-> b = a \/ b ∈ l + | [] => by simp [insertSorted] + | x :: xs => by + unfold insertSorted + by_cases ax : a < x + · simp [ax] + by_cases xa : x < a + · simp only [ax, xa, ite_false, ite_true, List.mem_cons, mem_insertSorted] + constructor + · rintro (bx | ba | inXs) + · exact Or.inr (Or.inl bx) + · exact Or.inl ba + · exact Or.inr (Or.inr inXs) + · rintro (ba | bx | inXs) + · exact Or.inr (Or.inl ba) + · exact Or.inl bx + · exact Or.inr (Or.inr inXs) + have same : a = x := by + rcases StrictTotalOrder.lt_trichotomy a x with lt | eq | gt + · exact absurd lt ax + · exact eq + · exact absurd gt xa + subst same + simp [ax] + +theorem sorted_insertSorted [DecidableLT α] [StrictTotalOrder α] (a : α) + : forall {l : List α}, l.Pairwise (· < ·) -> (insertSorted a l).Pairwise (· < ·) + | [], _ => List.pairwise_singleton _ a + | x :: xs, sorted => by + unfold insertSorted + by_cases ax : a < x + · simp only [ax, ite_true] + refine List.Pairwise.cons (fun y member => ?_) sorted + rcases List.mem_cons.mp member with same | inXs + · exact same ▸ ax + · exact StrictTotalOrder.lt_trans ax ((List.pairwise_cons.mp sorted).1 y inXs) + by_cases xa : x < a + · simp only [ax, xa, ite_true, ite_false] + have tail := List.pairwise_cons.mp sorted + refine List.Pairwise.cons (fun y member => ?_) (sorted_insertSorted a tail.2) + rcases mem_insertSorted.mp member with same | inXs + · exact same ▸ xa + · exact tail.1 y inXs + · simpa only [ax, xa, ite_false] using sorted + +instance [DecidableLT α] [StrictTotalOrder α] : Insert α (Finset α) := + ⟨fun a s => ⟨insertSorted a s.val, sorted_insertSorted a s.sorted⟩⟩ + +/-- The elements satisfying a predicate. -/ +def filter (p : α -> Prop) [DecidablePred p] (s : Finset α) : Finset α := + ⟨s.val.filter fun a => decide (p a), s.sorted.filter _⟩ + +/-- Remove an element. -/ +def erase [DecidableEq α] (s : Finset α) (a : α) : Finset α := + s.filter (· ≠ a) + +/-- Every element of either set; inserts the right set's elements into the left set. -/ +def union [DecidableLT α] [StrictTotalOrder α] (s t : Finset α) : Finset α := + t.val.foldr (fun a acc => insert a acc) s + +instance [DecidableLT α] [StrictTotalOrder α] : Union (Finset α) := + ⟨union⟩ + +instance [DecidableEq α] : Inter (Finset α) := + ⟨fun s t => s.filter (· ∈ t)⟩ + +instance [DecidableEq α] : SDiff (Finset α) := + ⟨fun s t => s.filter (· ∉ t)⟩ + +instance : HasSubset (Finset α) := + ⟨fun s t => forall ⦃a⦄, a ∈ s -> a ∈ t⟩ + +instance [DecidableEq α] (s t : Finset α) : Decidable (s ⊆ t) := + decidable_of_iff (s.val.all fun a => decide (a ∈ t)) + (by simp only [List.all_eq_true, decide_eq_true_eq]; exact Iff.rfl) + +/-- The set contains an element. -/ +def Nonempty (s : Finset α) : Prop := + exists a, a ∈ s + +instance decidableNonempty (s : Finset α) : Decidable s.Nonempty := + match s with + | ⟨[], _⟩ => isFalse fun ⟨_, member⟩ => nomatch member + | ⟨a :: _, _⟩ => isTrue ⟨a, List.mem_cons_self⟩ + +/-- The sets share no element. -/ +def Disjoint (s t : Finset α) : Prop := + forall ⦃a⦄, a ∈ s -> a ∉ t + +/-- The elements in increasing order. -/ +def sort (s : Finset α) : List α := + s.val + +/-- The least element, or `none` for the empty set. -/ +def min? (s : Finset α) : Option α := + s.val.head? + +/-- The number of elements. -/ +def card (s : Finset α) : Nat := + s.val.length + +/-- The set of a list's elements. -/ +def ofList [DecidableLT α] [StrictTotalOrder α] (l : List α) : Finset α := + l.foldr (fun a acc => insert a acc) ∅ + +end Finset + +end CCF diff --git a/lean/common/CCF/Function.lean b/lean/common/CCF/Function.lean new file mode 100644 index 00000000000..601a4f95dd0 --- /dev/null +++ b/lean/common/CCF/Function.lean @@ -0,0 +1,45 @@ +module + +@[expose] public section + +namespace CCF.Function + +/-! +Point updates of functions, covering the part of Mathlib's `Function.update` +that the models use. +-/ + +/-- `f` with the value at `a` replaced by `v`. -/ +def update {α β : Type} [DecidableEq α] (f : α -> β) (a : α) (v : β) : α -> β := + fun x => if x = a then v else f x + +theorem update_apply {α β : Type} [DecidableEq α] (f : α -> β) (a : α) (v : β) (x : α) + : update f a v x = if x = a then v else f x := + rfl + +@[simp] +theorem update_self {α β : Type} [DecidableEq α] (a : α) (v : β) (f : α -> β) + : update f a v a = v := by + simp [update] + +@[simp] +theorem update_of_ne {α β : Type} [DecidableEq α] {a a' : α} (different : a ≠ a') (v : β) + (f : α -> β) + : update f a' v a = f a := by + simp [update, different] + +/-- Writing back a function's own value leaves it unchanged. -/ +@[simp] +theorem update_eq_self {α β : Type} [DecidableEq α] (a : α) (f : α -> β) + : update f a (f a) = f := by + funext x + by_cases same : x = a <;> simp [update, same] + +/-- A second update at the same point overrides the first. -/ +@[simp] +theorem update_idem {α β : Type} [DecidableEq α] (a : α) (v w : β) (f : α -> β) + : update (update f a v) a w = update f a w := by + funext x + by_cases same : x = a <;> simp [update, same] + +end CCF.Function diff --git a/lean/common/CCF/Proofs/Execution.lean b/lean/common/CCF/Proofs/Execution.lean new file mode 100644 index 00000000000..fde50fe7386 --- /dev/null +++ b/lean/common/CCF/Proofs/Execution.lean @@ -0,0 +1,146 @@ +module + +public import CCF.Execution + +import Std.Tactic.BVDecide.Normalize.Prop + +@[expose] public section + +namespace CCF.Execution + +/-! +Theorems about executions: trace states are connected by transitions and reachable, +and valid traces cover exactly the reachable states. +-/ + +namespace Trace + +/-- The first state exists and is initial. -/ +theorem valid_init {system : TransitionSystem} (trace : Trace system) + : exists initial, trace.stateAt 0 = some initial /\ system.init initial := + ⟨trace.val.init, CCF.Seq.get?_cons_zero _ _, trace.property.1⟩ + +/-- Each recorded action executes the corresponding transition. -/ +theorem valid_step {system : TransitionSystem} (trace : Trace system) + (n : Nat) (before : system.State) (action : system.Action) + (first : trace.stateAt n = some before) (chosen : trace.actionAt n = some action) + : system.step before action = trace.stateAt (n + 1) := + trace.property.2 n before action first chosen + +/-- Actions exist exactly where a successor state exists, by construction. -/ +theorem valid_domains {system : TransitionSystem} (trace : Trace system) (n : Nat) + : (trace.actions.get? n).isSome <-> (trace.states.get? (n + 1)).isSome := by + simp [actions, states] + +/-- State membership is membership in the recorded state sequence. -/ +@[simp] +theorem mem_states {system : TransitionSystem} {trace : Trace system} + {state : system.State} + : state ∈ trace.states <-> state ∈ trace := + Iff.rfl + +/-- A trace state is present at some index. -/ +theorem mem_iff_exists_stateAt {system : TransitionSystem} {trace : Trace system} + {state : system.State} + : state ∈ trace <-> exists n, some state = trace.stateAt n := + CCF.Seq.mem_iff_exists_get? + +/-- A state found at an index belongs to the trace. -/ +theorem stateAt_mem {system : TransitionSystem} {trace : Trace system} + {n : Nat} {state : system.State} (found : trace.stateAt n = some state) + : state ∈ trace := + CCF.Seq.get?_mem found + +/-- Adjacent states are connected by the action recorded at their shared step. -/ +theorem step {system : TransitionSystem} (trace : Trace system) (n : Nat) + (before after : system.State) + (first : trace.stateAt n = some before) (next : trace.stateAt (n + 1) = some after) + : exists action, system.step before action = some after := by + have present : (trace.actions.get? n).isSome := (trace.valid_domains n).mpr + (by change (trace.stateAt (n + 1)).isSome; rw [next]; rfl) + obtain ⟨action, found⟩ := Option.isSome_iff_exists.mp present + exact ⟨action, (trace.valid_step n before action first found).trans next⟩ + +/-- Every state in a trace is reachable. -/ +theorem reachable {system : TransitionSystem} (trace : Trace system) + {state : system.State} (member : state ∈ trace) + : system.Reachable state := by + obtain ⟨index, found⟩ := mem_iff_exists_stateAt.mp member + clear member + induction index generalizing state with + | zero => + obtain ⟨initial, first, initialized⟩ := trace.valid_init + rw [first] at found + cases found + exact .initial initialized + | succ index ih => + cases previous : trace.stateAt index with + | none => + have absent := trace.states.le_stable (Nat.le_succ index) previous + change trace.stateAt (index + 1) = none at absent + rw [absent] at found + cases found + | some before => + obtain ⟨action, stepped⟩ := trace.step index before state previous found.symm + exact .step (ih previous.symm) stepped + +end Trace + +/-- Valid traces cover exactly the reachable states. Every reachable state is the +last state of some valid finite trace. -/ +theorem reachable_iff_trace {system : TransitionSystem} {state : system.State} + : system.Reachable state <-> exists trace : Trace system, state ∈ trace := by + constructor + · intro reachable + suffices finite : exists (initial : system.State) (steps : List (system.Action × system.State)), + system.init initial + /\ (initial :: steps.map Prod.snd)[steps.length]? = some state + /\ forall i : Fin steps.length, + system.step ((initial :: steps.map Prod.snd)[i.val]'(by simp; omega)) + steps[i.val].1 = some steps[i.val].2 by + obtain ⟨initial, steps, initialized, last, enabled⟩ := finite + have indexed (n : Nat) + : (CCF.Seq.cons initial ((CCF.Seq.ofList steps).map Prod.snd)).get? n + = (initial :: steps.map Prod.snd)[n]? := by + cases n <;> simp + refine ⟨⟨{ + init := initial + steps := CCF.Seq.ofList steps + }, initialized, ?_⟩, ?_⟩ + · intro n before action first chosen + change (steps[n]?).map Prod.fst = some action at chosen + obtain ⟨pair, present, actionEq⟩ := Option.map_eq_some_iff.mp chosen + obtain ⟨bound, pairEq⟩ := List.getElem?_eq_some_iff.mp present + have firstEq : (initial :: steps.map Prod.snd)[n]? = some before := + (indexed n).symm.trans first + obtain ⟨_, beforeEq⟩ := List.getElem?_eq_some_iff.mp firstEq + change system.step before action = (steps[n]?).map Prod.snd + rw [present] + simpa only [← beforeEq, ← actionEq, ← pairEq, Option.map_some] using enabled ⟨n, bound⟩ + · apply Trace.stateAt_mem (n := steps.length) + exact (indexed steps.length).trans last + induction reachable with + | initial initialized => + exact ⟨_, [], initialized, rfl, fun i => Fin.elim0 i⟩ + | @step before after action _ step ih => + obtain ⟨initial, steps, initialized, last, enabled⟩ := ih + refine ⟨initial, steps ++ [(action, after)], initialized, ?_, ?_⟩ + · simp [List.map_append] + · intro ⟨index, bounded⟩ + simp only [List.map_append, List.map_cons, List.map_nil] + simp only [← List.cons_append] + by_cases inside : index < steps.length + · rw [List.getElem_append_left + (as := initial :: steps.map Prod.snd) (i := index) (by simp; omega), + List.getElem_append_left inside] + exact enabled ⟨index, inside⟩ + · have lastIndex : index = steps.length := by simp at bounded; omega + subst index + have beforeEq := (List.getElem?_eq_some_iff.mp last).2 + rw [List.getElem_append_left + (as := initial :: steps.map Prod.snd) (i := steps.length) (by simp)] + simpa [← beforeEq] using step + · rintro ⟨trace, member⟩ + exact trace.reachable member + +end CCF.Execution diff --git a/lean/common/CCF/Proofs/Finset.lean b/lean/common/CCF/Proofs/Finset.lean new file mode 100644 index 00000000000..77c071fd502 --- /dev/null +++ b/lean/common/CCF/Proofs/Finset.lean @@ -0,0 +1,223 @@ +module + +public import CCF.Finset + +@[expose] public section + +namespace CCF + +/-! Lemmas about the operations on `CCF.Finset`. -/ + +namespace Finset + +/-- Duplicate-free lists with the same members have the same length. -/ +theorem length_eq_of_nodup_of_mem_iff {α : Type} {l₁ l₂ : List α} (nodup₁ : l₁.Nodup) + (nodup₂ : l₂.Nodup) (same : forall a, a ∈ l₁ <-> a ∈ l₂) + : l₁.length = l₂.length := + Nat.le_antisymm (nodup₁.length_le_of_subset fun a => (same a).mp) + (nodup₂.length_le_of_subset fun a => (same a).mpr) + +variable {α : Type} [LT α] + +section Sorted + +variable [StrictTotalOrder α] + +theorem ne_of_lt {a b : α} (lt : a < b) : a ≠ b := by + intro same + subst same + exact StrictTotalOrder.lt_irrefl a lt + +/-- Sorted lists have no duplicates. -/ +theorem nodup_of_sorted {l : List α} (sorted : l.Pairwise (· < ·)) : l.Nodup := + sorted.imp ne_of_lt + +/-- Strictly sorted lists with the same members are equal. -/ +theorem eq_of_sorted_of_mem_iff + : forall {l₁ l₂ : List α}, + l₁.Pairwise (· < ·) + -> l₂.Pairwise (· < ·) + -> (forall a, a ∈ l₁ <-> a ∈ l₂) + -> l₁ = l₂ + | [], [], _, _, _ => rfl + | [], b :: _, _, _, same => nomatch (same b).mpr List.mem_cons_self + | a :: _, [], _, _, same => nomatch (same a).mp List.mem_cons_self + | a :: l₁, b :: l₂, sorted₁, sorted₂, same => by + rw [List.pairwise_cons] at sorted₁ sorted₂ + have head : a = b := by + rcases List.mem_cons.mp ((same a).mp List.mem_cons_self) with ab | inL₂ + · exact ab + rcases List.mem_cons.mp ((same b).mpr List.mem_cons_self) with ba | inL₁ + · exact ba.symm + exact absurd (StrictTotalOrder.lt_trans (sorted₁.1 b inL₁) (sorted₂.1 a inL₂)) + (StrictTotalOrder.lt_irrefl a) + subst head + refine congrArg (a :: ·) (eq_of_sorted_of_mem_iff sorted₁.2 sorted₂.2 fun x => ?_) + constructor + · intro inL₁ + rcases List.mem_cons.mp ((same x).mp (List.mem_cons_of_mem a inL₁)) with xa | inL₂ + · exact absurd (xa ▸ sorted₁.1 x inL₁) (StrictTotalOrder.lt_irrefl x) + · exact inL₂ + · intro inL₂ + rcases List.mem_cons.mp ((same x).mpr (List.mem_cons_of_mem a inL₂)) with xa | inL₁ + · exact absurd (xa ▸ sorted₂.1 x inL₂) (StrictTotalOrder.lt_irrefl x) + · exact inL₁ + +end Sorted + +theorem mem_def {a : α} {s : Finset α} : a ∈ s <-> a ∈ s.val := + Iff.rfl + +@[ext] +theorem ext [StrictTotalOrder α] {s t : Finset α} (same : forall a, a ∈ s <-> a ∈ t) + : s = t := by + obtain ⟨l₁, sorted₁⟩ := s + obtain ⟨l₂, sorted₂⟩ := t + cases eq_of_sorted_of_mem_iff sorted₁ sorted₂ same + rfl + +@[simp] +theorem notMem_empty (a : α) : a ∉ (∅ : Finset α) := + List.not_mem_nil + +@[simp] +theorem mem_singleton {a b : α} : b ∈ ({a} : Finset α) <-> b = a := + List.mem_singleton + +@[simp] +theorem mem_insert [DecidableLT α] [StrictTotalOrder α] {a b : α} {s : Finset α} + : b ∈ insert a s <-> b = a \/ b ∈ s := + mem_insertSorted + +@[simp] +theorem mem_filter {p : α -> Prop} [DecidablePred p] {s : Finset α} {a : α} + : a ∈ s.filter p <-> a ∈ s /\ p a := by + simp [filter, mem_def] + +@[simp] +theorem mem_erase [DecidableEq α] {a b : α} {s : Finset α} + : a ∈ s.erase b <-> a ≠ b /\ a ∈ s := by + simp [erase, And.comm] + +@[simp] +theorem mem_union [DecidableLT α] [StrictTotalOrder α] {a : α} {s t : Finset α} + : a ∈ s ∪ t <-> a ∈ s \/ a ∈ t := by + change a ∈ t.val.foldr (fun a acc => insert a acc) s <-> a ∈ s \/ a ∈ t.val + induction t.val with + | nil => simp + | cons x xs ih => + simp only [List.foldr_cons, mem_insert, ih, List.mem_cons] + constructor + · rintro (ax | inS | inXs) + · exact Or.inr (Or.inl ax) + · exact Or.inl inS + · exact Or.inr (Or.inr inXs) + · rintro (inS | ax | inXs) + · exact Or.inr (Or.inl inS) + · exact Or.inl ax + · exact Or.inr (Or.inr inXs) + +@[simp] +theorem mem_inter [DecidableEq α] {a : α} {s t : Finset α} + : a ∈ s ∩ t <-> a ∈ s /\ a ∈ t := + mem_filter + +@[simp] +theorem mem_sdiff [DecidableEq α] {a : α} {s t : Finset α} + : a ∈ s \ t <-> a ∈ s /\ a ∉ t := + mem_filter + +theorem subset_iff {s t : Finset α} : s ⊆ t <-> forall ⦃a⦄, a ∈ s -> a ∈ t := + Iff.rfl + +@[simp] +theorem Subset.refl (s : Finset α) : s ⊆ s := + fun _ member => member + +theorem Subset.trans {s t u : Finset α} (st : s ⊆ t) (tu : t ⊆ u) : s ⊆ u := + fun _ member => tu (st member) + +theorem inter_subset_left [DecidableEq α] {s t : Finset α} : s ∩ t ⊆ s := + fun _ member => (mem_inter.mp member).1 + +theorem inter_subset_right [DecidableEq α] {s t : Finset α} : s ∩ t ⊆ t := + fun _ member => (mem_inter.mp member).2 + +theorem disjoint_left {s t : Finset α} : Disjoint s t <-> forall ⦃a⦄, a ∈ s -> a ∉ t := + Iff.rfl + +@[simp] +theorem mem_sort {s : Finset α} {a : α} : a ∈ s.sort <-> a ∈ s := + Iff.rfl + +theorem min?_mem {s : Finset α} {a : α} (least : s.min? = some a) : a ∈ s := + List.mem_of_head? least + +theorem min?_isSome {s : Finset α} (nonempty : s.Nonempty) : s.min?.isSome := by + obtain ⟨a, member⟩ := nonempty + match s, member with + | ⟨_ :: _, _⟩, _ => rfl + +@[simp] +theorem card_empty : (∅ : Finset α).card = 0 := + rfl + +theorem card_le_card [StrictTotalOrder α] {s t : Finset α} (subset : s ⊆ t) + : s.card <= t.card := + (nodup_of_sorted s.sorted).length_le_of_subset fun _ member => subset member + +theorem card_union_of_disjoint [DecidableLT α] [StrictTotalOrder α] {s t : Finset α} + (disjoint : Disjoint s t) + : (s ∪ t).card = s.card + t.card := by + rw [card, card, card, ← List.length_append] + apply length_eq_of_nodup_of_mem_iff (nodup_of_sorted (s ∪ t).sorted) + · exact List.nodup_append.mpr ⟨nodup_of_sorted s.sorted, nodup_of_sorted t.sorted, + fun a inS b inT same => disjoint inS (same ▸ inT)⟩ + · intro a + simpa [mem_def] using (mem_union (s := s) (t := t) (a := a)) + +theorem union_subset [DecidableLT α] [StrictTotalOrder α] {s t u : Finset α} + (su : s ⊆ u) (tu : t ⊆ u) + : s ∪ t ⊆ u := by + intro a member + rcases mem_union.mp member with inS | inT + · exact su inS + · exact tu inT + +/-- Two subsets of `s` whose sizes sum to more than `s`'s size intersect. -/ +theorem inter_nonempty_of_card_lt_card_add_card [DecidableEq α] [StrictTotalOrder α] + {s t u : Finset α} (ts : t ⊆ s) (us : u ⊆ s) (larger : s.card < t.card + u.card) + : (t ∩ u).Nonempty := by + classical + apply Decidable.by_contra + intro empty + have disjoint : Disjoint t u := fun a inT inU => empty ⟨a, mem_inter.mpr ⟨inT, inU⟩⟩ + have := card_le_card (union_subset ts us) + rw [card_union_of_disjoint disjoint] at this + omega + +@[simp] +theorem mem_ofList [DecidableLT α] [StrictTotalOrder α] {a : α} {l : List α} + : a ∈ ofList l <-> a ∈ l := by + induction l with + | nil => simp [ofList] + | cons x xs ih => + simp only [ofList, List.foldr_cons, mem_insert, List.mem_cons] at ih ⊢ + rw [ih] + +theorem card_ofList_le [DecidableLT α] [StrictTotalOrder α] (l : List α) + : (ofList l).card <= l.length := + (nodup_of_sorted (ofList l).sorted).length_le_of_subset + fun _ member => + mem_ofList.mp member + +theorem card_ofList_of_nodup [DecidableLT α] [StrictTotalOrder α] {l : List α} + (nodup : l.Nodup) + : (ofList l).card = l.length := + length_eq_of_nodup_of_mem_iff (nodup_of_sorted (ofList l).sorted) nodup + fun _ => + mem_ofList + +end Finset + +end CCF diff --git a/lean/common/CCF/Seq.lean b/lean/common/CCF/Seq.lean new file mode 100644 index 00000000000..12453aa0b4d --- /dev/null +++ b/lean/common/CCF/Seq.lean @@ -0,0 +1,111 @@ +module + +@[expose] public section + +namespace CCF + +/-! +Possibly infinite sequences, covering the part of Mathlib's `Stream'.Seq` that +traces use. A sequence is a function from indices to optional elements which +stays absent once an element is absent. +-/ + +/-- A finite or infinite sequence. -/ +structure Seq (α : Type) where + /-- Element `n`, or `none` past the end of a finite sequence. -/ + get? : Nat -> Option α + /-- Once an element is absent, the next one is absent too. -/ + stable : forall {n}, get? n = none -> get? (n + 1) = none + +namespace Seq + +variable {α β : Type} + +/-- The empty sequence. -/ +def nil : Seq α := + ⟨fun _ => none, fun _ => rfl⟩ + +/-- Prepend an element. -/ +def cons (a : α) (s : Seq α) : Seq α := + ⟨ + fun + | 0 => some a + | n + 1 => s.get? n, + fun {n} absent => by + cases n with + | zero => cases absent + | succ n => exact s.stable absent + ⟩ + +/-- Apply a function to every element. -/ +def map (f : α -> β) (s : Seq α) : Seq β := + ⟨ + fun n => (s.get? n).map f, + fun {n} absent => by + have : s.get? n = none := Option.map_eq_none_iff.mp absent + change (s.get? (n + 1)).map f = none + rw [s.stable this] + rfl + ⟩ + +/-- The finite sequence of a list's elements. -/ +def ofList (l : List α) : Seq α := + ⟨ + fun n => l[n]?, + fun {n} absent => by + simp only [List.getElem?_eq_none_iff] at absent ⊢ + omega + ⟩ + +/-- The infinite sequence of a stream's elements. -/ +def ofStream (f : Nat -> α) : Seq α := + ⟨fun n => some (f n), fun absent => by cases absent⟩ + +/-- An element is in a sequence when it is present at some index. -/ +instance : Membership α (Seq α) := + ⟨fun s a => exists n, s.get? n = some a⟩ + +@[simp] +theorem get?_nil (n : Nat) : (nil : Seq α).get? n = none := + rfl + +@[simp] +theorem get?_cons_zero (a : α) (s : Seq α) : (cons a s).get? 0 = some a := + rfl + +@[simp] +theorem get?_cons_succ (a : α) (s : Seq α) (n : Nat) + : (cons a s).get? (n + 1) = s.get? n := + rfl + +@[simp] +theorem map_get? (f : α -> β) (s : Seq α) (n : Nat) + : (s.map f).get? n = (s.get? n).map f := + rfl + +@[simp] +theorem ofList_get? (l : List α) (n : Nat) : (ofList l).get? n = l[n]? := + rfl + +@[simp] +theorem ofStream_get? (f : Nat -> α) (n : Nat) : (ofStream f).get? n = some (f n) := + rfl + +/-- Membership is presence at some index. -/ +theorem mem_iff_exists_get? {a : α} {s : Seq α} : a ∈ s <-> exists n, some a = s.get? n := + ⟨fun ⟨n, found⟩ => ⟨n, found.symm⟩, fun ⟨n, found⟩ => ⟨n, found.symm⟩⟩ + +/-- An element present at an index is a member. -/ +theorem get?_mem {s : Seq α} {n : Nat} {a : α} (found : s.get? n = some a) : a ∈ s := + ⟨n, found⟩ + +/-- Once an element is absent, every later element is absent. -/ +theorem le_stable (s : Seq α) {m n : Nat} (le : m <= n) (absent : s.get? m = none) + : s.get? n = none := by + induction le with + | refl => exact absent + | step _ ih => exact s.stable ih + +end Seq + +end CCF diff --git a/lean/common/README.md b/lean/common/README.md index ef6935d5874..23132267826 100644 --- a/lean/common/README.md +++ b/lean/common/README.md @@ -10,17 +10,29 @@ The `ccf_common` Lake package exposes protocol-independent definitions in the `C | `CCF.Execution` | Finite runs and finite or infinite execution traces | | `CCF.Parsec` | Stateful Parsec combinators over arrays of arbitrary events | | `CCF.Architecture` | Checks of specification import layering | +| `CCF.Seq` | Possibly infinite sequences (replaces Mathlib `Stream'.Seq`) | +| `CCF.Finset` | Finite sets as strictly sorted lists (replaces `Finset`) | +| `CCF.Function` | Point updates of functions (replaces `Function.update`) | +| `CCF.Proofs.Execution` | Theorems about runs, traces, and reachability | +| `CCF.Proofs.Finset` | Lemmas about the `CCF.Finset` operations | `CCF.Execution.TraceImpl system` records an `init` state and a possibly infinite `steps` sequence pairing each action with its destination state. `CCF.Execution.Trace system` is the subtype whose `TraceImpl.Valid` proof establishes initialization and every recorded transition. -`reachable_iff_trace` shows that finite execution traces reach exactly the reachable states. +`reachable_iff_trace`, in `CCF.Proofs.Execution`, shows that finite execution traces reach exactly the reachable states. + +As in the specification packages, definitions and the theorems about them live in separate modules. +Theorems go under `CCF.Proofs`, keeping their original names, so `CCF.Execution.reachable_iff_trace` is declared in `CCF.Proofs.Execution`. +Definition modules keep only the proofs their definitions carry, such as the sortedness of `CCF.Finset` and the stability of `CCF.Seq`. +`CCF.Seq` and `CCF.Function` keep their few `rfl` and `simp` lemmas alongside their definitions. ## Dependency imports -Specification proofs import the Mathlib tactics they need rather than the `Mathlib.Tactic` umbrella. -Their CCF declarations, theorem statements, exposed definitions, and required tactic support remain available, but importing a proof module or an assembled specification root does not promise to reexport unrelated Mathlib tactics or theory. -`CCF.Execution` publicly imports `Mathlib.Data.Seq.Defs` and keeps `Mathlib.Data.Seq.Basic` private for its internal proofs. -Consumers that need other Mathlib facilities should import their defining modules explicitly. +The common and specification packages depend only on Lean core, leanfmt and (for the disaster-recovery and kv `lake lint` drivers) Batteries, not on Mathlib. +`CCF.Seq`, `CCF.Finset`, and `CCF.Function` are minimal replacements for the Mathlib facilities the specifications used that Lean core, Std and Batteries do not provide. +The [`mathlib-equivalence`](../mathlib-equivalence/README.md) package proves that they are equivalent to the Mathlib definitions they replace, and runs in CI only when those definitions change. +Specification proofs import only the modules they need. +Their CCF declarations, theorem statements, exposed definitions, and required tactic support remain available, but importing a proof module or an assembled specification root does not promise to reexport unrelated tactics or theory. +Consumers that need other facilities should import their defining modules explicitly. The documented property entrypoints remain the public proof APIs; see the [CCF consensus protocol](../consensus/README.md#proofs), [consistency](../consistency/README.md#properties), and [disaster recovery](../disaster-recovery/README.md#properties) packages. Selective imports do not reduce the checked CCF roots or omit tests. @@ -66,7 +78,7 @@ It fails if any source module is missing from the imported modules, without requ After `lake build`, run the same `lake exe check-imports` command to check architecture as well as import coverage. The shared command discovers the package's library roots from Lake and applies `CCF.Architecture` to each specification root. -The `CCF` root contains shared infrastructure and is not treated as a specification. +The `CCF` root contains shared infrastructure; it is not treated as a specification and is checked only against the common rules below. New specifications need no per-model architecture test, namespace configuration, or additional CI command. The checker examines direct import edges throughout each library root's transitive import closure, including private imports. @@ -76,10 +88,12 @@ Architecture checks run in `lake exe check-imports`, not during `lake build`; CI The same rules apply to every specification namespace, including multi-component names: - `CCF` modules cannot import the specification. +- Within `CCF`, only the `CCF` entrypoint and `CCF.Proofs` modules can import `CCF.Proofs`. +- `Model` and its submodules cannot import `CCF.Proofs` or the `CCF` entrypoint that reexports it, so models depend only on shared definitions. - `Model` and its submodules can import only model modules within the specification. Model submodules cannot import the assembled `Model` entrypoint. - The `Properties` entrypoint can import model modules, property helpers, and proofs. - Property helpers can import model modules and other property helpers, but not proofs or the `Properties` entrypoint. - Proofs can import model modules, property helpers, and other proofs, but not the `Properties` entrypoint. - Other modules, such as tests and trace validation, are unrestricted. - Imports outside the specification namespace are unrestricted except for the common-to-specification restriction above. + Imports outside the specification namespace are unrestricted except for the `CCF` restrictions above. diff --git a/lean/common/lake-manifest.json b/lean/common/lake-manifest.json index bc08dbd62fd..15c4f7ce958 100644 --- a/lean/common/lake-manifest.json +++ b/lean/common/lake-manifest.json @@ -1,116 +1,7 @@ { "version": "1.3.0", "packagesDir": ".lake/packages", - "packages": [ - { - "url": "https://github.com/leanprover-community/mathlib4.git", - "type": "git", - "subDir": null, - "scope": "", - "rev": "56a005855ea17e0b0958f73ec801ae140b0a1679", - "name": "mathlib", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.35.0", - "inherited": false, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dfa4f38190d07c37e315953e08b90fe2d95b3c24", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/LeanSearchClient", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "d6b4c7be5be75ec4917c873ac50c756dc1436372", - "name": "LeanSearchClient", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/import-graph", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "a41f0e9a4dea23188ea9cc1c41ac9f8bbafe0b93", - "name": "importGraph", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/ProofWidgets4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "df72b022e558978a1c50264cfc4d7fec86fa8e04", - "name": "proofwidgets", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/aesop", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "4a174c490d8707121c4a9290800489f105d85e07", - "name": "aesop", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/quote4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dce0ad79c486cb1fb504af04f953c3466b0c6db8", - "name": "Qq", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/batteries", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "66e469188fe07963e5cf666c7d4433f45b8131c5", - "name": "batteries", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover/lean4-cli", - "type": "git", - "subDir": null, - "scope": "leanprover", - "rev": "c24fe6078c630e89b489bffe59b3e20ac30d12c8", - "name": "Cli", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.35.0", - "inherited": true, - "configFile": "lakefile.toml" - } - ], + "packages": [], "name": "ccf_common", "lakeDir": ".lake", "fixedToolchain": false diff --git a/lean/common/lakefile.toml b/lean/common/lakefile.toml index d68fab29a20..4618315f866 100644 --- a/lean/common/lakefile.toml +++ b/lean/common/lakefile.toml @@ -22,8 +22,3 @@ srcDir = "scripts" root = "CheckImports" supportInterpreter = true weakLinkArgs = ["-lLake"] - -[[require]] -name = "mathlib" -git = "https://github.com/leanprover-community/mathlib4.git" -rev = "v4.35.0" diff --git a/lean/common/scripts/CheckImports.lean b/lean/common/scripts/CheckImports.lean index 448b2585475..5969867edc8 100644 --- a/lean/common/scripts/CheckImports.lean +++ b/lean/common/scripts/CheckImports.lean @@ -34,7 +34,6 @@ def main : IO Unit := do unless importedModules.contains sourceModule do throw <| IO.userError s!"Module is not imported by {library.name}: {sourceModule}" - unless root == `CCF do - IO.ofExcept <| CCF.Architecture.checkImports root environment - IO.println s!"Architecture checks passed: {root}" + IO.ofExcept <| CCF.Architecture.checkImports root environment + IO.println s!"Architecture checks passed: {root}" IO.println s!"Import coverage passed: {library.name}" diff --git a/lean/consensus/Consensus/Model.lean b/lean/consensus/Consensus/Model.lean index ef1f327039e..cfdcaa72846 100644 --- a/lean/consensus/Consensus/Model.lean +++ b/lean/consensus/Consensus/Model.lean @@ -5,7 +5,6 @@ public import Consensus.Model.Node public import Consensus.Model.Messages public import Consensus.Model.NodeState public import CCF.MultiNodeTransitionSystem -public import Mathlib.Data.Finset.Max @[expose] public section @@ -34,7 +33,7 @@ def BOOTSTRAP_TERM : Nat := 2 /-- The smallest initial member is primary and holds the unsigned configuration. -/ def initialNodeState (initialConfiguration : Finset NodeID) (node : NodeID) : NodeState := - let primary := initialConfiguration.min = (node : WithTop NodeID) + let primary := initialConfiguration.min? = some node { role := if primary then diff --git a/lean/consensus/Consensus/Model/ClusterConfig.lean b/lean/consensus/Consensus/Model/ClusterConfig.lean index c534301dc0e..44dbc0bd0f2 100644 --- a/lean/consensus/Consensus/Model/ClusterConfig.lean +++ b/lean/consensus/Consensus/Model/ClusterConfig.lean @@ -12,6 +12,8 @@ Ledger-derived membership history and retirement queries. namespace Consensus.Model.Node +open CCF (Finset) + inductive MembershipState where /-- No membership removal observed; includes nodes that have never joined. -/ | noRetirementObserved diff --git a/lean/consensus/Consensus/Model/Node.lean b/lean/consensus/Consensus/Model/Node.lean index 59ca2141162..327fe1c5271 100644 --- a/lean/consensus/Consensus/Model/Node.lean +++ b/lean/consensus/Consensus/Model/Node.lean @@ -4,8 +4,7 @@ public import Consensus.Model.ClusterConfig public import Consensus.Model.Messages public import Consensus.Model.NodeState public import CCF.Capabilities -public import Mathlib.Data.Finset.Sort -public import Mathlib.Order.Prod.Lex.Basic +public import CCF.Function @[expose] public section @@ -22,7 +21,7 @@ disabled: the step has no effect and a received message stays in flight. namespace Consensus.Model.Node -open CCF (Capabilities Effect) +open CCF (Capabilities Effect Finset) abbrev Caps := Capabilities NodeID Message Notification @@ -59,18 +58,22 @@ Approximates `all_other_nodes`; unlike CCF, peers lost on rollback are not retai def eligiblePeers (state : NodeState) (self : NodeID) : Finset NodeID := (state.activeMembers ∪ state.retirementCompletedNodes).erase self +/-- Lexicographic order on successor ranks. -/ +def rankBelow (a b : Nat × Nat × Nat) : Bool := + decide (a.1 < b.1 \/ (a.1 = b.1 /\ Prod.lexLt a.2 b.2)) + /-- Maximize replication progress, latest active membership, then node ID. -/ def findSuccessor (state : NodeState) (self : NodeID) : Option NodeID := let configurations := state.activeConfigurations let rank node := - toLex (state.matchIndex node, toLex (latestMembershipIndex configurations node, node)) + (state.matchIndex node, latestMembershipIndex configurations node, node) let peers := (eligiblePeers state self).sort peers.foldl (fun best candidate => match best with | none => some candidate | some selected => - if rank selected < rank candidate then + if rankBelow (rank selected) (rank candidate) then some candidate else best) @@ -187,7 +190,10 @@ def sendEntries (caps : Caps) (self : NodeID) caps.send (.appendEntriesRequest (makeAppendEntriesRequest state destination endIndex)) destination - return { state with sentIndex := Function.update state.sentIndex destination endIndex } + return { + state with + sentIndex := CCF.Function.update state.sentIndex destination endIndex + } /-! ## Appending entries -/ @@ -365,7 +371,7 @@ def handleAppendEntriesResponse { state with matchIndex := - Function.update state.matchIndex source + CCF.Function.update state.matchIndex source (max (state.matchIndex source) response.lastLogIndex) } advanceCommit caps state self @@ -378,7 +384,7 @@ def handleAppendEntriesResponse return { state with sentIndex := - Function.update state.sentIndex source + CCF.Function.update state.sentIndex source (max (min retryIndex (state.sentIndex source)) (state.matchIndex source)) } diff --git a/lean/consensus/Consensus/Model/NodeState.lean b/lean/consensus/Consensus/Model/NodeState.lean index a68421e990c..01cabfb7c97 100644 --- a/lean/consensus/Consensus/Model/NodeState.lean +++ b/lean/consensus/Consensus/Model/NodeState.lean @@ -1,7 +1,6 @@ module -public import Mathlib.Data.Finset.Card -public import Mathlib.Data.Finset.Lattice.Fold +public import CCF.Finset @[expose] public section @@ -14,6 +13,8 @@ Signatures make their prefixes committable. Behaviour is in `Node.lean`. namespace Consensus.Model.Node +open CCF (Finset) + /-- A node's identifier. -/ abbrev NodeID := Nat diff --git a/lean/consensus/Consensus/Proofs/Direct.lean b/lean/consensus/Consensus/Proofs/Direct.lean index 2bf88f2769d..60f30085079 100644 --- a/lean/consensus/Consensus/Proofs/Direct.lean +++ b/lean/consensus/Consensus/Proofs/Direct.lean @@ -1,14 +1,15 @@ module public import Consensus.Model -public import Mathlib.Tactic.SplitIfs import all Init.Control.State -public import CCF.Execution +public import CCF.Proofs.Execution +public import CCF.Proofs.Finset namespace Consensus.Proofs.Config +open CCF (Finset) open Model.Node /-- The initial membership passed to the model, possibly empty. -/ @@ -19,6 +20,7 @@ end Consensus.Proofs.Config namespace Consensus.Proofs.Config +open CCF (Finset) open Model.Node section Initial variable [config : InitialConfiguration] @@ -165,7 +167,7 @@ private theorem step_deliver network := removeOne envelope before.network ++ outputs.outgoing } := by simp only [Model.transitionSystem, lift, next, Model.protocol] at stepped - simp [Model.Node.step, Option.bind_eq_some_iff] at stepped + simp [Model.Node.step, Option.bind_eq_some_iff, guard] at stepped obtain ⟨queued, state, found, next, outputs, ran, rfl⟩ := stepped exact ⟨queued, state, next, outputs, found, ran, by simp [replaceNode]⟩ @@ -222,12 +224,12 @@ open Consensus.Proofs.Config open Consensus.Model.Node @[simp] -private lemma EntryContent.isSignature_eq_true {content : EntryContent} +private theorem EntryContent.isSignature_eq_true {content : EntryContent} : content.isSignature = true <-> content = .signature := by cases content <;> simp [EntryContent.isSignature] /-- A successful one-based lookup proves the index lies within the log. -/ -private lemma entryAtSomeIndexBound +private theorem entryAtSomeIndexBound {log : List Entry} {index : Nat} {entry : Entry} @@ -243,7 +245,7 @@ private lemma entryAtSomeIndexBound exact within /-- A successful lookup is unchanged when the log is extended at the end. -/ -private lemma entryAt_of_prefix +private theorem entryAt_of_prefix {left right : List Entry} (isPrefix : left <+: right) {index : Nat} @@ -263,7 +265,7 @@ private lemma entryAt_of_prefix exact found /-- A positive signature test identifies a concrete signature entry. -/ -private lemma isSignatureAtTrue +private theorem isSignatureAtTrue {log : List Entry} {index : Nat} (signature : isSignatureAt log index = true) @@ -278,7 +280,7 @@ private lemma isSignatureAtTrue simpa [isSignatureAt, found] using signature /-- The latest signature index lies within the log. -/ -private lemma maxCommittableIndexBounded (log : List Entry) +private theorem maxCommittableIndexBounded (log : List Entry) : maxCommittableIndex log <= log.length := by unfold maxCommittableIndex let candidates := List.range (log.length + 1) @@ -316,7 +318,7 @@ private lemma maxCommittableIndexBounded (log : List Entry) exact foldBounded candidates 0 allBounded (Nat.zero_le _) /-- A positive latest committable index points to a signature. -/ -private lemma maxCommittableIndexPositiveIsSignature +private theorem maxCommittableIndexPositiveIsSignature {log : List Entry} (positive : 0 < maxCommittableIndex log) : isSignatureAt log (maxCommittableIndex log) = true := by @@ -346,10 +348,10 @@ private lemma maxCommittableIndexPositiveIsSignature exact Or.inr headValid · by_cases bestLeHead : best <= head · right - simpa [max_eq_right bestLeHead] using headValid + simpa [Nat.max_eq_right bestLeHead] using headValid · right have headLeBest : head <= best := Nat.le_of_lt (Nat.lt_of_not_le bestLeHead) - simpa [max_eq_left headLeBest] using bestIsValid + simpa [Nat.max_eq_left headLeBest] using bestIsValid · simp [headValid, bestValid] have resultValid := foldValid (List.range (log.length + 1)) 0 (Or.inl rfl) @@ -359,7 +361,7 @@ private lemma maxCommittableIndexPositiveIsSignature · exact resultValid /-- Every signature index is no later than the latest signature index. -/ -private lemma signatureIndex_le_maxCommittableIndex +private theorem signatureIndex_le_maxCommittableIndex {log : List Entry} {index : Nat} (signature : isSignatureAt log index = true) @@ -382,14 +384,14 @@ private lemma signatureIndex_le_maxCommittableIndex induction values with | nil => intro best - exact le_rfl + exact Nat.le.refl | cons head tail inductionHypothesis => intro best - apply le_trans (b := choose best head) + apply Nat.le_trans (m := choose best head) · simp only [choose] split · exact Nat.le_max_left _ _ - · exact Nat.le_refl _ + · exact Nat.le.refl · exact inductionHypothesis (choose best head) have foldContains : forall (values : List Nat) (best : Nat), @@ -408,7 +410,7 @@ private lemma signatureIndex_le_maxCommittableIndex choose best index = max best index := by simp [choose, signature] rw [selected] - exact (le_max_right best index).trans (foldAboveStart tail (max best index)) + exact Nat.le_trans (Nat.le_max_right best index) (foldAboveStart tail (max best index)) · exact inductionHypothesis (choose best head) tailMember @@ -419,7 +421,7 @@ private lemma signatureIndex_le_maxCommittableIndex exact Nat.lt_succ_of_le indexBound) /-- Extending a log preserves every earlier signature lookup. -/ -private lemma isSignatureAt_of_prefix +private theorem isSignatureAt_of_prefix {left right : List Entry} (isPrefix : left <+: right) {index : Nat} @@ -430,7 +432,7 @@ private lemma isSignatureAt_of_prefix simp [isSignatureAt, extended, content] /-- Extending a log cannot move its latest signature backwards. -/ -private lemma maxCommittableIndex_le_of_prefix +private theorem maxCommittableIndex_le_of_prefix {left right : List Entry} (isPrefix : left <+: right) : maxCommittableIndex left <= maxCommittableIndex right := by @@ -445,7 +447,7 @@ private lemma maxCommittableIndex_le_of_prefix (maxCommittableIndexPositiveIsSignature positive)) /-- Taking a log prefix leaves lookups inside that prefix unchanged. -/ -private lemma isSignatureAt_take_of_le +private theorem isSignatureAt_take_of_le {log : List Entry} {index count : Nat} (within : index <= count) @@ -466,7 +468,7 @@ private lemma isSignatureAt_take_of_le simp [isSignatureAt, taken, content] /-- The bounded committable frontier does not exceed the complete log. -/ -private lemma maxCommittableIndexUpTo_le_length (log : List Entry) (frontier : Nat) +private theorem maxCommittableIndexUpTo_le_length (log : List Entry) (frontier : Nat) : maxCommittableIndexUpTo log frontier <= log.length := by unfold maxCommittableIndexUpTo have bounded := @@ -475,7 +477,7 @@ private lemma maxCommittableIndexUpTo_le_length (log : List Entry) (frontier : N exact Nat.le_trans bounded (Nat.min_le_right _ _) /-- A positive bounded committable frontier points to a signature in the log. -/ -private lemma maxCommittableIndexUpToPositiveIsSignature +private theorem maxCommittableIndexUpToPositiveIsSignature {log : List Entry} {frontier : Nat} (positive : 0 < maxCommittableIndexUpTo log frontier) @@ -488,7 +490,8 @@ private lemma maxCommittableIndexUpToPositiveIsSignature /-- Recording a commit changes the commit index and retirement latch, and may clear the role and primary knowledge. -/ -private lemma NodeState.recordCommit_eq (node : NodeID) (state : NodeState) (index : Nat) +private theorem NodeState.recordCommit_eq (node : NodeID) (state : NodeState) + (index : Nat) : exists retiredCommittedIndex role primaryKnown, state.recordCommit node index = { state with commitIndex := index, retiredCommittedIndex, role, primaryKnown } @@ -500,27 +503,30 @@ private lemma NodeState.recordCommit_eq (node : NodeID) (state : NodeState) (ind · exact ⟨_, _, _, rfl, Or.inl rfl⟩ @[simp] -private lemma NodeState.recordCommit_log (node : NodeID) (state : NodeState) (index : Nat) +private theorem NodeState.recordCommit_log (node : NodeID) (state : NodeState) + (index : Nat) : (state.recordCommit node index).log = state.log := by obtain ⟨_, _, _, eq, _⟩ := NodeState.recordCommit_eq node state index rw [eq] @[simp] -private lemma NodeState.recordCommit_commitIndex (node : NodeID) (state : NodeState) +private theorem NodeState.recordCommit_commitIndex (node : NodeID) (state : NodeState) (index : Nat) : (state.recordCommit node index).commitIndex = index := by obtain ⟨_, _, _, eq, _⟩ := NodeState.recordCommit_eq node state index rw [eq] /-- Extending a log cannot move its bounded committable frontier backwards. -/ -private lemma maxCommittableIndexUpTo_mono {left right : List Entry} +private theorem maxCommittableIndexUpTo_mono {left right : List Entry} (isPrefix : left <+: right) (frontier : Nat) : maxCommittableIndexUpTo left frontier <= maxCommittableIndexUpTo right frontier := - maxCommittableIndex_le_of_prefix (isPrefix.take frontier) + maxCommittableIndex_le_of_prefix + (List.prefix_take_iff.mpr + ⟨(List.take_prefix _ _).trans isPrefix, List.length_take_le _ _⟩) /-- The follower append loop changes only the log, commit and retirement fields, and may clear the role. -/ -private lemma fromLeader_loop (self : NodeID) (limit : Nat) (entries : List Entry) +private theorem fromLeader_loop (self : NodeID) (limit : Nat) (entries : List Entry) : forall (state : NodeState), exists commitIndex retiredCommittedIndex role primaryKnown, entries.foldl @@ -555,8 +561,8 @@ private lemma fromLeader_loop (self : NodeID) (limit : Nat) (entries : List Entr state.primaryKnown, by simp, Or.inl rfl, - le_rfl, - le_max_left _ _ + Nat.le.refl, + Nat.le_max_left _ _ ⟩ | cons entry entries ih => intro state @@ -592,7 +598,7 @@ private lemma fromLeader_loop (self : NodeID) (limit : Nat) (entries : List Entr Intermediate commits use prefixes of the final log, so the follower's final commit index is the bounded committable frontier of the extended log. -/ -private lemma handleAppendEntiresFromPrimary_eq (self : NodeID) (state : NodeState) +private theorem handleAppendEntiresFromPrimary_eq (self : NodeID) (state : NodeState) (request : AppendEntriesRequest) : let log := state.log ++ request.entries.drop (state.log.length - request.prevLogIndex) @@ -639,7 +645,7 @@ private lemma handleAppendEntiresFromPrimary_eq (self : NodeID) (state : NodeSta · exact Or.inr none /-- A rollback point lies after the request's previous index. -/ -private lemma firstTermConflictIndex_ge {state : NodeState} +private theorem firstTermConflictIndex_ge {state : NodeState} {request : AppendEntriesRequest} {index : Nat} (conflict : firstTermConflictIndex state request = some index) : request.prevLogIndex + 1 <= index := by @@ -806,7 +812,7 @@ private theorem CommitFrontier.extend {state : NodeState} (frontier : CommitFrontier state) {log : List Entry} (extends_ : state.log <+: log) : CommitFrontier { state with log } := by - refine ⟨frontier.1.trans extends_.length_le, fun positive => ?_⟩ + refine ⟨Nat.le_trans frontier.1 extends_.length_le, fun positive => ?_⟩ exact isSignatureAt_of_prefix extends_ (frontier.2 positive) private theorem CommitFrontier.keep {state : NodeState} @@ -828,12 +834,13 @@ private theorem CommitFrontier.advance {state : NodeState} state with log, commitIndex := max state.commitIndex (maxCommittableIndexUpTo log bound) } := by - refine ⟨max_le extends_.1 (maxCommittableIndexUpTo_le_length log bound), fun positive => ?_⟩ + refine ⟨Nat.max_le.mpr ⟨extends_.1, maxCommittableIndexUpTo_le_length log bound⟩, + fun positive => ?_⟩ simp only at positive ⊢ rcases Nat.le_total state.commitIndex (maxCommittableIndexUpTo log bound) with le | le - · rw [max_eq_right le] at positive ⊢ + · rw [Nat.max_eq_right le] at positive ⊢ exact maxCommittableIndexUpToPositiveIsSignature positive - · rw [max_eq_left le] at positive ⊢ + · rw [Nat.max_eq_left le] at positive ⊢ exact extends_.2 positive private theorem foldl_select_max (P : Nat -> Prop) [DecidablePred P] (values : List Nat) @@ -852,9 +859,9 @@ private theorem foldl_select_max (P : Nat -> Prop) [DecidablePred P] (values : L by_cases chosen : P head · rcases Nat.le_total init head with le | le · right - simp [chosen, max_eq_right le] + simp [chosen, Nat.max_eq_right le] · left - simp [chosen, max_eq_left le] + simp [chosen, Nat.max_eq_left le] · simp [chosen] · exact Or.inr holds @@ -1199,15 +1206,15 @@ open Model.Node private theorem Extends.committedLog {before after : NodeState} (extended : Extends before after) : before.committedLog <+: after.committedLog := - List.prefix_take_iff.mpr ⟨extended.2, (List.length_take_le _ _).trans extended.1⟩ + List.prefix_take_iff.mpr ⟨extended.2, Nat.le_trans (List.length_take_le _ _) extended.1⟩ private theorem Extends.refl (state : NodeState) : Extends state state := - ⟨le_rfl, List.take_prefix _ _⟩ + ⟨Nat.le.refl, List.take_prefix _ _⟩ private theorem Extends.trans {first second third : NodeState} (left : Extends first second) (right : Extends second third) : Extends first third := - ⟨left.1.trans right.1, left.committedLog.trans right.2⟩ + ⟨Nat.le_trans left.1 right.1, left.committedLog.trans right.2⟩ /-- Keeping the log below `count`, at or above the commit index, and committing no less extends the committed log. -/ @@ -1222,11 +1229,11 @@ private theorem Extends.of_prefix {before after : NodeState} {count : Nat} private theorem Extends.of_log {before after : NodeState} (logEq : after.log = before.log) (commitEq : after.commitIndex = before.commitIndex) : Extends before after := - ⟨commitEq.ge, logEq ▸ List.take_prefix _ _⟩ + ⟨Nat.le_of_eq commitEq.symm, logEq ▸ List.take_prefix _ _⟩ private theorem Extends.append {state : NodeState} (entry : Entry) : Extends state { state with log := state.log ++ [entry] } := - ⟨le_rfl, (List.take_prefix _ _).trans (List.prefix_append _ _)⟩ + ⟨Nat.le.refl, (List.take_prefix _ _).trans (List.prefix_append _ _)⟩ end Consensus.Proofs.Direct @@ -1245,7 +1252,7 @@ private theorem Extends.fromLeader obtain ⟨retired, role, known, eq, -⟩ := Ledger.handleAppendEntiresFromPrimary_eq self state request rw [eq] - exact ⟨le_max_left _ _, (List.take_prefix _ _).trans (List.prefix_append _ _)⟩ + exact ⟨Nat.le_max_left _ _, (List.take_prefix _ _).trans (List.prefix_append _ _)⟩ private theorem Extends.handleAppendEntriesRequest (caps : Caps) (source : NodeID) : Keeps (Extends state) @@ -1280,7 +1287,7 @@ private theorem Extends.handleAppendEntriesRequest (caps : Caps) (source : NodeI primaryKnown := true, log := current.log.take (index - 1), isNewFollower := false } := Extends.of_prefix (count := index - 1) - (Nat.le_trans within (Nat.le_sub_of_add_le this)) (List.prefix_refl _) le_rfl + (Nat.le_trans within (Nat.le_sub_of_add_le this)) (List.prefix_refl _) Nat.le.refl exact Keeps.seq' fun _ => Keeps.pure' ((stepped.trans truncated).trans Extends.fromLeader) end AppendEntries @@ -1341,7 +1348,7 @@ private theorem Extends.becomePrimary (state : NodeState) } := by split · exact Extends.of_prefix (by unfold lastCommittableIndex; exact Nat.le_max_left _ _) - (List.prefix_refl _) le_rfl + (List.prefix_refl _) Nat.le.refl · exact Extends.of_log rfl rfl exact Keeps.bind' (Extends.advanced caps self _) fun _ kept => Keeps.seq' fun _ => Keeps.pure' (promoted.trans kept) diff --git a/lean/consensus/Consensus/Proofs/SafetyInvariant.lean b/lean/consensus/Consensus/Proofs/SafetyInvariant.lean index f5ae53169cd..e83b6864f32 100644 --- a/lean/consensus/Consensus/Proofs/SafetyInvariant.lean +++ b/lean/consensus/Consensus/Proofs/SafetyInvariant.lean @@ -1,15 +1,16 @@ module public import Consensus.Model -public import Mathlib.Tactic.SplitIfs import all Init.Control.State public import Consensus.Model.Node -public import CCF.Execution +public import CCF.Proofs.Execution +public import CCF.Proofs.Finset namespace Consensus.Proofs.Config +open CCF (Finset) open Model.Node /-- The initial membership passed to the model, possibly empty. -/ @@ -20,6 +21,7 @@ end Consensus.Proofs.Config namespace Consensus.Proofs.Config +open CCF (Finset) open Model.Node section Initial variable [config : InitialConfiguration] @@ -28,7 +30,7 @@ private abbrev INITIAL_CONFIGURATION : Finset NodeID := config.configuration /-- The smallest initial member, which the model makes the bootstrap primary. Meaningful only for a nonempty initial membership. -/ -private abbrev INITIAL_PRIMARY : NodeID := INITIAL_CONFIGURATION.min.untopD 0 +private abbrev INITIAL_PRIMARY : NodeID := INITIAL_CONFIGURATION.min?.getD 0 /-- The unsigned bootstrap configuration transaction of the initial primary. -/ private abbrev GENESIS : Entry := @@ -42,6 +44,7 @@ end Consensus.Proofs.Config namespace Consensus.Proofs.Config +open CCF (Finset) open Model.Node /-- Collect the reconfiguration entries of a log with their one-based indices. -/ @@ -968,20 +971,23 @@ end Consensus.Proofs.Safety.Ctx namespace Consensus.Proofs.Config +open CCF (Finset) open Model.Node section Initial variable [config : InitialConfiguration] private theorem initial_primary_iff (nonempty : INITIAL_CONFIGURATION.Nonempty) {node : NodeID} - : INITIAL_CONFIGURATION.min = (node : WithTop NodeID) <-> node = INITIAL_PRIMARY := by - rw [INITIAL_PRIMARY, ← Finset.coe_min' nonempty, WithTop.untopD_coe, WithTop.coe_inj] + : INITIAL_CONFIGURATION.min? = some node <-> node = INITIAL_PRIMARY := by + obtain ⟨least, found⟩ := Option.isSome_iff_exists.mp (Finset.min?_isSome nonempty) + simp only [INITIAL_PRIMARY, found, Option.getD_some, Option.some.injEq] exact eq_comm private theorem INITIAL_PRIMARY_mem (nonempty : INITIAL_CONFIGURATION.Nonempty) : INITIAL_PRIMARY ∈ INITIAL_CONFIGURATION := by - rw [INITIAL_PRIMARY, ← Finset.coe_min' nonempty, WithTop.untopD_coe] - exact Finset.min'_mem _ _ + obtain ⟨least, found⟩ := Option.isSome_iff_exists.mp (Finset.min?_isSome nonempty) + simp only [INITIAL_PRIMARY, found, Option.getD_some] + exact Finset.min?_mem found private theorem GENESIS_configured : GENESIS.content.metadata.configuration.isSome := by simp [EntryContent.metadata] @@ -1043,7 +1049,7 @@ private theorem step_deliver network := removeOne envelope before.network ++ outputs.outgoing } := by simp only [Model.transitionSystem, lift, next, Model.protocol] at stepped - simp [Model.Node.step, Option.bind_eq_some_iff] at stepped + simp [Model.Node.step, Option.bind_eq_some_iff, guard] at stepped obtain ⟨queued, state, found, next, outputs, ran, rfl⟩ := stepped exact ⟨queued, state, next, outputs, found, ran, by simp [replaceNode]⟩ @@ -1113,12 +1119,12 @@ open Consensus.Proofs.Config open Consensus.Model.Node @[simp] -private lemma EntryContent.isSignature_eq_true {content : EntryContent} +private theorem EntryContent.isSignature_eq_true {content : EntryContent} : content.isSignature = true <-> content = .signature := by cases content <;> simp [EntryContent.isSignature] /-- A successful one-based lookup proves the index lies within the log. -/ -private lemma entryAtSomeIndexBound +private theorem entryAtSomeIndexBound {log : List Entry} {index : Nat} {entry : Entry} @@ -1134,7 +1140,7 @@ private lemma entryAtSomeIndexBound exact within /-- A successful one-based lookup is membership evidence. -/ -private lemma entryAt_mem +private theorem entryAt_mem {log : List Entry} {index : Nat} {entry : Entry} @@ -1149,7 +1155,7 @@ private lemma entryAt_mem exact List.getElem_mem within /-- A successful lookup is unchanged when the log is extended at the end. -/ -private lemma entryAt_of_prefix +private theorem entryAt_of_prefix {left right : List Entry} (isPrefix : left <+: right) {index : Nat} @@ -1169,7 +1175,7 @@ private lemma entryAt_of_prefix exact found /-- A positive signature test identifies a concrete signature entry. -/ -private lemma isSignatureAtTrue +private theorem isSignatureAtTrue {log : List Entry} {index : Nat} (signature : isSignatureAt log index = true) @@ -1184,7 +1190,7 @@ private lemma isSignatureAtTrue simpa [isSignatureAt, found] using signature /-- The latest signature index lies within the log. -/ -private lemma maxCommittableIndexBounded (log : List Entry) +private theorem maxCommittableIndexBounded (log : List Entry) : maxCommittableIndex log <= log.length := by unfold maxCommittableIndex let candidates := List.range (log.length + 1) @@ -1222,7 +1228,7 @@ private lemma maxCommittableIndexBounded (log : List Entry) exact foldBounded candidates 0 allBounded (Nat.zero_le _) /-- A positive latest committable index points to a signature. -/ -private lemma maxCommittableIndexPositiveIsSignature +private theorem maxCommittableIndexPositiveIsSignature {log : List Entry} (positive : 0 < maxCommittableIndex log) : isSignatureAt log (maxCommittableIndex log) = true := by @@ -1252,10 +1258,10 @@ private lemma maxCommittableIndexPositiveIsSignature exact Or.inr headValid · by_cases bestLeHead : best <= head · right - simpa [max_eq_right bestLeHead] using headValid + simpa [Nat.max_eq_right bestLeHead] using headValid · right have headLeBest : head <= best := Nat.le_of_lt (Nat.lt_of_not_le bestLeHead) - simpa [max_eq_left headLeBest] using bestIsValid + simpa [Nat.max_eq_left headLeBest] using bestIsValid · simp [headValid, bestValid] have resultValid := foldValid (List.range (log.length + 1)) 0 (Or.inl rfl) @@ -1265,7 +1271,7 @@ private lemma maxCommittableIndexPositiveIsSignature · exact resultValid /-- Every signature index is no later than the latest signature index. -/ -private lemma signatureIndex_le_maxCommittableIndex +private theorem signatureIndex_le_maxCommittableIndex {log : List Entry} {index : Nat} (signature : isSignatureAt log index = true) @@ -1288,14 +1294,14 @@ private lemma signatureIndex_le_maxCommittableIndex induction values with | nil => intro best - exact le_rfl + exact Nat.le.refl | cons head tail inductionHypothesis => intro best - apply le_trans (b := choose best head) + apply Nat.le_trans (m := choose best head) · simp only [choose] split · exact Nat.le_max_left _ _ - · exact Nat.le_refl _ + · exact Nat.le.refl · exact inductionHypothesis (choose best head) have foldContains : forall (values : List Nat) (best : Nat), @@ -1314,7 +1320,7 @@ private lemma signatureIndex_le_maxCommittableIndex choose best index = max best index := by simp [choose, signature] rw [selected] - exact (le_max_right best index).trans (foldAboveStart tail (max best index)) + exact Nat.le_trans (Nat.le_max_right best index) (foldAboveStart tail (max best index)) · exact inductionHypothesis (choose best head) tailMember @@ -1325,7 +1331,7 @@ private lemma signatureIndex_le_maxCommittableIndex exact Nat.lt_succ_of_le indexBound) /-- Extending a log preserves every earlier signature lookup. -/ -private lemma isSignatureAt_of_prefix +private theorem isSignatureAt_of_prefix {left right : List Entry} (isPrefix : left <+: right) {index : Nat} @@ -1336,7 +1342,7 @@ private lemma isSignatureAt_of_prefix simp [isSignatureAt, extended, content] /-- Extending a log cannot move its latest signature backwards. -/ -private lemma maxCommittableIndex_le_of_prefix +private theorem maxCommittableIndex_le_of_prefix {left right : List Entry} (isPrefix : left <+: right) : maxCommittableIndex left <= maxCommittableIndex right := by @@ -1351,7 +1357,7 @@ private lemma maxCommittableIndex_le_of_prefix (maxCommittableIndexPositiveIsSignature positive)) /-- Taking a log prefix leaves lookups inside that prefix unchanged. -/ -private lemma isSignatureAt_take_of_le +private theorem isSignatureAt_take_of_le {log : List Entry} {index count : Nat} (within : index <= count) @@ -1372,7 +1378,7 @@ private lemma isSignatureAt_take_of_le simp [isSignatureAt, taken, content] /-- The bounded committable frontier does not exceed the complete log. -/ -private lemma maxCommittableIndexUpTo_le_length (log : List Entry) (frontier : Nat) +private theorem maxCommittableIndexUpTo_le_length (log : List Entry) (frontier : Nat) : maxCommittableIndexUpTo log frontier <= log.length := by unfold maxCommittableIndexUpTo have bounded := @@ -1381,7 +1387,7 @@ private lemma maxCommittableIndexUpTo_le_length (log : List Entry) (frontier : N exact Nat.le_trans bounded (Nat.min_le_right _ _) /-- Restricting the search frontier cannot reveal a later signature. -/ -private lemma maxCommittableIndexUpTo_le (log : List Entry) (frontier : Nat) +private theorem maxCommittableIndexUpTo_le (log : List Entry) (frontier : Nat) : maxCommittableIndexUpTo log frontier <= maxCommittableIndex log := by unfold maxCommittableIndexUpTo exact @@ -1389,7 +1395,7 @@ private lemma maxCommittableIndexUpTo_le (log : List Entry) (frontier : Nat) (List.take_prefix frontier log) /-- A positive bounded committable frontier points to a signature in the log. -/ -private lemma maxCommittableIndexUpToPositiveIsSignature +private theorem maxCommittableIndexUpToPositiveIsSignature {log : List Entry} {frontier : Nat} (positive : 0 < maxCommittableIndexUpTo log frontier) @@ -1400,7 +1406,7 @@ private lemma maxCommittableIndexUpToPositiveIsSignature (List.take_prefix frontier log) (maxCommittableIndexPositiveIsSignature positive) -private lemma configurationHistory_filterMap (index : Nat) (log : List Entry) +private theorem configurationHistory_filterMap (index : Nat) (log : List Entry) : (log.zipIdx index).filterMap (fun (entry, index) => entry.content.metadata.configuration.map @@ -1414,24 +1420,25 @@ private lemma configurationHistory_filterMap (index : Nat) (log : List Entry) simp [configurationsInLogFrom, h, ih] @[simp] -private lemma activeConfigurations_eq (state : NodeState) +private theorem activeConfigurations_eq (state : NodeState) : Model.Node.activeConfigurations state.log state.commitIndex = activeConfigurationsOf state := by rfl @[simp] -private lemma NodeState.activeConfigurations_eq (state : NodeState) +private theorem NodeState.activeConfigurations_eq (state : NodeState) : state.activeConfigurations = activeConfigurationsOf state := Consensus.Proofs.Ledger.activeConfigurations_eq state @[simp] -private lemma NodeState.activeMembers_eq (state : NodeState) +private theorem NodeState.activeMembers_eq (state : NodeState) : state.activeMembers = activeNodeUnion state := by simp [Model.Node.NodeState.activeMembers, activeNodeUnion, configurationMembers] /-- Recording a commit changes the commit index and retirement latch, and may clear the role and primary knowledge. -/ -private lemma NodeState.recordCommit_eq (node : NodeID) (state : NodeState) (index : Nat) +private theorem NodeState.recordCommit_eq (node : NodeID) (state : NodeState) + (index : Nat) : exists retiredCommittedIndex role primaryKnown, state.recordCommit node index = { state with commitIndex := index, retiredCommittedIndex, role, primaryKnown } @@ -1443,27 +1450,30 @@ private lemma NodeState.recordCommit_eq (node : NodeID) (state : NodeState) (ind · exact ⟨_, _, _, rfl, Or.inl rfl⟩ @[simp] -private lemma NodeState.recordCommit_log (node : NodeID) (state : NodeState) (index : Nat) +private theorem NodeState.recordCommit_log (node : NodeID) (state : NodeState) + (index : Nat) : (state.recordCommit node index).log = state.log := by obtain ⟨_, _, _, eq, _⟩ := NodeState.recordCommit_eq node state index rw [eq] @[simp] -private lemma NodeState.recordCommit_commitIndex (node : NodeID) (state : NodeState) +private theorem NodeState.recordCommit_commitIndex (node : NodeID) (state : NodeState) (index : Nat) : (state.recordCommit node index).commitIndex = index := by obtain ⟨_, _, _, eq, _⟩ := NodeState.recordCommit_eq node state index rw [eq] /-- Extending a log cannot move its bounded committable frontier backwards. -/ -private lemma maxCommittableIndexUpTo_mono {left right : List Entry} +private theorem maxCommittableIndexUpTo_mono {left right : List Entry} (isPrefix : left <+: right) (frontier : Nat) : maxCommittableIndexUpTo left frontier <= maxCommittableIndexUpTo right frontier := - maxCommittableIndex_le_of_prefix (isPrefix.take frontier) + maxCommittableIndex_le_of_prefix + (List.prefix_take_iff.mpr + ⟨(List.take_prefix _ _).trans isPrefix, List.length_take_le _ _⟩) /-- The follower append loop changes only the log, commit and retirement fields, and may clear the role. -/ -private lemma fromLeader_loop (self : NodeID) (limit : Nat) (entries : List Entry) +private theorem fromLeader_loop (self : NodeID) (limit : Nat) (entries : List Entry) : forall (state : NodeState), exists commitIndex retiredCommittedIndex role primaryKnown, entries.foldl @@ -1498,8 +1508,8 @@ private lemma fromLeader_loop (self : NodeID) (limit : Nat) (entries : List Entr state.primaryKnown, by simp, Or.inl rfl, - le_rfl, - le_max_left _ _ + Nat.le.refl, + Nat.le_max_left _ _ ⟩ | cons entry entries ih => intro state @@ -1535,7 +1545,7 @@ private lemma fromLeader_loop (self : NodeID) (limit : Nat) (entries : List Entr Intermediate commits use prefixes of the final log, so the follower's final commit index is the bounded committable frontier of the extended log. -/ -private lemma handleAppendEntiresFromPrimary_eq (self : NodeID) (state : NodeState) +private theorem handleAppendEntiresFromPrimary_eq (self : NodeID) (state : NodeState) (request : AppendEntriesRequest) : let log := state.log ++ request.entries.drop (state.log.length - request.prevLogIndex) @@ -1582,7 +1592,7 @@ private lemma handleAppendEntiresFromPrimary_eq (self : NodeID) (state : NodeSta · exact Or.inr none /-- A rollback point lies after the request's previous index. -/ -private lemma firstTermConflictIndex_ge {state : NodeState} +private theorem firstTermConflictIndex_ge {state : NodeState} {request : AppendEntriesRequest} {index : Nat} (conflict : firstTermConflictIndex state request = some index) : request.prevLogIndex + 1 <= index := by @@ -2009,6 +2019,7 @@ end Consensus.Proofs.Safety namespace Consensus.Proofs.Safety set_option linter.unusedSectionVars false +open CCF (Finset) open Model.Node private theorem take_eq_of_prefix {α : Type} {small large : List α} {n : Nat} @@ -2142,7 +2153,7 @@ private theorem acceptLog_eq {follower sender : List Entry} have senderOffset : sender.take (prev + offset) = sender.take prev ++ batch.take offset := by rw [List.take_add] congr 1 - conv_rhs => rw [batchEq] + conv => rhs; rw [batchEq] rw [List.take_take, Nat.min_eq_left (Nat.le_of_lt offBatch)] rw [takeLength, Nat.add_sub_cancel_left, keptAgree, senderOffset, List.append_assoc, List.take_append_drop, ← senderTake] @@ -2204,8 +2215,8 @@ private theorem acceptLog_eq {follower sender : List Entry} · have pos : 0 < follower.length := Nat.lt_of_le_of_lt (Nat.zero_le _) ahead have fs : follower.length <= sender.length := Nat.le_of_lt (Nat.lt_of_lt_of_le (Nat.lt_of_not_le long) batchBound) - have := aligned follower.length pos le_rfl fs (by - rw [termAt_eq pos le_rfl, termAt_eq pos fs] + have := aligned follower.length pos Nat.le.refl fs (by + rw [termAt_eq pos Nat.le.refl, termAt_eq pos fs] have eq : prev + (follower.length - 1 - prev) = follower.length - 1 := Nat.add_sub_of_le (Nat.le_sub_one_of_lt ahead) have lastLt : prev + (follower.length - 1 - prev) < follower.length := by @@ -2216,7 +2227,7 @@ private theorem acceptLog_eq {follower sender : List Entry} (Nat.lt_trans lastLt (Nat.lt_of_not_le long))) lastLt simpa only [eq] using this) - rwa [List.take_of_length_le le_rfl] at this + rwa [List.take_of_length_le Nat.le.refl] at this have differ : Not (follower.take (prev + batch.length) = sender.take (prev + batch.length)) := by intro same @@ -2233,7 +2244,7 @@ private theorem acceptLog_eq {follower sender : List Entry} rw [senderTake, List.take_append, List.length_take, Nat.min_eq_left prevSender, List.take_of_length_le (Nat.le_trans (List.length_take_le _ _) prevBound)] at viaTake exact viaTake - nth_rewrite 1 [followerEq] + rw (occs := .pos [1]) [followerEq] rw [List.append_assoc, List.take_append_drop, senderTake] private theorem mem_history_filterMap {log : List Entry} {start : Nat} @@ -2263,7 +2274,7 @@ private theorem configurationHistory_split (log : List Entry) (k : Nat) fun nodes => ({ index, nodes } : Configuration), ?_, ?_⟩ · unfold configurationHistory - conv_lhs => rw [split] + conv => lhs; rw [split] rw [List.zipIdx_append, List.filterMap_append] · intro configuration member have := mem_history_filterMap member @@ -2312,9 +2323,9 @@ private theorem length_filter_index_mono (configurations : List Configuration) : (configurations.filter fun configuration => configuration.index <= small).length <= (configurations.filter fun configuration => configuration.index <= large).length := by - apply List.Sublist.length_le - apply List.monotone_filter_right - intro configuration holds + simp only [← List.countP_eq_length_filter] + apply List.countP_mono_left + intro configuration _ holds simp at holds ⊢ exact Nat.le_trans holds le @@ -2353,7 +2364,8 @@ private theorem getElem_le_of_lt_length_filter {configurations : List Configurat : i < (configurations.filter fun configuration => configuration.index <= bound).length) - : (configurations[i]'(lt.trans_le (List.length_filter_le _ _))).index <= bound := by + : (configurations[i]'(Nat.lt_of_lt_of_le lt (List.length_filter_le _ _))).index + <= bound := by induction configurations generalizing i with | nil => simp at lt | cons head tail ih => @@ -2397,8 +2409,8 @@ private theorem chosen_bound {configurations : List Configuration} · simp at positive · simp only [chosen, Nat.eq_zero_of_not_pos counted, Nat.zero_sub, List.getElem_cons_zero] rcases List.mem_cons.mp member with rfl | later - · exact le_rfl - · exact ((List.pairwise_cons.mp sorted).1 other later).le + · exact Nat.le.refl + · exact Nat.le_of_lt ((List.pairwise_cons.mp sorted).1 other later) /-- Two logs agreeing up to `k`, with commit indices at most `k` and a configuration @@ -2419,7 +2431,8 @@ private theorem activeConfigurations_overlap {left right : List Entry} obtain ⟨leftRest, leftEq, leftLater⟩ := configurationHistory_split left k obtain ⟨rightRest, rightEq, rightLater⟩ := configurationHistory_split right k rw [agree] at leftEq - set common := configurationHistory (right.take k) + have sorted := configurationHistory_sorted (right.take k) + generalize configurationHistory (right.take k) = common at leftEq rightEq configured sorted ⊢ have commonPos : 0 < common.length := List.length_pos_iff.mpr configured have count : forall {log : List Entry} {rest commit}, configurationHistory log = common ++ rest @@ -2449,22 +2462,21 @@ private theorem activeConfigurations_overlap {left right : List Entry} rw [count leftEq leftLater leftLe, count rightEq rightLater rightLe] have leftBound := length_filter_le common leftCommit have rightBound := length_filter_le common rightCommit - have sorted := configurationHistory_sorted (right.take k) have last : common.length - 1 < common.length := Nat.sub_one_lt (Nat.ne_of_gt commonPos) rcases Nat.le_total leftCommit rightCommit with ordered | ordered · have mono := length_filter_index_mono common ordered have chosenLt := Nat.lt_of_le_of_lt (Nat.sub_le_sub_right rightBound 1) last refine ⟨common[_ - 1]'chosenLt, inDrop chosenLt leftEq (Nat.sub_le_sub_right mono 1), - inDrop chosenLt rightEq le_rfl, ?_⟩ + inDrop chosenLt rightEq Nat.le.refl, ?_⟩ rcases chosen_bound sorted rightCommit commonPos with within | first - · exact Or.inl (within.trans (Nat.le_max_right _ _)) + · exact Or.inl (Nat.le_trans within (Nat.le_max_right _ _)) · exact Or.inr first · have mono := length_filter_index_mono common ordered have chosenLt := Nat.lt_of_le_of_lt (Nat.sub_le_sub_right leftBound 1) last - refine ⟨common[_ - 1]'chosenLt, inDrop chosenLt leftEq le_rfl, + refine ⟨common[_ - 1]'chosenLt, inDrop chosenLt leftEq Nat.le.refl, inDrop chosenLt rightEq (Nat.sub_le_sub_right mono 1), ?_⟩ rcases chosen_bound sorted leftCommit commonPos with within | first - · exact Or.inl (within.trans (Nat.le_max_left _ _)) + · exact Or.inl (Nat.le_trans within (Nat.le_max_left _ _)) · exact Or.inr first /-- Two strict majorities of one configuration share a member. -/ @@ -2557,19 +2569,19 @@ private theorem rooted_overlap {root : Entry} have rooted : (right.take (max k 1)).take 1 = [root] := by rw [List.take_take, Nat.min_eq_left (Nat.le_max_right _ _), rightHead] obtain ⟨configuration, leftMember, rightMember, bound⟩ := - activeConfigurations_overlap agree' (leftLe.trans (Nat.le_max_left _ _)) - (rightLe.trans (Nat.le_max_left _ _)) + activeConfigurations_overlap agree' (Nat.le_trans leftLe (Nat.le_max_left _ _)) + (Nat.le_trans rightLe (Nat.le_max_left _ _)) (configurationHistory_ne_nil rooted configured) refine ⟨configuration, leftMember, rightMember, ?_⟩ rcases bound with within | first - · exact within.trans (Nat.le_max_left _ _) + · exact Nat.le_trans within (Nat.le_max_left _ _) · obtain ⟨rest, eq, _⟩ := configurationHistory_split (right.take (max k 1)) 1 obtain ⟨nodes, some⟩ := Option.isSome_iff_exists.mp configured have genesis : ({ index := 1, nodes } : Configuration) ∈ configurationHistory (right.take (max k 1)) := by rw [eq, rooted] simp [configurationHistory, some] - exact (first _ genesis).trans (Nat.le_max_right _ _) + exact Nat.le_trans (first _ genesis) (Nat.le_max_right _ _) /-- Quorums for two rooted logs agreeing on both committed prefixes share a voter; a configuration-bearing root supplies a common configuration. -/ @@ -2649,7 +2661,7 @@ private theorem CommitFrontier.extend {state : NodeState} (frontier : CommitFrontier state) {log : List Entry} (extends_ : state.log <+: log) : CommitFrontier { state with log } := by - refine ⟨frontier.1.trans extends_.length_le, fun positive => ?_⟩ + refine ⟨Nat.le_trans frontier.1 extends_.length_le, fun positive => ?_⟩ exact isSignatureAt_of_prefix extends_ (frontier.2 positive) private theorem CommitFrontier.keep {state : NodeState} @@ -2671,12 +2683,13 @@ private theorem CommitFrontier.advance {state : NodeState} state with log, commitIndex := max state.commitIndex (maxCommittableIndexUpTo log bound) } := by - refine ⟨max_le extends_.1 (maxCommittableIndexUpTo_le_length log bound), fun positive => ?_⟩ + refine ⟨Nat.max_le.mpr ⟨extends_.1, maxCommittableIndexUpTo_le_length log bound⟩, + fun positive => ?_⟩ simp only at positive ⊢ rcases Nat.le_total state.commitIndex (maxCommittableIndexUpTo log bound) with le | le - · rw [max_eq_right le] at positive ⊢ + · rw [Nat.max_eq_right le] at positive ⊢ exact maxCommittableIndexUpToPositiveIsSignature positive - · rw [max_eq_left le] at positive ⊢ + · rw [Nat.max_eq_left le] at positive ⊢ exact extends_.2 positive private theorem foldl_select_max (P : Nat -> Prop) [DecidablePred P] (values : List Nat) @@ -2695,9 +2708,9 @@ private theorem foldl_select_max (P : Nat -> Prop) [DecidablePred P] (values : L by_cases chosen : P head · rcases Nat.le_total init head with le | le · right - simp [chosen, max_eq_right le] + simp [chosen, Nat.max_eq_right le] · left - simp [chosen, max_eq_left le] + simp [chosen, Nat.max_eq_left le] · simp [chosen] · exact Or.inr holds @@ -3028,15 +3041,15 @@ open Model.Node private theorem Extends.committedLog {before after : NodeState} (extended : Extends before after) : before.committedLog <+: after.committedLog := - List.prefix_take_iff.mpr ⟨extended.2, (List.length_take_le _ _).trans extended.1⟩ + List.prefix_take_iff.mpr ⟨extended.2, Nat.le_trans (List.length_take_le _ _) extended.1⟩ private theorem Extends.refl (state : NodeState) : Extends state state := - ⟨le_rfl, List.take_prefix _ _⟩ + ⟨Nat.le.refl, List.take_prefix _ _⟩ private theorem Extends.trans {first second third : NodeState} (left : Extends first second) (right : Extends second third) : Extends first third := - ⟨left.1.trans right.1, left.committedLog.trans right.2⟩ + ⟨Nat.le_trans left.1 right.1, left.committedLog.trans right.2⟩ /-- Keeping the log below `count`, at or above the commit index, and committing no less extends the committed log. -/ @@ -3051,11 +3064,11 @@ private theorem Extends.of_prefix {before after : NodeState} {count : Nat} private theorem Extends.of_log {before after : NodeState} (logEq : after.log = before.log) (commitEq : after.commitIndex = before.commitIndex) : Extends before after := - ⟨commitEq.ge, logEq ▸ List.take_prefix _ _⟩ + ⟨Nat.le_of_eq commitEq.symm, logEq ▸ List.take_prefix _ _⟩ private theorem Extends.append {state : NodeState} (entry : Entry) : Extends state { state with log := state.log ++ [entry] } := - ⟨le_rfl, (List.take_prefix _ _).trans (List.prefix_append _ _)⟩ + ⟨Nat.le.refl, (List.take_prefix _ _).trans (List.prefix_append _ _)⟩ end Consensus.Proofs.Direct @@ -3074,7 +3087,7 @@ private theorem Extends.fromLeader obtain ⟨retired, role, known, eq, -⟩ := Ledger.handleAppendEntiresFromPrimary_eq self state request rw [eq] - exact ⟨le_max_left _ _, (List.take_prefix _ _).trans (List.prefix_append _ _)⟩ + exact ⟨Nat.le_max_left _ _, (List.take_prefix _ _).trans (List.prefix_append _ _)⟩ private theorem Extends.handleAppendEntriesRequest (caps : Caps) (source : NodeID) : Keeps (Extends state) @@ -3109,7 +3122,7 @@ private theorem Extends.handleAppendEntriesRequest (caps : Caps) (source : NodeI primaryKnown := true, log := current.log.take (index - 1), isNewFollower := false } := Extends.of_prefix (count := index - 1) - (Nat.le_trans within (Nat.le_sub_of_add_le this)) (List.prefix_refl _) le_rfl + (Nat.le_trans within (Nat.le_sub_of_add_le this)) (List.prefix_refl _) Nat.le.refl exact Keeps.seq' fun _ => Keeps.pure' ((stepped.trans truncated).trans Extends.fromLeader) end AppendEntries @@ -3170,7 +3183,7 @@ private theorem Extends.becomePrimary (state : NodeState) } := by split · exact Extends.of_prefix (by unfold lastCommittableIndex; exact Nat.le_max_left _ _) - (List.prefix_refl _) le_rfl + (List.prefix_refl _) Nat.le.refl · exact Extends.of_log rfl rfl exact Keeps.bind' (Extends.advanced caps self _) fun _ kept => Keeps.seq' fun _ => Keeps.pure' (promoted.trans kept) @@ -3407,8 +3420,8 @@ private theorem AEFrom.extend {self : NodeID} {term commit commit' : Nat} (le : commit <= commit') : AEFrom self term commit' log' envelope := by obtain ⟨source, target, request, payload, term, prev, prevTerm, entries, primaryCommit⟩ := sent - refine ⟨source, target, request, payload, term, prev.trans extends_.length_le, ?_, ?_, - primaryCommit.trans le⟩ + refine ⟨source, target, request, payload, term, Nat.le_trans prev extends_.length_le, ?_, ?_, + Nat.le_trans primaryCommit le⟩ · rw [prevTerm, termAt_of_prefix extends_ prev] · obtain ⟨rest, rfl⟩ := extends_ rw [List.drop_append_of_le_length prev] @@ -3553,7 +3566,7 @@ private theorem becomePrimary_sends (candidate : NodeState) have sentEq : leader.sentIndex peer = leader.log.length := by rw [advance.sentIndex, advance.log] simp [primaryState] - refine ⟨rfl, other, _, rfl, rfl, ?_, rfl, ?_, le_rfl⟩ <;> + refine ⟨rfl, other, _, rfl, rfl, ?_, rfl, ?_, Nat.le.refl⟩ <;> simp [makeAppendEntriesRequest, sentEq, messageEntries] · intro e member rcases List.mem_append.mp (by simpa using member) with old | new @@ -3700,7 +3713,7 @@ private theorem quiet_summary {self : NodeID} {before after : NodeState} /\ message.term <= after.currentTerm) (sends : forall e, e ∈ sent -> SendOK self before event after e) : Summary self before event after sent := by - refine ⟨term.ge, fun _ voted' votedEq => voted ▸ votedEq, fun either => ?_, + refine ⟨Nat.le_of_eq term.symm, fun _ voted' votedEq => voted ▸ votedEq, fun either => ?_, fun candidate => ⟨candidate, log, commit, Or.inr ⟨role ▸ candidate, term, Or.inl voted, fun voter member => Or.inl (votes ▸ member)⟩⟩, fun leader => Or.inl ⟨role ▸ leader, term⟩, @@ -3723,7 +3736,7 @@ private theorem bumped_summary {self : NodeID} {before after : NodeState} (sends : forall e, e ∈ sent -> SendOK self before event after e) : Summary self before event after sent := ⟨ - lt.le, + Nat.le_of_lt lt, fun same => (Nat.lt_irrefl _ (Nat.lt_of_lt_of_le lt (Nat.le_of_eq same))).elim, fun _ => Or.inr (Or.inr active), fun candidate => (notCandidate candidate).elim, @@ -3744,7 +3757,7 @@ private theorem observe_bumping (before : NodeState) {message : Message} cases message <;> simp_all [Bumping, observeTerm, updateTerm, becomeAwareOfNewTerm, bumpedState] · refine Or.inr ⟨Nat.not_lt.mp bump, ?_⟩ - cases message <;> simp_all [Bumping, observeTerm, updateTerm] + cases message <;> simp_all [Bumping, observeTerm, updateTerm, Nat.not_lt_of_le] end Consensus.Proofs.Safety @@ -3788,7 +3801,7 @@ private theorem checkQuorum_summary (state : NodeState) (input : Input) refine Sends.bind' Sends.guard' fun _ sent ⟨⟨leader, _⟩, empty⟩ => Sends.pure' ?_ subst empty refine ⟨ - le_rfl, + Nat.le.refl, fun _ voted eq => eq, fun _ => Or.inl (by rw [leader]; simp), fun c => by simp at c, @@ -3831,7 +3844,7 @@ private theorem sendEntries_summary (state : NodeState) (destination : NodeID) simp [eligiblePeers] at peer; exact peer.1 refine ⟨ rfl, - ⟨other, rfl, le.trans bound, rfl, ?_, le_rfl⟩, + ⟨other, rfl, Nat.le_trans le bound, rfl, ?_, Nat.le.refl⟩, by simp [leader], Or.inl ⟨leader, rfl⟩ ⟩ @@ -3853,7 +3866,7 @@ private theorem startElection_summary (state : NodeState) campaign_summary (fresh_campaign notNone rfl rfl rfl) result · refine Sends.bind' (broadcast_sends self _ _) fun _ sent requests => Sends.pure' ?_ simp only [List.append_nil] - refine ⟨le_rfl, fun _ voted eq => eq, fun _ => Or.inl notNone, fun c => by simp at c, + refine ⟨Nat.le.refl, fun _ voted eq => eq, fun _ => Or.inl notNone, fun c => by simp at c, fun c => by simp at c, fun c => by simp at c, Kind.same rfl rfl, fun e member => ?_⟩ obtain ⟨source, _, payload⟩ := requests e member refine ⟨source, ?_⟩ @@ -3877,7 +3890,7 @@ private theorem voteRequest_summary (before : NodeState) (source : NodeID) Event.receive source (Message.requestVoteRequest request) = (Event.receive source' message : Event) /\ Bumping message /\ message.term <= (bumpedState before request.term).currentTerm := - ⟨source, _, rfl, trivial, le_refl _⟩ + ⟨source, _, rfl, trivial, Nat.le.refl⟩ split <;> rename_i granted <;> simp only [decide_eq_true_eq] at granted · refine bumped_summary bump (by simp [bumpedState]) (by simp [bumpedState]) active (Kind.same rfl rfl) fun e member => ?_ @@ -3898,7 +3911,7 @@ private theorem voteRequest_summary (before : NodeState) (source : NodeID) /\ Bumping message /\ message.term <= before.currentTerm := ⟨source, _, rfl, trivial, le⟩ split <;> rename_i granted <;> simp only [decide_eq_true_eq] at granted - · refine ⟨le_rfl, fun _ voted votedEq => ?_, fun _ => Or.inr (Or.inr active), + · refine ⟨Nat.le.refl, fun _ voted votedEq => ?_, fun _ => Or.inr (Or.inr active), fun candidate => ⟨candidate, rfl, rfl, Or.inr ⟨candidate, rfl, ?_, fun voter member => Or.inl member⟩⟩, fun leader => Or.inl ⟨leader, rfl⟩, fun _ _ _ _ => Or.inl rfl, Kind.same rfl rfl, @@ -3933,7 +3946,7 @@ private theorem preVoteRequest_summary (before : NodeState) (source : NodeID) refine Sends.bind' (Sends.send _ _ _) fun _ sent eq => Sends.pure' ?_ <;> subst eq · refine bumped_summary bump (by simp [bumpedState]) (by simp [bumpedState]) - ⟨source, _, rfl, trivial, le_refl _⟩ (Kind.same rfl rfl) fun e member => ?_ + ⟨source, _, rfl, trivial, Nat.le.refl⟩ (Kind.same rfl rfl) fun e member => ?_ simp only [List.mem_singleton, List.append_nil] at member subst member exact ⟨rfl, rfl⟩ @@ -4001,7 +4014,7 @@ private theorem voteResponse_summary (before : NodeState) (source : NodeID) with ⟨bump, eq⟩ | ⟨le, eq⟩ <;> rw [eq] <;> simp only [handleRequestVoteResponse] · refine Sends.ite' (fun won => absurd won.1 (by simp [bumpedState])) fun _ => Sends.pure' (bumped_summary bump (by simp [bumpedState]) (by simp [bumpedState]) - ⟨source, _, rfl, trivial, le_refl _⟩ (Kind.same rfl rfl) (by simp)) + ⟨source, _, rfl, trivial, Nat.le.refl⟩ (Kind.same rfl rfl) (by simp)) · refine Sends.ite' (fun won => ?_) fun _ => Sends.pure' (quiet_summary rfl rfl rfl rfl rfl rfl rfl (fun empty => (empty rfl).elim) (by simp)) @@ -4033,7 +4046,7 @@ private theorem preVoteResponse_summary (before : NodeState) (source : NodeID) with ⟨bump, eq⟩ | ⟨le, eq⟩ <;> rw [eq] <;> simp only [handleRequestPreVoteResponse] · refine Sends.ite' (fun won => absurd won.1 (by simp [bumpedState])) fun _ => Sends.pure' (bumped_summary bump (by simp [bumpedState]) (by simp [bumpedState]) - ⟨source, _, rfl, trivial, le_refl _⟩ (Kind.same rfl rfl) (by simp)) + ⟨source, _, rfl, trivial, Nat.le.refl⟩ (Kind.same rfl rfl) (by simp)) · refine Sends.ite' (fun won => ?_) fun _ => Sends.pure' (quiet_summary rfl rfl rfl rfl rfl rfl rfl (fun empty => (empty rfl).elim) (by simp)) @@ -4078,7 +4091,7 @@ private theorem appendEntriesResponse_summary (before : NodeState) (source : Nod simp only [handleAppendEntriesResponse] · refine Sends.ite' (fun _ => Sends.pure' ?_) fun notFollower => absurd notFollower (by simp [bumpedState]) - refine ⟨bump.le, + refine ⟨Nat.le_of_lt bump, fun same => (Nat.lt_irrefl _ (Nat.lt_of_lt_of_le bump (Nat.le_of_eq same))).elim, fun _ => Or.inl (by rw [leader]; simp), fun c => by simp [bumpedState] at c, fun c => by simp [bumpedState] at c, fun c => by simp [bumpedState] at c, @@ -4101,7 +4114,7 @@ private theorem appendEntriesResponse_summary (before : NodeState) (source : Nod refine Sends.mono (advanceCommit_sends self _) fun after sent ⟨advance, nominated⟩ => ?_ have notCandidate : Not (after.role = .candidate) := by rcases advance.role with eq | eq <;> rw [eq] <;> simp [leader] - refine ⟨advance.term.ge, fun _ voted eq => by rw [advance.votedFor]; exact eq, + refine ⟨Nat.le_of_eq advance.term.symm, fun _ voted eq => by rw [advance.votedFor]; exact eq, fun _ => Or.inl (by rw [leader]; simp), fun c => (notCandidate c).elim, fun _ => Or.inl ⟨leader, advance.term⟩, fun _ _ _ peer => ?_, Kind.ack source response rfl leader success term advance, fun e member => ?_⟩ @@ -4109,7 +4122,7 @@ private theorem appendEntriesResponse_summary (before : NodeState) (source : Nod by_cases same : peer = source · subst same simp only [Function.update_self] - rcases max_choice (before.matchIndex peer) response.lastLogIndex with eq | eq <;> + rcases Std.max_eq_or (a := before.matchIndex peer) (b := response.lastLogIndex) with eq | eq <;> rw [eq] · exact Or.inl rfl · exact Or.inr ⟨response, rfl, success, term, rfl⟩ @@ -4206,8 +4219,10 @@ private theorem aeReply (self source : NodeID) (z : NodeState) (role : after.role = w.role \/ after.role = .none) (cand : after.role = .candidate -> after = w) => (⟨term.trans wTerm, voted.trans wVoted, matchEq.trans wMatch, - by rcases role with role | role <;> rw [role] <;> [rcases wRole with r | r; skip] <;> - simp [*], + by + rcases role with role | role <;> rw [role] + · rcases wRole with r | r <;> simp [*] + · simp [*], fun c => (cand c).trans (wCand (by rcases role with role | role <;> rw [role] at c · exact c @@ -4328,19 +4343,19 @@ private theorem appendEntriesRequest_summary (self : NodeID) (before : NodeState simp only [receive] rcases observe_bumping before (message := .appendEntriesRequest request) trivial with ⟨bump, eq⟩ | ⟨le, eq⟩ <;> rw [eq] - · refine Sends.mono (aeReply self source _ request (le_refl _)) fun after sent reply => ?_ + · refine Sends.mono (aeReply self source _ request (Nat.le.refl)) fun after sent reply => ?_ obtain ⟨kind, sends⟩ := aeReply_summary (before := before) (z := bumpedState before request.term) rfl rfl - bump.le reply + (Nat.le_of_lt bump) reply obtain ⟨term, _, _, role, _, _⟩ := reply have follower : after.role = .follower \/ after.role = .none := by rcases role with eq | eq | eq <;> rw [eq] <;> simp [bumpedState] exact bumped_summary (term ▸ bump) (by rcases follower with f | f <;> simp [f]) (by rcases follower with f | f <;> simp [f]) - ⟨source, _, rfl, trivial, term ▸ le_refl _⟩ kind sends + ⟨source, _, rfl, trivial, term ▸ Nat.le.refl⟩ kind sends · refine Sends.mono (aeReply self source _ request le) fun after sent reply => ?_ - obtain ⟨kind, sends⟩ := aeReply_summary (before := before) rfl rfl le_rfl reply + obtain ⟨kind, sends⟩ := aeReply_summary (before := before) rfl rfl Nat.le.refl reply obtain ⟨term, voted, matchEq, role, cand, _⟩ := reply - refine ⟨term.ge, fun _ voted' eq => voted ▸ eq, + refine ⟨Nat.le_of_eq term.symm, fun _ voted' eq => voted ▸ eq, fun _ => Or.inr (Or.inr ⟨source, _, rfl, trivial, term ▸ le⟩), fun c => ?_, fun leader => ?_, fun _ _ _ peer => Or.inl (congrFun matchEq peer), kind, sends⟩ · have eq := cand c @@ -4360,7 +4375,7 @@ private theorem BatchState.push {self : NodeID} {before state : NodeState} obtain ⟨⟨entries, sentIndex, rfl, terms⟩, beats⟩ := batch refine ⟨ ⟨entries ++ [{ term := before.currentTerm, content }], sentIndex, by simp, ?_⟩, - fun e member => (beats e member).extend (List.prefix_append _ _) le_rfl + fun e member => (beats e member).extend (List.prefix_append _ _) Nat.le.refl ⟩ intro entry member rcases List.mem_append.mp member with old | new @@ -4391,9 +4406,9 @@ private theorem appendEntry_batch (self : NodeID) (before : NodeState) · refine Sends.bind' (Sends.send _ _ _) fun _ sent eq => Sends.pure' fun e member' => ?_ simp only [eq, List.append_nil, List.mem_singleton] at member' subst member' - have added := (Finset.mem_sort _).mp member + have added := Finset.mem_sort.mp member have other : Not (peer = self) := (Finset.mem_erase.mp added).1 - refine ⟨rfl, other, _, rfl, rfl, ?_, ?_, ?_, le_rfl⟩ <;> + refine ⟨rfl, other, _, rfl, rfl, ?_, ?_, ?_, Nat.le.refl⟩ <;> simp only [makeAppendEntriesRequest, ite_eq_left added, messageEntries] <;> simp · have batch : BatchState self before { before with @@ -4425,7 +4440,7 @@ private theorem sendEntries_batch (self : NodeID) (before state : NodeState) · simp only [eq, List.mem_singleton] at new subst e have other : Not (destination = self) := (Finset.mem_erase.mp peer).1 - exact ⟨rfl, other, _, rfl, rfl, le.trans bound, rfl, List.take_prefix _ _, le_rfl⟩ + exact ⟨rfl, other, _, rfl, rfl, Nat.le_trans le bound, rfl, List.take_prefix _ _, Nat.le.refl⟩ private theorem appendBatch_summary (self : NodeID) (state : NodeState) (contents : List AppendEntryInput) @@ -4461,7 +4476,7 @@ private theorem appendBatch_summary (self : NodeID) (state : NodeState) have commit : state.commitIndex <= after.commitIndex := by have := advance.commit_le; rw [eq] at this; exact this refine ⟨ - term.ge, + Nat.le_of_eq term.symm, fun _ voted votedEq => by rw [advance.votedFor, eq]; exact votedEq, fun _ => Or.inl (by rw [leader]; simp), fun c => by rcases role with r | r <;> simp [r] at c, @@ -4634,7 +4649,7 @@ private theorem Seen.cons {current : Model.State} {rest : History} private theorem suffix_comparable {α : Type} {first second whole : List α} (left : first <:+ whole) (right : second <:+ whole) : first <:+ second \/ second <:+ first := by - rcases le_total first.length second.length with le | le + rcases Nat.le_total first.length second.length with le | le · exact Or.inl (List.suffix_of_suffix_length_le left right le) · exact Or.inr (List.suffix_of_suffix_length_le right left le) @@ -4729,9 +4744,11 @@ private theorem inv_initial : Inv [initial] := by · intro node state now active rw [stateOf now] at active ⊢ simp only [initialLocal] at active ⊢ - split_ifs at active ⊢ <;> simp_all [BOOTSTRAP_TERM] + by_cases primary : node = INITIAL_PRIMARY <;> by_cases member : node ∈ INITIAL_CONFIGURATION + <;> simp_all [BOOTSTRAP_TERM] · intro node state earlier now seen rw [stateOf now, initial_seen initialized seen] + exact Nat.le_refl _ · intro node state earlier candidate now seen voted rw [initial_seen initialized seen] at voted simp [initialLocal] at voted @@ -4751,7 +4768,8 @@ private theorem inv_initial : Inv [initial] := by · intro node state now candidate rw [stateOf now] at candidate simp only [initialLocal] at candidate - split_ifs at candidate + by_cases primary : node = INITIAL_PRIMARY <;> by_cases member : node ∈ INITIAL_CONFIGURATION + <;> simp [primary, member] at candidate · intro after before rest node term log commit suffix have := suffix.length_le simp at this @@ -4761,6 +4779,7 @@ private theorem inv_initial : Inv [initial] := by obtain ⟨-, rfl⟩ := led_single led refine ⟨fun log canon => ?_, fun log commit elected => absurd elected not_elected_single⟩ rw [(initial_canon initialized canon).2, stateOf now] + exact List.prefix_refl _ · intro node state index now positive bound rw [stateOf now] at bound ⊢ by_cases isLeader : node = INITIAL_PRIMARY @@ -4909,9 +4928,9 @@ private theorem termAt_mono {log : List Entry} rcases Nat.eq_zero_or_pos i with rfl | positive · rw [termAt_zero] exact Nat.zero_le _ - rw [termAt_eq positive (le.trans bound), termAt_eq (Nat.lt_of_lt_of_le positive le) bound] + rw [termAt_eq positive (Nat.le_trans le bound), termAt_eq (Nat.lt_of_lt_of_le positive le) bound] rcases Nat.eq_or_lt_of_le le with rfl | lt - · exact le_rfl + · exact Nat.le.refl · exact List.pairwise_iff_getElem.mp sorted _ _ _ _ (Nat.sub_lt_sub_right (Nat.succ_le_of_lt positive) lt) @@ -4949,7 +4968,7 @@ private theorem take_signature {log : List Entry} {index : Nat} (signature : isSignatureAt log index = true) : isSignatureAt (log.take index) (log.take index).length = true := by rw [List.length_take, Nat.min_eq_left (signature_bound signature)] - exact isSignatureAt_take_of_le le_rfl signature + exact isSignatureAt_take_of_le Nat.le.refl signature private theorem Led.two_le {history : History} {node : NodeID} {term : Nat} (led : Led history node term) @@ -5099,7 +5118,7 @@ private theorem Committed.signature {history : History} {term : Nat} _⟩ := committed.shape refine ⟨take_signature signature, ?_, led.two_le⟩ rw [List.length_take, Nat.min_eq_left (signature_bound signature), - termAt_take le_rfl, termEq] + termAt_take Nat.le.refl, termEq] /-- A part committed in a term is in every later leader log. -/ private theorem committed_in_canon {history : History} (complete : Completeness history) @@ -5142,7 +5161,7 @@ private theorem committed_comparable {history : History} · exact comparable_of_prefix (List.take_prefix _ _) ((List.take_prefix _ _).trans sub) · exact comparable_of_prefix (committed_in_canon complete mono committed canon' lt) (List.take_prefix _ _) - rcases le_total first second with le | le + rcases Nat.le_total first second with le | le · exact inCanon leftCommitted rightCommitted le · exact (inCanon rightCommitted leftCommitted le).symm @@ -5177,7 +5196,7 @@ private theorem Wins.facts {self : NodeID} {before' : NodeState} {event : Event} rw [← this] exact quorum rcases advance with rfl | ⟨log, term, voted, matchEq, _, _, lt, _, role⟩ - · exact ⟨rfl, rfl, rfl, fun _ => rfl, Or.inl rfl, le_rfl⟩ + · exact ⟨rfl, rfl, rfl, fun _ => rfl, Or.inl rfl, Nat.le.refl⟩ · refine ⟨log, term, voted, fun peer => by rw [matchEq]; rfl, ?_, ?_⟩ · rcases role with role | role · exact Or.inl role @@ -5386,11 +5405,11 @@ private theorem vals_upToDate {state : NodeState} (term : Nat) : voteLogUpToDate state (vals term state.log state.commitIndex) := by have mono : maxCommittableTerm state.log <= termAt state.log (max state.commitIndex (maxCommittableIndex state.log)) := - termAt_mono sorted (le_max_right _ _) - (max_le frontier (maxCommittableIndexBounded state.log)) + termAt_mono sorted (Nat.le_max_right _ _) + (Nat.max_le.mpr ⟨frontier, maxCommittableIndexBounded state.log⟩) rcases Nat.lt_or_eq_of_le mono with lt | eq · exact Or.inl lt - · exact Or.inr ⟨eq.symm, le_max_right _ _⟩ + · exact Or.inr ⟨eq.symm, Nat.le_max_right _ _⟩ end Consensus.Proofs.Safety @@ -5443,8 +5462,8 @@ private theorem accept_shape {source : NodeID} {request : AppendEntriesRequest} obtain ⟨_, _, _, followerBound, termEq, logEq, _⟩ := accepted have senderSeen : Seen (before :: rest) source sender := canon.1.seen.mono suffix have batchBound : request.prevLogIndex + request.entries.length <= sender.log.length := by - exact (Nat.add_le_add_left (Nat.le_trans entries.length_le (Nat.le_of_eq List.length_drop)) - _).trans (Nat.le_of_eq (Nat.add_sub_of_le prevBound)) + exact Nat.le_trans (Nat.add_le_add_left (Nat.le_trans entries.length_le (Nat.le_of_eq List.length_drop)) + _) (Nat.le_of_eq (Nat.add_sub_of_le prevBound)) have match' : forall j, 0 < j -> j <= c.pre.log.length -> j <= sender.log.length -> termAt c.pre.log j = termAt sender.log j -> c.pre.log.take j = sender.log.take j := fun _ positive left right same => @@ -5528,10 +5547,10 @@ private theorem terms : Terms (after :: before :: rest) := by have preTerms := c.inv.terms c.actor c.pre c.pre_now rcases c.post_log with sub | ⟨entries, log, terms, _, term, _⟩ | ⟨earlier, source, sender, n, suffix, canon, _, log⟩ - · exact (preTerms entry (sub.subset mem)).trans le + · exact Nat.le_trans (preTerms entry (sub.subset mem)) le · rw [log] at mem rcases List.mem_append.mp mem with old | new - · exact (preTerms entry old).trans le + · exact Nat.le_trans (preTerms entry old) le · rw [terms entry new] exact le · rw [log] at mem @@ -5553,6 +5572,7 @@ private theorem sorted : Sorted (after :: before :: rest) := by refine ⟨c.pre_sorted, ?_, ?_⟩ · exact List.pairwise_of_forall_mem_list fun first firstMem second secondMem => by rw [terms first firstMem, terms second secondMem] + exact Nat.le_refl _ · intro first firstMem second secondMem rw [terms second secondMem] exact preTerms first firstMem @@ -5572,8 +5592,8 @@ private theorem term_mono : TermMono (after :: before :: rest) := by intro node state earlier now seen rcases c.now_after now with ⟨rfl, rfl⟩ | ⟨different, old⟩ · rcases c.seen_after seen with seen | ⟨_, rfl⟩ - · exact (c.inv.term_mono c.actor c.pre earlier c.pre_now seen).trans c.term_le - · exact le_rfl + · exact Nat.le_trans (c.inv.term_mono c.actor c.pre earlier c.pre_now seen) c.term_le + · exact Nat.le.refl · rcases c.seen_after seen with seen | ⟨same, _⟩ · exact c.inv.term_mono node state earlier old seen · exact absurd same different @@ -5690,7 +5710,7 @@ private theorem wins_elect (wins : Wins c.actor c.pre c.event c.post) · rw [candidateLog] exact take_prefix_take _ (by simp only [lastCommittableIndex, candidateLog] - exact le_max_right _ _) + exact Nat.le_max_right _ _) · rw [candidateLog] exact List.take_prefix _ _ · intro voter mem @@ -5781,6 +5801,7 @@ private theorem suffix_of_cons_suffix {α : Type} {x y : α} {first second : Lis : first <:+ second := by rcases List.suffix_cons_iff.mp suffix with same | inner · rw [(List.cons.inj same).2] + exact List.suffix_refl _ · exact (List.suffix_cons _ _).trans inner /-- A state with a lower term than one at `a` was seen before `a`. -/ @@ -5844,7 +5865,7 @@ private theorem core {small large : History} (within : small <:+ large) by_cases covered : index <= commit · have agreeIndex : state.log.take index = log.take index := by have := congrArg (List.take index) agree - rwa [List.take_take, List.take_take, Nat.min_eq_left (covered.trans commitLe)] at this + rwa [List.take_take, List.take_take, Nat.min_eq_left (Nat.le_trans covered commitLe)] at this rw [agreeIndex] exact List.take_prefix _ _ obtain ⟨voter, ackMem, voteMem⟩ := @@ -5864,13 +5885,13 @@ private theorem core {small large : History} (within : small <:+ large) have partLength : (state.log.take index).length = index := by rw [List.length_take, Nat.min_eq_left indexLe] have partSignature : isSignatureAt (state.log.take index) index = true := - isSignatureAt_take_of_le le_rfl signature + isSignatureAt_take_of_le Nat.le.refl signature have partTerm : termAt (state.log.take index) index = term := by - rw [termAt_take le_rfl, termAtIndex] + rw [termAt_take Nat.le.refl, termAtIndex] have ackerTake : acker.log.take index = state.log.take index := (take_of_prefix_length ackerLog partLength).symm have ackerTerm' : termAt acker.log index = term := by - rw [termAt_of_prefix ackerLog partLength.ge, partTerm] + rw [termAt_of_prefix ackerLog (Nat.le_of_eq partLength.symm), partTerm] -- The granting state holds the part. have inGranting : state.log.take index <+: granting.log := by rcases persist _ innerB (List.cons_ne_nil _ _) voter granting acker index grantingMem ackerB @@ -5889,15 +5910,15 @@ private theorem core {small large : History} (within : small <:+ large) signatureIndex_le_maxCommittableIndex grantingSignature have maxTermGe : term <= maxCommittableTerm granting.log := by have := termAt_mono grantingSorted maxGe (maxCommittableIndexBounded granting.log) - rw [termAt_of_prefix inGranting partLength.ge, partTerm] at this + rw [termAt_of_prefix inGranting (Nat.le_of_eq partLength.symm), partTerm] at this exact this -- The election's last committable position. simp only [voteLogUpToDate, vals] at upToDate - set j := max commit (maxCommittableIndex log) with jEq + generalize jEq : max commit (maxCommittableIndex log) = j at upToDate ⊢ have two : 2 <= term := by have := leaderLed.two_le exact this - have jBound : j <= log.length := max_le frontier (maxCommittableIndexBounded log) + have jBound : j <= log.length := jEq ▸ Nat.max_le.mpr ⟨frontier, maxCommittableIndexBounded log⟩ have termGe : term <= termAt log j := upToDate.elim (fun gt => Nat.le_trans maxTermGe (Nat.le_of_lt gt)) (fun eq => Nat.le_trans maxTermGe (Nat.le_of_eq eq.1.symm)) @@ -5933,11 +5954,11 @@ private theorem core {small large : History} (within : small <:+ large) · exfalso have leaderSorted := sorted _ commitSuffix (List.cons_ne_nil _ _) leader state leaderNow have partSorted := leaderSorted.sublist (List.take_sublist index state.log) - have mono := termAt_mono partSorted short.le partLength.ge + have mono := termAt_mono partSorted (Nat.le_of_lt short) (Nat.le_of_eq partLength.symm) have atJ : termAt (state.log.take index) j = termAt log j := by rw [← termAt_of_prefix sub (Nat.le_of_lt (Nat.lt_of_lt_of_eq short partLength.symm)), - ← termAt_take (n := j) le_rfl, ← anchoredTake, - termAt_take le_rfl] + ← termAt_take (n := j) Nat.le.refl, ← anchoredTake, + termAt_take Nat.le.refl] rw [atJ, partTerm] at mono exact Nat.lt_irrefl _ (Nat.lt_of_lt_of_le above mono) · exact viaAnchor long (Nat.le_trans long anchoredLength) @@ -5981,15 +6002,15 @@ private theorem agree_or_contained {α : Type} {state log : List α} /\ (state.take index <+: part \/ part <+: state.take index)) : state.take index <+: log \/ exists k, state.take k = log.take k /\ base <= k /\ commit <= k := by - rcases le_or_gt commit base with le | lt + rcases (Nat.lt_or_ge base commit).symm with le | lt · exact Or.inr ⟨base, take_of_prefix_length (low le) - (List.length_take_of_le (Nat.le_trans baseLe indexLe)), le_rfl, le⟩ + (List.length_take_of_le (Nat.le_trans baseLe indexLe)), Nat.le.refl, le⟩ · obtain ⟨part, inPart, comparable⟩ := high lt have commitLength : (log.take commit).length = commit := List.length_take_of_le frontier have partLong : commit <= part.length := commitLength ▸ inPart.length_le have indexLength : (state.take index).length = index := List.length_take_of_le indexLe - rcases le_or_gt commit index with le | short - · refine Or.inr ⟨commit, ?_, lt.le, le_rfl⟩ + rcases (Nat.lt_or_ge index commit).symm with le | short + · refine Or.inr ⟨commit, ?_, Nat.le_of_lt lt, Nat.le.refl⟩ calc state.take commit = (state.take index).take commit := by rw [List.take_take, Nat.min_eq_left le] @@ -6116,7 +6137,7 @@ private theorem new_old_unique {node other : NodeID} {term commit : Nat} quorum', granted'⟩ := elect' have agreement : exists k, log.take k = log'.take k /\ commit <= k /\ commit' <= k := by rcases Nat.le_total commit' commit with le | le - · refine ⟨commit, ?_, le_rfl, le⟩ + · refine ⟨commit, ?_, Nat.le.refl, le⟩ rcases c.elect_backed after before rest node term log commit (List.suffix_refl _) elect with zero | ⟨_, part, committed, below, inPart⟩ · rw [zero, List.take_zero, List.take_zero] @@ -6125,7 +6146,7 @@ private theorem new_old_unique {node other : NodeID} {term commit : Nat} (Nat.lt_of_le_of_lt below (Nat.sub_lt (Nat.lt_of_lt_of_le (Nat.zero_lt_succ 2) three) Nat.one_pos)) exact take_of_prefix_length (inPart.trans this) (List.length_take_of_le frontier) - · refine ⟨commit', ?_, le, le_rfl⟩ + · refine ⟨commit', ?_, le, Nat.le.refl⟩ rcases c.inv.elect_backed a b r other term log' commit' suffix elect' with zero | ⟨_, part, committed, below, inPart⟩ · rw [zero, List.take_zero, List.take_zero] @@ -6157,11 +6178,11 @@ private theorem keep_log (sameTerm : c.post.currentTerm = c.pre.currentTerm) (led : Led (before :: rest) c.actor c.pre.currentTerm) : c.pre.log <+: c.post.log := by cases Summary.kind c.sum with - | same log _ => rw [log] + | same log _ => rw [log]; exact List.prefix_refl _ | append _ _ _ _ advance => rw [(Advance.facts advance).1] exact List.prefix_append _ _ - | ack _ _ _ _ _ _ advance => rw [(Advance.facts advance).1] + | ack _ _ _ _ _ _ advance => rw [(Advance.facts advance).1]; exact List.prefix_refl _ | accept source request eq accepted => exfalso obtain ⟨earlier, _, suffix, canon, aeok, _⟩ := c.accept_shape eq accepted @@ -6217,6 +6238,7 @@ private theorem canon_mono : CanonMono (after :: before :: rest) := by have := safety node' node _ led' led subst this rw [now_unique c.exec now' now] + exact List.prefix_refl _ rcases c.now_after now with ⟨rfl, rfl⟩ | ⟨different, old⟩ · have fromOld : Led (before :: rest) c.actor c.post.currentTerm -> c.pre.log <+: c.post.log /\ CanonMono (before :: rest) @@ -6268,13 +6290,13 @@ private theorem anchor : Anchor (after :: before :: rest) := by c.inv.anchor c.actor c.pre index c.pre_now positive within have same := take_eq_take_of_comparable comparable within bound have termSame : termAt c.post.log index = termAt c.pre.log index := by - rw [← termAt_take (n := index) le_rfl, ← same, termAt_take le_rfl] + rw [← termAt_take (n := index) Nat.le.refl, ← same, termAt_take Nat.le.refl] rw [termSame, ← same] exact ⟨log, canon.mono c.suffix_tail, length, take⟩ rcases c.post_log with sub | ⟨entries, log, terms, leader, term, notCandidate⟩ | ⟨earlier, source, sender, n, suffix, canon, _, log⟩ - · exact viaPre (Or.inr sub) (bound.trans sub.length_le) - · rcases le_or_gt index c.pre.log.length with within | above + · exact viaPre (Or.inr sub) (Nat.le_trans bound sub.length_le) + · rcases (Nat.lt_or_ge c.pre.log.length index).symm with within | above · exact viaPre (Or.inl (log ▸ List.prefix_append _ _)) within · have termEq : termAt c.post.log index = c.post.currentTerm := by rw [log] at bound ⊢ @@ -6291,7 +6313,7 @@ private theorem anchor : Anchor (after :: before :: rest) := by obtain ⟨_, _, rfl⟩ := canon.1.nonempty obtain ⟨anchored, anchoredCanon, length, take⟩ := c.anchors _ suffix (List.cons_ne_nil _ _) source sender index canon.1 positive - (bound.trans (by simp)) + (Nat.le_trans bound (by simp [Nat.min_le_right])) refine ⟨anchored, ?_, length, ?_⟩ · rw [termAt_take short] exact anchoredCanon.mono (suffix.trans c.suffix_tail) @@ -6319,7 +6341,7 @@ private theorem new_in_elected {leader : NodeID} {state : NodeState} have partSignature := take_signature signature have two : 2 <= state.currentTerm := leaderLed.two_le intro later - induction later using Nat.strong_induction_on with + induction later using Nat.strongRecOn with | _ later ih => intro node log commit elected lt obtain ⟨a, b, r, electSuffix, elect⟩ := elected @@ -6383,7 +6405,7 @@ private theorem new_in_elected {leader : NodeID} {state : NodeState} have leaderCanon : Canon (after :: before :: rest) state.currentTerm state.log := ⟨_, List.suffix_refl _, leader, state, ⟨leaderNow, rfl, leaderRole, leaderLed⟩, rfl⟩ - rcases lt_trichotomy earlier state.currentTerm with lower | rfl | higher + rcases Nat.lt_trichotomy earlier state.currentTerm with lower | rfl | higher · obtain ⟨log'', commit'', elected''⟩ := leaderLed.elected (Nat.lt_of_le_of_lt (committed.signature).2.2 lower) have inLog := c.old_complete (committed.mono innerH) elected'' lower @@ -6483,7 +6505,7 @@ private theorem acked_pre (leader : c.pre.role = .primary) {voter : NodeID} {ind cases h have inLog := (c.inv.canon_mono c.actor c.pre c.pre_now notCandidate (c.pre_led leader)).1 log canon - refine ⟨acker, seen.mono c.suffix_tail, termEq, bound.trans inLog.length_le, ?_⟩ + refine ⟨acker, seen.mono c.suffix_tail, termEq, Nat.le_trans bound inLog.length_le, ?_⟩ rw [take_eq_of_prefix inLog bound] exact sub @@ -6530,7 +6552,7 @@ private theorem advance_backed {middle : NodeState} cases h have step : CommitStep (after :: before :: rest) c.actor c.post c.post.currentTerm middle.commitIndex c.post.commitIndex := by - refine ⟨⟨c.post_now, rfl, notCandidate, led⟩, lt.le, ?_, ?_, ?_, voters, ?_, ?_⟩ + refine ⟨⟨c.post_now, rfl, notCandidate, led⟩, Nat.le_of_lt lt, ?_, ?_, ?_, voters, ?_, ?_⟩ · rw [log, eq] exact bound · rw [log, eq] @@ -6554,7 +6576,7 @@ private theorem advance_backed {middle : NodeState} · rw [zero] at step exact .fresh step · exact .chained step backing le within - exact Or.inr ⟨_, _, committed, le_rfl, List.prefix_refl _⟩ + exact Or.inr ⟨_, _, committed, Nat.le.refl, List.prefix_refl _⟩ private theorem pre_backed (agree : c.post.log.take c.pre.commitIndex = c.pre.log.take c.pre.commitIndex) @@ -6581,8 +6603,8 @@ private theorem accept_backed {source : NodeID} {request : AppendEntriesRequest} c.accept_shape received accepted obtain ⟨requestTerm, _, commitLe, _, _, _, commitEq⟩ := accepted rw [commitEq] - rcases max_choice c.pre.commitIndex - (maxCommittableIndexUpTo c.post.log + rcases Std.max_eq_or (a := c.pre.commitIndex) + (b := maxCommittableIndexUpTo c.post.log (min request.primaryCommit (request.prevLogIndex + request.entries.length))) with choice | choice <;> rw [choice] · refine (c.pre_backed ?_).mono c.suffix_tail @@ -6662,7 +6684,7 @@ private theorem commit_backed : CommitBacked (after :: before :: rest) := by by_cases fromSource : voter = source · subst fromSource rw [Function.update_self] at positive ⊢ - rcases max_choice (c.pre.matchIndex voter) response.lastLogIndex with + rcases Std.max_eq_or (a := c.pre.matchIndex voter) (b := response.lastLogIndex) with choice | choice <;> rw [choice] at positive ⊢ · obtain ⟨acker, seen, ackerTerm, _, sub⟩ := c.match_pre leader different positive exact ⟨acker, seen, ackerTerm, sub⟩ @@ -6723,21 +6745,21 @@ private theorem accept_persist {source : NodeID} {request : AppendEntriesRequest intro long agree apply differ rw [← agree] - exact take_eq_of_prefix inPre long.le + exact take_eq_of_prefix inPre (Nat.le_of_lt long) by_cases inSender : part <+: sender.log - · rcases le_or_gt part.length n with short | long + · rcases (Nat.lt_or_ge n part.length).symm with short | long · left have := take_prefix_take sender.log short rw [← List.prefix_iff_eq_take.mp inSender] at this rw [fresh] exact this - · exact (beyond long (take_eq_of_prefix inSender long.le).symm).elim + · exact (beyond long (take_eq_of_prefix inSender (Nat.le_of_lt long)).symm).elim · have positive := signature_pos signature have termLe : termAt part part.length <= c.post.currentTerm := - (termAt_le_of_mem (fun entry mem => c.inv.terms c.actor c.pre c.pre_now entry - (inPre.subset mem)) _).trans c.term_le + Nat.le_trans (termAt_le_of_mem (fun entry mem => c.inv.terms c.actor c.pre c.pre_now entry + (inPre.subset mem)) _) c.term_le rcases Nat.lt_or_ge (termAt part part.length) c.post.currentTerm with lower | upper - · exact Or.inr ⟨c.post.currentTerm, sender.log, lower, le_rfl, + · exact Or.inr ⟨c.post.currentTerm, sender.log, lower, Nat.le.refl, senderCanon.mono c.suffix_tail, inSender⟩ · exfalso obtain ⟨log, logCanon, length, take⟩ := @@ -6745,13 +6767,13 @@ private theorem accept_persist {source : NodeID} {request : AppendEntriesRequest have partEq : c.pre.log.take part.length = part := (List.prefix_iff_eq_take.mp inPre).symm have termEq : termAt c.pre.log part.length = c.post.currentTerm := by - have := termAt_take (log := c.pre.log) (le_refl part.length) + have := termAt_take (log := c.pre.log) (Nat.le_refl part.length) rw [partEq] at this exact this.symm.trans (Nat.le_antisymm termLe upper) rw [termEq] at logCanon have partLog : part = log.take part.length := partEq.symm.trans take have comparable := canon_chain c.monos logCanon senderCanon - rcases le_or_gt part.length sender.log.length with fits | long + rcases (Nat.lt_or_ge sender.log.length part.length).symm with fits | long · apply inSender rw [partLog, take_eq_take_of_comparable comparable length fits] exact List.take_prefix _ _ @@ -6798,10 +6820,10 @@ private theorem persist : Persist (after :: before :: rest) := by · have termEq : termAt (earlier.log.take index) (earlier.log.take index).length = termAt earlier.log index := by rw [List.length_take, Nat.min_eq_left (signature_bound signature), - termAt_take le_rfl] + termAt_take Nat.le.refl] rw [← termEq] exact c.persist_pre (take_signature signature) inPre - · exact Or.inr ⟨later, log, lt, le.trans c.term_le, canon.mono c.suffix_tail, missing⟩ + · exact Or.inr ⟨later, log, lt, Nat.le_trans le c.term_le, canon.mono c.suffix_tail, missing⟩ · exact Or.inl (List.take_prefix _ _) · rcases c.seen_after seen with oldSeen | ⟨same, _⟩ · rcases c.inv.persist node state earlier index old oldSeen signature with sub | bad @@ -7076,6 +7098,7 @@ end Consensus.Proofs.Safety namespace Consensus.Proofs.Election +open CCF (Finset) open Model.Node private theorem primary_eq_of_reachable [Config.InitialConfiguration] @@ -7117,6 +7140,7 @@ end Consensus.Proofs.Election namespace Consensus.Proofs.CommittedLogs +open CCF (Finset) open Model.Node open Consensus.Proofs.Config diff --git a/lean/consensus/Consensus/Proofs/Witnesses.lean b/lean/consensus/Consensus/Proofs/Witnesses.lean index e689cb089e0..183861cd330 100644 --- a/lean/consensus/Consensus/Proofs/Witnesses.lean +++ b/lean/consensus/Consensus/Proofs/Witnesses.lean @@ -1,15 +1,13 @@ module public import Consensus.Model -public import CCF.Execution +public import CCF.Proofs.Execution import all Init.Control.State -import all Init.Data.List.Sort.Basic -import all Mathlib.Data.List.Sort -meta import Lean.Elab.Tactic.Basic -meta import Lean.Meta.Tactic.AuxLemma -public import Mathlib.Tactic.SplitIfs +public meta import Lean.Elab.Tactic.ElabTerm + +meta import Lean.Meta.Tactic.AuxLemma namespace Consensus.Proofs.Config end Consensus.Proofs.Config @@ -103,7 +101,7 @@ public def lassoTrace {system : TransitionSystem} {start final : system.State} simp [lasso, Nat.not_lt.mpr le, stemRun] refine ⟨{ init := lasso system start stem cycle 0 - steps := Stream'.Seq.ofStream fun index => + steps := CCF.Seq.ofStream fun index => (lassoAction system start stem cycle nonempty index, lasso system start stem cycle (index + 1)) }, ?_, ?_⟩ @@ -186,25 +184,6 @@ public def input (node : Nat) (input : Consensus.Model.Node.Input) : Consensus.Model.State -> Consensus.Model.Action := fun _ => .local node input -/-- `Finset.sort` by insertion sort, for any order accepted by `Finset.sort`. -/ -private def insertionSortedBy {α : Type} (s : Finset α) (r : α -> α -> Prop) - [DecidableRel r] [IsTrans α r] [Std.Antisymm r] [Std.Total r] - : List α := - Quot.liftOn s.val (List.insertionSort r) - fun _ _ perm => - ((List.perm_insertionSort r _).trans - (perm.trans (List.perm_insertionSort r _).symm)).eq_of_pairwise' - (List.pairwise_insertionSort r _) (List.pairwise_insertionSort r _) - -/-- `Finset.sort` itself, rather than each application of it, is insertion sort. -The left side is closed, so `rw` replaces every sort in an unfolded run, including -those under binders, without the congruence proofs `simp` builds for each one. -/ -private theorem sort_eq_insertionSortedBy {α : Type} - : @Finset.sort α = @insertionSortedBy α := by - funext s r _ _ _ _ - obtain ⟨⟨list⟩, _⟩ := s - exact List.mergeSort_eq_insertionSort r list - /-- `run` over a bare step function. Unlike `run`, its step argument is not a dependency of the other arguments' types, so tactics can rewrite inside it. -/ private def runWith {S A : Type} (step : S -> A -> Option S) (start : S) @@ -220,12 +199,11 @@ private theorem run_eq_runWith (system : TransitionSystem) (start : system.State | nil => rfl | cons choose rest ih => simp only [run, runWith, ih] -/-- Unfold the model's step function down to its broadcasts and replace each -`Finset.sort` with insertion sort, so that the kernel can evaluate the run. -Each run becomes a `runWith` over a single copy of the step function, rather -than one copy per step; `dsimp` unfolds it without building proof terms; and a -single `rw` replaces every sort. -/ -macro "sort_by_insertion" : tactic => +/-- Unfold the model's step function down to its broadcasts, so that the kernel +can evaluate the run. Each run becomes a `runWith` over a single copy of the +step function, rather than one copy per step, and `dsimp` unfolds it without +building proof terms. -/ +macro "unfold_run" : tactic => `(tactic| (simp only [run_eq_runWith]; dsimp only [Consensus.Model.transitionSystem, MultiNodeTransitionSystem.lift, MultiNodeTransitionSystem.next, Consensus.Model.protocol, Consensus.Model.Node.step, Consensus.Model.Node.act, Consensus.Model.Node.receive, @@ -239,7 +217,7 @@ macro "sort_by_insertion" : tactic => Consensus.Model.Node.handleAppendEntriesResponse, Consensus.Model.Node.handleRequestVoteResponse, Consensus.Model.Node.handleRequestPreVoteResponse, - Consensus.Model.Node.handleProposeRequestVoteRequest]; rw [sort_eq_insertionSortedBy])) + Consensus.Model.Node.handleProposeRequestVoteRequest])) open Lean Elab Tactic Meta in /-- Close a closed goal `lhs = rhs` by asking only the kernel to check @@ -482,7 +460,7 @@ section Election public theorem election_finished : (run electionSystem electionStart electionChoices).isSome := by - sort_by_insertion + unfold_run decide +kernel public theorem election_run @@ -492,14 +470,14 @@ public theorem election_run public theorem election_cycle_finished : (run electionSystem electionFinal electionCycle).isSome := by unfold electionFinal - sort_by_insertion + unfold_run decide +kernel public theorem election_cycle_returns : (run electionSystem electionFinal electionCycle).getD electionStart = electionFinal := by unfold electionFinal - sort_by_insertion + unfold_run kernel_rfl public theorem election_cycle @@ -508,7 +486,7 @@ public theorem election_cycle public theorem election_both_lead : bothLead electionFinal = true := by unfold electionFinal - sort_by_insertion + unfold_run decide +kernel end Election @@ -522,7 +500,7 @@ open Consensus.Model (initialNodeState) section Commit public theorem commit_finished : (run commitSystem commitStart commitChoices).isSome := by - sort_by_insertion + unfold_run decide +kernel public theorem commit_run @@ -532,13 +510,13 @@ public theorem commit_run public theorem commit_cycle_finished : (run commitSystem commitFinal commitCycle).isSome := by unfold commitFinal - sort_by_insertion + unfold_run decide +kernel public theorem commit_cycle_returns : (run commitSystem commitFinal commitCycle).getD commitStart = commitFinal := by unfold commitFinal - sort_by_insertion + unfold_run kernel_rfl public theorem commit_cycle @@ -607,7 +585,7 @@ open CCF CCF.Execution CCF.MultiNodeTransitionSystem open Consensus.Model.Node open Consensus.Model (initialNodeState) -public lemma committed_logs_prefix_witness +public theorem committed_logs_prefix_witness : exists (config : Finset NodeID), exists (nodes : List NodeID) (trace @@ -644,7 +622,7 @@ public lemma committed_logs_prefix_witness by decide ⟩ -public lemma single_node_committed_log_monotonic_witness +public theorem single_node_committed_log_monotonic_witness : exists (config : Finset NodeID) (nodes : List NodeID), exists (pre post : Model.State), exists (nodeId : NodeID) (nodePre nodePost : NodeState), @@ -672,7 +650,7 @@ public lemma single_node_committed_log_monotonic_witness extend_committed.2 ⟩ -public lemma election_safety_witness +public theorem election_safety_witness : exists (config : Finset NodeID), exists (nodes : List NodeID) (trace @@ -704,7 +682,7 @@ public lemma election_safety_witness (start_initial (by decide) (by decide)) stemRun election_cycle (by simp [electionCycle]) - le_rfl + Nat.le.refl (by rw [List.take_length]; exact stemRun), mem_of_nodeState leftFound, mem_of_nodeState rightFound, @@ -713,7 +691,7 @@ public lemma election_safety_witness by decide ⟩ -public lemma committed_frontier_is_signature_witness +public theorem committed_frontier_is_signature_witness : exists (config : Finset NodeID), exists (nodes : List NodeID) (trace @@ -735,7 +713,7 @@ public lemma committed_frontier_is_signature_witness (start_initial (by decide) (by decide)) stemRun single_cycle (by simp [singleCycle]) - le_rfl + Nat.le.refl (by rw [List.take_length]; exact stemRun), member_of_nodeState _, by decide diff --git a/lean/consensus/Consensus/Properties.lean b/lean/consensus/Consensus/Properties.lean index 3eaca97708c..2c29865106b 100644 --- a/lean/consensus/Consensus/Properties.lean +++ b/lean/consensus/Consensus/Properties.lean @@ -16,6 +16,8 @@ exhibiting a nontrivial execution relevant to that property. namespace Consensus.Properties +open CCF (Finset) + abbrev GlobalTrace (config : Finset Model.Node.NodeID) (nodes : List Model.Node.NodeID) := CCF.Execution.Trace (Model.transitionSystem config nodes) @@ -38,7 +40,7 @@ theorem committed_logs_prefix /-- Witness: a valid trace has two states in which two distinct nodes have nonempty committed logs. -/ -lemma committed_logs_prefix_witness +theorem committed_logs_prefix_witness : exists (config : Finset NodeID), exists (nodes : List NodeID) (trace : GlobalTrace config nodes), exists (stateA stateB : Model.State), @@ -68,7 +70,7 @@ theorem single_node_committed_log_monotonic /-- Witness: a successful step from a state with unique node IDs strictly extends one node's nonempty committed log. -/ -lemma single_node_committed_log_monotonic_witness +theorem single_node_committed_log_monotonic_witness : exists (config : Finset NodeID) (nodes : List NodeID), exists (pre post : Model.State), exists (nodeId : NodeID) (nodePre nodePost : NodeState), @@ -97,7 +99,7 @@ theorem election_safety exact Proofs.Election.election_safety /-- Witness: a valid trace has a state in which two nodes are primaries. -/ -lemma election_safety_witness +theorem election_safety_witness : exists (config : Finset NodeID), exists (nodes : List NodeID) (trace : GlobalTrace config nodes) (state : Model.State), @@ -121,7 +123,7 @@ theorem committed_frontier_is_signature exact Proofs.Direct.committed_frontier_is_signature /-- Witness: a valid trace has a state with a positive commit index. -/ -lemma committed_frontier_is_signature_witness +theorem committed_frontier_is_signature_witness : exists (config : Finset NodeID), exists (nodes : List NodeID) (trace : GlobalTrace config nodes) (state : Model.State), diff --git a/lean/consensus/Consensus/Replay/Interpreter.lean b/lean/consensus/Consensus/Replay/Interpreter.lean index 9736ae28a3c..a31ca9a5d55 100644 --- a/lean/consensus/Consensus/Replay/Interpreter.lean +++ b/lean/consensus/Consensus/Replay/Interpreter.lean @@ -11,6 +11,7 @@ public section namespace Consensus.Replay open Lean Model.Node +open CCF (Finset) open CCF.MultiNodeTransitionSystem (nodeState removeOne) abbrev Envelope := Model.Envelope diff --git a/lean/consensus/Consensus/Replay/Reduction.lean b/lean/consensus/Consensus/Replay/Reduction.lean index d0b50c3d8ce..ab23c31fa16 100644 --- a/lean/consensus/Consensus/Replay/Reduction.lean +++ b/lean/consensus/Consensus/Replay/Reduction.lean @@ -19,6 +19,7 @@ Reduction never executes or repairs model state. namespace Consensus.Replay.Reducer open Lean Model.Node +open CCF (Finset) open CCF.Parsec (failure validated attempt many_ optional_) private structure ReductionState where @@ -55,7 +56,7 @@ private def modelNode (event : Event) (name : String) : Reduction NodeID := do private def modelMembers (event : Event) (names : List String) : Reduction (Finset NodeID) := do - return (← names.mapM (modelNode event)).toFinset + return Finset.ofList (← names.mapM (modelNode event)) private def appendInstruction (instr : Instruction) : Reduction Unit := modify fun s => { s with instructions := s.instructions.push instr } diff --git a/lean/consensus/Consensus/Tests/CanonicalTraces.lean b/lean/consensus/Consensus/Tests/CanonicalTraces.lean index 0b5506e81d3..667cf9e2073 100644 --- a/lean/consensus/Consensus/Tests/CanonicalTraces.lean +++ b/lean/consensus/Consensus/Tests/CanonicalTraces.lean @@ -10,6 +10,7 @@ namespace Consensus.Tests.CanonicalTraces open Consensus Consensus.Model.Node open Consensus.Model (initialNodeState BOOTSTRAP_TERM) +open CCF (Finset) open CCF.MultiNodeTransitionSystem (nodeState) private inductive Action where diff --git a/lean/consensus/README.md b/lean/consensus/README.md index 3011a02dfb5..a349eeba656 100644 --- a/lean/consensus/README.md +++ b/lean/consensus/README.md @@ -31,7 +31,6 @@ There are no liveness properties or fairness assumptions. Install Lean via [elan](https://lean-lang.org/install/), then run from this directory: ```sh -lake exe cache get lake build --wfail --fail-fast lake exe check-imports lake lint @@ -56,7 +55,7 @@ The shared `check-imports` command rejects modules missing from that import clos `Properties.lean` contains the full theorem and witness-lemma statements, with one-line proof links into `Proofs/`. Import `Consensus.Properties` and use `Consensus.Properties.` for these declarations. -Proof modules follow the shared [dependency import contract](../common/README.md#dependency-imports); import additional Mathlib facilities explicitly rather than relying on incidental reexports. +Proof modules follow the shared [dependency import contract](../common/README.md#dependency-imports); import additional facilities explicitly rather than relying on incidental reexports. `Proofs/Direct.lean` establishes node-local commit invariants; `Proofs/SafetyInvariant.lean` establishes the cross-node history invariant, in the `Consensus.Proofs.Safety` namespace, used for election safety and committed-log comparability. `Proofs/Witnesses.lean` supplies concrete executions checked by the kernel. The proof modules do not import each other, so Lake checks them in parallel; lemmas needed by more than one module are duplicated as private declarations to minimise verification wall-clock time. diff --git a/lean/consensus/lake-manifest.json b/lean/consensus/lake-manifest.json index 402931fc84a..fd3e43af68d 100644 --- a/lean/consensus/lake-manifest.json +++ b/lean/consensus/lake-manifest.json @@ -14,18 +14,6 @@ "inherited": false, "configFile": "lakefile.toml" }, - { - "url": "https://github.com/leanprover-community/mathlib4.git", - "type": "git", - "subDir": null, - "scope": "", - "rev": "56a005855ea17e0b0958f73ec801ae140b0a1679", - "name": "mathlib", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.35.0", - "inherited": false, - "configFile": "lakefile.lean" - }, { "type": "path", "scope": "", @@ -35,102 +23,6 @@ "dir": "../common", "copy": false, "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dfa4f38190d07c37e315953e08b90fe2d95b3c24", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/LeanSearchClient", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "d6b4c7be5be75ec4917c873ac50c756dc1436372", - "name": "LeanSearchClient", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/import-graph", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "a41f0e9a4dea23188ea9cc1c41ac9f8bbafe0b93", - "name": "importGraph", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/ProofWidgets4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "df72b022e558978a1c50264cfc4d7fec86fa8e04", - "name": "proofwidgets", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/aesop", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "4a174c490d8707121c4a9290800489f105d85e07", - "name": "aesop", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/quote4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dce0ad79c486cb1fb504af04f953c3466b0c6db8", - "name": "Qq", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/batteries", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "66e469188fe07963e5cf666c7d4433f45b8131c5", - "name": "batteries", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover/lean4-cli", - "type": "git", - "subDir": null, - "scope": "leanprover", - "rev": "c24fe6078c630e89b489bffe59b3e20ac30d12c8", - "name": "Cli", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.35.0", - "inherited": true, - "configFile": "lakefile.toml" } ], "name": "consensus", diff --git a/lean/consensus/lakefile.toml b/lean/consensus/lakefile.toml index dc9dc470e28..443c7237c28 100644 --- a/lean/consensus/lakefile.toml +++ b/lean/consensus/lakefile.toml @@ -10,11 +10,6 @@ name = "ccf_common" path = "../common" copy = false -[[require]] -name = "mathlib" -git = "https://github.com/leanprover-community/mathlib4.git" -rev = "v4.35.0" - [[require]] name = "leanfmt" git = "https://github.com/duckki/leanfmt.git" diff --git a/lean/consensus/replay/README.md b/lean/consensus/replay/README.md index 2f091cc6b9b..58a3ae69c27 100644 --- a/lean/consensus/replay/README.md +++ b/lean/consensus/replay/README.md @@ -10,7 +10,6 @@ The Lean version is [pinned](../../lean-toolchain). From `lean/consensus`, build the validator and validate a saved trace: ```sh -lake exe cache get lake build --wfail consensus-replay ./.lake/build/bin/consensus-replay path/to/trace.ndjson ``` diff --git a/lean/consistency/README.md b/lean/consistency/README.md index 4966682c8b5..78e1190c7f1 100644 --- a/lean/consistency/README.md +++ b/lean/consistency/README.md @@ -46,14 +46,13 @@ The primary consistency guarantee is expressed by `committed_rw_ordered_serializ Committed writes serialize in transaction-ID order, and that order respects request-to-initial-response intervals rather than waiting for committed-status notifications. Supporting proofs live under [`Proofs/`](consistency/Proofs); [`Witnesses.lean`](consistency/Proofs/Witnesses.lean) constructs the witness executions by replaying model actions and also holds the history-only proofs. The proof modules do not import each other, so Lake checks them in parallel; lemmas needed by more than one module are duplicated as private declarations to minimise verification wall-clock time. -Proof modules follow the shared [dependency import contract](../common/README.md#dependency-imports); import additional Mathlib facilities explicitly rather than relying on incidental reexports. +Proof modules follow the shared [dependency import contract](../common/README.md#dependency-imports); import additional facilities explicitly rather than relying on incidental reexports. ## Validation Install Lean through [elan](https://lean-lang.org/install/), then run from this package directory: ```sh -lake exe cache get lake check --inadvisably-no-sandbox lake exe check-imports lake lint diff --git a/lean/consistency/consistency/Proofs/Deadlock.lean b/lean/consistency/consistency/Proofs/Deadlock.lean index a2f60fd9770..69b4760ce25 100644 --- a/lean/consistency/consistency/Proofs/Deadlock.lean +++ b/lean/consistency/consistency/Proofs/Deadlock.lean @@ -2,8 +2,6 @@ module public import consistency.Model -import Mathlib.Tactic.Lemma - @[expose] public section namespace consistency.Proofs @@ -12,7 +10,7 @@ theorem deadlock_free : Model.transitionSystem.DeadlockFree := by intro state _ exact ⟨.request .rw, _, rfl⟩ -lemma deadlock_free_witness : exists state, Model.transitionSystem.Reachable state := +theorem deadlock_free_witness : exists state, Model.transitionSystem.Reachable state := ⟨Model.initialState, .initial rfl⟩ end consistency.Proofs diff --git a/lean/consistency/consistency/Proofs/Invalidation.lean b/lean/consistency/consistency/Proofs/Invalidation.lean index 34ea7fe9953..6889c7fec57 100644 --- a/lean/consistency/consistency/Proofs/Invalidation.lean +++ b/lean/consistency/consistency/Proofs/Invalidation.lean @@ -1,7 +1,7 @@ module public import consistency.Properties.History -public import CCF.Execution +public import CCF.Proofs.Execution /-! Status separation and invalid-observation proofs. @@ -568,7 +568,7 @@ private theorem snapshots_reachable {state : State} (found : at? branches branch = some ledger) (last : ledger.getLast? = some entry) (tx : TxContent) : Snapshot branches .ro tx (writes ledger) ⟨entry.view, ledger.length⟩ := by - have snapshot := snapshot_source branches anchored found (at_last last) .ro tx (by simp only [reduceCtorEq, IsEmpty.forall_iff]) + have snapshot := snapshot_source branches anchored found (at_last last) .ro tx (by simp only [reduceCtorEq, forall_false]) simpa only [List.take_length] using snapshot have step_snapshots (before after : State) (action : Action) (anchored : Anchored before.branches) @@ -634,7 +634,8 @@ private theorem anchored_prefix (branches : List (List Entry)) refine ⟨origin, originFound, ?_⟩ have bound : seqno ≤ (ledger.take seqno).length := by simp only [List.length_take, Nat.min_eq_left (at_bounds atEntry).2, Std.le_refl] - simpa only [List.take_take, min_self] using (take_of_prefix isPrefix seqno bound).symm + simpa only [List.take_take, Nat.min_self] + using (take_of_prefix isPrefix seqno bound).symm private theorem frontier_bound (history : List Event) {txid : TxID} (member : txid ∈ statusIDs history .committed) @@ -884,7 +885,7 @@ private theorem committed_views {state : State} refine ⟨ ordered ledger (List.mem_of_getElem? found), by - simp only [List.pairwise_cons, List.not_mem_nil, IsEmpty.forall_iff, implies_true, List.Pairwise.nil, and_self], + simp only [List.pairwise_cons, List.not_mem_nil, forall_false, implies_true, List.Pairwise.nil, and_self], ?_ ⟩ intro left member right singleton @@ -1011,7 +1012,7 @@ private theorem separated_snoc (history : List Event) (event : Event) · exact newInvalid invalid currentInvalid committed oldCommit sameView · rcases (status_ids_snoc _ _ _ _).mp invalidKnown with oldInvalid | currentInvalid · exact newCommit committed currentCommit invalid oldInvalid sameView - · simp_all only [Event.status.injEq, and_true, forall_eq', reduceCtorEq, and_false, IsEmpty.forall_iff, implies_true] + · simp_all only [Event.status.injEq, and_true, forall_eq', reduceCtorEq, and_false, forall_false, implies_true] private theorem separated_invalidate (state : State) (separated : Separated state.history) (anchored : Anchored state.branches) (current : Current state.branches state.history) @@ -1039,7 +1040,7 @@ private theorem separated_invalidate (state : State) (separated : Separated stat have frontier := Nat.le_trans bound (frontier_bound state.history known) simp only [mayInvalidate, last_of_at latestFound, ge_iff_le, actual, invalidView, bne_self_eq_false, Bool.and_false, gt_iff_lt, Nat.not_lt.mpr frontier, decide_false, Bool.false_and, Bool.or_self] apply separated_snoc _ _ separated - · simp only [Event.status.injEq, reduceCtorEq, and_false, IsEmpty.forall_iff, implies_true] + · simp only [Event.status.injEq, reduceCtorEq, and_false, forall_false, implies_true] · intro _ same cases same intro committed known sameView @@ -1064,7 +1065,7 @@ private theorem separated_reachable {state : State} · intro _ same cases same exact allowed - · simp only [Event.status.injEq, reduceCtorEq, and_false, IsEmpty.forall_iff, implies_true] + · simp only [Event.status.injEq, reduceCtorEq, and_false, forall_false, implies_true] have step_separated (before after : State) (action : Action) (separated : Separated before.history) (anchored : Anchored before.branches) (current : Current before.branches before.history) @@ -1301,7 +1302,7 @@ private theorem unique_reachable {state : State} : UniqueWrites (appendEntry state branch ⟨branch, none⟩).branches := by obtain ⟨ledger, found⟩ := active_ledger state active apply unique_modify _ unique _ ledger _ found - simp only [reduceCtorEq, ne_eq, IsEmpty.forall_iff, implies_true] + simp only [reduceCtorEq, ne_eq, forall_false, implies_true] have elected_location (branches : List (List Entry)) {target : List Entry} (targetMember : target ∈ branches) (count : Nat) {ledger : List Entry} (member : ledger ∈ branches ++ [target.take count]) {seqno : Nat} {entry : Entry} @@ -1389,7 +1390,7 @@ private theorem clean_snoc (branches : List (List Entry)) (history : List Event) · exact newInvalid invalid newInvalidated committed oldCommit · rcases (status_ids_snoc _ _ _ _).mp invalidKnown with oldInvalid | newInvalidated · exact newCommit committed newCommitted invalid oldInvalid - · simp_all only [Event.status.injEq, and_true, forall_eq', reduceCtorEq, and_false, IsEmpty.forall_iff, implies_true] + · simp_all only [Event.status.injEq, and_true, forall_eq', reduceCtorEq, and_false, forall_false, implies_true] private theorem origin_entry_in_branch (branches : List (List Entry)) (anchored : Anchored branches) {branch : Nat} {ledger origin : List Entry} @@ -1414,7 +1415,7 @@ private theorem clean_invalidate (state : State) (allowed : mayInvalidate state txid = true) : Clean state.branches (state.history ++ [Event.status txid .invalid]) := by apply clean_snoc _ _ _ clean - · simp only [Event.status.injEq, reduceCtorEq, and_false, IsEmpty.forall_iff, implies_true] + · simp only [Event.status.injEq, reduceCtorEq, and_false, forall_false, implies_true] · intro _ same cases same intro committed known origin originFound entry entryFound bound sameView @@ -1483,7 +1484,7 @@ private theorem clean_reachable {state : State} endpointFound view originFound entryFound bound have denied := allowed invalid known bound simp only [actual, sameView, BEq.rfl, Bool.true_eq_false] at denied - · simp only [Event.status.injEq, reduceCtorEq, and_false, IsEmpty.forall_iff, implies_true] + · simp only [Event.status.injEq, reduceCtorEq, and_false, forall_false, implies_true] have step_clean (before after : State) (action : Action) (clean : Clean before.branches before.history) (anchored : Anchored before.branches) (current : Current before.branches before.history) diff --git a/lean/consistency/consistency/Proofs/Ordering.lean b/lean/consistency/consistency/Proofs/Ordering.lean index 07bf24c1db9..ac28b71ca59 100644 --- a/lean/consistency/consistency/Proofs/Ordering.lean +++ b/lean/consistency/consistency/Proofs/Ordering.lean @@ -1,7 +1,7 @@ module public import consistency.Properties.History -public import CCF.Execution +public import CCF.Proofs.Execution /-! Ledger identity, commitment, serializability, ordering and real-time proofs. @@ -348,7 +348,7 @@ private theorem requests_reachable {state : State} constructor · intro index kind tx found rcases lookup_snoc found with ⟨_, old⟩ | ⟨rfl, rfl⟩ - · exact lt_of_lt_of_le (invariant.1 _ _ _ old) monotonic + · exact Nat.lt_of_lt_of_le (invariant.1 _ _ _ old) monotonic · simp only [next_request_snoc, Nat.lt_add_one] · intro left right leftKind rightKind leftTx rightTx first second same rcases lookup_snoc first with ⟨_, oldLeft⟩ | ⟨lastLeft, newLeft⟩ @@ -844,7 +844,7 @@ private theorem snapshots_reachable {state : State} (found : at? branches branch = some ledger) (last : ledger.getLast? = some entry) (tx : TxContent) : Snapshot branches .ro tx (writes ledger) ⟨entry.view, ledger.length⟩ := by - have snapshot := snapshot_source branches anchored found (at_last last) .ro tx (by simp only [reduceCtorEq, IsEmpty.forall_iff]) + have snapshot := snapshot_source branches anchored found (at_last last) .ro tx (by simp only [reduceCtorEq, forall_false]) simpa only [List.take_length] using snapshot have step_snapshots (before after : State) (action : Action) (anchored : Anchored before.branches) @@ -946,7 +946,8 @@ private theorem anchored_prefix (branches : List (List Entry)) refine ⟨origin, originFound, ?_⟩ have bound : seqno ≤ (ledger.take seqno).length := by simp only [List.length_take, Nat.min_eq_left (at_bounds atEntry).2, Std.le_refl] - simpa only [List.take_take, min_self] using (take_of_prefix isPrefix seqno bound).symm + simpa only [List.take_take, Nat.min_self] + using (take_of_prefix isPrefix seqno bound).symm private theorem frontier_bound (history : List Event) {txid : TxID} (member : txid ∈ statusIDs history .committed) @@ -1267,7 +1268,7 @@ private theorem committed_views {state : State} refine ⟨ ordered ledger (List.mem_of_getElem? found), by - simp only [List.pairwise_cons, List.not_mem_nil, IsEmpty.forall_iff, implies_true, List.Pairwise.nil, and_self], + simp only [List.pairwise_cons, List.not_mem_nil, forall_false, implies_true, List.Pairwise.nil, and_self], ?_ ⟩ intro left member right singleton @@ -1541,7 +1542,7 @@ theorem committed_rw_ordered_serializable have sameSeq : left.seqno = right.seqno := Nat.le_antisymm (Nat.le_of_not_lt (fun lt => ordered (Or.inr ⟨sameView.symm, lt⟩))) notLater - exact different (congrArg₂ TxID.mk sameView sameSeq) + exact different (congr (congrArg TxID.mk sameView) sameSeq) have through_entry {α : Type} {xs : List α} {index : Nat} {value : α} (found : at? xs index = some value) : xs.take index = xs.take (index - 1) ++ [value] := by diff --git a/lean/consistency/consistency/Proofs/Witnesses.lean b/lean/consistency/consistency/Proofs/Witnesses.lean index c99370de09e..920349a7ffd 100644 --- a/lean/consistency/consistency/Proofs/Witnesses.lean +++ b/lean/consistency/consistency/Proofs/Witnesses.lean @@ -1,7 +1,7 @@ module public import consistency.Properties.History -public import CCF.Execution +public import CCF.Proofs.Execution /-! Non-vacuity witnesses and the history-only safety proofs. @@ -289,12 +289,12 @@ private theorem causal_reachable {state : State} (tx : TxContent) : Causal (history ++ [Event.request kind tx]) := by apply causal_snoc history _ causal - simp only [reduceCtorEq, IsEmpty.forall_iff, implies_true] + simp only [reduceCtorEq, forall_false, implies_true] have causal_status (history : List Event) (causal : Causal history) (txid : TxID) (status : Status) : Causal (history ++ [Event.status txid status]) := by apply causal_snoc history _ causal - simp only [reduceCtorEq, IsEmpty.forall_iff, implies_true] + simp only [reduceCtorEq, forall_false, implies_true] have causal_response (history : List Event) (causal : Causal history) {requestIndex : Nat} {kind : TxType} {tx : TxContent} (observed : List TxContent) (txid : TxID) (found : at? history requestIndex = some (.request kind tx)) @@ -391,7 +391,7 @@ private theorem requests_reachable {state : State} constructor · intro index kind tx found rcases lookup_snoc found with ⟨_, old⟩ | ⟨rfl, rfl⟩ - · exact lt_of_lt_of_le (invariant.1 _ _ _ old) monotonic + · exact Nat.lt_of_lt_of_le (invariant.1 _ _ _ old) monotonic · simp only [next_request_snoc, Nat.lt_add_one] · intro left right leftKind rightKind leftTx rightTx first second same rcases lookup_snoc first with ⟨_, oldLeft⟩ | ⟨lastLeft, newLeft⟩ diff --git a/lean/consistency/consistency/Properties.lean b/lean/consistency/consistency/Properties.lean index e0baac60536..6627a876118 100644 --- a/lean/consistency/consistency/Properties.lean +++ b/lean/consistency/consistency/Properties.lean @@ -29,7 +29,7 @@ theorem deadlock_free : transitionSystem.DeadlockFree := by exact Proofs.deadlock_free /-- Witness: the initial state is reachable. -/ -lemma deadlock_free_witness : exists state, transitionSystem.Reachable state := by +theorem deadlock_free_witness : exists state, transitionSystem.Reachable state := by exact Proofs.deadlock_free_witness /-- Adjacent TxID-ordered committed responses strictly extend. @@ -48,7 +48,7 @@ theorem committed_rw_ordered_serializable exact Proofs.Ordered.committed_rw_ordered_serializable /-- The sorted committed responses contain an adjacent pair. -/ -lemma committed_rw_ordered_serializable_witness +theorem committed_rw_ordered_serializable_witness : ∃ (trace : GlobalTrace) (state : State) (left right : Response), state ∈ trace ∧ (left, right) @@ -72,7 +72,7 @@ theorem committed_rw_ordered_real_time exact Proofs.RealTime.committed_rw_ordered_real_time /-- Committed writes and a matching request satisfy the real-time antecedents. -/ -lemma committed_rw_ordered_real_time_witness +theorem committed_rw_ordered_real_time_witness : ∃ (trace : GlobalTrace) (state : State) (earlier later : Nat × Response) (request : Nat × (TxType × TxContent)), let (earlierIndex, earlier) := earlier @@ -101,7 +101,7 @@ theorem all_received_is_first_sent exact Proofs.History.all_received_is_first_sent /-- Both response kinds occur in the same execution. -/ -lemma all_received_is_first_sent_witness +theorem all_received_is_first_sent_witness : ∃ (trace : GlobalTrace) (state : State) (write read : Nat × Response), let (writeIndex, write) := write let (readIndex, read) := read @@ -123,7 +123,7 @@ theorem unique_txs exact Proofs.LedgerIdentity.unique_txs /-- Write responses with matching transaction IDs occur in a valid execution. -/ -lemma unique_txs_witness +theorem unique_txs_witness : ∃ (trace : GlobalTrace) (state : State) (left right : Nat × Response), let (leftIndex, left) := left let (rightIndex, right) := right @@ -145,7 +145,7 @@ theorem same_observations exact Proofs.LedgerIdentity.same_observations /-- Responses with matching transaction IDs occur in a valid execution. -/ -lemma same_observations_witness +theorem same_observations_witness : ∃ (trace : GlobalTrace) (state : State) (left right : Nat × Response), let (leftIndex, left) := left let (rightIndex, right) := right @@ -167,7 +167,7 @@ theorem unique_tx_requests exact Proofs.History.unique_tx_requests /-- Requests at distinct history positions occur in a valid execution. -/ -lemma unique_tx_requests_witness +theorem unique_tx_requests_witness : ∃ (trace : GlobalTrace) (state : State) (left right : Nat × (TxType × TxContent)), let (leftIndex, leftKind, leftTx) := left let (rightIndex, rightKind, rightTx) := right @@ -189,7 +189,7 @@ theorem unique_tx_ids exact Proofs.Responses.unique_tx_ids /-- Responses with matching request IDs occur in a valid execution. -/ -lemma unique_tx_ids_witness +theorem unique_tx_ids_witness : ∃ (trace : GlobalTrace) (state : State) (left right : Nat × Response), let (leftIndex, left) := left let (rightIndex, right) := right @@ -213,7 +213,7 @@ theorem unique_seq_nums_committed exact Proofs.Commitment.unique_seq_nums_committed /-- Committed write responses with matching sequence numbers occur in a valid execution. -/ -lemma unique_seq_nums_committed_witness +theorem unique_seq_nums_committed_witness : ∃ (trace : GlobalTrace) (state : State) (left right : Nat × Response), let (leftIndex, left) := left let (rightIndex, right) := right @@ -232,7 +232,7 @@ theorem committed_or_invalid exact Proofs.Statuses.committed_or_invalid /-- A committed status occurs in a valid execution. -/ -lemma committed_or_invalid_witness +theorem committed_or_invalid_witness : ∃ (trace : GlobalTrace) (state : State) (committed : TxID), state ∈ trace ∧ committed ∈ statusIDs state.history .committed := by exact Proofs.Witnesses.committed_or_invalid_witness @@ -252,7 +252,7 @@ theorem once_committed_prev_committed exact Proofs.Statuses.once_committed_prev_committed /-- Reported statuses satisfy the same-view committed-prefix antecedents. -/ -lemma once_committed_prev_committed_witness +theorem once_committed_prev_committed_witness : ∃ (trace : GlobalTrace) (state : State) (left right : TxID × Status), let (leftTxID, leftStatus) := left let (rightTxID, rightStatus) := right @@ -279,7 +279,7 @@ theorem once_committed_next_invalid exact Proofs.Statuses.once_committed_next_invalid /-- Reported statuses satisfy the older-view conflicting-suffix antecedents. -/ -lemma once_committed_next_invalid_witness +theorem once_committed_next_invalid_witness : ∃ (trace : GlobalTrace) (state : State) (left right : TxID × Status), let (leftTxID, leftStatus) := left let (rightTxID, rightStatus) := right @@ -306,7 +306,7 @@ theorem once_invalid_next_invalid exact Proofs.Statuses.once_invalid_next_invalid /-- Reported statuses satisfy the same-view invalid-suffix antecedents. -/ -lemma once_invalid_next_invalid_witness +theorem once_invalid_next_invalid_witness : ∃ (trace : GlobalTrace) (state : State) (left right : TxID × Status), let (leftTxID, leftStatus) := left let (rightTxID, rightStatus) := right @@ -331,7 +331,7 @@ theorem only_observe_sent_requests exact Proofs.Observations.only_observe_sent_requests /-- An observed write populates the observation-membership antecedent. -/ -lemma only_observe_sent_requests_witness +theorem only_observe_sent_requests_witness : ∃ (trace : GlobalTrace) (state : State) (response : Nat × Response) (tx : TxContent), let (responseIndex, response) := response @@ -350,7 +350,7 @@ theorem at_most_once_observed exact Proofs.Observations.at_most_once_observed /-- A response populates the observation domain. -/ -lemma at_most_once_observed_witness +theorem at_most_once_observed_witness : ∃ (trace : GlobalTrace) (state : State) (response : Nat × Response), let (responseIndex, response) := response state ∈ trace ∧ (responseIndex, response) ∈ responses state.history := by @@ -374,7 +374,7 @@ theorem all_committed_observed exact Proofs.RealTime.all_committed_observed /-- Committed writes and a matching request satisfy the real-time antecedents. -/ -lemma all_committed_observed_witness +theorem all_committed_observed_witness : ∃ (trace : GlobalTrace) (state : State) (earlier later : Nat × Response) (request : Nat × (TxType × TxContent)), let (earlierIndex, earlier) := earlier @@ -402,7 +402,7 @@ theorem invalid_not_observed_by_committed exact Proofs.InvalidObservations.invalid_not_observed_by_committed /-- An invalid write and a different committed response populate the exclusion antecedents. -/ -lemma invalid_not_observed_by_committed_witness +theorem invalid_not_observed_by_committed_witness : ∃ (trace : GlobalTrace) (state : State) (invalid observer : Nat × Response), let (invalidIndex, invalid) := invalid let (observerIndex, observer) := observer @@ -425,7 +425,7 @@ theorem committed_rw_serializable exact Proofs.Commitment.committed_rw_serializable /-- Committed write responses populate the serialization domain. -/ -lemma committed_rw_serializable_witness +theorem committed_rw_serializable_witness : ∃ (trace : GlobalTrace) (state : State) (left right : Nat × Response), let (leftIndex, left) := left let (rightIndex, right) := right diff --git a/lean/consistency/lake-manifest.json b/lean/consistency/lake-manifest.json index bfa17c9e300..ea6b42b218f 100644 --- a/lean/consistency/lake-manifest.json +++ b/lean/consistency/lake-manifest.json @@ -14,18 +14,6 @@ "inherited": false, "configFile": "lakefile.toml" }, - { - "url": "https://github.com/leanprover-community/mathlib4.git", - "type": "git", - "subDir": null, - "scope": "", - "rev": "56a005855ea17e0b0958f73ec801ae140b0a1679", - "name": "mathlib", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.35.0", - "inherited": false, - "configFile": "lakefile.lean" - }, { "type": "path", "scope": "", @@ -35,102 +23,6 @@ "dir": "../common", "copy": false, "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dfa4f38190d07c37e315953e08b90fe2d95b3c24", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/LeanSearchClient", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "d6b4c7be5be75ec4917c873ac50c756dc1436372", - "name": "LeanSearchClient", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/import-graph", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "a41f0e9a4dea23188ea9cc1c41ac9f8bbafe0b93", - "name": "importGraph", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/ProofWidgets4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "df72b022e558978a1c50264cfc4d7fec86fa8e04", - "name": "proofwidgets", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/aesop", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "4a174c490d8707121c4a9290800489f105d85e07", - "name": "aesop", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/quote4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dce0ad79c486cb1fb504af04f953c3466b0c6db8", - "name": "Qq", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/batteries", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "66e469188fe07963e5cf666c7d4433f45b8131c5", - "name": "batteries", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover/lean4-cli", - "type": "git", - "subDir": null, - "scope": "leanprover", - "rev": "c24fe6078c630e89b489bffe59b3e20ac30d12c8", - "name": "Cli", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.35.0", - "inherited": true, - "configFile": "lakefile.toml" } ], "name": "consistency", diff --git a/lean/consistency/lakefile.toml b/lean/consistency/lakefile.toml index a528b4d1c88..bf116aefea5 100644 --- a/lean/consistency/lakefile.toml +++ b/lean/consistency/lakefile.toml @@ -10,11 +10,6 @@ name = "ccf_common" path = "../common" copy = false -[[require]] -name = "mathlib" -git = "https://github.com/leanprover-community/mathlib4.git" -rev = "v4.35.0" - [[require]] name = "leanfmt" git = "https://github.com/duckki/leanfmt.git" diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Deadlock.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Deadlock.lean index 3aa6e93c95e..a8d2a7c6c46 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Deadlock.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Deadlock.lean @@ -3,8 +3,6 @@ module public import DisasterRecovery.Properties.Utils import all Init.Control.State -import Aesop -import Mathlib.Tactic.Lemma @[expose] public section @@ -67,7 +65,7 @@ private theorem advance_ready (config : Local.Config) (state : NodeState) | split at transition all_goals cases gossip : maximumGossip state.gossips <;> cases chosen : state.chosen <;> - simp_all [Ready, Capabilities.record] <;> aesop + simp_all [Ready, Capabilities.record] <;> grind private theorem advance_or_reject_ready (config : Local.Config) (state fallback : NodeState) (source : Location) (reason : String) @@ -113,34 +111,34 @@ private theorem step_ready (config : Local.Config) (state : NodeState) simp [Local.step, phase, StateT.run, Option.bind_eq_some_iff, Option.map_eq_some_iff] at transition all_goals first - | solve | aesop + | solve | grind | cases chosen : state.chosen <;> simp_all [Option.bind_eq_some_iff, Option.map_eq_some_iff, Capabilities.record] - <;> aesop + <;> grind | receiveGossip sender txid validation => cases validation <;> simp only [Local.step] at transition · split at transition · simp [rejected, Capabilities.record] at transition - aesop + grind · exact advance_or_reject_ready config _ state source _ (by simpa [Ready] using ready) ready after effects transition · simp [rejected, Capabilities.record] at transition - aesop + grind | receiveVote sender validation => cases validation <;> simp only [Local.step] at transition · exact advance_or_reject_ready config _ state source _ (by simpa [Ready] using ready) ready after effects transition · simp [rejected, Capabilities.record] at transition - aesop + grind | receiveIAmOpen sender validation => cases validation <;> simp only [Local.step] at transition · cases phase : state.phase <;> simp only [phase] at transition all_goals first | exact advance_or_reject_ready config _ state source _ (by simp [Ready]) ready after effects transition - | simp [rejected, Capabilities.record] at transition; aesop + | simp [rejected, Capabilities.record] at transition; grind · simp [rejected, Capabilities.record] at transition - aesop + grind @[local simp] private theorem effect_lift {S A : Type} (a : Option A) (s : S) @@ -336,7 +334,7 @@ theorem deadlock_free (config : Model.Config) rw [enabled] rfl -lemma deadlock_free_witness +theorem deadlock_free_witness : forall (config : Properties.ValidConfig), exists (state : Model.State), (transitionSystem config).Reachable state := by intro config diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Evaluation.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Evaluation.lean index 8c4cfa8fb2a..5a495352305 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Evaluation.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Evaluation.lean @@ -1,8 +1,7 @@ module public import DisasterRecovery.Properties.Utils - -import Mathlib.Data.Seq.Basic +public import CCF.Proofs.Execution @[expose] public section @@ -119,16 +118,16 @@ def ofSteps {system : TransitionSystem} (initial : system.State) (valid : StepsFrom system initial steps) : Execution.Trace system := ⟨ - { init := initial, steps := Stream'.Seq.ofList steps }, + { init := initial, steps := CCF.Seq.ofList steps }, initialized, by intro n before action first chosen - simp only [Stream'.Seq.map_get?, Stream'.Seq.ofList_get?] at chosen ⊢ + simp only [CCF.Seq.map_get?, CCF.Seq.ofList_get?] at chosen ⊢ rw [← List.getElem?_map] at chosen ⊢ refine stepsFrom_getElem? initial steps valid n before action ?_ chosen cases n <;> - simpa only [Stream'.Seq.get?_cons_zero, Stream'.Seq.get?_cons_succ, - Stream'.Seq.map_get?, Stream'.Seq.ofList_get?, List.getElem?_cons_zero, + simpa only [CCF.Seq.get?_cons_zero, CCF.Seq.get?_cons_succ, + CCF.Seq.map_get?, CCF.Seq.ofList_get?, List.getElem?_cons_zero, List.getElem?_cons_succ, List.getElem?_map] using first ⟩ @@ -139,8 +138,8 @@ theorem ofSteps_stateAt {system : TransitionSystem} {initial : system.State} = (initial :: steps.map Prod.snd)[n]? := by cases n <;> simp only [ofSteps, Execution.Trace.stateAt, Execution.Trace.states, - Stream'.Seq.get?_cons_zero, Stream'.Seq.get?_cons_succ, Stream'.Seq.map_get?, - Stream'.Seq.ofList_get?, List.getElem?_cons_zero, List.getElem?_cons_succ, + CCF.Seq.get?_cons_zero, CCF.Seq.get?_cons_succ, CCF.Seq.map_get?, + CCF.Seq.ofList_get?, List.getElem?_cons_zero, List.getElem?_cons_succ, List.getElem?_map] theorem ofSteps_actionAt {system : TransitionSystem} {initial : system.State} @@ -149,7 +148,7 @@ theorem ofSteps_actionAt {system : TransitionSystem} {initial : system.State} : (ofSteps initial steps initialized valid).actionAt n = (steps.map Prod.fst)[n]? := by simp only [ofSteps, Execution.Trace.actionAt, Execution.Trace.actions, - Stream'.Seq.map_get?, Stream'.Seq.ofList_get?, List.getElem?_map] + CCF.Seq.map_get?, CCF.Seq.ofList_get?, List.getElem?_map] theorem mem_ofSteps {system : TransitionSystem} {initial : system.State} {steps : List (system.Action × system.State)} {initialized : system.init initial} diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalWitnesses.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalWitnesses.lean index 6a15636bd21..54dc005ee0c 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalWitnesses.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/GlobalWitnesses.lean @@ -2,6 +2,7 @@ module public import DisasterRecovery.Proofs.Evaluation +import CCF.Function import all Init.Control.State @[expose] public section @@ -25,7 +26,7 @@ private abbrev table (config : Properties.ValidConfig) (states : Location → No private def initial (config : Properties.ValidConfig) : Model.State := { nodes := table config initialNode } -private lemma initialized (config : Properties.ValidConfig) +private theorem initialized (config : Properties.ValidConfig) : (Model.transitionSystem config).init (initial config) := by refine ⟨config.property, ?_, ?_, rfl, ?_⟩ · simp [initial, table, Function.comp_def] @@ -38,10 +39,10 @@ private def At (config : Properties.ValidConfig) (states : Location → NodeStat ∃ network, (Model.transitionSystem config).Reachable { nodes := table config states, network } -private lemma at_initial (config : Properties.ValidConfig) : At config initialNode := +private theorem at_initial (config : Properties.ValidConfig) : At config initialNode := ⟨[], .initial (initialized config)⟩ -private lemma lookup_table (config : Properties.ValidConfig) +private theorem lookup_table (config : Properties.ValidConfig) (states : Location → NodeState) (node : Location) (member : node ∈ config.val.protocol.expectedLocations) (network : List Model.Envelope) @@ -60,7 +61,7 @@ private lemma lookup_table (config : Properties.ValidConfig) ih (present.resolve_left (Ne.symm same))] simp [Function.comp_def, find_eq _ member] -private lemma update_table (config : Properties.ValidConfig) +private theorem update_table (config : Properties.ValidConfig) (states : Location → NodeState) (node : Location) (after : NodeState) : (table config states).map (fun entry => if entry.1 == node then (node, after) else entry) @@ -71,23 +72,23 @@ private lemma update_table (config : Properties.ValidConfig) by_cases same : n = node <;> simp [same, Function.update] @[local simp] -private lemma effect_bind {S A B : Type} (a : StateT S Option A) +private theorem effect_bind {S A B : Type} (a : StateT S Option A) (f : A → StateT S Option B) (s : S) : (a >>= f) s = (a s).bind (fun (a, s) => f a s) := rfl @[local simp] -private lemma effect_lift {S A : Type} (a : Option A) (s : S) +private theorem effect_lift {S A : Type} (a : Option A) (s : S) : (liftM a : StateT S Option A) s = a.map (fun a => (a, s)) := by cases a <;> rfl @[local simp] -private lemma effect_orElse {S A : Type} (a : StateT S Option A) +private theorem effect_orElse {S A : Type} (a : StateT S Option A) (b : Unit → StateT S Option A) (s : S) : (StateT.orElse a b) s = (a s <|> b () s) := rfl -private lemma recovered_exists (config : Properties.ValidConfig) (node : Location) +private theorem recovered_exists (config : Properties.ValidConfig) (node : Location) (member : node ∈ config.val.protocol.expectedLocations) : ∃ txid, Model.recoveredTxID config node = some txid := by have existsEntry : ∃ entry ∈ config.val.recovered, entry.1 = node := by @@ -99,7 +100,7 @@ private lemma recovered_exists (config : Properties.ValidConfig) (node : Locatio obtain ⟨entry, found⟩ := Option.isSome_iff_exists.mp found exact ⟨entry.2, by simp [Model.recoveredTxID, found]⟩ -private lemma protocol_run (config : Properties.ValidConfig) (node : Location) +private theorem protocol_run (config : Properties.ValidConfig) (node : Location) (txid : TxID) (before after : NodeState) (event : Event) (outputs : Outputs Location Message Notification) (recovered : Model.recoveredTxID config node = some txid) @@ -110,8 +111,8 @@ private lemma protocol_run (config : Properties.ValidConfig) (node : Location) = some (after, outputs) := by simpa [Model.protocol, StateT.run, recovered] using run -private lemma local_next (config : Properties.ValidConfig) (states : Location → NodeState) - (network : List Model.Envelope) (node : Location) +private theorem local_next (config : Properties.ValidConfig) + (states : Location → NodeState) (network : List Model.Envelope) (node : Location) (member : node ∈ config.val.protocol.expectedLocations) (input : Model.Input) (after : NodeState) (outputs : Outputs Location Message Notification) (run @@ -131,7 +132,7 @@ private lemma local_next (config : Properties.ValidConfig) (states : Location intro a _ by_cases same : a = node <;> simp [same, Function.update] -private lemma delivery_next (config : Properties.ValidConfig) +private theorem delivery_next (config : Properties.ValidConfig) (states : Location → NodeState) (network : List Model.Envelope) (envelope : Model.Envelope) (member : envelope.target ∈ config.val.protocol.expectedLocations) @@ -151,12 +152,12 @@ private lemma delivery_next (config : Properties.ValidConfig) network := MultiNodeTransitionSystem.removeOne envelope network ++ outputs.outgoing } := by - simp [MultiNodeTransitionSystem.next, queued, + simp [MultiNodeTransitionSystem.next, guard, queued, lookup_table config states envelope.target member, run] intro a _ by_cases same : a = envelope.target <;> simp [same, Function.update] -private lemma at_local {config : Properties.ValidConfig} {states : Location → NodeState} +private theorem at_local {config : Properties.ValidConfig} {states : Location → NodeState} (reachable : At config states) (node : Location) (member : node ∈ config.val.protocol.expectedLocations) (input : Model.Input) (after : NodeState) (outputs : Outputs Location Message Notification) @@ -170,7 +171,7 @@ private lemma at_local {config : Properties.ValidConfig} {states : Location → exact ⟨_, .step reachable (local_next config states network node member input after outputs run)⟩ -private lemma broadcast_run (source : Location) (message : Message) +private theorem broadcast_run (source : Location) (message : Message) (targets : List Location) (outputs : Outputs Location Message Notification) : (targets.foldlM (fun (_ : Unit) target => (Capabilities.record source).send message target) () @@ -196,14 +197,14 @@ private lemma broadcast_run (source : Location) (message : Message) simpa [List.append_assoc] using ih { outputs with outgoing := outputs.outgoing ++ [{ source, target, payload := message }] } -private lemma nonempty (config : Properties.ValidConfig) +private theorem nonempty (config : Properties.ValidConfig) : config.val.protocol.expectedLocations ≠ [] := by have valid := config.property.1 simp only [Config.isValid, Bool.and_eq_true] at valid intro empty simp [empty] at valid -private lemma retry_run (config : Properties.ValidConfig) (source : Location) +private theorem retry_run (config : Properties.ValidConfig) (source : Location) (txid : TxID) (state : NodeState) (phase : state.phase = .gossiping ∨ state.phase = .voting) (chosen : state.phase = .voting → state.chosen.isSome = true) @@ -219,7 +220,7 @@ private lemma retry_run (config : Properties.ValidConfig) (source : Location) rcases phase with phase | phase · refine ⟨{ outgoing := (config.val.protocol.expectedLocations.map (fun target => { source, target, payload := Message.gossip txid })) }, ?_, ?_, ?_⟩ - · simp [step, phase, nonempty config] + · simp [step, phase, nonempty config, guard] exact ⟨(), by simpa using (broadcast_run source (.gossip txid) config.val.protocol.expectedLocations {})⟩ · intro target member @@ -245,7 +246,7 @@ private lemma retry_run (config : Properties.ValidConfig) (source : Location) · intro other _ eq simp_all -private lemma send_deliver {config : Properties.ValidConfig} +private theorem send_deliver {config : Properties.ValidConfig} {states : Location → NodeState} (reachable : At config states) (source target : Location) (payload : Message) (sourceMember : source ∈ config.val.protocol.expectedLocations) @@ -280,7 +281,7 @@ private def collect : List (Location × TxID) → List (Location × TxID) | [] => [] | entry :: rest => insertGossip entry.1 entry.2 (collect rest) -private lemma collect_perm (entries : List (Location × TxID)) +private theorem collect_perm (entries : List (Location × TxID)) (distinct : (entries.map Prod.fst).Nodup) : (collect entries).Perm entries := by induction entries with @@ -296,7 +297,7 @@ private lemma collect_perm (entries : List (Location × TxID)) simp only [collect, insertGossip, absent] exact (List.mergeSort_perm _ _).trans (List.Perm.cons _ perm) -private lemma maximum_member {entries : List (Location × TxID)} +private theorem maximum_member {entries : List (Location × TxID)} {entry : Location × TxID} (selected : maximumGossip entries = some entry) : entry ∈ entries := by cases entries with @@ -318,7 +319,8 @@ private lemma maximum_member {entries : List (Location × TxID)} · exact List.mem_cons_of_mem _ (List.mem_cons_of_mem _ member) exact fold_member tail head -private lemma maximum_exists (entries : List (Location × TxID)) (nonempty : entries ≠ []) +private theorem maximum_exists (entries : List (Location × TxID)) + (nonempty : entries ≠ []) : ∃ entry, maximumGossip entries = some entry := by cases entries with | nil => contradiction @@ -342,7 +344,7 @@ private def gathered (config : Properties.ValidConfig) (node : Location) none } -private lemma gathered_empty (config : Properties.ValidConfig) (node : Location) +private theorem gathered_empty (config : Properties.ValidConfig) (node : Location) : gathered config node [] = initialNode node := by have positive : 0 < config.val.protocol.expectedLocations.length := List.length_pos_iff.mpr (nonempty config) @@ -354,7 +356,7 @@ private def Active (config : Properties.ValidConfig) (states : Location → Node ((states node).phase = .gossiping ∨ (states node).phase = .voting) ∧ ((states node).phase = .voting → (states node).chosen.isSome = true) -private lemma gathered_active (config : Properties.ValidConfig) (node : Location) +private theorem gathered_active (config : Properties.ValidConfig) (node : Location) (entries : List (Location × TxID)) (distinct : (entries.map Prod.fst).Nodup) : ((gathered config node entries).phase = .gossiping @@ -373,7 +375,7 @@ private lemma gathered_active (config : Properties.ValidConfig) (node : Location simp [gathered, full, selected] · simp [gathered, full] -private lemma active_update {config : Properties.ValidConfig} +private theorem active_update {config : Properties.ValidConfig} {states : Location → NodeState} (active : Active config states) (node : Location) (after : NodeState) (next @@ -385,7 +387,7 @@ private lemma active_update {config : Properties.ValidConfig} · simpa [same] using next · simpa [Function.update, same] using active other member -private lemma recovered_of_mem (config : Properties.ValidConfig) +private theorem recovered_of_mem (config : Properties.ValidConfig) (entry : Location × TxID) (member : entry ∈ config.val.recovered) : Model.recoveredTxID config entry.1 = some entry.2 := by have distinct : (config.val.recovered.map Prod.fst).Nodup := by @@ -408,7 +410,7 @@ private lemma recovered_of_mem (config : Properties.ValidConfig) simp [List.find?, beq_eq_false_iff_ne.mpr different, ih distinct.2 member] exact lookup _ distinct member -private lemma gossip_gathered_run (config : Properties.ValidConfig) (node : Location) +private theorem gossip_gathered_run (config : Properties.ValidConfig) (node : Location) (recovered : TxID) (entry : Location × TxID) (rest : List (Location × TxID)) (distinct : ((entry :: rest).map Prod.fst).Nodup) @@ -439,7 +441,7 @@ private lemma gossip_gathered_run (config : Properties.ValidConfig) (node : Loca advanceTimeoutLane, ins, full, length] rfl -private lemma fill_node (config : Properties.ValidConfig) (target : Location) +private theorem fill_node (config : Properties.ValidConfig) (target : Location) (targetMember : target ∈ config.val.protocol.expectedLocations) (entries : List (Location × TxID)) (distinct : (entries.map Prod.fst).Nodup) @@ -483,7 +485,7 @@ private lemma fill_node (config : Properties.ValidConfig) (target : Location) (by simpa [before, Model.protocol, Model.receive] using receive) simpa [before] using next -private lemma fill_nodes (config : Properties.ValidConfig) (targets : List Location) +private theorem fill_nodes (config : Properties.ValidConfig) (targets : List Location) (distinct : targets.Nodup) (subset : ∀ target ∈ targets, target ∈ config.val.protocol.expectedLocations) (states : Location → NodeState) (reachable : At config states) @@ -538,7 +540,7 @@ private lemma fill_nodes (config : Properties.ValidConfig) (targets : List Locat rw [unchanged other (fun member => absent (by simp [member]))] simp [next, different] -private lemma full_gossip_reachable (config : Properties.ValidConfig) +private theorem full_gossip_reachable (config : Properties.ValidConfig) : At config (fun node => gathered config node config.val.recovered) := by obtain ⟨states, reachable, _, filled, _⟩ := fill_nodes config config.val.protocol.expectedLocations config.property.2.1 @@ -563,7 +565,7 @@ private def selected (config : Properties.ValidConfig) (winner node : Location) gossips := collect config.val.recovered } -private lemma full_choice (config : Properties.ValidConfig) +private theorem full_choice (config : Properties.ValidConfig) : ∃ winner ∈ config.val.protocol.expectedLocations, (∀ node, gathered config node config.val.recovered = selected config winner node) ∧ At config (selected config winner) := by @@ -595,7 +597,7 @@ private def ballots : List Location → List Location | [] => [] | source :: rest => insertVote source (ballots rest) -private lemma ballots_perm (sources : List Location) (distinct : sources.Nodup) +private theorem ballots_perm (sources : List Location) (distinct : sources.Nodup) : (ballots sources).Perm sources := by induction sources with | nil => exact .nil @@ -619,11 +621,11 @@ private def voted (config : Properties.ValidConfig) (winner : Location) if voteQuorum config.val.protocol ≤ sources.length then some .quorum else none } -private lemma voted_nil (config : Properties.ValidConfig) (winner : Location) +private theorem voted_nil (config : Properties.ValidConfig) (winner : Location) : voted config winner [] = selected config winner winner := by simp [voted, ballots, voteQuorum, selected] -private lemma voted_active (config : Properties.ValidConfig) (winner : Location) +private theorem voted_active (config : Properties.ValidConfig) (winner : Location) (sources : List Location) (small : sources.length < voteQuorum config.val.protocol) : ((voted config winner sources).phase = .gossiping ∨ (voted config winner sources).phase = .voting) @@ -631,7 +633,7 @@ private lemma voted_active (config : Properties.ValidConfig) (winner : Location) → (voted config winner sources).chosen.isSome = true) := by simp [voted, selected, Nat.not_le.mpr small] -private lemma vote_run (config : Properties.ValidConfig) (winner source : Location) +private theorem vote_run (config : Properties.ValidConfig) (winner source : Location) (recovered : TxID) (rest : List Location) (distinct : (source :: rest).Nodup) (bound : (source :: rest).length ≤ voteQuorum config.val.protocol) : (step (Capabilities.record winner) config.val.protocol recovered @@ -663,7 +665,7 @@ private lemma vote_run (config : Properties.ValidConfig) (winner source : Locati full, length, advanceTimeoutLane] rfl -private lemma collect_votes (config : Properties.ValidConfig) (winner : Location) +private theorem collect_votes (config : Properties.ValidConfig) (winner : Location) (winnerMember : winner ∈ config.val.protocol.expectedLocations) (reachable : At config (selected config winner)) (sources : List Location) (distinct : sources.Nodup) @@ -711,19 +713,19 @@ private lemma collect_votes (config : Properties.ValidConfig) (winner : Location (by simpa [before, Model.protocol, Model.receive] using receive) simpa [before] using next -private lemma quorum_bound (config : Properties.ValidConfig) +private theorem quorum_bound (config : Properties.ValidConfig) : voteQuorum config.val.protocol ≤ config.val.protocol.expectedLocations.length := by have positive := List.length_pos_iff.mpr (nonempty config) unfold voteQuorum omega -private lemma recovered_distinct (config : Properties.ValidConfig) +private theorem recovered_distinct (config : Properties.ValidConfig) : (config.val.recovered.map Prod.fst).Nodup := by rw [config.property.2.2] exact config.property.2.1 /-- A full gossip exchange followed by a quorum of genuine votes reaches a quorum opener. -/ -lemma quorum_open_preserves_commit_witness +theorem quorum_open_preserves_commit_witness : ∀ config : Properties.ValidConfig, ∃ (trace : Properties.GlobalTrace config) (openedState : Model.State), ∃ (opener : Location) (openerState : NodeState), @@ -776,7 +778,7 @@ private def failedOver (config : Properties.ValidConfig) (winner : Location) phase := .opening, timeoutState := .opening, openKind := some .failover } -private lemma failover_reachable (config : Properties.ValidConfig) +private theorem failover_reachable (config : Properties.ValidConfig) (multiple : 2 ≤ config.val.protocol.expectedLocations.length) (winner : Location) (winnerMember : winner ∈ config.val.protocol.expectedLocations) (reachable : At config (selected config winner)) @@ -821,7 +823,7 @@ private lemma failover_reachable (config : Properties.ValidConfig) simpa using final /-- With at least two locations, one genuine vote and two timeouts reach failover. -/ -lemma full_gossip_preserves_commit_witness +theorem full_gossip_preserves_commit_witness : ∀ config : Properties.ValidConfig, 2 ≤ config.val.protocol.expectedLocations.length → ∃ (trace : Properties.GlobalTrace config) @@ -856,7 +858,7 @@ lemma full_gossip_preserves_commit_witness exact (collect_perm config.val.recovered (recovered_distinct config)).mem_iff · exact List.mem_map.mpr ⟨winner, winnerMember, by simp [states]⟩ -private lemma steps_snoc {system : TransitionSystem} (start before after : system.State) +private theorem steps_snoc {system : TransitionSystem} (start before after : system.State) (steps : List (system.Action × system.State)) (action : system.Action) (valid : StepsFrom system start steps) (last : (start :: steps.map Prod.snd)[steps.length]? = some before) @@ -873,7 +875,7 @@ private lemma steps_snoc {system : TransitionSystem} (start before after : syste refine ⟨first, ih pair.2 valid ?_⟩ simpa using last -private lemma snoc_before {α β : Type} (start before after : β) +private theorem snoc_before {α β : Type} (start before after : β) (steps : List (α × β)) (action : α) (last : (start :: steps.map Prod.snd)[steps.length]? = some before) : (start :: (steps ++ [(action, after)]).map Prod.snd)[steps.length]? @@ -883,7 +885,7 @@ private lemma snoc_before {α β : Type} (start before after : β) rw [List.getElem?_append] simpa using last -private lemma snoc_after {α β : Type} (start after : β) +private theorem snoc_after {α β : Type} (start after : β) (steps : List (α × β)) (action : α) : (start :: (steps ++ [(action, after)]).map Prod.snd)[steps.length + 1]? = some after := by @@ -892,7 +894,7 @@ private lemma snoc_after {α β : Type} (start after : β) rw [List.getElem?_append] simp -private lemma reachable_finite {system : TransitionSystem} {state : system.State} +private theorem reachable_finite {system : TransitionSystem} {state : system.State} (reachable : system.Reachable state) : ∃ (start : system.State) (steps : List (system.Action × system.State)), system.init start @@ -906,7 +908,7 @@ private lemma reachable_finite {system : TransitionSystem} {state : system.State steps_snoc start before after steps action valid last enabled, ?_⟩ simp -private lemma notification_exists (config : Properties.ValidConfig) +private theorem notification_exists (config : Properties.ValidConfig) (states : Location → NodeState) (network : List Model.Envelope) (reachable : (Model.transitionSystem config).Reachable @@ -949,7 +951,7 @@ private lemma notification_exists (config : Properties.ValidConfig) using lookup_table config nextStates envelope.target member afterGlobal.network /-- The final vote of a quorum emits an opening notification in a valid finite trace. -/ -lemma quorum_opener_unique_witness +theorem quorum_opener_unique_witness : ∀ config : Properties.ValidConfig, ∃ (trace : Properties.GlobalTrace config) (index : Nat) (opener : Location), Properties.Trace.NotificationAt config trace index opener @@ -999,10 +1001,11 @@ lemma quorum_opener_unique_witness .step (action := .local source .retry) reachableRest sentStep have full : voteQuorum config.val.protocol ≤ (source :: rest).length := by rw [← eq, length] + exact Nat.le_refl _ have receive := protocol_run config winner targetTxID (voted config winner rest) (voted config winner (source :: rest)) (.receiveVote source .accepted) _ targetRecovered - (vote_run config winner source targetTxID rest distinct' (by rw [← eq, length])) + (vote_run config winner source targetTxID rest distinct' (by rw [← eq, length]; exact Nat.le_refl _)) exact notification_exists config states (network ++ sent.outgoing) reachableSent { source, target := winner, payload := .vote } winnerMember diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Local.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Local.lean index dbf488b3ee3..8749d864e3c 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Local.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Local.lean @@ -12,28 +12,28 @@ open CCF open Model.Local @[local simp] -private lemma effect_bind {S A B : Type} (a : StateT S Option A) +private theorem effect_bind {S A B : Type} (a : StateT S Option A) (f : A -> StateT S Option B) (s : S) : (a >>= f) s = (a s).bind (fun (a, s) => f a s) := rfl @[local simp] -private lemma effect_lift {S A : Type} (a : Option A) (s : S) +private theorem effect_lift {S A : Type} (a : Option A) (s : S) : (liftM a : StateT S Option A) s = a.map (fun a => (a, s)) := by cases a <;> rfl -private lemma effect_orElse_internal {S A : Type} (a : StateT S Option A) +private theorem effect_orElse_internal {S A : Type} (a : StateT S Option A) (b : Unit -> StateT S Option A) (s : S) : (StateT.orElse a b) s = (a s <|> b () s) := rfl @[local simp] -private lemma effect_orElse {S A : Type} (a : StateT S Option A) +private theorem effect_orElse {S A : Type} (a : StateT S Option A) (b : Unit -> StateT S Option A) (s : S) : (StateT.orElse a b) s = (a s <|> b () s) := effect_orElse_internal a b s -private lemma validStep_run {config : Model.Config} +private theorem validStep_run {config : Model.Config} {s : MultiNodeTransitionSystem.LocalStep Location NodeState Event Message Notification} (valid : (Model.protocol config).ValidStep s) @@ -43,11 +43,12 @@ private lemma validStep_run {config : Model.Config} s.action).run {} = some (s.after, s.effects) := by - simpa [MultiNodeTransitionSystem.Protocol.ValidStep, Model.protocol, StateT.run, - Option.bind_eq_some_iff, Option.map_eq_some_iff] - using valid + simp [MultiNodeTransitionSystem.Protocol.ValidStep, Model.protocol, StateT.run, + Option.bind_eq_some_iff, Option.map_eq_some_iff] at valid + obtain ⟨_, _, ⟨_, found, rfl, rfl⟩, stepped⟩ := valid + exact ⟨_, found, stepped⟩ -lemma gossip_freezes_after_choice +theorem gossip_freezes_after_choice : forall (config : Model.Config), forall localStep : Properties.LocalStep, forall (source : Model.Local.Location) (txid : Model.Local.TxID), @@ -65,7 +66,7 @@ lemma gossip_freezes_after_choice obtain ⟨states, effects⟩ := run exact ⟨states.symm, by rw [← effects]; simp⟩ -lemma rejected_gossip_stutters +theorem rejected_gossip_stutters : forall (config : Model.Config), forall localStep : Properties.LocalStep, forall (source : Model.Local.Location) (txid : Model.Local.TxID), @@ -80,7 +81,7 @@ lemma rejected_gossip_stutters obtain ⟨states, effects⟩ := run exact ⟨states.symm, by rw [← effects]; simp⟩ -private lemma quorum_advance_opens (config : Config) (state : NodeState) +private theorem quorum_advance_opens (config : Config) (state : NodeState) (source : Location) (timeout : Bool) (phase : state.phase = .voting) (quorum : state.votes.length >= voteQuorum config) : exists next effects, @@ -94,10 +95,9 @@ private lemma quorum_advance_opens (config : Config) (state : NodeState) simp [empty, voteQuorum] at quorum simp [advance, phase, quorum, nonempty] cases timeout <;> - simp [Capabilities.record, advanceTimeoutLane, advanceTimeoutState, - ] + simp [Capabilities.record, advanceTimeoutLane, advanceTimeoutState, and_assoc] -lemma quorum_step_opens +theorem quorum_step_opens : forall (config : Model.Config), forall localStep : Properties.LocalStep, ((Model.protocol config).ValidStep localStep @@ -136,7 +136,7 @@ lemma quorum_step_opens obtain ⟨rfl, rfl⟩ := Prod.mk.inj (Option.some.inj run) exact ⟨opening, kind, notification⟩ -lemma aligned_opening_timeout_completes +theorem aligned_opening_timeout_completes : forall (config : Model.Config), forall localStep : Properties.LocalStep, ((Model.protocol config).ValidStep localStep diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Safety.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Safety.lean index e5f1bdd056f..1bc55ca269b 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Safety.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Safety.lean @@ -1,11 +1,8 @@ module public import DisasterRecovery.Properties.Utils -public import CCF.Execution -public import Mathlib.Order.Basic +public import CCF.Proofs.Execution public import DisasterRecovery.Model -public import Mathlib.Data.Finset.Card -public import Mathlib.Tactic.CasesM import all Init.Control.State @@ -27,7 +24,7 @@ private inductive Path (system : TransitionSystem) (rest : Path system middle tail after) : Path system before (middle :: tail) after -private lemma Path.reachable {system : TransitionSystem} {before tail after} +private theorem Path.reachable {system : TransitionSystem} {before tail after} (path : Path system before tail after) (reachable : system.Reachable before) : system.Reachable after := by induction path with @@ -804,7 +801,7 @@ namespace DisasterRecovery.Proofs.Trace open CCF variable {State : Type} -private lemma Path.run {system : TransitionSystem} {before tail after} +private theorem Path.run {system : TransitionSystem} {before tail after} (path : Path system before tail after) : exists actions, Execution.Run system before actions after := by induction path with @@ -814,7 +811,7 @@ private lemma Path.run {system : TransitionSystem} {before tail after} exact ⟨_, .cons step rest⟩ /-- Enabled steps connect a state of a valid trace to every later state of the trace. -/ -private lemma valid_path {system : TransitionSystem} {trace : Execution.Trace system} +private theorem valid_path {system : TransitionSystem} {trace : Execution.Trace system} (start count : Nat) {before after : system.State} (first : trace.stateAt start = some before) (last : trace.stateAt (start + count) = some after) @@ -837,15 +834,15 @@ private lemma valid_path {system : TransitionSystem} {trace : Execution.Trace sy exact ⟨_, .cons step rest⟩ /-- The later of two trace positions is also a trace position. -/ -private lemma max_isSome {trace : Stream'.Seq State} {first second : Nat} +private theorem max_isSome {trace : CCF.Seq State} {first second : Nat} (firstIn : (trace.get? first).isSome) (secondIn : (trace.get? second).isSome) : (trace.get? (max first second)).isSome := by - rcases le_total first second with le | le - · rwa [max_eq_right le] - · rwa [max_eq_left le] + rcases Nat.le_total first second with le | le + · rwa [Nat.max_eq_right le] + · rwa [Nat.max_eq_left le] /-- Finitely many trace positions all lie at or before one trace position after `start`. -/ -private lemma exists_bound {α : Type} {trace : Stream'.Seq State} {P : α -> Nat -> Prop} +private theorem exists_bound {α : Type} {trace : CCF.Seq State} {P : α -> Nat -> Prop} {start : Nat} (startIn : (trace.get? start).isSome) (items : List α) (indexed : forall item, @@ -855,7 +852,7 @@ private lemma exists_bound {α : Type} {trace : Stream'.Seq State} {P : α -> Na /\ start <= bound /\ forall item, item ∈ items -> exists index, index <= bound /\ P item index := by induction items with - | nil => exact ⟨start, startIn, le_rfl, by simp⟩ + | nil => exact ⟨start, startIn, Nat.le_refl _, by simp⟩ | cons head tail ih => obtain ⟨headIndex, headIn, headHolds⟩ := indexed head (by simp) obtain ⟨bound, boundIn, startLe, bounded⟩ := @@ -863,13 +860,13 @@ private lemma exists_bound {α : Type} {trace : Stream'.Seq State} {P : α -> Na refine ⟨ max headIndex bound, max_isSome headIn boundIn, - startLe.trans (le_max_right _ _), + Nat.le_trans startLe (Nat.le_max_right _ _), fun item member => ?_ ⟩ rcases List.mem_cons.mp member with rfl | member - · exact ⟨headIndex, le_max_left _ _, headHolds⟩ + · exact ⟨headIndex, Nat.le_max_left _ _, headHolds⟩ · obtain ⟨index, le, holds⟩ := bounded item member - exact ⟨index, le.trans (le_max_right _ _), holds⟩ + exact ⟨index, Nat.le_trans le (Nat.le_max_right _ _), holds⟩ end DisasterRecovery.Proofs.Trace @@ -879,7 +876,7 @@ open Execution open Execution.Local hiding Config open Execution.Global Predicates -private lemma recovered_configured +private theorem recovered_configured {config : Config} {node : Location} (keys : config.recovered.map Prod.fst = config.protocol.expectedLocations) @@ -894,7 +891,7 @@ private lemma recovered_configured rw [←keys, ←key] exact List.mem_map_of_mem member -private lemma retryMessages_source +private theorem retryMessages_source {config : Config} {source : Location} {sourceState : NodeState} @@ -923,7 +920,7 @@ private lemma retryMessages_source rcases created with ⟨effect, _, produced⟩ exact messageForEffect_source produced -private lemma retryMessages_valid +private theorem retryMessages_valid (config : Config) (source : Location) (sourceState : NodeState) @@ -939,7 +936,7 @@ private lemma retryMessages_valid · rw [sourceEq, stateEq] exact created -private lemma valid_envelope_effect +private theorem valid_envelope_effect {config : Config} {envelope : Envelope} (valid : envelope.Valid config) @@ -951,7 +948,7 @@ private lemma valid_envelope_effect rw [retryMessages, List.mem_filterMap] at created exact created -private lemma valid_gossip_uses_recovered_txid +private theorem valid_gossip_uses_recovered_txid {config : Config} {envelope : Envelope} {txid : TxID} @@ -973,7 +970,7 @@ private lemma valid_gossip_uses_recovered_txid cases gossip | opening _ | restart _ | completed | rejected _ => cases created -private lemma advance_location {config : Execution.Local.Config} {state : NodeState} +private theorem advance_location {config : Execution.Local.Config} {state : NodeState} {timeout : Bool} {output : StepOutput} (advanced : advance config state timeout = some output) : output.state.location = state.location := by @@ -1001,7 +998,7 @@ private lemma advance_location {config : Execution.Local.Config} {state : NodeSt · cases advanced exact lane_location _ timeout -private lemma step_preserves_location +private theorem step_preserves_location (config : Execution.Local.Config) (state : NodeState) (event : Event) @@ -1044,7 +1041,7 @@ private lemma step_preserves_location cases stepped rfl -private lemma nodeState_location +private theorem nodeState_location {state : State} {node : Location} {foundState : NodeState} @@ -1062,7 +1059,7 @@ private lemma nodeState_location have keyEq : entry.1 = node := beq_iff_eq.mp condition rw [←stateEq, locations entry membership, keyEq] -private lemma initial_well_formed +private theorem initial_well_formed (config : Config) (nodes : List Location) (valid : config.Valid) @@ -1080,7 +1077,7 @@ private lemma initial_well_formed · constructor <;> simp [Execution.Global.initial] @[simp] -private lemma recordEffects_system +private theorem recordEffects_system (node : Location) (nodeState : NodeState) (effects : List Effect) @@ -1097,7 +1094,7 @@ private lemma recordEffects_system cases effect <;> rfl @[simp] -private lemma recordEffects_network +private theorem recordEffects_network (node : Location) (nodeState : NodeState) (effects : List Effect) @@ -1114,7 +1111,7 @@ private lemma recordEffects_network cases effect <;> rfl @[simp] -private lemma recordEffects_sent +private theorem recordEffects_sent (node : Location) (nodeState : NodeState) (effects : List Effect) @@ -1130,7 +1127,7 @@ private lemma recordEffects_sent rw [ih] cases effect <;> rfl -private lemma reachable_config_valid +private theorem reachable_config_valid {config : Config} {state : State} (reachable : Reachable config state) @@ -1142,7 +1139,7 @@ private lemma reachable_config_valid exact valid | step _ _ valid => exact valid -private lemma recordEffects_preserves_histories_configured +private theorem recordEffects_preserves_histories_configured {config : Config} {node : Location} {nodeState : NodeState} @@ -1186,7 +1183,7 @@ private lemma recordEffects_preserves_histories_configured apply ih exact recordEffect_preserves_histories_configured wellFormed nodeConfigured -private lemma replaceNode_keys +private theorem replaceNode_keys (target : Location) (nextState : NodeState) (nodes : List (Prod Location NodeState)) @@ -1207,7 +1204,7 @@ private lemma replaceNode_keys simp only [List.cons.injEq, true_and] simpa [replaceNode] using ih -private lemma systemStep_node_keys_eq +private theorem systemStep_node_keys_eq {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -1222,7 +1219,7 @@ private lemma systemStep_node_keys_eq exact replaceNode_keys target (step config node event).state before.nodes -private lemma systemStep_preserves_node_locations +private theorem systemStep_preserves_node_locations {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -1263,7 +1260,7 @@ private lemma systemStep_preserves_node_locations (p := fun entry : Prod Location NodeState => entry.1 == target) found) -private lemma retry_cases +private theorem retry_cases {config : Config} {before after : State} {source : Location} @@ -1283,7 +1280,7 @@ private lemma retry_cases obtain ⟨recovered, sourceState, found, _, rfl⟩ := transition exact ⟨recovered, sourceState, found, rfl⟩ -private lemma deliver_cases +private theorem deliver_cases {config : Config} {before after : State} {envelope : Envelope} @@ -1302,7 +1299,7 @@ private lemma deliver_cases obtain ⟨pending, recovered, ⟨system, output⟩, stepped, rfl⟩ := transition exact ⟨pending, recovered, system, output, stepped, rfl⟩ -private lemma timeout_cases +private theorem timeout_cases {config : Config} {before after : State} {target : Location} @@ -1319,7 +1316,7 @@ private lemma timeout_cases obtain ⟨recovered, ⟨system, output⟩, stepped, accepted, rfl⟩ := transition exact ⟨recovered, system, output, stepped, accepted, rfl⟩ -private lemma retry_system_eq +private theorem retry_system_eq {config : Config} {before after : State} {source : Location} @@ -1328,7 +1325,7 @@ private lemma retry_system_eq obtain ⟨_, sourceState, _, rfl⟩ := retry_cases transition rfl -private lemma deliver_preserves_well_formed +private theorem deliver_preserves_well_formed {config : Config} {before after : State} {envelope : Envelope} @@ -1377,7 +1374,7 @@ private lemma deliver_preserves_well_formed · exact recovered_configured wellFormed.recoveredKeys (Option.isSome_iff_ne_none.mp targetRecovered) -private lemma timeout_preserves_well_formed +private theorem timeout_preserves_well_formed {config : Config} {before after : State} {target : Location} @@ -1414,7 +1411,7 @@ private lemma timeout_preserves_well_formed · exact recovered_configured wellFormed.recoveredKeys (Option.isSome_iff_ne_none.mp targetRecovered) -private lemma reachable_well_formed +private theorem reachable_well_formed {config : Config} {state : State} (reachable : Reachable config state) @@ -1491,31 +1488,31 @@ open DisasterRecovery.Proofs.Invariants attribute [local simp] Execution.Local.transitionSystem rejectionReason guard failure @[local simp] -private lemma lane_phase (state : NodeState) (timeout : Bool) +private theorem lane_phase (state : NodeState) (timeout : Bool) : (advanceTimeoutLane state timeout).phase = state.phase := by cases timeout <;> rfl @[local simp] -private lemma lane_votes (state : NodeState) (timeout : Bool) +private theorem lane_votes (state : NodeState) (timeout : Bool) : (advanceTimeoutLane state timeout).votes = state.votes := by cases timeout <;> rfl @[local simp] -private lemma lane_gossips (state : NodeState) (timeout : Bool) +private theorem lane_gossips (state : NodeState) (timeout : Bool) : (advanceTimeoutLane state timeout).gossips = state.gossips := by cases timeout <;> rfl @[local simp] -private lemma lane_chosen (state : NodeState) (timeout : Bool) +private theorem lane_chosen (state : NodeState) (timeout : Bool) : (advanceTimeoutLane state timeout).chosen = state.chosen := by cases timeout <;> rfl @[local simp] -private lemma lane_openKind (state : NodeState) (timeout : Bool) +private theorem lane_openKind (state : NodeState) (timeout : Bool) : (advanceTimeoutLane state timeout).openKind = state.openKind := by cases timeout <;> rfl -private lemma eq_of_key_eq +private theorem eq_of_key_eq {α : Type} {nodes : List (Prod Location α)} (nodup : (nodes.map Prod.fst).Nodup) @@ -1544,7 +1541,7 @@ private lemma eq_of_key_eq exact ⟨first, firstTail, keyEq⟩ · exact ih tailNodup firstTail secondTail keyEq -private lemma AdvanceSpec.lane {config : Execution.Local.Config} {input : NodeState} +private theorem AdvanceSpec.lane {config : Execution.Local.Config} {input : NodeState} {timeout : Bool} {out : StepOutput} (stateEq : out.state = advanceTimeoutLane input timeout) (effectsEq : out.effects = []) @@ -1556,7 +1553,7 @@ private lemma AdvanceSpec.lane {config : Execution.Local.Config} {input : NodeSt opening := by simp [effectsEq] /-- Characterizes every successful phase advance once, so callers avoid re-unfolding it. -/ -private lemma advance_spec {config : Execution.Local.Config} {input : NodeState} +private theorem advance_spec {config : Execution.Local.Config} {input : NodeState} {timeout : Bool} {out : StepOutput} (advanced : advance config input timeout = some out) : AdvanceSpec config input out := by @@ -1618,7 +1615,7 @@ private lemma advance_spec {config : Execution.Local.Config} {input : NodeState} exact AdvanceSpec.lane rfl rfl /-- Characterizes every local step once; the per-field step lemmas below follow from it. -/ -private lemma step_spec (config : Execution.Local.Config) (state : NodeState) +private theorem step_spec (config : Execution.Local.Config) (state : NodeState) (event : Event) : StepSpec config state event (step config state event) := by have advance_getD_spec @@ -1673,7 +1670,7 @@ private lemma step_spec (config : Execution.Local.Config) (state : NodeState) split <;> try split all_goals simp -private lemma retry_sendVote_state +private theorem retry_sendVote_state {config : Execution.Local.Config} {state : NodeState} {target : Location} (member : .sendVote target ∈ (step config state .retry).effects) : state.phase = .voting /\ state.chosen = some target := by @@ -1681,7 +1678,7 @@ private lemma retry_sendVote_state cases phase : state.phase <;> simp [phase] at member cases chosen : state.chosen <;> simp_all -private lemma retry_vote_state +private theorem retry_vote_state {config : Config} {envelope : Envelope} (valid : envelope.Valid config) @@ -1708,7 +1705,7 @@ private lemma retry_vote_state | completed => cases created | rejected reason => cases created -private lemma opening_effect_state +private theorem opening_effect_state (config : Execution.Local.Config) (state : NodeState) (event : Event) @@ -1721,7 +1718,7 @@ private lemma opening_effect_state · obtain ⟨phase, openKind, _⟩ := (advance_spec advanced).opening kind opening exact ⟨phase, openKind⟩ -private lemma sentVote_mono +private theorem sentVote_mono {before after : State} {voter target : Location} (sent : forall envelope, envelope ∈ before.sent -> envelope ∈ after.sent) @@ -1731,7 +1728,7 @@ private lemma sentVote_mono ⟨envelope, membership, source, destination, payload⟩ exact ⟨envelope, sent envelope membership, source, destination, payload⟩ -private lemma opening_valid_of_sent_eq +private theorem opening_valid_of_sent_eq {config : Config} {before after : State} {opening : Opening} @@ -1753,7 +1750,7 @@ private lemma opening_valid_of_sent_eq exact sent · exact votesSent voter membership -private lemma recordEffects_preserves_openings_valid +private theorem recordEffects_preserves_openings_valid {config : Config} {node : Location} {nodeState : NodeState} @@ -1828,7 +1825,7 @@ private lemma recordEffects_preserves_openings_valid (by cases effect <;> rfl) exact newValid kind (by simp [membership]) -private lemma systemStep_preserves_votes_nodup +private theorem systemStep_preserves_votes_nodup {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -1873,7 +1870,7 @@ private lemma systemStep_preserves_votes_nodup exact nodup (key, node) (List.mem_of_find?_eq_some found) · exact nodup previous previousMember -private lemma systemStep_preserves_voting_selections +private theorem systemStep_preserves_voting_selections {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -1925,7 +1922,7 @@ private lemma systemStep_preserves_voting_selections exact valid previous previousMember (by simpa [notTarget] using voting) -private lemma systemStep_output_location +private theorem systemStep_output_location {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -1950,7 +1947,7 @@ private lemma systemStep_output_location fun entry : Prod Location NodeState => entry.1 == target) found) -private lemma systemStep_output_mem +private theorem systemStep_output_mem {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -1970,7 +1967,7 @@ private lemma systemStep_output_mem entry.1 == target) found) simp [keyEq, outputEq] -private lemma systemStep_opening_effect_state +private theorem systemStep_opening_effect_state {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -1986,7 +1983,7 @@ private lemma systemStep_opening_effect_state rw [←outputEq] at opening ⊢ exact opening_effect_state config node event kind opening -private lemma systemStep_quorum_effect_has_threshold +private theorem systemStep_quorum_effect_has_threshold {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -2012,7 +2009,7 @@ private lemma systemStep_quorum_effect_has_threshold rw [←outputEq] at opening ⊢ exact quorum_effect_has_threshold config node event opening -private lemma systemStep_preserves_node_votes_sent +private theorem systemStep_preserves_node_votes_sent {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -2104,7 +2101,7 @@ private lemma systemStep_preserves_node_votes_sent exact previousMember) voter (by simpa [notTarget] using vote) -private lemma systemStep_preserves_vote_stability +private theorem systemStep_preserves_vote_stability {config : Execution.Local.Config} {before after : SystemState} {target : Location} @@ -2180,7 +2177,7 @@ private lemma systemStep_preserves_vote_stability (by simpa [notTarget] using sourceEq) /-- Inverts a successful retry transition. -/ -private lemma next_retry_inv +private theorem next_retry_inv {config : Config} {before after : State} {source : Location} (transition : next config before (.retry source) = some after) : exists sourceState, @@ -2196,7 +2193,7 @@ private lemma next_retry_inv exact ⟨sourceState, found, stateEq⟩ /-- Inverts a successful delivery transition. -/ -private lemma next_deliver_inv +private theorem next_deliver_inv {config : Config} {before after : State} {envelope : Envelope} (transition : next config before (.deliver envelope) = some after) : exists system output, @@ -2211,7 +2208,7 @@ private lemma next_deliver_inv exact ⟨system, output, inNetwork, stepped, stateEq⟩ /-- Inverts a successful timeout transition. -/ -private lemma next_timeout_inv +private theorem next_timeout_inv {config : Config} {before after : State} {target : Location} (transition : next config before (.timeout target) = some after) : exists system output, @@ -2222,7 +2219,7 @@ private lemma next_timeout_inv rcases transition with ⟨_, system, output, stepped, _, stateEq⟩ exact ⟨system, output, stepped, stateEq⟩ -private lemma next_preserves_node_votes_nodup +private theorem next_preserves_node_votes_nodup {config : Config} {before after : State} {action : Action} @@ -2247,7 +2244,7 @@ private lemma next_preserves_node_votes_nodup exact systemStep_preserves_votes_nodup nodup systemStep entry membership -private lemma deliver_preserves_node_votes_sent +private theorem deliver_preserves_node_votes_sent {config : Config} {before after : State} {envelope : Envelope} @@ -2303,7 +2300,7 @@ private lemma deliver_preserves_node_votes_sent rfl votesSent carry introducedVote systemStep entry membership voter vote -private lemma timeout_preserves_node_votes_sent +private theorem timeout_preserves_node_votes_sent {config : Config} {before after : State} {target : Location} @@ -2340,7 +2337,7 @@ private lemma timeout_preserves_node_votes_sent rfl votesSent carry introducedVote systemStep entry membership voter vote -private lemma deliver_preserves_openings_valid +private theorem deliver_preserves_openings_valid {config : Config} {before after : State} {envelope : Envelope} @@ -2392,7 +2389,7 @@ private lemma deliver_preserves_openings_valid voter vote simpa [SentVote, delivered] using sent -private lemma timeout_preserves_openings_valid +private theorem timeout_preserves_openings_valid {config : Config} {before after : State} {target : Location} @@ -2439,7 +2436,7 @@ private lemma timeout_preserves_openings_valid voter vote simpa [SentVote, timedOut] using sent -private lemma deliver_preserves_sent_votes_functional +private theorem deliver_preserves_sent_votes_functional {config : Config} {before after : State} {envelope : Envelope} @@ -2454,7 +2451,7 @@ private lemma deliver_preserves_sent_votes_functional · simpa [SentVote] using firstVote · simpa [SentVote] using secondVote -private lemma timeout_preserves_sent_votes_functional +private theorem timeout_preserves_sent_votes_functional {config : Config} {before after : State} {target : Location} @@ -2468,7 +2465,7 @@ private lemma timeout_preserves_sent_votes_functional · simpa [SentVote] using firstVote · simpa [SentVote] using secondVote -private lemma reachable_quorum_invariant +private theorem reachable_quorum_invariant {config : Config} {state : State} (reachable : Reachable config state) @@ -2865,7 +2862,7 @@ private lemma reachable_quorum_invariant exact next_preserves_quorum_invariant (reachable_well_formed reachable) invariant transition -private lemma quorum_lists_intersect +private theorem quorum_lists_intersect {α : Type} (expected first second : List α) (firstNodup : first.Nodup) @@ -2875,33 +2872,18 @@ private lemma quorum_lists_intersect (firstQuorum : expected.length / 2 + 1 <= first.length) (secondQuorum : expected.length / 2 + 1 <= second.length) : exists value, value ∈ first /\ value ∈ second := by - classical - by_contra noShared - push Not at noShared - have disjoint : Disjoint first.toFinset second.toFinset := - Finset.disjoint_left.mpr (by - intro value firstMember secondMember - exact noShared value - (List.mem_toFinset.mp firstMember) - (List.mem_toFinset.mp secondMember)) - have unionSubset : - first.toFinset ∪ second.toFinset ⊆ expected.toFinset := by - intro value membership - rw [Finset.mem_union] at membership - rw [List.mem_toFinset] - exact membership.elim - (fun member => - firstSubset value (List.mem_toFinset.mp member)) - (fun member => - secondSubset value (List.mem_toFinset.mp member)) - have unionCard := Finset.card_le_card unionSubset - rw [Finset.card_union_of_disjoint disjoint, - List.toFinset_card_of_nodup firstNodup, - List.toFinset_card_of_nodup secondNodup] at unionCard - have expectedCard := List.toFinset_card_le expected + apply Classical.byContradiction + intro noShared + have nodup : (first ++ second).Nodup := + List.nodup_append.mpr ⟨firstNodup, secondNodup, + fun value firstMember _ secondMember same => + noShared ⟨value, firstMember, same ▸ secondMember⟩⟩ + have bound := nodup.length_le_of_subset (l₂ := expected) fun value member => + (List.mem_append.mp member).elim (firstSubset value) (secondSubset value) + rw [List.length_append] at bound omega -private lemma quorum_opener_unique +private theorem quorum_opener_unique {config : Config} {state : State} {first second : Location} @@ -2961,28 +2943,28 @@ open CCF open Model.Local @[simp] -private lemma effect_pure {S A : Type} (a : A) (s : S) +private theorem effect_pure {S A : Type} (a : A) (s : S) : (pure a : StateT S Option A) s = some (a, s) := rfl @[simp] -private lemma effect_bind {S A B : Type} (a : StateT S Option A) +private theorem effect_bind {S A B : Type} (a : StateT S Option A) (f : A -> StateT S Option B) (s : S) : (a >>= f) s = (a s).bind (fun (a, s) => f a s) := rfl @[simp] -private lemma effect_modify {S : Type} (f : S -> S) (s : S) +private theorem effect_modify {S : Type} (f : S -> S) (s : S) : (modify f : StateT S Option Unit) s = some ((), f s) := rfl @[simp] -private lemma effect_lift {S A : Type} (a : Option A) (s : S) +private theorem effect_lift {S A : Type} (a : Option A) (s : S) : (liftM a : StateT S Option A) s = a.map (fun a => (a, s)) := by cases a <;> rfl @[simp] -private lemma effect_failure {S A : Type} (s : S) +private theorem effect_failure {S A : Type} (s : S) : (failure : StateT S Option A) s = none := by have effect_failure_internal {S A : Type} (s : S) : (failure : StateT S Option A) s = none := @@ -2990,7 +2972,7 @@ private lemma effect_failure {S A : Type} (s : S) exact effect_failure_internal s @[simp] -private lemma effect_alternative {S A : Type} (a b : StateT S Option A) (s : S) +private theorem effect_alternative {S A : Type} (a b : StateT S Option A) (s : S) : (a <|> b) s = (a s <|> b s) := by have effect_orElse_internal {S A : Type} (a : StateT S Option A) (b : Unit -> StateT S Option A) (s : S) @@ -2998,7 +2980,7 @@ private lemma effect_alternative {S A : Type} (a b : StateT S Option A) (s : S) rfl exact effect_orElse_internal a (fun _ => b) s -private lemma validStep_run {config : Model.Config} +private theorem validStep_run {config : Model.Config} {s : MultiNodeTransitionSystem.LocalStep Location NodeState Event Message Notification} (valid : (Model.protocol config).ValidStep s) @@ -3008,9 +2990,10 @@ private lemma validStep_run {config : Model.Config} s.action).run {} = some (s.after, s.effects) := by - simpa [MultiNodeTransitionSystem.Protocol.ValidStep, Model.protocol, StateT.run, - Option.bind_eq_some_iff, Option.map_eq_some_iff] - using valid + simp [MultiNodeTransitionSystem.Protocol.ValidStep, Model.protocol, StateT.run, + Option.bind_eq_some_iff, Option.map_eq_some_iff] at valid + obtain ⟨_, _, ⟨_, found, rfl, rfl⟩, stepped⟩ := valid + exact ⟨_, found, stepped⟩ end DisasterRecovery.Proofs.Local @@ -3022,13 +3005,13 @@ open Execution.Local (messages) open DisasterRecovery.Proofs.Local attribute [local simp] StateT.run -private lemma messages_cons (source : Location) (recovered : TxID) +private theorem messages_cons (source : Location) (recovered : TxID) (effect : Execution.Local.Effect) (effects : List Execution.Local.Effect) : messages source recovered (effect :: effects) = messages source recovered [effect] ++ messages source recovered effects := by cases effect <;> rfl -private lemma messages_map (source : Location) (recovered : TxID) +private theorem messages_map (source : Location) (recovered : TxID) (send : Location -> Execution.Local.Effect) (message : Message) (sends : forall target, @@ -3042,7 +3025,7 @@ private lemma messages_map (source : Location) (recovered : TxID) | cons head tail ih => rw [List.map_cons, messages_cons, sends, ih]; rfl /-- The executable and instrumented phase advances agree, case by case, by computation. -/ -private lemma advance_run (config : Config) (source : Location) (recovered : TxID) +private theorem advance_run (config : Config) (source : Location) (recovered : TxID) (state : NodeState) (timeout : Bool) : advance (Capabilities.record source) config state timeout {} = (Execution.Local.advance config state timeout).map (toRun source recovered) := by @@ -3063,7 +3046,7 @@ private lemma advance_run (config : Config) (source : Location) (recovered : TxI all_goals rfl /-- Every instrumented advance is accepted and emits only notifications. -/ -private lemma advance_output (config : Config) (state : NodeState) (timeout : Bool) +private theorem advance_output (config : Config) (state : NodeState) (timeout : Bool) (output : Execution.Local.StepOutput) (h : Execution.Local.advance config state timeout = some output) (source : Location) (recovered : TxID) @@ -3090,7 +3073,7 @@ private lemma advance_output (config : Config) (state : NodeState) (timeout : Bo all_goals exact ⟨rfl, rfl⟩ /-- Receive events never disable the executable step; they match the instrumented step. -/ -private lemma receive_run (config : Config) (source : Location) (recovered : TxID) +private theorem receive_run (config : Config) (source : Location) (recovered : TxID) (state : NodeState) (event : Event) (notRetry : event ≠ .retry) (notTimeout : event ≠ .timeout) : (step (Capabilities.record source) config recovered state event).run {} @@ -3132,13 +3115,13 @@ private lemma receive_run (config : Config) (source : Location) (recovered : TxI rfl · rfl -private lemma timeout_run (config : Config) (source : Location) (recovered : TxID) +private theorem timeout_run (config : Config) (source : Location) (recovered : TxID) (state : NodeState) : (step (Capabilities.record source) config recovered state .timeout).run {} = (Execution.Local.advance config state true).map (toRun source recovered) := advance_run config source recovered state true -private lemma retry_recorded (config : Config) (source : Location) (recovered : TxID) +private theorem retry_recorded (config : Config) (source : Location) (recovered : TxID) (state : NodeState) : (step (Capabilities.record source) config recovered state .retry).run {} = (do @@ -3216,7 +3199,7 @@ private lemma retry_recorded (config : Config) (source : Location) (recovered : split <;> rfl all_goals exact effect_failure (A := NodeState) _ -private lemma step_erases (config : Config) (recovered : TxID) (state : NodeState) +private theorem step_erases (config : Config) (recovered : TxID) (state : NodeState) (event : Event) {source : Location} (output : Result) (h : ((step (Capabilities.record source) config recovered state event).run {}).map @@ -3262,7 +3245,7 @@ private lemma step_erases (config : Config) (recovered : TxID) (state : NodeStat all_goals nofun /-- Erasing snapshots can merge envelopes. Select before removing, using projected equality. -/ -private lemma first_matching_envelope +private theorem first_matching_envelope (envelopes : List Execution.Global.Envelope) (envelope : Model.Envelope) (present : envelope ∈ envelopes.map eraseEnvelope) : exists decorated, @@ -3292,7 +3275,7 @@ private lemma first_matching_envelope different, removed] · simp [first, selected] -private lemma transition_messages_empty (config : Config) (state : NodeState) +private theorem transition_messages_empty (config : Config) (state : NodeState) (event : Event) (source : Location) (recovered : TxID) (notRetry : event ≠ .retry) : messages source recovered (Execution.Local.step config state event).effects @@ -3337,7 +3320,7 @@ private lemma transition_messages_empty (config : Config) (state : NodeState) rfl · rfl -private lemma retry_messages_erases (config : Model.Config) (source : Location) +private theorem retry_messages_erases (config : Model.Config) (source : Location) (state : NodeState) (recovered : TxID) (found : Model.recoveredTxID config source = some recovered) : (Execution.Global.retryMessages config source state).map eraseEnvelope @@ -3356,7 +3339,7 @@ private lemma retry_messages_erases (config : Model.Config) (source : Location) rfl all_goals rfl -private lemma local_step_run (config : Config) (source : Location) (recovered : TxID) +private theorem local_step_run (config : Config) (source : Location) (recovered : TxID) (state : NodeState) (event : Event) : (step (Capabilities.record source) config recovered state event).run {} = (do @@ -3389,7 +3372,7 @@ private lemma local_step_run (config : Config) (source : Location) (recovered : · rfl all_goals nofun -private lemma scheduled_step_some (config : Model.Config) (before after : Model.State) +private theorem scheduled_step_some (config : Model.Config) (before after : Model.State) (node : Location) (event : Event) (h : (do @@ -3457,7 +3440,7 @@ private lemma scheduled_step_some (config : Model.Config) (before after : Model. exact ⟨nofun, rfl⟩ @[simp] -private lemma erase_recordEffects (node : Location) (state : NodeState) +private theorem erase_recordEffects (node : Location) (state : NodeState) (effects : List Execution.Local.Effect) (before : Execution.Global.State) : erase (Execution.Global.recordEffects node state effects before) = erase before := by @@ -3472,7 +3455,7 @@ open Execution.Local hiding Config open Execution.Global Predicates open DisasterRecovery.Proofs.Invariants DisasterRecovery.Proofs.Quorum -private lemma maximumGossip_mem +private theorem maximumGossip_mem {gossips : List (Prod Location TxID)} {selected : Prod Location TxID} (maximum : maximumGossip gossips = some selected) @@ -3505,7 +3488,7 @@ private lemma maximumGossip_mem rw [←maximum] exact foldl_selectMaximum_mem head tail -private lemma recoveredTxID_of_mem +private theorem recoveredTxID_of_mem {config : Config} {location : Location} {txid : TxID} @@ -3533,7 +3516,7 @@ private lemma recoveredTxID_of_mem eq_of_key_eq keysNodup foundMember membership foundLocation simp [same] -private lemma up_to_date_with_quorum_of_voters +private theorem up_to_date_with_quorum_of_voters {config : Config} {candidate : TxID} {voters : List Location} (nodup : voters.Nodup) (threshold : voteQuorum config.protocol <= voters.length) @@ -3555,18 +3538,15 @@ private lemma up_to_date_with_quorum_of_voters exact List.mem_of_find?_eq_some found let eligible := config.recovered.filter fun (_, voter) => decide (Properties.LogUpToDate candidate voter) - have subset : voters.toFinset ⊆ (eligible.map Prod.fst).toFinset := by + have subset : voters ⊆ eligible.map Prod.fst := by intro voter member - obtain ⟨txid, recovered, earlier⟩ := fresh voter (List.mem_toFinset.mp member) - apply List.mem_toFinset.mpr + obtain ⟨txid, recovered, earlier⟩ := fresh voter member apply List.mem_map.mpr refine ⟨(voter, txid), List.mem_filter.mpr ⟨mem_of_recoveredTxID recovered, ?_⟩, rfl⟩ exact decide_eq_true earlier - have count := Finset.card_le_card subset - rw [List.toFinset_card_of_nodup nodup] at count - have bound := List.toFinset_card_le (eligible.map Prod.fst) - rw [List.length_map] at bound - exact threshold.trans (count.trans bound) + have count := nodup.length_le_of_subset subset + rw [List.length_map] at count + exact Nat.le_trans threshold count end DisasterRecovery.Proofs.Committed @@ -3578,7 +3558,7 @@ open Execution.Local (messages) open DisasterRecovery.Proofs.Local attribute [local simp] StateT.run -private lemma step_lifts (config : Model.Config) +private theorem step_lifts (config : Model.Config) (before : Execution.Global.State) (action : Model.Action) (after : Model.State) (nodup : (before.system.nodes.map Prod.fst).Nodup) (h : (Model.transitionSystem config).step (erase before) action = some after) @@ -3614,7 +3594,7 @@ private lemma step_lifts (config : Model.Config) have member := List.mem_of_find?_eq_some selected have key : entry.1 = node := beq_iff_eq.mp (List.find?_some (p := fun entry : Location × NodeState => entry.1 == node) selected) - conv_rhs => rw [← List.map_id nodes] + conv => rhs; rw [← List.map_id nodes] apply List.map_congr_left intro other membership split @@ -3778,7 +3758,7 @@ private theorem model_initial_lifts (config : Model.Config) (state : Model.State (state.nodes.map Prod.fst).map (fun node => (node, initialNode node)) = state.nodes := by rw [List.map_map] - conv_rhs => rw [← List.map_id state.nodes] + conv => rhs; rw [← List.map_id state.nodes] apply List.map_congr_left intro entry member have initialized := nodes entry member @@ -3891,10 +3871,10 @@ open Execution.Local hiding Config open Execution.Global Predicates open DisasterRecovery.Proofs.Invariants DisasterRecovery.Proofs.Quorum -private lemma prefix_refl (txid : TxID) : TxID.EarlierThan txid txid := by +private theorem prefix_refl (txid : TxID) : TxID.EarlierThan txid txid := by simp [TxID.EarlierThan] -private lemma prefix_of_score_false +private theorem prefix_of_score_false (leftName rightName : Location) (left right : TxID) (score : txScoreGreater leftName left rightName right = false) @@ -3903,7 +3883,7 @@ private lemma prefix_of_score_false simp [TxID.EarlierThan] omega -private lemma maximumGossip_upper_bound +private theorem maximumGossip_upper_bound {gossips : List (Prod Location TxID)} {selected member : Prod Location TxID} (maximum : maximumGossip gossips = some selected) @@ -3985,10 +3965,10 @@ open Execution.Local hiding Config open Execution.Global open Invariants Quorum -private lemma evolves_refl (state : NodeState) : Evolves state state := +private theorem evolves_refl (state : NodeState) : Evolves state state := ⟨fun _ h => h, fun _ h => h, fun h => ⟨h, rfl⟩⟩ -private lemma advance_frame {config : Execution.Local.Config} {state : NodeState} +private theorem advance_frame {config : Execution.Local.Config} {state : NodeState} {timeout : Bool} {output : StepOutput} (advanced : advance config state timeout = some output) : Frame state output.state := by @@ -4017,7 +3997,7 @@ private lemma advance_frame {config : Execution.Local.Config} {state : NodeState · cases advanced exact frame_lane timeout ⟨rfl, rfl, id⟩ -private lemma step_genuine (config : Config) (state : NodeState) (event : Event) +private theorem step_genuine (config : Config) (state : NodeState) (event : Event) (prior : state.gossips ⊆ config.recovered) (incoming : EventGenuine config event) : (step config.protocol state event).state.gossips ⊆ config.recovered := by have insertGossip_genuine {config : Config} {state : NodeState} {source : Location} @@ -4078,7 +4058,7 @@ private lemma step_genuine (config : Config) (state : NodeState) (event : Event) cases stepped exact prior -private lemma next_genuine {config : Config} {before after : State} {action : Action} +private theorem next_genuine {config : Config} {before after : State} {action : Action} (wf : Predicates.WellFormed config before) (prior : Genuine config before.system.nodes) (transition : next config before action = some after) @@ -4132,7 +4112,7 @@ private lemma next_genuine {config : Config} {before after : State} {action : Ac simpa only [recordEffects_system] using systemStep_genuine prior (by trivial) updated -private lemma step_evolves (config : Execution.Local.Config) (state : NodeState) +private theorem step_evolves (config : Execution.Local.Config) (state : NodeState) (event : Event) : Evolves state (step config state event).state := by have insertGossip_extends (source : Location) (txid : TxID) @@ -4207,7 +4187,7 @@ private lemma step_evolves (config : Execution.Local.Config) (state : NodeState) cases stepped exact evolves_refl state -private lemma systemStep_evolves {config : Execution.Local.Config} +private theorem systemStep_evolves {config : Execution.Local.Config} {before after : SystemState} {target : Location} {event : Event} {output : StepOutput} (nodup : (before.nodes.map Prod.fst).Nodup) (transition : systemStep config before target event = some (after, output)) @@ -4229,7 +4209,7 @@ private lemma systemStep_evolves {config : Execution.Local.Config} · refine ⟨current, ?_, evolves_refl current⟩ exact List.mem_map.mpr ⟨(node, current), member, by simp [same]⟩ -private lemma next_evolves {config : Config} {before after : State} {action : Action} +private theorem next_evolves {config : Config} {before after : State} {action : Action} (wf : Predicates.WellFormed config before) (transition : next config before action = some after) {node : Location} {current : NodeState} (member : (node, current) ∈ before.system.nodes) @@ -4252,7 +4232,7 @@ private lemma next_evolves {config : Config} {before after : State} {action : Ac obtain ⟨_, ⟨system, output⟩, updated, _, rfl⟩ := transition simpa only [recordEffects_system] using systemStep_evolves wf.nodeKeysNodup updated member -private lemma trace_node_final {config : Model.Config} +private theorem trace_node_final {config : Model.Config} {trace : Properties.GlobalTrace config} {bound : Nat} {ghost : State} (linked : History.Correspondence config trace bound ghost) {i : Nat} {state : Model.State} (le : i <= bound) (found : trace.stateAt i = some state) @@ -4295,7 +4275,7 @@ private lemma trace_node_final {config : Model.Config} obtain ⟨suffix, run⟩ := linked.suffix i state le found exact steps_evolve run (trace.reachable (CCF.Execution.Trace.stateAt_mem found)) present -private lemma next_frozen {config : Config} {before after : State} {action : Action} +private theorem next_frozen {config : Config} {before after : State} {action : Action} (wf : Predicates.WellFormed config before) (prior : FrozenVotes before) (transition : next config before action = some after) @@ -4347,7 +4327,7 @@ private lemma next_frozen {config : Config} {before after : State} {action : Act obtain ⟨_, ⟨system, output⟩, _, _, rfl⟩ := transition simpa only [FrozenVotes, recordEffects_sent] using carry -private lemma reachable_gossip_invariant {config : Config} {state : State} +private theorem reachable_gossip_invariant {config : Config} {state : State} (reachable : Reachable config state) : Genuine config state.system.nodes /\ FrozenVotes state := by induction reachable @@ -4372,7 +4352,7 @@ open Execution.Local open Execution.Global hiding Config open Predicates -private lemma advance_threshold {config : Config} {state : NodeState} {timeout : Bool} +private theorem advance_threshold {config : Config} {state : NodeState} {timeout : Bool} {output : StepOutput} (advanced : advance config state timeout = some output) (threshold : Threshold config state) : Threshold config output.state := by @@ -4412,7 +4392,7 @@ private lemma advance_threshold {config : Config} {state : NodeState} {timeout : · cases advanced exact lane_threshold timeout threshold -private lemma step_preserves_opening_threshold (config : Config) (state : NodeState) +private theorem step_preserves_opening_threshold (config : Config) (state : NodeState) (event : Event) (threshold : forall kind, @@ -4464,7 +4444,7 @@ private lemma step_preserves_opening_threshold (config : Config) (state : NodeSt cases stepped exact threshold -private lemma systemStep_preserves_opening_thresholds +private theorem systemStep_preserves_opening_thresholds (config : Model.Config) (before after : SystemState) (target : Location) (event : Event) (output : StepOutput) (threshold @@ -4495,7 +4475,7 @@ private lemma systemStep_preserves_opening_thresholds · subst entry exact threshold previous member -private lemma next_preserves_opening_thresholds (config : Model.Config) +private theorem next_preserves_opening_thresholds (config : Model.Config) (before after : State) (action : Action) (threshold : OpeningThresholds config before) (trans : next config before action = some after) : OpeningThresholds config after := by @@ -4519,7 +4499,7 @@ private lemma next_preserves_opening_thresholds (config : Model.Config) exact systemStep_preserves_opening_thresholds config before.system system target .timeout output threshold systemStep entry member -private lemma reachable_opening_thresholds {config : Model.Config} {state : State} +private theorem reachable_opening_thresholds {config : Model.Config} {state : State} (reachable : Reachable config state) : OpeningThresholds config state := by induction reachable @@ -4530,7 +4510,7 @@ private lemma reachable_opening_thresholds {config : Model.Config} {state : Stat | step _ trans ih => exact next_preserves_opening_thresholds config _ _ _ ih trans -private lemma reachable_quorum_thresholds {config : Model.Config} {state : State} +private theorem reachable_quorum_thresholds {config : Model.Config} {state : State} (reachable : Reachable config state) (entry : Location × NodeState) (member : entry ∈ state.system.nodes) (quorum : entry.2.openKind = some .quorum) @@ -4546,7 +4526,7 @@ open Execution.Local hiding Config open Execution.Global open Invariants Quorum -lemma quorum_open_preserves_commit +theorem quorum_open_preserves_commit : forall (config : Model.Config) (trace : Properties.GlobalTrace config) (openedState : Model.State), forall (opener : Model.Local.Location) (openerState : Model.Local.NodeState), @@ -4644,7 +4624,7 @@ open Execution.Local open Execution.Global hiding Config open Predicates -private lemma reachable_opening_has_vote {config : Model.Config} {state : State} +private theorem reachable_opening_has_vote {config : Model.Config} {state : State} (reachable : Reachable config state) (entry : Location × NodeState) (member : entry ∈ state.system.nodes) (opened : entry.2.openKind.isSome = true) @@ -4666,7 +4646,7 @@ open Execution.Local hiding Config open Execution.Global Predicates open DisasterRecovery.Proofs.Invariants DisasterRecovery.Proofs.Quorum -private lemma up_to_date_with_quorum_of_all +private theorem up_to_date_with_quorum_of_all {config : Config} {candidate : TxID} (valid : config.Valid) (fresh : forall entry, entry ∈ config.recovered -> TxID.EarlierThan entry.2 candidate) @@ -4694,7 +4674,7 @@ open Execution.Local hiding Config open Execution.Global open Invariants Quorum -lemma full_gossip_preserves_commit +theorem full_gossip_preserves_commit : forall (config : Model.Config) (trace : Properties.GlobalTrace config) (gossipedState openedState : Model.State), forall (opener : Model.Local.Location) (openerState : Model.Local.NodeState), @@ -4759,12 +4739,12 @@ lemma full_gossip_preserves_commit obtain ⟨voter, voted⟩ := Observed.reachable_opening_has_vote openingReachable _ openingPresent opening obtain ⟨final, finalMember, evolves⟩ := - trace_node_final linked (le_max_right _ _) openFound.symm present + trace_node_final linked (Nat.le_max_right _ _) openFound.symm present have invariant := reachable_quorum_invariant linked.reachable obtain ⟨envelope, sent, _, target, vote⟩ := invariant.votesSent _ finalMember voter (evolves.votes voted) have complete := - sent_vote_full_gossip linked (le_max_left _ _) gossipFound.symm full sent vote + sent_vote_full_gossip linked (Nat.le_max_left _ _) gossipFound.symm full sent vote obtain ⟨selected, txid, choice, maximum⟩ := invariant.sentVotesSelected envelope sent vote have wf := reachable_well_formed linked.reachable have selectedEq : selected = envelope.target := @@ -4785,7 +4765,7 @@ open Execution.Local open Execution.Global hiding Config open Predicates -private lemma notification_opening_state {config : Model.Config} +private theorem notification_opening_state {config : Model.Config} {trace : Properties.GlobalTrace config} {index : Nat} {node : Location} {kind : OpenKind} (notification @@ -4825,10 +4805,9 @@ private lemma notification_opening_state {config : Model.Config} rw [← same] exact List.mem_of_find?_eq_some found -private lemma current_quorum_unique_of_thresholds {config : Model.Config} {state : State} - (reachable : Reachable config state) - (first second : Location × NodeState) - (firstMember : first ∈ state.system.nodes) +private theorem current_quorum_unique_of_thresholds {config : Model.Config} + {state : State} (reachable : Reachable config state) + (first second : Location × NodeState) (firstMember : first ∈ state.system.nodes) (secondMember : second ∈ state.system.nodes) (firstQuorum : voteQuorum config.protocol <= first.2.votes.length) (secondQuorum : voteQuorum config.protocol <= second.2.votes.length) @@ -4861,7 +4840,7 @@ open Execution.Local hiding Config open Execution.Global open Invariants Quorum -private lemma quorum_notification_final_votes {config : Model.Config} +private theorem quorum_notification_final_votes {config : Model.Config} {trace : Properties.GlobalTrace config} {bound : Nat} {ghost : State} (linked : History.Correspondence config trace bound ghost) {index : Nat} (le : index + 1 <= bound) {node : Location} @@ -4879,18 +4858,14 @@ private lemma quorum_notification_final_votes {config : Model.Config} have nodup := (reachable_quorum_invariant openingReachable).votesNodup _ openingPresent have threshold := Observed.reachable_quorum_thresholds openingReachable _ openingPresent opened obtain ⟨final, finalMember, evolves⟩ := trace_node_final linked le inTrace present - have subset : current.votes.toFinset ⊆ final.votes.toFinset := by - intro voter member - exact List.mem_toFinset.mpr (evolves.votes (List.mem_toFinset.mp member)) - have count := Finset.card_le_card subset - rw [List.toFinset_card_of_nodup nodup] at count - exact ⟨final, finalMember, threshold.trans (count.trans (List.toFinset_card_le _))⟩ + have count := nodup.length_le_of_subset fun _ member => evolves.votes member + exact ⟨final, finalMember, Nat.le_trans threshold count⟩ end DisasterRecovery.Proofs.Gossip namespace DisasterRecovery.Proofs.Model -lemma quorum_opener_unique +theorem quorum_opener_unique : forall (config : Model.Config) (trace : Properties.GlobalTrace config), forall (firstStep secondStep : Nat) (firstOpener secondOpener : Model.Local.Location), @@ -4906,9 +4881,9 @@ lemma quorum_opener_unique (Trace.max_isSome (Option.isSome_iff_exists.mpr ⟨_, firstFound⟩) (Option.isSome_iff_exists.mpr ⟨_, secondFound⟩)) obtain ⟨firstState, firstMember, firstThreshold⟩ := - Gossip.quorum_notification_final_votes linked (le_max_left _ _) first + Gossip.quorum_notification_final_votes linked (Nat.le_max_left _ _) first obtain ⟨secondState, secondMember, secondThreshold⟩ := - Gossip.quorum_notification_final_votes linked (le_max_right _ _) second + Gossip.quorum_notification_final_votes linked (Nat.le_max_right _ _) second exact Observed.current_quorum_unique_of_thresholds linked.reachable (firstOpener, firstState) (secondOpener, secondState) firstMember secondMember firstThreshold secondThreshold diff --git a/lean/disaster-recovery/DisasterRecovery/Proofs/Witnesses.lean b/lean/disaster-recovery/DisasterRecovery/Proofs/Witnesses.lean index 443f2ac8911..f0c4c8d2fd4 100644 --- a/lean/disaster-recovery/DisasterRecovery/Proofs/Witnesses.lean +++ b/lean/disaster-recovery/DisasterRecovery/Proofs/Witnesses.lean @@ -1,6 +1,7 @@ module public import DisasterRecovery.Properties.Utils +public import CCF.Proofs.Execution import all Init.Control.State @@ -11,7 +12,7 @@ namespace DisasterRecovery.Proofs.Witnesses open CCF open Model.Local -private lemma exists_recovered (config : Properties.ValidConfig) +private theorem exists_recovered (config : Properties.ValidConfig) : exists node txid, Model.recoveredTxID config node = some txid := by cases recovered : config.val.recovered with | nil => @@ -21,7 +22,7 @@ private lemma exists_recovered (config : Properties.ValidConfig) obtain ⟨node, txid⟩ := entry exact ⟨node, txid, by simp [Model.recoveredTxID, recovered]⟩ -lemma gossip_freezes_after_choice_witness +theorem gossip_freezes_after_choice_witness : forall (config : Properties.ValidConfig), exists localStep : Properties.LocalStep, exists (source : Location) (txid : TxID), @@ -40,7 +41,7 @@ lemma gossip_freezes_after_choice_witness simp [MultiNodeTransitionSystem.Protocol.ValidStep, Model.protocol, recovered, step, before, rejected, Capabilities.record] -lemma rejected_gossip_stutters_witness +theorem rejected_gossip_stutters_witness : forall (config : Properties.ValidConfig), exists localStep : Properties.LocalStep, exists (source : Location) (txid : TxID), @@ -58,7 +59,7 @@ lemma rejected_gossip_stutters_witness simp [MultiNodeTransitionSystem.Protocol.ValidStep, Model.protocol, recovered, step, rejected, Capabilities.record] -lemma quorum_advance_opens_witness +theorem quorum_advance_opens_witness : forall (config : Properties.ValidConfig), exists localStep : Properties.LocalStep, (Model.protocol config).ValidStep localStep @@ -96,7 +97,7 @@ lemma quorum_advance_opens_witness step, advance, before, validTimeout, advanceTimeoutLane, advanceTimeoutState, Capabilities.record] -lemma aligned_opening_timeout_completes_witness +theorem aligned_opening_timeout_completes_witness : forall (config : Properties.ValidConfig), exists localStep : Properties.LocalStep, (Model.protocol config).ValidStep localStep diff --git a/lean/disaster-recovery/DisasterRecovery/Properties.lean b/lean/disaster-recovery/DisasterRecovery/Properties.lean index faf266df5e4..f6dd9e1d90b 100644 --- a/lean/disaster-recovery/DisasterRecovery/Properties.lean +++ b/lean/disaster-recovery/DisasterRecovery/Properties.lean @@ -20,7 +20,7 @@ theorem deadlock_free exact Proofs.Deadlock.deadlock_free /-- Witness: every valid recovery configuration has a reachable initial state. -/ -lemma deadlock_free_witness +theorem deadlock_free_witness : forall (config : ValidConfig), exists (state : Model.State), (Model.transitionSystem config).Reachable state := by @@ -40,7 +40,7 @@ theorem quorum_opener_unique /-- Witness: for every valid configuration, a valid trace exists with a step emitting `opening quorum`. -/ -lemma quorum_opener_unique_witness +theorem quorum_opener_unique_witness : forall (config : ValidConfig), exists (trace : GlobalTrace config), exists (step : Nat) (opener : Location), @@ -64,7 +64,7 @@ theorem quorum_open_preserves_commit /-- Witness: for every valid configuration, a valid trace and a state in it with a node with `openKind = quorum` whose voters all satisfy `ReceivedOwnGossip` exist. -/ -lemma quorum_open_preserves_commit_witness +theorem quorum_open_preserves_commit_witness : forall (config : ValidConfig), exists (trace : GlobalTrace config) (openedState : Model.State), exists (opener : Location) (openerState : NodeState), @@ -97,7 +97,7 @@ theorem full_gossip_preserves_commit /-- Witness: for every valid configuration with at least two locations, a valid trace with a full-gossip state and a state in it with a node with `openKind = failover` exist. -/ -lemma full_gossip_preserves_commit_witness +theorem full_gossip_preserves_commit_witness : forall (config : ValidConfig), 2 <= config.val.protocol.expectedLocations.length -> exists (trace : GlobalTrace config), @@ -132,7 +132,7 @@ theorem gossip_freezes_after_choice /-- Witness: for every valid configuration, a valid step exists that receives accepted gossip when `chosen` is set. -/ -lemma gossip_freezes_after_choice_witness +theorem gossip_freezes_after_choice_witness : forall (config : ValidConfig), exists localStep : LocalStep, exists (source : Location) (txid : TxID), @@ -154,7 +154,7 @@ theorem rejected_gossip_stutters exact Proofs.Local.rejected_gossip_stutters /-- Witness: for every valid configuration, a valid step exists that receives rejected gossip. -/ -lemma rejected_gossip_stutters_witness +theorem rejected_gossip_stutters_witness : forall (config : ValidConfig), exists localStep : LocalStep, exists (source : Location) (txid : TxID), @@ -179,7 +179,7 @@ theorem quorum_advance_opens /-- Witness: for every valid configuration, a valid timeout or accepted-vote step exists from `voting` with at least `voteQuorum` votes. -/ -lemma quorum_advance_opens_witness +theorem quorum_advance_opens_witness : forall (config : ValidConfig), exists localStep : LocalStep, (Model.protocol config).ValidStep localStep @@ -204,7 +204,7 @@ theorem aligned_opening_timeout_completes /-- Witness: for every valid configuration, a valid timeout step exists with `phase` and `timeoutState` both `opening`. -/ -lemma aligned_opening_timeout_completes_witness +theorem aligned_opening_timeout_completes_witness : forall (config : ValidConfig), exists localStep : LocalStep, (Model.protocol config).ValidStep localStep diff --git a/lean/disaster-recovery/DisasterRecovery/Tests/Execution.lean b/lean/disaster-recovery/DisasterRecovery/Tests/Execution.lean index 1ad167f795c..7b8b6d371f5 100644 --- a/lean/disaster-recovery/DisasterRecovery/Tests/Execution.lean +++ b/lean/disaster-recovery/DisasterRecovery/Tests/Execution.lean @@ -1,8 +1,6 @@ module -public import CCF.Execution - -import Mathlib.Data.Seq.Basic +public import CCF.Proofs.Execution @[expose] public section @@ -32,13 +30,13 @@ example : Run counter 0 [true, false, true] 2 := -- Stutters are recorded as enabled actions, not inserted implicitly. private def counting : Trace counter := ⟨ - { init := 0, steps := Stream'.Seq.ofList [(false, 0), (true, 1), (true, 2)] }, + { init := 0, steps := CCF.Seq.ofList [(false, 0), (true, 1), (true, 2)] }, rfl, by intro n before action first chosen rcases n with _ | _ | _ | n <;> - simp only [Stream'.Seq.get?_cons_zero, Stream'.Seq.get?_cons_succ, - Stream'.Seq.map_get?, Stream'.Seq.ofList_get?, List.getElem?_cons_zero, + simp only [CCF.Seq.get?_cons_zero, CCF.Seq.get?_cons_succ, + CCF.Seq.map_get?, CCF.Seq.ofList_get?, List.getElem?_cons_zero, List.getElem?_cons_succ, List.getElem?_nil, Option.map_some, Option.map_none, Option.some.injEq] at first chosen ⊢ all_goals subst_vars @@ -58,12 +56,12 @@ example : counting.actionAt 2 = some true := rfl example : counting.stateAt 4 = none := rfl example : counting.actionAt 3 = none := rfl example : 2 ∈ counting := Trace.stateAt_mem (n := 3) rfl -example : 2 ∈ counting.states := Stream'.Seq.get?_mem (n := 3) rfl -example : false ∈ counting.actions := Stream'.Seq.get?_mem (n := 0) rfl +example : 2 ∈ counting.states := CCF.Seq.get?_mem (n := 3) rfl +example : false ∈ counting.actions := CCF.Seq.get?_mem (n := 0) rfl private def initialOnly : Trace counter := ⟨ - { init := 0, steps := Stream'.Seq.nil }, + { init := 0, steps := CCF.Seq.nil }, rfl, by intro n before action _ chosen; simp at chosen ⟩ @@ -74,7 +72,7 @@ example : initialOnly.actionAt 0 = none := rfl private def infinite : Trace counter := ⟨ - { init := 0, steps := Stream'.Seq.ofStream (fun n => (true, n + 1)) }, + { init := 0, steps := CCF.Seq.ofStream (fun n => (true, n + 1)) }, rfl, by intro n before action first chosen @@ -104,42 +102,40 @@ example -- A final state has no outgoing action, but each transition has one. example (trace : Trace counter) - (states : trace.states = Stream'.Seq.ofList [0, 1]) - (actions : trace.actions = Stream'.Seq.ofList []) + (states : trace.states = CCF.Seq.ofList [0, 1]) + (actions : trace.actions = CCF.Seq.ofList []) : False := by have domains := trace.valid_domains 0 simp [states, actions] at domains example (trace : Trace counter) - (states : trace.states = Stream'.Seq.ofList [0]) - (actions : trace.actions = Stream'.Seq.ofList [true]) + (states : trace.states = CCF.Seq.ofList [0]) + (actions : trace.actions = CCF.Seq.ofList [true]) : False := by have domains := trace.valid_domains 0 simp [states, actions] at domains -- An enabled action that reaches the wrong successor is not a recorded step. example (trace : Trace counter) - (states : trace.states = Stream'.Seq.ofList [0, 1]) - (actions : trace.actions = Stream'.Seq.ofList [false]) + (states : trace.states = CCF.Seq.ofList [0, 1]) + (actions : trace.actions = CCF.Seq.ofList [false]) : False := by have stepped := trace.valid_step 0 0 false (by simp [states]) (by simp [actions]) simp [counter, states] at stepped -- An empty trace has no initial state. -example (trace : Trace counter) (states : trace.states = Stream'.Seq.ofList []) - : False := by +example (trace : Trace counter) (states : trace.states = CCF.Seq.ofList []) : False := by obtain ⟨_, first, _⟩ := trace.valid_init simp [states] at first -example (trace : Trace counter) (states : trace.states = Stream'.Seq.ofList [1]) - : False := by +example (trace : Trace counter) (states : trace.states = CCF.Seq.ofList [1]) : False := by obtain ⟨initial, first, initialized⟩ := trace.valid_init simp [states] at first subst first simp at initialized -- Adjacent states must be related by an enabled action. -example (trace : Trace counter) (states : trace.states = Stream'.Seq.ofList [0, 2]) +example (trace : Trace counter) (states : trace.states = CCF.Seq.ofList [0, 2]) : False := by obtain ⟨action, step⟩ := trace.step 0 0 2 (by simp [Trace.stateAt, states]) (by simp [Trace.stateAt, states]) @@ -155,7 +151,7 @@ example step := fun _ _ => none } : TransitionSystem)) - (states : trace.states = Stream'.Seq.ofList [0, 0]) + (states : trace.states = CCF.Seq.ofList [0, 0]) : False := by obtain ⟨_, step⟩ := trace.step 0 0 0 (by simp [Trace.stateAt, states]) (by simp [Trace.stateAt, states]) diff --git a/lean/disaster-recovery/DisasterRecovery/Tests/Trace.lean b/lean/disaster-recovery/DisasterRecovery/Tests/Trace.lean index a8de2f6983a..0a574ce795d 100644 --- a/lean/disaster-recovery/DisasterRecovery/Tests/Trace.lean +++ b/lean/disaster-recovery/DisasterRecovery/Tests/Trace.lean @@ -175,7 +175,7 @@ example Properties.quorum_advance_opens config quorumTimeout ⟨rfl, Or.inl rfl, rfl, by decide⟩ example (candidate : Properties.GlobalTrace config) - (states : candidate.states = Stream'.Seq.ofList [ready, voteSent]) + (states : candidate.states = CCF.Seq.ofList [ready, voteSent]) : False := by obtain ⟨start, first, _, _, _, _, nodes⟩ := candidate.valid_init have same : start = ready := by simpa [states] using first.symm diff --git a/lean/disaster-recovery/README.md b/lean/disaster-recovery/README.md index 88fc54a9efa..e909feb18a5 100644 --- a/lean/disaster-recovery/README.md +++ b/lean/disaster-recovery/README.md @@ -82,7 +82,6 @@ Eventual-progress and fairness properties are out of scope. Run the following commands from this directory: ```console -lake exe cache get lake build --wfail --fail-fast lake exe check-imports lake build CCF @@ -104,15 +103,15 @@ Lean's internal-module and collection-variable naming conventions, and its debug The package also sets `autoImplicit = false`, requiring declaration headers to bind their parameters explicitly rather than silently introducing undeclared names. This applies to ordinary Lake builds as well as CI. -The model, proofs, tests, and replayer use Lean's module system, as required by the Mathlib dependency. +The model, proofs, tests, and replayer use Lean's module system. The properties entrypoint publicly imports the model types and property helpers used by its statements, while its implementation imports remain private. -Proof modules and the assembled root follow the shared [dependency import contract](../common/README.md#dependency-imports); import additional Mathlib facilities explicitly rather than relying on incidental reexports. +Proof modules and the assembled root follow the shared [dependency import contract](../common/README.md#dependency-imports); import additional facilities explicitly rather than relying on incidental reexports. `@[expose] public section` keeps definitions used by cross-module proofs transparent; runtime-only helpers remain private. `mk_all --module` generates the corresponding package-level import root. Proofs that evaluate upstream implementations use narrowly scoped `import all` directives to retain access to those definitions. -`runLinter` uses Mathlib's declaration-lint driver, including the slow checks, over every module imported by `CCF.lean`, `DisasterRecovery.lean`, and `replayer.Main`. +`runLinter` uses Batteries' declaration-lint driver, including the slow checks, over every module imported by `CCF.lean`, `DisasterRecovery.lean`, and `replayer.Main`. It lints our declarations rather than dependencies, and findings fail the command. The package's default targets are the complete library and the replayer executable. Canonical scenario and state-enumeration checks run with `#eval` when `Tests/CanonicalTests.lean` is built, and assertion failures fail the build. @@ -131,12 +130,12 @@ Additional bundled checkers are not enabled. The [Lean workflow](../../.github/workflows/lean.yml) checks `consensus`, `common`, `consistency`, `disaster-recovery`, and `kv` in one matrix with fail-fast disabled, using the same [package workflow](../../.github/workflows/lean-package.yml). Each invocation has its own checkout and writable build directories, including `common/.lake`, because the packages reference `../common` without copying it. -Mathlib cache setup precedes kernel and axiom checking, which precedes import/architecture checking, formatting, linting, and package-specific fixtures. +Kernel and axiom checking precedes import/architecture checking, formatting, linting, and package-specific fixtures. Common receives its own kernel, import, and lint checks; the disaster-recovery formatting selector also covers common and tracked Lean files outside `lean/`. Recovery schema validation, positive/negative replay fixtures, and viewer dump generation run in the disaster-recovery job. Native CCF consensus and KV captures run independently of package checking. -The [CCF consensus replay job](../consensus/replay/README.md#ci-captures-and-replay) and the KV replay job each wait only for their corresponding native captures, restore Mathlib caches, and build their own replay executable without depending on the package matrix. +The [CCF consensus replay job](../consensus/replay/README.md#ci-captures-and-replay) and the KV replay job each wait only for their corresponding native captures and build their own replay executable without depending on the package matrix. The final check retains the name `Lean models and proofs` and requires all package checks, captures, and replay to succeed. Failed, cancelled, skipped, or missing prerequisites cannot yield a successful gate; a cancelled workflow may cancel the gate itself. The gate also rejects package inventory drift. @@ -150,7 +149,7 @@ To update a tool dependency without changing the toolchain, run `lake update --k ## Formatting -Install Lean via [elan](https://lean-lang.org/install/) and run `lake exe cache get` from this directory before the first formatting check. +Install Lean via [elan](https://lean-lang.org/install/) before the first formatting check. From the repository root, check every tracked `.lean` file: ```console diff --git a/lean/disaster-recovery/lake-manifest.json b/lean/disaster-recovery/lake-manifest.json index bfb8d6162ec..ddf10279408 100644 --- a/lean/disaster-recovery/lake-manifest.json +++ b/lean/disaster-recovery/lake-manifest.json @@ -15,16 +15,16 @@ "configFile": "lakefile.toml" }, { - "url": "https://github.com/leanprover-community/mathlib4.git", + "url": "https://github.com/leanprover-community/batteries.git", "type": "git", "subDir": null, "scope": "", - "rev": "56a005855ea17e0b0958f73ec801ae140b0a1679", - "name": "mathlib", + "rev": "66e469188fe07963e5cf666c7d4433f45b8131c5", + "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "v4.35.0", "inherited": false, - "configFile": "lakefile.lean" + "configFile": "lakefile.toml" }, { "type": "path", @@ -35,102 +35,6 @@ "dir": "../common", "copy": false, "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dfa4f38190d07c37e315953e08b90fe2d95b3c24", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/LeanSearchClient", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "d6b4c7be5be75ec4917c873ac50c756dc1436372", - "name": "LeanSearchClient", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/import-graph", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "a41f0e9a4dea23188ea9cc1c41ac9f8bbafe0b93", - "name": "importGraph", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/ProofWidgets4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "df72b022e558978a1c50264cfc4d7fec86fa8e04", - "name": "proofwidgets", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/aesop", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "4a174c490d8707121c4a9290800489f105d85e07", - "name": "aesop", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/quote4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dce0ad79c486cb1fb504af04f953c3466b0c6db8", - "name": "Qq", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/batteries", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "66e469188fe07963e5cf666c7d4433f45b8131c5", - "name": "batteries", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover/lean4-cli", - "type": "git", - "subDir": null, - "scope": "leanprover", - "rev": "c24fe6078c630e89b489bffe59b3e20ac30d12c8", - "name": "Cli", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.35.0", - "inherited": true, - "configFile": "lakefile.toml" } ], "name": "disaster_recovery", diff --git a/lean/disaster-recovery/lakefile.toml b/lean/disaster-recovery/lakefile.toml index 4629b84dbd4..d5674a7fd3f 100644 --- a/lean/disaster-recovery/lakefile.toml +++ b/lean/disaster-recovery/lakefile.toml @@ -24,8 +24,8 @@ path = "../common" copy = false [[require]] -name = "mathlib" -git = "https://github.com/leanprover-community/mathlib4.git" +name = "batteries" +git = "https://github.com/leanprover-community/batteries.git" rev = "v4.35.0" [[require]] diff --git a/lean/kv/Kv/Model.lean b/lean/kv/Kv/Model.lean index faa983a65c7..784d3febfb6 100644 --- a/lean/kv/Kv/Model.lean +++ b/lean/kv/Kv/Model.lean @@ -3,7 +3,7 @@ module -public import CCF.Execution +public import CCF.TransitionSystem public import Kv.Model.Transitions @[expose] public section diff --git a/lean/kv/Kv/Proofs/Reachable.lean b/lean/kv/Kv/Proofs/Reachable.lean index b7a1882c216..4de5e203032 100644 --- a/lean/kv/Kv/Proofs/Reachable.lean +++ b/lean/kv/Kv/Proofs/Reachable.lean @@ -4,6 +4,7 @@ module public import Kv.Properties.Invariants +public import CCF.Execution /-! The executable model's state invariants, their preservation by every accepted step, and the diff --git a/lean/kv/Kv/Proofs/Replay.lean b/lean/kv/Kv/Proofs/Replay.lean index b898c8cff9f..a97c01541d7 100644 --- a/lean/kv/Kv/Proofs/Replay.lean +++ b/lean/kv/Kv/Proofs/Replay.lean @@ -4,6 +4,7 @@ module public import Kv.Properties.Invariants +public import CCF.Execution /-! Snapshot, map-capture and attempt-replay claims for accepted traces. diff --git a/lean/kv/Kv/Proofs/Witnesses.lean b/lean/kv/Kv/Proofs/Witnesses.lean index b76709aacf7..997211d34b8 100644 --- a/lean/kv/Kv/Proofs/Witnesses.lean +++ b/lean/kv/Kv/Proofs/Witnesses.lean @@ -4,6 +4,7 @@ module public import Kv.Properties.Invariants +public import CCF.Execution /-! Non-vacuity witnesses for the claims in `Kv.Properties`, together with the executable model's @@ -761,25 +762,25 @@ private theorem txOf_world {n sid tid : Nat} private def committedCell : DB String String String := [(("a", "00"), ⟨"11", 1⟩)] -lemma read_your_write_witness +theorem read_your_write_witness : ∃ (db : DB String String String) (ws : Writes String String String) (a : Addr String String) (v : String), valueAt db ws a ≠ some v := ⟨committedCell, [], ("a", "00"), "22", by decide⟩ -lemma read_your_deletion_witness +theorem read_your_deletion_witness : ∃ (db : DB String String String) (ws : Writes String String String) (a : Addr String String), valueAt db ws a ≠ none := ⟨committedCell, [], ("a", "00"), by decide⟩ -lemma previous_ignores_pending_witness +theorem previous_ignores_pending_witness : ∃ (db : DB String String String) (ws : Writes String String String) (a : Addr String String), previousAt db a ≠ none ∧ find ws a ≠ none := ⟨committedCell, [(("a", "00"), some "22")], ("a", "00"), by decide, by decide⟩ -lemma publish_lookup_witness +theorem publish_lookup_witness : ∃ (ws : Writes String String String) (kept removed written : Addr String String) (v : String), find ws kept = none @@ -796,7 +797,7 @@ lemma publish_lookup_witness by decide ⟩ -lemma apply_atomic_witness +theorem apply_atomic_witness : ∃ (writes : Pending) (a b : Addr String String), a.1 ≠ b.1 ∧ find writes a ≠ none ∧ find writes b ≠ none := ⟨ @@ -808,23 +809,23 @@ lemma apply_atomic_witness by decide ⟩ -lemma absent_read_witness +theorem absent_read_witness : ∃ (db : DB String String String) (ws : Writes String String String) (a : Addr String String), find ws a = none ∧ find db a = none := ⟨[], [], ("a", "00"), rfl, rfl⟩ -lemma staged_noninterference_witness : ∃ a b : Addr String String, a ≠ b := +theorem staged_noninterference_witness : ∃ a b : Addr String String, a ≠ b := ⟨("a", "00"), ("a", "01"), by decide⟩ -lemma publication_noninterference_witness +theorem publication_noninterference_witness : ∃ (ws : Writes String String String) (a : Addr String String), find ws a = none := ⟨[], ("a", "00"), rfl⟩ -lemma publish_unique_witness : ∃ db : DB String String String, Unique db := +theorem publish_unique_witness : ∃ db : DB String String String, Unique db := ⟨[], List.nodup_nil⟩ -lemma transaction_snapshot_serial_witness +theorem transaction_snapshot_serial_witness : ∃ (w : World) (tid : Nat) (t : Tx) (snap : Snapshot), Model.transitionSystem.Reachable w ∧ find w.txs tid = some t @@ -841,7 +842,7 @@ lemma transaction_snapshot_serial_witness facts.log7 ⟩ -lemma transaction_application_serial_witness +theorem transaction_application_serial_witness : ∃ (w : World) (sid tid : Nat) (s : Store) (t : Tx) (snap : Snapshot), Model.transitionSystem.Reachable w ∧ storeOf w sid = .ok s @@ -864,7 +865,7 @@ lemma transaction_application_serial_witness facts.log8 ⟩ -lemma executable_branch_serializability_witness +theorem executable_branch_serializability_witness : ∃ (s final : Store) (ts : List Tx), (∀ t ∈ ts, ∃ (w : World) (tid : Nat), @@ -881,7 +882,7 @@ lemma executable_branch_serializability_witness List.cons_ne_nil _ _ ⟩ -lemma replay_segment_serializability_witness +theorem replay_segment_serializability_witness : ∃ (w final : World) (sid : Nat) (s : Store) (rs : List Record), Model.transitionSystem.Reachable w ∧ find w.stores sid = some s @@ -906,17 +907,17 @@ private theorem reachable_live_store transitionSystem.Reachable w ∧ find w.stores sid = some s := ⟨world 12, 1, _, world_reachable facts.accepted (by decide), find_store facts.store12⟩ -lemma reachable_store_invariants_witness +theorem reachable_store_invariants_witness : ∃ (w : World) (sid : Nat) (s : Store), Model.transitionSystem.Reachable w ∧ find w.stores sid = some s := reachable_live_store -lemma reachable_store_data_invariants_witness +theorem reachable_store_data_invariants_witness : ∃ (w : World) (sid : Nat) (s : Store), Model.transitionSystem.Reachable w ∧ find w.stores sid = some s := reachable_live_store -lemma step_capture_metadata_witness +theorem step_capture_metadata_witness : ∃ (w next : World) (sid tid version global term seq : Nat) (s : Store) (t : Tx), storeOf w sid = .ok s ∧ Model.transitionSystem.step w ⟨seq, .snapshot sid tid version global term⟩ @@ -938,7 +939,7 @@ lemma step_capture_metadata_witness find_tx facts.tx14 ⟩ -lemma step_capture_cut_values_witness +theorem step_capture_cut_values_witness : ∃ (w next : World) (sid tid version global term seq : Nat) (s : Store), storeOf w sid = .ok s ∧ Model.transitionSystem.step w ⟨seq, .snapshot sid tid version global term⟩ @@ -957,7 +958,7 @@ lemma step_capture_cut_values_witness step_world facts.accepted (by decide) ⟩ -lemma capture_replay_preserves_metadata_witness +theorem capture_replay_preserves_metadata_witness : ∃ (w capturedWorld final : World) (sid tid version global term seq : Nat) (s : Store) (t : Tx) (tail : List Record), storeOf w sid = .ok s @@ -988,7 +989,7 @@ lemma capture_replay_preserves_metadata_witness List.cons_ne_nil _ _ ⟩ -lemma replay_snapshot_fixed_witness +theorem replay_snapshot_fixed_witness : ∃ (w final : World) (tid : Nat) (before : Tx) (snap : Snapshot) (rs : List Record), find w.txs tid = some before ∧ before.snapshot = some snap @@ -1009,7 +1010,7 @@ lemma replay_snapshot_fixed_witness List.cons_ne_nil _ _ ⟩ -lemma step_map_capture_witness +theorem step_map_capture_witness : ∃ (w next : World) (sid tid localVersion globalVersion seq : Nat) (map : String) (s : Store) (before after : Tx) (snap : Snapshot), storeOf w sid = .ok s @@ -1039,7 +1040,7 @@ lemma step_map_capture_witness find_tx facts.tx15 ⟩ -lemma replay_map_global_fixed_witness +theorem replay_map_global_fixed_witness : ∃ (w final : World) (tid : Nat) (before : Tx) (map : String) (view : GlobalView) (rs : List Record), find w.txs tid = some before @@ -1062,7 +1063,7 @@ lemma replay_map_global_fixed_witness List.cons_ne_nil _ _ ⟩ -lemma capture_replay_preserves_map_witness +theorem capture_replay_preserves_map_witness : ∃ (w capturedWorld final : World) (sid tid localVersion globalVersion seq : Nat) (map : String) (s : Store) (before capturedTx : Tx) (snap : Snapshot) (tail : List Record), @@ -1101,17 +1102,17 @@ lemma capture_replay_preserves_map_witness List.cons_ne_nil _ _ ⟩ -lemma captureGlobal_placeholder_witness +theorem captureGlobal_placeholder_witness : ∃ (s : Store) (snap : Snapshot) (map : String), find (captureLocal s snap map).births map = none := ⟨{}, ⟨{}, 0⟩, "a", rfl⟩ -lemma captureGlobal_committed_witness +theorem captureGlobal_committed_witness : ∃ (s : Store) (snap : Snapshot) (map : String) (birth : Stamp), find (captureLocal s snap map).births map = some birth := ⟨written, writtenSnapshot, "a", _, some_get facts.captured⟩ -lemma step_global_read_from_captured_map_witness +theorem step_global_read_from_captured_map_witness : ∃ (w next : World) (sid tid seq : Nat) (map key value : String) (t : Tx) (view : GlobalView), Model.transitionSystem.Reachable w @@ -1136,7 +1137,7 @@ lemma step_global_read_from_captured_map_witness step_world facts.accepted (by decide) ⟩ -lemma step_global_has_from_captured_map_witness +theorem step_global_has_from_captured_map_witness : ∃ (w next : World) (sid tid seq : Nat) (map key : String) (t : Tx) (view : GlobalView), Model.transitionSystem.Reachable w @@ -1160,10 +1161,10 @@ lemma step_global_has_from_captured_map_witness step_world facts.accepted (by decide) ⟩ -lemma compact_above_head_noop_witness : ∃ (s : Store) (v : Nat), s.head.version < v := +theorem compact_above_head_noop_witness : ∃ (s : Store) (v : Nat), s.head.version < v := ⟨{}, 1, Nat.zero_lt_one⟩ -lemma rollback_keeps_prefix_witness +theorem rollback_keeps_prefix_witness : ∃ (s : Store) (f : Frame), f ∈ s.history ∧ f.version ≤ s.global ∧ f.data ≠ [] := ⟨ compactStore written 1, @@ -1173,7 +1174,7 @@ lemma rollback_keeps_prefix_witness facts.compactedData ⟩ -lemma rollback_discards_suffix_witness +theorem rollback_discards_suffix_witness : ∃ (s : Store) (v : Nat) (f : Frame), f ∈ s.history ∧ v < f.version ∧ s.global ≤ v := by have written_valid : StoreInvariant written := @@ -1187,7 +1188,7 @@ lemma rollback_discards_suffix_witness facts.writtenGlobal ⟩ -lemma durable_cut_survives_rollback_witness +theorem durable_cut_survives_rollback_witness : ∃ (w : World) (sid : Nat) (s : Store) (v cut : Nat), Model.transitionSystem.Reachable w ∧ find w.stores sid = some s @@ -1207,12 +1208,12 @@ lemma durable_cut_survives_rollback_witness facts.durable12 ⟩ -lemma stale_term_cannot_apply_witness +theorem stale_term_cannot_apply_witness : ∃ (s : Store) (t : Tx) (snap : Snapshot), t.snapshot = some snap ∧ s.term ≠ snap.term := ⟨{}, { store := 0, snapshot := some ⟨{}, 1⟩ }, _, rfl, by decide⟩ -lemma discarded_handle_cannot_apply_witness +theorem discarded_handle_cannot_apply_witness : ∃ (s : Store) (t : Tx) (snap : Snapshot) (m : String) (view : GlobalView), t.snapshot = some snap ∧ (m, view) ∈ t.globalViews @@ -1228,7 +1229,7 @@ lemma discarded_handle_cannot_apply_witness facts.discardedRevision ⟩ -lemma discarded_birth_cannot_apply_witness +theorem discarded_birth_cannot_apply_witness : ∃ (s : Store) (t : Tx) (snap : Snapshot) (m : String) (view : GlobalView), t.snapshot = some snap ∧ (m, view) ∈ t.globalViews @@ -1244,7 +1245,7 @@ lemma discarded_birth_cannot_apply_witness facts.discardedBirth ⟩ -lemma compacted_map_unavailable_witness +theorem compacted_map_unavailable_witness : ∃ (s : Store) (f : Frame) (m : String) (birth : Stamp), find f.births m = some birth ∧ (revision f m).version < (revision (atCut s s.global) m).version := @@ -1257,12 +1258,12 @@ lemma compacted_map_unavailable_witness facts.compacted ⟩ -lemma absent_map_available_witness +theorem absent_map_available_witness : ∃ (f : Frame) (m : String), find f.births m = none ∧ image f.data m = [] ∧ find f.revisions m = none := ⟨{}, "a", rfl, rfl, rfl⟩ -lemma absent_placeholder_has_no_values_witness +theorem absent_placeholder_has_no_values_witness : ∃ (s : Store) (f : Frame) (m : String), find f.births m = none ∧ mapAvailable s f m = true := ⟨{}, {}, "a", rfl, rfl⟩ diff --git a/lean/kv/Kv/Properties.lean b/lean/kv/Kv/Properties.lean index 065170c7d84..82538801d1b 100644 --- a/lean/kv/Kv/Properties.lean +++ b/lean/kv/Kv/Properties.lean @@ -4,6 +4,7 @@ module public import Kv.Properties.Invariants +public import CCF.Execution import Kv.Proofs.Reachable import Kv.Proofs.Replay @@ -33,7 +34,7 @@ theorem read_your_write exact Proofs.Model.read_your_write /-- Witness: before a write is staged, the read can return a different value. -/ -lemma read_your_write_witness +theorem read_your_write_witness : ∃ (db : DB String String String) (ws : Writes String String String) (a : Addr String String) (v : String), valueAt db ws a ≠ some v := by @@ -47,7 +48,7 @@ theorem read_your_deletion exact Proofs.Model.read_your_deletion /-- Witness: before a removal is staged, the read can return a value. -/ -lemma read_your_deletion_witness +theorem read_your_deletion_witness : ∃ (db : DB String String String) (ws : Writes String String String) (a : Addr String String), valueAt db ws a ≠ none := by @@ -61,7 +62,7 @@ theorem absent_read exact Proofs.Model.absent_read /-- Witness: a key can be neither staged nor committed. -/ -lemma absent_read_witness +theorem absent_read_witness : ∃ (db : DB String String String) (ws : Writes String String String) (a : Addr String String), find ws a = none ∧ find db a = none := by @@ -75,7 +76,7 @@ theorem staged_noninterference exact Proofs.Model.staged_noninterference /-- Witness: two addresses can differ. -/ -lemma staged_noninterference_witness : ∃ a b : Addr String String, a ≠ b := by +theorem staged_noninterference_witness : ∃ a b : Addr String String, a ≠ b := by exact Proofs.Witnesses.staged_noninterference_witness /-- Reading the committed version ignores staged writes. -/ @@ -85,7 +86,7 @@ theorem previous_ignores_pending exact Proofs.Model.previous_ignores_pending /-- Witness: a key can have both a committed version and a staged write. -/ -lemma previous_ignores_pending_witness +theorem previous_ignores_pending_witness : ∃ (db : DB String String String) (ws : Writes String String String) (a : Addr String String), previousAt db a ≠ none ∧ find ws a ≠ none := by @@ -103,7 +104,7 @@ theorem publish_lookup exact Proofs.Model.publish_lookup /-- Witness: one write set can leave, remove and write addresses. -/ -lemma publish_lookup_witness +theorem publish_lookup_witness : ∃ (ws : Writes String String String) (kept removed written : Addr String String) (v : String), find ws kept = none @@ -119,7 +120,7 @@ theorem publication_noninterference exact Proofs.Model.publication_noninterference /-- Witness: an address can be unwritten. -/ -lemma publication_noninterference_witness +theorem publication_noninterference_witness : ∃ (ws : Writes String String String) (a : Addr String String), find ws a = none := by exact Proofs.Witnesses.publication_noninterference_witness @@ -132,7 +133,7 @@ theorem publish_unique exact Proofs.Model.publish_unique /-- Witness: a database can have unique keys. -/ -lemma publish_unique_witness : ∃ db : DB String String String, Unique db := by +theorem publish_unique_witness : ∃ db : DB String String String, Unique db := by exact Proofs.Witnesses.publish_unique_witness /-- Applying an attempt publishes its entire write set at the next version. -/ @@ -143,7 +144,7 @@ theorem apply_atomic exact Proofs.Model.apply_atomic /-- Witness: one applied write set can span two maps. -/ -lemma apply_atomic_witness +theorem apply_atomic_witness : ∃ (writes : Pending) (a b : Addr String String), a.1 ≠ b.1 ∧ find writes a ≠ none ∧ find writes b ≠ none := by exact Proofs.Witnesses.apply_atomic_witness @@ -160,7 +161,7 @@ theorem transaction_snapshot_serial exact Proofs.Properties.transaction_snapshot_serial /-- Witness: an attempt with a snapshot can have a nonempty log. -/ -lemma transaction_snapshot_serial_witness +theorem transaction_snapshot_serial_witness : ∃ (w : World) (tid : Nat) (t : Tx) (snap : Snapshot), Model.transitionSystem.Reachable w ∧ find w.txs tid = some t @@ -180,7 +181,7 @@ theorem transaction_application_serial exact Proofs.Properties.transaction_application_serial /-- Witness: an attempt with a nonempty log can apply. -/ -lemma transaction_application_serial_witness +theorem transaction_application_serial_witness : ∃ (w : World) (sid tid : Nat) (s : Store) (t : Tx) (snap : Snapshot), Model.transitionSystem.Reachable w ∧ storeOf w sid = .ok s @@ -201,7 +202,7 @@ theorem executable_branch_serializability exact Proofs.Properties.executable_branch_serializability /-- Witness: a nonempty branch of applied attempts exists. -/ -lemma executable_branch_serializability_witness +theorem executable_branch_serializability_witness : ∃ (s final : Store) (ts : List Tx), (∀ t ∈ ts, ∃ (w : World) (tid : Nat), @@ -226,7 +227,7 @@ theorem replay_segment_serializability exact Proofs.Trace.replay_segment_serializability_claim /-- Witness: an accepted nonempty segment can keep a store alive. -/ -lemma replay_segment_serializability_witness +theorem replay_segment_serializability_witness : ∃ (w final : World) (sid : Nat) (s : Store) (rs : List Record), Model.transitionSystem.Reachable w ∧ find w.stores sid = some s @@ -250,7 +251,7 @@ theorem reachable_store_invariants exact Proofs.Trace.reachable_store_invariants_claim /-- Witness: a reachable world can have a live store. -/ -lemma reachable_store_invariants_witness +theorem reachable_store_invariants_witness : ∃ (w : World) (sid : Nat) (s : Store), Model.transitionSystem.Reachable w ∧ find w.stores sid = some s := by exact Proofs.Witnesses.reachable_store_invariants_witness @@ -265,7 +266,7 @@ theorem reachable_store_data_invariants exact Proofs.Trace.reachable_store_data_invariants_claim /-- Witness: a reachable world can have a live store. -/ -lemma reachable_store_data_invariants_witness +theorem reachable_store_data_invariants_witness : ∃ (w : World) (sid : Nat) (s : Store), Model.transitionSystem.Reachable w ∧ find w.stores sid = some s := by exact Proofs.Witnesses.reachable_store_data_invariants_witness @@ -283,7 +284,7 @@ theorem step_capture_metadata exact Proofs.Trace.step_capture_metadata_claim /-- Witness: a snapshot capture can be accepted. -/ -lemma step_capture_metadata_witness +theorem step_capture_metadata_witness : ∃ (w next : World) (sid tid version global term seq : Nat) (s : Store) (t : Tx), storeOf w sid = .ok s ∧ Model.transitionSystem.step w ⟨seq, .snapshot sid tid version global term⟩ @@ -301,7 +302,7 @@ theorem step_capture_cut_values exact Proofs.Trace.step_capture_cut_values_claim /-- Witness: a snapshot capture can be accepted. -/ -lemma step_capture_cut_values_witness +theorem step_capture_cut_values_witness : ∃ (w next : World) (sid tid version global term seq : Nat) (s : Store), storeOf w sid = .ok s ∧ Model.transitionSystem.step w ⟨seq, .snapshot sid tid version global term⟩ @@ -327,7 +328,7 @@ theorem capture_replay_preserves_metadata exact Proofs.Trace.capture_replay_preserves_metadata_claim /-- Witness: a snapshot capture can be followed by an accepted nonempty run that keeps the attempt. -/ -lemma capture_replay_preserves_metadata_witness +theorem capture_replay_preserves_metadata_witness : ∃ (w capturedWorld final : World) (sid tid version global term seq : Nat) (s : Store) (t : Tx) (tail : List Record), storeOf w sid = .ok s @@ -350,7 +351,7 @@ theorem replay_snapshot_fixed exact Proofs.Trace.replay_snapshot_fixed_claim /-- Witness: an attempt with a snapshot can be followed by an accepted nonempty run that keeps it. -/ -lemma replay_snapshot_fixed_witness +theorem replay_snapshot_fixed_witness : ∃ (w final : World) (tid : Nat) (before : Tx) (snap : Snapshot) (rs : List Record), find w.txs tid = some before ∧ before.snapshot = some snap @@ -378,7 +379,7 @@ theorem step_map_capture exact Proofs.Trace.step_map_capture_claim /-- Witness: a map acquisition can be accepted. -/ -lemma step_map_capture_witness +theorem step_map_capture_witness : ∃ (w next : World) (sid tid localVersion globalVersion seq : Nat) (map : String) (s : Store) (before after : Tx) (snap : Snapshot), storeOf w sid = .ok s @@ -403,7 +404,7 @@ theorem replay_map_global_fixed exact Proofs.Trace.replay_map_global_fixed_claim /-- Witness: an attempt with an acquired map can be followed by an accepted nonempty run that keeps it. -/ -lemma replay_map_global_fixed_witness +theorem replay_map_global_fixed_witness : ∃ (w final : World) (tid : Nat) (before : Tx) (map : String) (view : GlobalView) (rs : List Record), find w.txs tid = some before @@ -427,7 +428,7 @@ theorem replay_map_local_fixed exact Proofs.Trace.replay_map_local_fixed_claim /-- Witness: an acquired map can survive a nonempty accepted segment. -/ -lemma replay_map_local_fixed_witness +theorem replay_map_local_fixed_witness : ∃ (w final : World) (tid : Nat) (before : Tx) (map : String) (view : GlobalView) (rs : List Record), find w.txs tid = some before @@ -461,7 +462,7 @@ theorem capture_replay_preserves_map exact Proofs.Trace.capture_replay_preserves_map_claim /-- Witness: a map acquisition can be followed by an accepted nonempty run that keeps the attempt. -/ -lemma capture_replay_preserves_map_witness +theorem capture_replay_preserves_map_witness : ∃ (w capturedWorld final : World) (sid tid localVersion globalVersion seq : Nat) (map : String) (s : Store) (before capturedTx : Tx) (snap : Snapshot) (tail : List Record), @@ -485,7 +486,7 @@ theorem captureGlobal_placeholder exact Proofs.Trace.captureGlobal_placeholder /-- Witness: a snapshot can lack a map. -/ -lemma captureGlobal_placeholder_witness +theorem captureGlobal_placeholder_witness : ∃ (s : Store) (snap : Snapshot) (map : String), find (captureLocal s snap map).births map = none := by exact Proofs.Witnesses.captureGlobal_placeholder_witness @@ -498,7 +499,7 @@ theorem captureGlobal_committed exact Proofs.Trace.captureGlobal_committed /-- Witness: a snapshot can contain a map. -/ -lemma captureGlobal_committed_witness +theorem captureGlobal_committed_witness : ∃ (s : Store) (snap : Snapshot) (map : String) (birth : Stamp), find (captureLocal s snap map).births map = some birth := by exact Proofs.Witnesses.captureGlobal_committed_witness @@ -521,7 +522,7 @@ theorem step_global_read_from_captured_map exact Proofs.Trace.step_global_read_from_captured_map_claim /-- Witness: a global read of a committed value can be accepted. -/ -lemma step_global_read_from_captured_map_witness +theorem step_global_read_from_captured_map_witness : ∃ (w next : World) (sid tid seq : Nat) (map key value : String) (t : Tx) (view : GlobalView), Model.transitionSystem.Reachable w @@ -549,7 +550,7 @@ theorem step_global_has_from_captured_map exact Proofs.Trace.step_global_has_from_captured_map_claim /-- Witness: a global presence test of a committed key can be accepted. -/ -lemma step_global_has_from_captured_map_witness +theorem step_global_has_from_captured_map_witness : ∃ (w next : World) (sid tid seq : Nat) (map key : String) (t : Tx) (view : GlobalView), Model.transitionSystem.Reachable w @@ -567,7 +568,8 @@ theorem compact_above_head_noop exact Proofs.Model.compact_above_head_noop /-- Witness: a version can be beyond the head. -/ -lemma compact_above_head_noop_witness : ∃ (s : Store) (v : Nat), s.head.version < v := by +theorem compact_above_head_noop_witness + : ∃ (s : Store) (v : Nat), s.head.version < v := by exact Proofs.Witnesses.compact_above_head_noop_witness /-- Rollback keeps every frame at or below the global version. -/ @@ -577,7 +579,7 @@ theorem rollback_keeps_prefix exact Proofs.Model.rollback_keeps_prefix /-- Witness: a nonempty frame can be on the branch at or below the global version. -/ -lemma rollback_keeps_prefix_witness +theorem rollback_keeps_prefix_witness : ∃ (s : Store) (f : Frame), f ∈ s.history ∧ f.version ≤ s.global ∧ f.data ≠ [] := by exact Proofs.Witnesses.rollback_keeps_prefix_witness @@ -588,7 +590,7 @@ theorem rollback_discards_suffix exact Proofs.Model.rollback_discards_suffix /-- Witness: a frame on the branch can be above a version at or above the global version. -/ -lemma rollback_discards_suffix_witness +theorem rollback_discards_suffix_witness : ∃ (s : Store) (v : Nat) (f : Frame), f ∈ s.history ∧ v < f.version ∧ s.global ≤ v := by exact Proofs.Witnesses.rollback_discards_suffix_witness @@ -604,7 +606,7 @@ theorem durable_cut_survives_rollback exact Proofs.Properties.durable_cut_survives_rollback /-- Witness: a nonempty cut can be at or below the global version. -/ -lemma durable_cut_survives_rollback_witness +theorem durable_cut_survives_rollback_witness : ∃ (w : World) (sid : Nat) (s : Store) (v cut : Nat), Model.transitionSystem.Reachable w ∧ find w.stores sid = some s @@ -620,7 +622,7 @@ theorem stale_term_cannot_apply exact Proofs.Model.stale_term_cannot_apply /-- Witness: an attempt's snapshot term can differ from the store's. -/ -lemma stale_term_cannot_apply_witness +theorem stale_term_cannot_apply_witness : ∃ (s : Store) (t : Tx) (snap : Snapshot), t.snapshot = some snap ∧ s.term ≠ snap.term := by exact Proofs.Witnesses.stale_term_cannot_apply_witness @@ -635,7 +637,7 @@ theorem discarded_handle_cannot_apply exact Proofs.Properties.discarded_handle_cannot_apply /-- Witness: an attempt can hold a map whose revision is no longer on the branch. -/ -lemma discarded_handle_cannot_apply_witness +theorem discarded_handle_cannot_apply_witness : ∃ (s : Store) (t : Tx) (snap : Snapshot) (m : String) (view : GlobalView), t.snapshot = some snap ∧ (m, view) ∈ t.globalViews @@ -652,7 +654,7 @@ theorem discarded_birth_cannot_apply exact Proofs.Properties.discarded_birth_cannot_apply /-- Witness: an attempt can hold a map whose creation is no longer on the branch. -/ -lemma discarded_birth_cannot_apply_witness +theorem discarded_birth_cannot_apply_witness : ∃ (s : Store) (t : Tx) (snap : Snapshot) (m : String) (view : GlobalView), t.snapshot = some snap ∧ (m, view) ∈ t.globalViews @@ -668,7 +670,7 @@ theorem compacted_map_unavailable exact Proofs.Model.compacted_map_unavailable /-- Witness: a map can be revised before the global cut's revision. -/ -lemma compacted_map_unavailable_witness +theorem compacted_map_unavailable_witness : ∃ (s : Store) (f : Frame) (m : String) (birth : Stamp), find f.births m = some birth ∧ (revision f m).version < (revision (atCut s s.global) m).version := by @@ -684,7 +686,7 @@ theorem absent_map_available exact Proofs.Model.absent_map_available /-- Witness: a map can be absent, empty, and unrevised. -/ -lemma absent_map_available_witness +theorem absent_map_available_witness : ∃ (f : Frame) (m : String), find f.births m = none ∧ image f.data m = [] ∧ find f.revisions m = none := by exact Proofs.Witnesses.absent_map_available_witness @@ -698,7 +700,7 @@ theorem absent_placeholder_has_no_values exact Proofs.Model.absent_placeholder_has_no_values /-- Witness: an absent map can be available. -/ -lemma absent_placeholder_has_no_values_witness +theorem absent_placeholder_has_no_values_witness : ∃ (s : Store) (f : Frame) (m : String), find f.births m = none ∧ mapAvailable s f m = true := by exact Proofs.Witnesses.absent_placeholder_has_no_values_witness diff --git a/lean/kv/README.md b/lean/kv/README.md index 0977a08f166..762f9821fe6 100644 --- a/lean/kv/README.md +++ b/lean/kv/README.md @@ -202,7 +202,6 @@ Rejections remain diagnostic evidence and must not be hidden by reseeding state Run the following commands from this directory: ```console -lake exe cache get lake build --wfail --fail-fast lake exe check-imports lake build CCF diff --git a/lean/kv/lake-manifest.json b/lean/kv/lake-manifest.json index 2c579ab5d97..843ba7d15ef 100644 --- a/lean/kv/lake-manifest.json +++ b/lean/kv/lake-manifest.json @@ -15,16 +15,16 @@ "configFile": "lakefile.toml" }, { - "url": "https://github.com/leanprover-community/mathlib4.git", + "url": "https://github.com/leanprover-community/batteries.git", "type": "git", "subDir": null, "scope": "", - "rev": "56a005855ea17e0b0958f73ec801ae140b0a1679", - "name": "mathlib", + "rev": "66e469188fe07963e5cf666c7d4433f45b8131c5", + "name": "batteries", "manifestFile": "lake-manifest.json", "inputRev": "v4.35.0", "inherited": false, - "configFile": "lakefile.lean" + "configFile": "lakefile.toml" }, { "type": "path", @@ -35,102 +35,6 @@ "dir": "../common", "copy": false, "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/plausible", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dfa4f38190d07c37e315953e08b90fe2d95b3c24", - "name": "plausible", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/LeanSearchClient", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "d6b4c7be5be75ec4917c873ac50c756dc1436372", - "name": "LeanSearchClient", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/import-graph", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "a41f0e9a4dea23188ea9cc1c41ac9f8bbafe0b93", - "name": "importGraph", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/ProofWidgets4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "df72b022e558978a1c50264cfc4d7fec86fa8e04", - "name": "proofwidgets", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.lean" - }, - { - "url": "https://github.com/leanprover-community/aesop", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "4a174c490d8707121c4a9290800489f105d85e07", - "name": "aesop", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/quote4", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "dce0ad79c486cb1fb504af04f953c3466b0c6db8", - "name": "Qq", - "manifestFile": "lake-manifest.json", - "inputRev": "master", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover-community/batteries", - "type": "git", - "subDir": null, - "scope": "leanprover-community", - "rev": "66e469188fe07963e5cf666c7d4433f45b8131c5", - "name": "batteries", - "manifestFile": "lake-manifest.json", - "inputRev": "main", - "inherited": true, - "configFile": "lakefile.toml" - }, - { - "url": "https://github.com/leanprover/lean4-cli", - "type": "git", - "subDir": null, - "scope": "leanprover", - "rev": "c24fe6078c630e89b489bffe59b3e20ac30d12c8", - "name": "Cli", - "manifestFile": "lake-manifest.json", - "inputRev": "v4.35.0", - "inherited": true, - "configFile": "lakefile.toml" } ], "name": "kv", diff --git a/lean/kv/lakefile.toml b/lean/kv/lakefile.toml index dbcf4c29aea..3ff17751a69 100644 --- a/lean/kv/lakefile.toml +++ b/lean/kv/lakefile.toml @@ -24,8 +24,8 @@ path = "../common" copy = false [[require]] -name = "mathlib" -git = "https://github.com/leanprover-community/mathlib4.git" +name = "batteries" +git = "https://github.com/leanprover-community/batteries.git" rev = "v4.35.0" [[require]] diff --git a/lean/mathlib-equivalence/MathlibEquivalence.lean b/lean/mathlib-equivalence/MathlibEquivalence.lean new file mode 100644 index 00000000000..3448d3845d7 --- /dev/null +++ b/lean/mathlib-equivalence/MathlibEquivalence.lean @@ -0,0 +1,4 @@ +import MathlibEquivalence.Finset +import MathlibEquivalence.Function +import MathlibEquivalence.Rank +import MathlibEquivalence.Seq diff --git a/lean/mathlib-equivalence/MathlibEquivalence/Finset.lean b/lean/mathlib-equivalence/MathlibEquivalence/Finset.lean new file mode 100644 index 00000000000..dba7999739f --- /dev/null +++ b/lean/mathlib-equivalence/MathlibEquivalence/Finset.lean @@ -0,0 +1,119 @@ +module + +public import CCF.Proofs.Finset +public import Mathlib.Data.Finset.Max +public import Mathlib.Data.Finset.Sort +public import Mathlib.Logic.Equiv.Defs + +@[expose] public section + +/-! +For a linearly ordered element type, `CCF.Finset` is equivalent to Mathlib's +`Finset`, and the equivalence commutes with every operation that CCF defines. +-/ + +namespace MathlibEquivalence.Finset + +variable {α : Type} [LinearOrder α] + +instance : CCF.StrictTotalOrder α := + ⟨lt_irrefl, lt_trans, lt_trichotomy⟩ + +/-- The Mathlib set with the same elements. -/ +def toMathlib (s : CCF.Finset α) : _root_.Finset α := + ⟨s.val, Multiset.coe_nodup.mpr (s.sorted.imp ne_of_lt)⟩ + +/-- The CCF set with the same elements. -/ +def ofMathlib (s : _root_.Finset α) : CCF.Finset α := + ⟨s.sort, (_root_.Finset.sortedLT_sort s).pairwise⟩ + +@[simp] +theorem mem_toMathlib {a : α} {s : CCF.Finset α} : a ∈ toMathlib s ↔ a ∈ s := by + simp [toMathlib, CCF.Finset.mem_def] + +@[simp] +theorem mem_ofMathlib {a : α} {s : _root_.Finset α} : a ∈ ofMathlib s ↔ a ∈ s := by + simp [ofMathlib, CCF.Finset.mem_def] + +theorem ofMathlib_toMathlib (s : CCF.Finset α) : ofMathlib (toMathlib s) = s := + CCF.Finset.ext fun _ => by simp + +theorem toMathlib_ofMathlib (s : _root_.Finset α) : toMathlib (ofMathlib s) = s := + _root_.Finset.ext fun _ => by simp + +/-- `CCF.Finset α` and `Finset α` are equivalent. -/ +def equiv : CCF.Finset α ≃ _root_.Finset α where + toFun := toMathlib + invFun := ofMathlib + left_inv := ofMathlib_toMathlib + right_inv := toMathlib_ofMathlib + +theorem toMathlib_empty : toMathlib (∅ : CCF.Finset α) = ∅ := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_singleton (a : α) : toMathlib ({a} : CCF.Finset α) = {a} := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_insert (a : α) (s : CCF.Finset α) + : toMathlib (insert a s) = insert a (toMathlib s) := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_filter (p : α → Prop) [DecidablePred p] (s : CCF.Finset α) + : toMathlib (s.filter p) = (toMathlib s).filter p := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_erase (s : CCF.Finset α) (a : α) + : toMathlib (s.erase a) = (toMathlib s).erase a := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_union (s t : CCF.Finset α) + : toMathlib (s ∪ t) = toMathlib s ∪ toMathlib t := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_inter (s t : CCF.Finset α) + : toMathlib (s ∩ t) = toMathlib s ∩ toMathlib t := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_sdiff (s t : CCF.Finset α) + : toMathlib (s \ t) = toMathlib s \ toMathlib t := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_ofList (l : List α) : toMathlib (CCF.Finset.ofList l) = l.toFinset := + _root_.Finset.ext fun _ => by simp + +theorem toMathlib_subset {s t : CCF.Finset α} : toMathlib s ⊆ toMathlib t ↔ s ⊆ t := by + simp [_root_.Finset.subset_iff, CCF.Finset.subset_iff] + +theorem toMathlib_nonempty {s : CCF.Finset α} : (toMathlib s).Nonempty ↔ s.Nonempty := by + simp [_root_.Finset.Nonempty, CCF.Finset.Nonempty] + +theorem toMathlib_disjoint {s t : CCF.Finset α} + : Disjoint (toMathlib s) (toMathlib t) ↔ s.Disjoint t := by + simp [_root_.Finset.disjoint_left, CCF.Finset.disjoint_left] + +theorem card_toMathlib (s : CCF.Finset α) : (toMathlib s).card = s.card := by + simp [toMathlib, CCF.Finset.card] + +theorem sort_toMathlib (s : CCF.Finset α) : (toMathlib s).sort = s.sort := + congrArg CCF.Finset.val (ofMathlib_toMathlib s) + +theorem min_toMathlib (s : CCF.Finset α) : (toMathlib s).min = s.min?.elim ⊤ (↑) := by + rcases s with ⟨_ | ⟨x, xs⟩, sorted⟩ + · exact _root_.Finset.min_eq_top.mpr (_root_.Finset.ext fun _ => by simp [toMathlib]) + · have least : ∀ m ∈ toMathlib ⟨x :: xs, sorted⟩, (x : WithTop α) ≤ m := by + intro m member + simp only [toMathlib, _root_.Finset.mem_mk, Multiset.mem_coe, List.mem_cons] at member + rcases member with rfl | later + · exact le_rfl + · exact WithTop.coe_le_coe.mpr (le_of_lt ((List.pairwise_cons.mp sorted).1 m later)) + exact le_antisymm + (_root_.Finset.min_le (by simp [toMathlib])) + (_root_.Finset.le_min least) + +/-- The replaced uses compared `Finset.min` with an element. -/ +theorem min_toMathlib_eq_coe {s : CCF.Finset α} {a : α} + : (toMathlib s).min = a ↔ s.min? = some a := by + rw [min_toMathlib] + cases s.min? <;> simp + +end MathlibEquivalence.Finset diff --git a/lean/mathlib-equivalence/MathlibEquivalence/Function.lean b/lean/mathlib-equivalence/MathlibEquivalence/Function.lean new file mode 100644 index 00000000000..bbaa2e75e6f --- /dev/null +++ b/lean/mathlib-equivalence/MathlibEquivalence/Function.lean @@ -0,0 +1,19 @@ +module + +public import CCF.Function +public import Mathlib.Logic.Function.Basic + +public section + +/-! +`CCF.Function.update` is Mathlib's `Function.update`. +-/ + +namespace MathlibEquivalence.Function + +theorem update_eq {α β : Type} [DecidableEq α] (f : α → β) (a : α) (v : β) + : CCF.Function.update f a v = Function.update f a v := by + funext x + simp [CCF.Function.update_apply, Function.update_apply] + +end MathlibEquivalence.Function diff --git a/lean/mathlib-equivalence/MathlibEquivalence/Rank.lean b/lean/mathlib-equivalence/MathlibEquivalence/Rank.lean new file mode 100644 index 00000000000..e5ae27b72e2 --- /dev/null +++ b/lean/mathlib-equivalence/MathlibEquivalence/Rank.lean @@ -0,0 +1,45 @@ +module + +public import Consensus.Model.Node +public import Mathlib.Order.Prod.Lex.Basic +public import Mathlib.Tactic.CongrExclamation + +@[expose] public section + +/-! +`rankBelow` is the lexicographic order that `findSuccessor` used through +Mathlib's `toLex` before the Mathlib dependency was removed. +-/ + +namespace MathlibEquivalence.Rank + +open Consensus.Model.Node + +theorem rankBelow_eq (a b : Nat × Nat × Nat) + : rankBelow a b = decide (toLex (a.1, toLex a.2) < toLex (b.1, toLex b.2)) := by + rw [rankBelow, Bool.eq_iff_iff, decide_eq_true_iff] + simp [Prod.lexLt, Prod.Lex.toLex_lt_toLex] + +/-- `findSuccessor` as it was defined with Mathlib's `toLex`. -/ +def findSuccessorLex (state : NodeState) (self : NodeID) : Option NodeID := + let configurations := state.activeConfigurations + let rank node := + toLex (state.matchIndex node, toLex (latestMembershipIndex configurations node, node)) + let peers := (eligiblePeers state self).sort + peers.foldl + (fun best candidate => + match best with + | none => some candidate + | some selected => + if rank selected < rank candidate then + some candidate + else + best) + none + +theorem findSuccessor_eq_lex (state : NodeState) (self : NodeID) + : findSuccessor state self = findSuccessorLex state self := by + simp only [findSuccessor, findSuccessorLex, rankBelow_eq, decide_eq_true_eq] + congr! + +end MathlibEquivalence.Rank diff --git a/lean/mathlib-equivalence/MathlibEquivalence/Seq.lean b/lean/mathlib-equivalence/MathlibEquivalence/Seq.lean new file mode 100644 index 00000000000..095e3d5bdd1 --- /dev/null +++ b/lean/mathlib-equivalence/MathlibEquivalence/Seq.lean @@ -0,0 +1,60 @@ +module + +public import CCF.Seq +public import Mathlib.Data.Seq.Basic +public import Mathlib.Logic.Equiv.Defs + +@[expose] public section + +/-! +`CCF.Seq` is equivalent to Mathlib's `Stream'.Seq`, and the equivalence +commutes with every operation that CCF defines. +-/ + +namespace MathlibEquivalence.Seq + +variable {α β : Type} + +/-- The Mathlib sequence with the same elements. -/ +def toMathlib (s : CCF.Seq α) : Stream'.Seq α := + ⟨s.get?, s.stable⟩ + +/-- The CCF sequence with the same elements. -/ +def ofMathlib (s : Stream'.Seq α) : CCF.Seq α := + ⟨s.get?, s.2⟩ + +/-- `CCF.Seq α` and `Stream'.Seq α` are equivalent. -/ +def equiv : CCF.Seq α ≃ Stream'.Seq α where + toFun := toMathlib + invFun := ofMathlib + left_inv _ := rfl + right_inv _ := rfl + +@[simp] +theorem get?_toMathlib (s : CCF.Seq α) (n : Nat) : (toMathlib s).get? n = s.get? n := + rfl + +theorem toMathlib_nil : toMathlib (CCF.Seq.nil : CCF.Seq α) = Stream'.Seq.nil := + Stream'.Seq.ext fun _ => rfl + +theorem toMathlib_cons (a : α) (s : CCF.Seq α) + : toMathlib (CCF.Seq.cons a s) = Stream'.Seq.cons a (toMathlib s) := + Stream'.Seq.ext fun n => by cases n <;> rfl + +theorem toMathlib_map (f : α → β) (s : CCF.Seq α) + : toMathlib (s.map f) = Stream'.Seq.map f (toMathlib s) := + Stream'.Seq.ext fun n => by simp [Stream'.Seq.map_get?] + +theorem toMathlib_ofList (l : List α) + : toMathlib (CCF.Seq.ofList l) = Stream'.Seq.ofList l := + Stream'.Seq.ext fun n => by simp [Stream'.Seq.ofList_get?] + +theorem toMathlib_ofStream (f : Nat → α) + : toMathlib (CCF.Seq.ofStream f) = Stream'.Seq.ofStream f := + rfl + +theorem mem_toMathlib {a : α} {s : CCF.Seq α} : a ∈ toMathlib s ↔ a ∈ s := by + rw [Stream'.Seq.mem_iff_exists_get?, CCF.Seq.mem_iff_exists_get?] + rfl + +end MathlibEquivalence.Seq diff --git a/lean/mathlib-equivalence/README.md b/lean/mathlib-equivalence/README.md new file mode 100644 index 00000000000..a039d02093a --- /dev/null +++ b/lean/mathlib-equivalence/README.md @@ -0,0 +1,27 @@ +# Mathlib equivalence + +This package proves that the local replacements for Mathlib definitions are equivalent to the Mathlib definitions they replaced. +It is the only Lean package that depends on Mathlib, so the common and specification packages, and their CI jobs, do not need it. +The [Lean Mathlib equivalence workflow](../../.github/workflows/lean-mathlib-equivalence.yml) checks it only when the replacement definitions or this package change. + +| Module | CCF definition | Mathlib definition | Results | +| ----------------------------- | ------------------------------- | ----------------------------- | --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- | +| `MathlibEquivalence.Seq` | `CCF.Seq` | `Stream'.Seq` | `equiv`, an equivalence of types that preserves `get?`, `nil`, `cons`, `map`, `ofList`, `ofStream` and membership | +| `MathlibEquivalence.Finset` | `CCF.Finset` | `Finset`, for a `LinearOrder` | `equiv`, an equivalence of types that preserves membership, the empty set, singletons, `insert`, `filter`, `erase`, union, intersection, difference, `ofList` (`List.toFinset`), subset, `Nonempty`, `Disjoint`, `card`, `sort` and `min?` (`Finset.min`) | +| `MathlibEquivalence.Function` | `CCF.Function.update` | `Function.update` | The two are equal | +| `MathlibEquivalence.Rank` | `rankBelow` and `findSuccessor` | `toLex` | `rankBelow` is `toLex` comparison, and `findSuccessor` equals its previous `toLex` definition | + +The equivalences map each CCF operation to the corresponding Mathlib operation, so properties proved about the Mathlib definitions hold for the CCF ones. +The lemmas about the replacements in `CCF.Proofs.Finset` are proved independently, with the same names as their Mathlib counterparts. + +## Checking + +Fetch Mathlib's build cache (about 5 GB) and run the kernel and axiom check: + +```bash +cd lean/mathlib-equivalence +lake exe cache get +lake check --inadvisably-no-sandbox +``` + +Check formatting from the repository root with `./scripts/lean-format-checks.sh mathlib-equivalence`. diff --git a/lean/mathlib-equivalence/lake-manifest.json b/lean/mathlib-equivalence/lake-manifest.json new file mode 100644 index 00000000000..3390012eb35 --- /dev/null +++ b/lean/mathlib-equivalence/lake-manifest.json @@ -0,0 +1,149 @@ +{ + "version": "1.3.0", + "packagesDir": ".lake/packages", + "packages": [ + { + "url": "https://github.com/leanprover-community/mathlib4.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "56a005855ea17e0b0958f73ec801ae140b0a1679", + "name": "mathlib", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.35.0", + "inherited": false, + "configFile": "lakefile.lean" + }, + { + "type": "path", + "scope": "", + "name": "consensus", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "../consensus", + "copy": false, + "configFile": "lakefile.toml" + }, + { + "type": "path", + "scope": "", + "name": "ccf_common", + "manifestFile": "lake-manifest.json", + "inherited": false, + "dir": "../common", + "copy": false, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/plausible", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "dfa4f38190d07c37e315953e08b90fe2d95b3c24", + "name": "plausible", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/LeanSearchClient", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "d6b4c7be5be75ec4917c873ac50c756dc1436372", + "name": "LeanSearchClient", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/import-graph", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "a41f0e9a4dea23188ea9cc1c41ac9f8bbafe0b93", + "name": "importGraph", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/ProofWidgets4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "df72b022e558978a1c50264cfc4d7fec86fa8e04", + "name": "proofwidgets", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.lean" + }, + { + "url": "https://github.com/leanprover-community/aesop", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "4a174c490d8707121c4a9290800489f105d85e07", + "name": "aesop", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/quote4", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "dce0ad79c486cb1fb504af04f953c3466b0c6db8", + "name": "Qq", + "manifestFile": "lake-manifest.json", + "inputRev": "master", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover-community/batteries", + "type": "git", + "subDir": null, + "scope": "leanprover-community", + "rev": "66e469188fe07963e5cf666c7d4433f45b8131c5", + "name": "batteries", + "manifestFile": "lake-manifest.json", + "inputRev": "main", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/duckki/leanfmt.git", + "type": "git", + "subDir": null, + "scope": "", + "rev": "65d69c8dc2dfd0aa69fd4132d48f38b7af9a57ef", + "name": "leanfmt", + "manifestFile": "lake-manifest.json", + "inputRev": "65d69c8dc2dfd0aa69fd4132d48f38b7af9a57ef", + "inherited": true, + "configFile": "lakefile.toml" + }, + { + "url": "https://github.com/leanprover/lean4-cli", + "type": "git", + "subDir": null, + "scope": "leanprover", + "rev": "c24fe6078c630e89b489bffe59b3e20ac30d12c8", + "name": "Cli", + "manifestFile": "lake-manifest.json", + "inputRev": "v4.35.0", + "inherited": true, + "configFile": "lakefile.toml" + } + ], + "name": "mathlib_equivalence", + "lakeDir": ".lake", + "fixedToolchain": false +} diff --git a/lean/mathlib-equivalence/lakefile.toml b/lean/mathlib-equivalence/lakefile.toml new file mode 100644 index 00000000000..8db3b158d91 --- /dev/null +++ b/lean/mathlib-equivalence/lakefile.toml @@ -0,0 +1,23 @@ +name = "mathlib_equivalence" +version = "0.1.0" +moreLeanArgs = ["-DwarningAsError=true"] +leanOptions = { autoImplicit = false } +defaultTargets = ["MathlibEquivalence"] + +[[require]] +name = "ccf_common" +path = "../common" +copy = false + +[[require]] +name = "consensus" +path = "../consensus" +copy = false + +[[require]] +name = "mathlib" +git = "https://github.com/leanprover-community/mathlib4.git" +rev = "v4.35.0" + +[[lean_lib]] +name = "MathlibEquivalence" diff --git a/lean/mathlib-equivalence/lean-toolchain b/lean/mathlib-equivalence/lean-toolchain new file mode 120000 index 00000000000..6f68e61b371 --- /dev/null +++ b/lean/mathlib-equivalence/lean-toolchain @@ -0,0 +1 @@ +../lean-toolchain \ No newline at end of file diff --git a/scripts/lean-format-checks.sh b/scripts/lean-format-checks.sh index a8f3ac43eff..0c3008862cd 100755 --- a/scripts/lean-format-checks.sh +++ b/scripts/lean-format-checks.sh @@ -4,7 +4,8 @@ # Checks (and optionally fixes) all tracked Lean files via leanfmt. # Pass -f to auto-fix formatting issues. Pass package names under lean/ to -# check only those packages; the default checks every package. +# check only those packages; the default checks every package except +# mathlib-equivalence, which needs Mathlib and has its own workflow. set -euo pipefail @@ -22,7 +23,7 @@ if ! command -v lake >/dev/null 2>&1; then exit 1 fi -declare -A LIBRARIES=([disaster-recovery]=DisasterRecovery [consensus]=Consensus [consistency]=consistency [kv]=Kv) +declare -A LIBRARIES=([disaster-recovery]=DisasterRecovery [consensus]=Consensus [consistency]=consistency [kv]=Kv [mathlib-equivalence]=MathlibEquivalence) PACKAGES=("$@") if [ ${#PACKAGES[@]} -eq 0 ]; then PACKAGES=(disaster-recovery consensus consistency kv) @@ -36,7 +37,7 @@ for package in "${PACKAGES[@]}"; do fi # The disaster recovery package also checks Lean files outside lean/. if [ "$package" == "disaster-recovery" ]; then - PATHSPEC=("*.lean" ":(exclude)lean/consensus/*" ":(exclude)lean/consistency/*" ":(exclude)lean/kv/*") + PATHSPEC=("*.lean" ":(exclude)lean/consensus/*" ":(exclude)lean/consistency/*" ":(exclude)lean/kv/*" ":(exclude)lean/mathlib-equivalence/*") else PATHSPEC=("lean/$package/*.lean") fi